Um tutorial com as 100 melhores dicas selecionadas a dedo em toda a Internet para facilitar ainda mais o seu aprendizado em Delphi.

Depois abra o DELPHI; feche o projeto que estiver aberto usando a opção Close all dentro do menu File e crie um novo projeto utilizando a opção New Application também no menu File.

a) Mude as seguintes propriedades do Form1:

Name : frmEsconderMostrar

Caption : Programa para Esconder e Mostrar o Botão Iniciar

Position : poScreenCenter

BorderStyle : bsDialog

Height : 104

Width : 403

b) Insira dois Botões no formulário: na Paleta de Componentes Standard - Button

c) Mude as seguintes propriedades do Button1:

Name : btnEsconder

Caption : Esconder o Botão Iniciar

Width : 177

d) Mude as seguintes propriedades do Button2:

Name : btnMostrar

Caption : Mostrar o Botão Iniciar

Width : 177

OBS : Salve o projeto no sub-diretório que você criou:

e) A Unit1 salve com o nome de untEsconderMostrar e o Project1 com o nome de EsconderMostrar

f) Na parte interface da unit (untEsconderMostrar) abaixo da clausula uses inclua a definição da procedure

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

Procedure MostrarEsconderIniciar(Estado:Boolean); {inclua esta linha}

Na parte implementation da unit (untEsconderMostrar) inclua a procedure MostrarEsconderIniciar:

implementation

{$R *.DFM}

procedure MostrarEsconderIniciar(Estado:Boolean);

Var taskbarhandle, buttonhandle : HWND;

begin

taskbarhandle := FindWindow('Shell_TrayWnd', nil);

buttonhandle := GetWindow(taskbarhandle, GW_CHILD);

If Estado = True Then

ShowWindow(buttonhandle, SW_RESTORE) {mostra o botão}

Else

ShowWindow(buttonhandle, SW_HIDE); {esconde o botão}

end;

2) Mostrar e esconder A Barra de Tarefas

Crie um sub-diretório chamado “Barra de Tarefa” utilizando o windows explorer.

Feche o projeto que estiver aberto usando a opção Close all dentro do menu File e crie um novo projeto utilizando a opção New Application também no menu File.

a) Mude as seguintes propriedades do Form1:

Name : frmBarraTarefa

Caption : Programa para Esconder e Mostrar a Barra de Tarefa

Position : poScreenCenter

BorderStyle : bsDialog

Height : 104

Width : 403

b) Insira dois Botões no formulário: na Paleta de Componentes Standard - Button

c) Mude as seguintes propriedades do Button1:

Name : btnEsconder

Caption : Esconder a Barra de Tarefa

Width : 177

d) Mude as seguintes propriedades do Button2:

Name : btnMostrar

Caption : Mostrar a Barra de Tarefa

Width : 177

OBS : Salve o projeto no sub-diretório que você criou:

e) A Unit1 salve com o nome de untBarraTarefa e o Project1 com o nome de BarraTarefa.

f) Na parte interface da unit (untBarraTarefa) abaixo da clausula uses inclua a definição da procedure

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

procedure EscondeBarraTarefa(EstadoBarra: Boolean);{inclua esta linha}

Na parte implementation da unit (untBarraTarefa) inclua a procedure EscondeBarraTarefa:

implementation

{$R *.DFM}

procedure EscondeBarraTarefa(EstadoBarra: Boolean);

var wndHandle : THandle;

wndClass : array[0..50] of Char;

begin

StrPCopy(@wndClass[0],'Shell_TrayWnd');

wndHandle := FindWindow(@wndClass[0], nil);

If EstadoBarra=True Then

ShowWindow(wndHandle, SW_RESTORE) {Mostra a barra de tarefas}

Else

ShowWindow(wndHandle, SW_HIDE); {Esconde a barra de tarefas}

end;

3) Pegando o nome do usuario e a empresa do Windows

Crie um sub-diretório chamado “Usuário” utilizando o windows explorer.

Feche o projeto que estiver aberto usando a opção Close all dentro do menu File e crie um novo projeto utilizando a opção New Application também no menu File.

a) Mude as seguintes propriedades do Form1:

Name : frmEmpresausuario

Caption : Programa para ler do Windows nome do Usário e Empresa

Position : poScreenCenter

BorderStyle : bsDialog

Height : 123

Width : 441

b) Insira um Botões no formulário: na Paleta de Componentes Standard - Button

c) Mude as seguintes propriedades do Button1:

Name : btnUsuario

Caption : Pegar nome do Usuário e Empresa no Windows

Width : 241

d) Insira duas Caixas de Edição no formulário: na Paleta de Componentes Standard - Edit

e) Mude as seguintes propriedades do Edit1:

Name : EdtUsuario

Text : vazio

Width : 417

f) Mude as seguintes propriedades do Edit2:

Name : EdtEmpresa

Text : vazio

Width : 417

OBS : Salve o projeto no sub-diretório que você criou:

g) A Unit1 salve com o nome de untEmpresaUsuario o Project1 com o nome de Usuario.

h) Na parte uses da interface da unit (untEmpresaUsuario) insira a clausula : Registry

interface

uses

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

No evento onClick do botão btnUsuario inclua as seguintes linhas de código:

procedure TForm1.Button1Click(Sender: TObject);

var

reg: TRegIniFile;

begin

reg := TRegIniFile.create('SOFTWARE\MICROSOFT\MS SETUP (ACME)\');

EdtUsuario.Text := reg.ReadString('USER INFO','DefName','');

EdtEmpresa.Text := reg.ReadString('USER INFO','DefCompany','');

reg.free;

end;

4) Como arrastar um Form sem clicar no Caption?

