{O exemplo abaixo simula o pressionamento da tecla do botão esquerdo do mouse em uma determinada posição
da tela. No exemplo serão utilizados dois botões (Button1 e Button2), ao clicar no Button2 será executado o
onClick do Button1 como se o mouse tivesse clicado sobre ele }

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage('Button 1 clicked');
end;


procedure TForm1.Button2Click(Sender: TObject);
var
Pt : TPoint;
begin
Application.ProcessMessages;
{Obtém o point no centro do Button1} 
Pt.x := Button1.Left + (Button1.Width div 2);
Pt.y := Button1.Top + (Button1.Height div 2);
{Converte Pt para as coordenadas da tela } 
Pt := ClientToScreen(Pt);
Pt.x := Round(Pt.x * (65535 / Screen.Width));
Pt.y := Round(Pt.y * (65535 / Screen.Height));
{Move o mouse} 
Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE, Pt.x, Pt.y, 0, 0);
{Simula o pressionamento do botão esquerdo do mouse} 
Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN, Pt.x, Pt.y, 0, 0);
{ Simula soltando o botão esquerdo do mouse } 
Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, Pt.x, Pt.y, 0, 0);
end; 

unit Unit1; 

interface 

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons; 

type
TForm1 = class(TForm)
BitBtn1: TBitBtn;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end; 

var
Form1: TForm1; 

implementation 

{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject); 

var
R : TRect;
N : Integer;
Buff : array[0..255] of Char;begin
with BitBtn1 do
begin
Caption := 'Várias linhas no caption de um botão';
Glyph.Canvas.Font := Self.Font;
Glyph.Width := Width - 6;
Glyph.Height := Height - 6;
R := Bounds(0, 0, Glyph.Width, 0);
StrPCopy(Buff, Caption);
Caption := '';
DrawText(Glyph.Canvas.Handle, Buff,StrLen(Buff),R,
DT_CENTER or DT_WORDBREAK or DT_CALCRECT);
OffsetRect(R,(Glyph.Width - R.Right) div 2,
(Glyph.Height - R.Bottom) div 2);
DrawText(Glyph.Canvas.Handle, Buff, StrLen(Buff), R,
DT_CENTER or DT_WORDBREAK);
end;
end; 

end. 

{ O exemplo abaixo mostra como deixar cada linha do componente DBGrid de uma cor diferente, dando assim um efeito mesclado. O controle é feito no evento OnDrawColumnCell.}

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, DBTables, Grids, DBGrids, StdCtrls; 

type
TForm1 = class(TForm)
Button1: TButton;
DBGrid1: TDBGrid;
Table1: TTable;
DataSource1: TDataSource;
procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1; 

implementation
{$R *.DFM} 

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
If odd(Table1.RecNo) then
begin
DBGrid1.Canvas.Font.Color:= clWhite;
DBGrid1.Canvas.Brush.Color:= clGreen;
end
else
begin
DBGrid1.Canvas.Font.Color:= clBlack;
DBGrid1.Canvas.Brush.Color:= clWhite;
end;
DBGrid1.Canvas.FillRect(Rect);
DBGrid1.Canvas.TextOut(Rect.Left+2,Rect.Top,Column.Field.AsString);
end; 

unit Unit1; 

interface 

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls; 

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

var
Form1: TForm1; 

implementation 

{$R *.DFM} 

procedure TForm1.Button1Click(Sender: TObject);
begin
shellExecute(Handle,'Open','mailto:fabiano@softfab.cjb.net', nil, nil,sw_shownormal); 

end; 

{ Utilize o componente QRTextFilter }

procedure TForm1.Button4Click(Sender: TObject);
begin
{ Exemplo 1 }
QuickRep1.ExportToFilter(TQRAsciiExportFilter.Create(
'C:\REPORT.TXT'));

{ Exemplo 2 }

QuickRep1.ExportToFilter(TQRHTMLDocumentFilter.Create(
'C:\REPORT.htm'));
QuickRep1.ExportFilter.Free;
end; 

{Para testar o exemplo inclua em um form um componente Image e inclua neste componente Image uma imagem
qualquer. Inclua o código abaixo no evento OnMouseMove.}

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
// Retornar a cor
Caption := ColorToString(Image1.Canvas.Pixels[X,Y]);
{ Retornar o número da cor }
Caption := Caption + ' - '+IntToStr(ColorToRGB(Image1.Canvas.Pixels[X,Y]));
end;

{Para testar o exemplo abaixo inclua no seu form um componente Button e inclua o código abaixo no evento
OnClick do componente Button.}

