procedure TForm1.Button1Click(Sender: TObject);
var
Buffer : array [0..255] of char;
begin
GetShortPathName('C:\Arquivos de programas\Borland\Common Files\BDE\Bde32.hlp',@Buffer,sizeof(Buffer));
Memo1.Lines.Add(Buffer);
end; 

A função para verificar se o ano é bissexto é a IsLeapYear ( year : Word) : Boolean;
Que retornará TRUE se o ano informado no parâmetro for bissexto.

No evento OnChange do TabbedNotebook coloque :

AllowChange := False; 

No OnCreate do Form coloque

Var
Hr : Thandle;
Begin
{ Cria uma Região elíptica }
Hr := CreateEllipticRgn(0,0,100,200);
SetWindowRgn(Handle, hr, true);
End;

Procedure TForm1.WMEndsession ( var Msg : TWMEndSession);
Begin
If Msg.Endsession = True then
Showmessage('O windows está finalizando ' + #13 + 'às' + Formatdatetime('c',Now);
Inherited;
End;

No evento OnCreate do Formulário Principal coloque a clásula

SHORTDATEFORMAT:= 'dd/mm/yyyy'; 

Para listar todas janelas abertas, deve-se usar a funcao da API EnumWindows, que usa uma funcao Callback, com
dois parâmetros, um Handle para a janela e um ponteiro. Voce pode usá-la com 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; 

Para testar este exemplo inclua no seu form alguns componentes. Nestes componentes coloque informações na
propriedade Hint de cada componente e altere a propriedade ShowHint para True.

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure MyShowHint(var HintStr: string;
var CanShow: Boolean;
var HintInfo: THintInfo);
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

// Função que irá alterar a fonte do Hint
procedure TForm1.MyShowHint(var HintStr: string;
var CanShow: Boolean;
var HintInfo: THintInfo);
var i : integer;
begin
for i := 0 to Application.ComponentCount - 1 do
if Application.Components[i] is THintWindow then
with THintWindow(Application.Components[i]).Canvas do
begin
Font.Name := 'Arial';
Font.Size := 18;
Font.Style := [fsBold];
HintInfo.HintColor := clWhite;
end;
end;

// Evento OnCreate do Form
procedure TForm1.FormCreate(Sender: TObject);
begin
// Ativa a função que irá alterar o formato do Hint
Application.OnShowHint := MyShowHint;
end; 

Para testar o exemplo abaixo inclua no seu form um componente StringGrid

unit Unit1;

interface

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

type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
procedure FormCreate(Sender: TObject);
procedure StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
Col : integer; // Declarar esta variável
Row : integer; // Declarar esta variável
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

// Evento OnCreate do Form
procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.Hint := '0 0';
StringGrid1.ShowHint := True;
end;

// Evento OnMouseMove do componente StringGrid
procedure TForm1.StringGrid1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
r : integer;
c : integer;
begin
StringGrid1.MouseToCell(X, Y, C, R);
if ((Row <> r) or (Col <> c)) then
begin
Row := r; Col := c;
Application.CancelHint;
StringGrid1.Hint := 'Linha: '+IntToStr(r) + #32 + 'Coluna: '+IntToStr(c);
end;
end; 

private
{ Private declarations }
procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM} 

procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
begin
inherited; { Chama o manipulador de mensagem herdado }
if M.Result = htClient then { Verifica se está na area cliente do Form }
M.Result := htCaption; { Neste caso faz o Windows pensar que está na barra de Título. }
end; 

procedure TForm1.Button2Click(Sender: TObject);
var
lf : TLogFont;
tf : TFont;
begin
with Form1.Canvas do
begin
Font.Name := 'Arial';
Font.Size := 15;
tf := TFont.Create;
tf.Assign(Font);
GetObject(tf.Handle, sizeof(lf), @lf);
lf.lfEscapement := 300;
lf.lfOrientation := 300;
tf.Handle := CreateFontIndirect(lf);
Font.Assign(tf);
tf.Free;
TextOut(20, Height div 2,'Exemplo de texto');
end;
end; 

Para dar ao Enter a funcionalidade do Tab (ou seja, passar ao componente seguinte), digite a seguinte rotina no
evento OnKeyPress do form: 

procedure TNomeDoForm.NomeDoFormKeyPress(Sender: TObject; var Key: Char); 
begin 
if key = #13 then 
begin 
key := #0; 
perform (WM_NextDlgCtl, 0, 0); 
end; 
end; 

Em seguida coloque a propriedade KeyPriview do Form = TRUE e certifique-se que todos os botões do Form
estejam com a propriedade Default = FALSE.