Quando você pressiona o botão do mouse, o Windows identifica a posição da tela onde o cursor estava no momento do clique. Se a posição é igual a área do Caption do Form, o Windows ativa o modo de movimentação do Form permitindo que este seja arrastado. Portanto, a maneira mais fácil de solucionar esta questão é "enganar" o Windows.

Neste exemplo vamos considerar que o usuário poderá arrastar o Form ao clicar na área cliente deste Form:

a) Crie uma nova aplicação;

b) Adicione a seguinte declaração na seção private do Form:

procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;

c) Adicione o código deste procedimento na seção implementation do Form:

procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);

begin

inherited; { ativa a herança da mensagem }

if M.Result = htClient then { o clique foi na área cliente? }

M.Result := htCaption; { se sim, faz o Windows pensar que foi no Caption. }

end;

Este exemplo tratou o clique na área cliente. Você pode alterar este código para suas necessidades. Eis os possíveis valores para o Result:

VALOR - Local do clique

HTBORDER - Borda da janela que não tem a borda de tamanho

HTBOTTOM - Borda horizontal inferior da janela

HTBOTTOMLEFT - Canto inferior esquerdo da janela

HTBOTTOMRIGHT - Canto inferior direito da janela

HTCAPTION - Barra de Título(Caption)

HTCLIENT - Área cliente

HTERROR - igual ao HTNOWHERE, a diferença é que produz um beep indicando erro

HTGROWBOX - Caixa de tamanho (igual ao HTSIZE)

HTHSCROLL - Barra de rolagem horizontal

HTLEFT - Borda esquerda da janela

HTMENU - Em um menu

HTNOWHERE - Plano de fundo da janela ou linha de divisão entre janelas

HTREDUCE - Botão minimizar

HTRIGHT - Borda direita da janela

HTSIZE - Caixa de tamanho (igual ao HTGROWBOX)

HTSYSMENU - Botão de Sistema/Fechar da janela MDIChild

HTTOP - Borda horizontal superior da janela

HTTOPLEFT - Canto superior esquerdo da janela

HTTOPRIGHT - Canto direito superior da janela

HTTRANSPARENT - Janela em segundo plano

HTVSCROLL - Barra de rolagem vertical

HTZOOM - Botão maximizar

5) 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;

6) ESCONDENDO A APLICAÇÃO DA BARRA DE TAREFAS

Para fazer com que o ícone da aplicação em Delphi desapareça da Barra de Tarefas, execute o código a seguir:

var

H : HWnd;

begin

H := FindWindow(Nil,'Project1');

if H <> 0 then ShowWindow(H,SW_HIDE);

end;

7) OS COMANDOS INC e DEC

Você sabia que existe uma opção para a comum linha de comando: Variavel:=Variavel+1; ?

O comando INC e DEC permitem agilizar o processamento do seu sistema. Para isso substitua a linha acima por:

INC(variavel);

DEC(variavel) se você quiser diminuir ao invés de aumentar 1.

8) COMO FAZER UM BEEP NO COMPUTADOR

messageBeep(0);

9) COMO FAZER UMA PAUSA POR UM PERÍODO DETERMINADO

NumSec é o tempo em segundos de espera

var

NumSec SmallInt;

StartTime: TDateTime;

begin

StartTime := now;

NumSec:=10;

repeat

Application.ProcessMessages;

until Now > StartTime + NumSec * (1/24/60/60);

end;

10) DESABILITANDO O SPLASH SCREEN DO REPORT SMITH

1 - Localize o arquivo RS_RUN.INI (no diretório do Windows);

2 - Na seção [ReportSmith] inclua a linha seguinte:

ShowAboutBox=0

3 - Na seção [RS_RunTime] inclua a linha seguinte:

ShowAboutBox=0

4 - Não se esqueça de distribuir com o seu aplicativo o referido arquivo INI.

11) Lendo o volume do HD

Function ExtractDiskSerial(Drive:String):String;

Var

Serial:DWord;

DirLen,Flags: DWord;

DLabel : Array[0..11] of Char;

begin

GetVolumeInformation(PChar(Drive+':\'),dLabel,12,@Serial,DirLen,Flags,nil,0);

Result := IntToHex(Serial,8);

end;

12) descobrindo o número serial do hd

procedure TForm1.Button1Click(Sender: TObject);

var

SerialNum : pdword;

a, b : dword;

Buffer : array [0..255] of char;

begin

if GetVolumeInformation('c:\', Buffer, SizeOf(Buffer), SerialNum, a, b, nil, 0) then

Label1.Caption := IntToStr(SerialNum^);

end;

13) PARA SABER SOMENTE O PATH DA APLICAÇÃO

ExtractFilePath( Application.ExeName )

14) INTERCEPTAR AS TECLAS DE FUNÇÃO (f1, f2, f3...)

Primeiro, coloque a propriedade KeyPreview do formulário como TRUE. Depois, insira este código no evento OnKeyDown do formulário:

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

if Key = VK_F5 then

showMessage('I pressed the F5 key');

end;

Você também pode usar as variáveis VK_F1 até VK_F12 referentes as outras teclas de função.

15) TRADUZINDO A MENSAGEM: "Delete Record?"

Quando clicamos sobre o botão de deleção no DBNavigator (o do sinal de menos) surge uma box com a mensagem "Delete Record?" com botões Ok e Cancel. Para fazer aparecer a mensagem em português deverá selecionar o componente Table e mudar a propriedade ConfirmDelete para False e no evento da tabela BeforeDelete colocar o seguinte (flaviojr@cyber.com.br):

procedure TForm1.Table1BeforeDelete(DataSet:TDataSet);

begin

if MessageDlg('Eliminar o Registro?',mtConfirmation,[mbYes,mbNo],0)<>mrYes then Abort;

end;

