| nowości | o mnie | fotorelacje | top 40 | filmy | downloads | rumszas | cykloza | delphi | odsyłacze | kontakt |
|
A: Funkcje matematyczne
A1 Zamiana radianów na stopnie >> A2 Zamiana stopni na radiany >> A3 Podniesienie liczby x do potęgi y >> A4 Wartość losowa rozkładu normalnego Gaussa >> A5 Logarytm o podstawie n z liczby x >> A6 Funkcja arctg >> A7 Funkcja arcctg >> A8 Deklaracja i zapis liczb zespolonych typu TZesp >> A9 Konwersja liczby zespolonej do postaci kanonicznej >> A10 Dodawanie liczb zespolonych >> A11 Odejmowanie liczb zespolonych >> A12 Mnożenie liczb zespolonych >> A13 Dzielenie liczb zespolonych >> A14 Pierwiastek z liczby zespolonej >> A15 Sprawdzenie czy liczba x jest parzysta >> A16 Sprawdzenie czy liczba x jest podzielna przez y >> A17 Największy wspólny dzielnik dla dwóch lub więcej liczb naturalnych >> A18 Najmniejsza wspólna wielokrotność dwóch lub więcej liczb naturalnych >> A19 Konwersja liczby typu Cardinal do Integer >> B: Operacje na ciągach znakowych typu String
B1 Sprawdzenie czy ciąg znaków s typu String jest liczbą >> B2 Odczytanie ścieżki dostepowej z ciągu znaków typu C:\sciezka\nazwa.roz >> B3 Odczytanie nazwy pliku z ciągu znaków typu C:\sciezka\nazwa.roz >> B4 Odczytanie rozszerzenia pliku z ciągu znaków typu C:\sciezka\nazwa.roz >> B5 Odczytanie nazwy pliku z pominięciem rozszerzenia z ciągu znaków typu C:\sciezka\nazwa.roz >> B6 Zamiana w zmiennej s typu String wszystkich ciągów s1 na s2 >> B7 Alfabetyczne sortowanie tablicy ciągów znakowych typu String >> B8 Sprawdzenie czy drugi znak ciągu s typu String jest cyfrą >> B9 Sprawdzenie pierwszej pozycji ciągu znaków s1 w innym ciągu znaków s2 >> B10 Sprawdzenie czy zmienna s1 typu String zawiera ciąg znaków s2 >> B11 Konwersja liczby rzeczywistej x na ciąg znaków s typu string z automatycznym zaokrągleniem >> B12 Sprawdzenie ostatniej pozycji dowolnego ze znaków a, b lub c ciągu znaków s >> B13 Sprawdzenie czy ciąg znaków s pasuje do maski typu Mic?oso?t Win*s >> B14 Zamiana ciągu znaków s typu String na małe lub na duże litery >> B15 Formatowanie liczby całkowitej do stałej ilości cyfr >> B16 Odczytanie zawartości wskazanej kolumny wiersza z wyborem znaku separatora kolumn >> B17 Sprawdzenie ilości kolumn w wierszu z wyborem znaku separatora kolumn >> C: Operacje na plikach
C1 Wypisanie w komponencie ListBox wszystkich plików typu *.* z folderu C:\sciezka\folder >> C2 Liczenie plików typu *.* w folderze C:\sciezka\folder >> C3 Kasowanie pliku C:\sciezka\nazwa.roz >> C4 Przeniesienie pliku C:\sciezka\nazwa.roz do kosza >> C5 Odczytanie ścieżki oraz nazwy pliku exe uruchomionego programu >> C6 Otwarcie pliku C:\sciezka\nazwa.roz >> C7 Zapisanie zawartości komponentu Memo do pliku C:\sciezka\nazwa.roz >> C8 Wczytanie zawartości pliku C:\sciezka\nazwa.roz do komponentu Memo >> C9 Sprawdzenie rozmiaru pliku C:\sciezka\nazwa.roz w bajtach >> C10 Sprawdzenie czy plik C:\sciezka\nazwa.roz istnieje >> C11 Sprawdzenie czy folder C:\sciezka\folder istnieje >> C12 Zmiana nazwy pliku z C:\sciezka1\nazwa1.roz1 na C:\sciezka2\nazwa2.roz2 >> C13 Kopiowanie pliku z C:\sciezka1\nazwa1.roz1 do C:\sciezka2\nazwa2.roz2 >> C14 Zapisanie rekordu do pliku C:\sciezka\nazwa.roz >> C15 Wczytanie rekordu z pliku C:\sciezka\nazwa.roz >> C16 Tworzenie nowego folderu C:\sciezka\folder >> C17 Kasowanie pustego folderu C:\sciezka\folder >> C18 Kasowanie folderu C:\sciezka\folder w którym mogą znajdować się pliki lub podfoldery >> C19 Wczytanie do komponentu ListBox nazw plików i folderów po przeniesieniu ich na formę programu >> C20 Dodanie pliku C:\sciezka\nazwa.roz do autostartu rejestrowego >> C21 Wczytanie do komponentu ListBox nazw plików znajdujących się w folderze C:\sciezka\folder i w jego podfolderach >> C22 Nadanie plikowi C:\sciezka\plik.roz atrybutu ukryty >> C23 Nadanie plikowi C:\sciezka\plik.roz atrybutu tylko do odczytu >> C24 Zmiana daty utworzenia i ostatniej modyfikacji pliku C:\sciezka\plik.roz >> C25 Odczytanie daty utworzenia, modyfikacji i ostatniego dostępu do pliku C:\sciezka\plik.roz >> C26 Zapisanie ustawień programu do pliku >> C27 Wczytanie ustawień programu z pliku >> C28 Zasoby typu TResourceStream >> C29 Obsługa pliku metodą "Otwórz za pomocą..." ze wskazaniem na program stworzony w Delphi >> C30 Kopiowanie folderu wraz z zawartością >> D: Działania związane z myszą i klawiaturą
D1 Kliknięcie lewym przyciskiem myszy w punkcie x od lewej i y od góry na ekranie >> D2 Przesunięcie kursora o x w poziomie oraz y w pionie >> D3 Wciśnięcie dowolnego klawisza klawiatury z poziomu programu >> D4 Wpisanie ciągu znaków s typu String w miejsce ustawienia kursora tekstowego >> D5 Blokada myszy oraz blokada klawiatury >> D6 Zamiana przycisków myszy >> D7 Reakcja po wciśnięciu określonego klawisza lub kombinacji klawiszy na klawiaturze >> D8 Nadpisanie instrukcji wykonywanej przez system po wciśnięciu określonego klawisza na klawiaturze >> D9 Blokada klawisza PrintScreen >> D10 Ukrycie kursora myszy >> D11 Ograniczenie pola w którym może poruszać się kursor myszy >> E: Internet i powiązania sieciowe
E1 Zapisanie na dysku pliku z Internetu >> E2 Zapisanie na dysku pliku z Internetu z paskiem postępu pobierania i obsługą błędów >> E3 Wczytanie do komponentu Memo kodu źródłowego strony internetowej >> E4 Odczytanie adesu URL aktywnego okna przeglądarki >> E5 Otwarcie strony internetowej >> E6 Określenie adresu IP komputera >> E7 Wypisanie w komponencie Memo adesów Url ze wszystkich otwartych okien przeglądarki >> E8 Sprawdzanie czy komputer jest połączony z Internetem >> F: Operacje związane z ekranem, pulpitem i wyglądem formy programu
F1 Ukrycie belki na pasku zadań >> F2 Ukrycie formy programu >> F3 Ukrycie wybranych przycisków z prawego górnego rogu formy >> F4 Blokada rozciągania formy >> F5 Ukrycie ikon z pulpitu >> F6 Zmiana rozdzielczości ekranu >> F7 Sprawdzenie czy kolor piksela na ekranie oddalonego o x od lewej oraz y od góry jest czerwony >> F8 Przezroczysta forma programu >> F9 Włączenie trybu zawsze na wierzchu dla formy programu >> F10 Ukrycie paska tytułowego formy >> F11 Miganie belki programu na pasku zadań >> F12 Odświeżenie wyglądu formy programu >> G: Pozostałe
G1 Automatyczne zamkniecie programu jeżeli jest już uruchomiona jego kopia >> G2 Bezwarunkowe zamknięcie programu >> G3 Wypisanie w komponencie ListBox tytułów, typów oraz uchwytów wszystkich otwartych okien >> G4 Zamknięcie programu z wyświetleniem komunikatu o błędzie krytycznym >> G5 Określenie aktualnej daty >> G6 Zmiana wymiarów obrazu tak aby miał te same proporcje co oryginał ale nie przekroczył wskazanych wymiarów >> G7 Wyświetlenie obrazu typu jpeg >> G8 Ukrycie wszstkich przycisków typu Button >> G9 Pojedyncze odtworzenie dźwięku >> G10 Przeniesienie kursora do pola [i,j] komponentu StringGrid >> G11 Okno wyboru tak lub nie w języku polskim >> G12 Zamknięcie okna dowolnego programu o tytule t >> G13 Przesunięcie obszaru roboczego komponentu typu StringGrid tak aby widoczna była komórka [x,y] >> G14 Ustawienie kursora na końcu tekstu wyświetlanego w komponencie Edit >> G15 Dynamiczne tworzenie komponentów oraz nadpisywanie ich procedur >> G16 Uproszczone dynamiczne tworzenie komponentów oraz nadpisywanie ich procedur >> G17 Blokada menu Alt+Ctrl+Del >> G18 Usunięcie nazwy programu z listy menu Alt+Ctrl+Del >> G19 Określenie uchwytu okna o znanym tytule >> G20 Określenie uchwytu okna danego typu >> G21 Zamknięcie okna gdy znany jest jego uchwyt >> G22 Zminimalizowanie lub zmaksymalizowanie okna gdy znany jest jego uchwyt >> G23 Przesunięcie okna na wierzch lub na spód względem innych okien gdy znany jest jego uchwyt >> G24 Prawidłowe wyświetlanie polskich liter przy zapisywaniu zawratości komponentu Memo do pliku typu HTML >> G25 Zapisanie zawartości komponentu RichEdit do pliku bez dodatkowych, automatycznie generowanych znaków >> G26 Struktura pętli z użyciem polecenia break >> G27 Struktura pętli z użyciem polecenia goto >> G28 Deklaracja tablic >> G29 Tablica dynamiczna >> G30 Zmiana czcionki fragmentu tekstu w komponentcie RichEdit >> G31 Zwiększenie maksymalnej pojemności komponentu RichEdit do 1 GB teskstu >> G32 Utworzenie listy liter którymi oznaczone są dostępne partycje >> G33 Automatyczne przerzucanie tekstu do następnej linijki w komponencie RichEdit >> G34 Poziomy scrollbar w komponencie ListBox >> G35 Usunięcie konkretnego wiersza z komponentów Memo i ListBox >> G36 Białe kontenery kolorów niestandardowych w komponencie ColorDialog >> G37 Ustawienie tekstowego kursora w komponencie Memo w wierszu Y oraz na pozycji X >> G38 Przesunięcie obszaru roboczego komponentu Memo na samą górę >> G39 Przesunięcie obszaru roboczego komponentu Memo o 10 wierszy w dół >> G40 Przesunięcie obszaru roboczego komponentu Memo o 10 wierszy w górę >> G41 Przesunięcie obszaru roboczego komponentu Memo tak aby widoczny był kursor tekstowy >> G42 Określenie numeru pierwszego wiersza widocznego w komponencie Memo >> G43 Przesunięcie obszaru roboczego kompunentu Memo tak aby n-ty wiersz był pierwszym widocznym >> G44 Powiązanie komponentu FindDialog z komponentem Memo >> G45 Powiązanie komponentu ReplaceDialog z komponentem Memo >> G46 Określenie ścieżki katalogu w którym jest zainstalowany system Windows >> G47 Określenie ścieżki katalogu systemowego >> G48 Pole edycyjne do którego można wpisać tylko liczbę naturalną >> G49 Rozbicie koloru na składowe RGB >> G50 Wylogowanie użytkownika, wyłączenie lub zrestartowanie komputera >> G51 Precyzyjne określenie czasu pracy systemu >> G52 Zmiana priorytetu programu >> G53 Uruchomienie komendy wiersza poleceń >> A1 Zamiana radianów na stopnie
function TForm1.RadSto(rad: Double): Double; begin Result:=(360*rad)/(2*Pi); end; A2 Zamiana stopni na radiany
function TForm1.StoRad(sto: Double): Double; begin Result:=(sto*2*Pi)/360; end; A3 Podniesienie liczby x do potęgi y
function TForm1.Potega(x,y: Double): Double; begin if x=0 then Result:=0 else Result:=exp(y*ln(abs(x))); end; uwaga: powyższa funkcja działa poprawnie również dla potęg ujemnych, oraz ułamkowych (czyli pierwiastków) A4 Wartość losowa rozkładu normalnego Gaussa
procedure TForm1.FormCreate(Sender: TObject); begin Randomize; end; n:=RandG(0,1); uwaga: pierwszy parametr powyższej funkcji to wartość średnia rozkładu, drugi to odchylenie standardowe A5 Logarytm o podstawie n z liczby x
function TForm1.Lognx(n,x: Double): Double; begin Result:=ln(x)/ln(n); end; uwaga: wprowadzone wartości x oraz n muszą być dodatnie A6 Funkcja arctg
uses Math; function TForm1.ArcTg(x: Double): Duoble; begin Result:=ArcSin((x)/(Sqrt(1+x*x))); end; uwaga: wynik podawany jest w radianach, aby zamienić go na stopnie należy zastosować dodatkowe polecenie: Result:=(360*Result)/(2*Pi); A7 Funkcja arcctg
uses Math; function TForm1.ArcCtg(x: Double): Duoble; begin Result:=ArcCos((x)/(Sqrt(1+x*x))); end; uwaga: wynik podawany jest w radianach, aby zamienić go na stopnie należy zastosować dodatkowe polecenie: Result:=(360*Result)/(2*Pi); A8 Deklaracja i zapis liczb zespolonych typu TZesp
type TZesp = record X,Y: Double end; uwaga: tworzenie liczby zespolonej odbywa się poprzez poniższą funkcję: function TForm1.Zesp(x,y: Double): TZesp; begin Result.X:=x; Result.Y:=y; end; uwaga: x jest częścią rzeczywistą zaś y częścią urojoną liczby zespolonej A9 Konwersja liczby zespolonej do postaci kanonicznej
function TForm1.PostacKanonicznaZesp(z: TZesp): String; begin if (z.X=0) and (z.Y=0) then Result:='0' else if z.X=0 then Result:=FloatToStr(z.Y)+'i' else if z.Y=0 then Result:=FloatToStr(z.X) else if z.Y<0 then Result:=FloatToStr(z.X)+FloatToStr(z.Y)+'i' else Result:=FloatToStr(z.X)+'+'+FloatToStr(z.Y)+'i' end; A10 Dodawanie liczb zespolonych
function TForm1.DodawanieZesp(z1,z2: TZesp): TZesp; begin Result.X:=z1.X+z2.X; Result.Y:=z1.Y+z2.Y; end; A11 Odejmowanie liczb zespolonych
function TForm1.OdejmowanieZesp(z1,z2: TZesp): TZesp; begin Result.X:=z1.X-z2.X; Result.Y:=z1.Y-z2.Y; end; A12 Mnożenie liczb zespolonych
function TForm1.MnozenieZesp(z1,z2: TZesp): TZesp; begin Result.X:=z1.X*z2.X-z1.Y*z2.Y; Result.Y:=z1.X*z2.Y+z1.Y*z2.X; end; A13 Dzielenie liczb zespolonych
function TForm1.DzielenieZesp(z1,z2: TZesp): TZesp; begin Result.X:=(z1.X*z2.X+z1.Y*z2.Y)/(z2.X*z2.X+z2.Y*z2.Y); Result.Y:=(z1.Y*z2.X-z2.Y*z1.X)/(z2.X*z2.X+z2.Y*z2.Y); end; uwaga: przy dzieleniu przez 0+0i wyskoczy błąd taki sam jak w przypadku dzielenia liczby rzeczywistej przez zero A14 Pierwiastek z liczby zespolonej
function TForm1.PierwiastekZesp(z: TZesp): TZesp; begin Result.X:=sqrt((z.X+sqrt(z.X*z.X+z.Y*z.Y))/2); if z.Y<0 then Result.Y:=(-1)*sqrt((-z.X+sqrt(z.X*z.X+z.Y*z.Y))/2) else Result.Y:=sqrt((-z.X+sqrt(z.X*z.X+z.Y*z.Y))/2); end; A15 Sprawdzenie czy liczba x jest parzysta
if not Odd(x) then ... uwaga: funkcja Odd(x) zwraca wartość True jeżeli liczba x jest nieparzysta i dlatego należy zastosować negację A16 Sprawdzenie czy liczba x jest podzielna przez y
function TForm1.CzyPodzielne(x,y: Double): Boolean; begin if y=0 then Result:=False else if x/y=Round(x/y) then Result:=True else Result:=False; end; A17 Największy wspólny dzielnik dla dwóch lub więcej liczb naturalnych
function TForm1.NWD(x,y: Integer): Integer; begin while (x>0) and (y>0) do begin if x>y then x:=x mod y else y:=y mod x; end; Result:=0; if (x>0) and (y=0) then Result:=x; if (y>0) and (x=0) then Result:=y; end; uwaga: szukając NWD dla więcej niż dwóch liczb należy zastosować rekurencję, przykładowo dla czterech liczb będzie to: NWD(liczba1,NWD(liczba2,NWD(liczba3,liczba4))); A18 Najmniejsza wspólna wielokrotność dwóch lub więcej liczb naturalnych
function TForm1.NWW(x,y: Integer): Integer; var xy: Integer; begin xy:=x*y; while (x>0) and (y>0) do begin if x>y then x:=x mod y else y:=y mod x; end; Result:=0; if (x>0) and (y=0) then Result:=x; if (y>0) and (x=0) then Result:=y; if Result>0 then Result:=Round(xy/Result); end; uwaga: szukając NWW dla więcej niż dwóch liczb należy zastosować rekurencję, przykładowo dla czterech liczb będzie to: NWW(liczba1,NWW(liczba2,NWW(liczba3,liczba4))); A19 Konwersja liczby typu Cardinal do Integer
function TForm1.CardToInt(n: Cardinal): Integer; begin if n>2147483647 then Result:=2147483647 else Result:=n; end; uwaga: typ Cardinal przewiduje zakres liczb od 0 do 4294967295, natomiast typ Integer zakres od -2147483648 do 2147483647 B1 Sprawdzenie czy ciąg znaków s typu String jest liczbą
function TForm1.CzyLancuchJestLiczba(s: String): Boolean; begin Result:=False; if StrToFloatDef(s,0)<>0 then Result:=True; if StrToFloatDef(s,1)<>1 then Result:=True; end; B2 Odczytanie ścieżki dostepowej z ciągu znaków typu C:\sciezka\nazwa.roz
s:=ExtractFilePath('C:\sciezka\nazwa.roz'); B3 Odczytanie nazwy pliku z ciągu znaków typu C:\sciezka\nazwa.roz
s:=ExtractFileName('C:\sciezka\nazwa.roz'); B4 Odczytanie rozszerzenia pliku z ciągu znaków typu C:\sciezka\nazwa.roz
s:=ExtractFileExt('C:\sciezka\nazwa.roz'); uwaga: powyższa funkcja zwraca również kropkę zatem wynikiem powyższego przykładu będzie ".roz" B5 Odczytanie nazwy pliku z pominięciem rozszerzenia z ciągu znaków typu C:\sciezka\nazwa.roz
function TForm1.BezRozszerzenia(s: String): String; begin Result:=ExtractFileName(Copy(s,1,Length(s)-Length(ExtractFileExt(s)))); end; B6 Zamiana w zmiennej s typu String wszystkich ciągów s1 na s2
s:=StringReplace(s,s1,s2,[rfReplaceAll]); uwaga: jeżeli wielkość liter nie ma znaczenia to należy zastosować następujące polecenie: s:=StringReplace(s,s1,s2,[rfReplaceAll,rfIgnoreCase]); B7 Alfabetyczne sortowanie tablicy ciągów znakowych typu String
procedure TForm1.SortujAlfabetycznie(var t: array of String); var temp: String; i,j: Integer; begin for i:=Low(t) to High(t)-1 do for j:=i+1 to High(t) do if AnsiCompareText(t[i],t[j])>0 then begin temp:=t[i]; t[i]:=t[j]; t[j]:=temp; end; end; B8 Sprawdzenie czy n-ty znak ciągu s typu String jest cyfrą
function TForm1.CzyCyfraN(s: String; n: Integer): Boolean; begin if s[n] in ['0','1','2','3','4','5','6','7','8','9'] then Result:=True else Result:=False; end; B9 Sprawdzenie pierwszej pozycji ciągu znaków s1 w innym ciągu znaków s2
n:=Pos(s1,s2); uwaga: powyższa funkcja zwraca liczbę 0 jeżeli ciąg znaków s2 nie zawiera ani jednego ciągu znaków s1 B10 Sprawdzenie czy zmienna s1 typu String zawiera ciąg znaków s2
if Pos(s2,s1)<>0 then ... B11 Konwersja liczby rzeczywistej x na ciąg znaków s typu string z automatycznym zaokrągleniem
s:=FormatFloat('0.000',x); B12 Sprawdzenie ostatniej pozycji dowolnego ze znaków a, b lub c ciągu znaków s
n:=LastDelimiter('abc',s); uwaga: powyższa funkcja zwraca liczbę 0 jeżeli ciąg znaków s nie zawiera ani jednego z wymienionych B13 Sprawdzenie czy ciąg znaków s pasuje do maski typu Mic?oso?t Win*s
uses Masks; function TForm1.CzyPasuje(s,maska: string): Boolean; var cMask: TMask; begin cMask:=TMask.Create(maska); try Result:=cMask.Matches(s); finally cMask.Free; end; end; uwaga: znak zapytania to dowolna litera (ale dokładnie jedna), zaś gwiazdka oznacza dowolny ciąg znaków (również pusty) B14 Zamiana ciągu znaków s typu String na małe lub na duże litery
s:=AnsiLowerCase(s); uwaga: zamiana ciągu znaków na duże litery odbywa się poprzez poniższe polecenie: s:=AnsiUpperCase(s); B15 Formatowanie liczby całkowitej do stałej ilości cyfr
function TForm1.SIC(n,c: Integer): String; begin Result:=IntToStr(n); while Length(Result)<c do Result:='0'+Result; end; B16 Odczytanie zawartości wskazanej kolumny wiersza z wyborem znaku separatora kolumn
function TForm1.KolumnaN(s,sep: String; n: Integer): String; var n2,p,k: Integer; s2: String; begin Result:=''; if (n>0) and (Length(sep)=1) then begin s2:=sep+s; n2:=0; p:=1; while (n2<n) and (p<Length(s2)) do begin while (p<Length(s2)) and (s2[p]=sep) do p:=p+1; if s2[p]<>sep then n2:=n2+1; k:=p; while (k<Length(s2)) and (s2[k+1]<>sep) do k:=k+1; if n2=n then Result:=Copy(s2,p,k-p+1) else p:=k+1; end; end; end; uwaga: zmiennej sep przypisać należy znak który traktowany będzie jako separator kolumn (np. spacja) uwaga: powyższa funkcja rozpoznaje kolumny bez względu na ilość znaków separatora między nimi B17 Sprawdzenie ilości kolumn w wierszu z wyborem znaku separatora kolumn
function TForm1.IloscKolumn(s,sep: String): Integer; var i: Integer; s2: String; begin Result:=0; s2:=s+sep; for i:=1 to Length(s2)-1 do if (s2[i]<>sep) and (s2[i+1]=sep) then Result:=Result+1; end; uwaga: zmiennej sep przypisać należy znak który traktowany będzie jako separator kolumn (np. spacja) uwaga: powyższa funkcja rozpoznaje kolumny bez względu na ilość znaków separatora między nimi C1 Wypisanie w komponencie ListBox wszystkich plików typu *.* z folderu C:\sciezka\folder
procedure TForm1.StworzListe(folder: String); var sr: TSearchRec; czyKoniec: Integer; begin ListBox1.Items.Clear; czyKoniec:=0; if folder[Length(folder)]<>'\' then folder:=folder+'\'; FindFirst(folder+'*.*',FaAnyFile,sr); while czyKoniec=0 do begin ListBox1.Items.Add(sr.Name); czyKoniec:=FindNext(sr); end; sysutils.FindClose(sr); end; uwaga: klucz wyszukujący *.* można zmienić na inny, przykładowo na *.mpeg lub *a* C2 Liczenie plików typu *.* w folderze C:\sciezka\folder
function TForm1.LiczPliki(folder: String): Integer; var sr: TSearchRec; begin Result:=0; if folder[Length(folder)]<>'\' then folder:=folder+'\'; if FindFirst(folder+'*.*',FaAnyFile,sr)=0 then begin repeat Inc(Result); until FindNext(sr)<>0; FindClose(sr); end; Result:=Result-2; end; uwaga: w każdym folderze występują 2 niewidoczne pliki systemowe "." oraz ".." i stąd Result:=Result-2; uwaga: klucz wyszukujący *.* można zmienić na inny, przykładowo na *.mpeg lub *a* C3 Kasowanie pliku C:\sciezka\nazwa.roz
procedure TForm1.SkasujPlik(plik: String); begin FileSetAttr(plik,FileGetAttr(plik) and not (faReadOnly or faHidden)); DeleteFile(plik); end; C4 Przeniesienie pliku C:\sciezka\nazwa.roz do kosza
uses ShellApi; procedure TForm1.PrzeniesPlikDoKosza(plik: String); var fileOp: TSHFileOpStruct; begin FillChar(fileOp,SizeOf(fileOp),#0); fileOp.Wnd:=Application.Handle; fileOp.wFunc:=FO_DELETE; fileOp.pFrom:=PChar(plik+#0#0); fileOp.fFlags:=FOF_SILENT or FOF_ALLOWUNDO or FOF_NOCONFIRMATION; ShFileOperation(fileOp); end; uwaga: parametr FOF_SILENT wyłącza okno paska postępu usuwania uwaga: parametr FOF_NOCONFIRMATION wyłącza okno dialogowe potwierdzające usuwanie C5 Odczytanie ścieżki oraz nazwy pliku exe uruchomionego programu
s:=Application.ExeName; C6 Otwarcie pliku C:\sciezka\nazwa.roz
uses ShellApi; ShellExecute(Handle,'Open','C:\sciezka\nazwa.roz',nil,nil,SW_SHOW); uwaga: parametr SW_SHOW spowoduje że plik zostanie otwarty w trybie normalnym uwaga: parametr SW_HIDE spowoduje że plik zostanie otwarty i od razu zamknięty uwaga: parametr SW_MAXIMIZE spowoduje że plik zostanie otwarty w trybie pełnoekranowym uwaga: parametr SW_MINIMIZE spowoduje że plik zostanie otwarty i od razu zminimalizowany C7 Zapisanie zawartości komponentu Memo do pliku C:\sciezka\nazwa.roz
Memo1.Lines.SaveToFile('C:\sciezka\nazwa.roz'); uwaga: plik nazwa.roz może mieć dowolne rozszerzenie, przykładowo nazwa.txt lub nazwa.html uwaga: polecenie to wygląda identycznie dla komponentu RichEdit C8 Wczytanie zawartości pliku C:\sciezka\nazwa.roz do komponentu Memo
Memo1.Lines.LoadFromFile('C:\sciezka\nazwa.roz'); uwaga: polecenie to wygląda identycznie dla komponentu RichEdit C9 Sprawdzenie rozmiaru pliku C:\sciezka\nazwa.roz w bajtach
function TForm1.RozmiarPliku(plik: String): Integer; var sr: TSearchRec; begin FindFirst(plik,0,sr); Result:=sr.Size; SysUtils.FindClose(sr); end; C10 Sprawdzenie czy plik C:\sciezka\nazwa.roz istnieje
if FileExists('C:\sciezka\nazwa.roz') then ... C11 Sprawdzenie czy folder C:\sciezka\folder istnieje
if DirectoryExists('C:\sciezka\folder') then ... C12 Zmiana nazwy pliku z C:\sciezka1\nazwa1.roz1 na C:\sciezka2\nazwa2.roz2
RenameFile('C:\sciezka1\nazwa1.roz1','C:\sciezka2\nazwa2.roz2'); C13 Kopiowanie pliku z C:\sciezka1\nazwa1.roz1 do C:\sciezka2\nazwa2.roz2
CopyFile(PChar('C:\sciezka1\nazwa1.roz1'),PChar('C:\sciezka2\nazwa2.roz2'),True); uwaga: parametr True określa czy nadpisać plik C:\sciezka2\nazwa2.roz2 w przypadku gdy już istnieje taki plik C14 Zapisanie rekordu do pliku C:\sciezka\nazwa.roz
type rec = record n: Integer; s: String[255]; end; procedure TForm1.ZapiszRekord(r: rec; plik: String); var f: file of rec; begin AssignFile(f,plik); Rewrite(f); Write(f,r); CloseFile(f); end; C15 Wczytanie rekordu z pliku C:\sciezka\nazwa.roz
type rec = record n: Integer; s: String[255]; end; procedure TForm1.WczytajRekord(var r: rec; plik: String); var f: file of rec; begin AssignFile(f,plik); Reset(f); Read(f,r); CloseFile(f); end; C16 Tworzenie nowego folderu C:\sciezka\folder
CreateDir('C:\sciezka\folder'); uwaga: w przypadku gdy nie ma pewności czy istnieją foldery nadrzędne (czyli ścieżka) to należy zastosować polecenie: ForceDirectories('C:\sciezka\folder'); C17 Kasowanie pustego folderu C:\sciezka\folder
RemoveDir('C:\sciezka\folder'); C18 Kasowanie folderu C:\sciezka\folder w którym mogą znajdować się pliki lub podfoldery
procedure TForm1.UsunFolder(folder: String); var sr: TSearchRec; czyKoniec: Integer; folder2: String; begin folder2:=StringReplace(folder,'/','\',[rfReplaceAll]); if folder2[Length(folder2)]<>'\' then folder2:=folder2+'\'; czyKoniec:=FindFirst(folder2+'*.*',faAnyFile,sr); while czyKoniec=0 do begin if (sr.Name<>'.') and (sr.Name<>'..') then begin if DirectoryExists(folder2+sr.Name) then UsunFolder(folder2+sr.Name) else begin FileSetAttr(folder2+sr.Name,FileGetAttr(folder2+sr.Name) and not (faReadOnly or faHidden)); DeleteFile(folder2+sr.Name); end; end; czyKoniec:=FindNext(sr); end; FindClose(sr); RemoveDir(folder2); end; C19 Wczytanie do komponentu ListBox nazw plików i folderów po przeniesieniu ich na formę programu
uses ShellApi; private procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES; procedure TForm1.FormCreate(Sender: TObject); begin DragAcceptFiles(Handle,True); end; procedure TForm1.WMDropFiles(var Msg: TWMDropFiles); var cFileName: array [0..MAX_PATH] of Char; i,ilosc: Integer; begin ilosc:=DragQueryFile(Msg.Drop,$FFFFFFFF,nil,0); for i:=0 to ilosc-1 do begin if DragQueryFile(Msg.Drop,i,cFileName,DragQueryFile(Msg.Drop,i,nil,0)+1)>0 then ListBox1.Items.Add(cFileName); end; end; C20 Dodanie pliku C:\sciezka\nazwa.roz do autostartu rejestrowego
uses Registry; procedure TForm1.DodajDoKluczaRun(nazwa,plik: String); var reg: TRegistry; begin reg:=TRegistry.Create; try reg.RootKey:=HKEY_LOCAL_MACHINE; reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',True); reg.WriteString(nazwa,plik); finally reg.Free; end; end; uwaga: w obrębie pojedynczego klucza rejestru każdy wpis musi mieć inną nazwę (w przeciwnym wypadku zostanie nadpisany) C21 Wczytanie do komponentu ListBox nazw plików znajdujących się w folderze C:\sciezka\folder i w jego podfolderach
procedure TForm1.WczytajNazwyPlików(s: String); var sr: TSearchRec; czyKoniec: Integer; begin czyKoniec:=0; if (s[Length(s)]<>'/') and (s[Length(s)]<>'\') then s:=s+'\'; FindFirst(s+'*.*',FaAnyFile,sr); while czyKoniec=0 do begin if (sr.Name<>'.') and (sr.Name<>'..') then if DirectoryExists(s+sr.Name) then WczytajNazwyPlików(s+sr.Name+'\') else ListBox1.Items.Add(s+sr.Name); czyKoniec:=FindNext(sr); end; sysutils.FindClose(sr); end; C22 Nadanie plikowi C:\sciezka\plik.roz atrybutu ukryty
FileSetAttr('C:\sciezka\plik.roz',FileGetAttr('C:\sciezka\plik.roz') or (faHidden)); uwaga: usunięcie tego atrybutu odbywa się poprzez polecenie:: FileSetAttr('C:\sciezka\plik.roz',FileGetAttr('C:\sciezka\plik.roz') and not (faHidden)); C23 Nadanie plikowi C:\sciezka\plik.roz atrybutu tylko do odczytu
FileSetAttr('C:\sciezka\plik.roz',FileGetAttr('C:\sciezka\plik.roz') or (faReadOnly)); uwaga: usunięcie tego atrybutu odbywa się poprzez polecenie:: FileSetAttr('C:\sciezka\plik.roz',FileGetAttr('C:\sciezka\plik.roz') and not (faReadOnly)); C24 Zmiana daty utworzenia i ostatniej modyfikacji pliku C:\sciezka\plik.roz
procedure TForm1.ZmienDatePliku(plik: String; data: TDateTime); var fDate,fHandle: Integer; localFileTime,fileTime: TFileTime; bufor: File; begin if FileExists(plik) then begin try AssignFile(bufor,plik); Reset(bufor); fDate:=DateTimeToFileDate(data); fHandle:=TFileRec(bufor).Handle; DosDateTimeToFileTime(LongRec(fDate).Hi,LongRec(fDate).Lo,localFileTime); LocalFileTimeToFileTime(localFileTime,fileTime); SetFileTime(fHandle,@fileTime,@fileTime,@fileTime); finally CloseFile(bufor); end; end; end; ZmienDatePliku('C:\sciezka\plik.roz',EnCodeDate(1999,12,31)+EnCodeTime(23,59,59,99)); uwaga: data i czas muszą być wprowadzone z sensem (przykładowo data 30 luty lub godzina 33:86 spowodują błąd programu) C25 Odczytanie daty utworzenia, modyfikacji i ostatniego dostępu do pliku C:\sciezka\plik.roz
procedure TForm1.OdczytajDatyPliku(plik: String); var sr: TSearchRec; u,m,d: TDateTime; localFileTime: TFileTime; systemTime: TSystemTime; begin if FindFirst(plik,faAnyFile,sr)=0 then begin FileTimeToLocalFileTime(sr.FindData.ftCreationTime,localFileTime); FileTimeToSystemTime(localFileTime,systemTime); u:=SystemTimeToDateTime(systemTime); FileTimeToLocalFileTime(sr.FindData.ftLastWriteTime,localFileTime); FileTimeToSystemTime(localFileTime,systemTime); m:=SystemTimeToDateTime(systemTime); FileTimeToLocalFileTime(sr.FindData.ftLastAccessTime,localFileTime); FileTimeToSystemTime(localFileTime,systemTime); d:=SystemTimeToDateTime(systemTime); end; FindClose(sr); ShowMessage('Data utworzenia pliku to: '+DateTimeToStr(u)); ShowMessage('Data ostatniej modyfikacji pliku to: '+DateTimeToStr(m)); ShowMessage('Data ostatniego dostępu do pliku to: '+DateTimeToStr(d)); end; C26 Zapisanie ustawień programu do pliku
uses IniFiles; procedure TForm1.ZapiszUstawienia; var ini: TIniFile; b: Boolean; n: Integer; s: String; d: TDateTime; f: Double; begin b:=False; n:=99; s:='tekst'; d:=Now; f:=3.14; ini:=TIniFile.Create(ExtractFilePath(Application.ExeName)+'ustawienia.ini'); ini.WriteString('naglowek','s',s); ini.WriteBool('naglowek','b',b); ini.WriteInteger('naglowek','n',n); ini.WriteDateTime('naglowek','d',d); ini.WriteFloat('naglowek','f',f); ini.UpdateFile; ini.Free; end; uwaga: plik ustawienia.ini utworzony zostanie w tym samym folderze co plik exe uruchomionego programu C27 Wczytanie ustawień programu z pliku
uses IniFiles; procedure TForm1.WczytajUstawienia; var ini: TIniFile; b: Boolean; n: Integer; s: String; d: TDateTime; f: Double; begin ini:=TIniFile.Create(ExtractFilePath(Application.ExeName)+'ustawienia.ini'); b:=ini.ReadBool('naglowek','b',True); n:=ini.ReadInteger('naglowek','n',0); s:=ini.ReadString('naglowek','s',''); d:=ini.ReadDateTime('naglowek','d',Now); f:=ini.ReadFloat('naglowek','f',0); ini.Free; end; C28 Zasoby typu TResourceStream
Aby dodać plik do zasobów musisz utworzyć podręczny folder i umieścić w nim cztery pliki: a) plik który ma zostać dołączony do zasobów (np. program.exe), b) plik brcc32.exe z folderu Bin w katalogu Delphi, c) plik rw32core.dll z folderu Bin w katalogu Delphi, d) plik tekstowy zasoby.rc z następującą treścią: PROGRAM RCDATA "program.exe" (całość w jednej linijce). Następnie włącz tryb MS-DOS (przykładowo przez Start => Uruchom => Command). Poleceniami "cd.." i "cd folder" przejdź do folderu który stworzyłeś na początku. Wpisz polecenie "brcc32 zasoby.rc" co spowoduje kompilację zasobów. Powstały plik zasoby.res przenieś do folderu gdzie tworzysz swój projekt. W części implementacyjnej programu wstaw kod {$R ZASOBY.RES} i uruchom aplikację. Na koniec stwórz następującą procedurę wypakowującą plik z zasobów: procedure TForm1.WypakujZasoby(plik: String); var Res: TResourceStream; begin Res:=TResourceStream.Create(hInstance,'PROGRAM',RT_RCDATA); Res.SaveToFile(plik); Res.Free; end; C29 Obsługa pliku metodą "Otwórz za pomocą..." ze wskazaniem na program stworzony w Delphi
if ParamCount=1 then nazwaPliku:=ParamStr(1); uwaga: po wykonaniu powyższego polecenie do zmiennej nazwaPliku przypisana zostanie pełna ścieżka pliku "Otwartego za pomocą..." C30 Kopiowanie folderu wraz z zawartością
procedure TForm1.KopiujFolder(folderZrodlowy,folderDocelowy: String); var sr: TSearchRec; czyKoniec: Integer; folderZrodlowy2,folderDocelowy2: String; begin folderZrodlowy2:=StringReplace(folderZrodlowy,'/','\',[rfReplaceAll]); if folderZrodlowy2[Length(folderZrodlowy2)]<>'\' then folderZrodlowy2:=folderZrodlowy2+'\'; folderDocelowy2:=StringReplace(folderDocelowy,'/','\',[rfReplaceAll]); if folderDocelowy2[Length(folderDocelowy2)]<>'\' then folderDocelowy2:=folderDocelowy2+'\'; czyKoniec:=FindFirst(folderZrodlowy2+'*.*',faAnyFile,sr); while czyKoniec=0 do begin if (sr.Name<>'.') and (sr.Name<>'..') then begin if not DirectoryExists(folderDocelowy2) then ForceDirectories(folderDocelowy2); if DirectoryExists(folderZrodlowy2+sr.Name) then KopiujFolder(folderZrodlowy2+sr.Name,folderDocelowy2+sr.Name) else CopyFile(PChar(folderZrodlowy2+sr.Name),PChar(folderDocelowy2+sr.Name),True); end; czyKoniec:=FindNext(sr); end; FindClose(sr); end; D1 Kliknięcie lewym przyciskiem myszy w punkcie x od lewej i y od góry na ekranie
procedure TForm1.Klik(x,y: Integer); begin SetCursorPos(x,y); mouse_event(MOUSEEVENTF_LEFTDOWN,x,y,0,0); mouse_event(MOUSEEVENTF_LEFTUP,x,y,0,0); end; uwaga: aby wywołać kliknięcie prawym przyciskiem myszy należy zamienić parametr LEFT na RIGHT D2 Przesunięcie kursora o x w poziomie oraz y w pionie
procedure TForm1.Przesun(dx,dy: Integer); var p: TPoint; begin GetCursorPos(p); SetCursorPos(p.X+dx,p.Y+dy); end; D3 Wciśnięcie dowolnego klawisza klawiatury z poziomu programu
keybd_event(Ord(Chr(32)),0,0,0); keybd_event(Ord(Chr(32)),0,KEYEVENTF_KEYUP,0); uwaga: numer klawisza (w przykładzie 32 oznacza spację) sprawdzić można wywołując procedurę OnKeyDown dla Memo: procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin ShowMessage(IntToStr(Key)); end; D4 Wpisanie ciągu znaków s typu String w miejsce ustawienia kursora tekstowego
uses ClipBrd; procedure TForm1.Wpisz(s: String); begin ClipBoard.AsText:=s; keybd_event(Ord(Chr(17)),0,0,0); keybd_event(Ord(Chr(86)),0,0,0); keybd_event(Ord(Chr(86)),0,KEYEVENTF_KEYUP,0); keybd_event(Ord(Chr(17)),0,KEYEVENTF_KEYUP,0); end; uwaga: powyższa procedura kopiuje tekst s do schowka a następnie symuluje wciśnięcie kombinacji klawiszy Ctrl+V D5 Blokada myszy oraz blokada klawiatury
uses ShellApi; ShellExecute(Handle,'Open','rundll32','mouse,disable',nil,SW_SHOWNORMAL); uwaga: aby zablokować klawiaturę należy zamienić parametr mouse na keyboard uwaga: jedynym znanym mi sposobem odblokowania myszy lub klawiatury jest ponowne uruchomienie komputera D6 Zamiana przycisków myszy
SwapMouseButton(True); uwaga: aby przywrócić pierwotne ustawienia przycisków myszy należy zamienić parametr True na False D7 Reakcja po wciśnięciu określonego klawisza lub kombinacji klawiszy na klawiaturze
var MainHook: hHook; function KeyHook(code: Integer; wPar: wParam; lPar: lParam): Longint; StdCall; var kState: TKeyboardState; begin GetKeyboardState(kState); if (kState[32] and $80)<>0 then ShowMessage('Wcisnąłeś spację'); if (kState[65] and kState[66] and not kState[67] and $80)<>0 then ShowMessage('Wcisnąłeś jednocześnie klawisze A i B przy czym klawisz C nie był wciśnięty'); end; procedure TForm1.FormCreate(Sender: TObject); begin MainHook:=SetWindowsHookEx(WH_Keyboard,KeyHook,hInstance,0); end; procedure TForm1.FormDestroy(Sender: TObject); begin UnhookWindowsHookEx(MainHook); end; uwaga: numer klawisza (w przykładzie 32 oznacza spację) sprawdzić można wywołując procedurę OnKeyDown dla Memo: procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin ShowMessage(IntToStr(Key)); end; D8 Nadpisanie instrukcji wykonywanej przez system po wciśnięciu określonego klawisza na klawiaturze
private procedure WMHotKey(var Msg: TMessage); message WM_HOTKEY; procedure TForm1.FormCreate(Sender: TObject); begin RegisterHotKey(Handle,$0001,0,VK_SPACE); RegisterHotKey(Handle,$0002,MOD_ALT,VK_A); RegisterHotKey(Handle,$0003,MOD_SHIFT,VK_2); RegisterHotKey(Handle,$0004,0,VK_F12); end; procedure TForm1.WMHotKey(var Msg: TMessage); begin if Msg.wParam=$0001 then ShowMessage('Wybrano spację'); if Msg.wParam=$0002 then ShowMessage('Wybrano znak ą'); if Msg.wParam=$0003 then ShowMessage('Wybrano znak @'); if Msg.wParam=$0004 then ShowMessage('Wybrano F12'); end; uwaga: reakcja domyślna (np. zrobienie odstepu dla kalwisza Space) po nadpisaniu nie zostanie wywołana uwaga: niemożliwe jest nadpisanie tą metodą zdarzenia wywołango dla kombinacji kalwiszy Alt+Ctrl+Del uwaga: poniżej zamieszczam wszystkie znane mi oznaczenia klawiszy typu VK (ang. Virtual-Key): VK_SHIFT - Shift VK_CONTROL - Ctrl VK_MENU - Alt VK_BACK - BackSpace VK_TAB - Tab VK_RETURN - Enter VK_PAUSE - Pause VK_SNAPSHOT - PrintScreen VK_CAPITAL - Caps Lock VK_NUMLOCK - Num Lock VK_SCROLL - Scroll Lock VK_ESCAPE - Esc VK_SPACE - Space VK_PRIOR - Page Up VK_NEXT - Page Down VK_END - End VK_HOME - Home VK_INSERT - Insert VK_DELETE - Delete VK_LEFT - strzałka w lewo VK_UP - strzałka do góry VK_RIGHT - strzałka w prawo VK_DOWN - strzałka w dół VK_F1 - F1 (pozostałe analogicznie) VK_A - litera A (pozostałe analogicznie) VK_0 - cyfra 0 (pozostałe analogicznie) VK_NUMPAD0 - cyfra 0 w części numerycznej (pozostałe analogicznie) VK_MULTIPLY - gwiazdka w części numerycznej VK_ADD - plus w części numerycznej VK_SUBTRACT - minus w części numerycznej VK_DECIMAL - kropka w części numerycznej VK_DIVIDE - dzielenie w części numerycznej uwaga: VK jest parametrem typu całkowitego i można go zastąpić numerem odczytanym z procedury OnKeyDown dla Memo: procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin ShowMessage(IntToStr(Key)); end; uwaga: rozwiązanie to pozwala nadpisać zdarzenia dla wszystkich klawiszy, również tych nie posiadających oznaczenia VK D9 Blokada klawisza PrintScreen
private procedure WMHotKey(var Msg: TMessage); message WM_HOTKEY; procedure TForm1.FormCreate(Sender: TObject); begin RegisterHotKey(Handle,$0001,0,VK_SNAPSHOT); end; procedure TForm1.WMHotKey(var Msg: TMessage); begin if Msg.wParam=$0001 then begin //tu można wpisać polecenia wykonywane po wciśnięciu klawisza PrintScreen end; end; D10 Ukrycie kursora myszy
ShowCursor(False); uwaga: aby ponownie pokazać kursor myszy należy zamienić parametr False na True D11 Ograniczenie pola w którym może poruszać się kursor myszy
procedure TForm1.OgraniczPoleKursora(x1,x2,y1,y2: Integer); var R: TRect; begin R.Left:=x1; R.Right:=x2; R.Top:=y1; R.Bottom:=y2; ClipCursor(@R); end; E1 Zapisanie na dysku pliku z Internetu
uses UrlMon; UrlDownloadToFile(nil,'http://www.witryna.pl/nazwa.roz','C:\sciezka\nazwa.roz',0,nil); E2 Zapisanie na dysku pliku z Internetu z paskiem postępu pobierania i obsługą błędów
uses IdException; procedure TForm1.Pobierz(adres,plik: String); var fs: TFileStream; e: Exception; begin try IdHTTP1.Head(adres); fs:=TFileStream.Create(plik,fmCreate); IdHTTP1.Get(adres,fs); fs.Free; IdHTTP1.Disconnect; except on e: EIdProtocolReplyError do begin //tu można wpisać polecenia wykonywane w przypadku braku pliku end; on e: EIdSocketError do begin //tu można wpisać polecenia wykonywane w przypadku przekierowania end; end; end; procedure TForm1.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer); begin ProgressBar1.Max:=AWorkCountMax; end; procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer); begin ProgressBar1.Position:=AWorkCount; end; procedure TForm1.IdHTTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode); begin ProgressBar1.Position:=0; end; uwaga: przed uruchomieniem programu należy umieścić na formie komponent IdHTTP z zakładki Indy Clients uwaga: aby program nie zamrażał się przy nawiązywaniu połączenia należy dodać komponent IdAntiFreeze z zakładki Indy Misc E3 Wczytanie do komponentu Memo kodu źródłowego strony internetowej
Memo1.Text:=IdHTTP1.Get('http://www.witryna.pl'); uwaga: przed uruchomieniem programu należy umieścić na formie komponent IdHTTP z zakładki Indy Clients uwaga: adres strony musi zaczynać się od ciągu znaków http:// uwaga: aby program nie zamrażał się przy nawiązywaniu połączenia należy dodać komponent IdAntiFreeze z zakładki Indy Misc E4 Odczytanie adesu URL aktywnego okna przeglądarki
function TForm1.AdresOknaPrzegladarki: String; var ie,toolbar,combo,comboBoxEx,edit,worker: HWND; begin ie:=FindWindow(PChar('IEFrame'),nil); worker:=FindWindowEx(ie,0,'WorkerA',nil); toolbar:=FindWindowEx(worker,0,'ReBarWindow32',nil); comboBoxEx:=FindWindowEx(toolbar,0,'ComboBoxEx32',nil); combo:=FindWindowEx(comboBoxEx,0,'ComboBox',nil); edit:=FindWindowEx(combo,0,'Edit',nil); Result:=GetText(edit); end; function TForm1.GetText(windowHandle: HWND): String; var txtLength: Integer; buffer: String; begin txtLength:=SendMessage(windowHandle,WM_GETTEXTLENGTH,0,0); txtLength:=txtLength+1; SetLength(buffer,txtLength); SendMessage(windowHandle,WM_GETTEXT,txtLength,longint(@buffer[1])); Result:=buffer; end; uwaga: w przypadku braku otwartego okna przeglądarki internetowej powyższa funkcja zwraca pusty ciąg znaków E5 Otwarcie strony internetowej
uses ShellApi; ShellExecute(Handle,'Open','http://www.witryna.pl/',nil,nil,SW_SHOW); E6 Określenie adresu IP komputera
uses WinSock; function TForm1.MojAdresIP: String; var p: PHostEnt; s: array [0..128] of Char; p2: PChar; begin GetHostName(@s,128); p:=GetHostByName(@s); Result:=iNet_ntoa(PInAddr(p^.h_addr_list^)^); end; procedure TForm1.FormCreate(Sender: TObject); var wVersionRequested: Word; wsaData: TWSAData; begin wVersionRequested:=MakeWord(1,1); WSAStartup(wVersionRequested,wsaData); end; procedure TForm1.FormDestroy(Sender: TObject); begin WSACleanup; end; uwaga: adresy 0.0.0.0 oraz 127.0.0.1 oznaczają że komputer nie jest podłączony do sieci E7 Wypisanie w komponencie ListBox adesów Url ze wszystkich otwartych okien przeglądarki
uses SHDocVw; procedure TForm1.WypiszAdresyOkienPrzegladarki; var i: Integer; sw: Ishellwindows; ie: IWebbrowser2; begin ListBox1.Items.Clear; sw:=CoShellWindows.Create; for i:=0 to sw.count-1 do begin ie:=sw.Item(i) as IWebbrowser2; if ie<>nil then ListBox1.Items.Add(AnsiLowerCase(ie.LocationUrl)); end; end; E8 Sprawdzanie czy komputer jest połączony z Internetem
var polaczony: Boolean; function TForm1.CzyJestPolaczenie: Boolean; begin IdIcmpClient1.Host:='www.wp.pl'; IdIcmpClient1.Port:=80; IdIcmpClient1.Ping; Result:=polaczony; end; procedure TForm1.IdIcmpClient1Reply(ASender: TComponent; const AReplyStatus: TReplyStatus); begin if AReplyStatus.BytesReceived=0 then polaczony:=False else polaczony:=True; end; uwaga: przed uruchomieniem programu należy umieścić na formie komponent IdHTTP z zakładki Indy Clients uwaga: w polu Host zamiast www.wp.pl można wpisać dowolny serwer który nie odrzuca wiadomości Ping uwaga: w polu Port zamiast 80 można wpisać dowolną liczbę całkowitą od 0 do 65535 uwaga: aby program nie zamrażał się przy nawiązywaniu połączenia należy dodać komponent IdAntiFreeze z zakładki Indy Misc F1 Ukrycie belki na pasku zadań
procedure TForm1.FormCreate(Sender: TObject); var es: Integer; begin es:=GetWindowLong(Application.Handle,GWL_EXSTYLE); es:=es or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW; SetWindowLong(Application.Handle,GWL_EXSTYLE,es); end; F2 Ukrycie formy programu
Application.ShowMainForm:=False; uwaga: można również zastosować polecenie: Form1.Visible:=False; uwaga: właściwość tę ustawić można również w inspektorze obiektów F3 Blokada wybranych przycisków z prawego górnego rogu formy
Form1.BorderIcons:=[biSystemMenu,biMinimize,biMaximize]; uwaga: aby zablokować wybrany przycisk należy usunąć z powyższego zbioru jego deklarację uwaga: właściwość tę ustawić można również w inspektorze obiektów F4 Blokada rozciągania formy
Form1.BorderStyle:=bsSingle; uwaga: właściwość tę ustawić można również w inspektorze obiektów F5 Ukrycie ikon z pulpitu
procedure TForm1.UkryjIkonyPulpitu; var uchwyt: HWND; begin uchwyt:=FindWindow('Progman',nil ); ShowWindow(uchwyt,SW_HIDE); end; uwaga: aby ponownie pokazać ikony pulpitu należy zamienić parametr SW_HIDE na SW_SHOW F6 Zmiana rozdzielczości ekranu
procedure TForm1.ZmienRozdzielczoscEkranu(szerokosc,wysokosc: Integer); var mode: TDeviceMode; begin with mode do begin dmSize:=SizeOf(mode); dmBitsPerPel:=16; dmPelsWidth:=szerokosc; dmPelsHeight:=wysokosc; dmFields:=DM_PELSWIDTH+DM_PELSHEIGHT; ChangeDisplaySettings(mode,0) end; end; F7 Sprawdzenie czy kolor piksela na ekranie oddalonego o x od lewej oraz y od góry jest czerwony
var cnv: TCanvas; procedure TForm1.FormCreate(Sender: TObject); begin cnv:=TCanvas.Create; end; procedure TForm1.CzyPikselJestCzerwny(x,y: Integer): Boolean; begin cnv.Handle:=GetDC(0); if cnv.Pixels[x,y]=RGB(255,0,0) then Result:=True else Result:=False; end; F8 Przezroczysta forma programu
procedure TForm1.FormCreate(Sender: TObject); begin Form1.BorderStyle:=bsNone; Form1.Brush.Style:=bsClear; Form1.Refresh; end; F9 Włączenie trybu zawsze na wierzchu dla formy programu
Form1.FormStyle:=fsStayOnTop; uwaga: aby wyłączyć tryb zawsze na wierzchu należy zamienić parametr fsStayOnTop na fsNormal F10 Ukrycie paska tytułowego formy
procedure TForm1.FormCreate(Sender: TObject); begin SetWindowLong(Form1.Handle,GWL_STYLE,GetWindowLong(Form1.Handle,GWL_STYLE) and not WS_CAPTION); Height:=ClientHeight; end; F11 Miganie belki programu na pasku zadań
procedure TForm1.Timer1Timer(Sender: TObject); begin FlashWindow(Application.Handle,True); end; uwaga: przed uruchomieniem programu należy umieścić na formie komponent Timer z parametrem Interval równym 250 F12 Odświeżenie wyglądu formy programu
Application.ProcessMessages; G1 Automatyczne zamkniecie programu jeżeli jest już uruchomiona jego kopia
var hMapping: THandle; procedure TForm1.FormCreate(Sender: TObject); begin hMapping:=CreateFileMapping(THandle($FFFFFFFF),nil,PAGE_READONLY,0,32,'UniCodeG8BH76B6B6H8DS0'); if GetLastError=ERROR_ALREADY_EXISTS then Application.Terminate; end; procedure TForm1.FormDestroy(Sender: TObject); begin CloseHandle(hMapping); end; uwaga: ciąg znaków UniCode musi być niepowtarzalny, zatem sam stwórz ciąg przypadkowych znaków o dowolnej długości G2 Bezwarunkowe zamknięcie programu
Application.Terminate; G3 Wypisanie w komponencie ListBox tytułów, typów oraz uchwytów wszystkich otwartych okien
function EnumWindowsProc(wHandle: HWND): Boolean; StdCall; Export; var title,className: array [0..128] of Char; sTitle,sClass,sLine: String; begin Result:=True; GetWindowText(wHandle,title,128); GetClassName(wHandle,className,128); sTitle:=title; sClass:=className; if IsWindowVisible(wHandle) then begin sLine:=sTitle+'/'+sClass+'/'+IntToHex(wHandle,4); Form1.Listbox1.Items.Add(sLine); end; end; EnumWindows(@EnumWindowsProc,0); uwaga: usuwając warunek IsWindowVisible(wHandle) otrzymamy listę wszystkich uruchomionych procesów, również tych ukrytych G4 Zamknięcie programu z wyświetleniem komunikatu o błędzie krytycznym
FatalAppExit(0,'Wystąpił błąd 408E a to bardzo źle...'); uwaga: wyskakujące okienko wygląda groźnie, ale niczego złego nie powoduje G5 Określenie aktualnej daty
s:=DateToStr(Date); G6 Zmiana wymiarów obrazu tak aby miał te same proporcje co oryginał ale nie przekroczył wskazanych wymiarów
procedure TForm1.DopasujRozmiarObrazu(maxSzerokosc,maxWysokosc: Integer); begin Image1.Width:=maxSzerokosc; Image1.Height:=maxWysokosc; Image1.Proportional:=True; Image1.Stretch:=True; end; G7 Wyświetlenie obrazu typu jpeg
uses Jpeg; Image1.Picture.LoadFromFile('C:\sciezka\nazwa.jpeg'); G8 Ukrycie wszstkich przycisków typu Button
procedure TForm1.UkryjPrzyciski; var i: Integer; begin for i:=0 to ControlCount-1 do if Controls[i] is TButton then Controls[i].Visible:=False; end; G9 Pojedyncze odtworzenie dźwięku
procedure TForm1.OdtworzDzwiek(plik: String); begin MediaPlayer1.FileName:=plik; MediaPlayer1.Open; MediaPlayer1.Play; end; uwaga: przed uruchomieniem programu należy umieścić na formie komponent MediaPlayer z zakładki System uwaga: w ten sam sposób odtwarzać można dźwięki zapisane w innych formatach, przykładowo mp3 lub wmv G10 Przeniesienie kursora do komórki [x,y] komponentu StringGrid
procedure TForm1.KursorDoKomorki(x,y: Integer); begin StringGrid1.SetFocus; StringGrid1.Selection:=TGridRect(Rect(x,y,x,y)); end; uwaga: jeżeli SetFocus ustawiony zostanie na innym komponencie to pole [x,y] zostanie podświetlone G11 Okno wyboru tak lub nie w języku polskim
if MessageBox(0,'Czy jesteś pewien że chcesz to zrobić?','Potwierdzenie',MB_YESNO)=mrYes then PolecenieDlaTak else PolecenieDlaNie; G12 Zamknięcie okna dowolnego programu o tytule t
procedure TForm1.ZamknijOkno(t: String); var uchwyt: THandle; begin uchwyt:=FindWindow(nil,PChar(t)); SendMessage(uchwyt,WM_CLOSE,0,0); end; G13 Przesunięcie obszaru roboczego komponentu typu StringGrid tak aby widoczna była komórka [x,y]
procedure TForm1.PrzesunStringGrid(x,y: Integer); begin StringGrid1.LeftCol:=x; StringGrid1.TopRow:=y; end; G14 Ustawienie kursora na końcu tekstu wyświetlanego w komponencie Edit
procedure TForm1.UstawKursorNaKoncu; begin Edit1.SetFocus; Edit1.SelStart:=Length(Edit1.Text); end; G15 Dynamiczne tworzenie komponentów oraz nadpisywanie ich procedur
type TEtykieta = class(TLabel) public constructor Stworz(x,y: Integer); procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); Override; procedure MouseMove(Shift: TShiftState; X,Y: Integer); Override; private end; constructor TEtykieta.Stworz(x,y: Integer); var nowa: TEtykieta; begin nowa:=inherited Create(Owner); Parent:=Form1; with nowa do begin Left:=x; Top:=y; Font.Name:='Verdana'; Font.Size:=10; Font.Style:=[fsBold]; Caption:='Nowa etykieta'; end; end; procedure TEtykieta.MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); begin TEtykieta(Self).Free; end; procedure TEtykieta.MouseMove(Shift: TShiftState; X,Y: Integer); begin TEtykieta(Self).Caption:='Już nie taka nowa'; TEtykieta(Self).Color:=clWhite; TEtykieta(Self).Font.Color:=clRed; end; TEtykieta.Stworz(20,20); uwaga: nadpisywane procedury deklaruje się z pominięciem parametru Sender G16 Uproszczone dynamiczne tworzenie komponentów oraz nadpisywanie ich procedur
uses StdCtrls; procedure TForm1.Stworz(x,y: Integer); var nowa: TLabel; begin nowa:=TLabel.Create(Owner); with nowa do begin Parent:=Form1; Left:=x; Top:=y; Font.Name:='Verdana'; Font.Size:=10; Font.Style:=[fsBold]; Caption:='Nowa etykieta'; OnMouseDown:=Label1MouseDown; OnMouseMove:=Label1MouseMove; end; end; procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin (Sender as TLabel).Free; end; procedure TForm1.Label1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin (Sender as TLabel).Caption:='Już nie taka nowa'; (Sender as TLabel).Color:=clWhite; (Sender as TLabel).Font.Color:=clRed; end; Stworz(20,20); G17 Blokada menu Alt+Ctrl+Del
var OldValue: LongBool; SystemParametersInfo(97,Word(True),@OldValue,0); uwaga: aby odblokować menu Alt+Ctrl+Del należy zamienić parametr True na False G18 Usunięcie nazwy programu z listy menu Alt+Ctrl+Del
function RegisterServiceProcess(pid,num: Longint): Boolean; StdCall; External 'kernel32.dll' name 'RegisterServiceProcess'; procedure TForm1.FormCreate(Sender: TObject); begin RegisterServiceProcess(0,1); end; uwaga: pod Windows XP powyższe polecenie nie zadziała i należy zastosować poniższe polecenie: procedure TForm1.FormCreate(Sender: TObject); begin Application.Title:=''; end; G19 Określenie uchwytu okna o znanym tytule
var uchwyt: HWND; uchwyt:=FindWindow(nil,PChar('Tytuł okna')); uwaga: w przypadku gdyby kilka okien miało ten sam tytuł to uchwycone zostanie to okno które było używane jako ostatnie G20 Określenie uchwytu okna danego typu
var uchwyt: HWND; uchwyt:=FindWindow(PChar('Typ okna'),nil); uwaga: w przypadku gdyby kilka okien było tego samego typu to uchwycone zostanie to okno które było używane jako ostatnie G21 Zamknięcie okna gdy znany jest jego uchwyt
PostMessage(uchwyt,WM_CLOSE,0,0); G22 Zminimalizowanie lub zmaksymalizowanie okna gdy znany jest jego uchwyt
ShowWindow(uchwyt,SW_MAXIMIZE); uwaga: parametr SW_MAXIMIZE spowoduje że okno zostanie zmaksymalizowane uwaga: parametr SW_MINIMIZE spowoduje że okno zostanie zminimalizowane G23 Przesunięcie okna na wierzch lub na spód względem innych okien gdy znany jest jego uchwyt
SetWindowPos(uchwyt,HWND_BOTTOM,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE); uwaga: parametr HWND_BOTTOM spowoduje że okno zostanie przesunięte na spód uwaga: parametr HWND_TOP spowoduje że okno zostanie przesunięte na wierzch G24 Prawidłowe wyświetlanie polskich liter przy zapisywaniu zawratości komponentu Memo do pliku typu HTML
Należy zakodować dokumkent HTML zgodnie ze standardem ISO-8859-2, a przed zapisaniem zastosować funkcję: function TForm1.CP2CP(srcStr:PChar; CP1,CP2: Integer; errorCode: PInteger): String; var ws: PWideChar; ms: PChar; errorC,wSize,bSize: Integer; b: Bool; c: Char; begin b:=False; c:='#'; Result:=''; try wSize:=MultiByteToWideChar(CP1,1 or 0,PChar(srcStr),-1,ws,0); GetMem(ws,wSize*SizeOf(WideChar)); errorC:=MultiByteToWideChar(CP1,1 or 0,PChar(srcStr),-1,ws,wSize); if errorC<>0 then try bSize:=WideCharToMultibyte(CP2,0,ws,-1,ms,0,@c,@b); GetMem(ms,BSize*SizeOf(Char)); errorC:=WideCharToMultibyte(CP2,0,ws,-1,ms,bSize,@c,@b); if b then errorC:=-1; if errorC<>0 then Result:=ms; finally FreeMem(ms,bSize*SizeOf(Char)); end; finally FreeMem(ws,wSize*SizeOf(WideChar)); end; if errorCode<>nil then errorCode^:=errorC; end; Memo1.Text:=CP2CP(PChar(Memo1.Text),1250,28592,nil); uwaga: przy wczytywaniu zawartości pliku html do Memo należy wywołać konwersję odwrotną: Memo1.Text:=CP2CP(PChar(Memo1.Text),28592,1250,nil); G25 Zapisanie zawartości komponentu RichEdit do pliku bez dodatkowych, automatycznie generowanych znaków
należy ustawić właściwość PlainText komponentu RichEdit na True, lub zastosować poniższe polecenie: RichEdit1.PlainText:=True; G26 Struktura pętli z użyciem polecenia break
procedure TForm1.PetlaBreak; var i: integer; begin for i:=1 to 1000 do begin if i=8 then break; end; end; uwaga: polecenie break powoduje natychmiastowe zakończenie wykonywania pętli w jej ósmym przebiegu G27 Struktura pętli z użyciem polecenia goto
procedure TForm1.PetlaGoTo; var i: integer; label A; begin i:=0; A: i:=i+1; if i<8 then goto A; end; uwaga: polecenie goto powoduje zakończenie wykonywania poleceń i ponowne rozpoczęcie od miejsca A: typu label G28 Deklaracja tablic
const tablica1: array [0..9] of Integer = (0,1,4,2,3,4,5,6,7,8,9); tablica2: array [0..3,0..2] of Integer = ((11,12),(21,22),(31,32)); tablica3: array [5..10] of String = ('a','b','c','d','e'); G29 Tablica dynamiczna
var tablica: array of String; SetLength(tablica,2); tablica[0]:='1'; tablica[1]:='2'; G30 Zmiana czcionki fragmentu tekstu w komponentcie RichEdit
RichEdit1.SelStart:=10; RichEdit1.SelLength:=5; RichEdit1.SelAttributes.Name:='Verdana'; RichEdit1.SelAttributes.Size:=10; RichEdit1.SelAttributes.Color:=clRed; RichEdit1.SelAttributes.Style:=[fsBold,fsItalic]; uwaga: parametr SelStart określa numer pierwszego znaku natomiast SelLength długość formatowanego fragmentu tekstu G31 Zwiększenie maksymalnej pojemności komponentu RichEdit do 1 GB teskstu
RichEdit1.MaxLength:=1073741824; uwaga: wartość 1073741824 wynika z podniesienia liczby 2 do potęgi 30 G32 Utworzenie listy liter którymi oznaczone są dostępne partycje
function TForm1.ListaPartycji: String; var litera: Char; begin Result:=''; for litera:='A' to 'Z' do if GetDriveType(PChar(litera+':\'))=DRIVE_FIXED then Result:=Result+litera; end; G33 Automatyczne przerzucanie tekstu do następnej linijki w komponencie RichEdit
RichEdit1.WordWrap:=False; uwaga: właściwość tę ustawić można również w inspektorze obiektów G34 Poziomy scrollbar w komponencie ListBox
procedure TForm1.PoziomyScrollBar; var szerokosc: Integer; begin szerokosc:=0; for i:=0 to ListBox1.Items.Count-1 do if ListBox1.Canvas.TextWidth(ListBox1.Items[i])>szerokosc then szerokosc:=ListBox1.Canvas.TextWidth(ListBox1.Items[i]); SendMessage(ListBox1.Handle,LB_SETHORIZONTALEXTENT,szerokosc+5,0); end; uwaga: powyższą procedurę należy wywołać po każdej zmianie zbioru elementów (dodanie lub usunięcie) w komponencie ListBox G35 Usunięcie konkretnego wiersza z komponentów Memo i ListBox
Memo1.Lines.Delete(n); ListBox1.Items.Delete(n); G36 Białe kontenery kolorów niestandardowych w komponencie ColorDialog
ColorDialog1.CustomColors.Add('ColorA=FFFFFF'); ColorDialog1.CustomColors.Add('ColorB=FFFFFF'); ColorDialog1.CustomColors.Add('ColorC=FFFFFF'); ColorDialog1.CustomColors.Add('ColorD=FFFFFF'); ColorDialog1.CustomColors.Add('ColorE=FFFFFF'); ColorDialog1.CustomColors.Add('ColorF=FFFFFF'); ColorDialog1.CustomColors.Add('ColorG=FFFFFF'); ColorDialog1.CustomColors.Add('ColorH=FFFFFF'); ColorDialog1.CustomColors.Add('ColorI=FFFFFF'); ColorDialog1.CustomColors.Add('ColorJ=FFFFFF'); ColorDialog1.CustomColors.Add('ColorK=FFFFFF'); ColorDialog1.CustomColors.Add('ColorL=FFFFFF'); ColorDialog1.CustomColors.Add('ColorM=FFFFFF'); ColorDialog1.CustomColors.Add('ColorN=FFFFFF'); ColorDialog1.CustomColors.Add('ColorO=FFFFFF'); ColorDialog1.CustomColors.Add('ColorP=FFFFFF'); uwaga: właściwości te ustawić można również w inspektorze obiektów G37 Ustawienie tekstowego kursora w komponencie Memo w wierszu Y oraz na pozycji X
Memo1.CaretPos.Y:=Y; Memo1.CaretPos.X:=X; lub prościej: Memo1.CaretPos:=Point(X,Y); G38 Przesunięcie obszaru roboczego komponentu Memo na samą górę
SendMessage(Memo1.Handle,WM_VSCROLL,SB_TOP,0); G39 Przesunięcie obszaru roboczego komponentu Memo o 10 wierszy w dół
SendMessage(Memo1.Handle,EM_LINESCROLL,0,10); G40 Przesunięcie obszaru roboczego komponentu Memo o 10 wierszy w górę
SendMessage(Memo1.Handle,EM_LINESCROLL,0,-10); G41 Przesunięcie obszaru roboczego komponentu Memo tak aby widoczny był kursor tekstowy
SendMessage(Memo1.Handle,EM_SCROLLCARET,0,0); G42 Określenie numeru pierwszego wiersza widocznego w komponencie Memo
n:=Memo1.Perform(EM_GETFIRSTVISIBLELINE,0,0); G43 Przesunięcie obszaru roboczego kompunentu Memo tak aby n-ty wiersz był pierwszym widocznym
Memo1.Perform(EM_LINESCROLL,0,n); G44 Powiązanie komponentu FindDialog z komponentem Memo
Należy uzupełnić procedurę OnFind komponentu FindDialog o poniższe polecenia: procedure TForm1.FindDialog1Find(Sender: TObject); var szukanyTekst,przeszukiwanyTekst,komunikat: String; s1,pocz,pozycja: Integer; begin pozycja:=0; s1:=Memo1.SelStart; if Memo1.SelLength>0 then s1:=s1+1; szukanyTekst:=FindDialog1.FindText; przeszukiwanyTekst:=Memo1.Text; if FindDialog1.Options*[frMatchCase]=[] then begin szukanyTekst:=AnsiLowerCase(szukanyTekst); przeszukiwanyTekst:=AnsiLowerCase(przeszukiwanyTekst); end; if FindDialog1.Options*[frDown]=[frDown] then begin pozycja:=Pos(szukanyTekst,Copy(przeszukiwanyTekst,s1+1,Length(przeszukiwanyTekst)-s1+1)); if pozycja<>0 then pozycja:=pozycja+s1; end else begin pocz:=1; while Pos(szukanyTekst,Copy(przeszukiwanyTekst,pocz,s1-pocz+1))>0 do pocz:=Pos(szukanyTekst,Copy(przeszukiwanyTekst,pocz,s1-pocz+1))+pocz; if pocz=1 then pozycja:=0 else pozycja:=pocz-1; end; if pozycja=0 then begin; if FindDialog1.Options*[frDown]=[frDown] then komunikat:='W dół' else komunikat:='W górę'; komunikat:=komunikat+' od kursora tekstowego nie znaleziono wyrażenia "'; komunikat:=komunikat+FindDialog1.FindText+'"'; ShowMessage(komunikat); Memo1.SetFocus; end else begin Memo1.SelStart:=pozycja-1; Memo1.SelLength:=Length(FindDialog1.FindText); SendMessage(Memo1.Handle,EM_SCROLLCARET,0,0); Memo1.SetFocus; end; end; G45 Powiązanie komponentu ReplaceDialog z komponentem Memo
Należy uzupełnić procedury OnFind i OnReplace komponentu ReplaceDialog o poniższe polecenia: procedure TForm1.ReplaceDialog1Find(Sender: TObject); var szukanyTekst,przeszukiwanyTekst: String; s1,pozycja: Integer; begin pozycja:=0; s1:=Memo1.SelStart; if Memo1.SelLength>0 then s1:=s1+1; szukanyTekst:=ReplaceDialog1.FindText; przeszukiwanyTekst:=Memo1.Text; if ReplaceDialog1.Options*[frMatchCase]=[] then begin szukanyTekst:=AnsiLowerCase(szukanyTekst); przeszukiwanyTekst:=AnsiLowerCase(przeszukiwanyTekst); end; pozycja:=Pos(szukanyTekst,Copy(przeszukiwanyTekst,s1+1,Length(przeszukiwanyTekst)-s1+1)); if pozycja<>0 then pozycja:=pozycja+s1; if pozycja=0 then begin; ShowMessage('W dół od kursora tekstowego nie znaleziono wyrażenia "' +ReplaceDialog1.FindText+'"'); Memo1.SetFocus; end else begin Memo1.SelStart:=pozycja-1; Memo1.SelLength:=Length(ReplaceDialog1.FindText); SendMessage(Memo1.Handle,EM_SCROLLCARET,0,0); Memo1.SetFocus; end; end; procedure TForm1.ReplaceDialog1Replace(Sender: TObject); var szukanyTekst,przeszukiwanyTekst: String; s1,pozycja: Integer; begin pozycja:=0; s1:=Memo1.SelStart; szukanyTekst:=AnsiLowerCase(ReplaceDialog1.FindText); przeszukiwanyTekst:=AnsiLowerCase(Memo1.Text); if ReplaceDialog1.Options*[frReplaceAll]=[frReplaceAll] then begin if ReplaceDialog1.Options*[frMatchCase]=[] then Memo1.Text:=Copy(Memo1.Text,1,Memo1.SelStart) +StringReplace(Copy(Memo1.Text,Memo1.SelStart+1,Length(Memo1.Text) -Memo1.SelStart),ReplaceDialog1.FindText,ReplaceDialog1.ReplaceText, [rfReplaceAll,rfIgnoreCase]) else Memo1.Text:=Copy(Memo1.Text,1,Memo1.SelStart) +StringReplace(Copy(Memo1.Text,Memo1.SelStart+1,Length(Memo1.Text) -Memo1.SelStart),ReplaceDialog1.FindText,ReplaceDialog1.ReplaceText,[rfReplaceAll]); Memo1.SelStart:=s1; Memo1.SelLength:=0; Memo1.SetFocus; end else begin if ReplaceDialog1.Options*[frMatchCase]=[] then begin if Copy(przeszukiwanyTekst,Memo1.SelStart+1,Memo1.SelLength)=szukanyTekst then begin Memo1.Text:=Copy(Memo1.Text,1,Memo1.SelStart) +ReplaceDialog1.ReplaceText+Copy(Memo1.Text,Memo1.SelStart +Memo1.SelLength+1,Length(Memo1.Text)); s1:=s1+1; end; end else begin if Copy(Memo1.Text,Memo1.SelStart+1,Memo1.SelLength)=ReplaceDialog1.FindText then begin Memo1.Text:=Copy(Memo1.Text,1,Memo1.SelStart) +ReplaceDialog1.ReplaceText+Copy(Memo1.Text,Memo1.SelStart +Memo1.SelLength+1,Length(Memo1.Text)); s1:=s1+1; end; end; if ReplaceDialog1.Options*[frMatchCase]=[] then begin przeszukiwanyTekst:=AnsiLowerCase(Memo1.Text); pozycja:=Pos(szukanyTekst,Copy(przeszukiwanyTekst,s1+1,Length(przeszukiwanyTekst)-s1)); if pozycja<>0 then pozycja:=pozycja+s1; if pozycja=0 then begin; ShowMessage('W dół od kursora tekstowego nie znaleziono wyrażenia "' +ReplaceDialog1.FindText+'"'); Memo1.SetFocus; end else begin Memo1.SelStart:=pozycja-1; Memo1.SelLength:=Length(ReplaceDialog1.FindText); SendMessage(Memo1.Handle,EM_SCROLLCARET,0,0); Memo1.SetFocus; end; end else begin pozycja:=Pos(ReplaceDialog1.FindText,Copy(Memo1.Text,s1+1,Length(Memo1.Text)-s1)); if pozycja<>0 then pozycja:=pozycja+s1; if pozycja=0 then begin; ShowMessage('W dół od kursora tekstowego nie znaleziono wyrażenia "' +ReplaceDialog1.FindText+'"'); Memo1.SetFocus; end else begin Memo1.SelStart:=pozycja-1; Memo1.SelLength:=Length(ReplaceDialog1.FindText); SendMessage(Memo1.Handle,EM_SCROLLCARET,0,0); Memo1.SetFocus; end; end; end; end; G46 Określenie ścieżki katalogu w którym jest zainstalowany system Windows
function TForm1.SciezkaWindows: String; var wDir: array [0..255] of Char; begin GetWindowsDirectory(wDir,SizeOf(wDir)); Result:=wDir; end; G47 Określenie ścieżki katalogu systemowego
function TForm1.SciezkaSystemu: String; var wDir: array [0..255] of Char; begin GetSystemDirectory(wDir,SizeOf(wDir)); Result:=wDir; end; G48 Pole edycyjne do którego można wpisać tylko liczbę naturalną
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); begin if not ((Key in ['0'..'9']) or (Ord(Key)=8)) then Key:=#0; end; uwaga: liczba 8 jest numerem porządkowym klawisza BackSpace który również jest tym przypadku dozwolony G49 Rozbicie koloru na składowe RGB
procedure TForm1.KolorToRGB; var kolor: TColor; red,green,blue: Integer; begin kolor:=RGB(10,20,30); red:=GetRValue(kolor); green:=GetGValue(kolor); blue:=GetBValue(kolor); end; G50 Wylogowanie użytkownika, wyłączenie lub zrestartowanie komputera
function TForm1.Wyjscie(tryb: Longword): Boolean; var tTokenHd: THandle; tTokenPvg: TTokenPrivileges; cbtpPrevious: DWord; rtTokenPvg: TTokenPrivileges; pcbtpPreviousRequired: DWord; tpResult: Boolean; begin if Win32Platform=VER_PLATFORM_WIN32_NT then begin tpResult:=OpenProcessToken (GetCurrentProcess(),TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,tTokenHd); if tpResult then begin tpResult:=LookupPrivilegeValue(nil,'SeShutdownPrivilege',tTokenPvg.Privileges[0].Luid); tTokenPvg.PrivilegeCount:=1; tTokenPvg.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED; cbtpPrevious:=SizeOf(rtTokenPvg); pcbtpPreviousRequired:=0; if tpResult then Windows.AdjustTokenPrivileges (tTokenHd,False,tTokenPvg,cbtpPrevious,rtTokenPvg,pcbtpPreviousRequired); end; end; Result:=ExitWindowsEx(tryb,0); end; uwaga: aby wylogować użytkownika należy wywołać procedurę Wyjscie(EWX_LOGOFF or EWX_FORCE); uwaga: aby wyłączyć komputer należy wywołać procedurę Wyjscie(EWX_POWEROFF or EWX_FORCE); uwaga: aby ponownie uruchomić komputer należy wywołać procedurę Wyjscie(EWX_REBOOT or EWX_FORCE); G51 Precyzyjne określenie czasu pracy systemu
n:=GetTickCount; uwaga: powyższa funkcja zwraca liczbę milisekund od chwili uruchomienia komputera G52 Zmiana priorytetu programu
SetPriorityClass(GetCurrentProcess,HIGH_PRIORITY_CLASS); uwaga: dopuszczalne ustawienia priorytetu to: REALTIME_PRIORITY_CLASS - czasu rzeczywistego HIGH_PRIORITY_CLASS - wysoki NORMAL_PRIORITY_CLASS - normalny IDLE_PRIORITY_CLASS - niski uwaga: priorytet domyślny to NORMAL_PRIORITY_CLASS G53 Uruchomienie komendy wiersza poleceń
WinExec('command.com /c dir',SW_NORMAL); |
| zalecana rozdzielczość 1024x768 | copyright by Łasica |