Para que o seu Form não seja redimensionado

www.fontesbrasil.com



Inclua o código abaixo em um Form. 

type
TForm1 = class(TForm)
private
{ Private declarations }
procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
message WM_GETMINMAXINFO;
procedure WMInitMenuPopup(var Msg: TWMInitMenuPopup);
message WM_INITMENUPOPUP;
procedure WMNCHitTest(var Msg: TWMNCHitTest);
message WM_NCHitTest;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
begin
inherited;
with Msg.MinMaxInfo^ do
begin
ptMinTrackSize.x:= form1.width;
ptMaxTrackSize.x:= form1.width;
ptMinTrackSize.y:= form1.height;
ptMaxTrackSize.y:= form1.height;
end;
end;
procedure TForm1.WMInitMenuPopup(var Msg: TWMInitMenuPopup);
begin
inherited;
if Msg.SystemMenu then
EnableMenuItem(Msg.MenuPopup, SC_SIZE, MF_BYCOMMAND or MF_GRAYED)
end;
procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
begin
inherited;
with Msg do
if Result in [HTLEFT, HTRIGHT, HTBOTTOM, HTBOTTOMRIGHT,HTBOTTOMLEFT, HTTOP,
HTTOPRIGHT, HTTOPLEFT] then
Result:= HTNOWHERE
end;

 


 

 


Como mover um componente em Run-time




No exemplo abaixo deve ser incluído um componente Button. Para testar este exemplo mantenha a tecla CTRL
pressionada clique com o mouse no componente Button. Feito isto, basta arrastar o componente Button para
qualquer lado. 

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Button1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
MouseDownSpot : TPoint;
Capturing : bool;
end;
var
Form1: TForm1; 

implementation
{$R *.DFM} 

// Evento OnMouseDown do Form
procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if ssCtrl in Shift then begin
SetCapture(Button1.Handle);
Capturing := true;
MouseDownSpot.X := x;
MouseDownSpot.Y := Y;
end;
end; 

// Evento OnMouseMove do Form
procedure TForm1.Button1MouseMove(Sender:
TObject; Shift: TShiftState; X, Y: Integer);
begin
if Capturing then begin
Button1.Left:= Button1.Left-(MouseDownSpot.x-x);
Button1.Top:= Button1.Top - (MouseDownSpot.-y);
end;
end; 

// Evento OnMouseUp do Form
procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Capturing then begin
ReleaseCapture;
Capturing := false;
Button1.Left := Button1.Left - (MouseDownSpot.x -x);
Button1.Top := Button1.Top - (MouseDownSpot.y - y);
end;
end;

 

 




Como verificar se a tecla TAB foi pressionada




Para testar o exemplo abaixo inclua alguns componentes Edit em seu form. 

type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure ProcessaMsg(var Msg: TMsg; var Handled: Boolean);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.ProcessaMsg(var Msg: TMsg; var Handled: Boolean);
begin
if Msg.message = WM_KEYDOWN then
begin
if Msg.wParam = VK_TAB then
Caption := ‘Tecla Tab’;
end;
end;
// Evento OnCreate
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage := ProcessaMsg;
end;

 


 

 



Executar um AVI no Form




procedure TForm1.BitBtn1Click(Sender: TObject);
begin 

with MediaPlayer1 do
begin
FileName := ‘c:\windows\help\scroll.avi’;
Open;
Display := Form2;
Form2.Show;
Play;
end; 

end;

 


 



Colocar zeros a esquerda de um valor digitado no componente Edit




procedure TForm1.Edit1Exit(Sender: TObject);
begin
Edit1.Text := FormatFloat(‘000000’,StrToFloat(Edit1.Text));
end;




 

 

Cancelar o pressionamento de uma tecla




procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = ‘,’ then
Key := #0;
end;

Obs. O exemplo acima cancela o pressionamento de uma virgula em um componente EDIT.



 


Utilizar o MessageBox com parâmetros




var
Button: Integer;
Mensagem1 : Array[0..79] of Char;
Mensagem2 : Array[0..79] of Char;
begin
StrPCopy(Mensagem1, Edit1.Text + ‘ ‘ + Edit2.Text);
StrPCopy(Mensagem2, Edit3.Text + ‘ ‘ + Edit4.Text);
Button := Application.MessageBox (Mensagem2,Mensagem1, MB_YESNOCANCEL+
mb_DefButton1+MB_ICONQUESTION);
end;



 

 