16) INCLUIr UM PREVIEW PERSONALIZADO nO QUICK REPORT

No relatório, criar a procedure SHOWPREVIEW contendo:

Procedure Showpreview;

begin

preview.showmodal;

end;

Onde preview é o nome do form criado para preview.

Não esquecer de incluir o nome da procedure na cláusula uses.

Após isso, deve-se incluir no evento CREATE do formulario principal ou do relatório o direcionamento do objeto Qprinter, com a seguir:

qprinter.onpreview:=showpreview;

Isto faz com que toda vez que se desejar exibir um preview, o programa abra a rotina 'showpreview', que abre o formulário criado, chamado 'preview'.

17) EXECUTANDO PROGRAMAS EXTERNOS

Se você precisa abrir programas externos no seu aplicativo DELPHI, como a calculadora do Windows, por exemplo, inclua a seguinte linha no seu programa:

WinExec('calc.exe', sw_show);

'calc.exe' é o nome do programa. Caso queira abrir um outro programa, altere este nome.

18) UTILIZANDO A TECLA ENTER PARA SALTAR DE CAMPO

Insira este código em um evento OnKeyPress de um controle de edição:

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);

begin

If Key = #13 Then

Begin

SelectNext(Sender as tWinControl, True, True );

Key := #0;

end;

19) Tocando um som Wav sem o Media Player

Acrescente MMSystem na Uses do começo na Unit

Utilize a API SndPlaySound();

Para interromper o som sem ele acabar de tocar utilize a API PlaySound(nil,0,0);

Ex: SndPlaySound('c:\teste.wav', snd_ASync);

PS: snd_Loop serve para repetir continuamente o som.

20) Obter o diretório onde seu programa está instalado

Crie uma váriavel do tipo String e insira a seguinte linha no evento ou função desejada do formulário:

ExtractFilePath(Application.Exename);

Retorna-rá o path atual do arquivo .EXE do seu programa.

21) Como bloquear um arquivo em ambiente de rede

É uma dica simples mas muito importante !!!

Quando você programar visando uma rede e quiser bloquear um arquivo é só chamar o metodo "edit" da Tabela que estiver usando.

EX: Table1.edit;

PS: Se o registro já estiver bloqueado ocorrerá um erro, então você deve fazer o seguinte :

try { para verificar o erro }

Table1.edit;

exception on TDBEngineError do { o erro..}

MessageDlg('Registro ja esta sendo usado...!', mtInformation, [ mbOk ], 0 );

end;

22) Usando Enter para mudar de campo de um DBGrid

If ( Chr(Key) <> #13) Then Exit;

If ( DBGrid1.SelectedIndex + 1 <> DBGrid1.FieldCount ) Then

DBGRid1.SelectedIndex := DBGRid1.SelectedIndex + 1;

23) Função para obter o número do registro atual

Function Recno(Dataset: TDataset): Longint;

var

CursorProps: CurProps;

RecordProps: RECProps;

begin

{ Return 0 if dataset is not Paradox or dBASE }

Result := 0;

with Dataset do

begin

if State = dsInactive then DBError(SDataSetClosed);

Check(DbiGetCursorProps(Handle, CursorProps));

UpdateCursorPos;

try

Check(DbiGetRecord(Handle, dbiNOLOCK, nil, @RecordProps));

case CursorProps.iSeqNums of

0: Result := RecordProps.iPhyRecNum; { dBASE }

1: Result := RecordProps.iSeqNum; { Paradox }

end;

except

on EDBEngineError do

Result := 0;

end;

24) Enviando um arquivo para a lixeira

uses ShellAPI;

Function DeleteFileWithUndo(sFileName : string ) : boolean;

var

fos : TSHFileOpStruct;

begin

FillChar( fos, SizeOf( fos ), 0 );

With fos do

begin

wFunc := FO_DELETE;

pFrom := PChar( sFileName );

fFlags := FOF_ALLOWUNDO

or FOF_NOCONFIRMATION

or FOF_SILENT;

end;

Result := ( 0 = ShFileOperation( fos ) );

end;

25) carregar um cursor animado (*.ani)

const

cnCursorID1 = 1;

begin

Screen.Cursors[ cnCursorID1 ] := LoadCursorFromFile('c:\win95\cursors\cavalo.ani' );

Cursor := cnCursorID1;

end;

PS: O arquivo CAVALO.ANI deverá existir no diretório apontado.

26) Transferir o conteúdo de um Memo para o MemoField

var

t: TTable;

begin

t := TTable.create(self);

with t do

begin

DatabaseName := 'MyAlias'; {Nome do Alias}

TableName := 'MyTbl.db';

open;

edit;

insert;

FieldByName('TheField').assign(Memo1.lines);

post; { Requerido!!!}

close;

end;

27) Capturando o conteúdo do Desktop

Coloque o código abaixo no evento FormResize do Formulário.

procedure TForm1.FormResize(Sender: TObject);

var

R : TRect;

DC : HDc;

Canv : TCanvas;

begin

R := Rect( 0, 0, Screen.Width, Screen.Height );

DC := GetWindowDC( GetDeskTopWindow );

Canv := TCanvas.Create;

Canv.Handle := DC;

Canvas.CopyRect( R, Canv, R );

ReleaseDC( GetDeskTopWindow, DC );

end;

28) Escrevendo um texto diagonal usando o canvas

procedure TForm1.Button1Click(Sender: TObject);

var

begin

with Form1.Canvas do begin

Font.Name := 'Arial';

Font.Size := 24;

tf := TFont.Create;

tf.Assign(Font);

GetObject(tf.Handle, sizeof(lf), @lf);

lf.lfEscapement := 450;

lf.lfOrientation := 450;

tf.Handle := CreateFontIndirect(lf);

Font.Assign(tf);

tf.Free;

