1 - SendMessage(ListBox1.Handle, LB_SetHorizontalExtent, 250, longint(0));

2 - PostMessage(ProgressBar1.Handle, $0409, 0, ClGreen);

3 - Codice per abilitare il menù Start:

     EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil),
     0, 'Button', nil), True);

     Codice per disabilitare il menù Start:

     EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil),
     0, 'Button', nil), False);

4 - Apertura:

     mciSendString('Set cdaudio door open wait', nil, 0, handle);

    Chiusura:

     mciSendString('Set cdaudio door closed wait', nil, 0, handle);


     NOTA: Includere la unit MMSystem nello Uses.

5 - procedure TForm1.Button1Click(Sender: TObject);
     var 
     pidl: PITEMIDLIST;
     Path: array[0..255] of char;
     begin
       SHGetSpecialFolderLocation(0, CSIDL_COOKIES, pidl);
       SHGetPathFromIDList(pidl, path);
       Label1.Caption := Path;
     end;

     NOTA: Includere la unit ShlObj nello Uses.

     Clicca qui per ottenere altre cartelle di sistema...

6 - Se si possiede una versione di Delphi inferiore alla 5 usare questa funzione:

     function IncludeTrailingBackslash(Path: string) : string;
     begin
     if Copy(Path, Length(Path), 1) = '\' then
        Result := Path
     else
        Result := Path + '\';
     end;

     Altrimenti:

     var
       aSystemDirZ : array[0..2047] of Char;
       aWindowsDirZ : array[0..2047] of Char;
       fTempDir: string;
     begin
       GetSystemDirectory ( aSystemDirZ, 2047);
       GetWindowsDirectory( aWindowsDirZ, 2047);
       SetLength(fTempDir,257);

       fSystemDir := IncludeTrailingBackslash(aSystemDirZ);
       fWindowsDir := IncludeTrailingBackslash(aWindowsDirZ);
       GetTempPath(257,PChar(fTempDir));

       Label1.Caption := fSystemDir;
       Label2.Caption := fWindowsDir;
       Label3.Caption := fTempDir;
     end;

7 - Per spegnere il monitor:

     SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);

     Per accendere il monitor:

     SendMessage(Application.Handle, WM_SYSCOMMAND,SC_MONITORPOWER, -1);

8 - function GetComputerNetName: string;
     var buffer: array[0..255] of char;
          size: dword; 
    begin 
       size := 256;
       if GetComputerName(buffer, size) then
          Result := buffer else
          Result := ''
    end;

9 - function IsActiveDeskTopOn: Boolean;
     var
       h: hWnd;
     begin
        h := FindWindow('Progman', nil);
        h := FindWindowEx(h, 0,'SHELLDLL_DefView', nil);
        h := FindWindowEx(h, 0,'Internet Explorer_Server', nil);
        Result := h <> 0;
     end;

10 - Codice da srivere nell' evento OnCreate del Form dove si trova il pulsante:

       SetWindowLong(Button2.Handle, GWL_STYLE,
                               GetWindowLong(Button2.Handle, GWL_STYLE) OR BS_MULTILINE);

11 - procedure TForm1.TreeView1Click(Sender: TObject);
       var oNode: TTreeNode;
       begin
         TreeView1.ShowHint := True;
         oNode:=TTreeNode( TreeView1.Selected );
         StatusBar1.SimpleText := oNode.Text;
       end;

12 - RenameFile('Oldname', 'Newname'); 
      CopyFile(PChar('Oldname'), PChar('Newname'), False); 
      MoveFile(PChar('Oldname'), PChar('Newname'));

13 - procedure Copy(FromFile,ToFile:string);
       var FF,TF:TFileStream;
      begin
      FF:=TFileStream.Create(FromFile,fmOpenRead or fmShareDenyNone);
      FT:=TFileStream.Create(ToFile,fmCreate or fmShareExclusive);
      try
        try
          FT.CopyFrom(FF,0);
        except
           ShowMessage('Error copying: '+FromFile);
        end;
     finally
       FT.Free;
       FF.Free;
     end;
     end;

14 - ImageList1.GetBitmap(3,BitBtn1.Glyph);

15 - var
         Wnd: HWND;
         WinCaptionEx: array[0..MAX_PATH] of Char;
      begin
         Wnd := GetForeGroundWindow;
         GetWindowText(Wnd, WinCaptionEx, SizeOf(WinCaptionEx));
         Edit1.Text := WinCaptionEx;
      end;

