Delphi FAQ
1. Jak odczytywać i zapisywać wartości w rejestrze Windows'a
2. Jak zrobić tło gradientowe (przejście z ciemnego koloru do jaśniejszego)
3. Jak odtworzyć dźwięk WAV
4. Jak zamknąć system, uruchomić ponownie Windows lub komputer
5. Jak wyłączyć skróty Windows'a CTRL+ALT+DEL CTRL+ESC ALT+TAB i.t.d.
6. Jak wysunąć i wsunąć szufladę CD-ROM'u
7. Jak wykonać konwersję z BMP do JPEG
8. Jak wywołać okienko do wyboru katalogu 9. Jak ukryć działanie programu w systemie
10. Jak programowo zmienić rozdzielczość ekranu
11. Jak tworzyć pliki *.LNK ( skrót na pulpicie i w Menu Start )
12. Jak wrzucić program do Tray'a ( obok zegarka na pasku zadań
13. Jak zmierzyć długość string'a w pikselach
14. Jak pobrać ikony z plików *.exe , *.dll itd.
15. Jak wyszukać jakiś plik na dysku
16. Jak zmienić położenie przycisku Start - Windows'a
17. Jak odczytać numer seryjny i etykiete dyskietki, dysku
18. Jak rysować po pulpicie
19. Jak pobrać nazwy wszystkich czcionek dostępnych w systemie
20. Jak uruchomić przeglądarkę lub klienta poczty z wpisanym adresem
21. Jak napisać odpowiednik pascalowej funkcji PORT
22. Jak za pomocą Delphi włączyć i wyłączyć monitor
23. Jak zastąpić pascalową procedurę Delay
24. Jak zmienić rozdzielczość ekranu
25. Jak używać w swojej aplikacji innych kursorów
26. Jak wydrukować dokument
27. Jak zobaczyć wszystkie funkcje, procedury, właściwości zawarte w module
28. Jak wyświetlić plik pomocy
29. Jak ustawić Wygaszacz ekranu na (Brak)
30. Jak zmienić kształt formy i komponentów
31. Jak odczytać położenie kursora myszy na ekranie
32. Jak zrobić by program mógł być uruchamiany tylko w jednym egzemplarzu
33. Jak dokleić procedury do pliku *.EXE
34. Jak podłączyć diodę do komputera i programowo zaświecać ją i gasić
35. Jak zmienić ustawienia klawiatury
36. Jak ukryć systemowe aplikacje
37. Jak zmienić głośność dźwięków WAV
38. Jak wykorzystać Drag&Drop dla plików z Eksploratora Windows
39. Jak ustawić głośność dla CD
40. Jak w Delphi 4 używać polskich liter
41. Jak ustawić głośność dla MIDI
42. Jak wysłać komunikat do wszystkich aplikacji
43. Jak zmienić położnie dowolnego okna i jego rozmiary
44. Jak otrzymać uchwyt ( Handle ) dowolnego okna
45. Jak zmienić nazwę dowolnego okna ( Caption )
46. Jak zrobić listę otwartych okien w systemie
47. Jak ukryć aplikacje
48. Jak pokazać ukryte aplikacje
49. Jak maksymalizować dowolne okna
50. Jak minimalizować dowolne okna
51. Jak przywróćić okno
52. Jak zrobić listę plików znajdujących się w pamięci
53. Jak zabić dowolny proces w systemie
54. Jak poustawiać okna obok siebie (tile)
55. Jak poustawiać okna jedno pod drugim (cascade)
56. Jak zamienić przyciski myszy
57. Jak ustawić położenie kursora myszy na ekranie
58. Jak ograniczyć obszar po którym może poruszać się mysz
59. Jak zawiesić działanie myszki
60. Jak pobrać lub ustawić prędkość dwukrotnego kliknięcia myszą
61. Jak zawiesić działanie klawiatury
62. Jak pobrać lub zmienić częstotliwość migania kursora
63. Jak wydrukować stronę testową drukarki
64. Jak zawiesić system
65. Jak ukryć lub przywrócić kursor klawiatury
66. Jak pobrać lub ustawić pozycję kursora klawiatury
67. Jak pobrać rozmiar bitmapy
68. Jak sprawdzić czy dany uchwyt reprezentuje okno
69. Jak sprawdzić czy dany uchwyt reprezentuje okno widoczne
70. Jak pobrać ProcessID znając uchwt
71. Jak pobrać uchwyt pulpitu
72. Jak schować i pokazać kursor myszy
73. Jak skasować katalog
74. Jak kopiować plik i używać Progress Bar
75. Jak skopiować, przenieść, usunąć, zmienić nazwę pliku lub katalogu
76. Jak zrobić by katalog nie był dostępny
77. Jak zamienić wartość Hex na Integer
78. Jak odwołać się z Delphi do assemblera
79. Jak przekompilować teksty dbconsts.int (katalog ...DELPHIDOC) aby podczas błędów na bazach danych pokazywany był komunikat w języku polskim ?
80. Jak skopiować tekst do schowka (clipboard) ?
81. Jak skasować wartość z rejestru ?
82. Jak odczytać wartość binarną z rejestru ?
83. Jak indeksować komponenty ?
84. Jak przesuwać komponenty za pomocą myszy ?
85. Jak utworzyc kliknieciem myszki obiekt np Tlabel a pozniej przeniesc go w inne miejsce formy ?
86. Jak zmienić kolory np. wszystkim komponentom TPanel ?
87. Jak odtwarzać pliki *.wav i *.mid ?
88. Jak przechwycić klawiaturę ?
89. Jak odczytać IP ?
90. Jak symulować naciśnięcie klawisza klawiatury ?
91. Jak zmieniać położenie komponentów ?
92. Jak odczytać ikonę skojarzoną z rozszerzeniem?
93. Jak dodać pozycję w DodajUsuń programy (Panel Sterowania)?
94. Jak uruchomic np. polecenie DIR ?
95. Jak rozpoznać typ napędu ?
96. Jak sprawdzić ile miejsca na dysku zajmuje plik ?
97. Jak ukryc program by nie byl wyswietlany na pasku zadan ?
98. Jak odczytać kursor z pliku zasobów ?
99. Jak rozpoznac wersję systemu operacyjnego ?
100. Jak uzyskać informacje o pamięci ?
1. Jak odczytywać i zapisywać wartości w rejestrze Windows'a
Do grzebania w rejestrze służy objekt TRegistry ( lub TRegIniFile ).W sekcji USES deklarujemy Registry. Obiekt ten należy stworzyć przy pomocy konstruktora create tzn. Nazwa_Zmiennej_TRegisry:=TRegistry.Create; W segmencie VAR należy zadeklarować nazwę zmiennej typu TRegistry np. Rejestr:TRegistry; Właściwośći RootKey należy przypisać nazwę klucza głównego (domyślnie HKEY_CURRENT_USER) np. Rejestr.RootKey:=(HKEY_LOCAL_MACHINE); . function OpenKey(const Key: string; CanCreate: Boolean): Boolean; otwiera interesujący nas klucz. function ReadString(const Name: string): string; powoduje odczytanie wartości ciągu (o nazwie podanej w Name). Do zapisania wartości ciągu używamy procedure WriteString(const Name, Value: string); gdzie w zmiennej Name podajemy nazwę nowej wartości ciągu , a w Value wartość ciągu. Pozostałe funkcje i procedury należy używać analogicznie do opisanej.
Przykład : ( odczytanie numeru seryjnego Windows'a )
uses Registry;
procedure TForm1.Button1Click(Sender: TObject);
var Rejestr:TRegistry;
begin
Rejestr:=TRegistry.Create;
Rejestr.RootKey:=(HKEY_LOCAL_MACHINE);
Rejestr.OpenKey('SoftwareMicrosoftWindowsCurrentVersion',False);
Label1.Caption:=Rejestr.ReadString('ProductId');
end;
2. Jak zrobić tło gradientowe
Do początku.....
Trzeba narysować dużo prostokątów zmieniając im kolor. Np.:
procedure TForm1.FormPaint(Sender: TObject);
const stala=100;
var x:Integer;
Color:TColor;
begin
for x:=0 to stala-1 do
with Canvas do
begin
Color:=RGB(0,0,Round(50+205*(x/stala)));
Brush.Color:=Color;
Pen.Color:=Color;
Rectangle(0,Round(ClientHeight*(x/stala)),
ClientWidth,Round(ClientHeight*((x+1)/stala)));
end;
end;
Aby wszystko było w porządku przy zmianie rozmiarów okna należy wpisać poniższy kawałek kodu
procedure TForm1.FormResize(Sender: TObject); begin Invalidate; end;
3. Jak odtworzyć dźwięk WAV
Do początku.....
opis uFlags:
SND_ALIAS odgrywa pliki zdefiniowane w systemie np. "EmptyRecycleBin"
SND_ASYNC kontynuuje wykonywanie programu pomimo trwania odgrywania dźwięku
SND_FILENAME odgrywa plik o podanej ścieżce dostępu
SND_NODEFAULT nie odgrywa domyślnego dźwieku, jeżeli wskazany nie został odnaleziony
SND_NOSTOP nie przerywa żadnego aktualnie odgrywanego dźwięku
SND_NOWAIT nie czeka, jeżeli driver dźwięku jest zajęty
SND_SYNC wstrzymuje działanie programu do chwili zakończenia odgrywania dźwięku
uses mmsystem;
procedure TForm1.Button1Click(Sender: TObject);
begin
SndPlaySound('C:WINDOWSMEDIATADA.WAV', snd_ASync);
end;
4. Jak zamknąć system, uruchomić ponownie Windows lub komputer
Do początku.....
Nalezy wykorzystac funkcje ExitWindowsEx z parametrem :
EWX_FORCE Forces processes to terminate. Instead of bringing up the "application not responding" dialog box for the user, this value forces an application to terminate if it does not respond.
EWX_LOGOFF Shuts down all processes running in the security context of the process that called the ExitWindowsEx function. Then it logs the user off.
EWX_POWEROFF Shuts down the system and turns off the power.
EWX_REBOOT Shuts down the system and then restarts the system.
EWX_SHUTDOWN Shuts down the system to a point at which it is safe to turn off the power. All file buffers have been flushed to disk, and all running processes have stopped.
Przykład
procedure TForm1.Button1Click(Sender: TObject);
begin
ExitWindowsEx(EWX_REBOOT,0);
end;
5. Jak wyłączyć skróty Windows'a CTRL+ALT+DEL CTRL+ESC ALT+TAB i.t.d.
Do początku.....
Trzeba oszukać Windows'a tak, żeby myślał, że nasza alpikacja jest wygaszaczem ekranu. Nie działa na Windows NT !!!
var wartosc:longbool;
begin
SystemParametersInfo(97,Word(True),@wartosc,0); //Włącza blokadę
SystemParametersInfo(97,Word(False),@wartosc,0); //Wyłącza blokadę
end;
6. Jak wysunąć i wsunąć szufladę CD-ROM'u
Do początku.....
uses mmsystem;
mciSendString('Set cdaudio door open wait',nil,0,handle); // wysunięcie
mciSendString('Set cdaudio door closed wait',nil,0,handle); // wsunięcie
7. Jak wykonać konwersję z BMP na JPEG
Do początku.....
Najprostszym sposobem wykonania tego zadania jest wykorzystanie modułu JPEG dostarczanego począwszy od wersji 3.x pakietu Delphi. Wystarczy bowiem utworzyć obiekt typu TJEPGImage, przyporządkować mu obraz przechowywany w dowolnym obiekcie TBitmap, by na końcu zapisać jego wartość do pliku JPG posługując się standardową funkcją SaveToFile. W tym celu po pierwsze potrzebujemy zadeklarować odpowiedni moduł: uses JPEG; a po drugie wybrać interesującą nas metodę konwersji...
Konwersja BMP na JPEG
Poniższa procedura przedstawia sposób konwersji z formatu BMP na JPEG w przypadku, gdy znamy jedynie nazwę pliku. Wtedy to musimy najpierw stworzyć obiekt typu TBitmap, do którego następnie wczytujemy nasz plik. W drugim kroku tworzymy obiekt typu TJPEGImage i próbujemy przyporządkować mu zawartość poprzednio utworzonego obiektu z bitmapą. O ile nie wystąpi żaden bład, zapisujemy plik JPG i zwalniamy oba obiekty.
var
RysunekJPEG : TJPEGImage;
RysunekBMP : TBitmap;
begin
RysunekBMP:=TBitmap.Create;
try
RysunekBMP.LoadFromFile('NazwaPliku.BMP');
RysunekJPEG:=TJPEGImage.Create;
try
RysunekJPEG.Assign(RysunekBMP);
RysunekJPEG.SaveToFile('NazwaPliku.JPEG');
finally
RysunekJPEG.Free;
finally
RysunekBMP.Free;
end;
Czasem zdarza się jednak, że bitmapę przechowujemy w postaci innego obiektu (np. TImage). Wtedy to wystarczy jedynie utworzyć nowy obiekt typu TJPEGImage, przyporządkować mu tę właściowość naszego obiektu z rysunkiem, która posiada typ TBitmap (np. TImage.Picture.Bitmap) i na koniec zapisać obiekt JPEG.
Konwersja JPEG na BMP
W nieco odmienny sposób przeprowadzamy kowersję w stronę odwrotną, czyli z JPEG na BMP. Tak jak poprzednio musimy zadeklarować tutaj dwa obiekty: jeden typu TJPEGImage, a drugi TBitmap. Następnie wczytujemy rysunek JPG, a jego rozmiar przypisujemy bitmapie. Dalej, posługując się funkcją TCanvas.Draw, odrysowujemy rysunek JPG na bitmapie, aby ostatecznie zapisać ją przy pomocy funkcji SaveToFile. Na zakończenie zwalniamy oba obiekty:
var
RysunekJPEG : TJPEGImage;
RysunekBMP : TBitmap;
begin
RysunekJPEG:=TJPEGImage.Create;
RysunekJPEG.LoadFromFile('NazwaPliku.JPEG');
RysunekBMP:=TBitmap.Create;
RysunekBMP.Width:=RysunekJPEG.Width;
RysunekBMP.Height:=RysunekJPEG.Height;
RysunekBMP.Canvas.Draw(0,0,RysunekJPEG);
RysunekBMP.SaveToFile('NazwaPliku.BMP');
RysunekBMP.Free;
RysunekJPEG.Free;
end;
8. Jak wywołać okienko do wyboru katalogu
Do początku.....
Do wywołania Windows'owskiego okienka służy systemowa funkcja SHBrowseForFolder.
Funkcja ta jako parametr wywołania przyjmuje strukturę typu TBrowseInfo. Określa ona parametry wejściowe dla wyświetlanego okienka.
Poszczególne pola tej struktury oznaczają:
hwndOwner uchwyt do okna, z poziomu którego chcemy wywołać okienko wyboru;
pidlRoot wskaźnik na katlog podstawowy, który stanie się u nas katalogiem głównym i niemożliwe będzię przejście wyżej od niego; jeżeli podamy nil to przyjęty zostanie najwyższy możliwy poziom, czyli Desktop;
pszDisplayName wskaźnik na bufor tekstowy (PChar), który będzie przechowywał katalog wybrany przez użytkownika;
lpszTitle określa napis informacyjny jaki pojawi się w okienku tuż nad drzewem katalogów;
ulFlags ustala dodatkowe opcje, których znaczenie przedstawione zostało poniżej;
lpfn wskaźnik na funkcję zwrotną, która zostanie wywołana w momencie wystąpienia ewentualnego błędu; może przyjmować nil;
lParam parametr, jaki zostanie przekazany do powyższej funkcji;
iImage zmienna przyjmuje indeks ikony z listy systemowej, odpowiadający wybranemu katalogowi.
W strukturze tej występuje pole ulFlags, które może przyjąć dowolną kombinację z wymienionych niżej wartości (oczywiście pierwsze trzy paramatry wykluczają się nawzajem):
BIF_BROWSEFORCOMPUTER powoduje przeszukiwanie jedynie pod kątem komputerów; jeżeli użytkownik wybierze cokolwiek innego niż komputer przycisk OK pozostanie niedostępny;
BIF_BROWSEFORPRINTER jak wyżej, ale dotyczy drukarek;
BIF_RETURNONLYFSDIRS tutaj również, ale pozwala wybrać jedynie katalogi;
BIF_DONTGOBELOWDOMAIN powoduje ukrycie wszelkich katalogów sieciowych;
BIF_STATUSTEXT dodaje w obszarze okienka pole statusu, którego zawartość może być modyfikowana poprzez wysłanie komunikatu od funkcji zwrotnej.
Jeżeli chcemy wyświetlić okienko, to w pierwszej kolejności musimy wypełnić właśnie ten rekord. Deklarujemy użycie modułu ShlObj i dalej definiujemy trzy zmienne:
var
opcje : TBrowseInfo;
bufor : PChar;
dir : PItemIDList;
Następnie przydzielamy pamięć dla naszego bufora. Jego rozmiar jest tutaj określony przez wartość stałej systemowej MAX_PATH: GetMem(bufor, MAX_PATH);
W dalszej kolejności wypełniamy pozostałe pola rekordu, na przykład w podany niżej sposób:
with opcje do
begin
hwndOwner:=Form1.Handle;
pidlRoot:=nil;
pszDisplayName:=bufor;
lpszTitle:='Dokonaj wyboru katalogu:';
ulFlags:=BIF_RETURNONLYFSDIRS;
lpfn:=nil;
end;
Przypisując zmiennej ulFlags podaną wartość ograniczymy możliwość wyboru jedynie do katalogów, co jest sytuacją typową dla większości zastosowań. Teraz możemy już wywołać nasze okienko: dir:=SHBrowseForFolder(opcje);Następnie wystarczy sprawdzić, czy zwrócona przez fukcję wartość nie jest pusta i pobrać ścieżkę do wybranego obiektu przypisując ją na przykład zmiennej bufor:
if dir<>nil then SHGetPathFromIDList(dir,bufor);
Na koniec nie możemy jeszcze zapomnieć o zwolnieniu pamięci: FreeMem(bufor);
I to w zasadzie byłoby na tyle. Jednak w niektórych przypadkach zależy nam, aby ograniczyć przeszukiwanie tylko do konkretnej gałęzi lub też folderu specjalnego. Możemy na przykład ograniczyć wybór użytkownika wyłącznie do napędów dysków. Aby tego dokonać należy w odpowiedni sposób zmodyfikować flagę pidlRoot. Do tego celu służy funkcja SHGetSpecialFolderLocation, która podaje położenie folderów specjalnych. Jako paramatery przyjmuje ona uchwyt do bieżącego okienka, stałą określającą zakres oraz wskaźnik na zmienną, której przypisany zostanie stosowny identyfikator obiektu. Dla naszego przykładu zakres określony jest przez wartość stałej CSIDL_DRIVES. Wywołanie funkcji będzie przedstawiało się zatem następująco: SHGetSpecialFolderLocation(Form1.Handle,CSIDL_DRIVES,root);Następnie wystarczy dokonać przypisania: opcje.pidlRoot=root;i otrzymamy pożądane przez nas zawężenie. Z innych interesujących zakresów wymienić należy:
CSIDL_DESKTOP Pulpit (Desktop)
CSIDL_DRIVES Mój Komputer (My Computer)
CSIDL_NETWORK Otoczenie sieciowe (Network Neighborhood)
CSIDL_PERSONAL Moje dokumenty (My documents)
CSIDL_PROGRAMS gałąź Programy z Menu Start
CSIDL_STARTMENU pełne Menu Start
9. Jak ukryć działanie programu w systemie
Do początku.....
function registerserviceprocess(pid,blah:longint):boolean;
stdcall; external 'kernel32.dll' name 'RegisterServiceProcess';
pocedure TForm1.FormCreate(Sender: TObject);
begin
registerserviceprocess(0,1);
end;
10. Jak programowo zmienić rozdzielczość ekranu
Do początku.....
Wykorzystuje się do tego celu funkcję ChangeDisplaySettings
procedure TForm1.Button1Click(Sender:TObject);
var Mode:TDeviceMode;
S:String;
begin
with Mode do
begin
dmSize:=SizeOf(Mode);
dmBitsPerPel:=16;
dmPelsWidth:=800;
dmPelsHeight:=600;
dmFields:=DM_PELSWIDTH+DM_PELSHEIGHT;
end;
case ChangeDisplaySettings(Mode,0) of
DISP_CHANGE_SUCCESSFUL:S:='Operacja przebiegła pomyślnie';
DISP_CHANGE_RESTART:S:='Aby zmiany odniosły skutek należy zrestartować systi';
DISP_CHANGE_BADFLAGS:S:='Błędne pole dmFields';
DISP_CHANGE_FAILED:S:='Błąd podczas ustawiania trybu';
DISP_CHANGE_BADMODE:S:='Ten tryb nie jest obsługiwany';
DISP_CHANGE_NOTUPDATED:S:='Rejestr nie został zaktualizowany';
else S:='Nieznany kod wyniku';
end;
ShowMessage(S);
end;
11. Jak tworzyć pli,i *.LNK ( skrót na pulpicie i w Menu Start )
Do początku.....
uses ShlObj, ActiveX, ComObj, Registry;
procedure TForm1.Button1Click(Sender: TObject);
var MyObject:IUnknown;
MySLink:IShellLink;
MyPFile:IPersistFile;
FileName:String;
Directory:String;
WFileName:WideString;
MyReg:TRegIniFile;
begin
MyObject:=CreateComObject(CLSID_ShellLink);
MySLink:=MyObject as IShellLink;
MyPFile:=MyObject as IPersistFile;
FileName:='NOTEPAD.EXE';
with MySLink do
begin
SetArguments('C:AUTOEXEC.BAT');
SetPath(PChar(FileName));
SetWorkingDirectory(PChar(ExtractFilePath(FileName)));
end;
MyReg := TRegIniFile.Create('SoftwareMicroSoftWindowsCurrentVersionExplorer');
// Poniższe dodaje skrót do desktopu
Directory := MyReg.ReadString('Shell Folders','Desktop','');
// A to do menu Start
Directory := MyReg.ReadString('Shell Folders','Start Menu','')+ 'Microspace';
// CreateDir(Directory);
WFileName := Directory+'Oglodek.lnk';
MyPFile.Save(PWChar(WFileName),False);
MyReg.Free;
end;
12. Jak wrzucić program do Traya ( obok zegarka na pasku zadań )
Do początku.....
Są dwie rzeczy, które trzeba wziąć pod uwagę tworząc aplikację do traya. Pierwsza to "ukrycie" aplikacji przed Windows. Mimo, że aplikacje takie wyglądają i zachowują się jak zwykłe aplikacje Windows, nie można się na nie przełączyć przy użyciu Alt-Tab ani nie mają swojego przycisku na pasku zadań. Tym zajmiemy się najpierw.
Każde okno posiadające styl WS_EX_TOOLWINDOW ani nie ma przycisku na pasku zadań ani nie można się na nie przełączyć. Z początku może wydawać się właściwym ustawienie tego stylu przy użyciu CreateParams. Niestety nie zadziała to dla formy. Tu mała dygresja. Główna forma aplikacji nie jest oknem (w terminologii Windows) aplikacji. Obiekt aplikacji ma swoje własne okno - nie można go zobaczyć ale ono "tam" jest. To jest właśnie to okno, do którego należy przypisać styl WS_EX_TOOLWINDOW. Gdzie więc należy wstawić kod? Oczywiście w źródle projektu. Po wybraniu View|Project Source należy skopiować poniższy kod:
program Project1;
uses Forms,
Unit1 in 'Unit1.pas' {Form1},
Windows; //To jest wymagane aby znana była stała WS_EX_TOOLWINDOW i pozostałe
{$R *.RES}
//Deklaracja zmiennej do przyjęcia informacji o stylu okna
var ExtendedStyle : Integer;
begin
Application.Initialize;
//Pobranie informacji o oknie aplikacji przy użyciu GetWindowLong
ExtendedStyle:=GetWindowLong(Application.Handle, GWL_EXSTYLE);
//Teraz ustawiamy styl rozszerzony przy użyciu operacji na bitach
//Przekształca to okno z okna-aplikacji do okna-narzędzia
SetWindowLong(Application.Handle,GWL_EXSTYLE,ExtendedStyle or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
A teraz aby utworzyć właściwy efekt aplikacji w trayu będziemy potrzebowali przede wszystkim głównej formy aplikacji. Połóż na formie komponent TPopupMenu. Będzie to główny interfejs do naszej aplikacji. Popatrz na poniższy kod:
{ Poniższe umieszcza aplikację w trayu. Jest to główna forma aplikacji. Posiada ona menu popup używane do wyświetlenia formy i zamknięcia aplikacji. Używając modułu ShellApi w prosty sposób pokażemy ikonę aplikacji w trayu i spowodujemy aby reagowała na kliknięcia myszą }
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ShellAPI, ExtCtrls, Menus;
type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
ShowMainForm1: TMenuItem;
N1: TMenuItem;
ExitApplication1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure ShowMainForm1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ExitApplication1Click(Sender: TObject);
private
procedure WndProc(var Msg : TMessage); override;
public
IconNotifyData : TNotifyIconData;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
// Zostawiamy tylko przycisk zamykający okno
BorderIcons := [biSystemMenu];
// Teraz wypełniamy rekord IconNotifyData tak aby przyjmował
// komunikaty wysyłane do aplikacji i pokazywał "dymki" podpowiedzi.
with IconNotifyData do begin
hIcon:=Application.Icon.Handle;
uCallbackMessage:=WM_USER+1;
cbSize:=SizeOf(IconNotifyData);
Wnd:=Handle;
uID:=100;
uFlags:=NIF_MESSAGE+NIF_ICON+NIF_TIP;
end;
// Kopiujemy tytuł aplikacji jako "dymek"
StrPCopy(IconNotifyData.szTip, Application.Title);
// Dodajemy ikonę do traya
Shell_NotifyIcon(NIM_ADD,@IconNotifyData);
end;
procedure TForm1.WndProc(var Msg : TMessage);
var
p : TPoint;
begin
if (Msg.Msg=WM_USER+1)and(Msg.lParam=WM_RBUTTONDOWN) then
begin
GetCursorPos(p);
PopupMenu1.Popup(p.x, p.y);
end; inherited;
end;
// To jedna z procedur obsługi elementów menu
procedure TForm1.ShowMainForm1Click(Sender: TObject);
begin
Form1.Show;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caNone;
Form1.Hide;
end;
procedure TForm1.ExitApplication1Click(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE, @IconNotifyData);
Application.ProcessMessages;
Application.Terminate;
end;
end.
Jak widać nie ma wiele do zrobienia. Ale ważne jest aby rozumieć co zrobiliśmy w metodzie Create i jakie znaczenie ma rekord IconNotifyData. Jest to rekord zdefiniowany w module ShellAPI, który przechowuje informację o ikonie w trayu. Zauważ flagi, których użyliśmy: NIF_MESSAGE + NIF_ICON + NIF_TIP. Oznaczają one kolejno: obsługę komunikatów dla aplikacji, pokazywanie ikony aplikacji i pokazywanie "dymku" z podpowiedzią.
Następna sprawa to nadpisanie procedury WndProc (skrót od WindowProcedure). Dostaje ona wszystkie komunikaty przesyłane do okna i zachowuje się jak centralna rozdzielnia komunikatów. Można przejąć obsługę komunikatu pisząc własną jego obsługę i wywołując odziedziczoną procedurę. Przy obsłudze komunikatu sprawdzamy czy jest to nasz własny (wm_User+1) zdefiniowany w zmiennej IconNotifyData oraz czy nastąpiło kliknięcie prawym przyciskiem myszy. Pozostałe komunikaty przesyłamy bez zmian.[...]"
13. Jak zmierzyć długość string'a w pikselach
Do początku.....
Używamy funkcji TCanvas.TextWidth('www.teston.hg.pl') , która przyjmuje wartość długości.
14. Jak pobrać ikony z plików *.exe , *.dll itd.
Do początku.....
Należy skorzstać z funkcji ExtractIcon z modułu ShellApi .
uses ShellApi;
procedure TForm1.FormCreate(Sender: TObject);
begin
Image1.Picture.Icon.Handle:=ExtractIcon(Hinstance,'c:windowssystemshell32.dll',32);
end;
działa tylko w win 95-98-me
15. Jak wyszukać jakiś plik na dysku
Do początku.....
Należy wrzucić poniższą funkcję oraz wstawić komponent TMemo.
type
public
procedure ZnajdzPlik(Sciezka,NazwaPliku:String);
end;
procedure TForm1.ZnajdzPlik(Sciezka,NazwaPliku:String);
var
FSearchRec,DSearchRec:TSearchRec;
FindResult:integer;
function GetDirectoryName(Dir:String):String;
begin
if Dir[Length(Dir)]<>'' then
Result:=dir+''
else
Result:=Dir;
end;
function IsDirNotation(AdirName:String):Boolean;
begin
Result:=(AdirName='.') or (AdirName='..');
end;
begin
Sciezka:=GetDirectoryName(Sciezka);
FindResult:=FindFirst(Sciezka+NazwaPliku,faAnyFile+faHidden+faSysFile+faReadOnly,FSearchRec);
try
while FindResult = 0 do
begin
Memo1.Lines.Add(Sciezka+FsearchRec.Name);
FindResult:=FindNext(FSearchRec);
end;
FindResult:=FindFirst(Sciezka+'*.*',faDirectory,DSearchRec);
while FindResult=0 do
begin
if ((DSearchRec.Attr and faDirectory)=faDirectory) and not IsDirNOtation(DSearchRec.Name) then
ZnajdzPlik(Sciezka+DSearchRec.Name,NazwaPliku);
FindResult:=FindNext(DSearchRec);
end;
finally
FindClose(FSearchRec);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ZnajdzPlik('c:','*.exe');
end;
16. Jak zmienić położenie przycisku Start - Windows'a
Do początku.....
var Uchwyt: THandle;
begin
Uchwyt := FindWindow(PChar('Shell_TrayWnd'), nil);
SetWindowPos(Uchwyt, HWND_TOPMOST, 200, 200, 60, 10,SWP_NOSENDCHANGING or SWP_FRAMECHANGED);
end;
17. Jak odczytać numer seryjny i etykiete dyskietki, dysku
Do początku.....
Dla dysku metoda ta podaje tylko numer seryjny partycji. Dla dyskietki wszystko jest OK
var
Bufor:array[0..MAX_PATH] of Char;
MaxCompLength,FileSystemFlags:Integer;
Drive:Char;
Serial:DWORD;
begin
Drive:='A';
GetVolumeInformation(PChar(Drive + ':'),Bufor,SizeOf(Bufor),@Serial,MaxCompLength,FileSystemFlags,nil,0);
end;
Zmienna Serial posiada numer seryjny dyskietki, a bufor nazwę etykiety.
18. Jak rysować po pulpicie
Do początku.....
Wystarczy używać pulpitu jako Canvas.
Funkcja GetDesktopWindow zwraca uchwyt pulpitu.
Canvas.Handle:=GetWindowDC(GetDesktopWindow);
//tutaj używamy funkcji Canvas'a do rysowania
//a teraz zwalniamy uchwyt
ReleaseDC(GetDesktopWindow,Canvas.Handle);
19. Jak pobrać nazwy wszystkich czionek dostępnych w systemie
Do początku.....
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;
20. Jak uruchomić przeglądarkę lub klienta poczty z wpisanym adresem
Do początku.....
ShellExecute(Handle,'open','http://www.delphi.qs.pl',nil,nil,SW_SHOWNORMAL);
ShellExecute(Handle,'open','mailto:delphi@koti.pl',nil,nil,SW_SHOWNORMAL);
21. Jak napisać odpowiednik pascalowej funkcji PORT
Do początku.....
function PortIn(Port:Word):Byte;
var Cos:Byte;
begin
asm
mov DX , Port
in AL , DX
mov Cos, AL
end;
PortIn:=Cos;
end;
procedure PortOut(Port:Word;Wartosc:Byte); assembler;
asm
mov DX, Port
mov AL, Wartosc
out DX, AL
end;
22. Jak za pomocą Delphi włączyć i wyłączyć monitor
Do początku.....
SendMessage(Application.Handle,wm_SysCommand,SC_MonitorPower,1);
//wyłączenie monitora
SendMessage(Application.Handle,wm_SysCommand,SC_MonitorPower,-1);
//włączenie monitora
23. Jak zastąpić pascalową procedurę Delay
Sleep(ilosc_milisekund)
24. Jak zmienić rozdzielczość ekranu
procedure TForm1.Button1Click(Sender: TObject);
var Mode:TDeviceMode;
S:String;
begin
with Mode do
begin
dmSize:=SizeOf(Mode);
dmBitsPerPel:=16;
dmPelsWidth:=800;
dmPelsHeight:=600;
dmFields:=DM_PELSWIDTH+DM_PELSHEIGHT;
end;
case ChangeDisplaySettings(Mode,0)of
DISP_CHANGE_SUCCESSFUL:S:='Operacja przebiegła pomyślnie';
DISP_CHANGE_RESTART:S:='Aby zmiany odniosły skutek należy zrestartować system';
DISP_CHANGE_BADFLAGS:S:='Błędne pole dmFields';
DISP_CHANGE_FAILED:S:='Błąd podczas ustawiania trybu';
DISP_CHANGE_BADMODE:S:='Ten tryb nie jest obsługiwany';
DISP_CHANGE_NOTUPDATED:S:='Rejestr nie został zaktualizowany';
else S:='Nieznany kod wyniku';
end;
ShowMessage(S);
end;
25. Jak używać w swojej aplikacji innych kursorów
Screen.Cursors[numer_kursora]:=LoadCursorFromFile('nazwa_pliku');
Form1.Cursor:=numer_kursora;
numer_kursora jest dowolną liczbą całkowitą większą od 0 lub mniejszą od -20.
26. Jak wydrukować dokument
ShellExecute(handle,'print','SCIEZKA_DO_PLIKU',nil,nil,SW_SHOWNORMAL);
27. Jak zobaczyć wszystkie funkcje, procedury, właściwości zawarte w module
Działa tylko w Delphi 3 i 4 !!!
Należy umieścić nazwę modułu w częsci uses jeśli nie istnieje. Następnie wewnątrz procedury wystarczy napisać nazwę modułu z kropką i wyświetli się lista procedur funkcji i właściwości zawartych w module.
Przykład dla modułu ShellApi
uses ShellApi
procedure TForm1.Button1Click(Sender:TObject);
begin
ShellApi.
end;
28. Jak wyświetlić plik pomocy
uses ShellApi;
procedure TForm1.Button1Click(Sender:TObject);
begin
ShellExecute(Handle, 'open', 'sciezka+nazwa_pliku', nil, nil, SW_SHOWNORMAL);
end;
29. Jak ustawić wygaszacz ekranu na (Brak)
SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, Word(False), nil, 0);
Aby przywrócić poprzednie ustawienia
SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, Word(True), nil, 0);
30. Jak zmienić kształt formy i komponentów
procedure TForm1.Button1Click(Sender:TObject);
begin
SetWindowRgn(Handle,CreateRoundRectRgn(0,0,width,height,50,50),true);
//tworzy formę bardziej zaokrągloną
end;
SetWindowRgn(Handle,CreateEllipticRgn(0, 0, Width, Height), True); //tworzy z formy elipsę
//funkcja CreatePolygonRgn(.......) tworzy bardziej złożone kształty
//jak chcesz zrobic z formy gwiazdke to napisz do mnie a przesle ci informacje jak to zrobic
//zamiast uchwytu do formy ( Handle ) mozesz wykorzystac uchwyt do innych komponentow np. Button1.Handle
31. Jak odczytać położenie kursora myszy na ekranie
Nalezy wykorzystac funkcje GetCursorPos z nazwą zmiennej TPoint np.
var Punkt:TPoint;
GetCursorPos(Punkt);
Teraz Punkt.X posiada współrzędną X położenie kursora myszy a Punkt.Y współrzędną Y
32. Jak zrobić by program mógł być uruchamiany tylko w jednym egzemplarzu
unit unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
MessageId: Integer;
{ Private declarations }
public
{ Public declarations }
end;
const
UniqueAppStr : PChar = 'To jest unikatowy string aplikacji';
MI_FAIL_SUBCLASS = 1;
MI_FAIL_CREATE_MUTEX = 2;
var
Form1: TForm1;
MutHandle: THandle =0;
WProc: TFNWndProc = Nil;
MessageID:integer;
MIError: Integer = 0;
implementation
{$R *.DFM}
function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint):
Longint; stdcall;
begin
{ Jeżeli to ten komunikat... }
if Msg = MessageID then
begin
{ jeżeli okno główne jest zminimalizowane, przywróć jego normalną postać }
if IsIconic(Application.Handle) then
begin
Application.MainForm.WindowState := wsNormal;
Application.Restore;
end;
SetForegroundWindow(Application.MainForm.Handle);
Result := 0;
end
{ W przeciwnym wypadku przekaż komunikat do poprzedniej procedury okienkowej }
else
Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
MessageID := RegisterWindowMessage(UniqueAppStr);
MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);
if MutHandle = 0 then
begin
WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC,Longint(@NewWndProc)));
{ Zasygnalizuj nieudany subclassing }
if WProc = Nil then
MIError := MIError or MI_FAIL_SUBCLASS;
MutHandle := CreateMutex(Nil, False, UniqueAppStr);
if MutHandle = 0 then
MIError := MIError or MI_FAIL_CREATE_MUTEX;
end else begin
{ Pierwszy egzemplarz programu jest już uruchomiony }
ShowMessage('Nie mozna uruchomic drugiego egzemplarza tej aplikacji');
Application.Terminate;
end;
end;
end.
Martin Brzezinka zaproponował inny sposób
procedure TForm1.FormCreate(Sender: TObject);
begin
if GlobalFindAtom('PROGRAM_RUNNING') = 0 then
atom := GlobalAddAtom('PROGRAM_RUNNING')
else
begin
MessageDlg('You have the program running all ready!!', mtWarning,
[mbOK], 0);
Halt;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
GlobalDeleteAtom(atom);
end;
33. Jak dokleić procedury do pliku *.EXE
Na początku ostrzegam, że działa tylko dla plików DOS'owych.
Przed przystąpieniem do modyfikowania plików .EXE należy zapoznać się z ich budową. W największym skrócie składają się one z: nagłówka, tablicy relokacji oraz kodu programu. Wszystkie informacje o budowie pliku zawiera nagłówek. Oto jego skrótowy opis (1 słowo = 2 bajty):
Słowo Opis
1 identyfikator = $4D5A (litery 'MZ')
2 ilość bajtów na ostatniej 512-bajtowej stronie
3 ilość 512-bajtowych stron w pliku
4 liczba relokacji(1 relokacja = 4 bajty)
5 rozmiar nagłówka i tablicy relokacji w 16-bajtowych paragrafach
6 minimalna pamięć zarezerwowana dla pliku po uruchomieniu(nie wliczając kodu programu !)
7 maksymalny rozmiar pamięci jaką może wykorzystać program
8 segment stosu (SS)
9 rozmiar stosu (SP)
10 suma kontrolna (zwykle nie używane)
11 przesunięcie względem segm. kodu (IP)
12 początkowy segment kodu programu (CS)
13 przesunięcie tabl. relokacji względem początku pliku.
14 numer nakładki
Ze słów [2] i [3] oblicza się długość pliku zgodnie ze wzorem:
([3]-1)*512+[2] ale dla [2]=0 wzór ma postać: [3]*512.
Słowa [8] i [9] (SS:SP) określają segment i rozmiar stosu,a słowa [11] i [12] (CS:IP) miejsce od którego będzie wykonywany program.
Poniższy programik należy nazwać Proc.asm i skompilować w Assemblerze jako plik proc.com
Cseg segment para
assume cs:Cseg
org 100h
start:
mov si,0090h
jmp main
text db 'Podaj hasło:$'
Haslo db 'mirek!'
Len equ $-Haslo
main:
push ds
push es
push cs
pop ds
push cs
pop es
mov dx,si
mov ah,9h
int 21h
mov cx,Len
push cx
push si
skok:
mov ah,1h
int 21h
mov cs:[si],al
inc si
loop skok
pop si
pop cx
mov di,si
add di,13
rep cmpsb
je dalej
mov ah,4ch
int 21h
dalej:
mov ax,3h
int 10h
pop es
pop ds
Cseg ends
end start
Oraz plik RETP.ASM ,który także trzeba skompilować na RETP.COM
rseg segment para
org 100h
start:
mov bx,cs
sub bx,9090h
cli
mov sp,9090h
mov ax,cs
add ax,9090h
mov ss,ax
sti
push bx
mov ax,9090h
push ax
retf
rseg ends
end start
Gotowy plik proc.com i retp.com oraz poniższy kod skompilowany w Turbo Pascalu ( zajmuje dużo mnijej niż skompilowany w Delphi ) możesz tutaj ściągnąć .
A teraz w Delphi w jakimś zdarzeniu np. Button1Click wrzucamy poniższy kod
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
const
STOS=64;
comlen=0;
coment='mo';
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
f,retf,sourcef,resultf:file;
i,headsize,retplen,psize,ofset:word;
x:integer;
codes:longint;
header:array[1..14] of word;
proc:array[1..60000] of byte;
retp :array[1..90] of byte;
bufor:char;
NumRead, NumWritten: Integer;
Buf: array[1..2048] of Char;
implementation
{$R *.DFM}
function do_16(l:word):word;
begin
do_16:=l;
if(l mod 16)<>0 then do_16:=l-(l mod 16)+16
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if paramcount<1 then
begin showmessage('brak nazwy pliku');halt;end;
assignfile(sourcef,paramstr(1));
reset(sourcef,1);
blockread(sourcef,header,28);
codes:=header[3];
if header[2]>0 then dec(codes);
headsize:=header[5]*16;
codes:=(codes*512)+header[2]-headsize;
assignfile(f,'proc.com');
reset(f,1);
psize:=filesize(f);
blockread(f,proc,psize);
closefile(f);
assignfile(f,'retp.com');
reset(f,1);
retplen:=filesize(f);
blockread(f,retp,retplen);
closefile(f);
i:=(codes div 16)-header[12];
retp[05]:=lo(i);
retp[06]:=hi(i);
retp[09]:=lo(header[9]);
retp[10]:=hi(header[9]);
i:=header[8]-(codes div 16);
retp[14]:=lo(i);
retp[15]:=hi(i);
retp[21]:=lo(header[11]);
retp[22]:=hi(header[11]);
header[12]:=(codes) div 16;
header[11]:=(codes) mod 16;
proc[2]:=header[11]+6;proc[3]:=0;
ofset:=header[13];
header[13]:=28+comlen;
header[5]:=do_16(28+header[4]*4+comlen) div 16;
inc(codes,header[5]*16+retplen+psize);
header[09]:=STOS;
header[08]:=(codes div 16);
header[3]:=(codes div 512);
i:=(codes mod 512);
header[2]:=i;
if header[2]<>0 then inc(header[3]);
assignfile(resultf,'wynik.exe');
rewrite(resultf,1);
blockwrite(resultf,header,28);
if comlen>0 then blockwrite(resultf,coment,comlen);
seek(sourcef,ofset);
//getmem(buf,64000);
i:=do_16(header[4]*4+28)-28;
blockread(sourcef,buf,i);
blockwrite(resultf,buf,i);
seek(sourcef,headsize);
i:=1;
x:=1;
repeat
blockread(sourcef,bufor,sizeof(bufor),x);
blockwrite(resultf,bufor,x);
until (x=0);
//freemem(buf,64000);
blockwrite(resultf,proc,psize);
blockwrite(resultf,retp,retplen);
closefile(resultf);
closefile(sourcef);
end;
end.
Jeśli ktoś wie jak modyfikować pliki *.EXE pod Windows proszę o kontakt
34. Jak podłączyć diodę do komputera i programowo zaświecać ją i gasić
Wykorzystam do tego port COM 2 - taki jak do myszki tylko szerszy ( męski ).
Plus diody podłączyć pod 4. pin , minus pod 7.Mbr
Piny Oznaczenie Opis
1 GND Masa
2 TXD Transmisja danych
3 RXD Odbiór danych
4 RTS Zgłoszenie transmisji
5 CTS Sygnał końcowy transmisji
6 DSR Wstawienie sygnału gotowości
7 GND Masa
8 DCD Zasygnalizowanie przesyłu danych
9-19 - Złącza niewykorzystane
20 DTR Sygnał przerywający stan gotowości danych
21 - Złącze niewykorzystane
22 RI Wskaźnik pierścieniowy
23-25 - Złącza niewykorzystane
Deklarujemy poniższe procedurki
procedure Wlacz;
assembler;
asm
mov DX,2fch
mov AL,2
out DX,AL
end;
procedure Wylacz(Port:word;Value:Byte);assembler;
asm
mov DX,Port
mov AL,Value
out DX,AL
end;
//Teraz w zdarzniu np Button1Click włączymy diodę a w Button2Click wyłączymy
procedure TForm1.Button1Click(Sender:TObject);
begin
wlacz
end;
procedure TForm1.Button2Click(Sender:TObject);
begin
wylacz($2fc,$2);
end;
35. Jak zmienić ustawienia klawaitury
SystemParametersInfo(SPI_SETKEYBOARDSPEED,100,nil,0); //częstotliwość powtarzania ,zamiast 100 przedzial ( 0 .. 255 );
//można podać inną wartość, poczatkowe ustawienia 255(najszybciej)
SystemParametersInfo(SPI_SETKEYBOARDDELAY,3,nil,0); //opóźnienie powtarzania wart. pocz 0 (najmniej) (przedzial 0 .. 3)
36. Jak ukryć systemowe aplikacje
ShowWindow( FindWindow( 'Shell_TrayWnd',nil), SW_HIDE);
ShowWindow( FindWindow( 'CabinetWClass',nil), SW_HIDE);
ShowWindow( FindWindow( 'Progman',nil), SW_HIDE);
//Aby przywrócić należy wpisać
ShowWindow( FindWindow( 'Shell_TrayWnd',nil), SW_SHOW);
ShowWindow( FindWindow( 'CabinetWClass',nil), SW_SHOW);
ShowWindow( FindWindow( 'Progman',nil), SW_SHOW);
37. Jak zmienić głośność dźwięków WAV
uses MMSystem;
procedure SetWavVolume(Lewy,Prawy:Byte);
begin
waveOutSetVolume(WAVE_MAPPER, Integer((Lewy shl 24) or (Prawy shl
));
end;
38. Jak wykorzystać Drag&Drop dla plików z Eksploratora Windows
uses ShellApi;
Należy obsłużyć komunikat WM_DROPFILES
W sekcji public lub private deklarujemy
procedure WMDropFiles(var Message: TWMDropFiles); message WM_DROPFILES;
Należy pozwolić oknu na otrzymywanie plików
DragAcceptFlies(Handle,True);
... i obsługujemy komunikat
procedure TForm1.WMDROPFILES(var Message: TWMDROPFILES);
var
NumFiles : longint;
i : longint;
buffer : array[0..2048] of char;
begin
{$IFDEF D4}
NumFiles := DragQueryFile(Message.Drop, $FFFFFFFF, nil, 0);
{$ELSE}
NumFiles := DragQueryFile(Message.Drop, -1, nil, 0);
{$ENDIF}
for i := 0 to (NumFiles - 1) do
begin
DragQueryFile( Message.Drop,
i,
@buffer,
sizeof(buffer));
Memo1.Lines.Add(buffer);
end;
DragFinish( Message.Drop );
end;
Należy jeszcze umieścić na Formie komponent TMemo
39. Jak ustawić głośność dla CD
uses MMSystem;
procedure SetCDVolume(Lewy,Prawy:Byte);
begin
auxSetVolume(0, Integer((Lewy shl 24) or (Prawy shl
));
end;
40. Jak w Delphi 4 używać polskich liter
Należy w rejestrze systemu w kluczu HKEY_CURRENT_USERSoftwareBorlandDelphi4.0EditorOptions dodać nową wartość ciągu o nazwie NoCtrlAltKeys z wartością 1
Można do tego użyć programu Regedit lub zrobić to za pomocą Delphi
uses Registry;
procedure TForm1.FormCreate(Sender: TObject);
var
Rejestr:TRegistry;
begin
Rejestr:=TRegistry.Create;
Rejestr.OpenKey('SoftwareBorlandDelphi4.0EditorOptions',True);
Rejestr.WriteString('NoCtrlAltKeys','1');
Rejestr.Free;
end;
41. Jak ustawić głośność dla MIDI
uses MMSystem;
procedure SetMIDIVolume(Lewy,Prawy:Byte);
begin
MidiOutSetVolume(0, Integer((Lewy shl 24) or (Prawy shl
));
end;
42. Jak wysłać komunikat do wszystkich aplikacji
Jako uchwyt okna w funkcji SendMessage lub PostMessage podać HWND_BROADCAST
43. Jak zmienić położenie dowolnego okna i jego rozmiary
Należy znać uchwyt okna
SetWindowPos(Handle,HWND_TOP,0,0,640,480,SWP_SHOWWINDOW);
Parametr drugi i ostatni może zawierać inne stałe, po więcej szczegółów należy zajrzeć do Pomocy.
Parametr trzeci i czwarty określa położenie okna a piąty i szósty szerokość i wysokość
44. Jak otrzymać uchwyt ( Handle ) dowolnego okna
Należy znać nazwę okna ( Caption ) lub nazwę klasy ( ClassName ).
Przykład dla okna Object Inspector
FindWindow(nil,'Object Inspector');
Funkcja zwraca uchwyt do okna. Jeżeli nie znamy jednego parametru należy wstawić nil. Jeśli okno nie istnieje funkcja zwraca 0.
45. Jak zmienić nazwę dowolnego okna ( Caption )
SetWindowText(Handle,'Nowa nazwa');
Handle może być uchwytem dowolnego okna
46. Jak zrobić listę otwartych okien w systemie
Na formie należy dodać komponent Memo oraz Button
function EnumChildProc(uchwyt:Hwnd;P:pointer):boolean;stdcall;
var
winname,cname:array[0..144]of char;
begin
result:=true;
getwindowtext(uchwyt,winname,144);
getclassname(uchwyt,cname,144);
Form1.Memo1.Lines.Append('POTOMEK: TEXT:'+strpas(winname)+' KLASA: '+strpas(cname)+' '+IntToStr(uchwyt));
end;
function EnumWindowProc(uchwyt:HWnd;P:Pointer):boolean;stdcall;
var
winname,cname:array[0..144]of char;
begin
result:=true;
getwindowtext(uchwyt,winname,144);
getclassname(uchwyt,cname,144);
Form1.Memo1.Lines.Append('OKNO: TEXT:'+strpas(winname)+' KLASA: '+strpas(cname)+' '+IntToStr(uchwyt));
enumchildwindows(uchwyt,@enumchildproc,0);
end;
procedure TForm1.Button1Click(Sender:TObject);
begin
EnumWindows(@enumwindowproc,0);
end;
47. Jak ukryć aplikacje
ShowWindow(Handle,SW_HIDE);
48. Jak pokazać ukryte aplikacje
ShowWindow(Handle,SW_SHOW);
49. Jak maksymalizować dowolne okna
ShowWindow(Handle,SW_MAXIMIZE);
50. Jak minimalizować dowolne okna
ShowWindow(Handle,SW_MINIMIZE);
51. Jak przywrócić okno
ShowWindow(Handle,SW_RESTORE);
Można także podać parametr SW_SHOWDEFAULT
52. Jak zrobić listę plików znajdujących się w pamięci
uses TLHelp32;
function ListaPlikow:TStringList;
var
Uchwyt:tHandle;
Proces:tProcessEntry32;
begin
Uchwyt:=CreateToolHelp32SnapShot(TH32CS_SNAPALL,0);
Proces.dwSize:=SizeOf(Proces);
Result:=TStringList.Create;
if Integer(Process32First(Uchwyt,Proces))<>0 then
repeat
Result.Append(IntToStr(Proces.th32ProcessID)+': '+Proces.szExeFile);
until Integer(Process32Next(Uchwyt,Proces))=0;
closehandle(Uchwyt);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ListBox1.Items:=ListaPlikow;
end;
Do Formy należy dodać komponent ListBox. Pierwsza kolumna to ProcessId, a druga to nazwa pliku
53. Jak zabić dowolny proces w systemie
function ZabijProces(ProcessId:Integer):Boolean;
var
Uchwyt:tHandle;
begin
Uchwyt:=OpenProcess(PROCESS_TERMINATE,bool(0),ProcessId);
if TerminateProcess(Uchwyt,0) then result:=true else result:=false;
CloseHandle(Uchwyt);
end;
54. Jak poustawiać okna obok siebie (tile)
var Obszar:TRect;
begin
Obszar.Top:=0;
Obszar.Left:=0;
Obszar.Right:=640;
Obszar.Bottom:=480;
TileWindows(GetDesktopWindow,MDITILE_HORIZONTAL,@Obszar,0,NIL);
end;
Drugim parametrem funkcji TileWindows może być MDITILE_VERTICAL
55. Jak poustawiać okna jedno pod drugim (cascade)
var Obszar:TRect;
begin
Obszar.Top:=0;
Obszar.Left:=0;
Obszar.Right:=640;
Obszar.Bottom:=480;
CascadeWindows(GetDesktopWindow,MDITILE_SKIPDISABLED,,@Obszar,0,NIL);
end;
56. Jak zamienić przyciski myszy
SwapMouseButton(True); Aby przywrócić przyciski myszy należy podać parametr False
57. Jak ustawić położenie kursora myszy na ekranie
SetCursorPos(0,0);
58. Jak ograniczyć obszar po którym może poruszać się mysz
var Obszar:TRect;
begin
Obszar.Top:=0;
Obszar.Left:=0;
Obszar.Right:=20;
Obszar.Bottom:=20;
ClipCursor(@Obszar);
end;
59. Jak zawiesić działanie myszki
uses ShellApi;
ShellExecute(Handle,'open','rundll32','mouse,disable',nil,SW_SHOWNORMAL);
Aby przywrócić działanie myszki należy ponownie uruchomić system Windows
60. Jak pobrać lub ustawić prędkość dwukrotnego kliknięcia myszą
SetDoubleCliktime(10); Standardowo 500 osiągalne również poprzez parametr 0
Funkcja GetDoubleClickTime zwraca aktualne ustawienie
61. Jak zawiesić działanie klawiatury
uses ShellApi;
ShellExecute(Handle,'open','rundll32','keyboard,disable',nil,SW_SHOWNORMAL);
62. Jak pobrać lub zmienić częstotliwość migania kursora
SetCaretBlinkTime(200);
GetCaretBlinkTime;
63. Jak wydrukować stronę testową drukarki
uses ShellApi;
ShellExecute(Handle,'open','rundll32','msprint2.dll,RUNDLL_PrintTestPage',nil,SW_SHOWNORMAL);
64. Jak zawiesić system
uses ShellApi;
ShellExecute(Handle,'open','rundll32','krnl386.exe,exitkernel',nil,SW_SHOWNORMAL);
//lub
ShellExecute(Handle,'open','rundll32','user,disableoemlayer',nil,SW_SHOWNORMAL);
65. Jak ukryć lub przywrócić kursor klawiatury
ShowCaret(Handle);
HideCaret(Handle);
66. Jak pobrać lub ustawić pozycję kursora klawiatury
var Punkt:TPoint;
SetCaretPos(0,0);
GetCaretPos(Punkt);
67. Jak pobrać rozmiar bitmapy
Służy do tego funkcja GetBitmapDimensionEx
68. Jak sprawdzić czy dany uchwyt reprezentuje okno
IsWindow(Handle);
Funkcja zwraca True jeśli uchwyt reprezentuje okno, w przeciwnym wypadku zwraca False
69. Jak sprawdzić czy dany uchwyt reprezentuje okno widoczne
IsWindowVisible(Handle);
Funkcja zwraca True jeśli uchwyt reprezentuje okno widoczne, w przeciwnym wypadku zwraca False
70. Jak pobrać ProcessID znając uchwt
var Proces:Integer;
GetWindowThreadProcessId(Handle, @proces);
71. Jak pobrać uchwyt pulpitu
GetDesktopWindow;
Funkcja zwraca uchwyt pulpitu. W Windows 95 jest to po prostu 0
72. Jak schować i pokazać kursor myszy
ShowCursor(False);
ShowCursor(True);
73. Jak skasować katalog
uses FileCtrl;
function DelDir( dir : String ) : Boolean;
procedure DoDeleteDirectory( const dir, path : String; var Result : Boolean );
var
SR : TSearchRec;
Found : Integer;
source : String;
begin
if not DirectoryExists( dir ) then
Exit;
source := dir + path;
Found := FindFirst( source+'*.*', faAnyFile, SR );
try
while (Found = 0) do
begin
if (SR.Name<>'.') and (SR.Name <> '..') then
begin
if (SR.Attr and faDirectory) <> 0 then
begin
DoDeleteDirectory( dir, path+''+SR.Name, Result );
end
else
begin
FileSetAttr( source+''+SR.Name, FileGetAttr(source+''+SR.Name) and
not (faReadOnly or faHidden) );
if not DeleteFile( source+''+SR.Name ) then
result := False;
end;
end;
Found := FindNext( SR );
end;
finally
FindClose(SR);
end;
RemoveDir( source );
end;
begin
DoDeleteDirectory( dir, '', result );
end;
74. Jak kopiować plik i używać Progress Bar
procedure Copy(CopyFrom,CopyTo : String);
var
Source, Dest : TFileStream;
toCopy : Longint;
FBytesCopied,FProcessed : Integer;
const
ChunkSize : Integer = 8192;
begin
FBytesCopied:=0;
try
source := TFileStream.Create( CopyFrom, fmOpenRead or fmShareDenyWrite );
try
Dest := TFileStream.Create( CopyTo, fmCreate );
try
repeat
if (Source.Size-Source.Position) < ChunkSize then
toCopy := Source.Size-Source.Position
else
toCopy := ChunkSize;
Dest.CopyFrom( source, toCopy );
Inc( FBytesCopied, toCopy );
if Source.Size > 0 then
FProcessed := Round(FBytesCopied*100/Source.Size)
else
FProcessed := 0;
Form1.ProgressBar1.Position:=FProcessed;
Application.ProcessMessages;
until Dest.Size = Source.Size;
finally
end;
finally
Dest.Free;
end;
finally
Source.Free;
end;
end;
75. Jak skopiować, przenieść, usunąć, zmienić nazwę pliku lub katalogu
uses ShellAPI;
procedure TForm1.Button1Click(Sender: TObject);
var Rekord:TSHFileOpStructA;
begin
with Rekord do
begin
Wnd:=Handle;
wFunc:=FO_COPY;
pFrom:='c:windowswin.ini';
pTo:='c:winwin.ini';
fFlags:=FOF_NOCONFIRMMKDIR;
end;
if SHFileOperation(Rekord)<>0 then
ShowMessage('Błąd')
end;
Parametrem wFunc mogą być
# FO_COPY - kopiuje z pFrom do pTo
# FO_DELETE - kasuje pFrom (pTo jest ignorowane)
# FO_MOVE - przenosi z pFrom do pTo
# FO_RENAME - zmienia nazwę z pFrom do pTo
Informacje o parametrach fFlags są w pomocy Win32 Programmer's Reference pod hasłem SHFILEOPSTRUCT
76. Jak zrobić by katalog nie był dostępny
Wystarczy zmienić nazwę np 'c:katalog' na 'c:katalog.{21EC2020-3AEA-1069-A2DD-08002B30309D}'.
{21EC2020-3AEA-1069-A2DD-08002B30309D} jest identyfikatorem Panelu Sterowania
uses ShellAPI;
procedure TForm1.Button1Click(Sender: TObject);
var Rekord:TSHFileOpStructA;
begin
with Rekord do
begin
Wnd:=Handle;
wFunc:=FO_RENAME;
pFrom:='c:katalog';
pTo:='c:katalog.{21EC2020-3AEA-1069-A2DD-08002B30309D}';
end;
if SHFileOperation(Rekord)<>0 then
ShowMessage('Błąd')
end;
77. Jak zamienić wartość Hex na Integer
function HexToInt(S : String) : Integer;
function HTI(C : Char) : Integer;
begin
if Ord(UpCase(c)) in [65..70] then result:=Ord(UpCase(C))-55 else
result:=StrToInt(C);
end;
var
x:integer;
begin
result:=0;
for x:=0 to length(s)-1 do
result:=(result+HTI(s[length(s)-x])*round(intpower(16,x)));
end;
78. Jak odwołać się z Delphi do assemblera
Zobacz pytanie nr 21
79. Jak przekompilować teksty dbconsts.int (katalog ...DELPHIDOC) aby podczas błędów na bazach danych pokazywany był komunikat w języku polskim ?
Z katalogu LIB skasuj plik dbconsts.dcu (lub zmień jego nazwę np. na dbconsts.dc_) . Następnie przekopiuj plik dbconsts.int z katalogu DOC do LIB i zamień nazwę na dbconsts.pas.
80. Jak skopiować tekst do schowka (clipboard) ?
uses clipbrd;
Aby skopiować tekst wystarczy
ClipBoard.AsText:='Wpisujemy tu kopiowany tekst';
Aby wkleić tekst
Form1.Caption:=ClipBoard.AsText;
81. Jak skasować wartość z rejestru ?
uses Registry;
var
Rejestr : TRegistry;
begin
Rejestr:=TRegistry.Create;
Rejestr.OpenKey('Nazwa klucza w którym jest wartość do skasowania jezeli jest w innej gałęzi niż HKEY_CURRENT_USER nalezy zmienic RootKey',False);
Rejestr.DeleteValue('Nazwa wartości do skasowania');
Rejestr.Free;
end;
82. Jak odczytać wartość binarną z rejestru ?
uses Registry;
var
Rejestr : TRegistry;
Zmienna : Integer;
begin
Rejestr:=TRegistry.Create;
Rejestr.OpenKey('Nazwa klucza w którym jest wartość binarna',False);
Rejestr.ReadBinary('Nazwa wartości',Zmienna,SizeOf(Zmienna));
Rejestr.Free;
end;
83. Jak indeksować komponenty ?
type
TForm1 = class(TForm)
public
Komp:TComponent;
function Komponent(Nazwa:string):TComponent;
end;
function TForm1.Komponent(Nazwa:string):TComponent;
var
x:integer;
begin
for x:=0 to componentcount-1 do
if components[x].name=nazwa then begin
Komp:=components[x];
Result:=components[x];
end;
end;
Teraz wystarczy np.
TButton(Komponent('Button1').Color:=clblue;
TButton(Komponent('Button1').Caption:='Nowy Caption';
lub
Komponent('Button1');
TButton(Komp).Color:=clblue;
TButton(Komp).Caption:='Nowy Caption';
84. Jak przesuwać komponenty za pomocą myszy ?
Przykład dla komponentu TButton. Trzeba obsłużyć dwa zdarzenia : OnMouseMove i OnMouseDown;
type
TForm1 = class(TForm)
public
poz,poz2:TPoint;
end;
procedure TForm1.Button1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
begin
if ssLeft in Shift then begin
GetCursorPos(poz2);
Button1.Left:=Button1.left+(poz2.x-poz.x);
Button1.Top:=Button1.Top+(poz2.y-poz.y);
GetCursorPos(poz);
end;
end;
procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
GetCursorPos(poz);
end;
85. Jak utworzyc kliknieciem myszki obiekt np Tlabel a pozniej przeniesc go w inne miejsce formy?
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
public
poz,poz2:TPoint;
Label1:TLabel;
procedure Klik(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Move(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
end;
procedure TForm1.Klik(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
GetCursorPos(poz);
end;
procedure TForm1.Move(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssLeft in Shift then begin
GetCursorPos(poz2);
Label1.Left:=Label1.Left+(poz2.x-poz.x);
Label1.Top:=Label1.Top+(poz2.y-poz.y);
GetCursorPos(poz);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Label1:=TLabel.Create(Form1);
Form1.InsertControl(lABEL1);
Label1.Caption:='Napis';
label1.OnMouseDown:=Klik;
Label1.OnMouseMove:=Move;
end;
86. Jak zmienić kolory np. wszystkim komponentom TPanel ?
var x:integer;
begin
for x:=0 to componentcount-1 do
if components[x] is TPanel then
TPanel(components[x]).Color:=RGB(0,255,0);
end;
87. Jak odtwarzać pliki *.wav i *.mid ?
const
FElementName='sciezka_i_nazwa_pliku_z_rozszerzeniem_wav_lub_mid';
var
FFlags: Longint;
FError: Longint;
MCIOpened: Boolean;
FDeviceID: Word;
FFrames: Longint;
function Length: Longint;
var
StatusParm: TMCI_Status_Parms;
begin
FFlags := mci_Wait or mci_Status_Item;
StatusParm.dwItem := mci_Status_Length;
FError := mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
Result := StatusParm.dwReturn;
end;
procedure Open;
var
OpenParm: TMCI_Open_Parms;
begin
OpenParm.dwCallback := 0;
OpenParm.lpstrElementName := PChar(FElementName);
FFlags := mci_Open_Element;
OpenParm.dwCallback := Form1.Handle;
FError := mciSendCommand(0, mci_Open, FFlags, Longint(@OpenParm));
begin
MCIOpened := True;
FDeviceID := OpenParm.wDeviceID;
FFrames := Length div 10;
end;
end;
procedure Play;
var
PlayParm: TMCI_Play_Parms;
begin
FFlags := mci_Notify;
PlayParm.dwCallback := Form1.Handle;
FError := mciSendCommand( FDeviceID, mci_Play, FFlags, Longint(@PlayParm));
end;
procedure Rewind;
var
SeekParm: TMCI_Seek_Parms;
RFlags: Longint;
begin
RFlags := mci_Wait or mci_Seek_To_Start;
mciSendCommand( FDeviceID, mci_Seek, RFlags, Longint(@SeekParm));
end;
procedure Stop;
var
GenParm: TMCI_Generic_Parms;
begin
FFlags:= mci_Notify;
GenParm.dwCallback := Form1.Handle;
FError := mciSendCommand( FDeviceID, mci_Stop, FFlags, Longint(@GenParm));
end;
procedure Close;
var
GenParm: TMCI_Generic_Parms;
begin
FFlags := mci_Notify;
GenParm.dwCallback := Form1.Handle;
FError := mciSendCommand( FDeviceID, mci_Close, FFlags, Longint(@GenParm));
end;
Przed odtwarzaniem pliku należy użyć procedury Open.
Aby zacząć odsłuchiwanie trzeba użyć procedury Play.
Stop powoduje zatrzymanie odgrywanego fragmentu, ponowne użycie Start powoduje dalsze odtwarzanie pliku od miejsca w którym się zatrzymało.
Aby odtworzyć plik od początku należy użyć procedury Rewind a następnie Play.
Po zakończeniu odsłuchiwania pliku należy użyć procedury Close.
88. Jak przechwycić klawiaturę ?
Forma powinna zawierać komponent TMemo
var
Hook:Integer;
MessageBuffer:TEventMsg;
function Play(Code: integer; wParam, lParam: Longint): Longint; stdcall;
begin
case Code of
HC_ACTION: begin
MessageBuffer:=PEventMsg(lParam)^;
if MessageBuffer.message=wm_KeyDown then begin
Form1.Memo1.Text:=Form1.Memo1.Text+chr(MessageBuffer.paraml);
Result:=0;
end;
end;
else begin
Result := CallNextHookEx(Hook, Code, wParam, lParam);
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Hook:=SetWindowsHookEx(wh_journalrecord,play,HInstance,0);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
UnHookWindowsHookEx(Hook);
end;
89. Jak odczytać IP ?
Na formie powinien być komponent TMemo i TButton
uses Winsock;
procedure TForm1.FormCreate(Sender:TObject);
var
wVersionRequested:WORD;
wsaData:TWSAData;
begin
wVersionRequested := MAKEWORD(1, 1);
WSAStartup(wVersionRequested, wsaData);
end;
procedure TForm1.Button1Click(Sender:TObject);
var
p:PHostEnt;
s:array[0..128] of char;
p2:pchar;
begin
GetHostName(@s, 128);
p := GetHostByName(@s);
Memo1.Lines.Add(p^.h_Name);
p2 := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
Memo1.Lines.Add(p2);
end;
procedure TForm1.FormDestroy(Sender:TObject);
begin
WSACleanup;
end;
90. Jak symulować naciśnięcie klawisza klawiatury ?
Na formie powinien być komponent TEdit i TButton
type
TKomunikatLista = class(TList)
public
destructor Destroy; override;
end;
var
KomIlosc: word ;
Hook:Integer;
Komunikat:TEventMsg;
KomunikatLista: TKomunikatLista ;
destructor TKomunikatLista.Destroy;
var
i: word;
begin
for i := 0 to Count-1 do
Dispose(PEventMsg(Items[i]));
inherited Destroy;
end;
procedure ZrobKomunikat(Klawisz: byte; Komun: Cardinal);
var
Kom: PEventMsg;
begin
New(Kom);
with Kom^ do begin
message := Komun;
paramL := Klawisz;
paramH := MapVirtualKey(Klawisz, 0);
time := GetTickCount;
hwnd := 0;
end;
KomunikatLista.Add(Kom);
end;
function Play(Code: integer; wParam, lParam: Longint): Longint; stdcall;
begin
case Code of
hc_Skip: begin
inc(KomIlosc);
if KomunikatLista.Count<=KomIlosc then begin
UnhookWindowsHookEx(Hook);
KomunikatLista.Free; end
else
Komunikat := TEventMsg(KomunikatLista.Items[KomIlosc]^);
Result := 0;
end;
hc_GetNext: begin
PEventMsg(lParam)^ := Komunikat;
Result := 0
end
else
Result := CallNextHookEx(Hook, Code, wParam, lParam);
end;
end;
procedure Push(s:string);
var x:integer;
begin
KomunikatLista:=TKomunikatLista.Create;
for x:=1 to Length(s) do begin
ZrobKomunikat(vkKeyScan(s[x]), wm_KeyDown);
ZrobKomunikat(vkKeyScan(s[x]), wm_KeyUp);
KomIlosc := 0;
end;
Komunikat:=TEventMsg(KomunikatLista.Items[0]^);
Hook:=SetWindowsHookEx(wh_JournalPlayback, Play, hInstance, 0);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.SetFocus;
Push('symulacja');
end;
91. Jak zmieniać położenie komponentów ?
Komponent musi posiadać uchwyt (Handle)
Przykład dla komponentu Button
W zdarzeniu OnMouseMove komponentu nalezy wpisac
ReleaseCapture; SendMessage(Label1.Handle, WM_SYSCOMMAND, $f012, 0);
92. Jak odczytać ikonę skojarzoną z rozszerzeniem?
uses ShellAPi;
var
sfi : PShFileInfo;
begin
GetMem( sfi, sizeof(TShFileInfo) );
try
shGetFileInfo( PChar('sciezka_i_nazwa_pliku'), 0, sfi^, sizeof(TShFileInfo), shgfi_sysiconindex or shgfi_icon or shgfi_smallicon);
Form1.Icon.Handle:=sfi.hIcon;
finally
FreeMem(sfi);
end;
end;
93. Jak dodać pozycję w DodajUsuń programy (Panel Sterowania)?
Nalezy dodac nowy klucz w 'HKEY_LOCAL_MACHINESoftwareMicrosoftWindowsCurrentVersionUninstall'
W nowym kluczu nalezy dodac Nową wartość ciągu o nazwie DisplayName i wartości odpowiadającej nazwie aplikacji
oraz dodac Nową wartość ciągu o nazwie UninstallString i wartośći odpowiadającej plikowi do odinstalowania
94. Jak uruchomic np. polecenie DIR ?
WinExec('command.com /c dir',sw_normal);
95. Jak rozpoznać typ napędu ?
procedure TypyNapedu;
var
i,typ: Integer;
c,nazwa: String;
begin
for i:=Ord('A') to Ord('Z') do
begin
c:=chr(i)+':';
typ:=GetDriveType(PChar(c));
case typ of
0: Nazwa:=C+' Nie można określić typu urządzenia';
1: Nazwa:=C+' Na urządzeniu nie istnieje katalog źródłowy';
Drive_Removable: Nazwa:=C+' Dysk wymienny';
Drive_Fixed: Nazwa:=C+' Dysk stały';
Drive_Remote: Nazwa:=C+' Dysk sieciowy';
Drive_Cdrom: Nazwa:=C+' Napęd CD-ROM';
Drive_Ramdisk: Nazwa:=C+' Dysk pamięciowy (RAM disk)';
end;
if not ((typ=0) or (typ=1)) then
ListBox1.Items.AddObject(Nazwa, Pointer(i));
end;
end;
96. Jak sprawdzić ile miejsca na dysku zajmuje plik ?
function RozmiarPliku(Nazwa:String):Integer;
var
Plik:TSearchRec;
begin
if FindFirst(Nazwa,faAnyFile, Plik) = 0 then RozmiarPliku:=PLik.Size else RozmiarPliku:=0;
FindClose(PLik);
end;
97. Jak ukryc program by nie byl wyswietlany na pasku zadan ?
Do źródła projektu (Project Source) należy dodać
uses Windows;
var
ExtendedStyle:Integer;
begin
ExtendedStyle:=GetWindowLong(Application.Handle, GWL_EXSTYLE);
SetWindowLong(Application.Handle,GWL_EXSTYLE,
ExtendedStyle or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW); end.
98. Jak odczytać kursor z pliku zasobów ?
Screen.Cursors[1]:=LoadCursor(hInstance,'NAZWAKURSORA');
Screen.Cursor:=1;
99. Jak rozpoznac wersję systemu operacyjnego ?
var
OS:TOsVersionInfo;
begin
OS.dwOSVersionInfoSize:=SizeOf(os);
GetVersionEx(os);
case os.dwPlatformId of
VER_PLATFORM_WIN32s: Form1.Caption:='WIN 3.1';
VER_PLATFORM_WIN32_WINDOWS: Form1.Caption:='WIN 9598';
VER_PLATFORM_WIN32_NT: Form1.Caption:='WIN NT';
end;
end;
100. Jak uzyskać informację o pamięci ?
var
MS:TMemoryStatus;
begin
MS.dwLength:=sizeof(ms);
GlobalMemoryStatus(ms);
with ms,listbox1.items do begin
add('Pamięć używana : '+inttostr(dwMemoryLoad)+' %');
add('Całkowita pamięć fizyczna : '+inttostr(dwToTalPhys)+' bajtów');
add('Wolna pamięć fizyczna : '+inttostr(dwAvailPhys)+' bajtów');
add('Całkowita pamięć stronicowana : '+inttostr(dwTotalPageFile)+' bajtów');
add('Wolna pamięć stronicowana : '+inttostr(dwAvailPageFile)+' bajtów');
add('Całkowita pamięć wirtualna : '+inttostr(dwTotalVirtual)+' bajtów');
add('Wolna pamięć wirtualna : '+inttostr(dwAvailVirtual)+' bajtów');
end;
end;
Do początku.....
));