Para criar um form inicial, como o form de entrada do Word, primeiramente vá em Project|Options e remova o nome
do form inicial (clique no nome do form e clique em ">"). Depois, vá em View|Project Source e antes do primeiro
Application.CreateForm (NomeDoForm...), digite: 
frmSplash := TfrmSplash.Create (Application); 
frmSplash.Show; 
frmSplash.Update; 

E para remover o form da memória, digite após o último CreateForm: 

frmSplash.Free; 

Nota: não se esqueça de alterar a propriedade BorderStyle para bsNone, e Position para poScreenCenter

Para trocar a fonte de um DBGrid, utilize a rotina abaixo no evento OnDrawDataCell: 

if Tabela.FieldByName ('Salario').Value >= 10000 then 
begin 
DbGrid1.Canvas.Font.Color := clRed; 
DbGrid1.Canvas.Font.Style := [fsBold]; 
end; 
DbGrid1.DefaultDrawDataCell(Rect, Field, State); 

No caso, somente os registros com salário maior que R$ 10.000,00 ficarão com cor vermelha e em negrito. 

Nota: Não é necessário mover o ponteiro da tabela para colorir os registros. 

A maioria dos teclados possui apenas o ponto no teclado numérico. Mas se você precisar utilizar a vírgula como
separador decimal, utilize a seguinte rotina no evento OnKeyPress do Edit: (lembre-se que DecimalSeparator
contém o separador decimal (que não necessariamente está em português). Veja em Internacional no Painel de
Controle). 
begin 
if key = '.' then 
key:= DecimalSeparator; 
end; 

Para descobrir a linha e a coluna atuais de um componente TMemo, utilize a seguinte procedure:

with Memo do 
begin 
Linha := Perform (EM_LINEFROMCHAR, SelStart, 0); 
Coluna := SelStart - Perform (EM_LINEINDEX, Line, 0); 
end; 

Para limpar todos os Edits de um form, use a seguinte rotina: 

procedure TNomeDoForm.NomeDoBotaoClick(Sender: TObject); 
var 
I : integer; 
begin 
for I := 0 to ComponentCount - 1 do 
if (Components [I] is TEdit) then 
(Components [I] as TEdit).Clear; 
end; 


Para fazer qualquer operação em outro tipo de objeto, é só trocar TEdit pelo tipo de componente que você quer
manipular. 

Existem vários cursores no Delphi (crDefault é o cursor padrão, crHourGlass é a ampulheta, crHandPoint é a
"mãozinha", etc). Para alterá-lo, basta escolher um na propriedade Cursor do componente em que você quer
mudar o cursor (troque no form para trocar o do form inteiro). Mas, se você quiser colocar um cursor diferente,
siga os procedimentos abaixo: 
Na seção interface da unit que contém o form, coloque as seguintes linhas: 

const 
crSeuCursor = 1; // Tem que ser um valor maior que 0 (zero) 

No evento OnCreate do form, digite as seguintes linhas: 

Screen.Cursors [crSeuCursor] := LoadCursorFromFile ('Cursor.ani'); 
// O cursor pode ser dos tipos comum (*.cur) ou animado (*.ani) 
// Lembre-se: o arquivo tem que estar na mesma pasta do programa 
// ou digite o nome do caminho dele. 

Na hora de trocar de cursor, use o seguinte comando: 

Objeto.Cursor := crSeuCursor; 

onde Objeto é o nome do objeto que vai ter o cursor alterado (o form, por exemplo). 

Para pegar o primeiro nome de uma pessoa, crie a seguinte função: 

function PrimeiroNome (Nome : String) : String; 
var 
PNome : String; 
begin 
PNome := ''; 
if pos (' ', Nome) <> 0 then 
PNome := copy (Nome, 1, pos (' ', Nome) - 1); 
Result := PNome; 
end; 

Indice := ListView.Selected.Index; 

Lembre-se que o primeiro item possui índice igual a 0 (zero), o segundo vale 1, etc. Se quiser descobrir o rótulo (o
texto que fica abaixo do ícone), troque Index por Caption, assim: 

Rotulo := ListView.Selected.Caption; 

Coloque essas units na seção implementation : 

uses ShlObj, ActiveX,ComObj, Registry; 
Por último, crie uma procedure que faça o trabalho: 
procedure CreateShortcut (FileName, Parameters, InitialDir, ShortcutName, ShortcutFolder : String); 
var 
MyObject : IUnknown; 
MySLink : IShellLink; 
MyPFile : IPersistFile; 
Directory : String; 
WFileName : WideString; 
MyReg : TRegIniFile; 
begin 
MyObject := CreateComObject(CLSID_ShellLink); 
MySLink := MyObject as IShellLink; 
MyPFile := MyObject as IPersistFile; 
with MySLink do 
begin 
SetArguments(Parameters); 
SetPath(PChar(FileName)); 
SetWorkingDirectory(PChar(InitialDir)); 
end; 
MyReg := TRegIniFile.Create('Software\MicroSoft\Windows\CurrentVersion\Explorer'); 
Directory := MyReg.ReadString ('Shell Folders','Desktop',''); 
WFileName := Directory + '\' + ShortcutName + '.lnk'; 
MyPFile.Save (PWChar (WFileName), False); 
MyReg.Free; 
end;

