Dez dicas de Delphi
1. Fazendo uma janela filha de outra sem usar MDI
procedure TForm2.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params); { call the inherited first }
with Params do
begin
Style := Style or WS_CHILD; { add a style flag }
WndParent := Application.MainForm.Handle;
end;
end;
2. Abrindo e Fechando a bandeja do drive de CD-ROM
Para Abrir:
mciSendString('Set cdaudio door open wait', nil, 0, handle);
Para Fechar:
mciSendString('Set cdaudio door open wait', nil, 0, handle);
3. Obtendo a Data e a Hora de um Arquivo
function GetFileDate(Arquivo: String): String;
var FHandle: integer;
begin
FHandle := FileOpen(Arquivo, 0);
try
Result := DateTimeToStr(FileDateToDateTime(FileGetDate(FHandle)));
finally
FileClose(FHandle);
end;
end;
4. Testando a impressora se está OnLine
function PrinterOnLine : Boolean;
Const
PrnStInt : Byte = $17;
StRq : Byte = $02;
PrnNum : Word = 0; { 0 para LPT1, 1 para LPT2, etc. }
Var nResult : byte;
Begin (* PrinterOnLine*)
Asm
mov ah,StRq;
mov dx,PrnNum;
Int $17;
mov nResult,ah;
end;
PrinterOnLine := (nResult and $80) = $80;
End;
5. Obtendo a letra do drive de CD-ROM
function FindFirstCDROMDrive: Char;
var
drivemap, mask: DWORD;
i: Integer;
root: String;
begin
Result := #0;
root := 'A:\';
drivemap := GetLogicalDrives;
mask := 1;
for i:= 1 To 32 Do
begin
if (mask and drivemap) <> 0 Then
if GetDriveType( PChar(root) ) = DRIVE_CDROM Then
begin
Result := root[1];
Break;
end;
mask := mask shl 1;
Inc( root[1] );
End;
End;
6. Obtendo o número serial do HD
function SerialNumber(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;
7. Converte um número binário para inteiro
function BinToInt(Value: String): LongInt;
{Converte um numero binário em Inteiro}
var i,Size: Integer;
begin
Result := 0;
Size := Length(Value);
for i:=Size downto 0 do
if Copy(Value,i,1)='1' then
Result := Result+(1 shl i);
end;
8. Alterar atributos de um arquivo
var Attrib: integer;
begin
Attrib:=FileGetAttr('C:\ARQUIVO.XYZ');
if Attrib<>-1 then
begin
Attrib:=Attrib and not faReadOnly;
if FileSetAttr('C:\ARQUIVO.XYZ', Attrib)=0 then
Alteração Efetuada
else Windows code error;
end;
end;
9. Carregando um cursor animado
procedure TForm1.Button2Click(Sender: TObject);
const cnCursorID = 1;
begin
Screen.Cursors[cnCursorID]:=LoadCursorFromFile('drive:\caminho\arquivo.ani' );
Cursor := cnCursorID;
end;
10. Definindo o tamanho Mínimo e Máximo de um Formulário
procedure TForm1.WMGetMinMaxInfo(var MSG: TMessage);
begin
inherited;
with PMinMaxInfo(MSG.lparam)^ do
begin
ptMinTRackSize.X := 300;
ptMinTRackSize.Y := 150;
ptMaxTRackSize.X := 350;
ptMaxTRackSize.Y := 250;
end;
end;