implementation
uses UrlMon;
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
HlinkNavigateString(nil,'http://www.theclub.com.br');
end; 

{Para testar o exemplo abaixo inclua no seu form um componente Button e no evento OnClick o código abaixo:}

procedure TForm1.Button1Click(Sender: TObject);
begin
SystemParametersInfo(SPI_SETDESKWALLPAPER,
0,PChar('C:\windows\Arenito.bmp'),SPIF_SENDWININICHANGE);
end; 

No arquivo .Dpr coloque a seguinte cláusula {$D SCRNSAVE } depois do uses.
Deixe o Form principal sem borda e sem icone. No OnActivate coloque left e top como 0 e o Windowstate como
wsMaximize.

No OnCreate coloque application.OnMessage para um metodo que controle a desativacao do screen saver.
Coloque também o application.OnIdle para "rodar" o dito protetor... 

Também no OnCreate teste a linha de comando para /c ou /s. Estes parametros dizem o que é para fazer (/c
configura). 

Compile e renomeie o .exe para .scr, mova para o diretorio do windows e está pronto seu Protetor em Delphi 

{Na propriedade SQL de um TQuery coloque o seguinte }

Select EXTRACT(Day from data_Nascimento),Nome
from Clientes
where EXTRACT (Month from data_Nascimento) = 5

{Aqui neste exemplo ele vai retornar o dia do aniversário, e o nome dos clientes que fazer aniversário em maio} 

{Inclua na seção uses a Unit DB }

{ se o alias não existir... }
if not Session.IsAlias('MeuAlias') then 
begin
{ Adiciona o alias }
Session.AddStandardAlias('MeuAlias', 'C:\DirProg', 'PARADOX');
{ Salva o arquivo de configuração do BDE }
Session.SaveConfigFile;
end;

{ Se você quiser criar um Alias do tipo DBF, basta trocar 'PARADOX' por 'DBASE'} 

{ Inclua na seção uses a unit DB }

{ Enxergar somente configurações da sessão atual }
Session.ConfigMode := cmSession;
{ Adicionar o Alias }
Session.AddStandardAlias('MeuAlias', 'C:\DirProg', 'PARADOX');

if FileExists('c:\carta.doc') then
ShowMessage('O arquivo existe')
else
ShowMessage('O arquivo não existe'); 

{ Inclua na seção uses a unit FileCtrl }

if DirectoryExists('C:\MEUSDOCS') then
ShowMessage('O diretório existe')
else
ShowMessage('O diretório não existe'); 

{ Inclua na seção uses as units dbTables, DB }

procedure CriaTabelaClientes;
var
Tabela: TTable;
begin
Tabela := TTable.Create(Application);
try
Tabela.DatabaseName := 'C:\';
{ ou Tabela.DatabaseName := 'NomeAlias'; }

Tabela.TableName := 'Clientes.DB';
Tabela.TableType := ttParadox; { ou ttDBase }

{ Somente Delphi4 }
if Tabela.Exists then { Se a tabela já existe... }
Exit;
{***}

{ Cria a tabela }
Tabela.FieldDefs.Add('Codigo', ftInteger, 0, true);
Tabela.FieldDefs.Add('Nome', ftString, 30, true);
Tabela.FieldDefs.Add('DataNasc', ftDate, 0, false);
Tabela.FieldDefs.Add('RendaMes', ftCurrency, 0, false);
Tabela.FieldDefs.Add('Ativo', ftBoolean, 0, true);
{ etc, etc, etc }
Tabela.CreateTable;

{ Cria os Índices }
Tabela.AddIndex('ICodigo', 'Codigo', [ixPrimary, ixUnique]);
Tabela.AddIndex('INome', 'Nome', [ixCaseInsensitive]);
{ etc, etc, etc }
finally
Tabela.Free;
end;
end; 

{ Pausa por 1 segundo }
Sleep(1000);

{ Pausa por 10 segundos }
Sleep(10000); 

{ Mude a propriedade "KeyPreview" do Form para true. }

{ No evento "OnKeyPress" do Form acrescente o código abaixo: }

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then begin
Key := #0;
Perform(WM_NEXTDLGCTL, 1, 0);
end;
end;

{ Em StringGrid, escreva o evento OnKeyPress como abaixo: }

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
StringGrid1.Perform(WM_KEYDOWN, VK_TAB, 0);
end;

{ Em DBGrid, escreva o evento OnKeyPress como abaixo: }

procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
DBGrid1.Perform(WM_KEYDOWN, VK_TAB, 0);
end; 