Para criar um atalho para um programa, primeiramente coloque essas units na seção implementation de seu form: 
uses ShlObj, ActiveX, ComObj, Registry; 

Por último, crie uma procedure que faça o trabalho: 

procedure CreateShortcut (FileName, Parameters, InitialDir, ShortcutName, ShortcutFolder : String); 
var 
MyObject : IUnknown; 
MySLink : IShellLink; 
MyPFile : IPersistFile; 
Directory : String; 
WFileName : WideString; 
MyReg : TRegIniFile; 
begin 
MyObject := CreateComObject(CLSID_ShellLink); 
MySLink := MyObject as IShellLink; 
MyPFile := MyObject as IPersistFile; 
with MySLink do 
begin 
SetArguments(Parameters); 
SetPath(PChar(FileName)); 
SetWorkingDirectory(PChar(InitialDir)); 
end; 
MyReg := TRegIniFile.Create ('Software\MicroSoft\Windows\CurrentVersion\Explorer'); 
Directory := MyReg.ReadString('Shell Folders','Start Menu','') + '\' + ShortcutFolder; 
CreateDir(Directory); 
WFileName := Directory + '\' + ShortcutName + '.lnk'; 
MyPFile.Save (PWChar (WFileName), False); 
MyReg.Free; 
end; 

Se o texto de um TEdit for mudado no seu evento OnChange, este evento será chamado recursivamente até
acabar com o espaço de pilha. Para fazer isso, deve-se setar o evento OnChange para NIL antes de mudar o texto,
voltando ao original depois, desta maneira:

procedure Edit1Change(Sender : TObject); 
begin 
Edit1.OnChange := NIL; 
if Edit1.Text = 'Texto' then 
Edit1.Text := 'Novo Texto'; 
Edit1.OnChange := Edit1Change; 
end;

Esta dica também vale para evento OnValidate. 