TextOut(20, Height div 2, 'Texto Diagonal!');

end;

29) extrair um icone de um determinado aplicativo

Para extrair ícones de um executável, deve-se usar a função da API Extraction. Ela usa 3 parâmetros:

Instance - Instância da aplicação

FileName - Nome do executável. Deve ser um PChar

NumIcon - Número do ícone a ser recuperado. Se for Word(-1), a função retorna a quantidade de ícones do executável.

Coloque ShellAPI em uses no começo da unit.

procedure TForm1.Button1Click(Sender: TObject);

var

IconIndex : word;

h : hIcon;

begin

IconIndex := 0;

h := ExtractAssociatedIcon(hInstance,'C:\WINDOWS\NOTEPAD.EXE',IconINdex);

DrawIcon(Form1.Canvas.Handle,10,10,h);

end;

30) Alinhando items do menu à direita

Para alinhar itens do menu principal à direita, deve-se utilizar o seguinte código:

{Isto justifica todos itens à direita do selecionado}

procedure SetJustify(Menu: TMenu; MenuItem: TMenuItem; Justify: Byte);

{$IFDEF WIN32}

var

ItemInfo: TMenuItemInfo;

Buffer: array[0..80] of Char;

{$ENDIF}

begin

{$IFDEF VER80}

MenuItem.Caption := Chr(8) + MenuItem.Caption;

{$ELSE}

ItemInfo.cbSize := SizeOf(TMenuItemInfo);

ItemInfo.fMask := MIIM_TYPE;

ItemInfo.dwTypeData := Buffer;

ItemInfo.cch := SizeOf(Buffer);

GetMenuItemInfo(Menu.Handle, MenuItem.Command, False, ItemInfo);

if Justify = 1 then

ItemInfo.fType := ItemInfo.fType or MFT_RIGHTJUSTIFY;

SetMenuItemInfo(Menu.Handle, MenuItem.Command, False, ItemInfo);

{$ENDIF}

end;

31) abrir automaticamente seu navegador padrão e carregar a página determinada pelo link

1º Declare o procedure na seção PUBLIC da unit.

procedure JumpTo(const aAdress: String);

2º Coloque a cláusula ShellAPI na uses no início da unit.

procedure TForm1.JumpTo(const aAdress: String);

var

buffer: String;

begin

buffer := 'http://' + aAdress;

ShellExecute(Application.Handle, nil, PChar(buffer), nil, nil, SW_SHOWNORMAL);

end;

procedure TForm1.Label1Click(Sender: TObject);

begin

JumpTo('www.geocities.com/SiliconValley/Way/1497');

end;

32) copiar registros de uma tabela para outra incluindo valores NULL

procedure TtableCopiaRegistro(Origem, Destino: Ttable);

begin

with TabelaOrig do

begin

{Inicia um contador para os campos da TabelaOrig}

for i := 0 to FieldCount -1 do

{Este if verifica se o campo da TabelaOrig é NULL, se for, atribui seu valor ao

campo da TabelaDest}

if not Fields[i].IsNull then TabelaDest.Fields[i].Assign(Fields[i]);

end; {end with}

end;

Este exemplo funcionará com todos tipos de campos se você tiver acabado de criar a TabelaDest.

Para criar um dado valor NULL : Fields[i].Clear

33) deletar arquivos de um diretório com o caractere curinga '*'

procedure TForm1.SpeedButton1.Click(Sender: TObject);

var

SearchRec: TSearchRec;

Result: Integer;

begin

Result:=FindFirst('c:\teste\*.*', faAnyFile, SearchRec);

while result=0 do

begin

DeleteFile('c:\teste\'+SearchRec.Name);

Result:=FindNext(SearchRec);

end;

34) capturar a lista de Aliases disponíveis

Tudo que você precisa é de um componente TSession, um componente

TListBox e uma String List.

Defina a propriedade SessionName do TSession para 'Session'. Utilize o seguinte código:

procedure TForm1.Button3Click(Sender: TObject);

var

MyStringList: TStringList;

i: integer;

begin

MyStringList := TStringList.Create;

Session.GetAliasNames(MyStringList);

for I := 0 to MyStringList.Count - 1 do

ListBox1.Items.Add(MyStringList[I]);

end;

Utilize o Help do TSession e consulte seus métodos para ver por exemplo como capturar o diretório ou caminho de um Alias com o método 'GetAliasParams'.

35) Abrir e Fechar a bandeja DO drive de CD-ROM

{Para Abrir:}

mciSendString('Set cdaudio door open wait', nil, 0, handle);

{Para Fechar:}

mciSendString('Set cdaudio door closed wait', nil, 0, handle);

36) Utilizando o Code Explorer

A versão 4 do Borland Delphi está recheada de novos recursos em várias áreas do produto (IDE, Internet, linguagem, aplicações multi-tier, entre outras).

Uma das primeiras coisas que notamos quando abrimos o editor de código do Delphi 4 é a presença de um painel ancorado na lateral esquerda, contendo todos os tipos, classes, propriedades, métodos, variáveis globais, rotinas globais e interfaces contidos na unit selecionada. Esse painel é chamado Code Explorer e seu objetivo é tornar mais fácil a navegação entre as units do projeto e automatizar alguns processos envolvidos na criação de classes.

O Code Explorer também permite que você navegue diretamente para as declarações que são apresentadas nele, bastando dar um duploclique com o mouse sobre a declaração desejada. Novas declarações podem ser feitas também usando o Code Explorer, facilitando o desenvolvimento do código. Por exemplo, vamos supor que você queira criar uma nova função chamada Calculo com dois parâmetros do tipo real e que retornará também um real. Para isso, deve-se seguir os seguintes passos:

Selecione a pasta Variable/Constants dentro do Code Explorer. Dê um clique com o botão direito do mouse e selecione New no menu que aparecerá, como mostra a figura a seguir.

O Code Explorer apresentará um novo item que permite identificar qual o tipo de declaração que está sendo feita, por meio da informação que o programador passar a ele. No nosso exemplo, digitaremos o cabeçalho da função Calculo como segue :

function Calculo(x, y : real) : real;

Após digitar a declaração e pressionar <Enter> o Code Explorer criará automaticamente o cabeçalho da função na seção Interface e a sua implementação na seção Implementation da unit, como mostra a figura seguinte, evitiando assim que ocorreram erros de declaração no interior do código.

Um outro recurso que o Code Explorer fornece é conhecido como Class Completion. O programador pode, dentre outras facilidades, criar apenas o básico da declaração de uma propriedade e, com o simples toque de um atalho no teclado, o Code Explorer completará a declaração. Como exemplo, vamos declarar uma propriedade chamada Cor do tipo TColor dentro da nossa classe TForm 1.

type

TForm1=class(TForm)

private

{declarações privadas}

public

{declarações públicas}

property Cor:TColor;

end;

Agora com o cursor posicionado sobre a declaração da propriedade, pressionamos <Ctrl><Shift>C e o Code Explorer completará toda a declaração da estrutura da classe.

37) Copiando arquivos via Delphi

Function CopiaArquivo(scrname,destname:string):byte;

var

source,destination:file;

buffer:array[1..1024] of byte;

readcnt,writecnt:word;

pname,dname,fname,ename:String;

{USO:

R:=COPIAARQUIVO('C:\diretorio\FILE.EXT','C:\diretorio\FILE.EXT');

Devolve 0=Ok, 1=Erro no Origem, 2=Erro no Destino, 3=Disco Cheio}

begin

AssignFile(source,scrname);

Try

Reset(source,1);

Except

CopiaArquivo:=1;

Exit;

end;

If destname[length(destname)]='\' then

begin

pname:=scrname;

destname:=destname+separa(scrname,'\',Ocorre(scrname,'\')+1);

end;

AssignFile(destination,destname);

Try

Rewrite(destination,1);

Except

CopiaArquivo:=2;

Exit;

end;

Repeat

BlockRead(source,buffer,sizeof(buffer),readcnt);

Try

BlockWrite(destination,buffer,readcnt,writecnt);

Except

CopiaArquivo:=3; {Disco Cheio?}

Exit;

end;

until (readcnt=0) or (writecnt<>readcnt);

CloseFile(destination);

CloseFile(source);

CopiaArquivo:=0;

end;

38) abrir um TComboBox sem clicá-lo

ComboBox1.DroppedDown := True;

39) mudar a cor da célula ativa do DBGrid

A rotina abaixo deverá ser colocada no evento OnDrawDataCell, do DBGrid.

procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect; Field: TField; State: TGridDrawState);

begin

if gdFocused in State then

with (Sender as TDBGrid).Canvas do

begin

Brush.Color:=clRed;

FillRect(Rect);

TextOut(Rect.Left, Rect.Top, Field.AsString);

end;

40) Como incrementar 1 mês numa data

IncMonth(Data, 1);

No exemplo, a variável Data é do tipo TDateTime.

41) Verificar se existe disquete no drive

unit UTestaDrive;

interface

uses

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

type

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

function TemDiscoNoDrive(const drive : char): boolean;

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

function TForm1.TemDiscoNoDrive(const drive : char): boolean;

var

DriveNumero : byte;

EMode : word;

begin

result := false;

DriveNumero := ord(Drive);

if DriveNumero >= ord('a') then

dec(DriveNumero,$20);

EMode := SetErrorMode(SEM_FAILCRITICALERRORS);

try

if DiskSize(DriveNumero-$40) = -1 then

Result := true

else

messagebeep(0);

finally

SetErrorMode(EMode);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

if TemDiscoNoDrive('a') then

ShowMessage('Tem disco No drive A:')

else

ShowMessage('Não tem Disco no Drive A:');

end;

end.

42) Acessar o ambiente DOS

Para acessar as variáveis do ambiente DOS, deve-se usar a função da API GetDosEnvironment. Ela retorna um PChar que pode ser avaliado.

43) Executar um prog. DOS e fechar 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 proddos.exe, a chamada deve ser:

WinExec('c:\command.com /c progdos.exe', sw_ShowNormal);

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.

44) instanciar uma única vez um executável correspondente a uma determinada aplicação

No Microsoft® Windows®, existe uma tabela do sistema chamada ‘atom table’. Esta tabela armezena strings com seus correspondentes identificadores. Existem várias funções da API do windows, chamadas de ‘atom functions’, que permitem que uma aplicação insira, apague, procure por uma determinada ‘atom string’, etc.. O código abaixo garante que somente uma instância do executável de sua aplicação estará carregado em memória. O form1 seria o form principal da aplicação:

procedure TForm1.FormCreate(Sender: TObject);

begin

{Procura na tabela para verificar se o programa já está rodando}

{Substitua a string ‘MINHA STRING’ por uma de sua conveniência}

if GlobalFindAtom(‘MINHA STRING') = 0 then

{zero significa não encontrar}

atom := GlobalAddAtom(‘MINHA STRING’)

else

begin

{Se o programa já estiver rodando, então mostrar a mensagem e parar}

MessageDlg(‘A aplicação já encontra-se em execução!!', mtWarning, [mbOK], 0);

Halt;

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

{Remove o item da tabela, de modo que a aplicação possa ser executada novamente}

GlobalDeleteAtom(atom);

end;

45) Modificar várias propriedades de um objeto ao mesmo tempo

Utilize o comando with, desse modo:

With Edit1 do

begin

Text := ' @Delphi';

Widht := 30;

Enabled := True;

end;

46) Para emitir um som quando o ENTER for pressionado

