Dez dicas de Delphi
1. Desabilita o botão Fechar do Formulário
2. Mudar a cor da linha de um DBGrid
3. Inicializar vários EDITs em um formulário
4. Nome do computador
5. Trocar a resolução de vídeo
6. Executar Pack em Tabelas Paradox
7. Esconder a aplicação da barra de tarefas
8. Travar/Destravar as teclas: Alt+Tab, Ctrl+Esc, Ctrl+Alt+Del
9. Desconectar uma unidade de rede mapeada
10. Retorna o IP da Máquina
1. Desabilita o botão Fechar do Formulário (topo)
procedure TForm1.FormCreate(Sender: TObject);
var
hwndHandle : THANDLE;
hMenuHandle : HMenu;
begin
hwndHandle := Self.Handle;
if (hwndHandle <> 0) then
begin
hMenuHandle := GetSystemMenu(hwndHandle, FALSE);
if (hMenuHandle <> 0) then
DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);
end;
end;
2. Mudar a cor da linha de um DBGrid (topo)
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; .....);
begin
if odd(field.DataSet.RecNo) then
DBGrid1.Canvas.Font.Color := clBlue
else DBGrid1.Canvas.Font.Color := clWhite;
DBGrid1.DefaultDrawDataCell(Rect, dbgrid1.columns[datacol].field, state);
end;
3. Inicializar vários EDITs em um formulário (topo)
procedure TForm1.Button1Click(Sender: TObject);
var contador : integer;
begin
for contador := 0 to (Form1.ControlCount - 1) do
if Form1.Controls[contador].ClassName = 'TEdit' then
(Form1.Controls[contador] as TEdit).Text := '';
end;
4. Nome do computador (topo)
function NomeComputador : String;
var
lpBuffer : PChar;
nSize : DWord;
const Buff_Size = MAX_COMPUTERNAME_LENGTH + 1;
begin
nSize := Buff_Size;
lpBuffer := StrAlloc(Buff_Size);
GetComputerName(lpBuffer,nSize);
Result := String(lpBuffer);
StrDispose(lpBuffer);
end;
5. Trocar a resolução de vídeo (topo)
function TrocaResolucao(X, Y: word): Boolean;
var lpDevMode: TDeviceMode;
begin
if EnumDisplaySettings(nil, 0, lpDevMode) then
begin
lpDevMode.dmFields := DM_PELSWIDTH Or DM_PELSHEIGHT;
lpDevMode.dmPelsWidth := X;
lpDevMode.dmPelsHeight:= Y;
Result := ChangeDisplaySettings(lpDevMode, 0) = DISP_CHANGE_SUCCESSFUL;
end;
end;
6. Executar Pack em Tabelas Paradox (topo)
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;
7. Esconder a aplicação da barra de tarefas (topo)
var H : HWnd;
begin
H := FindWindow(Nil,'Project1');
if H <> 0 then
ShowWindow(H,SW_HIDE);
end;
8. Travar as teclas: Alt+Tab, Ctrl+Esc, Ctrl+Alt+Del (topo)
var OldValue : LongBool;
begin
SystemParametersInfo(97, Word(True), @OldValue, 0);
end;
Destravar as teclas: Alt+Tab, Ctrl+Esc, Ctrl+Alt+Del
var OldValue : LongBool;
begin
SystemParametersInfo(97, Word(False), @OldValue, 0);
end;
9. Desconectar uma unidade de rede mapeada (topo)
function DesconectaRede(Unidade:Pchar;ForcaCancel:boolean):String;
begin
WNetCancelConnection2(Unidade,0,ForcaCancel);
Case GetLastError() of
1205: Result := 'Não foi possível abrir o perfil';
1206: Result := 'Perfil do usuário não encontrado ou inválido';
1208: Result := 'Ocorreu um Erro específico na rede';
2138: Result := 'Rede não encontrada ou fora do ar';
2250: Result := 'Mapeamento inválido ou não encontrado';
2401: Result := 'Existem muitos arquivos abertos';
else Result := 'Unidade disconectada com sucesso';
end;
end;
10. Retorna o IP da Máquina (topo)
function GetIP:string;//--> Declare a Winsock na clausula uses da unit
var
WSAData: TWSAData;
HostEnt: PHostEnt;
Name:string;
begin
WSAStartup(2, WSAData);
SetLength(Name, 255);
Gethostname(PChar(Name), 255);
SetLength(Name, StrLen(PChar(Name)));
HostEnt := gethostbyname(PChar(Name));
with HostEnt^ do
Result:=Format('%d.%d.%d.%d',[Byte(h_addr^[0]),
Byte(h_addr^[1]),Byte(h_addr^[2]),Byte(h_addr^[3])]);
WSACleanup;
end;
Por: Fábio Corrêa