Super Dicas Delphi parte III

Obtendo 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;
end;
end;

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;

Desabilitar o CTRL+ALT+DEL e ALT+TAB

Var
numero: integer;
begin
SystemParametersInfo(97,Word(true),@numero,0);
end;
{ Para habilitar é só chamar a mesma função com Word(false) }

Carregar um cursor animado (*.ani) 

const
cnCursorID1 = 1;
begin
Screen.Cursors[ cnCursorID1 ] :=
LoadCursorFromFile('c:\win95\cursors\cavalo.ani' );
Cursor := cnCursorID1;
end;

Saindo do Windows

{ Reinicia o Windows }
ExitWindowsEx(EWX_REBOOT, 0); 
{ Desliga o Windows }
ExitWindowsEx(EWX_SHUTDOWN, 0); 
{ Força todos os programa a desligarem-se }
ExitWindowsEx(EWX_FORCE, 0); 

Modificando a posição do cursor em um Memo

Modificando a posição:

ActiveControl:=Memo1;
MemoCursorTo(Memo1,2,3);

Obtendo a Posição:

GetMemoLineCol(Memo1,Linha,Coluna);

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:
procedure TForm1.Table1BeforeDelete(DataSet:TDataSet);
begin
if MessageDlg('Eliminar o Registro?',mtConfirmation,[mbYes,mbNo],0)<>mrYes then Abort;
end;

Pegando o Nome do usuário e a Empresa do Windows

Uses Registry; 
Procedure GetUserCompany; 
var 
reg: TRegIniFile; 
begin 
reg := TRegIniFile.create('SOFTWARE\MICROSOFT\MS SETUP (ACME)\'); 
Edit1.Text := reg.ReadString('USER INFO','DefName',''); 
Edit2.Text := reg.ReadString('USER INFO','DefCompany',''); 
reg.free; 
end; 

Escrevendo um Texto na Diagonal usando o Canvas

procedure TForm1.Button1Click(Sender: TObject); 
var 
lf : TLogFont; 
tf : TFont; 
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; 
end; 

Fundo do texto transparente

procedure TForm1.Button1Click(Sender: TObject); 
var 
OldBkMode : integer; 
begin 
with Form1.Canvas do begin 
Brush.Color := clRed; 
FillRect(Rect(0, 0, 100, 100)); 
Brush.Color := clBlue; 
TextOut(10, 20, 'Não é Transparente!'); 
OldBkMode := SetBkMode(Handle, TRANSPARENT); 
TextOut(10, 50, 'É Transparente!'); 
SetBkMode(Handle, OldBkMode); 
end; 
end; 

Formatação de Casas Decimais

procedure TForm1.Button1Click(Sender: TObject); 
var num : integer; 
begin 
num:=12450; 
Edit1.text:=formatfloat('###,###,##0.00', num) 
end; 

Escondendo/Mostrando o botão Iniciar

procedure EscondeIniciar(Visible:Boolean); 
Var taskbarhandle, 
buttonhandle : HWND; 
begin 
taskbarhandle := FindWindow('Shell_TrayWnd', nil); 
buttonhandle := GetWindow(taskbarhandle, GW_CHILD); 
If Visible=True Then Begin 
ShowWindow(buttonhandle, SW_RESTORE); {mostra o botão} 
End Else Begin 
ShowWindow(buttonhandle, SW_HIDE); {esconde o botão} 
End; 
end; 

Esconde/Mostra a Barra de Tarefas

procedure EscondeTaskBar(Visible: Boolean); 
var wndHandle : THandle; 
wndClass : array[0..50] of Char; 
begin 
StrPCopy(@wndClass[0],'Shell_TrayWnd'); 
wndHandle := FindWindow(@wndClass[0], nil); 
If Visible=True Then Begin 
ShowWindow(wndHandle, SW_RESTORE); {Mostra a barra de tarefas} 
End Else Begin 
ShowWindow(wndHandle, SW_HIDE); {Esconde a barra de tarefas} 
End; 
end; 

Desabilitando o Alt+Tab

procedure TurnSysKeysOff; 
var OldVal : LongInt; 
begin 
SystemParametersInfo (97, Word (True), @OldVal, 0) 
end; 
procedure TurnSysKeysOn; 
var OldVal : LongInt; 
begin 
SystemParametersInfo (97, Word (False), @OldVal, 0) 
end; 

Detectando o Numero Serial do HD

Function SerialNum(FDrive:String) :String;
Var Serial:DWord;
DirLen,Flags: DWord;
DLabel : Array[0..11] of Char;
begin
Try
GetVolumeInformation(PChar(FDrive+':\'),dLabel,12,@Serial,DirLen,Flags,nil,0);
Result := IntToHex(Serial,8); 
Except Result :='';
end;
end;