Ez az amit keresek:


Röviden az oladal tartalmából:
  1. Delphi programok paraméteres indítása:
  2. Csak egyszer futhat a program:
  3. Csak egyszer futhat a program II.:
  4. Csatlakozva van a gép az Internetre?
  5. DDE adatátvitel
  6. Az URL megállapítása egy *.url fájlból:
  7. A Windows könyvtár megállapítása:
  8. Kivágás, Másolás, Beillesztés (Cut, Copy, Paste):
  9. Visszavonás (Undo):
  10. Kisbetü-nagybetü:
  11. Minden szó első betűjének nagybetűvé alakítása (angol):
  12. A Ctrl+Alt+Del, az Alt+Tab és a Ctrl+Esc billentyűkombinációk letiltása:
  13. Ctrl+Alt+Del letiltása II.:
  14. A Caps Lock, Num Lock, Scroll Lock használata:
  15. A Caps Lock, Num Lock, Scroll Lock használata II. (StatusBar-nál):
  16. Arab szám átalakítása római számmá
  17. Szám kiírása szöveggel (magyar):
  18. Parancsikon hozzáadása a StartMenühöz/Asztalhoz:
  19. A Form minimális és maximális méretének meghatározása:
  20. Az alkalmazás ikon-állapotban tartása:
  21. Ikon átalakítása Bitmappá:
  22. Clipboardról jpg-be:
  23. Desktop az image-ba:
  24. A Form tartalmának vágólapra másolása:
  25. A Form(ok) automatikus képernyő-felbontáshoz arányosítása:
  26. Az aktuális képernyőfelbontás megállapítása
  27. A futó program ikonjának eltüntetése a tálcáról (Taskbarról) + vissza:
  28. A gépben található meghajtók fajtája:
  29. A CD meghajtó ajtajának kinyitása és bezárása:
  30. Audio CD van a meghajtóban vagy nem?
  31. C meghajtó get-set:
  32. A globális változók egyszerűbb kezelése:
  33. A hosszú fájlnév átalakítása rövid fájlnévvé (és vissza):
  34. A kurzorvezérlő billentyűk (nyilak) használata:
  35. A monitor energiatakarékos üzemmódba helyezése:
  36. A merevlemez sorozatszámának megállapítása:
  37. Processzor aktuális sebessége:
  38. A program EXE könyvtárának megállapítása:
  39. Be van kapcsolva a Tálca automatikus elrejtés tulajdonsága?:
  40. A tálca (Taskbar) elrejtése és visszahozása Delphi programból
  41. A Start! gomb elrejtése a tálcáról:
  42. A Start! gomb letiltása és visszaállítása:
  43. Drag and Drop technika DBGridben:
  44. Drag & Drop használata Win95/98 Intézővel:
  45. Dátumok érvényességének vizsgálata:
  46. A Vezérlőpult (Control Panel) Dátum és idő, ill. Időzóna oldalának meghívása:
  47. A Vezérlőpult különböző párbeszédpaneljeinek megnyitása:
  48. A számítógép dátumának és idejének beállítása:
  49. A Windows és a rendszer újraindítása:
  50. Automatikus indítás:
  51. Van-e kislemez az A meghajtóban?:
  52. Van-e kislemez az A meghajtóban? II.:
  53. Az A:\ meghajtóban lévő lemez formázása:
  54. Az alkalmazás ikonjának megváltoztatása futásidőben:
  55. Animált kurzorok használata:
  56. A színek HTML értékének megállapítása:
  57. Az asztal hátterének megváltoztatása Delphi programból:
  58. WinRar használata:
  59. Notebook akkumulator:
  60. Applikáció aktivitásának figyelése:
  61. Menüpontok dinamikus létrehozása/törlése futásidőben:
  62. <ENTER> használata <TAB> helyett:
  63. Sérült vagy hiányzó DBase indexállomány (MDX) kijavítása:
  64. Directory keresése:
  65. Windows select directory használata:
  66. Windows,Temp,System könyvtár megállapítása:
  67. Windows fontok listája:
  68. Webböngészők címsorának kiolvasása:
  69. *.Wav file lejátszása:
  70. Üzenetküldés és fogadás más Applikációba:
  71. Utolsó hozzáférés:
  72. Új directory:
  73. Több soros Hint (gyorstipp):
  74. Külön szál, avagy független procedura:
  75. Tálcaikon eltüntetés:
  76. Applikáció tálcaikon nélkül:
  77. Tálcaeltüntetés:
  78. Színátmenetes Form létrehozása:
  79. Színes cellák a DBGrid-ben:
  80. Egy meghajtó teljes méretének és a szabad lemezterületnek a megállapítása:
  81. Tetszőleges (2-32) számrendszerbe átváltó program:
  82. Egérrel való klikkelés imitálása:
  83. Egy fájl tulajdonságainak megjelenítése (Fájlinformációs lap):
  84. Egy egyszerű szöveg-titkosító rutin:
  85. Egy könyvtár teljes méretének megállapítása:
  86. Egy StringGrid tartalmának elmentése és betöltése:
  87. Egymásba ágyazott könyvtárak létrehozása:
  88. EXE-ből az Icon kinyerése:
  89. EXECUTE hozzárendelés nélkül:
  90. Exe program futtatása, és várása a befejezéséig:
  91. InternetExplorer toolbar:
  92. Fájl dátuma:
  93. Fájlok másolása delphi programból:
  94. Fájlok törlése a Lomtárba:
  95. Fájlok attributuma:
  96. Form elrejtése már a létrehozásakor:
  97. Form tartalmának méretarányosítása:
  98. Formra file húzás:
  99. Futó alkalmazások, és kilövésük:
  100. Gombokból álló tömb (array of TButton):
  101. A hangerő állítása (Wave out, Line in, Midi):
  102. TASK LIST -ből eltüntetés:
  103. HOTKEY:
  104. Hozzárendelés lekérése:
  105. A Windows TEMP (ideiglenes) könyvtárának megállapítása:
  106. Időpontok kivonása:
  107. Image a Desktopra:
  108. Inaktív bezárásbomb:
  109. *.ini -fájlok használata:
  110. Internetes hivatkozás (Link) létrehozása:
  111. Internet kapcsolat figyelése:
  112. JPEG fájl beágyazása a programba (EXE-be):
  113. KEDVENCEK mappa kinyerése:
  114. Kép hozzáadása a menüpontokhoz:
  115. Monitor felbontás állítása:
  116. Az aktuális képernyőfelbontás megállapítása:
  117. Kisbetü-nagybetü:
  118. Komplett directory törlése:
  119. A könytárválasztó párbeszédablak használata:
  120. Könyvtárak másolása és áthelyezése:
  121. Kör alakú ablak:
  122. Kör alakú, lyukas Form egyéni fejléccel:
  123. Mandelbrot halmaz:
  124. Meghajtók típusa:
  125. Az alkalmazás memória-felhasználásának csökkentése:
  126. Monitor ki-bekapcsolása:
  127. MPEG videó lejátszása:
  128. Milyen szinü a nyíl alatti pixel?:
  129. Óra beállítása:
  130. Kicsi EXE:
  131. PostMessage utasítás:
  132. Program indítása programból:
  133. Progressbar szinének megváltoztatása:
  134. Rajzolás közvetlenül a Windows Asztalra:
  135. Saját applikáció directory-ja:
  136. Saját kiterjesztésü fájlok:
  137. A Shift, Ctrl és Alt billentyűk állapotának 'elkapása' menüparancsok esetén:
  138. Startgomb eltüntetése:
  139. A form mindig legfölül:
  140. String hozzáférés assemblerben:
  141. String átküldése másik Applikációba:
  142. Menü hozzárendelése a SysTray ikonhoz:
  143. System Tray alkalmazás elkészítése:
  144. A StartMenü elérési útjának megállapítása:
Ha van valami jó ötletetek, programotok, itt leírhatjátok...
További programok várhatóak...
A következő függvény visszaadja a StartMenü könyvtárának elérési útját: uses Windows, ShlObj;
function GetStartMenuPath: string;
var P : PItemIDList;
 C : array[0..Max_Path]of Char;
begin
 SHGetSpecialFolderLocation(hInstance, csidl_StartMenu, P);
 SHGetPathFromIDList(P, @C);
 GetStartMenuPath:=C;
end;

Ha egy fájl társítva van valamely programhoz, akkor a fájlra történő dupla kattintás hatására
elindul a program, és (többnyire) automatikusan betölti az adott fájlt. Hasonló helyzet áll elő,
ha a program EXE-jére dobunk rá egy vagy több fájlt. Ezt úgy oldja meg a Windows, hogy paraméterként
átadja a társított programnak a kiválasztott fájl(ok) elérési útját.
A parancssori paraméterek kezelése a Delphi System unitjának két alábbi függvényével oldható meg:
function ParamCount: Word; - visszaadja a programnak a parancssorban átadott paraméterek
számát.function ParamStr(Index): string; - visszaadja az adott helyen lévő paraméter
értékét. (A ParamStr(0) pedig a program teljes elérési utjával tér vissza.)

A lenti eljárás, ha a programot paraméterekkel indítottuk, az átadott paramétereket egy ListBox
soraiba tölti, ha pedig nem adtunk át paramétert, akkor a 'Nincs paraméter.' szövegű
üzenettel tér vissza.

procedure TForm1.FormCreate(Sender: TObject);
var
   I: Word;
begin
   if ParamCount > 0 then
     for I := 1 to ParamCount do
   begin
     ListBox1.Items.Add(ParamStr(I));
   end
   else ShowMessage('Nincs paraméter.')
end;
Ha kétszer elindítom ugyanazt az applikációt, akkor a progi másodszorra kikapcsolja magát:

   private
   atlanta:atom
. . .

procedure TForm1.FormCreate(Sender: TObject);
begin
  if globalfindatom('kulcs')=0 then atlanta:=globaladdatom('kulcs')
   else
  begin
    showmessage('Ehh... ezt a programot csak egyszer indíthatod el!');
    application.Terminate;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  globaldeleteatom(atlanta);
end;

Megjegyzés:
A példa akkor a legszebb, ha a "Form elrejtése már a létrehozásakor" példával együtt alkalmazzuk.

Ha kétszer elindítom ugyanazt az applikációt, akkor a progi másodszorra kikapcsolja magát, és
előtérbe hozza a már megnyitott másik ugyanolyan applikációt:

uses Messages,WinProcs

. . .

var HWND:THandle;

begin
   HWND:=FindWindow('TForm1','atlanta'); // form1.caption -ja "atlanta" !!
   if HWND=0 then
   begin
     Application.Initialize;
     Application.CreateForm(TForm1, Form1);
     Application.Run;
   end
   else
   begin
     winprocs.SetForegroundWindow(HWND);
   end;
end.

Megjegyzés:
A form1 caption-ja legyen "atlanta" mert a "atlanta" fejlécü applikációt keresi a program.
  1. Hogy megtudjuk, hogy csatlakozva van-e a gép az Internetre használhatjuk a TCP komponenst,
    amelynek segítségével megkapjuk a helyi IP címet. Ha ennek értéke "0.0.0.0",
    akkor nincs kapcsolat, ha más, akkor van.

    procedure TForm1.Button1Click(Sender: TObject);
    begin
       if TCP1.LocalIp = '0.0.0.0' then
         ShowMessage('Nincs kapcsolat!');
    end;

  2. Egy másik megoldás:

    uses wininet.pas

    function IsConnectedToInternet: bool;
    begin
       dwConnectionTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_PROXY;
       if InternetGetConnectedState(@dwConnectionTypes, 0) then
         Result := True
       else
         Result := False;
    end;
Két progi így komunikálhat egymással legegyszerűbben

  1. Az egyik applikáció: server (server.exe <-- befordítva)

    procedure TForm1.FormCreate(Sender: TObject);
    begin
      ddeserveritem1.ServerConv:=ddeserverconv1;
    end;

    procedure TForm1.Edit1Change(Sender: TObject);
    begin
      ddeserveritem1.Text:=edit1.Text;
    end;

    procedure TForm1.DdeServerItem1PokeData(Sender: TObject);
    begin
      edit1.Text:=ddeserveritem1.Text;
    end;
  2. A másik applikáció: kliens

    procedure TForm1.FormCreate(Sender: TObject);
    begin
      ddeclientconv1.FormatChars:=true;
      ddeclientconv1.ConnectMode:=ddemanual;
      ddeclientitem1.DdeConv:=ddeclientconv1;
      ddeclientitem1.DdeItem:='DdeServerItem1'; //<fontos a kisbetü/nagybetü!!!!!
      ddeclientconv1.ConnectMode:=ddeautomatic;
      ddeclientconv1.SetLink('server','ddeserverconv1');
    end;
    ahol "server" a másik applikáció neve (server.exe)

    procedure TForm1.Edit1Change(Sender: TObject);
    begin
      ddeclientconv1.PokeData('ddeserveritem1',pchar(edit1.text));
    end;

    procedure TForm1.DdeClientItem1Change(Sender: TObject);
    begin
      edit1.Text:=ddeclientitem1.Text;
    end;

Megjegyzés:
A dde adatátvitel egy kényes dolog, na meg idegölő is. Legtöbb esetben maga a Delphi is bezavar,
vagyis akkor működik rendesen, ha már nem felügyeli a Delphi. Legalábbis nálam.
A server nevü applikációt ha elindítjuk, akkor az magától elindítja a server applikációt is,
feltéve, hogy még nem volt elindítva, és egy ugyanabban a mappában legyen.
  1. Az első progi befordítva: server.exe
  2. A második proggi: Project1.exe (itt nem számít a név)
Az alábbi függvény visszaadja a FileName paraméterben megadott *.url fájlban tárolt URL-t:

function ResolveInternetShortcut(Filename: string): PChar;
var
   FName: array[0..MAX_PATH] of WideChar;
   Malloc: IMalloc;
   IUrl: IUniformResourceLocator;
   PersistFile: IPersistfile;
begin
   IUrl := CreateComObject(CLSID_InternetShortcut) as IUniformResourceLocator;
   Persistfile := IUrl as IPersistFile;
   StringToWideChar(FileName, FName, MAX_PATH);
   PersistFile.Load(Fname, STGM_READ);
   IUrl.geturl(@Result);
   ShGetMalloc(Malloc);
   Malloc.Free(@Result);
end;
A Windows könyvtár helyét a GetWindowsDirectory függvénnyel tudjuk megállapítani.
(Ennek a függvénynek a DOS-os megfelelője a GetWindowsDir,
amelyet azonban nem használhatunk windowsos alkalmazásban.)
Az alábbi függvény visszaadja a Windows könyvtár helyét (elérési útját):

functionFindWindowsDir : string;
var
   pWindowsDir : array [0..255] of Char;
   sWindowsDir : string;
begin
    GetWindowsDirectory (pWindowsDir, 255);
    sWindowsDir := StrPas (pWindowsDir);
    Result := sWindowsDir ;
end;

  1. Ha csak egyes, adatokkal rendelkező komponensekre használjuk,

    2. akkor a vágólapkezelés legegyszerűbb módja, a CopyToClipboard,
    CutToClipboard and PasteFromClipboard     eljárások használata. Például így:

    procedure TForm1.Button1Click(Sender: TObject);
    begin
         Memo1.CopyToClipboard //PasteFomClipboard
    end;

  2. De ha belegondolunk, hogy egy Form-on számtalan komponens lehet,

    3. és mondjuk egy menüből akarjuk meghívni a vágólap eljárásokat,
    akkor elég nagy munkába tellik, amíg meghatározzuk, hogy mikor melyik komponens
    tartalmát másolja a vágólapra. Ha ilyen esetben az éppen fókusszal rendelkező
    komponens tartalmát adjuk meg másolandónak és az adott komponens nem rendelkezik
    CopyToClipboard eljárrással, akkor a program futásában hiba áll be az eljárás
    meghívásakor. Szerencsére van egy nagyon egyszerű megoldása a bonyolultnak tűnő problémára:
    Egyszerűen egy WM_CUT, WM_COPY illetve WM_PASTE üzenetet kell
    küldeni az alkalmazásnak az alábbiak szerint és az majd eldönti,
    hogy melyik a fókusszal rendelkező komponens, ha pedig az adott komponensnek nincsen
    CopyToClipboard eljárása, akkor egyszerűen mellőzi azt. Nem okoz hibát a program futásában.

    procedure TfrmMain.CopyClick(Sender: TObject);
    begin
        SendMessage(ActiveControl.Handle, WM_COPY, 0, 0);
    end;

    procedure TfrmMain.PasteClick(Sender: TObject);
    begin
        SendMessage(ActiveControl.Handle, WM_PASTE, 0, 0);
    end;

    procedure TfrmMain.CutClick(Sender: TObject);
    begin
        SendMessage(ActiveControl.Handle, WM_CUT, 0, 0);
    end;
    {!!! MDI alkalmazásoknál az 'ActiveControl.Handle'-t le kell cserélni 'ActiveMDIChild.ActiveControl.Handle'-re !!!}
A legutóbbi utasítások visszavonása (Undo) hasonlóan egyszerű feladat,
mint a Kivágás, Másolás vagy a Beillesztés (Cut, Copy, Paste) utasítások.
Az egyetlen többletmunkát az jelenti, hogy a parancs kiadása előtt meg kell vizsgálni,
hogy van-e egyáltalán visszavonható utasítás.

  1. A visszavonás (Undo) parancs kiadását az alábbi kódnak a kívánt kontroll

    2. (pl. Szerkesztés/Visszavonás menüpont) OnClick eseményéhez való hozzárendelésével tudjuk elérni:

    procedure TForm.mniUndoClick(Sender: TObject);
    begin
        SendMessage(ActiveControl.Handle, EM_Undo, 0, 0);
    end;

  2. Ahhoz, hogy például a Szerkesztés menü Visszavonás menüpontját letiltsuk

    3. illetve újra engedélyezzük attól függően, hogy van-e visszavonható utasítás,
    az alábbi kódot kell a Szerkesztés menü OnClick eseményéhez rendelni.
    A WinAPI üzenet a menü legördülése előtt megvizsgálja, hogy van-e visszavonható parancs.

    procedure TForm.mnuEditClick(Sender: TObject);
    begin
       {Mielőtt a menü legördül letiltja illetve engedélyezi a visszavonás menupontot.}
      mniUndo.Enabled := SendMessage(ActiveControl.Handle,EM_CanUndo, 0, 0);
    end;

  string:= lowercase('AtlantA');
Megjegyzés: A string értéke "atlanta" lesz, kisbetűvel, illetve nagybetű lesz, ha a "lowercase" helyett "uppercase"-t használsz.

Az alábbi függvény a megadott sztring minden szavavának első betűjét
nagybetűvé alakítja (a szó további részét pedig kisbetűssé teszi).

function CapitalizeFirst(s:string):string;
var t:string;
   i:integer;
   newWord:boolean;