No Evento OnKeyPress de um Edit:

if Key = Chr(VK_RETURN) then

Perform(WM_NEXTDLGCTL,0,0);

47) Encolhendo o executável

Em Delphi 1.0, marcando a checkbox Optimize for size and load time, em Options/Project/Linker, não funciona (aparece uma mensagem de erro de disco cheio, mesmo com muito espaço). Delphi 1.0 vem com um programa DOS, W8LOSS, que faz o mesmo. Para usá-lo, deve-se digitar o seguinte:

W8LOSS programa.exe

Isto encolherá o executável em aproximadamente 20%, diminuindo o tempo de carga.

48) criar alias via programação

Paradox:

Session.AddStandardAlias('SeuAlias', edtPath.text, 'Paradox');

Session.SaveConfigFile;

49) desabilitar as teclas de acesso (Ctrl+Alt+Del), (Alt+Tab), (Ctrl+Esc)

var

OldValue : LongBool;

begin

{liga a trava}

SystemParametersInfo(97, Word(True), @OldValue, 0);

{desliga a trava}

SystemParametersInfo(97, Word(False), @OldValue, 0);

end;

50) Fazer um Splash Screen

form2:=tform2.create(application);

form2.show;

form2.update;

form2.hide;

form2.free;

Application.Run;

Obs: apagar a primeira linha, 'Application.Initialize'.

51) FUNÇÃO PARA ENCRIPTAR UMA STRING

function encrypt( dummy: Pchar):Pchar;

var

x: Integer;

w: Word;

s: String;

c: Char;

begin

s:=StrPas(dummy);

w:=StrLen(dummy);

for x:=1 to w do

begin

c:=s[x];

c:=char ( ord (c) xor 159);

s[x]:=c;

end;

StrPCopy(dummy,s);

encrypt:=dummy;

end;

52) Função reverter uma string

function TForm1.StrReverse(MyString : string) : String;

var

i: integer;

HelpString: string;

begin

HelpString := '';

for i := 1 to Length(MyString) do

HelpString := MyString[i]+HelpString;

Result := HelpString;

end;

53) função de CONVERTER UM NúMERo inteiro para binário

{Integer to Binary}

function IntToBin(Value: LongInt;Size: Integer): String;

var

i: Integer;

begin

Result:='';

for i:=Size downto 0 do

begin

if Value and (1 shl i)<>0 then

begin

Result:=Result+'1';

end

else

begin

Result:=Result+'0';

end;

54) função de CONVERTER UM NúMERo binário para inteiro

{Binary to Integer}

function BinToInt(Value: String): LongInt;

var

i,Size: Integer;

begin

Result:=0;

Size:=Length(Value);

for i:=Size downto 0 do

begin

if Copy(Value,i,1)='1' then

begin

Result:=Result+(1 shl i);

end;

55) função para encriptar e descriptar uma String

const

StartKey = 981; {Start default key}

MultKey = 12674; {Mult default key}

AddKey = 35891; {Add default key}

{Encriptar}

function Encrypt(const InString: string; StartKey,MultKey,AddKey: Integer): string;

var

I: Byte;

begin

Result := '';

for I := 1 to Length(InString) do

begin

Result := Result + CHAR(Byte(InString[I]) xor (StartKey shr 8));

StartKey := (Byte(Result[I]) + StartKey) * MultKey + AddKey;

end;

{Descriptar}

function Decrypt(const InString: string; StartKey,MultKey,AddKey: Integer): string;

var

I: Byte;

begin

Result := '';

for I := 1 to Length(InString) do

begin

Result := Result + CHAR(Byte(InString[I]) xor (StartKey shr 8));

StartKey := (Byte(InString[I]) + StartKey) * MultKey + AddKey;

end;

56) UMA ROTINA PARA VERIFICAR ERROS EM TODA A APLICAÇÃO

Para tratar erros de forma genérica, em todo o seu programa, insira no método ON CREATE do formulário principal a linha:

Application.OnException:=RotinaGeral;

RotinaGeral é uma procedure na qual deverá constar o código para verificar e enviar as mensagens de erro do seu sistema.

57) Enviando informações direto para a impressora

Muitas vezes torna-se necessário, ou até mesmo, imprescindível que você envie informações diretamente para a impressora, uma vez que a utilização da impressão típica do Windows é um pouco demorada e o uso do driver Genérico/Somente Texto não é muito confiável.

Uma boa solução para enviar informações diretamente para a impressora é usar o seguinte código:

Procedure TForm1.Button1Click(Sender: Object);

var

Imp: TextFile;

begin

AssignFile(Imp, 'LPT1');

Rewrite(Imp);

Write(Imp, 'Isto vai sair na impressora');

CloseFile(Imp);

end;

Desta forma será possível, inclusive, utilizar os códigos de configuração da impressora. Para a impressora padrão Epson, por exemplo, você poderia utilizar algo assim:

Write(Imp, #27#69 + 'Teste' + #27#70); { impressão em negrito }

Write(Imp, #15 + 'Teste' + #18); { impressão no modo condensado }

Write(Imp, #12); { salto de página }

58) Enviando Caracteres Diretamente ao Buffer da Impressora

Ao trabalharmos com impressão, em certos casos desejamos alterar o comportamento da impressora.

Algumas opções, principalmente em impressoras matriciais, são obtidas através do envio dos chamados "códigos de escape" para a impressora (por exemplo, alterar espaçamento entre as linhas (#45), tipo de fonte (#18, #23), etc). Em versões 16-bit do Windows, isso não era complicado, mas agora, nas versões 32-bit, o acesso direto ao hardware não é mais possível.

Portanto, para enviarmos caracteres diretamente a impressora, devemos utilizar o "escape" chamado "PASSTHROUGH" do Windows e enviarmos a informação desejada diretamente.

Na documentação do Win32 SDK este escape é dado como obsoleto, mas enquanto utilizarmos impressoras matriciais que necessitem de "códigos escape" para certas funcionalidades, ele será necessário.

Ao utilizar impressoras Postscript tenha cuidado, pois nem sempre esta técnica irá funcionar. Em impressoras matriciais, você pode enviar qualquer tipo de caracteres que achar necessário.

Abaixo segue um código exemplificando o envio de uma string qualquer diretamente ao buffer da impressora:

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

uses Printers;

type

{ Tipo requerido pelo PASSTHROUGH }

TBufferImpressora = record

TamanhoBuffer: Word;

Buffer: array [0..255] of Char;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

Buff: TBufferImpressora;

TestePasstrough: Integer;

strFoo: string;

begin

{ Primeiro devemos checar se o "escape" PASSTHROUGH é suportado. Para isso, executamos a função "Escape" passando o QUERYESCSUPPORT. Caso o driver suporte, ela irá retornar um valor maior que 0 }

TestePasstrough := PASSTHROUGH;

if Escape(Printer.Handle, QUERYESCSUPPORT, SizeOf(PASSTHROUGH), @TestePasstrough, nil) > 0 then

begin

{ Inicializamos o driver }

Printer.BeginDoc;

{ Informação qualquer a enviar diretamente para a impressora }

strFoo := 'Passthrough string';

{ Copia da string para a estrutura }

StrPCopy(Buff.Buffer, strFoo);

{ Indicamos o tamanho da informação}

Buff.TamanhoBuffer := StrLen(Buff.Buffer);

{ Enviamos o "escape" }

Escape(Printer.Canvas.Handle, PASSTHROUGH, 0, @Buff,nil);

{ Descarregamos... }

Printer.EndDoc;

end;

end.

59) 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;

60) Criar barra de status com suporte às caixas de edição do Windows 95

No evento OnCreate do Form:

Application.OnHint := DisplayHint;

Crie (e defina) uma Procedure DisplayHint (no Form Principal):

StatusBar1.Panels[0].Text := Application.Hint;

61) Capturando uma tela do windows

procedure TForm1.Button1Click(Sender: TObject);

var

DeskTopDC: HDc;

DeskTopCanvas: TCanvas;

DeskTopRect: TRect;

begin

DeskTopDC := GetWindowDC(GetDeskTopWindow);

DeskTopCanvas := TCanvas.Create;

DeskTopCanvas.Handle := DeskTopDC;

DeskTopRect := Rect(0,0,Screen.Width,Screen.Height);

Form1.Canvas.CopyRect(DeskTopRect,DeskTopCanvas,DeskTopRect);

ReleaseDC(GetDeskTopWindow,DeskTopDC);

end;

62) compactar de uma tabela Paradox

Para compactar (remover fisicamente todos registros apagados) de uma tabela Paradox deve-se utilizar o seguinte código:

procedure ParadoxPack(Table : TTable);

var

TBDesc : CRTblDesc;

hDb: hDbiDb;

TablePath: array[0..dbiMaxPathLen] of char;

begin

FillChar(TBDesc,Sizeof(TBDesc),0);

with TBDesc do begin

StrPCopy(szTblName,Table.TableName);

StrPCopy(szTblType,szParadox);

bPack := True;

end;

hDb := nil;

Check(DbiGetDirectory(Table.DBHandle, True, TablePath));

Table.Close;

Check(DbiOpenDatabase(nil, 'STANDARD', dbiReadWrite,

dbiOpenExcl,nil,0, nil, nil, hDb));

Check(DbiSetDirectory(hDb, TablePath));

Check(DBIDoRestructure(hDb,1,@TBDesc,nil,nil,nil,False));

Table.Open;

end;

63) Configurações internacionais

Normalmente o Delphi busca os formatos de data/hora, moeda e formato numérico da Configuração Internacional do Painel de Controle. Isto pode levar a erros quando avaliando datas, números ou listas.

Para evitar estes erros, você pode mudar as constantes definidas no Delphi, como DecimalSeparator, ShortFormatDate e outros desta maneira:

DecimalSeparator :='.';

ShortFormatDate :='mm/dd/yy';

Isto terá precedência sobre a configuração padrão. Para uma lista completa das variáveis, procure em Currency Formating Variables na ajuda do Delphi.

64) Listando todas as janelas abertas

Para listas (pegar) todas as janelas abertas, deve-se usar a função API EnumWindows, que usa uma função Callback, com dois parâmetros, um Handle para a janela e um ponteiro. Você pode usá-la como um código semelhante a este (este lista as janelas abertas, mesmo invisíveis, em uma listbox):

function EnumWindowsProc(Wnd: HWnd; Form:TForm1): Boolean; Export; {$ifdef Win32} StdCall; {$endif}

var

Buffer: Array[0..99] of Char;

begin

GetWindowText(Wnd, Buffer, 100);

if StrLen(Buffer)=0 then

Form.ListBox1.Items.Add(StrPas(Buffer));

Result :=True;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

EnumWindows(@EnumWindowsProc, LongInt(Self));

end;

65) Primeira letra de um EditBox maiúscula

Para converter a primeira letra de um EditBox para maiúsculas este código pode ser utilizado:

procedure TForm1.Edit1Change(Sender: TObject);

var

OldStart: Integer;

begin

with Edit1 do

if Text <> '' then

begin

OnChange :=NIL;

OldStart :=SelStart;

Text :=UpperCase(Copy(Text,1,1))+LowerCase(Copy(Text,2,Length(Text)));

OnChange :=Edit1.Change;

end;

