Tips&Tricks

I trucchi del mestiere

Come muovere un componente a runtime

In alcuni programmi ci si trova di fronte alla necessità di poter dare all'utente la possibilità di muovere uno o più componenti a run-time. Tutto può essere fatto grazie a due sole righe di codice inserite nell'evento ONMOUSEMOVE; di seguito sono mostrati due stralci di codice applicati a un pulsante (Button1) e a un controllo edit (Edit1) posti su una form vuota (Form1)
Tip fornito dal sig. G. Dottarelli

procedure TForm1.Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
ReleaseCapture;
Button1.Perform(WM_SYSCOMMAND, $F012,0);
end;
 
procedure TForm1.Edit1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
ReleaseCapture;
Edit1.Perform(WM_SYSCOMMAND, $F012,0);
end;

Copia dei file "visuale"

Utilizzando un componente come il TProgressBar, si può realizzare una form per la copia di file da una directory ad un'altra.
Tip fornito dal sig. A. Silvano

procedure TForm1.CopyFileWithProgressBar1(Source, Destination: string); 
var 
  FromF, ToF: file of byte; 
  Buffer: array[0..4096] of char; 
  NumRead: integer; 
  FileLength: longint; 
begin 
  AssignFile(FromF, Source); 
  reset(FromF); 
  AssignFile(ToF, Destination); 
  rewrite(ToF); 
  FileLength := FileSize(FromF); 
  with Progressbar1 do 
  begin 
    Min := 0; 
    Max := FileLength; 
    while FileLength > 0 do 
    begin 
      BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead); 
      FileLength := FileLength - NumRead; 
      BlockWrite(ToF, Buffer[0], NumRead); 
      Position := Position + NumRead; 
    end; 
    CloseFile(FromF); 
    CloseFile(ToF); 
  end; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  CopyFileWithProgressBar1('c:\Windows\Welcome.exe', 'c:\temp\Welcome.exe'); 
end;

Come inviare messaggi tramite il servizio Messenger

Tip fornito dal sig. A.Silvano

function NetSend(dest, Source, Msg: string): Longint; overload; 
type 
  TNetMessageBufferSendFunction = function(servername, msgname, fromname: PWideChar; 
    buf: PWideChar; buflen: Cardinal): Longint;  
  stdcall; 
var 
  NetMessageBufferSend: TNetMessageBufferSendFunction; 
  SourceWideChar: PWideChar; 
  DestWideChar: PWideChar; 
  MessagetextWideChar: PWideChar; 
  Handle: THandle; 
begin 
  Handle := LoadLibrary('NETAPI32.DLL'); 
  if Handle = 0 then 
  begin 
    Result := GetLastError; 
    Exit; 
  end; 
    @NetMessageBufferSend := GetProcAddress(Handle, 'NetMessageBufferSend'); 
  if @NetMessageBufferSend = nil then 
  begin 
    Result := GetLastError; 
    Exit; 
  end; 

  MessagetextWideChar := nil; 
  SourceWideChar      := nil; 
  DestWideChar        := nil; 

  try 
    GetMem(MessagetextWideChar, Length(Msg) * SizeOf(WideChar) + 1); 
    GetMem(DestWideChar, 20 * SizeOf(WideChar) + 1); 
    StringToWideChar(Msg, MessagetextWideChar, Length(Msg) * 
      SizeOf(WideChar) + 1); 
    StringToWideChar(Dest, DestWideChar, 20 * SizeOf(WideChar) + 1); 
    if Source = '' then 
      Result := NetMessageBufferSend(nil, DestWideChar, nil, 
        MessagetextWideChar, Length(Msg) * SizeOf(WideChar) + 1) 
    else 
    begin 
      GetMem(SourceWideChar, 20 * SizeOf(WideChar) + 1); 
      StringToWideChar(Source, SourceWideChar, 20 * SizeOf(WideChar) + 1); 
      Result := NetMessageBufferSend(nil, DestWideChar, SourceWideChar, 
        MessagetextWideChar, Length(Msg) * SizeOf(WideChar) + 1); 
      freemem(SourceWideChar); 
    end; 
  finally 
    FreeMem(MessagetextWideChar); 
    FreeLibrary(Handle); 
  end; 
end; 

function NetSend(Dest, Msg: string): Longint; overload; 
begin 
  Result := NetSend(Dest, '', Msg); 
end; 

function NetSend(Msg: string): Longint; overload; 
begin 
  Result := NetSend('', '', Msg); 
end; 

// Esempio 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  NetSend('LoginName', 'Proprio Messaggio'); 
end;

Identificare l'indirizzo IP del proprio PC

Un semplice ma utile tip che permette di identificare l'indirizzo IP del computer su cui si sta lavorando. L'indirizzo IP, alla pressione di un pulsante, viene messo in una TextBox. Trovate un'applicazione d'esempio su: www.itportal.it/ioProg70/Tips o sul supporto CD-Rom. Tip fornito dal sig. Roberto Grassi

procedure TForm1.Button1Click(Sender: TObject);
// Mettere uses Winsock nella 'interface'
function Ip:String;
var WSAData : TWSAData;
    HostName: String;
    HostEnt : PHostEnt;
begin
 WSAStartup(2, WSAData);
 SetLength(HostName, 255);
 GetHostName(PChar(HostName), 255);
 SetLength(HostName, StrLen(PChar(HostName)));
 HostEnt := GetHostByName(PChar(HostName));
 with HostEnt^ do
  begin
   Result := Format('%d.%d.%d.%d',
                        [Byte(h_addr^[0]),
                         Byte(h_addr^[1]),
                         Byte(h_addr^[2]),
                         Byte(h_addr^[3])]);
   WSACleanup;
  end;
end;
 
begin
 Edit1.Text:=Ip;
end;