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.
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;
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
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;
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.
Az első progi befordítva: server.exe
A második proggi: Project1.exe (itt nem számít a név)
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;
Ha csak egyes, adatokkal rendelkező komponensekre használjuk,
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;
De ha belegondolunk, hogy egy Form-on számtalan komponens lehet,
é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.
A visszavonás (Undo) parancs kiadását az alábbi kódnak a kívánt kontroll
(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;
Ahhoz, hogy például a Szerkesztés menü Visszavonás menüpontját letiltsuk
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.
Minden szó első betűjének nagybetűvé alakítása (angol):
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;
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.
A Caps Lock, Num Lock, Scroll Lock használata II. (StatusBar-ná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.)
A Form minimális és maximális méretének meghatározása:
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;
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.
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;
A Form(ok) automatikus képernyő-felbontáshoz arányosítása:
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:
A Form 'Scaled' tulajdonságát állítsd True-ra,
az 'AutoScroll' tulajdonságát pedig False-ra.
Kizárólag TrueType fontokat használj.
A Windows kis fontjait használd fejlesztés közben.
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)
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.
Egy meghajtó fajtáját a GetDriveType() WinAPI függvény segítségével tudjuk megállapítani.
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
. 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 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;
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.
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;
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.
A hosszú fájlnév átalakítása rövid fájlnévvé (és vissza):
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"
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;
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.
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.)
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.
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;
Be van kapcsolva a Tálca automatikus elrejtés tulajdonsága?:
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;
És egy példa a használatára:
if(IsTaskBarautoHideOn)then
begin
// be van kapcsolva...
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;
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.)
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.
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.
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.
Mentsd el az alkalmazást: File/Save Project As. A unitot nevezd el 'GridU1.pas'-nak, az alkalmazást pedig 'GridProj.dpr'-nek.
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
-----------------
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.
A Vezérlőpult (Control Panel) Dátum és idő, ill. Időzóna oldalának meghívása:
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);
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);
A Vezérlőpult különböző párbeszédpaneljeinek megnyitása:
A vezérlőpult (Control Panel) egyes párbeszédpaneljeinek megnyitásához a WinExec() API
függvény segítségével meg kell hívni a control.exe alkalmazást, paraméterként átadva
neki a megfelelő párbeszédpanel fájlnevét (vagy konstansát) és ha a panelen több oldal ("fül")
van, akkor a kívánt oldal számát (0 bázisú).
Példának okáért a Képernyő tulajdonságai párbeszédpanel Háttér oldalát az alábbi módon lehet megnyitni:
A windows környezet beállítását szolgáló fájlok (tulajdonképpen DLL-ek)
a Windows\System könyvtárban találhatók CPL kiterjesztéssel.
Azonban van egy-két párbeszédablak (vagy könyvtár), amelyet csak konstansal (a nevével)
lehet meghívni. Ilyen például a nyomtatók, vagy a telepített betűtípusok oldal.
Ezeknél nem kell (nem lehet) átadni a második paramétert. Például:
{Telepített nyomtatók}
WinExec('CONTROL.EXE PRINTERS', sw_ShowNormal);
{Telepített betűtípusok}
WinExec('CONTROL.EXE FONTS', sw_ShowNormal); A FONTOSABB PÁRBESZÉDPANELEK
A Windowst illetve az egész rendszert az ExitWindows WinAPI függvénnyel tudod újraindítani.
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;
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
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;
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;
{ . . . }
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;
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;
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;
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;
Sérült vagy hiányzó DBase indexállomány (MDX) kijavítása:
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:
Először kitöröljük az indexfile-t (MDX):
DeleteFile(Konyvtar+'FILE.MDX');
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');
Mindezek után már nyugodtan indexelhetünk:
Table1.AddIndex('KOD', 'KOD', []);
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.
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.
É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.
Egy fájl tulajdonságainak megjelenítése (Fájlinformációs lap):
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.
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;
Egy StringGrid tartalmának elmentése és betöltése:
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;
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;
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.
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','');
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;
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;
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;
(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:
{...}
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:
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.
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).
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.
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)
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 TEMP (ideiglenes) könyvtárának megállapítása
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:
a TMP környezetben meghatározott változó;
a TEMP környezetben meghatározott változó, ha a TMP nincs meghatározva;
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.
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;
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:
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. 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. 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. 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. 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. Hívd meg valahonnan az eljárást és már kész is az egész.
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;
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:
Először létrehozza az egyik (Checked) képet, majd hozzárendeli a képet tartalmazó fájlt.
Létrehozza a másik (Unchecked) képet is. Ehhez is hozzárendeli a megadott fájlt.
Meghívja a SetMenuItemBitmaps API hívást a megadott paraméterekkel:
A FileMenu a 'függőleges' főmenü neve.
A 0,1,2... a menüpont menüben lévő helyzetét jelöli (A példában a Fájl menü első eleme)
Az első Bitmap.Handle a menüpont nem jelölt (Unchecked) képét tölti be, a második pedig a menüpont jelölt (Checked) képét.
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;
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;
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.
{ . . . }
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;
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.
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;
Az alkalmazás memória-felhasználásának csökkentése
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.
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.
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...
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.
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.
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...
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!
A Shift, Ctrl és Alt billentyűk állapotának 'elkapása' menüparancsok esetén
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):
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.
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:
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.
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).
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).
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
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;
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;
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;
Egy meghajtó teljes méretének és a szabad lemezterületnek a megállapítása:
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.
0 = aktuális meghajtó, ahonnan a program EXE-t indították;
1 = A:\ meghajtó;
2 = B:\ meghajtó;
3 = C:\ meghajtó;
4 = D:\ meghajtó stb.
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;
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.
Hozz létre egy új Formot. Helyezz rá egy TTable, egy DataSource és egy DBGrid komponenst.
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.
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.
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;
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.
Állítsuk az adott komponens ShowHint tulajdonságát True-ra, de a Hint tulajdonságnak ne adjunk meg semmit.
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;
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;
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ó!!!}
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.
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:
B:\ =>> if diskindrive('b') then caption:='van' else caption:='nincs';
D:\ =>> if diskindrive('d') then caption:='van' else caption:='nincs';
E:\ =>> if diskindrive('e') then caption:='van' else caption:='nincs';
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 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.