Em Delphi 1.0, marcando a checkbox Optimize for size and load time, em Options/Project/Linker não funciona
(aparece uma mensagem 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 teclar o seguinte:

W8LOSS programa.exe

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

Para posicionar o cursor em uma linha de um Memo ou RichEdit, deve-se utilizar o seguinte:

With Memo1 do 
SelStart := Perform(EM_LINEINDEX, Linha, 0); 

Para esconder janelas filhas minimizadas, basta capturar a mensagem WM_Size, desta maneira: 

type 
TForm1 = class(TForm) 
public 
procedure WMSize(var M : TWMSIZE);Message WM_Size; 
end; 

implementation 

procedure TForm1.WMSize(var M:TWMSIZE); 
begin 
if M.SizeType=Size_Minimized then 
showwindow(Handle,Sw_Hide); 
end; 

Para executar ações padrão de um Ole Container (abrir um documento Word ou Excel ou rodar uma apresentação
Powerpoint), pode-se usar este código: 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
OleContainer1.DoVerb(ovprimary); 
end; 

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; 

Para colocar um arquivo qualquer dentro de um arquivo .exe, primeiramente crie um arquivo
com extensão .rc no Bloco de Notas. O formato de um arquivo .rc é o seguinte: 

1 RCDATA "MyPic.jpg" 

onde "1" é o índice do arquivo, "RCDATA" é significa que é um tipo de arquivo não-padrão (os
padrões são bitmaps, ícones e cursores) e ""MyPic.jpg"" é o nome do arquivo. Salve e execute o
programa BRCC32.EXE que fica no subdiretório Bin do Delphi (BRCC32 arquivo.rc). Será
criado um arquivo .res (arquivo.res) cujo conteúdo terá o próprio JPG. 

Nota: Você pode colocar mais de um arquivo no arquivo .res, desde que os índices sejam diferentes. 

Para colocá-lo no executável, coloque a linha: 

{$R arquivo.res} 

após a linha: 

{$R *.DFM} 

Ok, ele já vai ficar no executável. E como eu rodo esse JPG? Simples: 

procedure LoadJPEGfromEXE; 
var 
MyJPG : TJPEGImage; 
ResStream : TResourceStream; 
Index : Integer; 
begin 
Index := 1; 
try 
MyJPG := TJPEGImage.Create; 
ResStream := TResourceStream.CreateFromID (HInstance, Index,
RT_RCDATA); 
MyJPG.LoadFromStream (ResStream); 
Canvas.Draw (12, 12, MyJPG); 
finally 
MyJPG.Free; 
ResStream.Free; 
end; 
end; 

Troque o valor de Index pelo valor do índice que você criou para o arquivo que deseja abrir. 

Para calcular o feriado da Páscoa, use a rotina abaixo: 

function CalcEaster : String; 
var 
B,D,E,Q : Integer; 
GF : String; 
begin 
B := 225 - 11 * (Year mod 19); 
D := ((B-21) mod 30) + 21; 
if D > 48 then 
Dec (D); 
E := (Year + (Year div 4) + D + 1) mod 7; 
Q := D + 7 - E; 
if Q < 32 then 
begin 
if ShortDateFormat [1] = 'd' then 
Result := IntToStr(Q) + '/3/' + IntToStr(Year) 
else 
Result := '3/' + IntToStr(Q) + '/' + IntToStr(Year); 
end 
else 
begin 
if ShortDateFormat [1] = 'd' then 
Result := IntToStr (Q - 31) + '/4/' + IntToStr(Year) 
else 
Result := '4/' + IntToStr (Q - 31) + '/' + IntToStr(Year); 
end; 

if Q < 32 then 
begin 
if ShortDateFormat [1] = 'd' then 
GF := IntToStr(Q-2) + '/3/' + IntToStr(Year) 
else 
GF := '3/' + IntToStr(Q-2) + '/' + IntToStr(Year); 
end 
else 
begin 
if ShortDateFormat [1] = 'd' then 
GF := IntToStr (Q - 31 - 2) + '/4/' + IntToStr(Year) 
else 
GF := '4/' + IntToStr (Q - 31 - 2) + '/' + IntToStr(Year); 
end; 
end; 

Para tirar um ícone de um arquivo .exe ou .dll, use a procedure abaixo (coloque a unit ShellAPI na cláusula Uses
da sua unit): 

procedure ExtrairIcone; 
var 
IconIndex : Word; 
h : hIcon; 
begin 
IconIndex := 0; 
h := ExtractAssociatedIcon (hInstance, 'C:\Windows\Notepad.exe',
IconIndex); 
DrawIcon (Form1.Canvas.Handle, 10, 10, h); 
end; 

//Para reduzir o consumo de energia do monitor, use o seguinte comando: 

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

//Para voltar ao normal: 

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

Para acessar bancos de dados Paradox em uma rede utilizando Windows, faça o seguinte: 

Abra o BDE Administrator; 
Na aba Configuration, escolha a "pasta" Drivers|Native|PARADOX e altere NetDir para o nome do servidor 
(no formato de rede :\\Servidor\Compartilhamento); 

Na "pasta" System|INIT, altere LocalShare para True; 
Altere o diretório do alias para o nome do servidor (também no formato de rede). 

function NetUser : string; 
var 
szNetName: array [0..48] of char; 
iResult: DBIResult; 
begin 
iResult := DBIGetNetUserName (szNetName); 
if iResult <> DBIErr_None then 
DBIError (iResult) 
else 
Result := StrPas (szNetName); 
end; 

Não se esqueça de colocar cláusula Uses do form as units DBIProcs, DBITypes, DB e DBIErrs. 

var 
Erro : DWord; 
PServer, PSenha, PLetra : PChar; 
begin 
PServer := '\\NomeDaMaquina\Caminho' + #0; 
{ NomeDaMaquina é o nome da máquina } 
PLetra := 'Z:'; // Z: será a letra da pasta 
PSenha := ''; // Digite uma senha aqui, se quiser 
ERR := WNetAddConnection (PServer , PSenha , PLetra); 
case Erro of 
ERROR_ACCESS_DENIED : ShowMessage ('Acesso negado.'); 
ERROR_ALREADY_ASSIGNED : ShowMessage ('A letra do drive especificada
já está conectada.'); 
ERROR_BAD_DEV_TYPE : ShowMessage ('O tipo de dispositivo e o tipo de
recurso não são compatíveis.'); 
ERROR_BAD_DEVICE : ShowMessage ('Letra de unidade inválida.'); 
ERROR_BAD_NET_NAME : ShowMessage ('O nome da máquina não é válida ou
não pode ser localizada.' ); 
ERROR_BAD_PROFILE : ShowMessage ('Formato incorreto de parâmetros.');
ERROR_CANNOT_OPEN_PROFILE : ShowMessage ('Conexão permanente não
disponível.'); 
ERROR_DEVICE_ALREADY_REMEMBERED : ShowMessage ('Uma entrada para o
dispositivo especificado já está no perfil do usuário.'); 
ERROR_EXTENDED_ERROR : ShowMessage ('Erro de rede.'); 
ERROR_NO_NETWORK : ShowMessage ('A rede não está presente.'); 
else 
if Erro > 0 then 
ShowMessage ('Erro número ' + IntToStr (Erro) + '.'); 
end; 
end;

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