begin
  if s='' then exit;
  s:=lowercase(s);
  t:=uppercase(s);
  newWord:=true;
  for i:=1 to length(s) do
     begin
       if newWord and (s[i] in ['a'..'z']) then
         begin s[i]:=t[i];
           newWord:=false;
           continue;
         end;
      if s[i] in ['a'..'z',''''] then continue;
       newWord:=true;
     end;
  result:=s;
end;

  1. Az összes rendszer billentyűkombináció letiltása és vissszakapcsolása (Meik Weber):

    procedure TurnSysKeysOff; //Kikapcsolja
    var OldVal : LongInt;
    begin
       SystemParametersInfo (97, Word (True), @OldVal, 0)
    end;

    procedure TurnSysKeysBackOn; //Bekapcsolja
    var OldVal : LongInt;
    begin
       SystemParametersInfo (97, Word (False), @OldVal, 0)
    end;


  2. Egy másik megoldás (Richard Leigh):

    procedure TurnSysKeysOff; //Kikapcsolja
    var Dummy:integer;
    begin
       Dummy:=0;
       SystemParametersInfo( SPI_SCREENSAVERRUNNING, 1, @Dummy, 0);
    end;

    procedure TurnSysKeysOn; //Bekapcsolja
    var Dummy:integer;
    begin
       Dummy:=0;
       SystemParametersInfo( SPI_SCREENSAVERRUNNING, 0, @Dummy, 0);
    end;
Egy újabb technológia, amivel a kedves felhasználó melegebb éghajlatra küld,
pláne, ha lefagyott az applikációd egészképernyősként (a tálca sem látszódott)

procedure...//ide mármit írhatsz
var
   a:longint;
begin
   systemparametersinfo(97,word(true),@a,0);
end;

Megjegyzés:
Ahogy elnézem a dolgot, ez egy tipikus win9x megoldás, a w2000 már
inteligensebb egy ilyen trükknél.
Ez az eljárás a gomb megnyomására bekapcsolja a Caps Lock (nagybetűs) módot, majd ismételt
megnyomására kikapcsolja azt.

procedure TForm1.Button1Click(Sender: TObject);
Var KeyState : TKeyboardState;
begin
   GetKeyboardState(KeyState);
   if (KeyState[VK_CAPITAL] = 0) then
     KeyState[VK_CAPITAL] := 1 // Bekapcsolja a Caps Lockot
   else
     KeyState[VK_CAPITAL] := 0; //Kikapcsolja a Caps Lockot
     SetKeyboardState(KeyState);
end;

A Num Lock és a Scoll Lock ki- és bekapcsolása ugyanezzel az eljárással oldható meg csak a
VK_CAPITAL helyére VK_NUMLOCK kerül illetve a VK_SCROLL kerül.
procedure TForm1.CheckCapslock;
begin
   if Odd (GetKeyState (VK_CAPITAL)) then
     StatusBar1.Panels[1].Text := 'Caps'  //Caps szöveget ír az első cellába
   else
     StatusBar1.Panels[1].Text := '';  //semmit ír az első cellába
end;

procedure Tform1.Numlock;

begin
  if Odd (GetKeyState (VK_NUMLOCK)) then
     StatusBar1.Panels[2].Text := 'Num'  //Num szöveget ír a második cellába
  else
     StatusBar1.Panels[2].Text := '';  //semmis sem ír a második cellába
end;

procedure tform1.Insert;
begin
   if Odd (GetKeyState (VK_INSERT)) then cellába
     StatusBar1.Panels[3].Text := 'Ins'
  // Ins szöveget ír a harmadik    else
     StatusBar1.Panels[3].Text := 'Ovr';  //Ovr szöveget ír a harmadik cellába
end;

A Timer - be be kell írni a következőket, különben nem frissíti a kiírást:

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  CheckCapslock;
  Numlock;
  Insert;
end;
Az alábbi függvény a megadott arab számot római számmá alakítja:

function TfrmMain.IntToRome(Number:integer): string;
var
   R1, R2, R3: char;
   S: string[4];
   I: integer;
begin
   if (Number > 0) and (Number < 4000) then
     begin
       Result := '';
       S := IntToStr(Number);
       while length(S) < 4 do S := '0'+S;
       I := 1;
       R1 := '*'; R2 := '*'; R3 := '*';
       while I <= length(S) do
         begin
           if I = 1 then
            begin
              R1 := 'M'; R2 := '*'; R3 := '*';
             end;
           if I = 2 then
            begin
               R1 := 'C'; R2 := 'D'; R3 := 'M';
            end;
           if I = 3 then
             begin
               R1 := 'X'; R2 := 'L'; R3 := 'C';
             end;
           if I = 4 then
            begin
              R1 := 'I'; R2 := 'V'; R3 := 'X';
             end;
             case StrToInt(S[I]) of
               1 : Result := Result+R1;
               2 : Result := Result+R1+R1;
               3 : Result := Result+R1+R1+R1;
               4 : Result := Result+R1+R2;
               5 : Result := Result+R2;
               6 : Result := Result+R2+R1;
               7 : Result := Result+R2+R1+R1;
               8 : Result := Result+R2+R1+R1+R1;
               9 : Result := Result+R1+R3;
             end;
             inc(I);
     end;
   end
   else Result := '';
end;
Az alábbi függvény szöveggé alakítja a megadott számot:

function TfrmMain.IntToHunAlpha(Number: longint): string;
const
Ones: array[0..9] of string[10] = ('', 'egy', 'kettő', 'három', 'négy', 'öt', 'hat', 'hét', 'nyolc', 'kilenc');
Tens: array[0..9] of string[10] = ('', 'tíz', 'húsz', 'harminc', 'negyven', 'ötven', 'hatvan', 'hetven', 'nyolcvan', 'kilencven');
var
   Num: string;
   Group: string[3];
   X,Y,Z: integer;
   PN: longint;
   First: string[1];
function ToThousand(Group: string): string;
var
   Space: string[3];
begin
   Result := '';
   Space := ' ';
   insert(Group, Space, 4 - length(Group));
   Group := Space;
   if Group[1] <> ' ' then if Group[1] <> '0' then
   Result := Ones[StrToInt(Group[1])] + 'száz';
   if Group[2] <> ' ' then if Group[2] <> '0' then
   begin
     case StrToInt(Group[2]) of
       1: if Group[3] <> '0' then Result := Result + 'tizen'
       else Result := Result + 'tíz';
       2: if Group[3] <> '0' then Result := Result + 'huszon'
       else Result := Result + 'húsz';
       else Result := Result + Tens[StrToInt(Group[2])];
     end;
   end;
   Result := Result + Ones[StrToInt(Group[3])];
end;
begin
   PN := Abs(Number);
   if Number = 0 then Result := 'Nulla'
   else
     begin
       Result := '';
       X := 0;
       Num := IntToStr(PN);
       while X * 3 < length(Num) do
         begin
         Y := length(Num) + 1- (X + 1) * 3;
         Z := 3;
         if Y < 1 then
          begin
           Y := 1;
           Z := length(Num) mod 3;
           if Z = 0 then Z := 3;
          end;
       Group := copy(Num, Y, Z);
       if StrToInt(Group) <> 0 then
         begin
           case X of
           0: Result := ToThousand(Group);
           1: if PN @#62 2000 then Result := ToThousand(Group) + 'ezer-' + Result
           else Result := ToThousand(Group) + 'ezer' + Result;
           2: Result := ToThousand(Group) + 'millió-' +Result;
           3: Result := ToThousand(Group) + 'milliárd-' +Result;
           end;
         end;
       inc(X);
     end;
     if Number < 0 then Result := 'mínusz ' + Result;
       First := AnsiUpperCase(Result[1]);
       Result[1] := First[1];
       if Result[length(Result)] = '-' then
       Result := copy(Result, 1, length(Result) - 1);
     end;
end;
Ez az egyszerű példaprogram bemutatja, hogy hogyan lehet új parancsikont létrehozni
Windows 95/98/NT alatt az Asztalon illetve a StartMenüben.

Egy új alkalmazásban helyezz egy TButton-t (Button1) a Form-ra.
Kattints rá duplán erre a gombra, majd cseréld le az Unit1 kódját az alul található kódra.

Ez a program a gomb megnyomására létrehoz egy új parancsikont az
Asztalon és/vagy a StartMenüben. A parancsikonnak 'FooBar' lesz a neve és megnyitja
az AUTOEXEC.BAT-ot a JEGYZETTÖMB-ben (Notepad), ha meghívják.

(A program a 'Software\MicroSoft\Windows\CurrentVersion\Explorer\Shell Folders')
(HKEY_CURRENT_USER) registry kulcs 'Desktop' és 'Start Menu' értékeit használja.)

{---------------------------}
{ Parancsikon létrehozása }
{---------------------------}

unit Unit1;
interface
uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls;
type
   TForm1 = class(TForm)
     Button1: TButton;
     procedure Button1Click(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
   end;
var
   Form1: TForm1;

implementation

{$R *.DFM}

uses ShlObj, ActiveX, ComObj, Registry;

procedure TForm1.Button1Click(Sender: TObject);
var    MyObject : IUnknown;
   MySLink : IShellLink;
   MyPFile : IPersistFile;
   FileName : String;
   Directory : String;
   WFileName : WideString;
   MyReg : TRegIniFile;
begin
   MyObject := CreateComObject(CLSID_ShellLink);
   MySLink := MyObject as IShellLink;
   MyPFile := MyObject as IPersistFile;
   FileName := 'NOTEPAD.EXE';
   with MySLink do begin
   SetArguments('C:\AUTOEXEC.BAT');
   SetPath(PChar(FileName));
   SetWorkingDirectory(PChar(ExtractFilePath(FileName)));
   end;
   MyReg := TRegIniFile.Create(
   'Software\MicroSoft\Windows\CurrentVersion\Explorer');
// Használd a következő sort, ha az Asztalra akarod a
// parancsikont létrehozni
   Directory := MyReg.ReadString('Shell Folders','Desktop','');
// Használd a következő három sort, ha a StartMenübe akarod
// az új parancsikont létrehozni
// Directory := MyReg.ReadString('Shell Folders','Start Menu','')+
// '\Whoa!';
// CreateDir(Directory);
   WFileName := Directory+'\FooBar.lnk';
   MyPFile.Save(PWChar(WFileName),False);
   MyReg.Free;
end;
end.
Ablakméret beállításakor a Windows küld egy üzenetet, melyben lekérdezi az
általad engedélyezett méreteket. Ha ezt az üzenetet lekezeled, akkor meghatározhatod
az ablakod maximálizált méretét, az akkori pozícióját, illetve a nem maximalizált
állapotában a maximális és a minimális méretét.
Ha azt szeretnéd, hogy a felhasználó ne tudja átméretezni a form-ot,
akkor e két utolsó tulajdonságot állítsd egyforma méretre. Az üzenetet a következőképpen tudod lekezelni:
{...}
   private
{ Private declarations }
     procedure WMGetMinMaxInfo(var MSG: Tmessage);
     message WM_GetMinMaxInfo;
{...}
procedure TForm1.WMGetMinMaxInfo(var MSG: Tmessage);
begin
   {Az eredeti eseménykezelő meghívása}
   inherited;
   {Az értékek beállítása}
   with PMinMaxInfo(MSG.lparam)^ do
     begin
     {A maximalizált méret}
     with ptMaxSize do
       begin X := Screen.Width;
         Y := Screen.Height;
       end;
         {Maximalizált állapotban a pozíció}
         with ptMaxSize do
      begin
        X := 0; Y := 0;
      end;
     {A minimális méret}
     with ptMinTrackSize do
    begin
        X := 100; Y := 100;
     end;
     {A maximális méret}
     with ptMaxTrackSize do
      begin
        X := 640; Y := 480;
      end;
   end;
end;
Egy Form (alkalmazás) ikon-állapotban tartása a következőképpen oldható meg:
  1. Állítsd a Form WindowState tulajdonságát wsMinimized értékre.
  2. A Form osztály deklarációjának private részében helyezd el a következő sort:
    procedure WMQueryOpen(VAR Msg : TWMQueryOpen); message WM_QUERYOPEN;
  3. A kifejtő részben pedig hozd létre az alábbi eljárást:

    procedure TForm1.WMQueryOpen(VAR Msg : TWMQueryOpen);
    begin
       Msg.Result := 0;
    end;
Az alábbi módszer bemutatja, hogy hogyan lehet egy FileListBox-ban
kiválasztott fájlhoz társított alkalmazásból kinyerni a fájl ikonját.
Ezt az ikont átalakítjuk Bitmappé, megjelenítjük egy TImeage-ben,
majd elmentjük BMP formátumban.

uses ShellAPI;

. . .

procedure TForm1.Button1Click(Sender: TObject);
var
   Icon : TIcon;
   Bitmap : TBitmap;
   w : word;
   hi : HIcon;
   S : PChar;
begin
   Icon:=TIcon.Create; // Az ikon létrehozása
   Bitmap := TBitmap.Create; // A bitmap lérehozása
   w:=0;   // A társított EXE első ikonja
   S:= PChar(FileListBox1.FileName);
   hi:=ExtractAssociatedIcon(hInstance,S,w); // Az ikon kinyerése
   Icon.Handle:=hi; // a fájlból
   Bitmap.Width:=Icon.Width; // A bitmap mérete legyen
   Bitmap.Height:=Icon.Height; // az ikon mérete
   Bitmap.Canvas.Draw(0, 0, Icon );   // Az ikon tartalmának
// bitmapra rajzolása
   Image1.Picture.Bitmap:=Bitmap;   // A bitmap megjelenítése
   Bitmap.SaveToFile('c:\proba.bmp');   // A bitmap elmentése
   Icon.Free;
   Bitmap.Free;
end;
A következő példa a Jpg képek használatát is bemutatja, kell hozzá egy edit1.-komponens...

uses clipbrd, jpeg

...

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var jpg:Tjpegimage;
begin
  if key=vk_return then
  begin
    if clipboard.HasFormat(cf_picture)or clipboard.HasFormat(cf_bitmap)or clipboard.HasFormat(cf_metafilepict) =true then
     begin
       clipboard.Open;
       image1.Picture.Assign(clipboard);
       clipboard.Close;
       jpg:=Tjpegimage.Create;
       jpg.Assign(image1.picture.Graphic);
       jpg.SaveToFile('c:\'+edit1.Text+'.jpg');
       jpg.free;
     end
     else
       edit1.Color:=form1.Color;
  end;
end;

Megjegyzés:
A jpg komponens csak read-onli, tehát ha szerkeszteni akarsz egy jpg képet,
akkor azt át kell konvertálni bmp-re, ott szerkeszteni, és a végén visszakonvertálni.
A desktop (ami a monitorodon van) könnyedén "lefényképezhetjük" a fenti programmal.
Az első példához szükséges egy Image1. komponens!

procedure TForm1.Button1Click(Sender: TObject);
var
  dc:HDC;
begin
  dc:=GetDc(0);
  BitBlt(image1.canvas.handle,0,0,width,height,dc,0,0,srccopy);
end;

vagy

procedure SaveScreen(ALeft, ATop, ARight, ABottom: Integer; BmpFile:string);
var
   FCanvas: TCanvas;
   Bitmap: TBitmap;
   FRect: TRect;
begin
   FCanvas := TCanvas.Create;
   FCanvas.Handle := GetDC( 0 );
   try
     Bitmap := TBitmap.Create;
   try
     Bitmap.Width := ARight;
     Bitmap.Height := ABottom;
     FRect := Rect( aLeft, ATop, ARight, ABottom );
     Bitmap.Canvas.CopyRect( FRect, FCanvas, FRect );
     Bitmap.SaveToFile( BmpFile );
   finally
  Bitmap.Free;
   end;
  finally
   ReleaseDC( 0, FCanvas.Handle );
   FCanvas.Free;
   end;
end;

Megjegyzés:
Második példa meghívása:
SaveScreen( 0, 0, Screen.Width, Screen.Height, 'c:\Test.bmp' );
Egy Form tartalmát (képét) az alábbi eljárással lehet a vágólapra másolni:

implementation
{$R *.DFM}

uses clipbrd;

procedure TForm1.Button1Click(Sender: TObject);
var bitmap:tbitmap;
begin
   bitmap:=tbitmap.create;
   bitmap.width:=clientwidth;
   bitmap.height:=clientheight;
   try
     with bitmap.Canvas do
     CopyRect (clientrect,canvas,clientrect);
     clipboard.assign(bitmap);
   finally
     bitmap.free;
   end;
end;
Az alkalmazás Formja, amit a készítésénél a saját monitor felbontáshoz
terveztél sajnos elképzelhető, hogy alacsonyabb felbontás mellett nagyobb lesz,
mint a rendelkezésre álló képernyőterület, és így egyes részei nem fognak látszani.
Ez a probléma kiküszöbölhető, ha a Delphiben beállítod, hogy futásidőben ilyen
esetben adjon gördítősávokat a Formodhoz (Form.AutoScroll).

Mindazonáltal a Delphi egy sokkal szebb megoldást is nyújt az adott problémára.
Ha a Delphi automatikus arányosítását (Form.Scaled) használod, akkor a Delphi
futásidőben lekérdezi a rendszer képernyő-felbontását és eltárolja azt az
alkalmazás Képernyő objektumának (Application.Screen) PixelPer Inch tulajdonságában.
Ezután ezt az értéket használva átméretezi a Formot (és annak tartalmát) az
éppen aktuális képernyő-felbontáshoz viszonyítva.

Ahhoz, hogy ez a módszer ténylegesen és eredményesen működjön, az alábbi dolgokat kell szem előtt tartani:

  1. A Form 'Scaled' tulajdonságát állítsd True-ra,
  2. az 'AutoScroll' tulajdonságát pedig False-ra.
  3. Kizárólag TrueType fontokat használj.
  4. A Windows kis fontjait használd fejlesztés közben.

A Lap Tetejére
  1. Az aktuális képernyőfelbontás megállapításához a GetSystemMetrics() Windows API függvényt használhatjuk. Ez a függvény a paramétertől függően a Windows különböző
    méretbeállításaival illetve egyéb konfiurációs információkkal tér vissza.
    Jelen esetben az alábbi négy paraméter lehet segítségünkre a feladat megoldásában:
    SM_CXSCREEN - a teljes képernyő szélességét adja vissza pixelben.
    SM_CYSCREEN - a teljes képernyő magasságát adja vissza pixelben.
    SM_CXFULLSCREEN - egy teljes méretű ablak kliens-területének teljes szélessége pixelben.
    SM_CYFULLSCREEN - egy teljes méretű ablak kliens-területének teljes magasságát adja vissza
    pixelben. (az SM_CYSCREEN értékből levonva az ablakok fejlécmagassága és a Taskbar magassága)
  2. Lássunk egy példát a fenti függvény alkalmazására:
    Az alábbi eljárás egy gomb lenyomására egy üzenetablakban megjeleníti a képernyőfelbontás aktuális értékeit és
    egy teljes méretű ablak kliens-területének maximális értékét.

    procedure TForm1.Button1Click(Sender: TObject);
    var scrWidth, scrHeight : Integer;
    mclWidth, mclHeight : Integer;
    begin
    scrWidth := GetSystemMetrics(SM_CXSCREEN);
    scrHeight := GetSystemMetrics(SM_CYSCREEN);
    mclWidth := GetSystemMetrics(SM_CXFULLSCREEN);
    mclHeight := GetSystemMetrics(SM_CYFULLSCREEN);
    ShowMessage('Képernyőfelbontás: ('+IntToStr(scrWidth)+ 'x'+IntToStr(scrHeight)+ ')'+ #13 +'Max. kliensterület: ('+IntToStr(mclWidth)+ 'x'+IntToStr(mclHeight)+ ')');
    end;
Az éppen futó alkalmazás ikonjának (gombjának) a tálcáról való eltüntetése:
ShowWindow (Application.Handle, SW_HIDE);

..és visszahozása:

ShowWindow (Application.Handle, SW_RESTORE);

Ennyi az egész...

  1. Egy meghajtó fajtáját a GetDriveType() WinAPI függvény segítségével tudjuk megállapítani.

    2. GetDriveType() : WinAPI függvény, amely visszaadja a meghajtó típusát.
    Az egyetlen paraméter, amit át kell adni neki, a meghajtó betűjele A:\ formátumban.
    A függvény visszatérési értékei a következők:
    0 : nem állapítható meg
    1 : a gyökérkönyvtár nem létezik
    DRIVE_REMOVABLE : a lemez eltávolítható a meghajtóból (floppy)
    DRIVE_FIXED : a lemez nem távolítható el a meghajtóból (merevlemez)
    DRIVE_REMOTE : hálózati meghajtó
    DRIVE_CDROM : CD-ROM meghajtó
    DRIVE_RAMDISK : RAM disk
  2. . Az alábbi példa egy gomb lenyomására egy ListBox-ban megjeleníti a gépen található meghajtók betűjelét és fajtáját. A GetDriveType() függvény által visszaadott (meghajtó-típus) értéket egy többágú szelekcióval (case) értékeljük ki, majd hozzáadjuk a ListBox elemeihez.
{ . . . }

type
   TForm1 = class(TForm)
     ListBox1: TListBox;
     Button1: TButton;
     procedure Button1Click(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
   end;

  { . . . }

procedure TForm1.Button1Click(Sender: TObject);
var
     x : char;
     DrvType : Integer;
     DrvLetter,
     DrvString : String;
begin
   ListBox1.Clear;
   {25 lehetséges meghajtó ... a-z}
   for x := 'A' to 'Z' do
   begin
     DrvLetter := x +':\';
     {A meghajtó-típus megállapítása}
     DrvType := GetDriveType(pChar(DrvLetter));
     {A visszatérő érték elemzése}
       case DrvType of
        0,1 : DrvString := '';
        DRIVE_REMOVABLE : DrvString := 'Removable';
        DRIVE_FIXED : DrvString := 'Fixed';
        DRIVE_REMOTE : DrvString := 'Network';
        DRIVE_CDROM : DrvString := 'CD-ROM';
        DRIVE_RAMDISK : DrvString := 'RAM disk';
       end;
     {Ha nem üres a meghajtó típusát jelölő string, akkor
     a betűjelét és típusát hozzáadjuk a ListBox elemeihez}
     if DrvString <> '' then
       Listbox1.Items.Add(DrvLetter + ' = ' + DrvString);
   end;
end;
A CD meghajtó ajtaját az alábbi utasításokkal lehet Delphi programból kinyitni illetve bezárni:
(pl. egy gomb lenyomásával)

uses MMSystem;

...

// kinyitja a CD ajtaját
mciSendString('Set cdaudio door open wait', nil, 0, handle);

// bezárja a CD ajtaját
mciSendString('Set cdaudio door closed wait', nil, 0, handle);
Ennyi az egész...
A GetDriveType() Windows API függvénnyel először megállapítható, hogy a vizsgált meghajtó CD-ROM
meghajtó-e, majd a GetVolumeInformation() Windows API függvénnyel pedig megvizsgálhatjuk,
hogy a 'VolumeName' értéke 'Audio CD'-e vagy sem.

uses MPlayer;

...

function IsAudioCD(Drive : char) : bool;
var
   DrivePath : string;
   MaximumComponentLength : DWORD;
   FileSystemFlags : DWORD;
   VolumeName : string;
begin
   Result := false;
   DrivePath := Drive + ':\';
   if GetDriveType(PChar(DrivePath)) <> DRIVE_CDROM then exit;
   SetLength(VolumeName, 64);
   GetVolumeInformation(PChar(DrivePath), PChar(VolumeName), Length(VolumeName), nil, MaximumComponentLength, FileSystemFlags, nil, 0);
   if lStrCmp(PChar(VolumeName),'Audio CD') = 0 then result := true;
end;

function PlayAudioCD(Drive : char) : bool;
var
   mp : TMediaPlayer;
begin
   result := false;
   Application.ProcessMessages;
   if not IsAudioCD(Drive) then exit;
   mp := TMediaPlayer.Create(nil);
   mp.Visible := false;
   mp.Parent := Application.MainForm;
   mp.Shareable := true;
   mp.DeviceType := dtCDAudio;
   mp.FileName := Drive + ':';
   mp.Shareable := true;
   mp.Open;
   Application.ProcessMessages;
   mp.Play;
   Application.ProcessMessages;
   mp.Close;
   Application.ProcessMessages;
   mp.free;
   result := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if not PlayAudioCD('D') then
   ShowMessage('Not an Audio CD');
end;
A merevlemez cimkéjét átírhatjuk, olvashatjuk:

procedure TForm1.FormCreate(Sender: TObject);
var
   a: array[0..100] of char;
   b: dword;
begin
  windows.GetVolumeInformation('c:\',a,100,nil,b,b,nil,0);
  edit1.Text:=string(a);
end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if key=vk_return then windows.SetVolumeLabel('C:\', pchar(edit1.Text));
end;

Megjegyzés:
Ezzel a programmal megnézhetjük, és akár alakíthatjuk is a C meghajtó cimkéjét.
(Ha átjavítod a kódot, akkor nemcsak a C meghajtót)
Sokszor igen nehéz fejben tartani az összes, különböző helyeken deklarált globális
(akár több unit által is használt) változó nevét és típusát.
A Delphi 3 és a későbbi verziók használata esetén a Delphi ún. Code Insight
szolgáltatásának segítségével egy nagyon hasznos segítséget kapunk, ha ezeket a változókat egy
rekord adattípusban tároljuk el. Ha ugyanis a későbbiekben hivatkozni akarunk
valamely a rekordban eltárolt változóra, csak meg kell adni a rekord nevét és
a Delphi kódkiegészítő funkciója (Code Completition Wizard) automatikusan megjeleníti
egy legördülő listában a változókat és azok típusát.
Innen már csak ki kell választani az éppen szükségeset.
  1. Mindehhez csak deklarálni kell egy rekord adattípust egy általánosan elérhető Unitban. Pl. így:
    Type
       TMyGlobals = Record
         IsSelected : Boolean;
         UserName : String;
         DBName : String;
         RecordNum : Integer;
         Status : Byte;
         end;
  2. Majd létre kell hozni egy ilyen típusu változót:
    Var
    Global : TMyGlobals;
Mindezek után ha a rekord nevének (itt 'Global') beírása után pontot teszünk,
a Delphi automatikusan legördít egy a rekordban tárolt változókat tartalmazó listát,
ahonnan csak ki kell választani a megfelelőt. Sőt, ha a globális változókat egy
értékadó művelet jobb oldalán használjuk, akkor a legördülő lista az adott helyen
használható típusú változókra korlátozódik. Például: ha egy Label.Caption-nak adunk értéket,
akkor a változók közül csak a string típusúak jelennek meg a listában.
Az alábbi függvényekkel a hosszú fájlneveket alakíthatod át rövid fájlnévvé,
valamint a rövid fájlnevet vissza a hosszú fájlnév módba. Pl.: "Long File Name.pas" <--> "longfi~1.pas"
  1. Hosszú fájlnévből rövid fájlnév:
    Function GetShortFileName(Const FileName : String) : String;
    var
        aTmp: array[0..255] of char;
    begin
        if GetShortPathName(PChar(FileName),aTmp,Sizeof(aTmp)-1)=0 then
           Result:= FileName
        else
           Result:=StrPas(aTmp);
    end;

  2. Rövid fájlnévből hosszú fájlnév:
    Function GetLongFileName(Const FileName : String) : String;
    var
        aInfo: TSHFileInfo;
    begin
        if SHGetFileInfo(PChar(FileName),0,aInfo,Sizeof(aInfo),SHGFI_DISPLAYNAME)<>0 then
           Result:= String(aInfo.szDisplayName)
        else
           Result:= FileName;
    end;
A kurzorvezérlő billentyűk eredeti funkciójának megváltoztatásához (felülírásához) a Form
vagy az adott okjektum(ok) OnKeyDown eseményét kell az alábbiak szerint meghatározni.
(A lenti példában a LE és FEL nyilakkal lehet a következő illetve az előző controlra váltani;
mint a TAB-bal.) Fontos, hogy a Form KeyPreview tulajdonságát True-ra állítsuk.

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
   if (Key=VK_DOWN) then //bal nyíl VK_LEFT     PostMessage(Handle, WM_NEXTDLGCTL, 0, 0);
    {következő kontrol}
   if (KEY=VK_UP) then //jobb nyíl VK_RIGHT
    PostMessage(Handle, WM_NEXTDLGCTL, 1, 0);
    {előző kontrol}
end;

A fenti eljárást nem csak a kurzorvezérlő nyilakkal lehet használni,
hanem sok más billentyű (pl. End, Home, etc.) úgynevezett 'Virtual-Key'
kódja behelyttesíthető a VK_DOWN illetve VK_UP helyébe.
A különböző billentyűk Windows által használt VK kódjai megtekintéséhez kattins ide.
  1. A monitor kikapcsolása:
       SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);
  2. A monitor bekapcsolása:    SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, -1);
Természetesen ez a módszer csak az olyan monitoroknál működik, amelyeknek van energiatakarékos üzemmódja A merevlemez (a példában 'C:\') sorozatszámát az alábbi eljárással lehet megjeleníteni:
procedure TForm1.Button1Click(Sender: TObject);
var
    SerialNum : pdword;
    a, b : dword;
    Buffer : array [0..255] of char;
begin
    if GetVolumeInformation('c:\', Buffer, SizeOf(Buffer),@SerialNum, a, b, nil, 0) then
    Label1.Caption := IntToStr(SerialNum^);
end;
A processzor aktuális sebességét az alábbi függvény meghívásával lehet megjeleníteni:
function TForm1.GetCpuSpeed: Extended;
var
    t: DWORD;
    mhi, mlo, nhi, nlo: DWORD;
    t0, t1, chi, clo, shr32: Comp;
begin
    shr32 := 65536;
    shr32 := shr32 * 65536;
    t := GetTickCount;
    while t = GetTickCount do begin end;
    asm
       DB 0FH
       DB 031H
       mov mhi,edx
       mov mlo,eax
    end;
    while GetTickCount < (t + 1000) do begin end;
    asm
       DB 0FH
       DB 031H
       mov nhi,edx
       mov nlo,eax
    end;
    chi := mhi; if mhi < 0 then chi := chi + shr32;
    clo := mlo; if mlo < 0 then clo := clo + shr32;
    t0 := chi * shr32 + clo;
    chi := nhi; if nhi < 0 then chi := chi + shr32;
    clo := nlo; if nlo < 0 then clo := clo + shr32;
    t1 := chi * shr32 + clo;
    Result := (t1 - t0) / 1E6;
end;
//A függvény meghívása
procedure TForm1.Button1Click(Sender: TObject);
begin
    label1.Caption := FloatToStr(GetCpuSpeed) + ' mhz';
end;

Néha szükség lehet arra, hogy megállapítsuk, hogy a program EXE-je melyik
könyvtárban található. (Például, ha az INI fájlt itt helyezzük el a windows könyvtár helyett.)
  1. A feladat megoldásához az alábbi funkciót illetve tulajdonságot használhatjuk:
    function ExtractFilePath(const FileName: string): string; - visszaadja a paraméterben
    megadott fájl elérési útjából a meghajtó jelét és a könytára(ka)t.
    Tehát lecsapja a végéről a fájl nevét és kiterjesztését.
    TApplication.ExeName - visszaadja a futtatott program EXE teljes elérési útját,
    fájlnévvel és kiterjesztéssel.
  2. Lássunk egy példát a fentiek használatára:

    procedure TForm1.Button1Click(Sender: TObject);
    begin
       MessageDlg('A program EXE könyvtára:' + #13+ ExtractFilePath( Application.ExeName),mtInformation, [mbOk], 0);
    end;
  1. Az alábbi függvény segítségével megállapítható, hogy a Windows Taskbar (Tálca)
    automatikus elrejtés tulajdonsága be van-e kapcsolva vagy sem:

    uses ShellAPI;

    ...

    function IsTaskbarAutoHideOn : boolean;
    var ABData : TAppBarData;
    begin
       ABData.cbSize := sizeof(ABData);
       Result := (SHAppBarMessage(ABM_GETSTATE, ABData) and ABS_AUTOHIDE) > 0;
    end;
  2. És egy példa a használatára:
    if(IsTaskBarautoHideOn)then
    begin
       // be van kapcsolva...
    end;
A tálcát az alábbi eljárásokkal lehet elrejteni a Windows 95/NT asztalról illetve ismét láthatóvá tenni.

procedure hideTaskbar;
var wndHandle : THandle;
    ; wndClass : array[0..50] of Char;
begin
    StrPCopy(@wndClass[0], 'Shell_TrayWnd');
    wndHandle := FindWindow(@wndClass[0], nil);
    ShowWindow(wndHandle, SW_HIDE); // Ez eltünteti a tálcát
end;

procedure showTaskbar;
var wndHandle : THandle;
    ; wndClass : array[0..50] of Char;
begin
    ;StrPCopy(@wndClass[0], 'Shell_TrayWnd');
    wndHandle := FindWindow(@wndClass[0], nil);
    ;ShowWindow(wndHandle, SW_RESTORE); // Ez visszahozza a tálcát
end;
A Start! gomb tálcáról való eltüntetését ezzel az eljárással tudod megoldani:

procedure hideStartbutton(visi:boolean);
Var
   Tray, Child : hWnd;
   C : Array[0..127] of Char;
   S : String;
Begin
   Tray := FindWindow('Shell_TrayWnd', NIL);
   Child := GetWindow(Tray, GW_CHILD);
   While Child <> 0 do
     Begin
     If GetClassName(Child, C, SizeOf(C)) > 0 Then
       Begin
         S := StrPAS(C);
         If UpperCase(S) = 'BUTTON' then
           begin
             startbutton_handle:=child; // IsWindowVisible(Child)
             If Visi
             then ShowWindow(Child, 1)
             else ShowWindow(Child, 0);
           end;
       End;
       Child := GetWindow(Child, GW_HWNDNEXT);
   End;
End;

A Start! gomb letiltását és a letiltás feloldását ezzel a két eljárással lehet megoldani:

procedure TForm1.Button1Click(Sender: TObject);
begin
   {Letiltás}
   EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil),0, 'Button', nil), false);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   {Feloldás}
   EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button', nil), true);
end;
Ez a példa egy komponens és egy mintaalkalmazás elkészítésén keresztül bemutatja, hogy hogyan
lehet két DBGrid tetszőleges mezői között alkalmazni a Drag & Drop (Fogd és Vidd) technikát. (A
példa a Delphi 3-as és 4-es verziói alatt működik, de egyes kisebb változtatásokkal használható a
Delphi 1-es és 2-es verzióival is.)

  1. Készíts egy új Unit-ot (File/New/Unit). A lenti MyDBGrid unit szövegét másold bele és
    mentsd el MyDBGrid.pas néven. Ez lesz az új DBGrid komponens.

  2. Most installáld az új komponenst: Component/Install Component. Válts át az 'Into New
    Package    ' fülre. A Unit neve szerkesztőmezőbe hívd be a MyDBGrid.pas fájlt. Nevezd el
    az új komponens-csomagot 'MyPackage.dpk'-nak. Nyomd meg az igen gombot, amikor a Delphi
    közli, hogy az új csomag installálva lesz, majd az OK-t, amikor jelzi, hogy a 'VCL30.DPL' szükséges hozzá. Zárd be a csomag
    -szerkesztőt és mentsd el a komponens-csomagot.

  3. Készíts egy új alkalmazást: File/New Application. Kattints jobb gombbal a Form-ra (Form1) és
    válaszd a gyorsmenüből a 'View As Text' menüpontot. A lenti GridU1 form szöveges forrást másold be
    a Form1 forrásába. Most kattints jobb gombbal a Form1 forrásába és válaszd ki a 'View As Form'
    menüpontot. Eltarthat egy rövid ideig míg visszavált Form nézetre mert közben meg kell nyitnia az
    adatbázis táblákat is. Ezután a lenti GridU1 Unit szövegét másold be az 'Unit1'-be.
  4. Mentsd el az alkalmazást: File/Save Project As. A unitot nevezd el 'GridU1.pas'-nak, az
    alkalmazást pedig 'GridProj.dpr'-nek.
  5. Futtasd az alkalmazást és ha minden igaz, máris működni fog a Drag&Drop technika a két DBGrid
    mezői között.

-----------------
The MyDBGrid unit
-----------------

unit MyDBGrid;
interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids;

type
     TMyDBGrid = class(TDBGrid)
   private
     { Private declarations }
     FOnMouseDown: TMouseEvent;
   protected
     { Protected declarations }
     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
   published
     { Published declarations }
   property Row;
   property OnMouseDown read FOnMouseDown write FOnMouseDown;
   end;

procedure Register;
implementation

procedure TMyDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   if Assigned(FOnMouseDown) then
     FOnMouseDown(Self, Button, Shift, X, Y);
   inherited MouseDown(Button, Shift, X, Y);
end;

procedure Register;
begin
   RegisterComponents('Samples', [TMyDBGrid]);
end;
end.

---------------
The GridU1 unit
---------------

unit GridU1;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Db, DBTables, Grids, DBGrids, MyDBGrid, StdCtrls;

type
   TForm1 = class(TForm)
     MyDBGrid1: TMyDBGrid;
     Table1: TTable;
     DataSource1: TDataSource;
     Table2: TTable;
     DataSource2: TDataSource;
     MyDBGrid2: TMyDBGrid;
     procedure MyDBGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
     procedure MyDBGrid1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
     procedure MyDBGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);
   private
     { Private declarations }
   public
     { Public declarations }
   end;

var
   Form1: TForm1;

implementation

{$R *.DFM}

var
   SGC : TGridCoord;

procedure TForm1.MyDBGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
   DG : TMyDBGrid;
begin
   DG := Sender as TMyDBGrid;
   SGC := DG.MouseCoord(X,Y);
   if (SGC.X > 0) and (SGC.Y > 0) then
     (Sender as TMyDBGrid).BeginDrag(False);
end;

procedure TForm1.MyDBGrid1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
var
   GC : TGridCoord;
begin
   GC := (Sender as TMyDBGrid).MouseCoord(X,Y);
   Accept := Source is TMyDBGrid and (GC.X > 0) and (GC.Y > 0);
end;

procedure TForm1.MyDBGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
   DG : TMyDBGrid;
   GC : TGridCoord;
   CurRow : Integer;
  begin
     DG := Sender as TMyDBGrid;
     GC := DG.MouseCoord(X,Y);
     with DG.DataSource.DataSet do
     begin
       with (Source as TMyDBGrid).DataSource.DataSet do
       Caption := 'You dragged "'+Fields[SGC.X-1].AsString+'"';
       DisableControls;
       CurRow := DG.Row;
       MoveBy(GC.Y-CurRow);
       Caption := Caption+' to "'+Fields[GC.X-1].AsString+'"';
       MoveBy(CurRow-GC.Y);
       EnableControls;
     end;
    end;
end.

---------------
The GridU1 form
---------------

object Form1: TForm1
   Left = 200
   Top = 108
   Width = 544
   Height = 437
   Caption = 'Form1'
   Font.Charset = DEFAULT_CHARSET
   Font.Color = clWindowText
   Font.Height = -11
   Font.Name = 'MS Sans Serif'
   Font.Style = []
   PixelsPerInch = 96
   TextHeight = 13
  object MyDBGrid1: TMyDBGrid
   Left = 8
   Top = 8
   Width = 521
   Height = 193
   DataSource = DataSource1
   Row = 1
   TabOrder = 0
   TitleFont.Charset = DEFAULT_CHARSET
   TitleFont.Color = clWindowText
   TitleFont.Height = -11
   TitleFont.Name = 'MS Sans Serif'
   TitleFont.Style = []
   OnDragDrop = MyDBGrid1DragDrop
   OnDragOver = MyDBGrid1DragOver
   OnMouseDown = MyDBGrid1MouseDown
   end
  object MyDBGrid2: TMyDBGrid
   Left = 7
   Top = 208
   Width = 521
   Height = 193
   DataSource = DataSource2
   Row = 1
   TabOrder = 1
   TitleFont.Charset = DEFAULT_CHARSET
   TitleFont.Color = clWindowText
   TitleFont.Height = -11
   TitleFont.Name = 'MS Sans Serif'
   TitleFont.Style = []
   OnDragDrop = MyDBGrid1DragDrop
   OnDragOver = MyDBGrid1DragOver
   OnMouseDown = MyDBGrid1MouseDown
  end
  object Table1: TTable
   Active = True
   DatabaseName = 'DBDEMOS'
   TableName = 'ORDERS'
   Left = 104
   Top = 48
  end
  object DataSource1: TDataSource
   DataSet = Table1
   Left = 136
   Top = 48
  end
  object Table2: TTable
   Active = True
   DatabaseName = 'DBDEMOS'
   TableName = 'CUSTOMER'
   Left = 104
   Top = 240
  end
  object DataSource2: TDataSource
   DataSet = Table2
   Left = 136
   Top = 240
  end
end
Egy kis példaprogram: (megszámolja, hogy hány fájl lett a Form-ra 'dobva' és kiírja a fájlok neveit)

unit Unit1;
interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls;
type
   TForm1 = class(TForm)
     procedure FormCreate(Sender: TObject);
   private
     { Private declarations }

   procedure FileIsDropped ( var Msg : TMessage ) ;
               Message WM_DropFiles ;
   public
     { Public declarations }
   end;

var
   Form1: TForm1;

implementation
uses shellapi;
{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
   DragAcceptFiles( Handle,True ) ;
end;

procedure TForm1.FileIsDropped ( var Msg : TMessage ) ;
var
   hDrop : THandle ;
   fName : array[0..254] of char ;
   NumberOfFiles : integer ;
   fCounter : integer ;
   Names : string ;
begin
   hDrop := Msg.WParam ;
   NumberOfFiles := DragQueryFile(hDrop,-1,fName,254);
   Names := '' ;
   for fCounter := 1 to NumberOfFiles do
begin
   DragQueryFile(hDrop,fCounter,fName,254);
  // Ez adja vissza a fájlok neveit
   Names := Names + #13#10 + fName ;
   end ;
   ShowMessage('Droped '+IntToStr(NumberOfFiles) + ' Files : ' + Names );
   DragFinish ( hDrop);
  end;
end.
Sok esetben fontos lehet, hogy a program kizárólag érvényes dátumokat fogadjon el.
Természetesen meg lehet vizsgálni, hogy a felhasználó érvényes évet, hónapot, napot adott-e meg.
Azonban egyáltalán nem biztos, hogy az e módszer szerint megvizsgált dátum ténylegesen létezik is.
Tegyük fel például, hogy a felhasználó 97/09/31-et ad meg. Egyébként az év, hónap, nap érvényes érték lesz,
de szeptember 31-dikét nem fogunk találni a naptárban.

A dátumok érvényessége és létezése a következő módon egyszerűen megvizsgálható:

var adatetime : tdatetime;
...

try
   adatetime:=StrToDate(inputdatestring);
except
   // EConvertError error - invalid date or invalid date format
end;

Ez a módszer természetesen a szökőévek tekintetében is működni fog.
  1. A Control Panel Dátum és Idő beállítása oldalát az alábbi WinExec() utasítással tudod megnyitni:
    WinExec('CONTROL.EXE timedate.cpl,,0', sw_ShowNormal);
  2. Az Időzóna beállítása pedig a következő módon hívható meg:
    WinExec('CONTROL.EXE timedate.cpl,,1', sw_ShowNormal);

Az alábbi két eljárás segítségével beállíthatod a dátumot, illetve az időt.
uses Windows, SysUtils;

{...}

procedure setdate(y: word; m,d: byte);
var systime:tsystemtime;
begin
   getlocaltime(systime);
   systime.wday:=d;
   systime.wmonth:=m;
   systime.wyear:=y;
   setlocaltime(systime);
end;

procedure settime(h,m,s,ms:byte);
var systime:tsystemtime;
begin
   getlocaltime(systime);
   systime.whour:=h;
   systime.wminute:=m;
   systime.wsecond:=s;
   systime.wmilliseconds:=ms;
   setlocaltime(systime);
end;
A Windowst illetve az egész rendszert az ExitWindows WinAPI függvénnyel tudod újraindítani.
  1. A Windows újraindítása a rendszer újraindítása nélkül:

    procedure TMainForm.RestartWindowsBtnClick(Sender: TObject);
    begin
       if not ExitWindows(EW_RestartWindows, 0) then
         ShowMessage('Az egyik alkalmazást nem lehet bezárni.');
    end;


  2. Az egész rendszer újraindítása:

    procedure TMainForm.RebootSystemBtnClick(Sender: TObject);
    begin
       if not ExitWindows(EW_RebootSystem, 0) then
         ShowMessage('Az egyik alkalmazást nem lehet bezárni.');
    end;
Registry használatával megoldott automatikus indítás a windows indulásakor.
Ezt azért szeretik, mert a mezei felhasználó nem tudja törölni.
És te sem, ha nem figyelsz oda, és valamit elrontasz!

uses registry

...

procedure TForm1.Button1Click(Sender: TObject);
var
  reg:Tregistry;
begin
  reg:=Tregistry.Create;
  reg.RootKey:=hkey_local_machine;
  reg.OpenKey('software\microsoft\windows\currentversion\run',false);
  reg.WriteString('azenprogim','c:\vavava.vav');
  reg.CloseKey;
end;

És a törlése:

procedure TForm1.Button2Click(Sender: TObject);
var
  reg:Tregistry;
begin
  reg:=Tregistry.Create;
  reg.RootKey:=hkey_local_machine;
  reg.OpenKey('software\microsoft\windows\currentversion\run',false);
  reg.DeleteValue('azenprogim');
  reg.CloseKey;
end;

Megjegyzés:
A registry-ből törölni is kell a bejegyzést, a bizonyos kulcsal:
azenprogim! Windows könyvtárban a REGEDIT.EXE programmal is nyomon követhetjük, ha valamit elcsesztünk.
A Shell32.dll-ben van egy nem dokumentált API függvény, nevezetesen a SHFormatDrive,
amely megnyitja a 3,5'' lemez (A:\) formázása párbeszédablakot.
Az alábbi példa ennek működését mutatja be:
implementation

{$R *.DFM}

const SHFMT_ID_DEFAULT = $FFFF;
   // Formázási tulajdonságok
   SHFMT_OPT_QUICKFORMAT = $0000;
   SHFMT_OPT_FULL = $0001;
   SHFMT_OPT_SYSONLY = $0002;
   // Hiba kódok
   SHFMT_ERROR = $FFFFFFFF;
   SHFMT_CANCEL = $FFFFFFFE;
   SHFMT_NOFORMAT = $FFFFFFFD;


function SHFormatDrive(Handle:HWND; Drive, ID, Options:Word): LongInt;
   stdcall; external 'shell32.dll' name 'SHFormatDrive'


procedure TForm1.btnFormatDiskClick(Sender : TObject);
var
   retCode: LongInt;
begin
   retCode:= SHFormatDrive(Handle, 0, SHFMT_ID_DEFAULT, SHFMT_OPT_QUICKFORMAT);
   if retCode < 0 then ShowMessage('A lemez nem lett formázva.');
end;

Az alkalmazás ikonjának futásidejű megváltoztatásához egyszerűen át kell állítani az
alkalmazás Icon tulajdonságát a megfelelő ikonra. Például így:

if (Working) then
   Application.Icon.LoadFromFile(StartupDirectory + 'Busy.ico')
else
   Application.Icon.LoadFromFile(StartupDirectory + 'Lazy.ico');
Egy egyszerű megoldás:

const crMyCursor = 1;

...

procedure TForm1.FormCreate(Sender: TObject);
begin
// Betölti a kurzorfájlt.
Screen.Cursors[crMyCursor] :=LoadCursorFromFile('c:\windows\cursors\globe.ani');
// Hozzárendeli a kurzort a formhoz.
Cursor := crMyCursor;
end;

A Lap Tetejére
Egy szín HTML értékének képzése hasonló a szín hexadecimális értékéhez.
Az egyik eltérés az, hogy az érték nem dollár ($), hanem kettős kereszt (#) jellel kezdődik.
A másik különbség pedig az, hogy a vörös és a kék byte helyek felcserélődnek.
(#FF0000 = vörös, #00FF00 = zöld, #0000FF = kék)

A lenti egyszerű példa egy üzenetablakban megjeleníti a színválasztó
párbeszédablakban (TColorDialog) kiválasztott szín HTML értékét.
A GetRValue, GetGValue és a GetBValue WinAPI függvények segítségével megkapjuk a
színt alkotó alapszínek (vörös, zöld, kék) intenzitását, majd a Format()
formázó függvénnyel összerakjuk a HTML színértékek képzésének szabályai szerint így megkapott értékeket.
{ . . . }
type
     TForm1 = class(TForm)
     Button1: TButton;
     ColorDialog1: TColorDialog;
     procedure Button1Click(Sender: TObject);
   private
     { Private declarations }
     function HTMLColorValue(AColor:TColor):String;
   public
     { Public declarations }
   end;
var
   Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
   tmpColor : TColor;
begin
   {A ColorDialog meghívása}
   if ColorDialog1.Execute then
     begin
       {A kiválasztott szín}
       tmpColor := ColorDialog1.Color;
       {A szín átalakítása és megjelenítése}
       ShowMessage(HTMLColorValue(tmpColor));
     end;
end;

function TForm1.HTMLColorValue(AColor:TColor):String;
var
   Red, Blue, Green : Integer;
begin
   {A vörös szín intenzitása}
   Red := GetRValue(AColor);
   {A kék szín intenzitása}
   Blue := GetBValue(AColor);
   {A zöld szín intenzitása}
   Green := GetGValue(AColor);
   {A szín átalakítása HTML formátumra}
   Result := Format('#%2.2x%2.2x%2.2x', [Red,Green,Blue]);
end;
{ . . . }
A Windows 95/NT asztal hátterének megváltoztatása egy Delphi programból egy
viszonylag egyszerű feladat. Ezzel a kóddal:

uses Registry;

...
procedure ChangeIt;
var
    Reg: TRegIniFile;
begin
    Reg := TRegIniFile.Create('Control Panel');
    Reg.WriteString('desktop','Wallpaper', 'c:\windows\erdő.bmp');
    Reg.WriteString('desktop', 'TileWallpaper', '1');
    Reg.Free;
    SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil,SPIF_SENDWININICHANGE);
end;

Ennyi az egész... Ha meghívod az eljárást, a háttér az általad meghatározott képre vált át.
(A példában az "erdő.bmp" képre - Magyar Windowsnál!) Ha a 'TileWallpaper' értéke '1',
akkor a háttérkép mozaik elrendezésű, míg '0' értéknél középre rendezi.

Sokszor jelent gondot, egy program becsomagolása, ha azt akarjuk,
hogy azt más ki is tudja csomagolni, lehetőleg egy álltalános tömörítővel.
Nekem csak a WinRAR van meg, de a WinZip is valahogyan így működhet.
Az első példában a c:\a\ -könyvtár teljes tartalmát csomagolom be a
c:\atlanta.rar fájlba, a második példában pedig onnan csomagolom ki.

uses Shellapi, ...

procedure TForm1.Button1Click(Sender: TObject);
begin
   shellexecute(handle,'open','C:\Program Files\winrar\winrar.exe',
   'Add c:\atlanta c:\a\',nil,sw_shownormal);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
   shellexecute(handle,'open','C:\Program Files\winrar\winrar.exe',
   'extr c:\atlanta c:\a\',nil,sw_shownormal);
end;

Megjegyzés:
A winrarhoz van leírás a helpben menüben!. Egy kis gyagya program, ami kiirja, hogy a hordozható számítógéped akkumulátorában
mennyi áram van még

procedure TForm1.Button1Click(Sender: TObject);
var
   SysPowerStatus: TSystemPowerStatus;
begin
   GetSystemPowerStatus(SysPowerStatus);
   if Boolean(SysPowerStatus.ACLineStatus) then
   begin
      ShowMessage('System running on AC.');
   end
   else
   begin
      ShowMessage('System running on battery.');
      ShowMessage(Format('Battery power left: %d percent.', [SysPowerStatus.BatteryLifePercent]));
   end;
end;
Sokszor kérdés , hogy hogyan figyelhetem, hogy egy applikáció aktív, vagy nem aktív:

private
procedure atlanta(var mmm:TwmSysCommand); message wm_activate;
. . .
procedure Tform1.atlanta;
begin
   if mmm.CmdType<>0 then application.Title:='Aktív'
    else application.Title:='Nem aktív';
end;

Megjegyzés:
Ha az applikáció aktívra, vagy unaktívra vált, a procedura magától lefut
  1. Első megoldás (Jeff Lawton): A menüpontok futásidőben történő
    hozzáadását/eltávolítását a Create, Add, Insert, Remove metódusokkal lehet végrehajtani.

    procedure tform1.addmainitem(s:string);
    var
       newitem : Tmenuitem;
    begin
       newitem:=tmenuitem.create(Mainmenu1);
       newitem.caption:=s;
    {ha egy OnClick eseményt akarsz hozzárendelni
       newitem.onclick:=Dynamenuclick; }
    {adja a főmenühöz}
       mainmenu1.items.insert(mainmenu1.items.count,newitem);
       removemenu1.enabled:=true;
       addmenuitem1.enabled:=true;
    end;


     procedure tform1.addsubitem(s:string; to : integer);
    var
       newitem, toitem : Tmenuitem;
    begin
    {to = főmenüpont, amihez hozzáadja az almenüpontot}
       toitem:=mainmenu1.items[to];
       newitem:=tmenuitem.create(toitem);
       newitem.caption:=s;
    {ha egy OnClick eseményt akarsz hozzárendelni
       newitem.onclick:=Dynamenuclick; }
       toitem.onclick:=nil;
       toitem.insert(toitem.count,newitem);
       removemenuitem1.enabled:=true;
    end;


  2. Egy másik megoldás (Jani Järvinen): Használhatod a 'Menus' unitban előre definiált
    menüfunkciókat is.

    function NewMenu(Owner: TComponent; const AName: string; Items: array of TMenuItem): TMainMenu;

    function NewPopupMenu(Owner: TComponent; const AName: string; Alignment: TPopupAlignment; AutoPopup: Boolean; Items: array of TMenuitem): TPopupMenu;

    function NewSubMenu(const ACaption: string; hCtx: Word; const AName: string; Items: array of TMenuItem): TMenuItem;

    function NewItem(const ACaption: string; AShortCut: TShortCut; AChecked, AEnabled: Boolean;AOnClick: TNotifyEvent; hCtx: Word; const AName: string): TMenuItem;

    function NewLine: TMenuItem; {Új elválasztó vonal}

    Ezek használatára egy példa (UNDU - Robert Vivrette):

    PopupMenu1 := TPopupMenu.Create(Self);
    with PopUpMenu1.Items do
       begin
          Add(NewItem('First Menu',0,False,True,MenuItem1Click,0,'MenuItem1'));
          Add(NewItem('Second Menu',0,False,True,MenuItem2Click,0,'MenuItem2'));
          Add(NewItem('Third Menu',0,False,True,MenuItem3Click,0,'MenuItem3'));
          Add(NewLine); // Új elválasztó vonal
          Add(NewItem('Fourth Menu',0,False,True,MenuItem4Click,0,'MenuItem4'));
       end;

  1. Ha a Form összes objektumára (már amelyiknél lehet) alkalmazni akarom a TAB-ot
    helyettesítő ENTER eljárást, akkor a legegyszerűbb megoldás: A Form KeyPreview tulajdonságát True-ra
    kell állítani, majd a Form OnKeyPress eseményébe az alábbi sorokat kell írni:

    procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
    begin
        if (Key = #13) then //vagy 'if Key = Chr(VK_RETURN) then'
        begin
           Key := #0; //Eat the ENTER Key
           Perform(WM_NEXTDLGCTL, 0, 0); //A következő kontrol
           {Perform(WM_NEXTDLGCTL, 1, 0)} //Az előző control
        end;
    end;
  2. Ha csak bizonyos objektumokra akarom alkalmazni (a gombokra nem lehet), akkor a kívánt objektumokat kijelölve az OnKeyPress eseményüket be kell állítani az alábbi
    MyKeyPress eljárásra (a Form OnKeyPress-t nem).

    procedure TForm1.MyKeyPress(Sender: TObject; var Key:Char);
    begin
        if Key = Chr(VK_RETURN) then //vagy 'if (Key = #13) then'
        begin
           Perform(WM_NEXTDLGCTL,0,0);
           key:= #0;
        end;
    end;
A Delphi1-ben a DBase file-ok összetett indexállománya csak MDX lehet (TTable osztály TableType property: ttDBase). Ha hiányzik (vagy sérült) az MDX file, akkor a DBF file nem nyitható meg.
Vagy ha újra kell indexelni a DBF file-t elöbb törölni kellene az indexeket (csak a másodlagosakat
lehet) és utána AddIndex(...)-el újra létrehozni. A probléma alapja, hogy a DBF file fejlécébe be van
jegyezve, hogy létezik hozzá index.
Ez a probléma a következő módon oldható meg:

  1. Először kitöröljük az indexfile-t (MDX):
        DeleteFile(Konyvtar+'FILE.MDX');
  2. Utána a lenti eljárás segítségével a DBF file fejlécében felülírunk egy byte-ot, ezzel elérjük,
    hogy ne keresse megnyitáskor az indexet:

    procedure TForm1.RemoveMDXByte(dbFile: String);
       { Bemenő paraméter: a sérült .DBF fájl neve(útvonala) }
       { Megpatcheli a .DBF fejlécet, ezzel eléri, hogy ne keresse }
       { megnyitáskor az indexet }

    const
        Value: Byte = 0;
    var
        F: File of byte;
    begin
        AssignFile(F, dbFile);
        Reset(F);
        Seek(F, 28); { itt van az index bejegyezve }
        Write(F, Value);
        CloseFile(F);
    end;
       // pl. RemoveMDXByte(Konyvtar+'KEPLET.DBF');
  3. Mindezek után már nyugodtan indexelhetünk:
        Table1.AddIndex('KOD', 'KOD', []);
Pontosabban ellenőrzése, hogy létezik-e.

procedure TForm1.Button1Click(Sender: TObject);
begin
{$I-}
   chdir('c:\wawa');
   if ioresult=0 then kész;
   {$I+}
end;

Megjegyzés:
Ahol a "{$I-}" arra kell, hogy ha már van olyan directory, akkor ne akadjon le a program.
procedure TForm1.Button1Click(Sender: TObject);
var
 x,y:integer;
begin
 x:=5;
 y:=5;
 setcursorpos(x,y);
 mouse_event (MOUSEEVENTF_LEFTDOWN, 0,0,0,0);
 mouse_event (MOUSEEVENTF_LEFTUP, 0,0,0,0);
end;

Megjegyzés:
A nyilat az 5,5 -ös kordinátára viszi, és ott imitál egy click-et. (Cursor koordinátájának lekérdezése GETCURSORPOS(point); (point:Tpoint!)

A szövegek titkosítása számtalan formában lehetséges; az alábbiakban bemutatásra kerülő módszer az egyik legegyszerűbb ezek közül. Ez a mód bőven elegendő arra, hogy ne tudják elolvasni a szöveget, de ha valaki igazán fel akarja törni a titkosítást, akkor annak nem fog sok idejébe kerülni. :-)
Alapvetően a szövegek titkosításának elve a betűk olyanmód összekeverése, hogy utána az eredeti szöveg adatveszteség nélkül visszaállítható legyen. Az alábbi példában használt technika alapja a bit-ek eltolása: a karaktereket egy byte értéknek vesszük és meghatározott hellyel eltoljuk a bit-jeit jobbra vagy balra. Ha valamelyik bit "túlcsúszik" a byte végén, akkor az az elejére kerül (pl. ha a jobb oldalon lépi túl a byte határát, akkor a bal oldalon tűnik fel). Például a '01010011' érték három bit-tel balra eltolva '10011010' lenne. Ha ezt az értéket három bittel jobbra tolnánk el, akkor az eredeti érték visszaállna.

  1. Az első dolog: egy függvény készítése, amely egy karakter bit-jeit meghatározott hellyel eltolja valamelyik irányba, és visszaadja annak titkosított értékét. Function RotateBits(C: Char; Bits: Integer): Char;
    var
      SI : Word;
    begin
      Bits := Bits mod 8;
      if Bits < 0 then // balra
      begin
       // Az adatokat egy Word (2 byte) jobb felébe helyezzük
       SI := MakeWord(Byte(C),0);
       // Meghatározott bit-tel eltoljuk balra...
       SI := SI shl Abs(Bits);
      end
      else // ...jobbra
      begin
       // Az adatokat egy Word (2 byte) bal felébe helyezzük
       SI := MakeWord(0,Byte(C));
       // Meghatározott bit-tel eltoljuk jobbra
       SI := SI shr Abs(Bits);
      end;
      SI := Lo(SI) or Hi(SI);
      Result := Chr(SI);
    end;

    Először maximum 8-ra korlátozzuk a valamelyik irányba történő mozgatást. Ha az érték negatív, balra tolja el, egyébként pedig jobbra. A mod függvénnyel biztosítjuk, hogy az eredmény -7 és 7 közé essen.
    Ezután a byte-ot elhelyezzük egy Word érték jobb vagy bal felében. Mivel a Word 2 byte-ot tartalmaz, a második byte-ját fogjuk használni az eredeti byte eltolt bit-jeinek tárolására. Ha balra tolom el őket, akkor a Word jobb felébe helyezem az értéket, ha pedig jobbra, akkor a bal felébe. Ezt követően az SHL (Shift Left) vagy az SHR (Shift Right) eljárások megfelelő használatával eltolom a biteket balra illetve jobbra. A végső feladat ennek a két értéknek az egyesítése. Ezt a Word első (hi-order) és második (lo-order) byte-jának OR operátorral történő összekapcsolásával érhetjük el. Ennek hatására a két byte értéke egy byte-tá egyesül. Ezt a byte értéket átalakítjuk egy Char típusú értékké; ez lesz végül a függvény visszatérő eredménye.


  2. És most lássuk a fő-eljárást, amely elvégzi a titkosítást és a dekódolást:

Function Encryption(Str,Pwd: String; Encode: Boolean): String;
var
  a,PwdChk,Direction,ShiftVal,PasswordDigit : Integer;
begin
  PasswordDigit := 1;
  PwdChk := 0;
  for a := 1 to Length(Pwd) do Inc(PwdChk,Ord(Pwd[a]));
  Result := Str;
  if Encode then Direction := -1 else Direction := 1;
  for a := 1 to Length(Result) do
  begin
   if Length(Pwd)=0 then
   ShiftVal := a
  else
   ShiftVal := Ord(Pwd[PasswordDigit]);
   if Odd(A) then
   Result[A] := RotateBits(Result[A],-Direction*(ShiftVal+PwdChk))
   else
   Result[A] := RotateBits(Result[A],Direction*(ShiftVal+PwdChk));
   inc(PasswordDigit);
if PasswordDigit > Length(Pwd) then PasswordDigit := 1;
end;
end;
A fenti függvénynek három paramétere van. Az első a bemeneti, titkosítandó szöveg (Str) a második a jelszó (Pwd), (amennyiben megadjuk), a harmadik pedig egy logikai típusu paraméter, amely meghatározza, hogy titkosítani vagy dekódolni akarunk.
Elsőként a jelszó karaktereinek Ord értékét (sorszámát vagy ASCII kódját) összeadjuk. Ez egy további lehetőséget nyújt a szöveg megkeverésére. Utána nincs is más dolgunk
, mint hogy a titkosítandó szöveg karakterein végighaladva a RotateBits függvény segítségével összekeverjük annak tartalmát.
Amennyiben megadtunk valamilyen jelszót, akkor annak ASCII kódját vesszük értékül a karakterek eltolása tekintetében. A ciklus minden egyes végigfutásánál a jelszó k
övetkező karakterét vesszük alapul. (Ha a végére értünk, akkor az első karakter következik.) Ha nincs jelszó, akkor az eltolási érték a ciklusnak a szövegben aktuálisan elért helyének értékét veszi fel. (pl. Ha az első karakteren áll, akkor 1, ha a másodikon, akkor 2, etc.) Végül: ha a szöveg páratlan sorszámú karakerén állunk (pl. 1., 3., 5.), akkor a biteket balra toljuk, ha pedig pároson, akkor jobbra.
A Direction érték pedig az egész folyamat irányát fordítja meg, attól függően, hogy titkosítást vagy dekódolást adtunk meg a függvény harmadik paraméterében.

  1. Egy fájl tulajdonságainak a Windows fájlinformációs lapján történő megjelenítése a ShellExecuteEx() WinAPI függvény segítségével érhető el. A Függvénynek paraméterként egy TShellExecuteInfo típusú struktúrát kell átadni, melyben a 'properties' igével adjuk meg, hogy a fájlinformációt akarjuk megjeleníteni.
  2. A lenti példa megjeleníti a Megnyitás párbeszédablakban (OpenDialog) kiválasztott fájl információs lapját.

uses ShellAPI;

{ . . . }

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var MyShellExecuteInfo : TShellExecuteInfo;
  FileChr : array [0..MAX_PATH] of Char;
begin
  {a Megnyitás párbeszédablak meghívása}
  if OpenDialog1.Execute then
  begin
   {a TShellExecuteInfo struktúra inicializálása}
   FillChar(MyShellExecuteInfo,
     SizeOf(TShellExecuteInfo), #0);
   StrPCopy (FileChr, OpenDialog1.FileName);
   {a TShellExecuteInfo struktúra feltöltése}
   MyShellExecuteInfo.cbSize := SizeOf(TShellExecuteInfo);
   MyShellExecuteInfo.lpFile := FileChr; // a fájl vagy könyvtár
   MyShellExecuteInfo.lpVerb := 'properties';
   MyShellExecuteInfo.fMask := SEE_MASK_INVOKEIDLIST;
   {a ShellExecuteEx függvény meghívása}
   ShellExecuteEx(@MyShellExecuteInfo);
  end;
end;
Az alábbi függvény visszaadja a paraméterként megadott könyvtárban található (normál, rendszer és rejtett) fájlok összméretét. A rekurzív algoritmus megvizsgálja a könyvtárban található összes alkönyvtárat is. A visszatérő értéket a függvény a DirBytes változóban tárolja el lefutás után.

uses FileCtrl;
...

var
  DirBytes : integer;
...

function TForm1.DirSize(Dir:string):integer;
var
  SearchRec : TSearchRec;
  Separator : string;
begin
  if Copy(Dir,Length(Dir),1)='\' then
   Separator := ''
  else
   Separator := '\';
   if FindFirst(Dir+Separator+'*.*',faAnyFile,SearchRec) = 0 then begin
    if FileExists(Dir+Separator+SearchRec.Name) then begin
     DirBytes := DirBytes + SearchRec.Size;
     {Memo1.Lines.Add(Dir+Separator+SearchRec.Name);}
    end else if DirectoryExists(Dir+Separator+SearchRec.Name) then begin
     if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then begin
     DirSize(Dir+Separator+SearchRec.Name);
    end;
   end; while FindNext(SearchRec) = 0 do begin
   if FileExists(Dir+Separator+SearchRec.Name) then begin
    DirBytes := DirBytes + SearchRec.Size;
    {Memo1.Lines.Add(Dir+Separator+SearchRec.Name);}
   end else if DirectoryExists(Dir+Separator+SearchRec.Name) then
    begin
    if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then begin
    DirSize(Dir+Separator+SearchRec.Name);
    end;
    end;
   end;
  end;
  FindClose(SearchRec);
end;
  1. Az alábbi eljárás elmenti egy StringGrid teljes tartalmát a 'C:\Grid.txt' fájlba:

    Procedure SaveGrid;
    var f : textfile;
      x,y : integer;
    begin
      assignfile (f,'c:\grid.txt');
      rewrite (f);
      writeln (f,stringgrid.colcount);
      writeln (f,stringgrid.rowcount);
      For X:=0 to stringgrid.colcount-1 do
       For y:=0 to stringgrid.rowcount-1 do
       writeln (F, stringgrid.cells[x,y]);
      closefile (f);
    end;
  2. Ez pedig feltölti a Grid celláit a megadott fájlból:
Procedure LoadGrid;
var f : textfile;
  temp,x,y : integer;
  tempstr : string;
begin
  assignfile (f,'c:\grid.txt');
  reset (f);
  readln (f,temp);
  stringgrid.colcount:=temp;
  readln (f,temp);
  stringgrid.rowcount:=temp;
  For X:=0 to stringgrid.colcount-1 do
   For y:=0 to stringgrid.rowcount-1 do
   begin
    readln (F, tempstr);
    stringgrid.cells[x,y]:=tempstr;
   end;
  closefile (f);
end;
  1. Az alábbi eljárással könnyen megoldható az egymásba ágyazott könyvtárak (könyvtárak és alkönyvtárak) egyidejű létrehozása:

    uses SysUtils, FileCtrl;

      . . .

    procedure MkDirMulti(sPath : string);
    begin
      if('\' = sPath[Length(sPath)])then
      begin
      sPath := Copy(sPath, 1, Length(sPath)-1);
      end;
      if( ( Length( sPath ) < 3 ) or
       FileCtrl.DirectoryExists(sPath) )then
      begin
    Exit;
    end;
      MkDirMulti(SysUtils.ExtractFilePath(sPath ) );
      try
      System.MkDir( sPath );
      except
      { kivételkezelés }
      end;
    end;

  2. Egy példa a használatára:
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      MkDirMulti('c:\temp\one\two\three\four' );
    end;
uses shellapi
procedure TForm1.Button1Click(Sender: TObject);
var
 icon:TIcon;
begin
 if Opendialog1.Execute then
  begin
   icon:=TIcon.Create;
   icon.Handle:=ExtractIcon(hInstance,PChar(Opendialog1.filename),0);
   DrawIcon(Form1.Canvas.Handle,10,10,icon.Handle);
   icon.Free;
  end;
end;

Megjegyzés:
Egy exe file-ban több ikon is lehet, én csak a default ikont szedtem ki, de ha a 0-t átjavítod 1-re, vagy 2..3.. akkor a többi ikon is láthatóvá vállik (winamp egészen biztos)

A shellexecute( hozzárendelés alapján indítja el az applikációt, az EXE hozzárendelése a %1 %*. A lenti példában közvetlen indítok el egy programfájlot, például a Project1.exe -t átkeresztelem Project1.jpg -re, és ennek ellenére elindítom a programot.

uses
  ShellApi...

{$R *.DFM}

procedure Execute(strProg: String);
var StartupInfo : TStartupInfo;
 ProcessInfo : TProcessInformation;
  ExitCode : DWORD;
begin
  StrPCopy(CmdLine, strProg);
  FillChar(StartupInfo, SizeOf(StartupInfo), 0);
  StartupInfo.cb := SizeOf(StartupInfo);
  StartupInfo.wShowWindow := SW_SHOWMINIMIZED;
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  CreateProcess(nil, PChar(CmdLine), nil, nil, False, 0, nil, nil,
  StartupInfo, ProcessInfo);
  CloseHandle(ProcessInfo.hThread);
  repeat
   Application.ProcessMessages;
  until not GetExitCodeProcess(ProcessInfo.hProcess, ExitCode) or
(ExitCode <> STILL_ACTIVE);
  CloseHandle(ProcessInfo.hProcess);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 execute('c:\Project1.jpg');
end;
end.

Ha egy programot elindítunk a saját applikációnkból, az alábbi módon meg is várhatjuk annak befejezését.

function ExecAndWait(const Filename, Params: string):boolean;
{$IFDEF WIN32}
var
  SUInfo: TStartupInfo;
  ProcInfo: TProcessInformation;
  CmdLine: string;
begin
  { Enclose filename in quotes to take care of long filenames with spaces. }
  CmdLine := Filename+' '+Params;
  FillChar(SUInfo, SizeOf(SUInfo), #0);
  with SUInfo do
  begin
   cb := SizeOf(SUInfo);
   dwFlags := STARTF_USESHOWWINDOW;
   wShowWindow := word(0);
  end;
  Result := CreateProcess(NIL, PChar(CmdLine), NIL, NIL, FALSE,
   CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, NIL,
   PChar(ExtractFilePath(Filename)), SUInfo, ProcInfo);
   { Wait for it to finish. }
   if Result then
   begin
    repeat
     application.ProcessMessages;
    until 0 = WaitForSingleObject(ProcInfo.hProcess, 10);
   { Clean up the handles. }
   CloseHandle(ProcInfo.hProcess);
   CloseHandle(ProcInfo.hThread);
  end;
{$ELSE}
var
  InstanceID : THandle;
  Buff: array[0..255] of char;
begin
  StrPCopy(Buff, Filename + ' ' + Params);
  InstanceID := WinExec(Buff, WindowState);
  if InstanceID < 32 then { a value less than 32 indicates an Exec error }
   Result := FALSE
  else begin
  Result := TRUE;
  repeat
   Application.ProcessMessages;
  until Application.Terminated;
end;
{$ENDIF}
END;

Megjegyzés:
Egy kicsit átjavítottam az eredeti példát, mert az mikor elindította az exe-t, akkor megfagyva várta a program befejeződését, a fenti példában már nem így van.
ExecAndWait('d:\nevezo.exe','');
Az Internet Explorer Toolbarjara rakhatunk képet a lenti megoldással:

uses Registry,...

procedure Toolbar(Path:string);
var reg:Tregistry;
begin
 reg:=TRegistry.Create;
 reg.RootKey := HKEY_CURRENT_USER;
 reg.OpenKey('SOFTWARE\Microsoft\Internet Explorer\Toolbar',true);
 reg.WriteString('BackBitmapIE5',Path);
 reg.WriteString('BackBitmapIE6',Path);
 reg.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 Toolbar('c:\gigas.bmp');
end;

Megjegyzés:
Internet Explorer 5, és 6-os verzióra jó, de szerintem csak a verziószámot kell átjavítani a jövőben.

A lenti példa a legegyszerübb megoldás egy fájl létrehozási idejének a megállapítására:

 string:=DateTimeToStr(FileDateToDateTime(Fileage('c:\a.jpg')))

Megjegyzés:
Fájlnak még az utoljára felülírt, és utoljára olvasott idejét is ki lehet olvasni, de oda már a Tsearchrec utasítás szükséges.
Három megoldás:
  1. Az első File Stram-et használ:

    Procedure FileCopy( Const sourcefilename, targetfilename: String );
    Var
      S, T: TFileStream;
    Begin
      S := TFileStream.Create( sourcefilename, fmOpenRead );
      try
       T := TFileStream.Create( targetfilename,fmOpenWrite or fmCreate );
       try
       T.CopyFrom(S, S.Size ) ;
       finally
       T.Free;
      end;
      finally
       S.Free;
      end;
    End;

  2. A második memóriablokkokat olvas és ír.
    procedure FileCopy(const FromFile, ToFile: string);
    var
      FromF, ToF: file;
      NumRead, NumWritten: Word;
      Buf: array[1..2048] of Char;
    begin
      AssignFile(FromF, FromFile);
      Reset(FromF, 1); { Rekord nagysága = 1 }
      AssignFile(ToF, ToFile); { Megnyitja a kimeneti fájlt }
      Rewrite(ToF, 1); { Rekord nagysága = 1 }
      repeat
       BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
       BlockWrite(ToF, Buf, NumRead, NumWritten);
      until (NumRead = 0) or (NumWritten <> NumRead);
       CloseFile(FromF);
       CloseFile(ToF);
    end;

  3. A harmadik pedig az LZCopy-t használja
    uses LZExpand;

    ...

    procedure CopyFile(FromFileName, ToFileName: string);
    var
      FromFile, ToFile: File;
    begin
      AssignFile(FromFile, FromFileName); {Assign FromFile to FromFileName}
      AssignFile(ToFile, ToFileName); {Assign ToFile to ToFileName}
      Reset(FromFile); {Open file for input }
      try
       Rewrite(ToFile); { Create file for output }
       try
       { ha negatív érték érkezik vissza a fájl másolásakor }
       { elindítja a kivételkezelőt }
       if LZCopy(TFileRec(FromFile).Handle, TFileRec(ToFile).Handle) < 0 then
       raise EInOutError.Create('Error using LZCopy')
      finally
       CloseFile(ToFile); { Bezárja a ToFile-t }
      end;
      finally
       CloseFile(FromFile); { Bezárja a FromFile-t }
      end;
    end;
Az alacsony szintű törléseknél - ilyet végez a DeleteFile eljárás is - a file letörlődik. A következő kódrészlet segítségével azonban, egy API hívást használva a kukába helyeződik át a file. Egy file törléséhez egyszerűen meg kell hívni a DeleteFileWithUndo() eljárást, paraméternek megadva a file nevét. Amennyiben a művelet sikeres volt, az eljárás TRUE-t ad vissza...

  ...

uses ShellAPI;

  ...

function DeleteFileWithUndo( sFileName : string ): boolean;
var
  fos : TSHFileOpStruct;
begin
  FillChar( fos, SizeOf( fos ), 0 );
  with fos do
  begin
   wFunc := FO_DELETE;
   pFrom := PChar( sFileName );
   fFlags := FOF_ALLOWUNDO
   or FOF_NOCONFIRMATION
   or FOF_SILENT;
  end;
  Result := ( 0 = ShFileOperation( fos ) );
end;
Fájlok attributumát lehet megváltoztatni a következő művelettel:

procedure TForm1.Button1Click(Sender: TObject);
var a:integer;
begin
 a:=GetFileAttributesa('c:\log.txt');
  {
  a=128 -semmi
  a=32 -archiv
  a=1 -csak olvasható
  a=2 -rejtett
  a=4 -system
  }
 ...

Megjegyzés:
Például ha egy fájlnak az attributumat rejtett+csak olvashatóra szeretnénk állítani, akkor:
SetFileAttributes('c:\log.txt',3);
(Fejléc nélküli) Form mozgatása a 'belsejénél fogva'.

A legegyszerűbb mód az, hogy elhiteted a Windows-zal, hogy kattintás a form fejlécén történt. Ezt a wm_NCHitTest üzenet lekezelésével tudod megtenni, mint azt a következő példa mutatja:
  {...}

private
  { Private declarations }
procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
  {...}

procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
begin
  inherited; // A szülőobjektum meghívása
  if M.Result = htClient then // A klikkelés a kliensterületen történt?
  M.Result := htCaption; // Ha igen, hitessük el a Windows-zal,
  // hogy az ablak fejlécén történt
end;
Ha azt akarjuk, hogy egy form ne látszódjon a program indulásakor, még csak egy pillanatra sem, azt a következő módon oldhatjuk meg.
Alap:

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

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Ezt javítjuk ki a következő képpen:

program Project1;

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

{$R *.RES}

begin
  Application.Initialize;
  application.ShowMainForm:=false;
  islibrary:=false;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Megjegyzés:
Ezzel a megoldással a formot nem eltüntetjük, hanem meg sem jelenítjük. Egy show utasítással megjelenik a form, és innentől minden a szokásos módon folytatódik.
Hatásos a következőkkel kombinálni:
  1. Csak egyszer futhet a program
  2. Ctrl+Alt+Del letiltása I.
  3. Ctrl+Alt+Del letiltása II.


Egy form tartalmát lekicsinyíthetjük úgy is, hogy nem kell átméretezni minden rajta található komponenst.
procedure TForm1.Button1Click(Sender: TObject);
begin
 scaleby(50,100);
end;

Megjegyzés:
A dolog szépséghibája csak az, hogy magát a formot nem méretezi kicsire.
uses ShellApi

 ...

private
  procedure WMDROPFILES(var Message: TWMDROPFILES);
  message WM_DROPFILES;
  { Private declarations }

...

procedure TForm1.WMDROPFILES(var Message: TWMDROPFILES);
var
  NumFiles : longint;
  i : longint;
  buffer : array[0..255] of char;
begin
 {How many files are being dropped}
  NumFiles := DragQueryFile(Message.Drop,-1,nil,0);
 {Accept the dropped files}
  for i := 0 to (NumFiles - 1) do begin
  DragQueryFile(Message.Drop,i,@buffer,sizeof(buffer));
  Form1.Memo1.Lines.Add(buffer);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DragAcceptFiles(Form1.Handle, True);
end;

Windows alatt futó programok listáját kapjuk meg a lenti példa segitségével, sőt még ki is lőhetjük azokat, ha a proggi sorszámát beirod a SpinEdit1-be, és nyomsz egy Buttont.

uses TLHelp32;

 ...

procedure TForm1.FormCreate(Sender: TObject);
var
  a:tHandle;
  b:tProcessEntry32;
begin
  a:=CreateToolHelp32SnapShot(TH32CS_SNAPALL,0);
  b.dwSize:=SizeOf(b);
  if Integer(Process32First(a,b))<>0 then
  repeat
  ListBox1.items.Append(IntToStr(b.th32ProcessID)+': '+b.szExeFile);
  until Integer(Process32Next(a,b))=0;
  closehandle(a);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  a:tHandle;
begin
  a:=OpenProcess(PROCESS_TERMINATE,bool(0),
  SpinEdit1.Value); {ide ird a kilovendo proggi sorszámát!!!}
  TerminateProcess(a,0);
  CloseHandle(a);
end;

Ez az egyszerű kis program futásidőben létrehoz négy gombot és egy címkét. A gombok lenyomásakor a címkén megjelenik a lenyomott gomb sorszáma.
A program futtatásához nem kell mást tenned, csak készíts egy új projectet, másold az alábbi szöveget a Unit1-be, és rendeld hozzá FormCreate eseménykezelőt a Form1 OnCreate eseményéhez (dupla kattintás a Formon vagy az Object Inspectorban).

unit Unit1;
interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
  procedure FormCreate(Sender: TObject);
  procedure ButtonClick(Sender: TObject);
  private
  { Private declarations }
  public
  { Public declarations }
end;
var
  Form1: TForm1;

implementation

{$R *.DFM}

const
  b = 4; {A létrehozandó gombok száma}
var
  ButtonArray : Array[0..b-1] of TButton; {A Gombokból álló tömb...}
  MessageBox: TLabel; {...és a címke definiálása}

procedure TForm1.FormCreate(Sender: TObject);
var
  loop : integer;
begin
  ClientWidth:=(b*60)+10; {A Form méretének}
  ClientHeight:=65; {meghatározása}
  MessageBox:=TLabel.Create(Self); {A címke létrehozása...}
  MessageBox.Parent:=Self;
  MessageBox.Align:=alTop; {...és tulajdonságainak}
  MessageBox.Alignment:=taCenter; {meghatározása}
  MessageBox.Caption:='Nyomj le egy gombot!';
  for loop:= 0 to b-1 do {A Gombok létrehozása...}
  begin
   ButtonArray[loop]:=TButton.Create(Self);
   with ButtonArray[loop] do
    begin
    Parent :=self; {...és tulajdonságaiknak}
    Caption :=IntToStr(loop); {meghatározása}
    Width :=50;
    Height :=25;
    Top :=30;
    Left :=(loop*60)+10;
    Tag :=loop; {Ez mondja meg, hogy melyik gombot}
    OnClick :=ButtonClick; {nyomtuk le...}
    end;
  end;
end;

procedure TForm1.ButtonClick(Sender: TObject);
var
  t : Integer;
begin
  t:=(Sender as TButton).Tag; {A Gomb azonosítójának megállapítása}
  MessageBox.Caption:='Az '+IntToStr(t)+'. számú gombot nyomtad le.';
end;
end.
A Wave output hangerejének lekérdezése/beállítása a WaveOutGetVolume és WaveOutSetVolume eljárásokkal lehetséges. Figyelni kell arra, hogy a WaveOutGetVolume pointernek tudja csak átadni a hangerőt. A két rutin az MMSYSTEM unitban található. A Line in, és a Midi hangerejének beállítását ugyanígy kell csinálnod, a megfelelő eljárások az AuxSetVolume, AuxGetVolume (Line In), illetve a MidiOutSetVolume és a MidiOutGetVolume (Midi). A hangerőt DWORD-ben kapod, kell megadnod, aminek az alsó 16 bit-je az egyik, a felső 16 bit-je pedig a másik oldal hangerejét adja meg, amennyiben az egység támogatja a Stereo hangot.

var
  VolumeControlHandle: hWnd;
  pCurrentVolumeLevel: PDWord;
  CurrentVolumeLevel: DWord;
begin
  VolumeControlHandle:=FindWindow('Volume Control',nil);
  {lekérdezés:}
  New(pCurrentVolumeLevel);
  WaveOutGetVolume(VolumeControlHandle,pCurrentVolumeLevel);
  CurrentVolumeLevel:=pCurrentVolumeLevel^;
  Dispose(pCurrentVolumeLevel);
  {beállítás:}
  if WaveOutSetVolume(VolumeControlHandle,CurrentVolumeLevel)<>0 then
  ShowMessage('Nem tudtam beállítani a hangerőt!');
end;

A task list (control+alt+del) -ből tüntethetjük el a programunkat, így akár egy teljes applikációt láthatatlanná lehet tenni az oprendszer/felhasználó számára. Igaz, hogy a megoldás csak win9x/me alatt működik.

implementation
function RegisterServiceProcess (dwProcessID, dwType: DWord) : DWord; stdcall; external 'KERNEL32.DLL';

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
 RegisterServiceProcess(GetCurrentProcessID,1);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 RegisterServiceProcess(GetCurrentProcessID,0);
end;

Megjegyzés:
NT alatt nem működik, de ott is lehet trükközni: kilövöd az internat nevü applikációt, ez rakja ki az óra mellé azt a kék HU ikont, bemásolod magad a windows\system könyvtárba internat.exe néven, te is kirakod a HU ikont, és már láthatatlan is vagy. (na jó, kell még pár dolog, hogy ne vegyenek észre, fájl létrehozási dátuma, meg mérete, de az már semmiség)
Avagy billentyükombináció, ami minden applikációból elérhető

private
procedure hotykey(var msg:TMessage); message WM_HOTKEY;

 . . .

var
 Form1: TForm1;
 id:Integer;

 . . .

procedure TForm1.hotykey(var msg:TMessage);
begin
 caption:=inttostr(msg.LParamHi);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 id:=GlobalAddAtom('hotkey');
 RegisterHotKey(handle,id,mod_shift,65);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 UnRegisterHotKey(handle,id);
end;

Megjegyzés:
A "Shift+a" betü lenyomására lefut a HOTKEY procedura, mindegy, hogy milyen applikációban van a windows, és egyben le is nyeli a rendszer a leütött billentyüt.
mod_alt , mod_control , mod_shift , mod_win
Példánkban egy mp3 kiterjesztésnek a hozzárendelési útvonalát kérdezzük le

implementation
uses
 {$IFDEF WIN32}
  Registry; {We will get it from the registry}
  {$ELSE}
  IniFiles; {We will get it from the win.ini file}
 {$ENDIF}
 {$IFNDEF WIN32}
  const MAX_PATH = 144;
 {$ENDIF}

 . . .

function GetProgramAssociation (Ext : string) : string;
var
 {$IFDEF WIN32}
  reg: TRegistry;
  s : string;
 {$ELSE}
  WinIni : TIniFile;
  WinIniFileName : array[0..MAX_PATH] of char;
  s : string;
 {$ENDIF}
begin
 {$IFDEF WIN32}
  s := '';
  reg := TRegistry.Create;
  reg.RootKey := HKEY_CLASSES_ROOT;
  if reg.OpenKey('.' + ext + '\shell\open\command',
  false) <> false then begin
  {The open command has been found}
  s := reg.ReadString('');
  reg.CloseKey;
  end else begin
  {perhaps thier is a system file pointer}
  if reg.OpenKey('.' + ext,
  false) <> false then begin
  s := reg.ReadString('');
  reg.CloseKey;
  if s <> '' then begin
  {A system file pointer was found}
  if reg.OpenKey(s + '\shell\open\command',
  false) <> false then
  {The open command has been found}
  s := reg.ReadString('');
  reg.CloseKey;
  end;
  end;
end;
{Delete any command line, quotes and spaces}
if Pos('%', s) > 0 then
Delete(s, Pos('%', s), length(s));
if ((length(s) > 0) and
(s[1] = '"')) then
Delete(s, 1, 1);
if ((length(s) > 0) and
(s[length(s)] = '"')) then
Delete(s, Length(s), 1);
while ((length(s) > 0) and
((s[length(s)] = #32) or
(s[length(s)] = '"'))) do
Delete(s, Length(s), 1);
{$ELSE}
GetWindowsDirectory(WinIniFileName, sizeof(WinIniFileName));
StrCat(WinIniFileName, '\win.ini');
WinIni := TIniFile.Create(WinIniFileName);
s := WinIni.ReadString('Extensions',ext,'');
WinIni.Free;
{Delete any command line}
if Pos(' ^', s) > 0 then
Delete(s, Pos(' ^', s), length(s));
{$ENDIF}
result := s;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetProgramAssociation('mp3'));
end;


Megjegyzés:
Próbálkoztam az elérési útvonal megváltoztatásával, ami egy fél óra alatt össze is jött úgy,
hogy az utolsó reg.readstring helyére reg.WriteString('','d:\sajat.exe'); -t írtam, de mivel ez szerintem nem a legszabályosabb, ezért nem csináltam belőle külön példát.
A Windows 95/98 és az NT is kijelöl egy könyvtárat az ideiglenes fájloknak. A felhasználók azonban
gyakran megváltoztatják ennek a könyvtárnak a helyét, és az így már nem a Windows alapállapot
szerinti helyen lesz.

A GetTempPath Windows API függvény visszaadja az ideiglenes (Temporary) könyvtár aktuális helyét
(elérési útját):
function GetTempDirectory : String;
var TempDir : array [0..255] of Char;
begin
GetTempPath(255, @TempDir);
Result := StrPas(TempDir);
end;

A GetTempPath függvény az ideiglenes könyvtár elérési útját a következő sorrendben adja vissza:
  1. a TMP környezetben meghatározott változó;
  2. a TEMP környezetben meghatározott változó, ha a TMP nincs meghatározva;
  3. az aktuális könyvtár, ha sem a TMP, sem a TEMP nincs meghatározva.
2001,1,15 1:12.20.0 -ból kivonom a 2001,1,14 23:01.01.01 -et


procedure TForm1.Button1Click(Sender: TObject);
var
de,da,di:Tdatetime;
ev,ho,nap ,ora,perc,mperc,milisec:word;
begin
de:=encodedate(2001,1,14)+encodetime(23,01,01,01);
da:=encodedate(2001,1,15)+encodetime(1,12,20,0);
di:=da-de;
decodedate(di,ev,ho,nap);
decodetime(di,ora,perc,mperc,milisec);
label1.Caption:=inttostr(ev-1899);
label2.Caption:=inttostr(ho-12);
label3.Caption:=inttostr(nap-30);
label4.Caption:=inttostr(ora);
label5.Caption:=inttostr(perc);
label6.Caption:=inttostr(mperc);
label7.Caption:=inttostr(milisec);
end;
Megjegyzés:
Így fejből nem is tudom, hogy hány évet számol a windows, de neki csak 1899-12-30 -tól indul az
időszámítás, bár a fenti példának nem számított a windows ilyen jellegü korlátoltsága.
A desktopra (ami a monitorodon van) teszünk képet a lenti példával

procedure TForm1.Button1Click(Sender: TObject);
var
dc:HDC;
begin
dc:=GetDc(0);
bitblt(dc,0,0,width,height,image1.Canvas.Handle,0,0,srccopy);
end;

Megjegyzés:
A desktop, amit a windows használ közvetlen grafikus felületként, erre raktam rá az image1 képét.
Egy form bezárás gombjának inaktívvá tétele:

procedure TForm1.Button1Click(Sender: TObject);
var
hSysMenu: HMENU;
begin
hSysMenu := GetSystemMenu(Self.Handle, False);
if hSysMenu <> 0 then begin
EnableMenuItem(hSysMenu, SC_CLOSE,
MF_BYCOMMAND Or MF_GRAYED);
DrawMenuBar(Self.Handle);
end;
KeyPreview := True;
end;

Példánkat próbáljuk ki, a form alapvető méreteinek a kimentésével

uses Inifiles

...

procedure TForm1.FormCreate(Sender: TObject);
var
Ini: TIniFile;
dir:string;
begin
dir:=ExtractFilePath(Application.ExeName);
Ini := TIniFile.Create(dir + 'Ablak.ini');
try
Left := Ini.ReadInteger('Window', 'Left', Left);
Top := Ini.ReadInteger('Window', 'Top', Top);
Width := Ini.ReadInteger('Window', 'Width', Width);
Height := Ini.ReadInteger('Window', 'Height', Height);
Edit1.Text:=Ini.ReadString('Window', 'Szoveg','Eredeti');
CheckBox1.Checked:=Ini.ReadBool('Window', 'Kijeloles',true);
except
//
end;
Ini.Free;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
Ini: TIniFile;
dir:string;
begin
dir:=ExtractFilePath(Application.ExeName);
Ini := TIniFile.Create(dir + 'Ablak.ini');
try
Ini.WriteInteger('Window', 'Left', Left);
Ini.WriteInteger('Window', 'Top', Top);
Ini.WriteInteger('Window', 'Width', Width);
Ini.WriteInteger('Window', 'Height', Height);
Ini.WriteString('Window', 'Szoveg', Edit1.text);
Ini.WriteBool('Window', 'Kijeloles',CheckBox1.Checked);
except
//
end;
Ini.Free;
end;

Megjegyzés:
Mit is csinálunk?
Width := Ini.ReadInteger('Window', 'Width', Width);
integer:=ini.readinteger(adatcsoport_neve , adat_megnevezése , adat_ha_még_nincs_érték);
1. uses ShellAPI

2. Helyezz egy TLabel komponenst a Formra.

3. Állítsd a Font.Style tulajdonságát fsUnderline-ra, a Cursor tulajdonságát pedig crHandPoint-ra.

4. Majd add a következő WinAPI függvényt az OnClick eseményéhez:
ShellExecute(Handle,'open', 'http://www.yahoo.com' ,'','',
SW_SHOWMAXIMIZED);
Amennyiben pedig egy e-mail címre akarsz hivatkozni, akkor azt add meg a függvény harmadik
paraméterében. Például így:

ShellExecute(Handle,'open', 'mailto:valaki@valahol.net' ,'','',
SW_SHOWNORMAL);
implementation
{$R *.DFM}

function kapcsolat(lpdwFlags: LPDWORD;
dwReserved: DWORD): BOOL; stdcall; external 'wininet.dll' name 'InternetGetConnectedState';

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if kapcsolat(pdword(0),0)=false then
label1.Caption:='Nincs internet kapcsolat'
else
label1.Caption:='Van internet kapcsolat';
end;

Megjegyzés:
win2000, win98 -on megy a dolog, de minden olyan operációs rendszeren menni kelli, ahol a
wininet.dll fájl megtalálható.
Ez az egyszerű öt lépésből álló módszer bemutatja, hogy hogyan kell beépíteni JPEG fájlokat a
program EXE-be, majd azokat onnan használni.
  1. 1. Készíts egy ún. 'Resource script' fájlt (MyPic.RC) egy egyszerű szövegszerkesztővel, mint például
    a Jegyzettömb, és add hozzá az alábbi sort:
    1 RCDATA "MyPic.jpg"

    Az első bejegyzés (1) az erőforrás sorszáma. A második bejegyzés (RCDATA) meghatározza, hogy egy
    felhasználó által megadott erőforrásról van szó. A harmadik, utolsó bejegyzés a használni kívánt
    JPEG fájl neve.

  2. 2. Használd a Borland Erőforrás-szerkesztőjét (BRCC32.EXE) a létrehozott RC fájl lefordításához. Ez
    az RC fájlból egy bináris Erőforrás (Resource) fájlt (*.RES) hoz létre. Futtatásához a DOS
    parancssorba írd az alábbiakat:
    BRCC32 MyPic.RC
    Ez létrehozza a 'MyPic.RES' nevű RES fájlt.
  3. 3. A következő fordítási direktívával utasítjuk a fordítót, hogy az elkészült erőforrás-fájlt építse
    bele a programba:
    {$R *.DFM}
    {$R MyPic.RES}
  4. 4. Add a következő eljárást a programhoz:

    procedure LoadJPEGfromEXE;
    var
    MyJPG : TJPEGImage; // JPEG objektum
    ResStream : TResourceStream; // Resource Stream objektum
    begin
    try
    MyJPG := TJPEGImage.Create;
    ResStream := TResourceStream.CreateFromID(HInstance, 1, RT_RCDATA);
    MyJPG.LoadFromStream(ResStream); // Ennyi az egész...
    Canvas.Draw(12,12,MyJPG); // Megrajzolja a képet
    finally
    MyJPG.Free;
    ResStream.Free;
    end;
    end; // procedure
    Figyeld meg a TResourceStream komponens CreateFormID eljárás második paraméterét. Ez hívja meg az
    erőforrás-fájlból a kívánt fájlt, méghozzá egyszerűen az erőforrás sorszámát megadva.

    Természetesen a fent leírt módon több JPEG fájlt is beleágyazhatunk a program EXE-be. Ehhez a
    különböző JPEG fájloknak külön sorban más-más sorszámot kell adni a Resource (.RC) Fájlban.

  5. 5. Hívd meg valahonnan az eljárást és már kész is az egész.
Kedvencek mappa tartalma:

uses shlobj;

function GetIEFavorites(const favpath: string):TStrings;
var searchrec:TSearchrec;
str:TStrings;
path,dir,filename:String;
Buffer: array[0..2047] of Char;
found:Integer;
begin
str:=TStringList.Create;
//Get all file names in the favourites path
path:=FavPath+'\*.url';
dir:=ExtractFilepath(path);
found:=FindFirst(path,faAnyFile,searchrec);
while found = 0 do
begin
//Get now URLs from files in variable files
SetString(filename, Buffer,
GetPrivateProfileString('InternetShortcut',
PChar('URL'), NIL, Buffer, SizeOf(Buffer),
PChar(dir+searchrec.Name)));
str.Add(filename);
found := FindNext(searchrec);
end;
found:=FindFirst(dir+'\*.*',faAnyFile,searchrec);
while found=0 do
begin
if ((searchrec.Attr and faDirectory) > 0) and
(searchrec.Name[1]<>'.') then
str.AddStrings(GetIEFavorites(dir+'\'+searchrec.name));
found := FindNext(searchrec);
end;
FindClose(searchrec);
Result:=str;
end;

procedure TForm1.Button1Click(Sender: TObject);
var pidl: PItemIDList;
FavPath: array[0..MAX_PATH] of char;
begin
//get the favorites folder
SHGetSpecialFolderLocation(Handle, CSIDL_FAVORITES, pidl);
SHGetPathFromIDList(pidl, favpath);
ListBox1.Items:=GetIEFavorites(StrPas(FavPath));
end;

Megjegyzés:
-Button1.,Listbox1. -komponensek kellenek!
A menüpontokhoz egy kis kép (BMP) hozzáadása nem egy túl nehéz feladat. A hozzárendeléshez a
SetMenuItemBitmaps API hivatkozást használhatjuk az alábbiak szerint:

procedure TForm1.FormCreate(Sender: TObject);
var
Bmp1 : TPicture;
Bmp2 : TPicture;
begin
Bmp1 := TPicture.Create;
Bmp1.LoadFromFile('C:\Dokumentumok\ikon1.bmp');
Bmp2 := TPicture.Create;
Bmp2.LoadFromFile('C:\Dokumentumok\ikon2.bmp');
SetMenuItemBitmaps( FileMenu.Handle,
0,
MF_BYPOSITION,
Bmp1.Bitmap.Handle,
Bmp2.Bitmap.Handle);
end;

  1. Először létrehozza az egyik (Checked) képet, majd hozzárendeli a képet tartalmazó fájlt.
  2. Létrehozza a másik (Unchecked) képet is. Ehhez is hozzárendeli a megadott fájlt.
  3. Meghívja a SetMenuItemBitmaps API hívást a megadott paraméterekkel:
Megjegyzés:
A képeknek csak a bal felső sarka fog látszani, ha a kép túl nagy lenne a rendelkezésére álló
helyhez képest.
Sajnos a jelölés nem változik meg automatikusan, de ezen könnyen lehet segíteni, ha az adott
menüpont OnClick eseményébe az alábbi sorkat írjuk:

procedure TForm1.MyComp1Click(Sender: TObject);
begin
if MyComp1.Checked then
MyComp1.Checked:=False
else MyComp1.Checked :=True
end;
Monitor felbontását változtathatjuk meg az alábbi példával

{$R *.DFM}

procedure SetRes(XRes, YRes: DWord);
var
lpDevMode : TDeviceMode;
begin
EnumDisplaySettings(nil, 0, lpDevMode);
lpDevMode.dmFields:=DM_PELSWIDTH or DM_PELSHEIGHT;
lpDevMode.dmPelsWidth:=XRes;
lpDevMode.dmPelsHeight:=YRes;
ChangeDisplaySettings(lpDevMode, 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
SetRes(800,600);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
SetRes(1024,768);
end;

Megjegyzés:
Ez az első olyan megoldás, ahol a monitor frekvenciáját nem cseszi össze a monitor felbontásának az
átállítása.
1. Az aktuális képernyőfelbontás megállapításához a GetSystemMetrics() Windows API függvényt
használhatjuk. Ez a függvény a paramétertől függően a Windows különböző méretbeállításaival illetve
egyéb konfiurációs információkkal tér vissza.

Jelen esetben az alábbi négy paraméter lehet segítségünkre a feladat megoldásában:
SM_CXSCREEN - a teljes képernyő szélességét adja vissza pixelben.
SM_CYSCREEN - a teljes képernyő magasságát adja vissza pixelben.
SM_CXFULLSCREEN - egy teljes méretű ablak kliens-területének teljes szélessége pixelben.
SM_CYFULLSCREEN - egy teljes méretű ablak kliens-területének teljes magasságát adja vissza
pixelben. (az SM_CYSCREEN értékből levonva az ablakok fejlécmagassága és a Taskbar magassága)

2. Lássunk egy példát a fenti függvény alkalmazására: Az alábbi eljárás egy gomb lenyomására egy
üzenetablakban megjeleníti a képernyőfelbontás aktuális értékeit és egy teljes méretű ablak kliens
-területének maximális értékét.
procedure TForm1.Button1Click(Sender: TObject);
var scrWidth, scrHeight : Integer;
mclWidth, mclHeight : Integer;
begin
scrWidth := GetSystemMetrics(SM_CXSCREEN);
scrHeight := GetSystemMetrics(SM_CYSCREEN);
mclWidth := GetSystemMetrics(SM_CXFULLSCREEN);
mclHeight := GetSystemMetrics(SM_CYFULLSCREEN);
ShowMessage('Képernyőfelbontás: ('+
IntToStr(scrWidth)+ 'x'+
IntToStr(scrHeight)+ ')'+
#13 +
'Max. kliensterület: ('+
IntToStr(mclWidth)+ 'x'+
IntToStr(mclHeight)+ ')');
end;
string:= lowercase('atlanta');
Megjegyzés:
A string értéke "atlanta" lesz, kisbetüvel, illetve nagybetü lesz, ha a "lowercase" helyett "uppercase
"-t hasznalsz.
A C:\a könyvtárat törli a program, a teljes helyben tárolt tartalommal

uses shellapi

function deldir(dir: String): boolean;
var fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos do begin
wFunc := FO_DELETE;
fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
pFrom := PChar(dir+#0);
end;
Result:=(0=ShFileOperation(fos));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
deldir('c:\a');
end;

Megjegyzés:
Nem a lomtárba töröl!
Az alábbi példa bemutatja, hogy hogyan lehet használni a Windows könytárválasztó párbeszédablakját
az SHBrowseForFolder Win32API függvény segítségével.
{ . . . }

implementation
uses shlobj;
{$R *.DFM}

function ShellShowDirs ( AHandle : HWND ): string ;
var
BrowsingInfo : TBrowseInfo ; // BrowsingInfo;
DirPath : String ; // char DirPath[MAX_PATH];
FolderName : string ; // char FolderName[MAX_PATH];
pItemId : PItemIDList; // LPITEMIDLIST; ItemID;
begin
DirPath := '' ;
FolderName := '' ;
DirPath := StringOfChar(' ', MAX_PATH);
FolderName := StringOfChar (' ' , MAX_PATH) ;
// A párbeszédablak tulajdonságai
BrowsingInfo.hwndOwner := AHandle ; // self.Handle ;
BrowsingInfo.pszDisplayName := PChar(FolderName) ;
BrowsingInfo.lpszTitle := PAnsiChar
('Válassz egy könyvtárat!');
BrowsingInfo.ulFlags := BIF_RETURNONLYFSDIRS
and BIF_DONTGOBELOWDOMAIN ;
BrowsingInfo.pidlRoot := nil ;
BrowsingInfo.lpfn := nil ;
// A párbeszédablak megjelenítése
pItemID := SHBrowseForFolderA( BrowsingInfo );
// A választott könyvtár megállapítása
SHGetPathFromIDList(pItemID, PChar(DirPath));
result := PChar(DirPath) ;
// pItemId által lefoglalt memória felszabadítása
GlobalFreePtr(pItemID);
end;

procedure TForm1.SelDirBtnClick(Sender: TObject);
var
sDir : string ;
begin
sDir := ShellShowDirs (self.Handle);
if ( length(sDir) > 0 ) then
ShowMessage ('A választott könyvtár:'+ #13 + sDir )
else
ShowMessage ('Nem választott könyvtárat.') ;
end ;
Egy könyvtárat és teljes tartalmát az alábbi módon lehet átmásolni egy adott helyre:
implementation
uses ShellAPI;

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
FOS :TSHFileOpStruct;
begin
with FOS do begin
Wnd := Self.Handle;
wFunc := FO_COPY; //Másolás
pFrom := 'c:\idapi\*.*'; //Honnan, mely fájlokat?
pTo := 'c:\proba'; //Hová? (célkönyvtár)
fFlags := FOF_NoConfirmMkDir; //Kérdés nélkül létrehozza
end; //az új (cél)könyvtárat.
SHFileOperation(FOS);
end;

Ha a könyvtárat és tartalmát nem másolni, hanem áthelyezni szeretnéd, akkor a FO_COPY helyett
FO_MOVE beállítást kell használnod.
A SetWindowRgn eljárás segítségével csinálhatod meg, azonban ez előtt még létre kell hoznod egy
Region objektumot, aminek olyan az alakja, amilyet szeretnél. Ez tartalmazhat téglalapot, kört és
ellipszist, illetve ezeknek a kombinációját. Javallott, hogy a Form.BorderStyle-t állítsd bsNone-ra.
Példa egy kör alakú ablak létrehozására:

procedure TForm1.FormCreate(Sender: TObject);
var
hR: THandle;
begin
{Legyen ugyanolyan széles az objektumunk, mint amilyen magas}
width:=height;
{Hozzuk létre a Region-t}
hR := CreateEllipticRgn(0,0,Width+1,Height+1);
{Állítsuk be az ablak alakját}
SetWindowRgn(Handle,hR,True);
end;
Az alábbi példaprogram létrehoz egy kör alakú, lyukas Formot, amelynek hajlított, a kör szélére
illeszkedő fejléce van.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, Menus, StdCtrls;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
rTitleBar : THandle;
Center : TPoint;
CapY : Integer;
Circum : Double;
SB1 : TSpeedButton;
RL, RR : Double;
procedure TitleBar(Act : Boolean);
procedure WMNCHITTEST(var Msg: TWMNCHitTest);
message WM_NCHITTEST;
procedure WMNCACTIVATE(var Msg: TWMNCACTIVATE);
message WM_NCACTIVATE;
procedure WMSetText(var Msg: TWMSetText);
message WM_SETTEXT;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

CONST
TitlColors : ARRAY[Boolean] OF TColor =
(clInactiveCaption, clActiveCaption);
TxtColors : ARRAY[Boolean] OF TColor =
(clInactiveCaptionText, clCaptionText);

procedure TForm1.FormCreate(Sender: TObject);
VAR
rTemp, rTemp2 : THandle;
Vertices : ARRAY[0..2] OF TPoint;
X, Y : INteger;
begin
Caption := 'OOOH! Doughnuts!';
BorderStyle := bsNone; {fontos!!!}
IF Width > Height THEN Width := Height
ELSE Height := Width;
Center := Point(Width DIV 2, Height DIV 2);
CapY := GetSystemMetrics(SM_CYCAPTION)+8;
rTemp := CreateEllipticRgn(0, 0, Width, Height);
rTemp2 := CreateEllipticRgn((Width DIV 4), (Height DIV 4),
3*(Width DIV 4), 3*(Height DIV 4));
CombineRgn(rTemp, rTemp, rTemp2, RGN_DIFF);
SetWindowRgn(Handle, rTemp, True);
DeleteObject(rTemp2);
rTitleBar := CreateEllipticRgn(4, 4, Width-4, Height-4);
rTemp := CreateEllipticRgn(CapY, CapY, Width-CapY, Height-CapY);
CombineRgn(rTitleBar, rTitleBar, rTemp, RGN_DIFF);
Vertices[0] := Point(0,0);
Vertices[1] := Point(Width, 0);
Vertices[2] := Point(Width DIV 2, Height DIV 2);
rTemp := CreatePolygonRgn(Vertices, 3, ALTERNATE);
CombineRgn(rTitleBar, rTitleBar, rTemp, RGN_AND);
DeleteObject(rTemp);
RL := ArcTan(Width / Height);
RR := -RL + (22 / Center.X);
X := Center.X-Round((Center.X-1-(CapY DIV 2))*Sin(RR));
Y := Center.Y-Round((Center.Y-1-(CapY DIV 2))*Cos(RR));
SB1 := TSpeedButton.Create(Self);
WITH SB1 DO
BEGIN
Parent := Self;
Left := X;
Top := Y;
Width := 14;
Height := 14;
OnClick := Button1Click;
Caption := 'X';
Font.Style := [fsBold];
END;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Close;
End;

procedure TForm1.WMNCHITTEST(var Msg: TWMNCHitTest);
begin
Inherited;
WITH Msg DO
WITH ScreenToClient(Point(XPos,YPos)) DO
IF PtInRegion(rTitleBar, X, Y) AND
(NOT PtInRect(SB1.BoundsRect, Point(X,Y))) THEN
Result := htCaption;
end;

procedure TForm1.WMNCActivate(var Msg: TWMncActivate);
begin
Inherited;
TitleBar(Msg.Active);
end;

procedure TForm1.WMSetText(var Msg: TWMSetText);
begin
Inherited;
TitleBar(Active);
end;

procedure TForm1.TitleBar(Act: Boolean);
VAR
TF : TLogFont;
R : Double;
N, X, Y : Integer;
begin
IF Center.X = 0 THEN Exit;
WITH Canvas DO
begin
Brush.Style := bsSolid;
Brush.Color := TitlColors[Act];
PaintRgn(Handle, rTitleBar);
R := RL;
Brush.Color := TitlColors[Act];
Font.Name := 'Arial';
Font.Size := 12;
Font.Color := TxtColors[Act];
Font.Style := [fsBold];
GetObject(Font.Handle, SizeOf(TLogFont), @TF);
FOR N := 1 TO Length(Caption) DO
BEGIN
X := Center.X-Round((Center.X-6)*Sin(R));
Y := Center.Y-Round((Center.Y-6)*Cos(R));
TF.lfEscapement := Round(R * 1800 / pi);
Font.Handle := CreateFontIndirect(TF);
TextOut(X, Y, Caption[N]);
R := R - (((TextWidth(Caption[N]))+2) / Center.X);
IF R < RR THEN Break;
END;
Font.Name := 'MS Sans Serif';
Font.Size := 8;
Font.Color := clWindowText;
Font.Style := [];
end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
WITH Canvas DO
BEGIN
Pen.Color := clBlack;
Brush.Style := bsClear;
Pen.Width := 1;
Pen.Color := clWhite;
Arc(1, 1, Width-1, Height-1, Width, 0, 0, Height);
Arc((Width DIV 4)-1, (Height DIV 4)-1,
3*(Width DIV 4)+1, 3*(Height DIV 4)+1, 0, Height, Width, 0);
Pen.Color := clBlack;
Arc(1, 1, Width-1, Height-1, 0, Height, Width, 0);
Arc((Width DIV 4)-1, (Height DIV 4)-1,
3*(Width DIV 4)+1, 3*(Height DIV 4)+1, Width, 0, 0, Height);
TitleBar(Active);
END;
end;
end.
procedure TForm1.FormPaint(Sender: TObject);
var dx,dy: real;
i,j: word;
aa,bb,iteration,MaxIteration:byte;
a,b,old_a: real;
begin
bb:=7;
MaxIteration:=80;
dx:=3/Form1.Width;
dy:=2.8/Form1.Height;
for j:=0 to Form1.Height do
for i:=0 to Form1.Width do begin
a:=0;
b:=0;
iteration:=0;
repeat
old_a:= a;
a:= a*a - b*b + -2+i*dx;
b:= 2*old_a*b + -1.4+j*dy;
inc(iteration);
until (a*a+b*b > 4) or (iteration > MaxIteration);
aa:=iteration;
case aa of
0..2:Form1.Canvas.Pixels[i,j]:=rgb(aa*bb,aa*bb,aa);
3..6:Form1.Canvas.Pixels[i,j]:=rgb(aa*bb,aa*bb,aa);
7..10:Form1.Canvas.Pixels[i,j]:=rgb(aa*bb,aa*bb,aa);
11..14:Form1.Canvas.Pixels[i,j]:=rgb(aa*bb,aa*bb,aa);
15..18:Form1.Canvas.Pixels[i,j]:=rgb(aa*bb,aa*bb,aa);
19..22:Form1.Canvas.Pixels[i,j]:=rgb(aa*bb,aa*bb,aa);
23..26:Form1.Canvas.Pixels[i,j]:=rgb(aa*bb,aa*bb,aa);
27..30:Form1.Canvas.Pixels[i,j]:=rgb(aa*bb,aa*bb,aa);
31..34:Form1.Canvas.Pixels[i,j]:=rgb(aa*bb,aa*bb,aa);
35..38:Form1.Canvas.Pixels[i,j]:=rgb(aa*bb,aa*bb,aa);
39..42:Form1.Canvas.Pixels[i,j]:=rgb(aa*bb,aa*bb,aa);
43..45:Form1.Canvas.Pixels[i,j]:=rgb(aa*bb,aa*bb,aa);
46..49:Form1.Canvas.Pixels[i,j]:=rgb(aa*bb,aa*bb,aa);
50..53:Form1.Canvas.Pixels[i,j]:=rgb(aa*bb,aa*bb,aa);
54..57:Form1.Canvas.Pixels[i,j]:=rgb(aa*bb,aa*bb,aa);
58..61:Form1.Canvas.Pixels[i,j]:=rgb(aa*bb,aa*bb,aa);
62..65:Form1.Canvas.Pixels[i,j]:=rgb(aa*bb,aa*bb,aa);
66..69:Form1.Canvas.Pixels[i,j]:=rgb(aa*bb,aa*bb,aa);
70..77:Form1.Canvas.Pixels[i,j]:=rgb(aa*bb,aa*bb,aa);
80..255:Form1.Canvas.Pixels[i,j]:=rgb(0,0,0);
end;
end;
end;

Megjegyzés:
Aki tud hasonló matematikán alapuló rajzolós procedurát, az küldje el a címemre!
Ritkán fordul elő, hogy egy "E" meghajtóról kéne megállapítani, hogy az hdd, vagy cd-rom. Ezt
mutatja be az alábbi példa.

procedure TForm1.Button1Click(Sender: TObject);
var
i,typ: Integer;
c,forma: String;
begin
for i:=Ord('A') to Ord('Z') do
begin
c:=chr(i)+':\';
typ:=GetDriveType(PChar(c));
case typ of
0: forma:=C+' valami hiba';
1: forma:=C+' ez is valami hiba';
Drive_Removable: forma:=C+'Drive_Removable';
Drive_Fixed: forma:=C+'Drive_Fixed';
Drive_Remote: forma:=C+'Drive_Remote';
Drive_Cdrom: forma:=C+'Drive_Cdrom';
Drive_Ramdisk: forma:=C+'Drive_Ramdisk';
end;
if not ((typ=0) or (typ=1)) then
ListBox1.Items.AddObject(forma, Pointer(i));
end;
end;
Egy egyszerű módja az alkalmazás által felhasznált memória csökkentésének - feltéve, hogy a
program nem használ OLE-t - az, hogy felszabadítod az OLE-hoz szükséges DLL-eket.
FreeLibrary(GetModuleHandle('OleAut32'));
Ez az eljárás felszabadítja az OleAut32.dll-t és az OLE32.dll-t, így az alkalmazás közel 1MB-tal
kevesebb memóriát használ a RAM-ból.
Már amelyik monitoron van ilyen funkció

Monitor kikapcsolása:

procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(Application.Handle, WM_SYSCOMMAND,
SC_MONITORPOWER, 1);
end;

Monitor bekapcsolása:

procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(Application.Handle, WM_SYSCOMMAND,
SC_MONITORPOWER, 0);
end;

Megjegyzés:
Persze ez a megoldás a képernyőkímélő meghívása(még akkor is, ha nincs a gépeden ez a funkció
bekapcsolva), és ebből következik, hogy egér-billentyü változásokra egyszerre bekapcsol a monitorod.
Aki *.mpeg videót akar lejátszani, és kezdő, akkor csak valamilyen komponensre tud gondolni, pedig a
delphi része az mp3, és az mpg (szintén komponens) :) A Mediaplayer1-kompi tudja ezeket.

procedure TForm1.Button1Click(Sender: TObject);
begin
MediaPlayer1.FileName:='C:\tt.mpg';
MediaPlayer1.open;
MediaPlayer1.Display:=panel1;
MediaPlayer1.DisplayRect:=Panel1.ClientRect;
MediaPlayer1.Play;
end;

Megjegyzés:
A fenti példában tul.képpen mindegy, hogy a filename-hoz mpeg, mpg, mp3-at töltessz, a proggi ugyis
a fájl tartalmából állapítja meg, hogy mi is az.
No comment

procedure TForm1.Timer1Timer(Sender: TObject);
var
DC: HDC;
color: TColorRef;
pont:Tpoint;
begin
getcursorpos(pont);
DC:=GetDC(0);
try
Color:=GetPixel(DC,pont.x,pont.y);
Win32Check(Color<>CLR_INVALID);
form1.Color:=color;
finally
ReleaseDC(0,DC);
end;
end;

Megjegyzés:
A form színe egyenlő lesz a kurzor alatti pixel színével
A TComponent minden leszármazottja egy CM_MOUSEENTER illetve CM_MOUSELEAVE üzenetet küld amikor az
egér belép vagy kilép a komponens keretein. Ahhoz, hogy ezeket az üzeneteket 'elkapjuk' egy
üzenetkezelő eljárást kell létrehoznunk. Az alábbi példa egy Formon lévő három címke (Label) és egy
jelölőnégyzet (CheckBox) szövegének színét változtatja meg a kurzor belépésekor és kilépésekor.
// Fölül kell írni a WndProc eljárást
procedure WndProc(var Message : TMessage); override;
procedure ChangeColor(Sender : TObject; Msg : Integer);
...
procedure TForm1.WndProc(var Message : TMessage);
begin
// Melyik komponens fölött van a kurzor?
// Annak a színe változzon!
if Message.LParam = Longint(Label1) then
ChangeColor(Label1, Message.Msg);
if Message.LParam = Longint(Label2) then
ChangeColor(Label2, Message.Msg);
if Message.LParam = Longint(Label3) then
ChangeColor(Label3, Message.Msg);
if Message.LParam = Longint(CheckBox1) then
ChangeColor(CheckBox1, Message.Msg);
inherited WndProc(Message);
end;

procedure TForm1.ChangeColor(Sender : TObject; Msg : Integer);
Begin
// Ha Címke (Label) fölött van a kurzor

If Sender Is TLabel Then
Begin
if (Msg = CM_MOUSELEAVE) then
(Sender As TLabel).Font.Color := clWindowText;
if (Msg = CM_MOUSEENTER) then
(Sender As TLabel).Font.Color := clBlue;
End;

// Ha CheckBox fölött van a kurzor
If Sender Is TCheckBox Then
Begin
if (Msg = CM_MOUSELEAVE) then
(Sender As TCheckBox).Font.Color := clWindowText;
if (Msg = CM_MOUSEENTER) then
(Sender As TCheckBox).Font.Color := clRed;
End;
End;

A szín megváltoztatása helyett bárilyen más eseményt meg lehet határozni...
Óra beállítása saját programból.

procedure TForm1.Button1Click(Sender: TObject);
var ti:Tsystemtime;
begin
getlocaltime(ti);
ti.wYear:=1956;
ti.wMonth:=3;
ti.wDay:=31;
ti.wHour:=20;
ti.wMinute:=10;
ti.wSecond:=2;
setlocaltime(ti);
end;

Megjegyzés:
A getlocaltime utasítás itt csak azért szerepel, hogy a lehetőséget megadjam az idő esetleges
kiolvasásához. (a:=ti.wYear;)
Delphiben egy exe több 100 KB. Az alábbi példában csak 16384 Byte.

program Project1;
uses
windows,
messages;

procedure MainPaint(hWindow:HWND; pt:TPaintStruct);
begin
SetBkMode(pt.hdc,TRANSPARENT);
TextOut(pt.hdc,10,10,'Xakk, ohh yeahh!',13 );
end;

procedure MainDestroy(hWindow: HWND);
begin
PostQuitMessage(0);
end;

function MainWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
LParam: LPARAM): LRESULT; stdcall; export;
var ps: TPaintStruct;
begin
Result := 0;
case Msg of
WM_PAINT: begin
BeginPaint(hWindow, ps);
MainPaint(hWindow,ps);
EndPaint( hWindow, ps );
end;
WM_DESTROY: MainDestroy(hWindow);
else begin
result := DefWindowProc( hWindow, Msg, wParam, lParam );
exit;
end;
end; // case
end;

var
wc: TWndClass;
hWindow: HWND;
Msg: TMsg;
begin
wc.lpszClassName := 'GenericAppClass';
wc.lpfnWndProc := @MainWndProc;
wc.style := CS_VREDRAW or CS_HREDRAW;
wc.hInstance := hInstance;
wc.hIcon := LoadIcon(0,IDI_QUESTION);
wc.hCursor := LoadCursor(0,IDC_ARROW);
wc.hbrBackground := (COLOR_WINDOW+1);
wc.lpszMenuName := nil;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
RegisterClass(wc);
hWindow := CreateWindowEx(WS_EX_CONTROLPARENT or WS_EX_WINDOWEDGE,'GenericAppClass',
'API',WS_VISIBLE or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or WS_OVERLAPPEDWINDOW,CW_USEDEFAULT,0,400,300,0,0,hInstance, nil);
ShowWindow(hWindow,CmdShow);
UpDateWindow(hWindow);
// Message Loop
while GetMessage(Msg, 0, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
Halt(Msg.wParam);
end.

Néhány applikációval kapcsolatos parancs

PostMessage(Handle,wm_SysCommand,Sc_Minimize,0);
-applikáció minimálás
PostMessage(Handle,wm_SysCommand,Sc_Maximize,0);
-applikáció maximálás
PostMessage(Handle,wm_SysCommand,Sc_Restore,0);
-applikáció visszahozás
PostMessage(Handle,wm_SysCommand,Sc_Nextwindow,0);
-következő applikáció
PostMessage(Handle,wm_SysCommand,Sc_Prevwindow,0);
-előző applikáció
PostMessage (Handle, WM_SYSCOMMAND, SC_CONTEXTHELP, 0);
-help cursor az első kattintásig
3 példa bemutatása a shellexecute használatával, saját applikációnkból való külső program
elindításához.

Mindegyik programhoz be kell írni
uses shellapi, ...
különben nem működik
Az első példa egy weblapot nyit meg:

procedure TForm1.Button1Click(Sender: TObject);
begin
shellexecute(handle,'open','http://ize.com',nil,nil,sw_shownormal);
end;

A másodikban a Winampot idítom el, egy mp3 hozzárendelésével:

procedure TForm1.Button1Click(Sender: TObject);
begin
shellexecute(handle,'open','C:\Program Files\Winamp\winamp.exe',
'D:\Mp3\Five.mp3',nil,sw_shownormal);
end;

A harmadikban több mp3-at rendelek a winamphoz, itt érdemes megfigyelni, hogy az mp3-ak között egy
szóközt kell hagyni.

procedure TForm1.Button1Click(Sender: TObject);
begin
shellexecute(handle,'open','C:\Program Files\Winamp\winamp.exe'
, 'D:\Mp3\Five.mp3 D:\Mp3\Floorfilla.exe',nil,sw_shownormal);
end;
procedure TForm1.Button1Click(Sender: TObject);
const
PBM_SETBARCOLOR = $0409;
YourColor = clgreen;
begin
SendMessage(ProgressBar1.Handle, PBM_SETBARCOLOR, 0, YourColor);
end;
A lenti példa a GetDC(0) Windows API függvény által visszaadott DC-t használva a WinAPI rajzoló
funkciókkal a Windows asztalra rajzol egy ferde fekete vonalat.

procedure TForm1.Button1Click(Sender: TObject);
var dc : hdc;
begin
dc := GetDc(0);
MoveToEx(Dc, 0, 0, nil);
LineTo(Dc, 300, 300);
ReleaseDc(0, Dc);
end;
DC (Device Context) - Kapcsolat egy windows alkalmazás, egy eszközmeghajtó (driver) és egy kimeneti
eszköz (pl. képernyő) között.
function GetDC(Wnd: HWnd): HDC; - visszaadja egy megadott ablak kliensterületére vonatkozó DC
kezelőjét (Handle).
function ReleaseDC(Wnd: HWnd; DC: HDC): Integer; - felszabadítja az adott DC-t, hogy azt más
alkalmazások is használhassák.
function MoveToEx(DC: HDC; nX, nY: Integer; Point: PPoint): Bool; - az aktuális pozíciót az x és y
paraméterekben megadott pontra helyezi.
function LineTo(DC: HDC; X, Y: Integer): Bool; - az aktuális pozíciótól a megadott pontig egy
vonalat húz és az aktuális pozíciót a paraméterben megadott pontra állítja.
Saját applikáció directory-jára szinte mindig szükség van, ha valamit ki akarunk menteni.

procedur
e TForm1.Button1Click(Sender: TObject); var
a:string;
begin
a:=extractfilepath(application.exename);
end;
Szeretnéd, hogy a programodhoz saját kiterjesztésü fájlok kapcsolódjanak? Úgy, mint a Winamp-hoz az
mp3-as fájlok? Nem egy ördöngős dolog egy fájl kiterjesztését magadra irányítani, bár a windows
fennállása óta már 3x változtatták, a w95, w98, w98me, w2000, w2000xp -n biztosan menni fog. Ha
jobban megnézed a kódot, akkor feltünhet, hogy 2x-esen bebiztosítottam.
uses
Registry...

{$R *.DFM}

function hozzarendeles(kiterjesztes,path:string;ikon_szama:integer):boolean;
var reg:Tregistry;
s:string;
begin
s:='xakk_'+copy(kiterjesztes,2,length(kiterjesztes)-1);
reg:=Tregistry.create;
reg.RootKey := HKEY_CLASSES_ROOT;
reg.OpenKey(kiterjesztes,true);
reg.WriteString('',s);
reg.OpenKey('shell\open\command',true);
reg.WriteString('','"'+path+'"'+' "%1"');
reg.CloseKey;
reg.OpenKey(kiterjesztes+'\Defaulticon',true);
reg.WriteString('',path+','+inttostr(ikon_szama));
reg.CloseKey;
reg.CloseKey;
reg.OpenKey(s + '\shell\open\command',true);
reg.WriteString('','"'+path+'"'+' "%1"');
reg.CloseKey;
reg.OpenKey(s+'\Defaulticon',true);
reg.WriteString('',path+','+inttostr(ikon_szama));
reg.CloseKey;
form1.caption:=path;
reg.free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
hozzarendeles('.ziz','d:\papa.exe',0);
end;
end.

Megjegyzés:
Na ja! A fenti *.ziz kiterjesztésü fájlt már magadra irányítottad, de a d:\papa.exe nevü
programodnak ezt fel is kell fogni valahogy:

procedure TForm1.FormCreate(Sender: TObject);
var a:integer;
begin
for a:=0 to paramcount do if paramcount <> 0 then
listbox1.Items.Add(paramstr(a));
end;

Még az előzőkhöz annyit, hogy:
hozzarendeles('.ziz','d:\papa.exe',0);
ahol a 0 az exe-ben tárolt ikon sorszáma!
Ha a menüeseményekkel a Shift, Ctrl vagy Alt billentyük állapotától függö utasítást akarsz
végrehajtani, akkor a következő példában szemléltetett módon lehet megtudni, hogy az adott
billentyűk le vannak-e nyomva vagy sem mikor a menure kattintunk.

procedure TForm1.Menu1Click(Sender: TObject);
begin
{Check if Shift key is down}
if HiWord(GetKeyState(VK_SHIFT)) <> 0 then
Label1.Caption := 'Shift'
else
{Check if Ctrl key is down}
if HiWord(GetKeyState(VK_CONTROL)) <> 0 then Label1.Caption := 'Control'
else
{Check if Alt key is down}
if HiWord(GetKeyState(VK_MENU)) <> 0 then
Label1.Caption := 'Alt'
else
Label1.Caption := 'None';
end;
Egy hátborzongató technikai megoldás, akinek a windows-át így piszkálgatod, az biztos elküld
melegebb éghajlatra.
Nincs:

procedure TForm1.Button1Click(Sender: TObject);
var x1,x2:hwnd;
begin
x1:=findwindow('shell_traywnd',nil);
x2:=getwindow(x1,gw_child);
showwindow(x2,0);
end;

Van:

procedure TForm1.Button1Click(Sender: TObject);
var x1,x2:hwnd;
begin
x1:=findwindow('shell_traywnd',nil);
x2:=getwindow(x1,gw_child);
showwindow(x2,1);
end;
Ha olyan Formot akarunk készíteni, amely mindig legfölül (a többi ablak fölött) marad, akkor
használhatjuk a Delphi "FormStyle" tulajdonságának "fsStayOnTop" beállítását. Azonban, ha
futásidőben változtatjuk meg ezt a tulajdonságot, az villan egyet amikor az új módra átvált Az alábbi API hívás e zavaró villanás nélkül éri el, hogy a Form legfelül maradjon (mindig látszon):

SetWindowPos(Form1.Handle, HWND_TOPMOST, Form1.Left, Form1.Top,
Form1.Width, Form1.Height, 0);

Helyettesítsd be a "Form1"-et a saját Formod nevével és már kész is. Ha Form helyzetét vissza akarod
állítani normálra, akkor azt a következő módon teheted meg:
SetWindowPos(Form1.Handle, HWND_NOTOPMOST, Form1.Left, Form1.Top,
Form1.Width, Form1.Height, 0);
StayOnTop

Ha egy applikációban több Form van, és azt szeretnénk, hogy az összesnek StayOnTop tulajdonsága
legyen, akkor nem elég az összes form FormStyle propertyét StayOnTop-ra állítani, mert ez a
delphinek egy alapvető hibája (csak egy form használata esetében működik), hanem külön meg kell írni
API szinten.

SetWindowPos(Handle, HWND_TOPMOST,
Left, Top, Width, Height,
SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
Megjegyzés:
A fenti kódot minden formnak a FormCreate procedurájába be kell bigyeszteni. procedure TForm1.Button1Click(Sender: TObject);
var D: TCopyDataStruct;
t: PChar;
s:string;
begin
s:='Biztosithatom önöket arról, hogy nem lesz tübb gázáremelés';
t := StrAlloc(length(s));
try
t := StrPLCopy(t, s, Length(s));
D.cbData := Length(t) + 1;
D.lpData := t;
SendMessage(masik applikáció HANDLE-ja, WM_COPYDATA, 0, integer(@D));
finally
StrDispose(t);
end;
end;

Masik applikációban:

private
procedure WMCopyData(var msg: TMessage); message WM_COPYDATA;
...
procedure Tform1.WMCopyData;
var
D: PCopyDataStruct;
P: PChar;
begin
D := PCopyDataStruct(msg.LParam);
P := PChar(D.lpData);
form1.caption:=p;
end;

procedure TForm1.Button1Click(Sender: TObject);
const
a:string='atlanta';
b:string='ikaro';
begin
A:='ATLANTA';
B:='IKARO';
ASM
PUSH EAX
PUSH EBX
PUSH ECX
MOV EAX, DWORD ptr a //EAX= ATLANTA VALOS POINTERE A MEMORIABAN
MOV EBX, DWORD ptr B //EBX= IKARO VALOS POINTERE A MEMORIABAN
MOV CL, [EBX+4] //CL = IKARO-BOL AZ UTOLSO 'O'
MOV BYTE ptr [EAX+1], CL //ATLANTA POINTER (T-BETU) ='O'
POP ECX
POP EBX
POP EAX
END;
caption:=a;
end;
Megjegyzés:
Tehát caption = 'aotlanta'
Egy System Tray alkalmazás elkészítése alapvetően három fő lépésre bontható le:
a) A program ikonjának hozzáadása a SysTray-hez.
b) Menü (ill. események) hozzárendelése az ikonhoz.
c) A program FőFormjának elrejtése. (ha szükséges)
A program ikonjának hozzáadása a System Tray-hez
1. A feladat megoldása a Shell_NotifyIcon(dwMessage, lpData) Windows API függvény használatával
történik. A függvény első paramétere egy üzenet, amely meghatározza, hogy mit teszünk az ikonnal, a
második pedig egy az ikon adatstruktúrájára vonatkozó mutató (pointer). Mivel ez az adatstruktúra a
ShellAPI unitban van deklarálva (TNotifyIconData), ezért azt bele kell foglalni a uses klauzulába.

2. Ezután a Form deklarációjának private részében létre kell hozni egy TNotifyIconData típusú
változót az alábbi módon:

private
{ Private declarations }
TrayIcon: TNotifyIconData;

3. Majd a Form On Create eseményében rendeljük hozzá a megfelelő értékeket ehhez a változóhoz és
hívjuk meg a Shell_NotifyIcon API függvényt.

procedure TForm1.FormCreate(Sender: TObject);
begin
with TrayIcon do
begin
cbSize := SizeOf(TrayIcon);
Wnd := Handle; {A FőForm Handle-je }
uId := 100;
uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
uCallBackMessage := WM_USER + 1;{A Formnak küldött üzenet azonosítója}
hIcon := Application.Icon.Handle; {A megjelenítendő ikon Handle-je}
szTip := 'Az ikonhoz tartozó tipp...'; {Az ikonhoz tartozó tipp}
end;
Shell_NotifyIcon(NIM_ADD, @TrayIcon); {A függvény meghívása}
end;

A megadott értékek a későbbiekben a NIM_MODIFY üzenettel változtathatók meg. Egyszerűen rendeljük
hozzá az új értékeket a változóhoz és hívjuk meg a függvényt. Például így:
StrPCopy(TrayIcon.szTip, Application.Title);
Shell_NotifyIcon(NIM_MODIFY, @TrayIcon);

FONTOS! Az alkalmazás bezárásakor ne feledjük el a NIM_DELETE üzenettel eltávolítani az ikont a
System Tray-ből.
Shell_NotifyIcon(NIM_DELETE, @TrayIcon);

 Ahhoz, hogy az alkalmazást kezelni tudjuk magából a létrehozott ikonból az ikonhoz hozzá kell
rendelni egy menüt (vagy egyéb eseményeket).

1. Először helyezz a Formra egy előugró menüt (TPopupMenu) és határozd meg az egyes menüpontok
OnClick eseményéhez tartozó eljárásokat (pl. kilépés, a Form elrejtése ill. mutatása).

2. Ezt követően a WndProc eljárás felülírásával elérjük, hogy a SysTray-ben elhelyezkedő ikon
"válaszoljon" az általunk meghatározott üzenetekre.

private
{ Private declarations }
procedure WndProc(var Msg: TMessage); override;

. . .

procedure TForm1.WndProc(var Msg: TMessage);
var p : TPoint;
begin
case Msg.Msg of WM_USER + 1 : //az üzenet azonosítója
case Msg.LParam of
WM_RBUTTONDOWN : //kattintás az egér jobb gombjával
begin
GetCursorPos(p); //a kurzor pozíciója a kattintáskor
PopupMenu1.Popup(p.x,p.y); //a menü kinyitása
end;
WM_LBUTTONDBLCLK : //bal dupla-kattintás
begin
Form1.Show;
end;
WM_LBUTTONDOWN : //kattintás az egér bal gombjával;
end;
end;
inherited; //a le nem kezelt üzenetek elintéztetése
end;

Egyéb hasznos dolgok

1. Ha azt akarjuk elérni, hogy a FőForm a program indulásánál teljesen rejtve maradjon, akkor a
Project fájlban (az Application.Run előtt) állítsuk be a következő alkalmazás-tulajdonságot:

Application.ShowMainForm:= False;

2. Abban az esetben, ha nem szeretnénk a FőForm (rendszergombokkal történő) bezárásakor kilépni a
programból, csupán a System Tray-be kívánjuk "ledobni", akkor a Form OnClose eseményét az alábbiak
szerint kell meghatároznunk:

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:= caNone;
Form1.Hide;
end;

A program bezárását ilyenkor a SysTray-ikon egy menüparancsával érdemes megoldani. Mégpedig a
következő módon:

procedure TForm1.meExitClick(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE, @TrayIcon);
Application.ProcessMessages;
Application.Terminate;
end;
Ahhoz, hogy az alkalmazást kezelni tudjuk magából a létrehozott ikonból az ikonhoz hozzá kell
rendelni egy menüt (vagy egyéb eseményeket).
  1. Először helyezz a Formra egy előugró menüt (TPopupMenu) és határozd meg az egyes menüpontok
    OnClick eseményéhez tartozó eljárásokat (pl. kilépés, a Form elrejtése ill. mutatása).
  2. Ezt követően a WndProc eljárás felülírásával elérjük, hogy a SysTray-ben elhelyezkedő ikon
    "válaszoljon" az általunk meghatározott üzenetekre.
       private
       { Private declarations }
       procedure WndProc(var Msg: TMessage); override;

       . . .

    procedure TForm1.WndProc(var Msg: TMessage);
    var p : TPoint;
    begin
       case Msg.Msg of WM_USER + 1 : //az üzenet azonosítója
         case Msg.LParam of
           WM_RBUTTONDOWN : //kattintás az egér jobb gombjával
           begin
          GetCursorPos(p); //a kurzor pozíciója a kattintáskor
           PopupMenu1.Popup(p.x,p.y); //a menü kinyitása
         end;
         WM_LBUTTONDBLCLK : //bal dupla-kattintás
         begin
           Form1.Show;
         end;
         WM_LBUTTONDOWN : //kattintás az egér bal gombjával;
         end;
       end;
      inherited; //a le nem kezelt üzenetek elintéztetése
    end;

Egyéb hasznos dolgok

  1. Ha azt akarjuk elérni, hogy a FőForm a program indulásánál teljesen rejtve maradjon,
    akkor a Project fájlban (az Application.Run előtt) állítsuk be a következő alkalmazás-tulajdonságot:

       Application.ShowMainForm:= False;

  2. Abban az esetben, ha nem szeretnénk a FőForm (rendszergombokkal történő) bezárásakor kilépni a
    programból, csupán a System Tray-be kívánjuk "ledobni", akkor a Form OnClose eseményét az alábbiak
    szerint kell meghatároznunk:

    procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
    begin
       Action:= caNone;
       Form1.Hide;
    end;

A program bezárását ilyenkor a SysTray-ikon egy menüparancsával érdemes megoldani.
Mégpedig a következő módon:

procedure TForm1.meExitClick(Sender: TObject);
begin
   Shell_NotifyIcon(NIM_DELETE, @TrayIcon);
   Application.ProcessMessages;
   Application.Terminate;
end;

Kapcsolódó témakörök és komponensek

A futó program ikonjának eltüntetése a tálcáról (Taskbarról) + vissza
 Az alkalmazás FőFormjának elrejtése

A Windows System könyvtárának helyét a GetSystemDirectory függvénnyel tudjuk megállapítani.
(Ennek a függvénynek a DOS-os megfelelője a GetSystemDir, amelyet azonban nem használhatunk
windowsos alkalmazásban.)
Az alábbi függvény visszaadja a Windows System könyvtárának helyét (elérési útját):

function FindSystemDir : string;
var
   pSystemDir : array [0..255] of Char;
   sSystemDir : string;
begin
   GetSystemDirectory (pSystemDir, 255);
   sSystemDir := StrPas (pSystemDir);
   Result := sSystemDir ;
end;
  1. Egy meghajtó teljes méretének és az azon rendelkezésre álló szabad lemezterületnek a
    megállapítására a Delphi alábbi két függvényét használhatjuk:

    DiskSize() - visszaadja bájtokban a paraméterben átadott meghajtó teljes méretét.
    DiskFree() - viszaadja bájtokban a paraméterben átadott meghajtón rendelkezésre álló szabad
    lemezterületet. (Érvénytelen meghajtó megadása esetén mindkét függvény -1-gyel tér vissza.)
    Mindkét függvény egyetlen paramétere a meghajtó jelölőszáma.
    1. 0 = aktuális meghajtó, ahonnan a program EXE-t indították;
    2. 1 = A:\ meghajtó;
    3. 2 = B:\ meghajtó;
    4. 3 = C:\ meghajtó;
    5. 4 = D:\ meghajtó stb.
    2. 2. Egy példa a fenti két függvény használatára:

procedure TForm1.Button1Click(Sender: TObject);
var TotalFree, TotalSize : Integer;
begin
   TotalFree := DiskFree(3);
   if TotalFree <> -1 then
   begin
     TotalSize := DiskSize(3);
     if TotalSize <> -1 then
     begin
       TotalFree := TotalFree div 1024;
       TotalSize := TotalSize div 1024;
       ShowMessage('Disk Free: '+format('%d',[TotalFree]) + ' kb' + #13 + 'Disk Size: '+format('%d',[TotalSize]) + ' kb');
     end;
   end;
end;
Az alábbi példaprogram bemutatja, hogy hogyan lehet egy színátmenetes Formot létrehozni.
A példában a Form színe feketéből áttűnik a színválasztó párbeszédablakban (ColorDialogBox)
megadott színbe.
A színek manipulálására a GetRValue(), GetBValue(), GetGValue() és az RGB() Win32 API függvényeket, a Form megfestésére pedig a TCanvas.MoveTo() és a TCanvas.LineTo() eljárásokat használjuk.
unit Unit1;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type
TForm1 = class(TForm)
   Button1: TButton;
   ColorDialog1: TColorDialog;
   procedure Button1Click(Sender: TObject);b
   procedure FormPaint(Sender: TObject);
   procedure FormCreate(Sender: TObject);
private
   { Private declarations }
   EndColor:TColor;
public
   { Public declarations }
end;

var
   Form1: TForm1;

implementation

  {$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
   {A végszín bekérése}
   ColorDialog1.Execute;
   EndColor := ColorDialog1.Color;
   {A Form Paint eseményének meghívása}
   Repaint;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
   x,GradientDistance,GradientWidth : Integer;
   tmpColor : TColor;
   NewRed,NewGreen,NewBlue : Byte;
   EndRed,EndGreen,EndBlue : Byte;
begin
   {Ha nincs beállítva végszín, kilép.}
   if EndColor = clBlack then Exit;
   {A tmpcolor inicializálása}
   tmpColor := EndColor;
   {A színátmenet hossza}
   GradientDistance := Height;
   {A színátmenet szélessége}
   GradientWidth := Width;
   {A vörös, zöld és kék kezdőértékei}
   EndRed := GetRValue(EndColor);
   EndBlue := GetBValue(EndColor);
   EndGreen := GetGValue(EndColor);
   {Átmenet a kezdő és a végső színérték közt}
   for x := 1 to GradientDistance do
   begin
     {A szín vörös, zöld és kék összetevőinek
     beállítása az aktuális távolságnak a
     teljes távolsághoz viszonyított arányában}
     NewRed := (x*EndRed) div GradientDistance;
     NewBlue := (x*EndBlue) div GradientDistance;
     NewGreen := (x*EndGreen) div GradientDistance;
     {Az új szín megadása a megváltozott vörös, zöld
     kék színeknek megfelelően}
     tmpColor := RGB(NewRed,NewGreen,NewBlue);
     {Az új festőszín beállítása}
     Canvas.Pen.Color := tmpColor;
     {A vonalnak az új színnel való megrajzolása}
     Canvas.MoveTo(0,x);
     Canvas.LineTo(GradientWidth,x);
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  {A végszín kezdeti értékének megadása}
   EndColor := clBlack;
end;
end.
Az alábbi példában a DBGrid OnDrawColumnCell eseményével a feltétel(ek)nek megfelelő cellákat
fogjuk más színnel jelölni.
  1. Hozz létre egy új Formot. Helyezz rá egy TTable, egy DataSource és egy DBGrid komponenst.
  2. A TTable mutasson az EMPLOYEE.DB adatbázisra a DBDEMOS 'adatbázis-csoportban'.
    A DataSource mutasson a TTable-re, a DBGrid pedig a DataSource-re.
  3. Másold az alábbi kódot a DBGrid OnDrawColumnCell eseményébe:
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer;
     Column: TColumn; State: TGridDrawState);
var holdColor: TColor;
begin
   holdColor := DBGrid1.Canvas.Brush.Color; {eltárolja az eredeti színt}
   if Column.FieldName = 'EmpNo' then {csak az EmpNo oszlopban}
   if (Column.Field.AsInteger mod 2 <> 0) then {ha páratlan}
   begin
     DBGrid1.Canvas.Brush.Color := clGreen;
     DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);
     DBGrid1.Canvas.Brush.Color := holdColor;
   end;
end;

Tehát a fönti eljárás az EmpNo oszlopban a páratlan értéket tartalmazó cellákat zöldre 'festi'.
Ennek során a TCustomDBGrid komponensben (amely a TDBGrid-nek a 'szülője') meghatározott
DefaultDrawColumnCell eljárást használja.
Egy technikai megoldás, aminek semmi értelme, de azért bemutatom:

procedure TForm1.Button1Click(Sender: TObject);
var
  x1:Thandle;
  x2:array[0..50]of char;
begin
  strcopy(@x2[0],'shell_traywnd');
  x1:=findwindow(@x2[0],nil);
  showwindow(x1,sw_hide);
end;

És vissza:

procedure TForm1.Button1Click(Sender: TObject);
varb   x1:Thandle;
  x2:array[0..50]of char;
begin
  strcopy(@x2[0],'shell_traywnd');
  x1:=findwindow(@x2[0],nil);
  showwindow(x1,sw_restore);
end;
Egy gyakran használt alkalmazás a programokban a tálca-ikon eltüntetés:
Tálcaikon eltüntetés, és visszavarázsolás:

procedure TForm1.Button1Click(Sender: TObject);
begin
  showwindow(application.handle,sw_hide);
end;

És vissza:

procedure TForm1.Button1Click(Sender: TObject);
begin
  showwindow(application.handle,sw_restore);
end;

Megjegyzés:
Tapasztalat, hogy több form használatakor nem működik a megoldás.
Aki a tálcaikont el akarja tüntetni, annak 99%-ban egyáltalán nem kell a tálcaikon.
Egy Form1.Show, Application.Restore, vagy a program indulása mindenképpen megjeleníti a tálcaikont,
és ha a program indulásakor kiadjuk az utasitást: showwindow(application.handle,sw_hide);
még igy is bevillan, ami egy bug a programozó számára. De van megoldás:

program Project1;
uses
   Forms,windows,
   Unit1 in 'Unit1.pas' {Form1};
{$R *.RES}
var ExtendedStyle : Integer;
begin
   Application.Initialize;
   ExtendedStyle:=GetWindowLong(Application.Handle, GWL_EXSTYLE);
   SetWindowLong(Application.Handle, GWL_EXSTYLE,ExtendedStyle or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
   Application.CreateForm(TForm1, Form1);
   Application.Run;
end.

A lenti programmal ugy elindítom az EXECUTE procedurát, mintha az egy másik applikáció lenne.
Ez a procedúra teljesen önállóan viselkedik a mi applikációnktól, akár még le is fagyhat,
a fő applikáció ettől még vígan fut.

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TMyThread = class(TThread)
private
public
procedure Execute; override;
end;

type
TForm1 = class(TForm)
Button2: TButton;
procedure Button2Click(Sender: TObject);
private
  { Private declarations }
public
  { Public declarations }
end;

var
Form1: TForm1;
MyThread: TMyThread;
implementation

{$R *.DFM}

procedure TMyThread.Execute;
const s:byte=0;
var
  x,y,a:integer;
begin
  for x:=0 to 10000 do
  begin
    form1.caption:=inttostr(x);
    inc(s);
  end;
  MyThread.DoTerminate;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  MyThread := TMyThread.Create(false);
  canvas.TextOut(0,0,'Készen van');
end;
end.

Megjegyzés:
A threadnak akár még a prioritását is állíthatjuk: FThread.Priority:=tpHighest;
Időigényes számításokat, vagy nyomtatást érdemes ilyen szálakkal letudni, ha nem akarunk közben ezekre várakozni.
Ha azt szeretnénk, hogy egy komponensnek ne csupán egy, hanem több sorból álló Hint-je (gyorstippje?)
legyen, akkor azt az alábbi módszerrel könnyen megoldhatjuk.
  1. Állítsuk az adott komponens ShowHint tulajdonságát True-ra, de a Hint tulajdonságnak ne adjunk meg semmit.
  2. Ezután a Form OnCreate eseményében az alábbi módon adjunk értéket a komponens Hint tulajdonságának.
    A megoldás lényege a soremelő karakter (#13 vagy Chr(13)).

    procedure TForm1.FormCreate(Sender: TObject);
    var Datum : string;
    begin
       Datum := FormatDateTime('dddddd', Now);
       Form1.Hint := 'A mai dátum:' + #13 + Datum
    end;
Új directoryt hozhatunk létre az alábbi módon:

procedure TForm1.Button1Click(Sender: TObject);
begin
  {$I-}
  mkdir('c:\wawa');
  {$I+}
  if ioResult=0 then kész else rossz'
end;

Megjegyzés:
Ahol a "{$I-}" arra kell, hogy ha már van olyan directory, akkor ne akadjon le a program.

A fájl utolsó hozzáférésének (használatának) időpontját az alábbi eljárással tudod megjeleníteni.
(A kérdéses fájl nevét (elérési útját) az AnyFile.FIL helyére kell behelyettesíteni.)

procedure TForm1.Button1Click(Sender: TObject);
var
   FileHandle : THandle;
  LocalFileTime : TFileTime;
   DosFileTime : DWORD;
   LastAccessedTime : TDateTime;
   FindData : TWin32FindData;
begin
   FileHandle := FindFirstFile('AnyFile.FIL', FindData);
   if FileHandle <> INVALID_HANDLE_VALUE then
   begin
     Windows.FindClose(Handle);
     if (FindData.dwFileAttributes and
     FILE_ATTRIBUTE_DIRECTORY) = 0 then
     begin
       FileTimeToLocalFileTime(FindData.ftLastWriteTime,LocalFileTime);
       FileTimeToDosDateTime(LocalFileTime,LongRec(DosFileTime).Hi,LongRec(DosFileTime).Lo);
       LastAccessedTime := FileDateToDateTime(DosFileTime);
       Label1.Caption := DateTimeToStr(LastAccessedTime);
     end;
   end;
end;
Van egy egyszerü megoldás két applikáció közötti adatátvitelre, 2 integer tipusu szám átvitele, a PostMessage -val.

PostMessage( másik Applikáció handle-ja , message -csatorna , adat1:integer , adat2:integer );
Üzenetküldő Applikáció:

uses Messages,WinProcs
const messa = wm_app +1;
. . .

procedure TForm1.Button1Click(Sender: TObject);
var HWND:THandle;
begin
  HWND:=FindWindow('TForm1','atlanta'); // a másik applikáció form1.caption -ja "atlanta" !!
  if HWND<> 0 then
  begin
    PostMessage(HWND,messa,888,999);
  end;
end;

Üzenet fogadó Applikáció:
{a form caption-ja legyen "atlanta", mert ezt fogja keresni a hívó Applikáció!!!}

const messa = wm_app +1;

private
procedure uzenet(var msg:Tmsg); message messa;

{$R *.DFM}

procedure Tform1.uzenet;
var a,b:integer;
begin
  a:=msg.message; //az egyik integer (888)
  b:=msg.wparam; //a másik integer (999)
end;

Megjegyzés:
Az üzenetküldő proggi először is megkeresi a másik üzenet fogadó applikáció handle-ját
a form1.caption -ja alapján, aminek "atlanta" -nak kell lennie. A többi világos.
Én szöveget is át szoktam vele küldeni ugy,
hogy a szöveg karaktereit (byte) egyesével átküldöm, a tuloldalon pedig összerakom.
Egy pillanat alatt megvan.
Próbáld ki ezt a függvényt:

function DiskExists(Drive: Char): Boolean;
var ErrorMode: Word;
begin
   Drive := UpCase(Drive);
   { Megvizsgálja, hogy a meghajtó betüjele érvényes-e }
   if not (Drive in ['A'..'Z']) then
      raise EConvertError.Create('Not a valid drive letter');
   { Kikapcsolja a kritikus hibákat }
   ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
   try
      Application.ProcessMessages;
      Result := (DiskSize(Ord(Drive) - Ord('A') + 1) <> -1);
   finally
      { Visszaállítja az eredeti hibamódot }
      SetErrorMode(ErrorMode);
      Application.ProcessMessages;
   end;
end;
Ezer megoldás van a kislemezes lekérdezésre, de itt a legszebb kódot teszem közzé function DiskInDrive(Drive: Char): Boolean;
  var ErrorMode: Word;
begin
   if Drive in ['a'..'z'] then Dec(Drive, $20);
   if not (Drive in ['A'..'Z']) then
   raise EConvertError.Create(Format('Nem érvényes meghajtó: %s',[Drive]));
   ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
   try { 1 = a, 2 = b, 3 = c, stb... }
     Result := DiskSize(Ord(Drive) - $40) <> -1;
   finally
     SetErrorMode(ErrorMode);
   end; end;

Function meghívása:

procedure TForm1.Button1Click(Sender: TObject);
begin
  if diskindrive('a') then caption:='van' else caption:='nincs';
end;
Megjegyzés: Ezt minden meghajtóval meg lehet játszani:
  1. B:\  =>>  if diskindrive('b') then caption:='van' else caption:='nincs';
  2. D:\  =>>  if diskindrive('d') then caption:='van' else caption:='nincs';
  3. E:\  =>>  if diskindrive('e') then caption:='van' else caption:='nincs';
és így tovább...



A Lap Tetejére
  • *.Wav file lejátszása:
    • uses mmsystem,...
    . . . .
    procedure TForm1.Button1Click(Sender: TObject);
    begin
       playsound('c:\winnt\media\chord.wav',0,snd_async);
    end;

    Megjegyzés:
    Mp3 lejátszását már nem lehet alapból megoldani, oda komponenst kell telepíteni,
    mp3-komponenst találsz a komponensek-oldalon.


    A Lap Tetejére
  • Webböngészők címsorának kiolvasása:
    • Az Internet Explorer, illetve a Netscape webböngészők címsorát olvashatjuk ki az alábbi példával:

    uses ddeman
    . . .

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

    procedure TForm1.Button1Click(Sender: TObject);
    begin
       label1.caption:=Get_URL('Netscape');
       label2.caption:=Get_URL('IExplore');
    end;

    Megjegyzés:
    Persze ehez az is kell, hogy legyen egy aktív böngészőnk

    A Lap Tetejére
  • Windows,Temp,System könyvtár megállapítása :
    • A windows, stb. könyvtárak helyének megállapítása azért fontos, hogy az applikációd
    más típusu windows op. rendszeren is működjön. Pl a lengyel windows-on.

    windows könyvtár:

    procedure TForm1.Button1Click(Sender: TObject);
    var
       a:array[0..255]of char;
    begin
       GetWindowsDirectory(a,255);
       caption:=strpas(a);
    end;

    system könyvtár:

    procedure TForm1.Button1Click(Sender: TObject);
    var
       a:array[0..255]of char;
    begin
       GetSystemDirectory(a,255);
       caption:=strpas(a);
    end;

    temp könyvtár:

    procedure TForm1.Button1Click(Sender: TObject);
    var
       a:array[0..255]of char;
    begin
       GetTempPath(255,@a);
       caption:=strpas(a);
    end;

    Megjegyzés:
    A win98 -telepítésekor (ezt tudom biztosra) a windows könyvtárnak adhatunk
    más nevet is, hát pont erre való a fenti példa!
    Ha a programunk nem magyar windows-on fog menni, akkor érdemes az user fontkészletét megnézni, vagy onnan választani

    function Fonty(var LogFont: TLogFont; var TextMetric: TTextMetric; FontType: Integer; Data: Pointer): Integer; stdcall;
    begin
       Form1.Memo1.Lines.Append(LogFont.lfFaceName);
       Result := 1;
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    var DC:HDC;
    begin
       DC:=GetDC(0);
       EnumFonts(DC,nil,@Fonty,nil);
    end;



    Egy könyvtárat választhat ki az user a lenti példa segitségével, szebb, és jobb, mint a DirectoryListBox.

    uses Filectrl

    procedure TForm1.Button1Click(Sender: TObject);
    var
      Dir : String;
    begin
      SelectDirectory('Select a directory','',Dir);
      ShowMessage(Dir);
    end;

    Megjegyzés:
    Aszzem, a windows selectDirectory ablakát hívja meg a program, bár lusta voltam megnézni.
    Ha nem, akkor egy pontos utánzat a delphi részéről, de még mindig jobb,
    mint az az undorító kinézetü DirectoryListBox1.komponens.

  • A Lap Tetejére
    Tetszőleges (2-32) számrendszerbe átváltó program:
    • // Tetszőleges (2-32) alapú számrendszerbe való
    // átváltást megvalósító program, ahol az
    // osztási maradékokat dinamikus tömbben tároljuk
    program dintomb;
    {$APPTYPE CONSOLE}
    uses
    SysUtils,Dialogs;

    var alap, szam : int64;
    i : integer;
    verem : array of byte;
    vm : integer;
    jegyek : array[0..31] of char;
    begin
    // a lehetséges számjegyeket tartalmazó tömb feltöltése:
    for i:=0 to 9 do jegyek[i]:= chr(48 + i);
    for i:=10 to 31 do jegyek[i]:= chr(55 + i);

    // a program adatainak beolvasása:
    write('Kerem a szamrendszer alapjat:', #9);
    readln(alap);
    if not (alap in [2..32]) then
    begin
    ShowMessage('Csak 2..32 közötti érték használható');
    halt;
    end;
    write('Az atvaltando szam:', #9#9);
    readln(szam);
    // a maradékok elhelyezése a veremben helyfoglalással:
    SetLength(verem,0);
    while szam<>0 do
    begin
    vm := length(verem);
    SetLength(verem, vm+1); // A verem méretének változtatása
    verem[vm] := szam mod alap;
    szam:= szam div alap;
    end;
    // a szám kiírása a veremből történő visszaolvasással
    write('A(z) ', alap:2, ' szamrendszerbeli alak:', #9);
    for i:=length(verem)-1 downto 0 do
    write(jegyek[verem[i]]:1);
    writeln(#13#13);
    // a dinamikus tömb felszabadítása
    Setlength(verem,0);
    readln;
    end.