Retorna a cor de um determinado componente no formato String




procedure TForm1.BitBtn1Click(Sender: TObject);
begin
// Retorna a cor do form
Caption := ColorToString(Form1.Color);
// Muda a cor do form
Form1.Color := StringToColor(‘clBlack’);
end;



 


Verifica se existe o diretório




procedure TForm1.Button1Click(Sender: TObject);
begin
if DirectoryExists(Edit1.Text) then
Label1.Caption := Edit1.Text + ‘ exists’
else
Label1.Caption := Edit1.Text + ‘ does not exist’;
end;




 

 

Bloquear a tecla Ctrl+Del do DBGrid




procedure TForm1.DBGrid1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if ((Shift = [ssCtrl]) and (key = vk_delete)) THEN
Abort;
end;



 

 

Para criar uma janela não retangular




Você deve criar uma Região do Windows e usar a função da API SetWindowRgn, desta maneira (isto funciona
apenas em
D2/D3): 

var 
hR : THandle; 
begin {cria uma Reigião elíptica} 
hR := CreateEllipticRgn(0,0,100,200); 
SetWindowRgn(Handle,hR,True); 
end; 




 

 

Fecha todos os arquivos




var
i: integer;
begin
with Session do
for i:= 0 to DatabaseCount - 1 do
Databases[I].Close;
end;



 


Hint com quebra de linhas




Para incluir mais de uma linha no Hint você deve utilizar o evento OnMouseMove de cada componente.
Veja abaixo como ficará o código em um Edit por exemplo. 

procedure TForm1.Edit1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Edit1.hint := ‘Primeira Linha’+#13+’Segunda Linha’+#13+
‘Terceira Linha’+#13+’Quarta Linha’;
end; 

Obs. Não esquecer de mudar para TRUE o evento ShowHint.



 


Imprimir diretamente para a impressora sem passar pelo gerenciador de impressão




procedure TForm1.Button1Click(Sender: TObject);
var
F : TextFile;
i : integer; 