{ Coloque dois TEdit no form.
Coloque um TButton no form e altere o evento OnClick
deste botão como abaixo:
}
procedure TForm1.Button1Click(Sender: TObject);
var
DataHora: TSystemTime;
Data, Hora: TDateTime;
Ano, Mes, Dia,
H, M, S, Mil: word;
begin
Data := StrToDate(Edit1.Text);
Hora := StrToTime(Edit2.Text);
DecodeDate(Data, Ano, Mes, Dia);
DecodeTime(Hora, H, M, S, Mil);
with DataHora do begin
wYear := Ano;
wMonth := Mes;
wDay := Dia;
wHour := H;
wMinute := M;
wSecond := S;
wMilliseconds := Mil;
end;
SetLocalTime(DataHora);
end; 

{ Coloque este código no OnClick de um botão }
with Screen.Fonts do
if IndexOf('Courier New') >= 0 then
ShowMessage('A fonte está instalada.')
else
ShowMessage('A fonte não está instalada.'); 

Inclua na seção uses: Printers

{ Coloque este código no OnClick de um botão }
with Printer.Fonts do
if IndexOf('Draft 10cpi') >= 0 then
ShowMessage('A impressora possui a fonte.')
else
ShowMessage('A impressora NÃO possui a fonte.'); 

 



{ Coloque o código abaixo no OnClick de um botão }
AddFontResource(PChar('c:\MyFonts\Monospac.ttf')); 

{ Coloque um TButton no form e escreva o evento OnClick
deste como abaixo: }
procedure TForm1.Button1Click(Sender: TObject);
var
Vermelho, Verde, Azul: byte;
MinhaCor: TColor;
begin
Vermelho := 0;
Verde := 200;
Azul := 150;
MinhaCor := TColor(RGB(Vermelho, Verde, Azul));
Form1.Color := MinhaCor;
end; 

{ Digite a procedure abaixo imediatamente após a palavra
implementation no código do seu formulário. }

procedure MouseParaControle(Controle: TControl);
var
IrPara: TPoint;
begin
IrPara.X := Controle.Left + (Controle.Width div 2);
IrPara.Y := Controle.Top + (Controle.Height div 2);
if Controle.Parent <> nil then
IrPara := Controle.Parent.ClientToScreen(IrPara);
SetCursorPos(IrPara.X, IrPara.Y);
end;

{ Para testar, coloque no Form um botão e troque o name dele
para btnOK e modifique o evento OnShow do Form 
conforme abaixo: }

procedure TForm1.FormShow(Sender: TObject);
begin
MouseParaControle(btnOk);
end; 

{ Coloque um TTimer no Form desejado. Define a propriedade
Interval do Timer para 1000 (1 segundo). Modifique
o evento OnTimer do Timer conforme abaixo: }

procedure TForm1.Timer1Timer(Sender: TObject);
begin
FlashWindow(Handle, true);
FlashWindow(Application.Handle, true);
end; 

{ Na seção "private" do Form principal acrescente: }
procedure AppMsg(var Msg: TMsg; var Handled: Boolean);

{ Na seção "implementation" acrescente (troque TForm1 para
o nome do seu form principal): }
procedure TForm1.AppMsg(var Msg: TMsg; var Handled: Boolean);
begin
if (Msg.Message = wm_SysCommand) and
(Msg.wParam = sc_ScreenSave) then
Handled := true;
end;

{ No evento "OnCreate" do form principal, coloque: }
Application.OnMessage := AppMsg; 

{ Coloque um botão no form e altera o evento OnClick dele
conforme abaixo: }

procedure TForm1.Button1Click(Sender: TObject);
var
R: TRect;
begin
{ Pega o retângulo da área cliente do form }
R := GetClientRect;
{ Converte as coordenadas do form em coordenadas da tela }
R.TopLeft := ClientToScreen(R.TopLeft);
R.BottomRight := ClientToScreen(R.BottomRight);
{ Limita a região de movimentação do mouse }
ClipCursor(@R);
ShowMessage('Tente mover o mouse para fora da área cliente do Form');
{ Libera a movimentação }
ClipCursor(nil);
end; 

function DriveOk(Drive: Char): boolean;
var
I: byte;
begin
Drive := UpCase(Drive);
if not (Drive in ['A'..'Z']) then
raise Exception.Create('Unidade incorreta');
I := Ord(Drive) - 64;
Result := DiskSize(I) >= 0;
end;