16 - Edit1.Text := DateToStr(Now);

17 - program Project1;

       uses
       Forms,
       windows,
       Unit1 in 'Unit1.pas' {Form1};

       {$R *.RES}

       const
       ProgName = 'Stop Internet Popup';  //mettete qui la proprietà caption del form principale da controllare
       var
         MyProg: THandle;
       begin
         Myprog := FindWindow('TApplication', pchar(ProgName));
         If MyProg <> 0 Then
       begin
         Application.MessageBox('Non puoi avviare un programma che è già attivo.... :(', ProgName, 0);
         Application.Terminate;
       end;
         Application.Initialize;
         Application.CreateForm(TForm1, Form1);
         Application.Run;
       end.

18 - procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
                                                            Shift: TShiftState; X, Y: Integer);
      begin
        ReleaseCapture;
        Perform(WM_SYSCOMMAND,$f012,0);
      end;

19 - procedure RemoveCaption(AForm :TForm);
       var
         FDiff: integer;
       begin
         FDiff:=GetSystemMetrics(SM_CYCAPTION);
         SetWindowLong(AForm.Handle,GWL_STYLE,GetWindowLong(AForm.Handle,GWL_Style) and not WS_Caption);
         AForm.Height:=AForm.Height-FDiff;
       end;

      procedure TForm1.FormCreate(Sender: TObject);
      begin
        RemoveCaption(Self);
      end;

20 - Button1.Perform(WM_LBUTTONDOWN, 0, 0);
       Button1.Perform(WM_LBUTTONUP, 0, 0);

21 - procedure AddColoredLine(ARichEdit: TRichEdit; AText: string; AColor: TColor); 
      begin
        with ARichEdit do
          begin
            SelStart := Length(Text);
            SelAttributes.Color := AColor;
            SelAttributes.Size := 8;
            SelAttributes.Name := 'MS Sans Serif';
            Lines.Add(AText);
          end;
       end;

       procedure TForm1.Button1Click(Sender: TObject);
       begin
         AddColoredLine(RichEdit1, 'Hallo', clRed);
         AddColoredLine(RichEdit1, 'Hallo', clGreen);
       end;

22 - function IsActiveDeskTopOn: Boolean;
       var
         h: HWND;
       begin
          h := FindWindow('Progman', nil);
          h := FindWindowEx(h, 0, 'SHELLDLL_DefView', nil);
          h := FindWindowEx(h, 0, 'Internet Explorer_Server', nil);
          Result := h <> 0;
       end;

23 - function GetWindowsLanguage: string;
      var
        WinLanguage: array [0..50] of char;
      begin
      VerLanguageName(GetSystemDefaultLangID, WinLanguage, 50);
      Result := StrPas(WinLanguage);
      end;

     procedure TForm1.Button1Click(Sender: TObject);
     begin
     ShowMessage(GetWindowsLanguage);
     end;

24 - Procedura API:
      SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, 1, nil, 0); {Abilita}
      SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, 0, nil, 0); {Disabilita}
      Nota: questa operazione viene applicata a tutte le finestre dei vari programmi installati sul PC

25 - procedure TForm1.FormCreate(Sender: TObject); 
       begin 
          AddFontResource(PChar(ExtractFilePath(ParamStr(0) + 'YourFont.TTF'))); 
          SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0); 
       end; 

       procedure TForm1.FormDestroy(Sender: TObject); 
       begin 
         RemoveFontResource(PChar(ExtractFilePath(ParamStr(0) + 'YourFont.TTF'))); 
         SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0); 
       end; 

26 - function RegisterServer(const aDllFileName: string; aRegister: Boolean): Boolean; 
      type 
     TRegProc = function: HResult; 
     stdcall; 
     const 
     cRegFuncNameArr: array [Boolean] of PChar = 
     ('DllUnregisterServer', 'DllRegisterServer'); 
     var 
     vLibHandle: THandle; 
     vRegProc: TRegProc; 
     begin 
     Result := False; 
     vLibHandle := LoadLibrary(PChar(aDllFileName)); 
     if vLibHandle = 0 then Exit; 
     @vRegProc := GetProcAddress(vLibHandle, cRegFuncNameArr[aRegister]); 
     if @vRegProc <> nil then 
     Result := vRegProc = S_OK; 
     FreeLibrary(vLibHandle); 
     end; 

    procedure TForm1.Button1Click(Sender: TObject);
    begin
      RegisterServer('percorso della vostra DLL', true); //come registrare
    end;

    procedure TForm1.Button2Click(Sender: TObject);
    begin
      RegisterServer('percorso della vostra DLL', false);  //come non registrare
    end;

