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