{ - Coloque no Form1 um TEdit (Edit1)
- Coloque no Form1 um TButton
- Altere o evento OnClick do Button1 conforme abaixo: }

procedure TForm1.Button1Click(Sender: TObject);
begin
if DriveOk(Edit1.Text[1]) then
ShowMessage('Drive não preparado')
else
ShowMessage('Drive OK');
end; 

{ Coloque um TButton no Form e altere o evento
OnClick deste botão como abaixo: }

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage('Largura: ' + IntToStr(Screen.Width) + #13 +
'Altura: ' + IntToStr(Screen.Height));
end;

{ Muitos programas Windows permitem apenas uma cópia em 
execução de cada vez. Isto é interessante principalmente
quando é um grande aplicativo, pois duas cópias ao mesmo
tempo usuaria muito mais memória. Em aplicativos 
desenvolvidos em Delphi podemos ter esta característica.
Vejamos:

- Crie um novo projeto;
- Mude o "Name" do Form1 para DPGFormPrinc;
- Altere o código-fonte do arquivo Project1.dpr
conforme abaixo: }

program Project1;

uses
Forms, Windows,
Unit1 in 'Unit1.pas' {DPGFormPrinc};

{$R *.RES}

var
Handle: THandle;
begin
Handle := FindWindow('TDPGFormPrinc', nil);
if Handle <> 0 then begin { Já está aberto }
Application.MessageBox('Este programa já está aberto. A cópia ' +
'anterior será ativada.', 'Programa já aberto', MB_OK);
if not IsWindowVisible(Handle) then
ShowWindow(Handle, SW_RESTORE);
SetForegroundWindow(Handle);
Exit;
end;
Application.Initialize;
Application.CreateForm(TDPGFormPrinc, DPGFormPrinc);
Application.Run;
end. 

{ - Coloque um Button no Form;
- Altere o evento OnClick do Button conforme abaixo: }

procedure TForm1.Button2Click(Sender: TObject);
var
SR: TSearchRec;
I: integer;
begin
I := FindFirst('c:\Teste\*.*', faAnyFile, SR);
while I = 0 do begin
if (SR.Attr and faDirectory) <> faDirectory then
if not DeleteFile('c:\Teste\' + SR.Name) then
ShowMessage('Não consegui excluir c:\Teste\' + SR.Name);
I := FindNext(SR);
end;
end; 

{ Coloque um Button no Form e altere o evento OnClick deste
como abaixo: }

procedure TForm1.Button1Click(Sender: TObject);
begin
{ Verifica o Delphi }
if FindWindow('TAppBuilder', nil) > 0 then
ShowMessage('O Delphi está aberto')
else
ShowMessage('O Delphi NÃO está aberto');

{ Verifica o Word }
if FindWindow('OpusApp', nil) > 0 then
ShowMessage('O Word está aberto')
else
ShowMessage('O Word NÃO está aberto');

{ Verifica o Excell }
if FindWindow('XLMAIN', nil) > 0 then
ShowMessage('O Excell está aberto')
else
ShowMessage('O Excell NÃO está aberto');
end; 

procedure TForm1.Button3Click(Sender: TObject);
begin
{ Exibe as cores atuais dos Edit's }
ShowMessage(ColorToString(Edit1.Color));
ShowMessage(ColorToString(Edit2.Color));

{ Altera as cores dos Edit's }
Edit1.Color := StringToColor('clBlue');
Edit2.Color := StringToColor('$0080FF80');
end; 

Var
Variavel : Strig;
num : integer;
begin
num:= 129;
Variavel := FormatFloat('000000',num );
Caption:= Variavel;
{ O Caption do formulário ficará assim : 000129}
end;

{ - Coloque um TButton no Form;
- Altere o evento OnCreate do Form como abaixo: }

procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.Hint := 'Linha 1 da dica' + #13 +
'Linha 2 da dica' + #13 +
'Linha 3 da dica';
Button1.ShowHint := true;
end; 

{ - Coloque um botão no form e altere seu evento OnClick
conforme abaixo: }

procedure TForm1.Button1Click(Sender: TObject);
var
Janela: HWND;
begin
Janela := FindWindow('OpusApp'), nil);
if Janela = 0 then
ShowMessage('Programa não encontrado')
else
PostMessage(Janela, WM_QUIT, 0, 0);
end;
{Neste caso OpusApp é o título da aplicação que aparece na barra de título, mas você também poderia tentar
fechar o Bloco de Notas, Word, Excel e outros}

Home   1 - 2 - 3 - 4   Proxima     6 - 7 - 8 - 9  - 10