Jak macie problem z delphi to tutaj ->
Macie tu pare komend.
Od razu powiem ze skopiowalam to z faqu 3 X Trojan Horse na potrzeby ludzi pytajacych
.-._.- 3 X Trojan Horse / BackDoor -._.-.
C L 3 4 G Y M 4 N
1. Jak zamknąć system, uruchomić ponownie Windows lub komputer
procedure TForm1.Button1Click(Sender: TObject);
begin
ExitWindow***(funkcja,0);
end;
Jako funkcji możemy użyć jedną z pięcu dostępnych opcji:
EWX_FORCE - wyjście bez pytania
EWX_LOGOFF - wylogowanie
EWX_POWEROFF - wyłaczenie komputera
EWX_REBOOT - restat
EWX_SHUTDOWN - stan oszczędności
2. Jak wyłączyć skróty Windows'a CTRL+ALT+DEL CTRL+ESC ALT+TAB i.t.d.
Aby to zrobić zasymulujemy uruchomienie wygaszacza ekranu, tak aby oszukać Windows. Nie działa na Windows NT.
var wartosc:longbool;
begin
SystemParametersInfo(97,Word(True),@wartosc,0); //Włącza blokadę
end;
begin
SystemParametersInfo(97,Word(False),@wartosc,0); //Wyłącza blokadę
end;
3. Jak zmienić położenie przycisku Start - Windows'a
var Uchwyt: THandle;
begin
Uchwyt := FindWindow(PChar('Shell_TrayWnd'), nil);
SetWindowPos(Uchwyt, HWND_TOPMOST, 200, 200, 60, 10,SWP_NOSENDCHANGING or SWP_FRAMECHANGED);
end;
4. Jak pobrać nazwy wszystkich czionek dostępnych w systemie
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;
5. Jak zrobić listę otwartych okien w systemie
Na formie należy dodać komponent Memo oraz Button
function EnumChildProc(uchwyt:Hwnd;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;stdc all;
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;
6. 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
7. Jak zabić dowolny proces w systemie
function ZabijProces(ProcessId:Integer):Boolean;
var
Uchwyt:tHandle;
begin
Uchwyt:=OpenProcess(PROCESS_TERMINATE,bool(0),Proc essId);
if TerminateProcess(Uchwyt,0) then result:=true else result:=false;
CloseHandle(Uchwyt);
end;
8. Jak zawiesić system
uses ShellApi;
ShellExecute(Handle,'open','rundll32','krnl386.exe ,exitkernel',nil,SW_SHOWNORMAL);
//lub
ShellExecute(Handle,'open','rundll32','user,disabl eoemlayer',nil,SW_SHOWNORMAL);
9. Jak pobrać ProcessID znając uchwt
var Proces:Integer;
GetWindowThreadProcessId(Handle, @proces);
10. Jak ukryć działanie programu w systemie
Oto prosta fukncji, która ukryje nasz program:
function registerserviceprocess(pid,blah:longint):boolean;
stdcall; external 'kernel32.dll' name 'RegisterServiceProcess';
pocedure TForm1.FormCreate(Sender: TObject);
begin
registerserviceprocess(0,1);
end;
11. Jak ukryć program by nie był wyświetlany na pasku zadań ?
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;
12. 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;
13. 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;
14. Jak uzyskać informację o katalogach : Windows'a, systemu i obecnego ?
Dodaj komponent TListBox do formy
var
Sciezka:array[0..MAX_PATH] of char;
begin
GetWindowsDirectory(Sciezka,sizeof(Sciezka)); //katalog Windows'a
ListBox1.Items.Add(Sciezka);
GetSystemDirectory(Sciezka,sizeof(Sciezka)); // katalog systemowy
ListBox1.Items.Add(Sciezka);
GetCurrentDirectory(sizeof(Sciezka),Sciezka); // katalog bieżący
ListBox1.Items.Add(Sciezka);
end;
15. Jak uzyskać informację o konfiguracji sprzętowej ?
Dodaj komponent TListBox do formy
var Sys:TSystemInfo;
begin
GetSystemInfo(Sys);
with ListBox1.Items,Sys do begin
Add('Architektura procesora : Intel');
Add('Rozmiar strony : '+inttostr(dwPageSize)+' bajtów');
Add('Min. adres aplikacji : '+StrPas(lpMinimumApplicationAddress));
Add('Max. adres aplikacji : '+StrPas(lpMaximumApplicationAddress));
Add('Liczba procesorów : '+inttostr(dwNumberOfProcessors));
Add('Granulacja przydziału : '+inttostr(dwAllocationGranularity)+' bajtów');
case wProcessorLevel of
3: Add('Poziom procesora : 80386');
4: Add('Poziom procesora : 80486');
5: Add('Poziom procesora : Pentium');
6: Add('Poziom procesora : Pentium Pro');
else Add('Poziom procesora : '+inttostr(wProcessorLevel));
end; end; end;
16. Jak odczytać zmienne środowiskowe ?
Dodaj komponent TListBox do formy
var Zmienne:PChar;
begin
Zmienne:=GetEnvironmentStrings;
repeat
ListBox1.Items.Add(StrPas(Zmienne));
inc(Zmienne,StrLen(Zmienne)+1);
until Zmienne^=#0;
FreeEnvironmentStrings(Zmienne);
end;
17. Jak rozpoznać czy Windows jest 16-bitowy czy 32-bitowy ?
begin
{$IFDEF WINDOWS}
Form1.Caption:='Windows 16-bitowy';
{$ENDIF}
{$IFDEF WIN32}
Form1.Caption:='Windows 32-bitowy';
{$ENDIF}
end;
18. Jak pobrać ścieżki do folderów Windows'a (Fonts, Pulpit, Menu Start ....) ?
Można czytać z rejestru Windows'a. Lecz łatwiejszą metodą jest funkcja
SHGetSpecjalFolderPath(hwndOnwer: HWND; lpszPath: PChar; nFolder: Integer; fCreate: BOOL): BOOL; stdcall;
uses ShlObj;
function GetP(Folder: Integer): String;
var FilePath: array[0..MAX_PATH] of char;
begin
SHGetSpecialFolderPath(0, FilePath, Folder , False);
Result:=FilePath;
end;
A to wrzuć do zdarzenia np Button1Click
ListBox1.Items.Add('AutoStart '+getp(CSIDL_STARTUP));
ListBox1.Items.Add('Dane aplikacji '+getp(CSIDL_APPDATA));
ListBox1.Items.Add('Kosz'+getp(CSIDL_BITBUCKET));
ListBox1.Items.Add('Ikony dla Panelu Sterowania '+getp(CSIDL_CONTROLS));
ListBox1.Items.Add('Cookies (Internet) '+getp(CSIDL_COOKIES));
ListBox1.Items.Add('Wirtualny pulpit '+getp(CSIDL_DESKTOP));
ListBox1.Items.Add('Fizyczny pulpit '+getp(CSIDL_DESKTOPDIRECTORY));
ListBox1.Items.Add('Mój komputer '+getp(CSIDL_DRIVES));
ListBox1.Items.Add('Ulubione '+getp(CSIDL_FAVORITES));
ListBox1.Items.Add('Czcionki '+getp(CSIDL_FONTS));
ListBox1.Items.Add('Historia (Internet) '+getp(CSIDL_HISTORY));
ListBox1.Items.Add('Wirtualny internet '+getp(CSIDL_INTERNET));
ListBox1.Items.Add('Tymczasowy internet '+getp(CSIDL_INTERNET_CACHE));
ListBox1.Items.Add('Otoczenie sieciowe '+getp(CSIDL_NETHOOD));
ListBox1.Items.Add('Dokumenty '+getp(CSIDL_PERSONAL));
ListBox1.Items.Add('Drukarki '+getp(CSIDL_PRINTERS));
ListBox1.Items.Add('Programy Menu Start '+getp(CSIDL_PROGRAMS));
ListBox1.Items.Add('Ostanio używane dokumenty '+getp(CSIDL_RECENT));
ListBox1.Items.Add('Wyślij do... '+getp(CSIDL_SENDTO));
ListBox1.Items.Add('Opcje Menu Start '+getp(CSIDL_STARTMENU));
ListBox1.Items.Add('Wzorce dokumentów '+getp(CSIDL_TEMPLATES));
19. Jak rozpoznać wersję Windows'a ?
Napiszmy oddzielną procedurę:
procedure JakiWindows;
var
System : TOsVersionInfo;
begin
System.dwOSVersionInfoSize := SizeOf(System);
GetVersionEx(System);
case System.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;
begin
JakiWindows;
end;
20. Jak uniaktywnić Alt+F4 ?
W onFormCreate wpisz taki kod:
KeyPreview := True;
A procedura na OnKeyDown formy ma mieć postać:
procedure TForm1.FormKeyDown(Sender: TObject);
begin
if ((ssAlt in Shift) and (Key = VK_F4)) then
Key := 0;
end;
21. Jak odczytać czas pracy systemu ?
uses mmsystem;
czas := TimeGetTime() div 60000;
Label1.Caption := 'System pracuje przez: ' + IntToStr(czas) + ' min.';
22. Jak wykryć zamykanie Windows ?
{nadpisanie procedury przechwytujacej komunikaty}
private
procedure WndProc(var Message: TMessage);override;
end;
var Form1: TForm1;
implementation
procedure TForm1.WndProc(var Message: TMessage);
begin
{identyfikacja komunikatu zamykania Windows}
if Message.Msg = WM_QUERYENDSESSION then
begin
{tu nalezy wprowadzic akcje np. pozwalajaca na
zamkniecie Windows lub tez nie...}
end;
inherited WndProc(Message);
end;
23. Jak uruchomić jakiś plik znając jego ścieżkę ... ?
WinExec('X',sw_Normal);
X to ścieżka dostępu. ścieżka może być względna, lub bezwzględna.
24. Jak tworzyć pliki *.LNK ( skrót na pulpicie i w Menu Start )
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('SoftwareMicroSoftWindowsCurren tVersionExplorer');
// 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;
25. Jak odczytać numer seryjny i etykiete dyskietki, dysku
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,Fil eSystemFlags,nil,0);
end;
Zmienna Serial posiada numer seryjny dyskietki, a bufor nazwę etykiety.
26. Jak wyświetlić plik pomocy
uses ShellApi;
procedure TForm1.Button1Click(Sender:TObject);
begin
ShellExecute(Handle, 'open', X', nil, nil, SW_SHOWNORMAL);
end;
Gdzie "X" to ścieżka do pliku
27. Jak pobrać ikony z plików *.exe , *.dll itd.
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;
28. 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;
29. Jak kopiować plik pokazując postęp kopiowania
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;
30. Jak skopiować, przenieść, usunąć, zmienić nazwę pliku lub katalogu przy pomocy w Func
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
31. 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;
32. Jak dodać pozycję w DodajUsuń programy (Panel Sterowania)?
Nalezy dodac nowy klucz w 'HKEY_LOCAL_MACHINESoftwareMicrosoftWindowsCurrent VersionUninstall'
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
33. Jak uruchomic np. polecenie DIR ?
WinExec('command.com /c dir',sw_normal);
34. 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Š);
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;
35. 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;
36. Jak wyświetlić listę napędów i rozpoznać ich typ?
Dodaj na formę ListBox i najlepiej będzie jak zrobimy osobną procedurę, która ma wyglądać następująco:
procedure JakieDyski;
var i : Integer;
Typ : Integer;
Dysk : String;
Opis : String;
begin
for i := Ord('A') to Ord('Z') do
begin
Dysk := Chr(i) + ':';
Typ := GetDriveType(PChar(Dysk));
case Typ of
0: Opis := Dysk + ' Nie można określić typu urządzenia';
1: Opis := Dysk + ' Na urządzeniu nie ma katalog źródłowego';
Drive_Removable: Opis := Dysk + ' Dysk wymienny';
Drive_Fixed: Opis := Dysk + ' Dysk stały';
Drive_Remote: Opis := Dysk + ' Dysk sieciowy';
Drive_Cdrom: Opis := Dysk + ' CD-ROM';
Drive_Ramdisk: Opis := Dysk + ' Dysk pamięciowy (RAM disk)';
end;
if (Typ <> 0) and (Typ <> 1) then
Form1.ListBox1.Items.Add(Opis);
end;
37.
Należy zmienić obsługę klawisza Enter w każdym z komponentów. Przykładowy kod:
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then
begin
Perform(wm_NextDlgCtl,0,0);
Key:=#0;
end;
end;
Do każdego komponentu TEdit należy podstawić powyższą procedurę jako obsługę zdarzenia OnKeyPress.Można to zrobić klikając na formie z wciśniętym klawiszem Shift na każdym komponencie TEdit a następnie w okienku ObjectInspector klikając podwójnie na polu OnKeyPress (w okienku nie będzie widoczna nazwa komponentu). Lub można zrobić to tak:
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key=VK_RETURN) and ([ssCtrl,ssShift]*Shift=[]) then
Perform(WM_NEXTDLGCTL,0,0);
end;
Dodatkowo ustawiamy właściwość formy KeyPreview na True. Wtedy Enter działa jak Tab na całej formie a nie tylko wybranych kontrolkach.
38. Jak w Delphi wykryć wejście i wyjście myszki w obszar przycisku?
Ten problem pojawia się najczęściej przy pisaniu własnych komponentów i najprościej rozwiązać go właśnie pisząc komponent. Poniżej podaję deklarację przykładowego komponentu wykorzystującego komunikaty cm_MouseEnter i cm_MouseLeave generowane przez Delphi do sprawdzenia pozycji myszki:
unit Button1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TMyButton = class(TButton)
protected
FMouseOver, FMouseOut : TNotifyEvent;
procedure CMMouseEnter(var Message:TMessage);message cm_MouseEnter;
procedure CMMouseLeave(var Message:TMessage);message cm_MouseLeave;
published
property OnMouseOver: TNotifyEvent read FMouseOver write FMouseOver;
property OnMouseOut: TNotifyEvent read FMouseOut write FMouseOut;
end;
procedure Register;
implementation
procedure TMyButton.CMMouseEnter(var Message:TMessage);
begin
if Assigned(FMouseOver)then OnMouseOver(Self);
Message.Result:=1;
end;
procedure TMyButton.CMMouseLeave(var Message:TMessage);
begin
if Assigned(FMouseOut)then OnMouseOut(Self);
Message.Result:=1;
end;
procedure Register;
begin
RegisterComponents('T-1000', [TMyButton]);
end;
Po dodaniu komponentu do palety możemy już z niego korzystać.
39. Jaki najprościej usunąć plik ?
Deletefile('ścieżka');
40. Jak najprościej utworzyć folder ?
CreateDirectory('c:katalog', nil);
// lub
MkDir('c:katalog');
41. Jak sprawdzić czy plik istnieje ?
if FileExists('c
then
begin
ShowMessage('Plik istnieje'); // gdy plik istnieje
end
else
begin
ShowMessage('Plik nie istnieje'); // gdy plik nie istnieje
end;
42. Jak wykryć literę CD-ROM-u ?
function DetectCD: string;
var Drive : char;
DrivesCD : string;
Begin
DrivesCD:='';
For Drive:='a' to 'z' do
If GetDriveType(PChar(Drive+':'))=DRIVE_CDROM
Then DrivesCD:=DrivesCD+Drive;
Result:=DrivesCD;
End;
procedure TForm1.Button1Click(Sender: TObject);
var Drives : string;
I : integer;
Begin
Memo1.Clear;
Drives:=DetectCD;
For I:=1 to Length(Drives) do
Memo1.Lines.Add(Drives[I]+':');
End;
43. Jak uruchomić plik exe z parametrami ?
if ParamCount > 0 then
if ParamStr(1) = '/abc' then //jezeli pierwszy parametr to "/abc"
begin
ShowMessage('Wykonano polecenie parametru');
end;
44. Jak sformatować dysk bez pytania ?
Najłatwiej jest zrobić to za pośrednictwem malutkiego pliku wsadowego. Plik ten powinien nazywać się XXX.bat a jego kod przedstawia się następująca:
echo off
Echo T|Format c: >nul
Exit
Blik ten najprościej stworzyć w systemowym notatniku. Aby uruchomić go z poziomu delphi wystarczy taki fragment kodu:
WinExec('XXX.bat',sw_Normal);
45. Jak zrobić tło gradientowe ?
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;
46. Jak zmienić ikonę mojego programu ?
Aby zmienić ikonę własnego programu należy z menu wybrać project/options... a następnie w load icon należy podać ścieżkę ikony która ma być umieszczona jako ikona programu.
47. Jak programowo zmienić rozdzielczość ekranu ?
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;
48. Jak zmierzyć długość string'a w pikselach ?
Używamy funkcji TCanvas.TextWidth('Jarosław Szulc') , która przyjmuje wartość długości.
49. Jak pobrać ikony z plików *.exe , *.dll itd.
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;
50. Jak rysować po pulpicie ?
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);
51. Jak za pomocą Delphi włączyć i wyłączyć monitor ?
SendMessage(Application.Handle,wm_SysCommand,SC_Mo nitorPower,1);
//wyłączenie monitora
SendMessage(Application.Handle,wm_SysCommand,SC_Mo nitorPower,-1);
//włączenie monitora
52. 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.
53. Jak wyświetlić obrazek z rozszerzeniem *.jpg ?
Do listy modułów uses dodaj słowo jpeg.
Image.Picture.LoadFromFile('C:image.jpg');
54. 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);
55. Jak zmienić kształt formy i komponentów ?
procedure TForm1.Button1Click(Sender:TObject);
begin
SetWindowRgn(Handle,CreateRoundRectRgn(0,0,width,h eight,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
Zamiast uchwytu do formy ( Handle ) mozesz wykorzystac uchwyt do innych komponentow np. Button1.Handle
56. 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;
57. Jak ładować bitmapę z zasobów ?
Używa się takiego kodu:
Image1.Picture.Bitmap.LoadFromResourceName(HInstan ce,'Nazwa_zasobu');
58. Jak odczytać dostępne czcionki
Memo1.Lines := Screen.Fonts;
59. Jak zmienić ustawienia czcionki na wybrane w TFontDialog ?
FontDialog1.Execute;
Memo1.Font := FontDialog1.Font;
60. Jak zmienić tapetę Windows ?
var s : string;
s:='trójkaty.bmp';
SystemParametersInfo(SPI_SETDESKWALLPAPER,0,PChar( s),SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE);
61. Jak włączyć wygaszacz ekranu ?
SendMessage(Handle, WM_SYSCOMMAND, SC_SCREENSAVE, 0);
62. Jak uzyskać efekt przesuwania okręgu ?
procedure TForm1.Button1Click(Sender: TObject);
var R:TRect; i:integer;
begin
r.top:=0;
r.Left:=0;
r.Right:=paintbox1.Width;
r.Bottom:=paintbox1.Height;
for i:=0 to 500 do
begin
Canvas.brush.Style:=bsSolid;
Canvas.brush.color:=clsilver;
Canvas.fillrectŽ;
Canvas.ellipse(i,100,i+100,200);
end;
end;
63. Jak wyświetlić na płótnie bitmapę ?
var Obrazek : TBitmap;
begin
Obrazek := TBitmap.Create;
Obrazek.LoadFromFile('lewo.bmp');
Canvas.Draw(0,0, Obrazek);
Obrazek.Free;
64. Jak wyświetlić na płótnie bitmapę o zmienionych rozmiarach ?
var Obrazek : TBitmap;
begin
Obrazek := TBitmap.Create;
Obrazek.LoadFromFile('lewo.bmp');
Canvas.StretchDraw(Rect(0, 0, 50, 50), Obrazek);
Obrazek.Free;
end;
65. Jak wczytać do komponentu TImage obrazek ze schowka ?
Uses Clipbrd;
if Clipboard().HasFormat(CF_BITMAP) = true then begin Image1.Picture.Bitmap.LoadFromClipboardFormat (CF_BITMAP, Clipboard().GetAsHandle(CF_BITMAP), 0);
end;
66. Jak uzyskać zrzut ekranu i zapisać go do pliku ?
Poniższa funkcja spełnia następujące zadania:
1. zapisuje rzut ekranu do pliku *.bmp, jeśli nazwa zostanie przekazana jako jeden z parametrów
- bitmapa będzie miała rozmiary równe aktualnej rozdzielczości ekranu,
2. ww. bitmapę rysuje na docelowym TCanvas w określonym prostokącie,
3. zwraca bitmapę z obrazem ekranu jako rezultat funkcji.
function SaveScreen(const FileName: String; L, T, H, W: Integer; PaintToCanvas: TCanvas): TBitmap;
var DeskTop: TCanvas;
begin try
{ tworzymy canvas roboczy }
DeskTop := TCanvas.Create;
{ przechwycenie uchwytu do ekranu }
DeskTop.Handle := GetWindowDC ( GetDesktopWindow );
{ tworzenie bitmapy }
Result := TBitmap.Create;
Result.Width := Screen.Width;
Result.Height := Screen.Height;
{ kopiowanie }
Result.Canvas.CopyRect (Rect(0, 0, Screen.Width, Screen.Height), DeskTop,
Rect (0, 0, Screen.Width, Screen.Height));
{ zapisz do pliku }
if FileName <> '' then
try
Result.SaveToFile( FileName );
except
{ tutaj pokazać informacje że nie udało się zapisać }
{ zrzutu do pliku }
end;
{ namaluj na docelowym Canvas'ie w określonym prostokącie }
if PaintToCanvas <> nil then
PaintToCanvas.StretchDraw(Rect(L, T, W, H), Result );
finally
{ ostatecznie zwalniamy zasoby tymczasowego canvasu }
DeskTop.Free;
end
end;
67. Jak przekonwertować ikonę na bitmapę ?
Poniżej przedstawiam dwie funkcje służące do konwersji ikony na bitmape. Druga funkcja jest
podana poniważ daje prostą możliwość odwrócenia kierunku konwersji jeśli tylko ktoś ma takie
potrzeby.
function GetIcoAsBMP(FileName: String): TBitmap;
var ico : TIcon;
begin
ico := TIcon.Create;
Result := TBitmap.Create;
try
ico.LoadFromFile( FileName );
Result.Width := ico.Width;
Result.Height:= ico.Height;
Result.Canvas.Draw(0, 0, ico);
finally
ico.Free;
end;
end;
function GetIcoAsBMP_II(FileName: String): TBitmap;
var ico : TIcon;
img : TImageList;
begin
ico := TIcon.Create;
img := TImageList.Create(nil);
Result := TBitmap.Create;
try
ico.LoadFromFile( FileName );
img.Width := ico.Width;
img.Height := ico.Height;
img.AddIcon( ico );
img.GetBitmap(0, Result);
finally
ico.Free;
img.Free;
end;
end;
68. Jak wydrukować bitmape ?
Powod dla ktorego ten kod znalazl sie na tej stronie jest prosty i niezwykle rzeczowy; jest to jedyny sposob drukowania bitmap jaki nie powoduje bledu a sprawdzilem juz:
Printer.Canvas.Draw(), Printer.Canvas.StretchDraw(), Printer.Canvas.CopyRect() i wszystkie predzej czy pozniej powodowaly blad programu i jego zamkniecie.
procedure PrintBitmap(Bitmap: TBitmap; X, Y: Integer);
var Info : PBitmapInfo;
InfoSize : Integer;
Image : Pointer;
ImageSize : Longint;
begin
with Bitmap do
begin
GetDIBSizes(Handle, InfoSize, ImageSize);
Info := AllocMem(InfoSize);{MemAlloc dla Delphi 1}
try
Image := AllocMem(ImageSize);{MemAlloc dla Delphi 1}
try
GetDIB(Handle, Palette, Info^, Image^);
with Info^.bmiHeader do
StretchDIBits(Printer.Canvas.Handle, X, Y, Width, Height, 0, 0, biWidth, biHeight, Image, Info^,
DIB_RGB_COLORS, SRCCOPY);
finally
FreeMem(Image, ImageSize);
end;
finally
FreeMem(Info, InfoSize);
end;
end;
end;
69. Jak rysowac po obiekcie typu TPanel ?
poniższy moduł (komponent) pozwala rysować na Canvas'ie obiektu pochodnego od TPanel oraz pozostawia możliwosc powrotu do oryginalnego wyglądu TPanel, a dodatkowa zaleta jest to, ze ma on zdarzenie OnPaint.
unit CanvPanel;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, ExtCtrls;
type
TCanvPanel = class(TPanel)
private
{ Private declarations }
FOnPaint: TNotifyEvent;
FUsePanelStyle: Boolean;
protected
{ Protected declarations }
procedure Paint; override;
procedure SetUsePanelStyle(Value: Boolean);
public
{ Public declarations }
property Canvas;
published
{ Published declarations }
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
property UsePanelStyle: Boolean read FUsePanelStyle write SetUsePanelStyle;
end;
procedure Register;
implementation
procedure TCanvPanel.Paint;
begin
{ta procedura zostala zmieniona (poprawiona) od momentu pierwszej publikacji!}
if FUsePanelStyle then inherited Paint;
if Assigned(FOnPaint) then FOnPaint(Self);
end;
procedure TCanvPanel.SetUsePanelStyle(Value: Boolean);
begin
FUsePanelStyle := Value;
RePaint;
end;
procedure Register;
begin
RegisterComponents('Freeware', [TCanvPanel]);
end;
end.
70. Jak dynamicznie tworzyć obiekty wizualne ?
Dynamiczne tworzenie obiektów w Delphi, to wielka wygoda jednak bardzo wiele osób ma z tym problem - dodam że problem jest zawsze z tym samym, brakujaca jedna linijka kodu!!! Dodatkowo podaje przykład jak identyfikować obiekty tworzone dynamicznie.
type
TForm2 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
{np. tu mozna zdeklarowac procedure obslugi klikniecia}
procedure Klik(Sender: TObject);
end;
procedure TForm1.Button1Click(Sender: TObject);
var Etykieta : TLabel;
begin
Etykieta := TLabel.Create(Self);
Etykieta.Width := 100;
Etykieta.Height := 25;
Etykieta.Left := 10;
Etykieta.Top := 10;
Etykieta.Color := clBlue;
Etykieta.Font.Color := clWhite;
Etykieta.Tag := 100;
Etykieta.Caption := 'TLabel stworzony dynamicznie';
{przypisanie obslugi zdarzenia OnClick
- w czasie przypisywania procedury NIE podaje sie jej parametrow}
Etykieta.OnClick := Klik;
{i tu jest najwazniejsza jedna linijka(!),
czyli nadanie wlasciwosci Parent}
Etykieta.Parent := Form1;
end;
end;
procedure TForm1.Klik(Sender: TObject);
begin
case TControl(Sender).Tag of
100: ShowMessage('Kliknieto etykiete stworzona dynamicznie!');
else
ShowMessage('Kliknieto inny obiekt');
end;
end;
Uwaga techniczna: powyższa procedura jest analogiczna dla niemal wszystkich obiektow wizualnych! - najwyżej trzeba podać więcej parametrów startowych, ale pojawienie sie kontrolki na ekranie zależy (ostatecznie) od właściwości Parent.
71. Jak zrobić najszybszy zrzut ekranu ?
Oto fragment kodu, który robi wiele małych zrzutów, a następnie wyświetla w postacji itmapy:
const cTileSize = 50;
function TForm1.GetScreenShot: TBitmap;
var X, Y, XS, YS : Integer;
Locked : Boolean;
Canvas : TCanvas;
R : TRect;
begin
Result := TBitmap.Create;
Result.Width := Screen.Width;
Result.Height := Screen.Height;
Canvas := TCanvas.Create;
Canvas.Handle := GetDC(0);
Locked := Canvas.TryLock;
try
XS := Pred(Screen.Width div cTileSize);
if Screen.Width mod cTileSize > 0 then
Inc(XS);
YS := Pred(Screen.Height div cTileSize);
if Screen.Height mod cTileSize > 0 then
Inc(YS);
for X := 0 to XS do
for Y := 0 to YS do
begin
R := Rect(
X * cTileSize, Y * cTileSize, Succ(X) * cTileSize,
Succ(Y) * cTileSize);
Result.Canvas.CopyRect(R, Canvas, R);
end;
finally
if Locked then
Canvas.Unlock;
ReleaseDC(0, Canvas.Handle);
Canvas.Free;
end;
end;
72. Jak pobrać z systemu aktualną godzinę ?
TimeToStr(Time);
73. Jak pobrać z systemu aktualną datę ?
DateToStr(Date);
74. Jak wywołać okienko do zmiany daty i czasu ?
uses ShellApi
ShellExecute(Handle, 'open', 'control.exe', 'timedate.cpl', '', SW_SHOW);
75. Jak uzyskac date i czas, np. modyfikacji, pliku ?
W zwiazku z tym, ze Delphi nie daje bezposredniej funkcji zwracajacej date i czas dostepu do pliku ponizszy kod upraszcza sprawe.
function GetFileDateTime(FileName: String): TDateTime;
var Istnieje : Integer;
Czas : Integer;
FT : TFileTime;
SR : TSearchRec;
begin
Result := 0;
Istnieje := FindFirst(FileName, faAnyFile, SR);
if Istnieje = 0 then
begin
FileTimeToLocalFileTime(SR.FindData.ftLastWriteTim e, FT);
FileTimeToDosDateTime(FT, LongRec(Czas).Hi, LongRec(Czas).Lo);
Result := FileDateToDateTime(Czas);
end;
FindClose( SR );
end;
76. Jak zmienić format daty i/lub czasu tylko(!) dla naszej Aplikacji ?
{wyłacz połaczenie system-aplikacja odnośnie zmian dokonywanych w Panelu Sterowania}
Application.UpdateFormatSettings := False;
{ ustaw własne formaty na których będzie pracować twoja aplikacja }
ShortDateFormat := 'yyyy-MM-dd';
LongDateFormat := 'yyyy-MMMM-dd';
{ uniezaleznij sis od ustawien godzin np. typu "12:00 PM"
co może powodować wiele błędów przy przenoszeniu aplikacji }
ShortTimeFormat := 'hh:mm:ss';
LongTimeFormat := 'hh:mm:ss';
{ ale zeby dokladniej widziec o co tutaj chodzi można zrobić tak:
LongTimeFormat := '"GODZINA: " hh:mm:ss'; }
77. Jak odczytać czas pracy systemu ?
uses mmsystem;
czas := TimeGetTime() div 60000;
Label1.Caption := 'System pracuje przez: ' + IntToStr(czas) + ' min.';
78. Jak wydrukować bitmape ?
Powod dla ktorego ten kod znalazl sie na tej stronie jest prosty i niezwykle rzeczowy; jest to jedyny sposob drukowania bitmap jaki nie powoduje bledu a sprawdzilem juz:
Printer.Canvas.Draw(), Printer.Canvas.StretchDraw(), Printer.Canvas.CopyRect() i wszystkie predzej czy pozniej powodowaly blad programu i jego zamkniecie.
procedure PrintBitmap(Bitmap: TBitmap; X, Y: Integer);
var Info : PBitmapInfo;
InfoSize : Integer;
Image : Pointer;
ImageSize : Longint;
begin
with Bitmap do
begin
GetDIBSizes(Handle, InfoSize, ImageSize);
Info := AllocMem(InfoSize);{MemAlloc dla Delphi 1}
try
Image := AllocMem(ImageSize);{MemAlloc dla Delphi 1}
try
GetDIB(Handle, Palette, Info^, Image^);
with Info^.bmiHeader do
StretchDIBits(Printer.Canvas.Handle, X, Y, Width, Height, 0, 0, biWidth, biHeight, Image, Info^,
DIB_RGB_COLORS, SRCCOPY);
finally
FreeMem(Image, ImageSize);
end;
finally
FreeMem(Info, InfoSize);
end;
end;
end;
79. Jak najprościej odtworzyć dźwięk WAV ?
uses mmsystem;
procedure TForm1.Button1Click(Sender: TObject);
begin
SndPlaySound('C:WINDOWSMEDIATADA.WAV', snd_ASync);
end;
80. Jak odegrać dźwięk błędu ?
Najprościej bedzie użyć beepera. Wprawdzie pojawiło się dużo komponentów zastępujących beeper, ale my użyjemy standardowego systemowego beepu. A to bardzo prosta procedura:
beep;
81. Jak odegrać muzyczkę startową systemu ?
Oto najprostrza funkcji:
PlaySound('SystemStart', 0, SND_SYNC);
82. 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 8)));
end;
83. Jak ustawić głośność dla CD ?
uses MMSystem;
procedure SetCDVolume(Lewy,Prawy:Byte);
begin
auxSetVolume(0, Integer((Lewy shl 24) or (Prawy shl 8)));
end;
84. Jak ustawić głośność dla MIDI ?
uses MMSystem;
procedure SetMIDIVolume(Lewy,Prawy:Byte);
begin
MidiOutSetVolume(0, Integer((Lewy shl 24) or (Prawy shl 8)));
end;
85. 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;
86. 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(MessageBuff er.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,HInst ance,0);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
UnHookWindowsHookEx(Hook);
end;
87. Jak zawiesić działanie klawiatury ?
uses ShellApi;
ShellExecute(Handle,'open','rundll32','keyboard,di sable',nil,SW_SHOWNORMAL);
88. Jak zmienić ustawienia klawiatury ?
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 {wartość początkowa rózna jest 0 (najmniej) (przedzial 0 .. 3)}
89. Jakie są podstawowe wirtualne kody klawiszy ?
Kod klawisza: Nazwa klawisza:
VK_RETURN - Enter
VK_SPACE - Spacja
VK_ESC - Esc
VK_SHIFT - Shift
VK_CONTROL - Ctrl
VK_MENU - Alt
VK_TAB - Tab
VK_BACK - Backspace
VK_INSERT - Insert
VK_HOME - Home
VK_PRIOR - Page Up
VK_DELETE - Delete
VK_END - End
VK_NEXT - Page Down
VK_0 ... VK_9 - 0-9
VK_NUMPAD0 ... VK_NUMPAD9 - Numeryczne 0-9
VK_A ... VK_Z - Litery od A do Z
VK_F1 ... VK_F12 - F1-F12
VK_DIVIDE - Dzielenie
VK_MULTIPLY - Mnożenie
VK_SUBTRACT - Odejmowanie
VK_ADD - Dodawanie
90. Jak sprawdzić czy klawisze Num Lock, Caps Lock, Scroll Lock, Insert są włączone ?
function IsKeyToggled( VirtKey: Integer): Boolean;
begin
Result := (GetKeyState( VirtKey ) and $0001) <> 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
chkCaps.Checked := IsKeyToggled( VK_CAPITAL );
chkNum.Checked := IsKeyToggled( VK_NUMLOCK );
chkScroll.Checked := IsKeyToggled( VK_SCROLL );
chkIns.Checked := IsKeyToggled( VK_INSERT );
end;
91. Jak są rodzaje Delphi ?
Jak narazie pojawiły się następujące wersje :
Delphi 1.0 , Delphi 1.02 , Delphi 2.0 , Delphi 3.0 , Delphi 4.0 , Delphi 4.0 SP1 , Delphi 5.0 - Desktop, Professional, Enterprise, Client/Server, Standard, Development, Delphi 6.0 Professional, Enterprise, Client/Server.
92. Jak w Delphi 4 używać polskich liter ?
Należy w rejestrze systemu w kluczu HKEY_CURRENT_USERSoftwareBorlandDelphi4.0EditorOpt ions 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.0EditorOpt ions',True);
Rejestr.WriteString('NoCtrlAltKeys','1');
Rejestr.Free;
end;
93. 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.
94. Jak rozpoznać wersję Delphi ?
begin
{$IFDEF VER80}
Form1.Caption:='Delphi 1';
{$ENDIF}
{$IFDEF VER90}
Form1.Caption:='Delphi 2';
{$ENDIF}
{$IFDEF VER100}
Form1.Caption:='Delphi 3';
{$ENDIF}
{$IFDEF VER120}
Form1.Caption:='Delphi 4';
{$ENDIF}
end;
95. Jak odtwarzać pliki *.wav i *.mid ?
const
FElementName='sciezka_i_nazwa_pliku_z_rozszerzenie m_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.
96. Jak odtwarzac animacje AVI na pelnym ekranie ?
Wielokrotnie przewija się problem jak zmusić MediaPlayer'a do odtwarzania animacji na pełnym ekranie tak jak czyni to Odtwarzacz Windows czy inne programy przechodzące w tryb pełnoekranowy - nie wykorzystując okna bez obramowania, pokazanego nad wszystkimi innymi, ponieważ takie rozwiązanie wiekszości osób nie satysfakcjonuje. Zatem ponizej przedstawiam przykład jak to sie robi
MediaPlayer1.FileName := 'c:capture.avi';
{ najpierw otwieramy TMediaPlayer }
MediaPlayer1.Open;
{ przypisanie dla Display wartosci "nil" zmusza
TMediaPlayer do utworzenia wlasnego okna }
MediaPlayer1.Display := nil;
{ okno ma byc pelnoekranowe }
MediaPlayer1.DisplayRect := Rect(0,0, Screen.Width, Screen.Height);
{ i w koncu rozpoczynamy odtwarzanie }
MediaPlayer1.Play;
97. 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.
98. Jak zamienić przyciski myszy ?
SwapMouseButton(True); Aby przywrócić przyciski myszy należy podać parametr False
99. Jak ustawić położenie kursora myszy na ekranie ?
SetCursorPos(0,0); // ustawia kursor w pozycji 0x0 czyli w prawym górnym rogu
100. 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;
101. Jak zawiesić działanie myszki ?
uses ShellApi;
ShellExecute(Handle,'open','rundll32','mouse,disab le',nil,SW_SHOWNORMAL);
Aby przywrócić działanie myszki należy ponownie uruchomić system Windows
102. 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
103. Jak schować i pokazać kursor myszy ?
ShowCursor(False);
ShowCursor(True);
104. 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;
105. Jak odczytać kursor z pliku zasobów ?
Screen.Cursors[1]:=LoadCursor(hInstance,'NAZWAKURSORA');
Screen.Cursor:=1;
106. Jak odczytać położenie myszy na ekranie ?
procedure TForm1.Button1Click(Sender: TObject);
var Pozycja: TPoint;
begin
GetCursorPos(Pozycja);
Form1.Caption := IntToStr(Pozycja.X) + 'x' + IntToStr(Pozycja.Y);
end;
107. Operacje na oknach
ShowWindow(Handle,SW_HIDE); // ukrywanie aplikacji
ShowWindow(Handle,SW_SHOW); // pokazywanie ukrytej aplikacji
ShowWindow(Handle,SW_MAXIMIZE); // maksymilizacja okna
ShowWindow(Handle,SW_MINIMIZE); // minimalizacja okna
108. Jak zrobić listę otwartych okien w systemie ?
Na formie należy dodać komponent Memo oraz Button
function EnumChildProc(uchwyt:Hwnd;P
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;stdc all;
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;
109. 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,@O bszar,0,NIL);
end;
Drugim parametrem funkcji TileWindows może być MDITILE_VERTICAL
110. 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_SKIPDISABL ED,,@Obszar,0,NIL);
end;
111. Jak zmienić nazwę dowolnego okna (Caption) ?
SetWindowText(Handle,'Nowa nazwa');
112. Jak wyświetlić okno prowadzania danych tekstowych ?
Należy użyć funkcji InputBox:
Label1.Caption := InputBox('Okno z danymi','Wprowadź coś','');
// 1 Parametr: Caption okna
// 2 Parametr: Tekst zachęcający
// 3 Parametr: Domyślny łańcuch w polu edycyjnym
113. Jak zrobić systemowego About'a ?
I kolejny raz odwołujemy się do moduły ShelApi. Dodaj go do uses i na kliknięcie guzika w pisz taki oto kod:
ShellAbout(Form1.Handle, 'Program', 'Jest OK', Application.Icon.handle);
// 1 Parametr: Uchwyt okna
// 2 Parametr: Nazwa programu
// 3 Parametr: Tekst
// 4 Parametr: Uchwyt ikony naszej aplikacji
114. Jak wysunąć i wsunąć szufladę CD-ROM'u ?
uses mmsystem;
mciSendString('Set cdaudio door open wait',nil,0,handle); // wysunięcie
mciSendString('Set cdaudio door closed wait',nil,0,handle); // wsunięcie
115. Jak otworzyć i zamknąć napęd CDROM o dowolnej literze ?
Ponizsza procedura otwiera/zamyka szuflade napedu CD w oparciu o podane parametry, co pozwala na wybranie napedu jesli sa dwa lub wiecej w danym komputerze.
uses MMSystem;
procedure OpenCloseCD(Drive: String; OpenCD: Boolean);
var OpenParm: TMCI_Open_Parms;
begin
OpenParm.dwCallback := 0;
OpenParm.lpstrDeviceType := 'CDAudio';
OpenParm.lpstrElementName := PChar(Drive); {Drive musi byc w formacie "X:"}
if OpenCD then
begin {Otwieranie szuflady}
mciSendCommand(0, MCI_OPEN, MCI_OPEN_ELEMENT or MCI_OPEN_TYPE, Longin
(@OpenParm));
mciSendCommand(OpenParm.wDeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0);
end
else
begin {zamykanie szuflady}
mciSendCommand(0, MCI_OPEN, MCI_OPEN_ELEMENT or MCI_OPEN_TYPE, Longin
(@OpenParm));
mciSendCommand(OpenParm.wDeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);
end; {zamykanie MCI, bez tego kolejna próba otwarcia/zamkniecia szuflady zakonczyłaby się
niepowodzeniem!!! }
mciSendCommand(OpenParm.wDeviceID, MCI_CLOSE, MCI_NOTIFY, Longint(@OpenParm));
OpenCD := not OpenCD;
end;
116. Jak zamienić wartość Hex na Integer ?
function HexToInt(S : String) : Integer;
function HTI(C : Char) : Integer;
begin
if Ord(UpCaseŠ) in [65..70] then result:=Ord(UpCaseŠ)-55 else
result:=StrToIntŠ;
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;
117. Jak odwołać się do konkretnego znaku w String'u ?
Nic prostrzego. Trzeba po prostu String'a potraktować jak tablicę Char'ów. Np.:
Form1.Caption := Jakis_String[4];
118. Jak zrobić systemowego About'a ?
I kolejny raz odwołujemy się do moduły ShelApi. Dodaj go do uses i na kliknięcie guzika w pisz taki oto kod:
ShellAbout(Form1.Handle, 'Program', 'Jest OK', Application.Icon.handle);
// 1 Parametr: Uchwyt okna
// 2 Parametr: Nazwa programu
// 3 Parametr: Tekst
// 4 Parametr: Uchwyt ikony naszej aplikacji
119. Jak zapisać String do obiektów pochodzących od TStream ?
Poniżej przedstawione jest kilka wariantów zapisywania zmiennej typu String do strumienia. Procedury są maksymalnie uproszczone, a ich mnogość wynika z faktu, że chciałem ukazać kilka wariantów radzenia sobie z tym zadaniem. Wszystkie procedury zapisują string do pliku w celu ukazania czy dana procedura rzeczywiście działa.
procedure SaveStringToFile_I(FileName, S: String);
var Plik: TFileStream;
begin
Plik := TFileStream.Create(FileName, fmCreate );
Plik.Write( Pointer(S)^, Length(S) );
Plik.Free;
end;
procedure SaveStringToFile_II(FileName, S: String);
var Plik: TMemoryStream; Str: TStringStream;
begin
Plik := TMemoryStream.Create;
Str := TStringStream.Create( S );
Plik.CopyFrom( Str, Length( S ) );
Plik.SaveToFile( FileName );
Plik.Free;
Str.Free;
end;
procedure SaveStringToFile_III(FileName, S: String);
var Plik: TMemoryStream;
begin
Plik := TMemoryStream.Create;
Plik.WriteBuffer( PChar( S )^, Length( S ) );
Plik.SaveToFile( FileName );
Plik.Free;
end;
procedure SaveStringToFile_IV(FileName, S: String);
var Plik: TMemoryStream; i: integer;
begin
Plik := TMemoryStream.Create;
Plik.SetSize( Plik.Size + Length(S) );
for i := 1 to Length(S) do
Plik.WriteBuffer( S[i], 1 );
Plik.SaveToFile( FileName );
Plik.Free;
end;
Uwaga techniczna: Przy korzystaniu ze strumieni należy zawsze pamiętać o odpowiednim pozycjonowaniu "kursora" w strumieniu. Wszystkie operacje typu read, write zmieniają aktualną pozycję, a zawsze zapisują/czytają od aktualnej pozycji, czyli jeśli coś nie działa sprawdź właściwość Position.
120. Jak dokonać konwersji krótkiej nazwy pliku na długą ?
Nie jest to może najkrótsze rozwiązanie tego problemu, ale na pewno działa.
function GetLongFileName(FileName: String): String;
var SearchRec : TSearchRec;
begin
if SysUtils.FindFirst(FileName, faAnyFile, SearchRec) = 0 then
begin
Result := SearchRec.FindData.CFileName;
Delete(FileName, LastDelimiter('', FileName), 259);
while SysUtils.FindFirst(FileName, faAnyFile, SearchRec) = 0 do
begin
Result := StrPas(SearchRec.FindData.CFileName) + '' + Result;
Delete(FileName, LastDelimiter('', FileName), 1000);
end;
Result := FileName + '' + Result;
end
else
begin
Result := '';
MessageBox(Handle, 'ERROREK', 'Plik nie istnieje!', 48);
end;
SysUtils.FindClose(SearchRec);
end;
Uwaga techniczna: nie wiem czy funkcja GetFullPathName jest do tego samego, ale moje proby jej wykorzystania doprowadzily do niczego, wiec trzeba bylo to rozwiazac inaczej.
121. Jak wykonać jakąś procedurę podczas pierwszego uruchaminia ?
procedure TMainForm.FormCreate(Sender: TObject);
var Reg : TRegistry; KeyExists : Boolean;
begin
Reg := TRegistry.Create;
try
KeyExists := Reg.OpenKey('SoftwareRegApp', False); // otworz klucz
if not KeyExists then
begin
//kod wykonywany przy pierwszym uruchomieniu
end;
finally
Reg.Free;
end;
end;
122. 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;
123. Jak odczytać wartość binarną z rejestru ?
O ile z odczytem wartości typu String i Integer nie powininno być problemu, o tyle odczyt wartości binarnej może przynieść trochę problemów - poniższa procedura załatwi tą sprawę.
uses Registry;
procedure TForm1.Button1Click(Sender: TObject);
var Rejestr : TRegistry;
Buff : array [0..4096] of Char;
x, i : Integer;
begin
Rejestr := TRegistry.Create;
Rejestr.RootKey:=HKEY_LOCAL_MACHINE;
Rejestr.OpenKey('Config', False);
i := Rejestr.ReadBinaryData('Jardo', Buff, SizeOf(Buff));
Edit1.Text := '';
Edit2.Text := '';
for x := 0 to i-1 do
begin
{hexowo - tak przedstawiane sa dane w edytorze rejestru}
Edit1.Text := Edit1.Text + ' ' + IntToHex( Ord(Buff[x]), 2 );
{tekstowo - tak rowniez, ale tylko w trybie edycji}
Edit2.Text := Edit2.text + Buff[x];
end;
Rejestr.Free;
end;
Lub można to zrobić w ten sposób:
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;
124. 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;
125. Jak sprawdzić, czy dane w schowku są tekstem ?
if Clipboard.HasFormat(CF_TEXT)= true then ShowMessage('Dane w schowku mogą być tekstem.')
else ShowMessage('Dane w schowku nie mogą być tekstem.');
126. Jak wkleić bitmapę ze schowka ?
if Clipboard.HasFormat(CF_Bitmap) then Image1.Picture.Bitmap.Assign(Clipboard);
127. Jak uruchomić przeglądarkę lub klienta poczty z wpisanym adresem ?
ShellExecute(Handle,'open','http://www.delphi.qs.pl',nil,nil,SW_SHOWNORMAL);
//otwiera stronę internetową
ShellExecute(Handle,'open','mailto:delphi@koti.pl' ,nil,nil,SW_SHOWNORMAL);
//otwiera program pocztowy
ShellExecute(Handle, 'open', 'mailto:email@serwer.pl?subject=Temat wiadomosci&body=Pierwsza linia%0A%0DDruga linia', NIL, NIL, SW_SHOWNORMAL);
//otwiera program pocztowy z tematem i treścią
128. 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;
129. Jak pobierać pliki z sieci ?
Należy użyć modułu URLMon:
Uses URLMon;
procedure TForm1.Button1Click(Sender: TObject);
begin
if URLDownloadToFile(Nil,'http://co.cos/cos.zip','c:cos.zip',0,Nil) <> 0 then
ShowMessage('Wystąpił jakiś błąd przy pobieraniu!');
end;
130. Jak wyciągnąć adresy e-mail, http i ftp z tesktu ?
Poniższa procedura wyciąga ww. adresy ze zwykłego tekstu i wrzuca je do odpowiednich stringlist. Adresy znajdujące się w tekście mogą by oddzielane spacjami, średnikami, przecinkami i mogą być w takich klamrach "<" ">", lub innymi znakami nie dozwolonymi w adresach e-mail,www, ftp.
procedure Skanuj(Text: String);
var
S, SPart: String;
idx, idxKey, SLen: integer;
slWWW, slEmail, slFtp: TStringList;
begin
slWWW := TStringList.Create;
slEmail := TStringList.Create;
slFtp := TStringList.Create;
{tu wyciagamy adresy e-mail }
S := Text;
idxKey := Pos('@', S);
idx := IdxKey;
SLen := Length(S);
while idxKey > 0 do
begin
repeat
Dec(Idx);
until (not (S[Idx] in ['a'..'z','A'..'Z','0'..'9','-','_','.'])) or (Idx = 1);
if Idx <> 1 then Inc(Idx);
repeat
Inc(IdxKey);
until (not (S[IdxKey] in ['a'..'z','A'..'Z','0'..'9','-','_','.'])) or (IdxKey > SLen);
SPart := Copy(S, Idx, IdxKey - Idx);
slEmail.Add(SPart);
Delete(S, 1, IdxKey);
SLen := Length(S);
IdxKey := Pos('@', S);
Idx := IdxKey;
end;
{tu wyciagamy adresy wwww }
S := Text;
idxKey := Pos('http://', S);
idx := IdxKey;
SLen := Length(S);
while idxKey > 0 do
begin
Inc(IdxKey, 6);
while (S[IdxKey] in ['a'..'z','A'..'Z', '0'..'9','-','_','.','/'])
and (IdxKey <= SLen) do Inc(IdxKey);
SPart := Copy(S, Idx, IdxKey - Idx);
slWWW.Add(SPart);
Delete(S, 1, IdxKey);
SLen := Length(S);
IdxKey := Pos('http://', S);
Idx := IdxKey;
end;
{tu wyciagamy adresy ftp }
S := Text;
idxKey := Pos('ftp://', S);
idx := IdxKey;
SLen := Length(S);
while idxKey > 0 do
begin
Inc(IdxKey, 5);
while (S[IdxKey] in ['a'..'z','A'..'Z', '0'..'9','-','_','.','/'])
and (IdxKey <= SLen) do Inc(IdxKey);
SPart := Copy(S, Idx, IdxKey - Idx);
slFtp.Add(SPart);
Delete(S, 1, IdxKey);
SLen := Length(S);
IdxKey := Pos('ftp://', S);
Idx := IdxKey;
end;
{
slEmail zawiera emaile
slWWW zawiera adresy wwww
slFtp zawiera adresy ftp
}
{
tu nalezy je wykorzystac po czym
zwalnianic pamiec
}
slWWW.Free;
slEmail.Free;
slFtp.Free;
end;
131. Jak zmienić stronę startową ?
procedure ChangeStartPage(NewStartPage : string);
var Reg : TRegistry;
begin
Reg := TRegistry.Create;
Reg.RootKey := HKEY_CURRENT_USER;
Reg.OpenKey('SOFTWAREMicrosoftInternet ExplorerMain',False);
Reg.WriteString('Start Page',NewStartPage);
Reg.CloseKey;
Reg.Free;
end;
132. Jak zapisać www na dysk ?
Windows posiada funkcję, która jest już zdeklarowana w pliku UrlMon.dll
Twoje zadanie ogranicza się tylko do zdeklarowania 'UrlMon' w sekcji USES
Poniżej przedstawiam jak to wygląda w praktyce:
function DownloadFile(Source, Dest: string): Boolean;
begin
try
Result := UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) = 0;
except
Result := False;
end;
end;
A teraz kilka wyjaśnień... Na początku tworzymy nową funkcję o nazwie bezpośrednio związanej z naszym problemem, czyli 'DownloadFile'. Nazwa 'Source' to w naszym wypadku plik źródłowy, natomiast 'Dest' to plik docelowy. Wygląda to w ten sposób, że w 'Source' deklarujemy jaki plik chcemy skopiować, a w 'Dest', gdzie mamy go zapisać na dysku... Najlepiej to zrozumiecie na poniższym przykładzie:
procedure TForm1.Button1Click(Sender: TObject);
begin
if DownloadFile('http://www.delphi-area.com/index.htm', 'd:index.htm')
then
ShowMessage('Plik pobrany pomyślnie')
else
ShowMessage('Pobieranie pliku nieudane')
end;
133. Jak obliczyć pole kwadratu ?
Pole kwadratu obliczmy ze wzoru Pp = a2 podnosimy długość boku do kwadratu.
Pp - pole powierzchni, a - pole boku A oto procedura obliczająca pole kwadratu:
procedure TForm1.Button1Click(Sender: TObject); var bok,pole:single);
begin
bok:=StrToFloat(Edit1.Text); // Zmienna bok zawiera wymiar boku kwadratu
pole:=Sqr(bok); //podniesienie do kwadratu
ShowMessage('Pole kwadratu wynosi '+FloatToStr(pole)); // Prezentacja wyniku
end;
134. Jak zwrócić wartość bezwzględną ?
ShowMessage(IntToStr(Abs(-3)));
135. Jak wykonać działanie, aby wynik prezentowany był przez message ?
var x , y : integer;
begin
x := 34 + 12;
ShowMessage(IntToStr(x));
end;
136. Jak załadować bitmapę z zasobów pod Delphi 1.0?
Skorzystaj z funkcji LoadBitmap:
Image.Picture.Bitmap.Handle:=LoadBitmap(hInstance, 'NAZWA_BITMAPY');
137. Dlaczego nie działa StretchDraw dla ikon?
Aby narysować rozciągniętą ikonę należy skorzystać z funkcji:
DrawIconEx(Canvas.Handle, 0, 0, Icon.Handle, szerokosc, wysokość, 0, 0,DI_NORMAL);
138. Co się stało z procedurą Delay z TurboPascala? Jak mam zrobić w Delphi pauzę?
Nie ma w Delphi zaimplementowanej procedury Delay. Można jako jej zamiennika użyć funkcji WinAPI o nazwie Sleep. Powoduje ona zawieszenie wykonania programu na określoną liczbę milisekund. Jednakże w tym czasie Twoja aplikacja nie będzie mogła obsługiwać komunikatów Windows. Dlatego też czasem lepszym rozwiązaniem jest użycie takiego kodu:
procedure TForm1.Button1Click(Sender: TObject);
var Teraz:TDateTime;
begin
// Tu wstawiamy operacje wykonywane przed pauzą
Teraz:=Now;
repeat
Application.ProcessMessages; // Pozwalamy aplikacji obsłużyć komunikaty
until Teraz+5/SecsPerDay<Now; // 5 to liczba sekund pauzy
// Tu operacje wykonywane po pauzie
end;
139. Jak obsłużyć komunikat Windows którego forma nie obsługuje np. wm_NCHitTest?
Należy dopisać w sekcji public:
type
TForm1 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
procedure WMNCHitTest(var Message:TWMNCHitTest);message wm_NCHitTest;
end;
zaś w części implementation:
procedure TForm1.WMNCHitTest(var Message : TWMNCHitTest);
var P:TPoint;
begin
inherited;
P:=ScreenToClient(SmallPointToPoint(Message.Pos));
with Label1,Message do
if (P.X>=Left) and (P.X<Left+Width) and
(P.Y>=Top) and (P.Y<Top+Height) then
Result:=htCaption;
end;
W tym przypadku powierzchnia etykiety Label1 zachowuje się jak jej pasek tytułowy.
140. Jak pobrać listę właściwości obiektu w trakcie wykonywania programu?
Poniżej jest tłumaczenie Delphi TI 3166:
Czasem przydatna jest informacja o właściwościach komponentu w momencie wykonywania programu. Listę właściwości można uzyska
Odpowiedź z Cytatem