66) Desligar e Ligar o Monitor (Off/On)

Turn monitor off

SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);

Turn monitor on

SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, -1);

67) Invertendo os Botões do Mouse

Adicionar à cláusula Uses, Shellapi.

Digitar os seguintes parâmetros:

Swapmousebutton(true) ;

Para voltar ao normal basta mudar para False.

68) Mudar o Papel de Parede do Windows

Primeiro deve-se adicionar à cláusula Uses, ShellApi.

Em seguida deve-se digitar os seguinte comandos:

procedure TForm1.FormCreate(Sender: TObject);

var

Arquivo: String;

begin

Arquivo:='c:\windows\nuvens.bmp';

SystemParametersInfo(SPI_SetDeskWallPaper, 0, PChar(Arquivo), 0);

end;

69) Acessando arquivos Paradox em rede

Arquivos Paradox podem ser compartilhados em rede. Para que isto ocorra devemos:

Adicionar o Database Engine Configuration (BDE Config);

Selecionar a página Drivers;

Selecionar o driver PARADOX e alterar o parâmetro NET DIR para o local onde serão gravados os arquivos de controle para compartilhamento. Por exemplo, "G:\MEUAPLIC", onde G corresponde ao drive de rede e MEUAPLIC, o diretório onde está o aplicativo (executável);

Depois selecionar a página System;

Alterar o parâmetro LOCAL SHARE para TRUE. Após isto o BDE controlará o compartilhamento de arquivos Paradox em rede.

70) Pesquisa incremental numa tabela

Para fazer pesquisa incremental numa tabela usando um EDIT, deve-se colocar o seguinte código em seu evento OnChange:

procedure TForm1.Edit1Change(Sender: TObject);

begin

Width Edit1 do

if Text <>'' then

Table1.FindNearest([Text]);

end;

71) incluir mais de uma linha no Hint

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 a propriedade ShowHint.

72) Como saber se o aplicativo já foi aberto

Esta dica só funciona em Delphi 1.0 e não no win95, mas como bom micreiro, coloquei também a versão para W95, que segue abaixo:

No Projeto (.DPR):

uses windows, messages, // necessarios acrescentar

Forms, ...........

var

Hwnd: THandle; // variavel necessaria

begin

Hwnd:=FindWindow('O seu TForm', 'O caption do seu form principal');

if Hwnd = 0 then begin

Application.Initialize;

end

else begin

if not IsWindowVisible(Hwnd) then begin // se minimizado

ShowWindow(Hwnd, SW_SHOWNORMAL); //mostra

PostMessage(Hwnd, WM_USER, 0, 0); //restaura

end;

SetForegroundWindow(Hwnd); // visivel

end;

No Programa principal coloque:

private

{ Private declarations }

public

procedure WMUser(var msg: TMessage); message WM_USER; //definicao

{ Public declarations }

end;

implementation

{$R *.DFM}

procedure TPrincipal.WMUser(var msg: TMessage); //uso de fato.

begin

Application.restore;

end;

73) Mostrar e alterar resoluções de vídeo

Para mostrar as resoluções de vídeo disponíveis, deve-se usar a função da API EnumDisplaySettings: ela pega todos os modos de vídeo disponíveis.

Para alterar os modos, deve-se usar a função ChangeDisplaySettings, que muda a resolução de vídeo e quantidade de cores.

74) Verificar sistema operacional

unit sobreManager;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,

Buttons, ExtCtrls;

type

TfrmSobreManager = class(TForm)

btnOK: TButton;

ProductName: TLabel;

Version: TLabel;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Panel1: TPanel;

Image2: TImage;

GroupBox1: TGroupBox;

Bevel1: TBevel;

stOSVersao: TStaticText;

stOSBuilder: TStaticText;

stOS: TStaticText;

stOSService: TStaticText;

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

frmSobreManager: TfrmSobreManager;

implementation

{$R *.DFM}

// VERIFICA E APRESENTA AS INFORMAÇÕES do SISTEMA OPERACIONAL (FaC)

procedure TfrmSobreManager.FormCreate(Sender: TObject);

var

verInfo : TOsVersionInfo;

str : String;

I : Word;

begin

verInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);

if GetVersionEx(verInfo) then begin

stOSVersao.Caption := 'Versão : '+ IntToStr(verInfo.dwMajorVersion) +

IntToStr(verInfo.dwMinorVersion);

stOSBuilder.Caption := 'Compilação : '+IntToStr(verInfo.dwBuildNumber);

str := 'Sistema Operacional : ';

case verInfo.dwPlatformId of

VER_PLATFORM_WIN32s : stOS.Caption := str +'Windows 95';

VER_PLATFORM_WIN32_WINDOWS : stOS.Caption := str +'Windows 95 Osr2 / 98';

VER_PLATFORM_WIN32_NT : stOS.Caption := str +'Windows NT';

end;

str := '';

for I := 0 to 127 do

str := str + verInfo.szCSDVersion[I];

stOSService.Caption := 'Informações Adicionais : '+ str;

end

end;

end.

75) Nome do usuário logado na rede

Existe na API do BDE uma funcao chamada DbiGetNetUserName, que retorna o nome do usuário logado. Tente o seguinte:

function GetUserName:string;

var

Nome: array[0..64] of char;

begin

if DbiGetNetUserName(Nome) <> DBIERR_NONE then Nome:='';

Result:=StrPas(Nome);

end;

76) capturar o nome das tabelas de um banco de dados

Crie um Alias para o seu banco da dados(Fizemos com um banco do Interbase). Adicione o seguinte código ao seu programa(Neste caso o código foi feito no evento OnActivate do Form1):

procedure TForm1.FormActivate(Sender: TObject);

Var

MyStringList: TStringList;

i: Integer;

begin

try