begin
AssignFile(F,’LPT1');
Rewrite(F);
i := 0;
Writeln(F,’Teste de impressao - Linha 0');
Writeln(F,’Teste de impressao - Linha 1');
Writeln(F,#27#15+’Teste de Impressão - Linha 2');
Writeln(F,’Teste de impressao - Linha 3');
Writeln(F,#27#18+’Teste de Impressão - Linha 4');
Writeln(F,’Teste de impressao - Linha 5');
Writeln(F,#12); // Ejeta a página
CloseFile(F);
end;




 

 

 

Fechar um aplicativo Delphi a partir de outro aplicativo Delphi




procedure TForm1.Button1Click(Sender: TObject);
var
Win : THandle; 

begin
Win := FindWindow(nil,’Form1');
if Win <> 0 then
PostMessage(Win,WM_CLOSE,0,0)
else
ShowMessage(‘Programa não encontrado’);
end; 

Obs. No exemplo acima foi utilizado o POSTMESSAGE para enviar uma mensagem WM_CLOSE para a janela
principal.




Mostrar o HINT num Panel




procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnHint := DisplayHint;
end;
procedure TForm1.DisplayHint(Sender: TObject);
begin
Panel1.Caption := Application.Hint;
end; 

Obs. Não é necessário Atribuir True para o ShowHint




 

 

 

Executando um programa em DOS e fechando sua janela em seguida




Quando você executa um programa DOS no Windows95, sua janela permanece aberta até ser fechada pelo
usuário.
Para executar um programa DOS que fecha sua janela após a execução, deve ser especificado “command.com /c
programa” na linha de comando. Usando a função da API WinExec para executar um programa chamado
progdos.exe, a chamada deve ser: 

WinExec(‘command.com /c progdos.exe’,sw_ShowNormal); 

Obs. Se o programa deve ser executado sem que seja visualizado pelo usuário, o segundo parâmetro deve ser
sw_Hide. Deve ser especificada a extensão .com senão o programa não será executado.


 


 

 

Retornar o nome do usuário que esta editando o registro




procedure TForm1.BitBtn1Click(Sender: TObject);
begin
try
Table1.Edit;
except on E:EDBEngineError do
if E.Errors[0].ErrorCode = 10241 then
begin
ShowMessage(‘Mensagem de erro’+E.Errors[0].Message );
ShowMessage( ‘Arquivo com erro’+E.Errors[1].Message );
ShowMessage( ‘Nome do usuario’+ E.Errors[2].Message );
end;
end;
end;




 

 

Retornar o nome do usuário que esta com a tabela Exclusiva




procedure TForm1.BitBtn1Click(Sender: TObject); 

begin
try
Table1.Close;
Table1.Exclusive := True;
Table1.Open;
except on E:EDBEngineError do
if E.Errors[0].ErrorCode = 10243 then
begin
ShowMessage(‘Mensagem de erro’+E.Errors[0].Message );
ShowMessage( ‘Arquivo com erro’+E.Errors[1].Message );
ShowMessage( ‘Nome do usuario’+ E.Errors[2].Message );
end
end; 

end;





 

 

 

Configuração do BDE para ambiente de rede




Para o seu aplicativo feito em Delphi rodar em rede, você deve instalar o BDE em todas as estações. No BDE de
cada estação, você deve colocar no parâmetro NET DIR do drive PARADOX o local onde estão as bases de
dados e na PATH do Alias especificar o caminho das base de dados. Mas muita atenção, todas as estações
devem estar com a mesma configuração do BDE. Veja o exemplo abaixo para configuração do parâmetro NET DIR
do drive PARADOX e o PATH do Alias. 

Estação n.1
NET DIR F:\
Path do Alias F:\DIRETORIO 

Estação n.2
NET DIR F:\
Path do Alias F:\DIRETORIO 

Estação n.3
NET DIR F:\
Path do Alias F:\DIRETORIO 

Não é aconselhável que os aplicativos feitos em Delphi 1, sejam executados no servidor da base de dados, pois o
PARADOX apresenta problemas de corrupção de arquivos e índices neste caso. É aconselhável que no servidor
você coloque somente as bases de dados. Mas caso você tenha necessidade de utilizar o servidor você pode
utilizar uma solução alternativa para o problema do PARADOX, esta solução esta sendo satisfatória na maioria
dos casos. Digamos que a letra do drive de rede que você vai acessar o servidor, seja a letra “F:”, então, faça o
seguinte: Coloque a linha abaixo no arquivo AUTOEXEC.BAT, do servidor. 

SUBST F: C: 

Configure o BDE do servidor para que ele acesse o drive “F:”
Esta linha deverá ser colocada apenas no servidor, com isso você passa a ter em seu servidor, um drive virtual
para acessar o
drive C:, evitando o problema do PARADOX.
No Delphi 2 e Delphi 3, você deve utilizar um instalador de programas. No CD do Delphi 2 e Delphi 3 existe um
instalador
chamado InstallShield para fazer a instalação e configuração do aplicativo e do BDE. 

Veja abaixo os exemplos da configuração do BDE p/ Delphi 2 e 3: 

Servidor Estação 1
NET DIR \\SERVIDOR\C NET DIR \\SERVIDOR\C
PATH DO ALIAS \\SERVIDOR\C\DIRETORIO PATH DO ALIAS \\SERVIDOR\C\DIRETORIO
LOCAL SHARE TRUE LOCAL SHARE FALSE 

Estação 2 Estação 3
NET DIR \\SERVIDOR\C NET DIR \\SERVIDOR\C
PATH DO ALIAS \\SERVIDOR\C\DIRETORIO PATH DO ALIAS \\SERVIDOR\C\DIRETORIO
LOCAL SHARE FALSE LOCAL SHARE FALSE 

DICA: 
O executável pode ser colocado em cada máquina da rede, diminuindo assim o tráfego de rede.


 


 

 

 

Como criar um Form de Apresentação (Splash Form) como o do WORD




Para você criar um pequeno Form de apresentação enquanto seu programa é carregado ou enquanto sua
aplicação gera indices, etc. Crie seu Form de Apresentação (ApresForm) e depois no menu View opção Project
Source, inclua o seguinte código: 

program Mastapp; 
uses
Forms, 

Apres in ‘APRES.PAS’ {ApresForm},
Aplicacao01 in ‘APLIC01.PAS’ {Aplic01Form},
Aplicacao02 in ‘APLIC02.PAS’ {Aplic02Form};
{$R *.RES}
begin
ApresForm := TApresForm.Create(Application);
ApresForm.Show;
ApresForm.Update;
Application.CreateForm(TAplic01Form, Aplic01Form);
Application.CreateForm(TAplic01Form, Aplic02Form);
ApresForm.Hide;
ApresForm.Free;
Application.Run;
end.



 


 

 

Verifica se o Form, já esta ativo, Delphi1, Delphi2 e Delphi3




procedure TForm1.Button1Click(Sender: TObject);
var Found,i : Integer;
begin
Found := -1;
for i := 0 to Screen.FormCount - 1 do
if Screen.Forms[i] is TForm2 then
Found := i;
if Found >= 0 then
Screen.Forms[Found].Show
else
begin
Form2 := TForm2.Create(Self);
Form2.Show;
end; 

end;


 


 

 

 

Converter a primeira letra de um Texto em maiúscula




procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
with Sender as TEdit do
if (SelStart = 0) or (Text[SelStart] = ‘ ‘) then
if Key in [‘a’..’z’] then
Key := UpCase(Key);
end;



 


Verifica se o Form, já esta ativo




procedure TForm1.Button1Click(Sender: TObject);
var Found,i : Integer;
begin
Found := -1;
for i := 0 to Screen.FormCount - 1 do
if Screen.Forms[i] is TForm2 then
Found := i;
if Found >= 0 then
Screen.Forms[Found].Show
else
begin
Form2 := TForm2.Create(Self);
Form2.Show;
end; 
end;




 

 

Mostrar as fontes TrueType instaladas no Windows




Para testar o exemplo abaixo inclua em seu formulário um componente ListBox, um componente Label e um
componente
ListBox. 

// Evento OnClick do componente LisBox 

procedure TForm1.ListBox1Click(Sender: TObject);
begin 

{ Atribui a propriedade Caption do componente Label o nome da fonte selecionada apenas para visualização} 

Label1.Caption := ListBox1.Items[ListBox1.ItemIndex]; 

{ Atribui ao componente Label1 na propriedade Name da propriedade Font o nome da fonte selecionada
para que o componente Label para utilizar a mesma fonte }
Label1.Font.Name := ListBox1.Items[ListBox1.ItemIndex]; 

end; 

// Evento OnClick do componente Button. 

procedure TForm1.Button1Click(Sender: TObject);
begin
{Carrega as fontes instaladas no Windows para o componente ListBox}
ListBox1.Items := Screen.Fonts;
end;

 


 

 

ShowMessage com quebra de linhas




procedure TForm1.Button1Click(Sender: TObject);
var
MSG : String;
begin
MSG := ‘Mensagem da Primeira Linha’+#13+’Mensagem da Segunda Linha’+#13+’Mensagem da Terceira Linha’;
ShowMessage(MSG);
end;
ATENÇÃO. A quebra foi possível através do codigo #13.



 


 

 

 

Veja abaixo como retornar informações do ambiente DOS




No exemplo abaixo deve ser incluído no form um componente Button, um componente StringGrid e um
componente ListBox. 

type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
StringGrid1: TStringGrid;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end; 

var
Form1: TForm1; 

implementation 

{$R *.DFM} 

// Evento OnClick do componente Button
procedure TForm1.Button1Click(Sender: TObject); 

var
Env : PChar;
i : Integer;
S : String;
PosEq : Integer;
begin
Env := GetEnvironmentStrings;
With ListBox1,StringGrid1 do begin
While Env^ <> #0 do begin
Items.Add(StrPas(Env));
Inc(Env,StrLen(Env)+1);
end;
RowCount := Items.Count;
for i := 0 to Pred(Items.Count) do begin
PosEq := Pos(‘=’,Items[i]);
Cells[0,i] := Copy(Items[i],1,PosEq-1);
Cells[1,i] :=
Copy(Items[i],PosEq+1,Length(Items[i]));
end;
end; 

end;



 


 

 

Como colocar um componente ComboBox em um componente StringGrid




Inclua no seu Form um componente ComboBox e um componente StringGrid. 

type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
ComboBox1: TComboBox;
procedure FormCreate(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure ComboBox1Exit(Sender: TObject);
procedure StringGrid1SelectCell
(Sender: TObject; Col, Row: Integer;
var CanSelect: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
// Evento OnCreate do Form
procedure TForm1.FormCreate(Sender: TObject);
begin
{ Ajusta a altura do ComboBox com a altura da linha do StringGrid}
StringGrid1.DefaultRowHeight := ComboBox1.Height;
{Esconde o ComboBox}
ComboBox1.Visible := False;
end;
// Evento OnChange do componente ComboBox
procedure TForm1.ComboBox1Change
(Sender: TObject);
begin
StringGrid1.Cells[StringGrid1.Col,StringGrid1.Row]
:= ComboBox1.Items[ComboBox1.ItemIndex];
ComboBox1.Visible := False;
StringGrid1.SetFocus;
end;
// Evento OnExit do componente ComboBox
procedure TForm1.ComboBox1Exit
(Sender: TObject);
begin
StringGrid1.Cells[StringGrid1.Col,StringGrid1.Row]
:= ComboBox1.Items[ComboBox1.ItemIndex];
ComboBox1.Visible := False;
StringGrid1.SetFocus;
end;
// Evento OnSelectCell do componente StringGrid
procedure TForm1.StringGrid1SelectCell(Sender: TObject; Col, Row: Integer;
var CanSelect: Boolean);
var
R: TRect;
begin
if ((Col = 3) AND
(Row <> 0)) then begin
R := StringGrid1.CellRect(Col, Row);
R.Left := R.Left + StringGrid1.Left;
R.Right := R.Right + StringGrid1.Left;
R.Top := R.Top + StringGrid1.Top;
R.Bottom := R.Bottom + StringGrid1.Top;
ComboBox1.Left := R.Left + 1;
ComboBox1.Top := R.Top + 1;
ComboBox1.Width := (R.Right + 1) - R.Left;
ComboBox1.Height := (R.Bottom + 1) - R.Top;
ComboBox1.Visible := True;
ComboBox1.SetFocus;
end;
CanSelect := True; 

end;




 


Como retornar o coluna ativa do DBGrid




unit Unit1;
interface 

use
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs,
Db, DBTables, Grids, DBGrids;
type
TForm1 = class(TForm)
DBGrid1: TDBGrid;
Table1: TTable;
DataSource1: TDataSource;
procedure DBGrid1ColEnter(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.DFM} 

procedure TForm1.DBGrid1ColEnter(Sender: TObject);
begin
Caption := DBGrid1.SelectedField.FieldName;
end;



 

 

Como mover o conteudo da calculadora do Windows para um Edit




Neste exemplo deve ser incluído um componente Timer. 

type
TForm1 = class(TForm)
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
private
Hour, Minute, Second: Word; {hora corrente}
XCenter, YCenter, Radius: Integer; {tamanho atual do formulário} 

public
procedure DrawHand (XCenter, YCenter, Radius,
BackRadius: Integer; Angle: Real);
end; 

var
Form1: TForm1; 

implementation 

{$R *.DFM}
// Evento OnTimer do componente Timer
procedure TForm1.Timer1Timer(Sender: TObject);
var
HSec: Word; {valor temporário, não utilizado}
begin
{obtém a hora do sistema}
DecodeTime (Time, Hour, Minute, Second, HSec);
Refresh;
end; 

// Evento OnPaint do componente Form
procedure TForm1.FormPaint(Sender: TObject);
var
Angle: Real;
I, X, Y, Size: Integer;
begin
{calcula o centro do formulário}
XCenter := ClientWidth div 2;
YCenter := ClientHeight div 2;
if XCenter > YCenter then
Radius := YCenter - 10
else
Radius := XCenter - 10;
{0. Desenha o marcador de horas}
Canvas.Pen.Color := clYellow;
Canvas.Brush.Color := clYellow;
Size := Radius div 50 + 1;
for I := 0 to 11 do
begin
Angle := 2 * Pi * I / 12;
X := XCenter - Round (Radius * Cos (Angle));
Y := YCenter - Round (Radius * Sin (Angle));
Canvas.Ellipse (X - Size, Y - Size, X +
Size, Y + Size);
end; 

{1. Desenha o ponteiro dos minutos}
Canvas.Pen.Width := 2;
Canvas.Pen.Color := clBlue;
Angle := 2 * Pi * Minute / 60;
DrawHand (XCenter, YCenter, Radius * 90 div 100, 0, Angle);
{2. Desenha o ponteiro das horas: percentual dos minutos adicionado à hora para mover o ponteiro suavemente}
Angle := 2 * Pi * (Hour + Minute / 60) / 12;
DrawHand (XCenter, YCenter,
Radius * 70 div 100, 0, Angle);
{3. Desenha o ponteiro dos segundos}
Canvas.Pen.Width := 1;
Canvas.Pen.Color := clRed;
Angle := 2 * Pi * Second / 60;
DrawHand (XCenter, YCenter, Radius,
Radius * 30 div 100, Angle);
end; 

procedure TForm1.DrawHand (XCenter, YCenter,
Radius, BackRadius: Integer; Angle: Real);
begin
Angle := (Angle + 3*Pi/2);
Canvas.MoveTo (
XCenter - Round (BackRadius * Cos (Angle)),
YCenter - Round (BackRadius * Sin (Angle)));
Canvas.LineTo (
XCenter + Round (Radius * Cos (Angle)),
YCenter + Round (Radius * Sin (Angle)));
end; 

// Evento OnCreate do Form
procedure TForm1.FormCreate(Sender: TObject);
begin
{lê as horas antes do formulário ser exibido}
Timer1Timer (self);
end; 

// Evento OnResize do Form
procedure TForm1.FormResize(Sender: TObject);
begin
Refresh;
end;

 




 

 

 

Como criar um contador de página para um relatório desenvolvido no QuickReport 2.0




var
Form1: TForm1;
i : integer;
implementation
{$R *.DFM} 

procedure TForm1.Button1Click(Sender: TObject);
begin
i := 0 ;
QuickRep1.Prepare;
QrLabel2.Caption := IntToStr(i);
QuickRep1.Preview;
end; 

procedure TForm1.QuickRep1StartPage(Sender: TQuickRep);
begin
i := i + 1;
Form2.Label1.caption := IntToStr(i);
end;




 

 

Como alterar a data e hora do sistema




procedure TForm1.Button1Click(Sender: TObject);
begin
SetNewTime(1998,2,10,18,07);
end; 

function SetNewTime(Ano, Mes, Dia, hour, minutes: word): Boolean; 

var
st:TSYSTEMTIME;
begin
GetLocalTime(st);
st.wYear := Ano;
st.wMonth := Mes;
st.wDay := Dia;
st.wHour := hour;
st.wMinute := minutes;
if not SetLocalTime(st) then
Result := False
else
Result := True;
end;




 

 

Como incluir o evento onClick no DBgrid




unit Unit1; 

interface 

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Grids, DBGrids, DB, DBTables; 

type
thack = class(tcontrol);
TForm1 = class(TForm)
Table1: TTable;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1; 

implementation 

{$R *.DFM} 

procedure TForm1.Button1Click(Sender: TObject);
begin
THack(dbgrid1).controlstyle := THack(dbgrid1).controlstyle + [csClickEvents];
THack(dbgrid1).OnClick := Form1.OnClick;
end; 

procedure TForm1.FormClick(Sender: TObject);
begin
ShowMessage(‘Teste’);
application.processmessages;
end; 

end.


 


 

 

 

Como jogar uma imagem direto para um campo da tabela




procedure TForm1.Button1Click(Sender: TObject);
var
BMP: TBitMap;
begin
BMP := TBitMap.Create;
if OpenPictureDialog1.Execute then
begin
if Table1.State in [dsInsert, dsEdit] then
begin
BMP.LoadFromFile(OpenPictureDialog1.FileName);
Table1Graphic.Assign( BMP );
end;
end
end;




 

 

Como retornar a uma lista os campos indexados de um tabela




procedure TForm1.Button3Click(Sender: TObject);
var
i : integer;
begin
Table1.IndexDefs.Update;
ListBox1.Items.add
(‘******** Índice Primário ********’);
for i:=0 to Table1.IndexDefs.Count-1 do
begin
if Table1.IndexDefs.Items[i].Options = [ixPrimary..ixUnique] then
ListBox1.Items.add(Table1.IndexDefs.Items[I].Fields)
else
begin
ListBox1.Items.add(‘’);
ListBox1.Items.add
(‘**** Índice Secundário ****’);
Listbox1.Items.Add(Table1.IndexDefs.Items[I].Name);
end;
end; 

end;

 

 


Home   1 - Proxima      3 - 4 - 5 - 6 - 7 - 8 - - 10

                     fontesbrasil.com® Todos os direitos reservados.


Redirecinar:  http://www.fontesbrasil.com       Melhor visualização 800 x 600