27 - Prima di tutto dovete registrare il vostro programma nel regedit in modo tale
che cliccando col tasto dx in explorer su una cartella il contextmenù mostri una
voce tipo: copia path cartella .... Quindi associare all'evento OnCreate del vostro
Form il seguente codice:

 if ParamStr(1) <> '' then
Label1.Caption := ShortToLongPath(ParamStr(1));

28 - uses ShellApi;

function CopyDir(const fromDir, toDir: string): Boolean;
var
fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos do
begin
wFunc := FO_COPY;
fFlags := FOF_FILESONLY;
pFrom := PChar(fromDir + #0);
pTo := PChar(toDir)
end;
Result := (0 = ShFileOperation(fos));
end;

Esempio 1:

CopyDir('C:\lavori', 'F:\lavori');

Esempio 2:

if CopyDir('C:\lavori', 'F:\lavori') = True  then
ShowMessage('Directory copiata.');

29 - Ecco la funzione:

function TColorToHTML(Color: TColor): String;
begin
Result := '#' + IntToHex(GetRValue(Color), 2) + IntToHex(GetGValue(Color), 2) + IntToHex(GetBValue(Color), 2);
end;

30 - Ecco la funzione:

function HTMLToTColor(sColor: string): TColor;
begin
if (Length(sColor) > 0) and (sColor[1] = '#') then
Delete(sColor, 1, 1);
Result := RGB(StrToInt('$'+Copy(sColor, 1, 2)), StrToInt('$'+Copy(sColor, 3, 2)), StrToInt('$'+Copy(sColor, 5, 2)));
end;

31 - Ecco la funzione:

uses ShellApi;

function IsTaskbarAutoHideOn : Boolean;
var
ABData : TAppBarData;
begin
ABData.cbSize := SizeOf (ABData);
result := (SHAppBarMessage (ABM_GETSTATE, ABData) and ABS_AUTOHIDE) > 0
end;

32 - Ecco la soluzione:

var
Attr: integer;
begin
Attr := FileGetAttr(FileName);
Attr := Attr and (not faReadOnly);
FileSetAttr(FileName, Attr);
DeleteFile(FileName);
end;

33 - Ecco la soluzione:

DefWindowProc(Form1.Handle,WM_SYSCOMMAND,SC_SCREENSAVE,0);

34 - Ecco la soluzione:

uses
  ComObj, ShlObj, ActiveX;

function IsActiveDesktopEnable: Boolean;
const
  CLSID_ActiveDesktop: TGUID = '{75048700-EF1F-11D0-9888-006097DEACF9}';
var
  ActiveDesk: IActiveDesktop;
  ComponentsOpt: TComponentsOpt;
  hr: HRESULT;
  dwReserved: DWORD;
begin
  ZeroMemory(@ComponentsOpt, SizeOf(TComponentsOpt));
  ComponentsOpt.dwSize := SizeOf(TComponentsOpt);
  hr := CoCreateInstance(CLSID_ActiveDesktop, nil, CLSCTX_INPROC_SERVER,
    CLSID_ActiveDesktop, ActiveDesk);
  if SUCCEEDED(hr) then
  begin
    hr := ActiveDesk.GetDesktopItemOptions(ComponentsOpt, dwReserved);
  end;
  Result := ComponentsOpt.fActiveDesktop;
end;

35 - Ecco la soluzione:

procedure TForm1.Button1Click(Sender: TObject);
var
 hTaskBar, hButton : HWND;
 hDCScreen : HDC;
 ScreenHeight : DWORD;
begin
  //find "Start" button
  hDCScreen := GetDC(0);
  ScreenHeight :=GetDeviceCaps(hDCScreen,VERTRES);
  ReleaseDC(0, hDCScreen);
  hTaskBar := FindWindow('Shell_TrayWnd', nil);
  hButton := GetWindow(hTaskBar, GW_CHILD);

  SendMessage(hButton, WM_LBUTTONDOWN,MK_LBUTTON,LOWORD(5)+
    HIWORD(ScreenHeight-20));
end;

36 - Ecco la soluzione:

procedure TForm1.Button1Click(Sender: TObject);
var
  number: integer;
begin
  number := GetSysTemMetrics(SM_CLEANBOOT);
  case number of
  0: ShowMessage('Il PC è in Normal Boot - Modalità normale');
  1: ShowMessage('Il PC è in Safe Boot - Modalità provvisoria');
  2: ShowMessage('Il PC è in Modalità provvisoria con prompt di rete');
  end;
end;

37 - Ecco la soluzione: (ricordarsi di mettere il codice nell' evento 'OnPaint' del form)


procedure TForm1.FormPaint(Sender: TObject);
var
  Row, Ht: Word;
begin
  Ht:=(ClientHeight+255) div 256;
  for Row:=0 to 255 do
    with Canvas do 
    begin
      Brush.Color:=RGB(Row,0,0);
      FillRect(Rect(0,Row*Ht,ClientWidth,(Row+1)*Ht));
    end;
end;

38 - Ecco la soluzione: (ricordarsi di mettere in uses la unit FileCTRL)

const
  sPath = 'C:\WINDOWS\system32\Restore\srdiag.exe';

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(MinimizeName(sPath, Form1.Canvas, 200));
end;

39 - Ecco la soluzione: (ricordarsi di mettere in uses la unit FileCTRL)

procedure TForm1.Button1Click(Sender: TObject);
var
  Dir: string;
begin
  Dir := 'C:\Windows\1dir\2dir';
  ForceDirectories(Dir);
if DirectoryExists(Dir) then
  ShowMessage(Dir + ' creata correttamente');
end;

40 - Ecco la soluzione: (ricordarsi di mettere in uses la unit DateUtils)

function NumeroGiorni(d:TDateTime):integer;
begin
  Result := DaysBetween(StartOfTheYear(d)-1, d);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage('Giorni passati dalla data scelta: '+IntToStr(NumeroGiorni(DateTimePicker1.DateTime)));
end;

41 - Ecco la soluzione:

procedure DisableTaskMgr(bTF: Boolean);
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_CURRENT_USER;
  reg.OpenKey('Software', True);
  reg.OpenKey('Microsoft', True);
  reg.OpenKey('Windows', True);
  reg.OpenKey('CurrentVersion', True);
  reg.OpenKey('Policies', True);
  reg.OpenKey('System', True);
  if bTF = True then
  begin
    reg.WriteString('DisableTaskMgr', '1');
  end
  else if bTF = False then
  begin
    reg.DeleteValue('DisableTaskMgr');
  end;
  reg.CloseKey;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  DisableTaskMgr(True);
end;

42 - Ecco la soluzione: (ricordarsi di mettere in uses la unit UrlMon)

function DownloadFile(Source, Dest: string): Boolean;
begin
  try
    Result := UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) = 0;
  except
    Result := False;
  end;
end;

Esempio:

procedure TForm1.Button1Click(Sender: TObject);
begin
  if DownloadFile ('http://www.ansa.it', 'c:\index.html') then
     ShowMessage('Download eseguito con successo!')
  else
     ShowMessage('Download non eseguito!')
end;

43 - Ecco la soluzione: (ricordarsi di mettere in uses la unit DDEMan)

function GetURL(Service: string): string;
var
  ClDDE: TDDEClientConv;
  temp: PChar;
begin
  Result := '';
  ClDDE := TDDEClientConv.Create(nil);
  with ClDDE do
  begin
    SetLink(Service, 'WWW_GetWindowInfo');
    temp := RequestData('0xFFFFFFFF');
    Result := StrPas(temp);
    StrDispose(temp);
    CloseLink;
  end;
  ClDDE.Free;
end;

Esempio:

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(GetURL('IExplore'));
  { ShowMessage(GetURL('Netscape')); }
  { ShowMessage(GetURL('Firefox')); }
end;

44 - Ecco la soluzione:

function IsWinVISTA: Boolean;
begin
Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and
(Win32MajorVersion = 6) and (Win32MinorVersion = 0);
end;

if IsWinVISTA = True then Beep;

45 - Ecco la soluzione:

function IsWin7: Boolean;
begin
Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and
(Win32MajorVersion = 6) and (Win32MinorVersion = 1);
end;

if IsWin7 = True then Beep;

46 - Ecco la soluzione:

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
begin
  for i := ListBox1.Items.Count - 1 downto 0 do
    if ListBox1.Selected[i] then
      ListBox1.Items.Delete(i);
end;