o mnie | fotorelacje | filmy | downloads | rumszas | cykloza | miejsca | delphi | kontakt | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Operacje matematyczne 001 Zaokrąglenie liczby rzeczywistej w dół lub w górę oraz do najbliższej liczby całkowitej >> 002 Część całkowita i ułamkowa liczby rzeczywistej >> 003 Część całkowita i reszta z dzielenia liczby naturalnej n1 przez liczbę naturalną n2 >> 004 Największy wspólny dzielnik dla dwóch lub więcej liczb naturalnych >> 005 Najmniejsza wspólna wielokrotność dwóch lub więcej liczb naturalnych >> 006 Sprawdzenie czy liczba naturalna jest parzysta >> 007 Podniesienie liczby x do potęgi y >> 008 Logarytm o podstawie n z liczby x >> 009 Funkcja arctg >> 010 Funkcja arcctg >> 011 Konwersja radianów na stopnie >> 012 Konwersja stopni na radiany >> 013 Losowa liczba naturalna >> 014 Losowa liczba rzeczywista >> 015 Losowa liczba rzeczywista rozkładu Gaussa >> 016 Obliczanie odległości między dwoma współrzędnymi geograficznymi >> 017 Obliczanie godziny wschodu słońca dla danego dnia i współrzędnych geograficznych >> 018 Obliczanie godziny zachodu słońca dla danego dnia i współrzędnych geograficznych >> Operacje związane z łańcuchami String 019 Kopiowanie fragmentu łańcucha String >> 020 Kopiowanie początkowych znaków łańcucha String >> 021 Kopiowanie końcowych znaków łańcucha String >> 022 Usunięcie wewnętrznego fragmentu z łańcucha String >> 023 Usunięcie białych znaków występujących na początku i na końcu łańcucha String >> 024 Konwersja łańcucha String na małe lub na duże litery >> 025 Zamiana w łańcuchu String wszystkich łańcuchów s1 na s2 >> 026 Odwrócenie kolejności znaków w łańcuchu String >> 027 Sprawdzenie czy n-ty znak łańcucha String jest cyfrą >> 028 Sprawdzenie pierwszej pozycji ciągu znaków s1 w innym ciągu znaków s2 >> 029 Sprawdzenie ostatniej pozycji ciągu znaków s1 w innym ciągu znaków s2 >> 030 Sprawdzenie ostatniej pozycji dowolnego ze znaków a, b lub c w ciągu znaków s >> 031 Sprawdzenie czy ciąg znaków s pasuje do maski >> 032 Zmiana długości łańcucha String >> 033 Sprawdzenie czy łańcuch String jest liczbą >> 034 Sprawdzenie czy łańcuch String jest liczbą całkowitą >> 035 Sprawdzenie czy łańcuch String jest liczbą naturalną >> 036 Sprawdzenie czy łańcuch String jest liczbą heksadecymalną >> 037 Formatowanie liczby rzeczywistej na łańcuch String z zaokrągleniem >> 038 Formatowanie liczby rzeczywistej na łańcuch String z cyframi znaczącymi >> 039 Formatowanie liczby całkowitej do określonej liczby cyfr >> 040 Formatowanie łańcucha String do określonej liczby znaków z wyrównaniem do lewej lub prawej >> 041 Konwersja zapisu liczby naturalnej z systemu dziesiętnego na heksadecymalny >> 042 Konwersja zapisu liczby naturalnej z systemu heksadecymalnego na dzisiętny >> 043 Konwersja zapisu liczby naturalnej z systemu dziesiętnego na binarny >> 044 Konwersja zapisu liczby naturalnej z systemu dziesiętnego na binarny o określonej liczbie cyfr >> 045 Konwersja zapisu liczby naturalnej z systemu binarnego na dzisiętny >> 046 Konwersja łańcucha String o postaci prostej na postać heksadecymalno-bajtową >> 047 Konwersja łańcucha String o postaci heksadecymalno-bajtowej na postać prostą >> 048 Konwersja łańcucha String o postaci prostej na postać Base64 >> 049 Konwersja łańcucha String o postaci Base64 na postać prostą >> 050 Lista wszystkich możliwych permutacji znaków w łańcuchu String >> 051 Sprawdzenie liczby kolumn w wierszu z wyborem znaku separatora kolumn >> 052 Odczytanie zawartości wskazanej kolumny wiersza z wyborem znaku separatora kolumn >> 053 Sprawdzenie liczby kolumn w wierszu gdzie separatorem jest ciąg spacji >> 054 Odczytanie zawartości wskazanej kolumny wiersza gdzie separatorem jest ciąg spacji >> 055 Odczytanie lewej i prawej wartości z pary oddzielonej separatorem wieloznakowym >> 056 Odczytanie ścieżki dostępowej z pełnej ścieżki pliku lub folderu >> 057 Odczytanie nazwy pliku z jego pełnej ścieżki >> 058 Odczytanie rozszerzenia pliku z jego pełnej ścieżki >> 059 Odczytanie nazwy pliku z pominięciem rozszerzenia z jego pełnej ścieżki >> 060 Zmiana rozszerzenia pliku w ciągu znaków zawierającym jego nazwę lub pełną ścieżkę >> 061 Konwersja pełnej ścieżki pliku lub folderu do formatu DOS 8.3 >> 062 Sprawdzenie czy łańcuch String przechowuje ścieżkę pliku lub folderu >> 063 Sprawdzenie czy łańcuch String przechowuje adres IPv4 >> 064 Sprawdzenie czy łańcuch String przechowuje adres IPv6 >> 065 Sprawdzenie czy łańcuch String przechowuje adres FQDN >> 066 Sprawdzenie czy łańcuch String przechowuje datę o postaci RRRR-MM-DD >> 067 Sprawdzenie czy łańcuch String przechowuje godzinę o postaci GG:MM:SS >> 068 Sprawdzenie czy łańcuch String przechowuje czas o postaci RRRR-MM-DD GG:MM:SS >> Operacje związane z datą i czasem 069 Sprawdzenie aktualnej daty >> 070 Ustawienie wartości zmiennej TDateTime >> 071 Sprawdzenie wartości składowych zmiennej TDateTime >> 072 Sprawdzenie numeru dnia w roku, miesiącu i tygodniu dla zmiennej TDateTime >> 073 Sprawdzenie numeru tygodnia w roku dla zmiennej TDateTime >> 074 Zmiana wartości zmiennej TDateTime o zadany okres czasu >> 075 Ustawienie wartości zmiennej TDateTime na ostatnią milisekundę danego okresu >> 076 Sprawdzenie liczby dni w danym roku lub miesiącu >> 077 Sprawdzenie czy dany rok jest przestępny >> 078 Sprawdzenie kolejności dwóch zmiennych TDateTime >> 079 Sprawdzenie odstępu między dwiema zmiennymi TDateTime >> 080 Sprawdzenie aktualnego czasu UTC >> 081 Sprawdzenie czasu pracy systemu >> 082 Konwersja czasu z liczby sekund do postaci hh:mm:ss >> 083 Konwersja czasu z liczby milisekund do postaci hh:mm:ss >> 084 Konwersja czasu do postaci yyyy-mm-dd hh:mm:ss zzz >> 085 Sprawdzenie czy dany dzień wypada w okresie stosowania czasu letniego >> 086 Wstrzymanie aplikacji na zadany okres czasu >> 087 Wstrzymanie wątku na zadany okres czasu >> Operacje związane z komponentem RichEdit 088 Wyłączenie zwijania tekstu w komponencie RichEdit >> 089 Zmiana szerokości odstępów kolejnych tabulacji na krotność 8 znaków >> 090 Zwiększenie maksymalnej pojemności komponentu RichEdit do 1 GB tekstu >> 091 Prawidłowe wyświetlanie tekstu zawierającego znak "ń" w komponencie RichEdit >> 092 Zmiana sposobu kodowania tekstu w komponencie RichEdit z Windows-1250 na UTF-8 >> 093 Zmiana sposobu kodowania tekstu w komponencie RichEdit z Windows-1250 na ISO-8859-2 >> 094 Zapisanie zawartości komponentu RichEdit do pliku bez dodatkowych znaków formatu RTF >> 095 Sprawdzenie numeru wiersza z kursorem karetki i jego pozycji w komponencie RichEdit >> 096 Ustawienie kursora karetki na pozycji X w wierszu Y w komponencie RichEdit >> 097 Sprawdzenie numeru pierwszego wiersza widocznego w komponencie RichEdit >> 098 Sprawdzenie numeru ostatniego wiersza widocznego w komponencie RichEdit >> 099 Przesunięcie obszaru roboczego komponentu RichEdit na samą górę lub sam dół >> 100 Przesunięcie obszaru roboczego komponentu RichEdit o jedną stronę w górę lub w dół >> 101 Przesunięcie obszaru roboczego komponentu RichEdit o 5 wierszy w górę lub w dół >> 102 Przesunięcie obszaru roboczego komponentu RichEdit tak aby n-ty wiersz był pierwszym widocznym >> 103 Przesunięcie obszaru roboczego komponentu RichEdit tak aby widoczny był kursor karetki >> 104 Sprawdzenie oraz ustawienie pozycji suwaków komponentu RichEdit >> 105 Sprawdzenie wysokości pojedynczego wiersza w komponencie RichEdit >> 106 Zmiana czcionki fragmentu tekstu w komponencie RichEdit >> 107 Zmiana koloru tła fragmentu tekstu w komponencie RichEdit >> 108 Sprawdzenie koloru tekstu w komponencie RichEdit >> 109 Kopiowanie tekstu z komponentu RichEdit do schowka >> 110 Wklejanie tekstu do komponentu RichEdit ze schowka >> 111 Kopiowanie tekstu z komponentu RichEdit poprzez Ctrl+C jako zwykły tekst >> 112 Wklejanie tekstu do komponentu RichEdit poprzez Ctrl+V jako zwykły tekst >> 113 Wycinanie tekstu z komponentu RichEdit poprzez Ctrl+X jako zwykły tekst >> 114 Powiązanie komponentu FindDialog z komponentem RichEdit >> 115 Powiązanie komponentu ReplaceDialog z komponentem RichEdit >> 116 Wyszukiwanie tekstu w komponencie RichEdit z wykorzystaniem klawisza F3 >> 117 Wprowadzanie tabulacji w komponencie RichEdit >> 118 Przesuwalna belka dzieląca dwa komponenty RichEdit >> 119 Synchronizacja suwaków dwóch komponentów RichEdit >> 120 Zmienna TStringList jako usprawnienie komponentu RichEdit >> Operacje związane z wyglądem i zachowaniem okna aplikacji 121 Ukrycie okna aplikacji >> 122 Ukrycie paska tytułowego okna aplikacji >> 123 Ustawienie przeźroczystości dla okna aplikacji >> 124 Ustawienie trybu zawsze na wierzchu dla okna aplikacji >> 125 Zmiana tytułu aplikacji wyświetlanego na pasku zadań >> 126 Włączenie migania przycisku aplikacji na pasku zadań >> 127 Ukrycie przycisku aplikacji na pasku zadań >> 128 Blokada rozciągania okna aplikacji >> 129 Zmiana ograniczenia systemowego maksymalnych wymiarów okna aplikacji >> 130 Wywołanie akcji z chwilą maksymalizacji okna aplikacji >> 131 Blokada wybranych przycisków z prawego górnego rogu okna aplikacji >> 132 Odświeżenie wyglądu okna aplikacji >> Operacje związane z myszą i klawiaturą 133 Sprawdzenie czy klawisz ScrollLock jest wciśnięty >> 134 Wywołanie wciśnięcia klawisza na klawiaturze >> 135 Wpisanie znaków z łańcucha String w miejsce ustawienia kursora karetki >> 136 Nadpisanie akcji wykonywanej przez system po wciśnięciu określonego klawisza na klawiaturze >> 137 Blokada klawisza PrintScreen >> 138 Blokada myszy oraz blokada klawiatury >> 139 Przesunięcie kursora myszy o X w poziomie oraz Y w pionie >> 140 Kliknięcie lewym przyciskiem myszy w punkcie X od lewej i Y od góry na ekranie >> 141 Ograniczenie pola w którym może poruszać się kursor myszy >> 142 Zamiana przycisków myszy >> 143 Ukrycie kursora myszy >> Operacje związane z ekranem i pulpitem 144 Sprawdzenie wymiarów obszaru roboczego ekranu >> 145 Sprawdzenie rozdzielczości ekranu >> 146 Zmiana rozdzielczości ekranu >> 147 Zapisanie do pliku BMP widoku ekranu >> 148 Zapisanie do pliku BMP widoku aktywnego okna >> 149 Sprawdzenie czy kolor piksela na ekranie oddalonego o X od lewej oraz Y od góry jest czerwony >> 150 Zmiana tapety pulpitu >> 151 Ukrycie ikon na pulpicie >> Operacje związane z plikami i folderami 152 Sprawdzenie czy plik istnieje >> 153 Kopiowanie pliku >> 154 Zmiana nazwy pliku >> 155 Kasowanie pliku >> 156 Sprawdzenie czy folder istnieje >> 157 Tworzenie nowego folderu >> 158 Kopiowanie folderu wraz z zawartością >> 159 Przenoszenie folderu wraz z zawartością >> 160 Kasowanie pustego folderu >> 161 Kasowanie folderu w którym mogą znajdować się pliki lub podfoldery >> 162 Zmiana nazwy folderu >> 163 Sprawdzenie rozmiaru pliku w bajtach >> 164 Sprawdzenie czy dwa pliki są identyczne >> 165 Wczytanie do komponentu ListBox nazw plików typu *.roz znajdujących się w danym folderze >> 166 Wczytanie do komponentu ListBox nazw plików typu *.roz znajdujących się w folderze i jego podfolderach >> 167 Wczytanie do komponentu ListBox nazw plików i folderów po przeniesieniu ich na formę >> 168 Wczytanie do komponentu ListBox nazw plików i folderów po przeniesieniu ich na jego obszar >> 169 Wczytanie do komponentu Edit nazwy pliku lub folderu po przeniesieniu go na jego obszar >> 170 Wczytanie do komponentu ListBox nazw plików i folderów po przeniesieniu ich na ikonę aplikacji >> 171 Sortowanie listy plików w komponencie ListBox z uwzględnieniem drzewa folderów >> 172 Otwarcie folderu zawierającego wskazany plik i zaznaczenie tego pliku >> 173 Przenoszenie pliku lub folderu do kosza >> 174 Wybranie innej nazwy pliku lub folderu gdy wybrana jest zajęta >> 175 Wybranie innej nazwy folderu gdy wybrana jest zajęta >> 176 Wczytanie zawartości pliku do komponentu RichEdit >> 177 Zapisanie zawartości komponentu RichEdit do pliku >> 178 Wczytanie zawartości pliku do łańcucha String >> 179 Zapisanie łańcucha String do pliku >> 180 Zapisanie ustawień aplikacji do pliku nazwa.ini >> 181 Wczytanie ustawień aplikacji z pliku nazwa.ini >> 182 Ustawienie plikowi atrybutu tylko do odczytu >> 183 Ustawienie plikowi atrybutu ukryty >> 184 Ustawienie plikowi atrybutu systemowy >> 185 Ustawienie plikowi atrybutu archiwalny >> 186 Sprawdzenie daty utworzenia, modyfikacji i ostatniego dostępu do pliku >> 187 Zmiana daty utworzenia, modyfikacji i ostatniego dostępu do pliku >> 188 Sprawdzenie ścieżki oraz nazwy pliku exe uruchomionek aplikacji >> 189 Obsługa pliku metodą "Otwórz za pomocą..." ze wskazaniem na własną aplikację >> 190 Dodanie pliku do autostartu w rejestrze systemowym >> 191 Tworzenie pliku z zasobu TResourceStream >> 192 Tworzenie twardego linku >> 193 Wczytanie wartości wybranej komórki z pliku Excel >> Operacje związane z systemem Windows 194 Sprawdzenie wersji systemu Windows >> 195 Sprawdzenie ścieżki katalogu w którym jest zainstalowany system Windows >> 196 Sprawdzenie ścieżki katalogu systemowego >> 197 Sprawdzenie ścieżki pulpitu i innych katalogów systemowych >> 198 Wylogowanie użytkownika, wyłączenie lub zrestartowanie komputera >> 199 Wykonanie komendy w wierszu poleceń >> 200 Sprawdzenie czy istnieje klucz w rejestrze systemowym >> 201 Sprawdzenie czy istnieje wartość klucza w rejestrze systemowym >> 202 Odczytanie danych z wartości klucza w rejestrze systemowym >> 203 Dodanie wartości klucza do rejestru systemowego >> 204 Usunięcie wartości klucza z rejestru systemowego >> Operacje związane z procesami 205 Uruchomienie procesu >> 206 Uruchomienie procesu i wstrzymanie aplikacji do jego zakończenia >> 207 Sprawdzenie identyfikatora procesu aplikacji >> 208 Sprawdzenie identyfikatora procesu okna o danym uchwycie >> 209 Zmiana priorytetu procesu aplikacji >> 210 Zmiana priorytetu danego procesu >> 211 Wczytanie do komponentu ListBox informacji o wszystkich uruchomionych procesach >> 212 Wczytanie do komponentu ListBox informacji o wszystkich uruchomionych wątkach >> 213 Wczytanie do komponentu ListBox wszystkich uchwytów danego procesu >> 214 Zakończenie danego procesu >> Operacje związane z uchwytami okien 215 Wczytanie do komponentu ListBox tytułów, typów oraz uchwytów wszystkich otwartych okien >> 216 Ustalenie uchwytu i tytułu aktywnego okna >> 217 Ustalenie uchwytu okna o znanym tytule >> 218 Ustalenie uchwytu okna danego typu >> 219 Sprawdzenie czy okno o danym uchwycie istnieje >> 220 Sprawdzenie czy okno o danym uchwycie jest widoczne >> 221 Sprawdzenie czy okno o danym uchwycie jest zminimalizowane >> 222 Sprawdzenie czy okno o danym uchwycie jest zmaksymalizowane >> 223 Sprawdzenie czy okno o danym uchwycie jest w trybie zawsze na wierzchu >> 224 Zminimalizowanie lub ukrycie okna gdy znany jest jego uchwyt >> 225 Przeniesienie okna na wierzch lub na spód względem innych okien gdy znany jest jego uchwyt >> 226 Zamknięcie okna gdy znany jest jego uchwyt >> Operacje związane z siecią i Internetem 227 Sprawdzenie czy komputer jest połączony z Internetem >> 228 Sprawdzenie adresu IP komputera >> 229 Sprawdzenie wszystkich adresów IP komputera >> 230 Sprawdzenie adresu MAC karty sieciowej >> 231 Zapisanie na dysku pliku z Internetu >> 232 Zapisanie na dysku pliku z Internetu z podaniem identyfikatora aplikacji >> 233 Zapisanie na dysku pliku z Internetu z paskiem postępu pobierania i obsługą błędów >> 234 Otwarcie strony internetowej w przeglądarce domyślnej >> 235 Otwarcie strony internetowej we wskazanej przeglądarce >> 236 Wczytanie do komponentu RichEdit kodu źródłowego strony internetowej >> Pozostałe 237 Struktura pętli z użyciem polecenia break >> 238 Struktura pętli z użyciem etykiety i polecenia goto >> 239 Deklaracja tablic >> 240 Tablica dynamiczna >> 241 Ukrycie wszystkich komponentów Button na oknie aplikacji >> 242 Ustawienie kursora karetki na końcu tekstu wyświetlanego w komponencie Edit >> 243 Zaznaczenie całego tekstu z komponentu Edit poprzez Ctrl+A >> 244 Komponent Edit do którego można wpisać tylko liczbę naturalną >> 245 Powiązanie komponentów Edit i UpDown by działały jak SpinEdit >> 246 Poziomy suwak w komponencie ListBox >> 247 Przesunięcie obszaru roboczego komponentu StringGrid tak aby widoczna była komórka [x,y] >> 248 Ustawienie kursora karetki w komórce [x,y] komponentu StringGrid >> 249 Sprawdzenie szerokości i wysokości tekstu komponentu Label >> 250 Umieszczenie komponentu Label na komponencie ProgressBar >> 251 Zmiana koloru komponentu ProgressBar >> 252 Ograniczenie częstotliwości aktualizacji komponentu ProgressBar w przypadku bardzo długiej pętli >> 253 Ustawienie niestandardowego skrótu dla akcji komponentu ActionList >> 254 Białe kontenery kolorów niestandardowych w komponencie ColorDialog >> 255 Wyłączenie migania zaznaczonego komponentu ScrollBar >> 256 Wczytanie do komponentu Image obrazu z pliku JPEG >> 257 Zmiana wymiarów obrazu komponentu Image bez zmiany proporcji >> 258 Odtworzenie dźwięku w komponencie MediaPlayer >> 259 Przeniesienie skupienia (focus) na inny komponent >> 260 Dynamiczne tworzenie komponentów oraz nadpisywanie ich procedur >> 261 Odwołanie się do komponentu o danej nazwie >> 262 Konwersja koloru na składowe RGB formatu HTML >> 263 Bezwarunkowe zamknięcie aplikacji >> 264 Zamkniecie aplikacji jeżeli jest już uruchomiona jej kopia >> 265 Zamknięcie aplikacji z wyświetleniem komunikatu o błędzie krytycznym >> 266 Wyłączenie powiadomień o błędach aplikacji >> 267 Wyświetlenie komunikatu ShowMessage z podziałem tekstu na linie >> 268 Wyświetlenie komunikatu MessageBox z opcjami tak lub nie >> 269 Wyświetlenie komunikatu MessageDlg z wieloma opcjami >> 270 Zamaskowanie gwiazdkami tekstu wprowadzanego w okno InputBox >> 271 Wykonywanie wielu operacji równolegle z wykorzystaniem wątków >> 272 Sprawdzenie jakimi literami oznaczone są poszczególne partycje dysku >> 273 Sprawdzenie wolnej i całkowitej przestrzeni na dysku >> 274 Sprawdzenie numeru seryjnego partycji >> Operacje matematyczne 001 Zaokrąglenie liczby rzeczywistej w dół lub w górę oraz do najbliższej liczby całkowitej uses Math; wDol:=Floor(x); wGore:=Ceil(x); doNajblizszej:=Round(x); 002 Część całkowita i ułamkowa liczby rzeczywistej calkowita:=Int(x); calkowita:=Trunc(x); ulamkowa:=Frac(x);uwaga: funkcja Int zwraca wartość typu Extended natomiast funkcja Trunc zwraca wartość typu Int64 003 Część całkowita i reszta z dzielenia liczby naturalnej n1 przez liczbę naturalną n2 calkowita:=n1 div n2; reszta:=n1 mod n2; 004 Największy wspólny dzielnik dla dwóch lub więcej liczb naturalnych function TForm1.NWD(n1,n2: Integer): Integer; begin while (n1>0) and (n2>0) do begin if n1>n2 then n1:=n1 mod n2 else n2:=n2 mod n1; end; Result:=0; if (n1>0) and (n2=0) then Result:=n1; if (n2>0) and (n1=0) then Result:=n2; 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(n1,NWD(n2,NWD(n3,n4))); 005 Najmniejsza wspólna wielokrotność dwóch lub więcej liczb naturalnych function TForm1.NWW(n1,n2: Integer): Integer; var nn: Integer; begin nn:=n1*n2; while (n1>0) and (n2>0) do begin if n1>n2 then n1:=n1 mod n2 else n2:=n2 mod n1; end; Result:=0; if (n1>0) and (n2=0) then Result:=n1; if (n2>0) and (n1=0) then Result:=n2; if Result>0 then Result:=nn div 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(n1,NWW(n2,NWW(n3,n4))); 006 Sprawdzenie czy liczba naturalna jest parzysta if not Odd(n) then ShowMessage('Ta liczba jest parzysta');uwaga: funkcja Odd zwraca wartość True jeżeli liczba n jest nieparzysta i dlatego należy zastosować negację 007 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 (pierwiastków) 008 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 009 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 010 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 011 Konwersja radianów na stopnie function TForm1.RadianyNaStopnie(rad: Double): Double; begin Result:=(360*rad)/(2*Pi); end; 012 Konwersja stopni na radiany function TForm1.StopnieNaRadiany(sto: Double): Double; begin Result:=(sto*2*Pi)/360; end; 013 Losowa liczba naturalna procedure TForm1.FormCreate(Sender: TObject); begin Randomize; end; n:=Random(5);uwaga: powyższa funkcja zwróci losową wartość od 0 do 4 014 Losowa liczba rzeczywista procedure TForm1.FormCreate(Sender: TObject); begin Randomize; end; x:=Random;uwaga: powyższa funkcja zwróci losową liczbę z przedziału <0,1) 015 Losowa liczba rzeczywista rozkładu Gaussa procedure TForm1.FormCreate(Sender: TObject); begin Randomize; end; x:=RandG(0,1);uwaga: pierwszy parametr powyższej funkcji to wartość średnia rozkładu a drugi to odchylenie standardowe 016 Obliczanie odległości między dwoma współrzędnymi geograficznymi function TForm1.OdlegloscGeograficzna(lat1,lat2,lon1,lon2: Double): Double; var rmax,rmin,r,a,b,lon11,lon22: Double; begin rmax:=6378.24; rmin:=6356.86; lon11:=lon1; lon22:=lon2; if lon1-lon2>180 then begin lon11:=180-lon1; lon22:=-180-lon2; end; if lon2-lon1>180 then begin lon11:=-180-lon1; lon22:=180-lon2; end; r:=(rmax-(rmax-rmin)*Sin((lat1+lat2)*Pi/360)); a:=(lon22-lon11)*Cos(lat1*Pi/180); b:=(lat2-lat1); Result:=Sqrt(a*a+b*b)*Pi*r/0.18; end;uwaga: parametry lat1, lat2, lon1 i lon2 to odpowiednio szerokość i długość geograficzna dwóch punktów uwaga: dopuszczalne wartości to od -180 do 180 dla długości i od -90 do 90 dla szerokości geograficznej uwaga: parametr rmax określa promień Ziemi na równiku, zaś rmin na biegunach uwaga: wynik podawany jest w metrach 017 Obliczanie godziny wschodu słońca dla danego dnia i współrzędnych geograficznych uses Math; function TForm1.WschodSlonca(r,m,d: Integer; szer,dlug: Double): String; var wHour,wMin: String; j,cent,l,g,o,f,e,a,c,w: Double; begin j:=367*r-Int(7*(r+Int((m+9)/12))/4)+Int(275*m/9)+d-730531.5; cent:=j/36525; l:=4.8949504201433+628.331969753199*cent; while l>6.28318530718 do l:=l-6.28318530718; g:=6.2400408+628.3019501*cent; while g>6.28318530718 do g:=g-6.28318530718; o:=0.409093-0.0002269*cent; f:=0.033423*Sin(g)+0.00034907*Sin(2*g); e:=0.0430398*Sin(2*(l+f))-0.00092502*Sin(4*(l+f))-f; a:=ArcSin(Sin(o)*Sin(f+l)); c:=(Sin(0.017453293*-0.833)-Sin(0.017453293*szer)*Sin(a))/(Cos(0.017453293*szer)*Cos(a)); w:=(Pi-(e+0.017453293*dlug+1*ArcCos(c)))*57.29577951/15; wHour:=FloatToStr(Floor(w)+(Round(60*Frac(w)) div 60)); if Length(wHour)=1 then wHour:='0'+wHour; wMin:=FloatToStr(Round(60*Frac(w)) mod 60); if Length(wMin)=1 then wMin:='0'+wMin; Result:=wHour+':'+wMin; end;uwaga: powyższa funkcja zwraca godzinę w formacie czasu uniwersalnego (UTC) 018 Obliczanie godziny zachodu słońca dla danego dnia i współrzędnych geograficznych uses Math; function TForm1.ZachodSlonca(r,m,d: Integer; szer,dlug: Double): String; var zHour,zMin: String; j,cent,l,g,o,f,e,a,c,z: Double; begin j:=367*r-Int(7*(r+Int((m+9)/12))/4)+Int(275*m/9)+d-730531.5; cent:=j/36525; l:=4.8949504201433+628.331969753199*cent; while l>6.28318530718 do l:=l-6.28318530718; g:=6.2400408+628.3019501*cent; while g>6.28318530718 do g:=g-6.28318530718; o:=0.409093-0.0002269*cent; f:=0.033423*Sin(g)+0.00034907*Sin(2*g); e:=0.0430398*Sin(2*(l+f))-0.00092502*Sin(4*(l+f))-f; a:=ArcSin(Sin(o)*Sin(f+l)); c:=(Sin(0.017453293*-0.833)-Sin(0.017453293*szer)*Sin(a))/(Cos(0.017453293*szer)*Cos(a)); z:=(Pi-(e+0.017453293*dlug+(-1)*ArcCos(c)))*57.29577951/15; zHour:=FloatToStr(Floor(z)+(Round(60*Frac(z)) div 60)); if Length(zHour)=1 then zHour:='0'+zHour; zMin:=FloatToStr(Round(60*Frac(z)) mod 60); if Length(zMin)=1 then zMin:='0'+zMin; Result:=zHour+':'+zMin; end;uwaga: powyższa funkcja zwraca godzinę w formacie czasu uniwersalnego (UTC) Operacje związane z łańcuchami String 019 Kopiowanie fragmentu łańcucha String s:=Copy(s,5,3)uwaga: powyższe polecenie kopiuje 3 znaki począwszy od 5-go (czyli 5-ty, 6-ty i 7-my) 020 Kopiowanie początkowych znaków łańcucha String uses StrUtils; s:=LeftStr(s,3);uwaga: powyższe polecenie kopiuje 3 początkowe znaki 021 Kopiowanie końcowych znaków łańcucha String uses StrUtils; s:=RightStr(s,3);uwaga: powyższe polecenie kopiuje 3 końcowe znaki 022 Usunięcie wewnętrznego fragmentu z łańcucha String Delete(s,2,5);uwaga: powyższe polecenie usuwa 5 znaków począwszy od 2-go 023 Usunięcie białych znaków występujących na początku i na końcu łańcucha String s:=Trim(s);uwaga: powyższe polecenie usuwa spacje oraz znaki kontrolne (np. tabulacja) uwaga: by usunąć tylko początkowe białe znaki należy zastosować następujące polecenie: s:=TrimLeft(s);uwaga: by usunąć tylko końcowe białe znaki należy zastosować następujące polecenie: s:=TrimRight(s); 024 Konwersja łańcucha 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); 025 Zamiana w łańcuchu String wszystkich łańcuchó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]);uwaga: by zamienić tylko pierwsze wystąpienie ciągu s1 to należy zastosować następujące polecenie: s:=StringReplace(s,s1,s2,[]); 026 Odwrócenie kolejności znaków w łańcuchu String uses StrUtils; s:=ReverseString(s); 027 Sprawdzenie czy n-ty znak łańcucha String jest cyfrą function TForm1.CzyCyfra(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; 028 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 uwaga: w przypadku sprawdzania pozycji pojedynczego znaku c szybciej zadziała poniższa funkcja: function TForm1.CharPos(c: Char; s: String): Integer; var i: Integer; begin Result:=0; for i:=1 to Length(s) do if s[i]=c then begin Result:=i; break; end; end;uwaga: powyższa funkcja zadziała analogicznie jak wywołanie Pos(c,s) ale szybciej zwróci wynik 029 Sprawdzenie ostatniej pozycji ciągu znaków s1 w innym ciągu znaków s2 uses StrUtils; function TForm1.LastPos(s1,s2: String): Integer; begin Result:=Pos(ReverseString(s1),ReverseString(s2)); if Result<>0 then Result:=Length(s2)-Length(s1)-Result+2; end;uwaga: powyższa funkcja zwraca liczbę 0 jeżeli ciąg znaków s2 nie zawiera ani jednego ciągu znaków s1 030 Sprawdzenie ostatniej pozycji dowolnego ze znaków a, b lub c w 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 031 Sprawdzenie czy ciąg znaków s pasuje do maski function TForm1.CzyPasujeDoMaski(maska,s: String; znakS,znakM: Integer): Boolean; begin if Length(maska)>znakM then begin case maska[znakM+1] of '*': begin Result:=CzyPasujeDoMaski(maska,s,znakS,znakM+1) or ((Length(s)>znakS) and CzyPasujeDoMaski(maska,s,znakS+1,znakM)); end; '?': begin if Length(s)>znakS then Result:=CzyPasujeDoMaski(maska,s,znakS+1,znakM+1) else Result:=False; end; else begin if (Length(s)>znakS) and (s[znakS+1]=maska[znakM+1]) then Result:=CzyPasujeDoMaski(maska,s,znakS+1,znakM+1) else Result:=False; end; end; end else begin if Length(s)>znakS then Result:=False else Result:=True; end; end;uwaga: w masce znak zapytania zastępuje dokładnie jeden dowolny znak a gwiazdka dowolny ciąg znaków (również pusty) uwaga: funkcja działa rekurencyjnie i przy wywołaniu należy przypisać wartościom znakS i znakM liczbę 0 uwaga: poniżej funkcja alternatywna (niedopracowana i nieco wolniejsza ale umożliwiająca stosowanie zestawu znaków): uses Masks; function TForm1.CzyPasujeDoMaski(maska,s: String): Boolean; begin s:='a'+s+'z'; maska:='a'+maska+'z'; maska:=StringReplace(maska,'[','[[]',[rfReplaceAll]); Result:=MatchesMask(s,maska); end;uwaga: w powyższej funkcji przy sprawdzaniu dopasowania nie jest brana pod uwagę wielkość liter uwaga: wstawienie znaku "[" w nawias kwadratowy wyłącza jego specjalne znaczenie (określanie zestawu znaków) uwaga: dodanie litery na początku i końcu rozwiązuje błąd dopasowania dla niektórych postaci maski 032 Zmiana długości łańcucha String SetLength(s,5);uwaga: w przypadku gdy łańcuch będzie dłuższy to końcowe znaki zostaną usunięte uwaga: w przypadku gdy łańcuch będzie krótszy to polecenie wydłuży go do 5 znaków (dodając znaki przypadkowe) uwaga: w łańcuchu String znaki indeksowane są od 1 zaś komórka o indeksie 0 przechowuje długość łańcucha 033 Sprawdzenie czy łańcuch String jest liczbą function TForm1.CzyLiczba(s: String): Boolean; begin if StrToFloatDef(s,0)=StrToFloatDef(s,1) then Result:=True else Result:=False; end; 034 Sprawdzenie czy łańcuch String jest liczbą całkowitą function TForm1.CzyLiczbaCalkowita(s: String): Boolean; begin if StrToIntDef(s,0)=StrToIntDef(s,1) then Result:=True else Result:=False; end; 035 Sprawdzenie czy łańcuch String jest liczbą naturalną function TForm1.CzyLiczbaNaturalna(s: String): Boolean; begin if StrToIntDef(s,-1)<0 then Result:=False else Result:=True; end; 036 Sprawdzenie czy łańcuch String jest liczbą heksadecymalną function TForm1.CzyLiczbaHex(s: String): Boolean; var i: Integer; begin Result:=True; if s='' then Result:=False else for i:=1 to Length(s) do if not (AnsiLowerCase(s)[i] in ['0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f']) then Result:=False; end; 037 Formatowanie liczby rzeczywistej na łańcuch String z zaokrągleniem s:=FormatFloat('0.000',1234.5678);uwaga: w powyższym przykładzie (zaokrąglenie do 3 cyfr po przecinku) wynikiem będzie 1234.568 038 Formatowanie liczby rzeczywistej na łańcuch String z cyframi znaczącymi s:=FloatToStrF(1234.5678,ffFixed,4,3);uwaga: w powyższym przykładzie (3 cyfry po przecinku ale tylko 4 cyfry znaczące) wynikiem będzie 1235.000 039 Formatowanie liczby całkowitej do określonej liczby cyfr function TForm1.OLC(n,c: Integer): String; begin Result:=IntToStr(n); while Length(Result)<c do Result:='0'+Result; end; 040 Formatowanie łańcucha String do określonej liczby znaków z wyrównaniem do lewej lub prawej function TForm1.OLZwL(s: String; c: Integer): String; begin Result:=s; while Length(Result)<c do Result:=Result+' '; end; function TForm1.OLZwP(s: String; c: Integer): String; begin Result:=s; while Length(Result)<c do Result:=' '+Result; end; 041 Konwersja zapisu liczby naturalnej z systemu dziesiętnego na heksadecymalny hex:=IntToHex(n,1);uwaga: wartość 1 określa minimalną liczbę znaków 042 Konwersja zapisu liczby naturalnej z systemu heksadecymalnego na dzisiętny n:=StrToInt64('$'+hex); 043 Konwersja zapisu liczby naturalnej z systemu dziesiętnego na binarny function TForm1.DecToBin(n: Integer): String; begin Result:=''; while n>0 do begin if Odd(n) then Result:='1'+Result else Result:='0'+Result; n:=n shr 1; end; end; 044 Konwersja zapisu liczby naturalnej z systemu dziesiętnego na binarny o określonej liczbie cyfr function TForm1.DecToBinOLC(n,c: Integer): String; begin Result:=''; while n>0 do begin if Odd(n) then Result:='1'+Result else Result:='0'+Result; n:=n shr 1; end; while Length(Result)<c do Result:='0'+Result; end;uwaga: zmiennej c należy przypisać liczbę cyfr (bitów) 045 Konwersja zapisu liczby naturalnej z systemu binarnego na dzisiętny function TForm1.BinToDec(b: String): Integer; var i,p2: Integer; begin Result:=0; p2:=1; for i:=Length(b) downto 1 do begin if b[i]='1' then Result:=Result+p2; p2:=p2*2; end; end; 046 Konwersja łańcucha String o postaci prostej na postać heksadecymalno-bajtową function TForm1.StringToHexBytes(s: String): String; var i: Integer; begin Result:=''; for i:=1 to Length(s) do Result:=Result+IntToHex(Ord(s[i]),2); end; 047 Konwersja łańcucha String o postaci heksadecymalno-bajtowej na postać prostą function TForm1.HexBytesToString(hexB: String): String; var n: Integer; begin Result:=''; n:=1; while (Length(Result)=n-1) and (Length(hexB)>=n*2) and (Ord(hexB[n*2-1]) in [48..57,65..70,97..102]) and (Ord(hexB[n*2]) in [48..57,65..70,97..102]) do begin Result:=Result+Chr(StrToInt64('$'+hexB[n*2-1]+hexB[n*2])); n:=n+1; end; if Length(Result)*2<Length(hexB) then Result:=''; end; 048 Konwersja łańcucha String o postaci prostej na postać Base64 const znaki64='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/'; function TForm1.ZakodujBase64(s: String): String; var i,a,b,c,n: Integer; begin Result:=s+s; n:=0; a:=0; b:=0; for i:=1 to Length(s) do begin c:=Ord(s[i]); b:=b*256+c; a:=a+8; while a>=6 do begin a:=a-6; c:=b div (1 shl a); b:=b mod (1 shl a); n:=n+1; Result[n]:=znaki64[c+1]; end; end; if a>0 then begin c:=b shl (6-a); n:=n+1; Result[n]:=znaki64[c+1]; end; SetLength(Result,n); end; 049 Konwersja łańcucha String o postaci Base64 na postać prostą const znaki64='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/'; function TForm1.OdkodujBase64(s: String): String; var i,a,b,c,n: Integer; begin Result:=s; n:=0; a:=0; b:=0; for i:=1 to Length(s) do begin c:=Pos(s[i],znaki64)-1; if c>=0 then begin b:=b*64+c; a:=a+6; if a>=8 then begin a:=a-8; c:=b shr a; b:=b mod (1 shl a); c:=c mod 256; n:=n+1; Result[n]:=Chr(c); end; end; end; SetLength(Result,n); end; 050 Lista wszystkich możliwych permutacji znaków w łańcuchu String procedure TForm1.Permutacje(s: String; k: Integer); var i: Integer; cTemp: Char; begin if k=1 then begin RichEdit1.Lines.Add(s); end else begin for i:=1 to k do begin cTemp:=s[k]; s[k]:=s[i]; s[i]:=cTemp; Permutacje(s,k-1); Tempc:=s[k]; s[k]:=s[i]; s[i]:=cTemp; end; end; end;uwaga: funkcja działa rekurencyjnie i przy wywołaniu należy przypisać wartości k długość zmiennej s 051 Sprawdzenie liczby kolumn w wierszu z wyborem znaku separatora kolumn function TForm1.LiczbaKolumn(s,sep: String): Integer; var i: Integer; begin Result:=1; for i:=1 to Length(s) do if s[i]=sep then Result:=Result+1; end;uwaga: zmiennej sep przypisać należy znak który traktowany będzie jako separator kolumn (np. średnik) uwaga: funkcja stosuje format CSV (np. gdy separatorem jest średnik to ciąg znaków ";tekst;" zawiera 3 kolumny) 052 Odczytanie zawartości wskazanej kolumny wiersza z wyborem znaku separatora kolumn function TForm1.KolumnaNta(s,sep: String; n: Integer): String; var n2,p,k: Integer; begin Result:=''; if n>0 then begin s:=sep+s; n2:=0; p:=1; k:=1; while (n2<n) and (p<Length(s)) do begin p:=k; k:=p+1; while (k<=Length(s)) and (s[k]<>sep) do k:=k+1; n2:=n2+1; end; Result:=Copy(s,p+1,k-p-1); end; end;uwaga: zmiennej sep przypisać należy znak który traktowany będzie jako separator kolumn (np. średnik) uwaga: funkcja stosuje format CSV (np. gdy separatorem jest średnik to ciąg znaków ";tekst;" zawiera 3 kolumny) 053 Sprawdzenie liczby kolumn w wierszu gdzie separatorem jest ciąg spacji function TForm1.LiczbaKolumnSpacje(s: String): Integer; var i: Integer; begin Result:=0; s:=s+' '; for i:=1 to Length(s)-1 do if (s[i]<>' ') and (s[i+1]=' ') then Result:=Result+1; end;uwaga: powyższa funkcja traktuje wielokrotne powtórzenie spacji jako jeden separator uwaga: funkcja stosuje format tekstowy (np. ciąg znaków " tekst tekst " zawiera 2 kolumny) 054 Odczytanie zawartości wskazanej kolumny wiersza gdzie separatorem jest ciąg spacji function TForm1.KolumnaNtaSpacje(s: String; n: Integer): String; var n2,p,k: Integer; begin Result:=''; if n>0 then begin s:=' '+s; n2:=0; p:=1; while (n2<n) and (p<Length(s)) do begin while (p<Length(s)) and (s[p]=' ') do p:=p+1; if s[p]<>' ' then n2:=n2+1; k:=p; while (k<Length(s)) and (s[k+1]<>' ') do k:=k+1; if n2=n then Result:=Copy(s,p,k-p+1) else p:=k+1; end; end; end;uwaga: powyższa funkcja traktuje wielokrotne powtórzenie spacji jako jeden separator uwaga: funkcja stosuje format tekstowy (np. ciąg znaków " tekst tekst " zawiera 2 kolumny) 055 Odczytanie lewej i prawej wartości z pary oddzielonej separatorem wieloznakowym function TForm1.WartoscLewa(s,sep: String): String; begin if Pos(sep,s)>0 then Result:=Copy(s,1,Pos(sep,s)-1) else Result:=s; end; function TForm1.WartoscPrawa(s,sep: String): String; begin if Pos(sep,s)>0 then Result:=Copy(s,Pos(sep,s)+Length(sep),Length(s)-Pos(sep,s)-Length(sep)+1) else Result:=''; end;uwaga: zmiennej sep przypisać należy ciąg znaków który traktowany będzie jako separator uwaga: przykładowo wywołanie WartoscPrawa('przyczyna => skutek',' => ') zwróci ciąg znaków "skutek" 056 Odczytanie ścieżki dostępowej z pełnej ścieżki pliku lub folderu s:=ExtractFilePath('C:\sciezka\nazwa.roz'); 057 Odczytanie nazwy pliku z jego pełnej ścieżki s:=ExtractFileName('C:\sciezka\nazwa.roz'); 058 Odczytanie rozszerzenia pliku z jego pełnej ścieżki s:=ExtractFileExt('C:\sciezka\nazwa.roz');uwaga: powyższa funkcja zwraca również kropkę zatem wynikiem powyższego przykładu będzie ".roz" 059 Odczytanie nazwy pliku z pominięciem rozszerzenia z jego pełnej ścieżki function TForm1.BezRozszerzenia(s: String): String; begin Result:=ExtractFileName(Copy(s,1,Length(s)-Length(ExtractFileExt(s)))); end; 060 Zmiana rozszerzenia pliku w ciągu znaków zawierającym jego nazwę lub pełną ścieżkę s:=ChangeFileExt('C:\sciezka\nazwa.roz1','.roz2'); 061 Konwersja pełnej ścieżki pliku lub folderu do formatu DOS 8.3 function TForm1.SciezkaDOS83(s: String): String; var dos83: String; dlugosc: Integer; begin SetLength(dos83,MAX_PATH); dlugosc:=GetShortPathName(PChar(s),PChar(dos83),MAX_PATH-1); SetLength(dos83,dlugosc); Result:=dos83; end;uwaga: przykładowo dla ścieżki C:\Documents and Settings\Administrator wynikiem będzie C:\DOCUME~1\ADMINI~1 uwaga: konwertowana ścieżka musi wskazywać na istniejący plik lub folder 062 Sprawdzenie czy łańcuch String przechowuje ścieżkę pliku lub folderu function TForm1.CzySciezkaPoprawna(s: String): Boolean; begin if (Pos(':',s)=2) and (LastDelimiter(':',s)=2) then Result:=True else Result:=False; if (Result) and (not (s[1] in ['a'..'z','A'..'Z'])) then Result:=False; if (Result) and (Length(s)>2) and (s[3]<>'\') then Result:=False; if (Result) and (Pos('\\',s)>0) then Result:=False; if (Result) and (Pos('.\',s)>0) then Result:=False; if (Result) and (Pos(' \',s)>0) then Result:=False; if (Result) and (s[Length(s)]='.') then Result:=False; if (Result) and (s[Length(s)]=' ') then Result:=False; if (Result) and (LastDelimiter('/*?"<>|',s)>0) then Result:=False; end; 063 Sprawdzenie czy łańcuch String przechowuje adres IPv4 function TForm1.CzyAdresIPv4(ip: String): Boolean; begin Result:=True; if not (StrToIntDef(Copy(ip,1,Pos('.',ip)-1),256) in [0..255]) then Result:=False; ip:=Copy(ip,Pos('.',ip)+1,Length(ip)-Pos('.',ip)); if not (StrToIntDef(Copy(ip,1,Pos('.',ip)-1),256) in [0..255]) then Result:=False; ip:=Copy(ip,Pos('.',ip)+1,Length(ip)-Pos('.',ip)); if not (StrToIntDef(Copy(ip,1,Pos('.',ip)-1),256) in [0..255]) then Result:=False; if not (StrToIntDef(Copy(ip,Pos('.',ip)+1,Length(ip)-Pos('.',ip)),256) in [0..255]) then Result:=False; end; 064 Sprawdzenie czy łańcuch String przechowuje adres IPv6 function TForm1.CzyAdresIPv6(ip: String): Boolean; var n,liczbaDwukropkow,dlugoscBloku: Integer; podwojnyDwukropek: Boolean; begin if Length(ip)>39 then Result:=False else Result:=True; n:=1; while (Result) and (n<=Length(ip)) do begin if not (ip[n] in ['0'..'9','a'..'f','A'..'F',':']) then Result:=False; n:=n+1; end; n:=1; dlugoscBloku:=0; liczbaDwukropkow:=0; podwojnyDwukropek:=False; while (Result) and (n<=Length(ip)) do begin if ip[n]=':' then begin liczbaDwukropkow:=liczbaDwukropkow+1; if liczbaDwukropkow>7 then Result:=False; if (dlugoscBloku=0) and (podwojnyDwukropek) then Result:=False; if (dlugoscBloku=0) and (not podwojnyDwukropek) and (n>1) then podwojnyDwukropek:=True; dlugoscBloku:=0; end else begin dlugoscBloku:=dlugoscBloku+1; if dlugoscBloku>4 then Result:=False; end; n:=n+1; end; if (liczbaDwukropkow<7) and (not podwojnyDwukropek) then Result:=False; end; 065 Sprawdzenie czy łańcuch String przechowuje adres FQDN function TForm1.CzyAdresFQDN(fqdn: String): Boolean; var n,dlugoscBloku: Integer; begin if (Length(fqdn) in [1..253]) and (Ord(fqdn[1]) in [48..57,65..90,97..122]) then Result:=True else Result:=False; n:=1; dlugoscBloku:=1; while Result and (n<Length(fqdn)) do begin n:=n+1; if (not (Ord(fqdn[n]) in [45,46,48..57,65..90,97..122])) then Result:=False; if ((fqdn[n]='.') or (fqdn[n]='-')) and ((fqdn[n-1]='.') or (fqdn[n-1]='-')) then Result:=False; if fqdn[n]='.' then dlugoscBloku:=0 else dlugoscBloku:=dlugoscBloku+1; if dlugoscBloku>63 then Result:=False; end; if (dlugoscBloku=n) or (fqdn[n]='.') or (fqdn[n]='-') then Result:=False; end; 066 Sprawdzenie czy łańcuch String przechowuje datę o postaci RRRR-MM-DD uses DateUtils; function TForm1.CzyRRRRMMDD(s: String): Boolean; begin if (Length(s)=10) and (s[5]='-') and (s[8]='-') and (IsValidDate(StrToIntDef(Copy(s,1,4),-1),StrToIntDef(Copy(s,6,2),-1) ,StrToIntDef(Copy(s,9,2),-1))) then Result:=True else Result:=False; end; 067 Sprawdzenie czy łańcuch String przechowuje godzinę o postaci GG:MM:SS uses DateUtils; function TForm1.CzyGGMMSS(s: String): Boolean; begin if (Length(s)=8) and (s[3]=':') and (s[6]=':') and (IsValidTime(StrToIntDef(Copy(s,1,2),-1),StrToIntDef(Copy(s,4,2),-1) ,StrToIntDef(Copy(s,7,2),-1),0)) then Result:=True then Result:=False; end; 068 Sprawdzenie czy łańcuch String przechowuje czas o postaci RRRR-MM-DD GG:MM:SS uses DateUtils; function TForm1.CzyDataGodzina(s: String): Boolean; begin if (Length(s)=19) and (s[5]='-') and (s[8]='-') and (s[11]=' ') and (s[14]=':') and (s[17]=':') and (IsValidDate(StrToIntDef(Copy(s,1,4),-1),StrToIntDef(Copy(s,6,2),-1) ,StrToIntDef(Copy(s,9,2),-1))) and (IsValidTime(StrToIntDef(Copy(s,12,2),-1),StrToIntDef(Copy(s,15,2),-1) ,StrToIntDef(Copy(s,18,2),-1),0)) then Result:=True else Result:=False; end; Operacje związane z datą i czasem 069 Sprawdzenie aktualnej daty s1:=DateToStr(Now)+' '+TimeToStr(Now); s2:=DateTimeToStr(Now); 070 Ustawienie wartości zmiennej TDateTime uses DateUtils; dt:=EncodeDateTime(1999,12,31,23,59,59,0); 071 Sprawdzenie wartości składowych zmiennej TDateTime uses DateUtils; n:=YearOf(dt); n:=MonthOf(dt); n:=WeekOf(dt); n:=DayOf(dt); n:=HourOf(dt); n:=MinuteOf(dt); n:=SecondOf(dt); n:=MilliSecondOf(dt); 072 Sprawdzenie numeru dnia w roku, miesiącu i tygodniu dla zmiennej TDateTime uses DateUtils; n:=DayOfTheYear(dt); n:=DayOfTheMonth(dt); n:=DayOfTheWeek(dt);uwaga: w przypadku funkcji DayOfTheWeek pierwszym dniem tygodnia jest poniedziałek uwaga: w przypadku alternatywnej funkcji DayOfWeek pierwszym dniem tygodnia jest niedziela 073 Sprawdzenie numeru tygodnia w roku dla zmiennej TDateTime uses DateUtils; n:=WeekOfTheYear(Now); 074 Zmiana wartości zmiennej TDateTime o zadany okres czasu uses DateUtils; dt:=IncYear(dt,-1); dt:=IncMonth(dt,1); dt:=IncDay(dt,2); dt:=IncHour(dt,3); dt:=IncMinute(dt,4); dt:=IncSecond(dt,5); dt:=IncMilliSecond(dt,6);uwaga: dodatnia liczba jednostek czasu powoduje przesunięcie w stronę przyszłości a ujemna w stronę przeszłości 075 Ustawienie wartości zmiennej TDateTime na ostatnią milisekundę danego okresu uses DateUtils; dt:=EndOfTheYear(dt); dt:=EndOfTheMonth(dt); dt:=EndOfTheWeek(dt); dt:=EndOfTheDay(dt); dt:=EndOfAYear(1999); dt:=EndOfAMonth(1999,12); dt:=EndOfAWeek(1999,52); dt:=EndOfADay(1999,12,31) 076 Sprawdzenie liczby dni w danym roku lub miesiącu uses DateUtils; n:=DaysInMonth(dt); n:=DaysInYear(dt); n:=DaysInAYear(1999); n:=DaysInAMonth(1999,12); 077 Sprawdzenie czy dany rok jest przestępny if IsLeapYear(1999) then ShowMessage('Ten rok jest przestępny') else ShowMessage('Ten rok nie jest przestępny'); 078 Sprawdzenie kolejności dwóch zmiennych TDateTime uses DateUtils; n:=CompareDateTime(dt1,dt2);uwaga: powyższa funkcja zwraca wartość -1 gdy dt1 jest przed dt2, wartość 1 gdy jest przeciwnie, a wartość 0 gdy są równe 079 Sprawdzenie odstępu między dwiema zmiennymi TDateTime uses DateUtils; n:=YearsBetween(dt1,dt2); n:=MonthsBetween(dt1,dt2); n:=WeeksBetween(dt1,dt2); n:=DaysBetween(dt1,dt2); n:=HoursBetween(dt1,dt2); n:=MinutesBetween(dt1,dt2); n:=SecondsBetween(dt1,dt2); n:=MilliSecondsBetween(dt1,dt2); x:=YearSpan(dt1,dt2); x:=MonthSpan(dt1,dt2); x:=WeekSpan(dt1,dt2); x:=DaySpan(dt1,dt2); x:=HourSpan(dt1,dt2); x:=MinuteSpan(dt1,dt2); x:=SecondSpan(dt1,dt2); x:=MiliSecondSpan(dt1,dt2);uwaga: powyższe funkcje zwracają wartość bezwzględną (bez znaku) uwaga: funkcje z grupy Between zwracają liczbę całkowitą (z zaokrągleniem w dół) uwaga: funkcje z grupy Span zwracają liczbę rzeczywistą (z ułamkiem po przecinku) 080 Sprawdzenie aktualnego czasu UTC function TForm1.CzasUTC: TDateTime; var sdt: TSystemTime; begin GetSystemTime(sdt); Result:=SystemTimeToDateTime(sdt); end; 081 Sprawdzenie czasu pracy systemu n:=GetTickCount;uwaga: powyższa funkcja zwraca liczbę milisekund od chwili uruchomienia komputera 082 Konwersja czasu z liczby sekund do postaci hh:mm:ss function TForm1.SekundyHHMMSS(n: Integer): String; begin Result:=IntToStr(n mod 60); if Length(Result)=1 then Result:='0'+Result; Result:=IntToStr((n mod 3600) div 60)+':'+Result; if Length(Result)=4 then Result:='0'+Result; Result:=IntToStr(n div 3600)+':'+Result; if Length(Result)=7 then Result:='0'+Result; end; 083 Konwersja czasu z liczby milisekund do postaci hh:mm:ss function TForm1.MilisekundyHHMMSS(ms: Integer): String; var h,m,s: Integer; begin h:=ms div 3600000; m:=(ms mod 3600000) div 60000; s:=((ms mod 3600000) mod 60000) div 1000; Result:=Format('%s:%s:%s',[FormatFloat('00',h),FormatFloat('00',m),FormatFloat('00',s)]); end; 084 Konwersja czasu do postaci yyyy-mm-dd hh:mm:ss zzz s:=FormatDateTime('yyyy-mm-dd hh:mm:ss zzz',Now); 085 Sprawdzenie czy dany dzień wypada w okresie stosowania czasu letniego uses DateUtils; function TForm1.CzyCzasLetni(dt: TDateTime): Boolean; var i: Integer; start,stop: TDateTime; tzi: TTimeZoneInformation; begin GetTimeZoneInformation(tzi); start:=EncodeDateTime(YearOf(dt),tzi.DaylightDate.wMonth,1 ,tzi.DaylightDate.wHour,tzi.DaylightDate.wMinute,tzi.DaylightDate.wSecond,0); if tzi.DaylightDate.wDay=5 then begin start:=DateOf(EndOfTheMonth(start))+TimeOf(start); while Pred(DayOfWeek(start))<>tzi.DaylightDate.wDayOfWeek do start:=IncDay(start,-1) end else begin while Pred(DayOfWeek(start))<>tzi.DaylightDate.wDayOfWeek do start:=IncDay(start); for i:=1 to Pred(tzi.DaylightDate.wDay) do start:=IncWeek(start) end; stop:=EncodeDateTime(YearOf(dt),tzi.StandardDate.wMonth,1 ,tzi.StandardDate.wHour,tzi.StandardDate.wMinute,tzi.StandardDate.wSecond,0); if tzi.StandardDate.wDay=5 then begin stop:=DateOf(EndOfTheMonth(stop))+TimeOf(stop); while Pred(DayOfWeek(stop))<>tzi.StandardDate.wDayOfWeek do stop:=IncDay(stop,-1) end else begin while Pred(DayOfWeek(stop))<>tzi.StandardDate.wDayOfWeek do stop:=IncDay(stop); for i:=1 to Pred(tzi.StandardDate.wDay) do stop:=IncWeek(stop) end; Result:=(dt>=start) and (dt<stop); end; 086 Wstrzymanie aplikacji na zadany okres czasu Sleep(1000);uwaga: parametr powyższej funkcji to czas wstrzymania w milisekundach uwaga: powyższa procedura powoduje zamrożenie okna aplikacji 087 Wstrzymanie wątku na zadany okres czasu procedure TForm1.DelayMS(ms: Cardinal); var t0: Cardinal; begin t0:=GetTickCount; while (GetTickCount<t0+ms) do begin Application.ProcessMessages; Sleep(1); end; end;uwaga: powyższa procedura nie powoduje zamrożenia okna aplikacji Operacje związane z komponentem RichEdit 088 Wyłączenie zwijania tekstu w komponencie RichEdit RichEdit1.WordWrap:=False;uwaga: właściwość tę ustawić można również w inspektorze obiektów 089 Zmiana szerokości odstępów kolejnych tabulacji na krotność 8 znaków procedure TForm1.UstawSzerokoscTabulacjiRichEdit(re: TObject; liczbaZnakow: Integer); var pf: TParaFormat; i,szerokoscZnaku: Integer; begin FillChar(pf,SizeOf(pf),0); pf.cbSize:=SizeOf(pf); pf.dwMask:=PFM_TABSTOPS; pf.cTabCount:=32; Canvas.Font.Assign((re as TRichEdit).SelAttributes); szerokoscZnaku:=(Canvas.TextWidth('12345678')*1440) div (Screen.PixelsPerInch*Length('12345678')); for i:=1 to pf.cTabCount do pf.rgxTabs[i]:=i*szerokoscZnaku*liczbaZnakow; (re as TRichEdit).Perform(EM_SETPARAFORMAT,0,Integer(@pf)); end;uwaga: w komponencie RichEdit należy ustawić czcionkę o stałej szerokości znaków (np. Courier New) uwaga: wyczyszczenie lub nadpisanie RichEdit.Text przywraca ustawienia domyślne 090 Zwiększenie maksymalnej pojemności komponentu RichEdit do 1 GB tekstu RichEdit1.MaxLength:=1073741824;uwaga: domyślnie MaxLength wynosi 81920 uwaga: liczba 1073741824 wynika z podniesienia 2 do potęgi 30 091 Prawidłowe wyświetlanie tekstu zawierającego znak "ń" w komponencie RichEdit uses RichEdit; procedure TForm1.FormCreate(Sender: TObject); begin SendMessage(RichEdit1.Handle,EM_SETLANGOPTIONS,0,0); end;uwaga: powyższe polecenie należy powtórzyć dla każdego komponentu RichEdit 092 Zmiana sposobu kodowania tekstu w komponencie RichEdit z Windows-1250 na UTF-8 RichEdit1.Text:=AnsiToUtf8(RichEdit1.Text);uwaga: zmianę kodowania w przeciwną stronę realizuje funkcja Utf8ToAnsi 093 Zmiana sposobu kodowania tekstu w komponencie RichEdit z Windows-1250 na ISO-8859-2 function TForm1.ZmianaKodowania(s: String; codePage1,codePage2: Integer): String; var ws: PWideChar; ms: PChar; eCode,wSize,bSize: Integer; b: Bool; c: Char; begin ws:=''; ms:=''; wSize:=0; bSize:=0; b:=False; c:='#'; Result:=''; try wSize:=MultiByteToWideChar(codePage1,1 or 0,PChar(s),-1,ws,0); GetMem(ws,wSize*SizeOf(WideChar)); eCode:=MultiByteToWideChar(codePage1,1 or 0,PChar(s),-1,ws,wSize); if eCode<>0 then try bSize:=WideCharToMultibyte(codePage2,0,ws,-1,ms,0,@c,@b); GetMem(ms,bSize*SizeOf(Char)); eCode:=WideCharToMultibyte(codePage2,0,ws,-1,ms,bSize,@c,@b); if b then eCode:=-1; if eCode<>0 then Result:=ms; finally FreeMem(ms,bSize*SizeOf(Char)); end; finally FreeMem(ws,wSize*SizeOf(WideChar)); end; end; RichEdit1.Text:=ZmianaKodowania(RichEdit1.Text,1250,28591);uwaga: wartości codePage określa https://learn.microsoft.com/en-us/windows/win32/intl/code-page-identifiers 094 Zapisanie zawartości komponentu RichEdit do pliku bez dodatkowych znaków formatu RTF RichEdit1.PlainText:=True; 095 Sprawdzenie numeru wiersza z kursorem karetki i jego pozycji w komponencie RichEdit wiersz:=RichEdit1.CaretPos.Y; pozycja:=RichEdit1.CaretPos.X; 096 Ustawienie kursora karetki na pozycji X w wierszu Y w komponencie RichEdit RichEdit1.CaretPos:=Point(X,Y); 097 Sprawdzenie numeru pierwszego wiersza widocznego w komponencie RichEdit n:=RichEdit1.Perform(EM_GETFIRSTVISIBLELINE,0,0);uwaga: wiersze w komponencie RichEdit numerowane są od 0 uwaga: powyższa funkcja zwraca numer pierwszego wiersza który jest widoczny w całości 098 Sprawdzenie numeru ostatniego wiersza widocznego w komponencie RichEdit function TForm1.NumerOstatniegoWidocznegoWiersza: Integer; var i: Integer; r: TRect; begin RichEdit1.Perform(EM_GETRECT,0,Longint(@r)); r.Left:=r.Left+1; r.Top:=r.Bottom-2; i:=RichEdit1.Perform(EM_CHARFROMPOS,0,Integer(@r.TopLeft)); Result:=RichEdit1.Perform(WM_USER+54,0,i)-1; end;uwaga: wiersze w komponencie RichEdit numerowane są od 0 uwaga: powyższa funkcja zwraca numer ostatniego wiersza który jest widoczny w całości i zawiera znak zakończenia linii 099 Przesunięcie obszaru roboczego komponentu RichEdit na samą górę lub sam dół SendMessage(RichEdit1.Handle,WM_VSCROLL,SB_TOP,0); SendMessage(RichEdit1.Handle,WM_VSCROLL,SB_BOTTOM,0); 100 Przesunięcie obszaru roboczego komponentu RichEdit o jedną stronę w górę lub w dół SendMessage(RichEdit1.Handle,WM_VSCROLL,SB_PAGEUP,0); SendMessage(RichEdit1.Handle,WM_VSCROLL,SB_PAGEDOWN,0); 101 Przesunięcie obszaru roboczego komponentu RichEdit o 5 wierszy w górę lub w dół SendMessage(RichEdit1.Handle,EM_LINESCROLL,0,-5); SendMessage(RichEdit1.Handle,EM_LINESCROLL,0,5); 102 Przesunięcie obszaru roboczego komponentu RichEdit tak aby n-ty wiersz był pierwszym widocznym SendMessage(RichEdit1.Handle,WM_VSCROLL,SB_TOP,0); SendMessage(RichEdit1.Handle,EM_LINESCROLL,0,n);uwaga: powyższa instrukcja umożliwia wyjechanie poza koniec tekstu (np. gdy pierwszym widocznym ma zostać wiersz ostatni) 103 Przesunięcie obszaru roboczego komponentu RichEdit tak aby widoczny był kursor karetki SendMessage(RichEdit1.Handle,EM_SCROLLCARET,0,0);uwaga: powyższa instrukcja przestaje działać po dodaniu RichEdit do listy modułów (uses RichEdit;) i należy ją zastąpić przez: SendMessage(RichEdit1.Handle,WM_USER-841,0,0); 104 Sprawdzenie oraz ustawienie pozycji suwaków komponentu RichEdit var p: TPoint; RichEdit1.Perform(WM_USER+221,0,LParam(@p)); pozycjaSuwakaPoziomego:=p.X; pozycjaSuwakaPionowego:=p.Y; p.X:=pozycjaSuwakaPoziomego; p.Y:=pozycjaSuwakaPionowego; RichEdit1.Perform(WM_USER+222,0,LParam(@p)); 105 Sprawdzenie wysokości pojedynczego wiersza w komponencie RichEdit function TForm1.WysokoscWiersza: Integer; var tm : TTextMetric; reDC: HDC; begin reDC:=GetDC(RichEdit1.Handle); SelectObject(reDC,RichEdit1.Font.Handle); GetTextMetrics(reDC,tm); ReleaseDC(RichEdit1.Handle,reDC); Result:=tm.tmHeight; end;uwaga: poniższa funkcja pozwala sprawdzić ile pełnych wierszy zmieści się w obszarze roboczym komponentu RichEdit: function TForm1.LiczbaPelnychWierszy: Integer; begin n:=RichEdit1.ClientHeight div WysokoscWiersza; end; 106 Zmiana czcionki fragmentu tekstu w komponencie 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 uwaga: formatowanie wielu fragmentów tekstu można przyspieszyć zamrażając RichEdit na czas formatowania: var poprzedniSelStart,poprzedniSelLength: Integer; focusObject: TWinControl; poprzedniSelStart:=RichEdit1.SelStart; poprzedniSelLength:=RichEdit1.SelLength; focusObject:=Screen.ActiveControl; RichEdit1.Perform(WM_SETREDRAW,WParam(False),0); RichEdit1.Enabled:=False; ProceduraFormatujacaTekst; RichEdit1.Enabled:=True; RichEdit1.Perform(WM_SETREDRAW,WParam(True),0); RichEdit1.Repaint; focusObject.SetFocus; RichEdit1.SelStart:=poprzedniSelStart; RichEdit1.SelLength:=poprzedniSelLength; 107 Zmiana koloru tła fragmentu tekstu w komponencie RichEdit uses RichEdit; var stylTekstu: TCharFormat2; FillChar(stylTekstu,SizeOf(stylTekstu),0); stylTekstu.cbSize:=SizeOf(stylTekstu); stylTekstu.dwMask:=CFM_BACKCOLOR; stylTekstu.crBackColor:=ColorToRGB(clRed); RichEdit1.SelStart:=10; RichEdit1.SelLength:=5; RichEdit1.Perform(EM_SETCHARFORMAT,SCF_SELECTION,LParam(@stylTekstu));uwaga: parametr SelStart określa numer pierwszego znaku natomiast SelLength długość formatowanego fragmentu tekstu 108 Sprawdzenie koloru tekstu w komponencie RichEdit uses RichEdit; var stylTekstu: TCharFormat2; FillChar(stylTekstu,SizeOf(stylTekstu),0); stylTekstu.cbSize:=SizeOf(TCharFormat); RichEdit1.Perform(EM_GETCHARFORMAT,SCF_SELECTION,LParam(@stylTekstu)); if Integer(stylTekstu.crTextColor)=ColorToRGB($FF0000) then ShowMessage('Aktualnie wprowadzany tekst ma kolor czerwony') else ShowMessage('Aktualnie wprowadzany tekst ma kolor $'+IntToHex(stylTekstu.crTextColor,6));uwaga: sprawdzenie koloru tekstu w miejscu innym niż kursor karetki wymaga chwilowej zmiany wartości RichEdit1.SelStart 109 Kopiowanie tekstu z komponentu RichEdit do schowka RichEdit1.CopyToClipboard;uwaga: skopiowany tekst zachowuje pierwotny format (czcionka, kolor itp.) 110 Wklejanie tekstu do komponentu RichEdit ze schowka RichEdit1.PasteFromClipboard;uwaga: wklejony tekst zachowuje pierwotny format (czcionka, kolor itp.) 111 Kopiowanie tekstu z komponentu RichEdit poprzez Ctrl+C jako zwykły tekst Aby nadpisać procedurę Ctrl+C komponentu RichEdit należy: 1) umieścić na formie komponent ActionList z zakładki Standard 2) utworzyć akcję i ustawić jej właściwość Enabled na False 3) uzupełnić następujące procedury: uses Clipbrd, Menus; procedure TForm1.RichEdit1Enter(Sender: TObject); begin Action1.ShortCut:=TextToShortCut('Ctrl+C'); Action1.Enabled:=True; end; procedure TForm1.RichEdit1Exit(Sender: TObject); begin Action1.Enabled:=False; Action1.ShortCut:=TextToShortCut(''); end; procedure TForm1.Action1Execute(Sender: TObject); begin Clipboard.AsText:=RichEdit1.SelText; end; 112 Wklejanie tekstu do komponentu RichEdit poprzez Ctrl+V jako zwykły tekst Aby nadpisać procedurę Ctrl+V komponentu RichEdit należy: 1) umieścić na formie komponent ActionList z zakładki Standard 2) utworzyć akcję i ustawić jej właściwość Enabled na False 3) uzupełnić następujące procedury: uses Clipbrd, Menus; procedure TForm1.RichEdit1Enter(Sender: TObject); begin Action1.ShortCut:=TextToShortCut('Ctrl+V'); Action1.Enabled:=True; end; procedure TForm1.RichEdit1Exit(Sender: TObject); begin Action1.Enabled:=False; Action1.ShortCut:=TextToShortCut(''); end; procedure TForm1.Action1Execute(Sender: TObject); begin if Clipboard.HasFormat(CF_TEXT) then RichEdit1.SelText:=Clipboard.AsText; end; 113 Wycinanie tekstu z komponentu RichEdit poprzez Ctrl+X jako zwykły tekst Aby nadpisać procedurę Ctrl+X komponentu RichEdit należy: 1) umieścić na formie komponent ActionList z zakładki Standard 2) utworzyć akcję i ustawić jej właściwość Enabled na False 3) uzupełnić następujące procedury: uses Clipbrd, Menus; procedure TForm1.RichEdit1Enter(Sender: TObject); begin Action1.ShortCut:=TextToShortCut('Ctrl+X'); Action1.Enabled:=True; end; procedure TForm1.RichEdit1Exit(Sender: TObject); begin Action1.Enabled:=False; Action1.ShortCut:=TextToShortCut(''); end; procedure TForm1.Action1Execute(Sender: TObject); begin Clipboard.AsText:=RichEdit1.SelText; RichEdit1.SelText:=''; end; 114 Powiązanie komponentu FindDialog z komponentem RichEdit procedure TForm1.FindDialog1Find(Sender: TObject); var pierwszyZnakWyniku,tempSelStart,tempSelLength: Integer; szukanyTekst,przeszukiwanyTekst,komunikat: String; begin szukanyTekst:=FindDialog1.FindText; przeszukiwanyTekst:=RichEdit1.Text; if FindDialog1.Options*[frMatchCase]=[] then begin szukanyTekst:=AnsiLowerCase(szukanyTekst); przeszukiwanyTekst:=AnsiLowerCase(przeszukiwanyTekst); end; if FindDialog1.Options*[frDown]=[frDown] then begin tempSelStart:=RichEdit1.SelStart; if Copy(przeszukiwanyTekst,RichEdit1.SelStart+1,RichEdit1.SelLength)=szukanyTekst then tempSelStart:=tempSelStart+1; pierwszyZnakWyniku:=Pos(szukanyTekst,Copy(przeszukiwanyTekst,tempSelStart+1 ,Length(przeszukiwanyTekst)-tempSelStart)); if pierwszyZnakWyniku<>0 then pierwszyZnakWyniku:=pierwszyZnakWyniku+tempSelStart; end else begin tempSelLength:=RichEdit1.SelLength; if Copy(przeszukiwanyTekst,RichEdit1.SelStart+1,RichEdit1.SelLength)=szukanyTekst then tempSelLength:=tempSelLength-1; pierwszyZnakWyniku:=0; while Pos(szukanyTekst,Copy(przeszukiwanyTekst,pierwszyZnakWyniku+1 ,RichEdit1.SelStart+tempSelLength-pierwszyZnakWyniku))>0 do pierwszyZnakWyniku:=Pos(szukanyTekst,Copy(przeszukiwanyTekst ,pierwszyZnakWyniku+1,RichEdit1.SelStart+tempSelLength-pierwszyZnakWyniku)) +pierwszyZnakWyniku; end; if pierwszyZnakWyniku=0 then begin; if FindDialog1.Options*[frDown]=[frDown] then komunikat:='W dół' else komunikat:='W górę'; komunikat:=komunikat+' od kursora karetki nie znaleziono wyrażenia "'+szukanyTekst+'"'; ShowMessage(komunikat); RichEdit1.SetFocus; end else begin RichEdit1.SelStart:=pierwszyZnakWyniku-1; RichEdit1.SelLength:=Length(szukanyTekst); SendMessage(RichEdit1.Handle,EM_SCROLLCARET,0,0); end; end;uwaga: zamiast wywołania EM_SCROLLCARET można dla komponentu RichEdit ustawić właściwość HideSelection na False uwaga: skutkuje to automatyczym przesuwaniem obszaru roboczego do zaznaczonego tekstu, co można selektywnie przywracać: var poprzedniaPozycjaSuwaka: Integer; poprzedniaPozycjaSuwaka:=RichEdit1.Perform(EM_GETFIRSTVISIBLELINE,0,0); JakasProceduraZaznaczajacaTekst; SendMessage(RichEdit1.Handle,WM_VSCROLL,SB_TOP,0); SendMessage(RichEdit1.Handle,EM_LINESCROLL,0,poprzedniaPozycjaSuwaka); 115 Powiązanie komponentu ReplaceDialog z komponentem RichEdit procedure TForm1.ReplaceDialog1Find(Sender: TObject); var pierwszyZnakWyniku,tempSelStart: Integer; szukanyTekst,przeszukiwanyTekst,komunikat: String; begin szukanyTekst:=ReplaceDialog1.FindText; przeszukiwanyTekst:=RichEdit1.Text; if ReplaceDialog1.Options*[frMatchCase]=[] then begin szukanyTekst:=AnsiLowerCase(szukanyTekst); przeszukiwanyTekst:=AnsiLowerCase(przeszukiwanyTekst); end; tempSelStart:=RichEdit1.SelStart; if Copy(przeszukiwanyTekst,RichEdit1.SelStart+1,RichEdit1.SelLength)=szukanyTekst then tempSelStart:=tempSelStart+1; pierwszyZnakWyniku:=Pos(szukanyTekst,Copy(przeszukiwanyTekst,tempSelStart+1 ,Length(przeszukiwanyTekst)-tempSelStart)); if pierwszyZnakWyniku<>0 then pierwszyZnakWyniku:=pierwszyZnakWyniku+tempSelStart; if pierwszyZnakWyniku=0 then begin; komunikat:='W dół od kursora karetki nie znaleziono wyrażenia "'+szukanyTekst+'"'; ShowMessage(komunikat); RichEdit1.SetFocus; end else begin RichEdit1.SelStart:=pierwszyZnakWyniku-1; RichEdit1.SelLength:=Length(szukanyTekst); SendMessage(RichEdit1.Handle,EM_SCROLLCARET,0,0); end; end; procedure TForm1.ReplaceDialog1Replace(Sender: TObject); var pierwszyZnakWyniku,oldSelStart: Integer; szukanyTekst,przeszukiwanyTekst,komunikat: String; begin szukanyTekst:=ReplaceDialog1.FindText; przeszukiwanyTekst:=RichEdit1.Text; if ReplaceDialog1.Options*[frMatchCase]=[] then begin szukanyTekst:=AnsiLowerCase(szukanyTekst); przeszukiwanyTekst:=AnsiLowerCase(przeszukiwanyTekst); end; if ReplaceDialog1.Options*[frReplaceAll]=[frReplaceAll] then begin oldSelStart:=RichEdit1.SelStart; if ReplaceDialog1.Options*[frMatchCase]=[] then RichEdit1.Text:=StringReplace(RichEdit1.Text,ReplaceDialog1.FindText ,ReplaceDialog1.ReplaceText,[rfReplaceAll,rfIgnoreCase]) else RichEdit1.Text:=StringReplace(RichEdit1.Text,ReplaceDialog1.FindText ,ReplaceDialog1.ReplaceText,[rfReplaceAll]); if oldSelStart<=Length(RichEdit1.Text) then RichEdit1.SelStart:=oldSelStart else RichEdit1.SelStart:=Length(RichEdit1.Text); RichEdit1.SelLength:=0; RichEdit1.SetFocus; end else begin if Copy(przeszukiwanyTekst,RichEdit1.SelStart+1,RichEdit1.SelLength)=szukanyTekst then begin oldSelStart:=RichEdit1.SelStart; RichEdit1.Text:=Copy(RichEdit1.Text,1,RichEdit1.SelStart) +ReplaceDialog1.ReplaceText+Copy(RichEdit1.Text,RichEdit1.SelStart +RichEdit1.SelLength+1,Length(RichEdit1.Text)-RichEdit1.SelStart-RichEdit1.SelLength); RichEdit1.SelStart:=oldSelStart+Length(ReplaceDialog1.ReplaceText); RichEdit1.SelLength:=0; end; przeszukiwanyTekst:=RichEdit1.Text; if ReplaceDialog1.Options*[frMatchCase]=[] then przeszukiwanyTekst:=AnsiLowerCase(przeszukiwanyTekst); pierwszyZnakWyniku:=Pos(szukanyTekst,Copy(przeszukiwanyTekst,RichEdit1.SelStart +1,Length(przeszukiwanyTekst)-RichEdit1.SelStart)); if pierwszyZnakWyniku<>0 then pierwszyZnakWyniku:=pierwszyZnakWyniku+RichEdit1.SelStart; if pierwszyZnakWyniku=0 then begin; komunikat:='W dół od kursora karetki nie znaleziono wyrażenia "'+szukanyTekst+'"'; ShowMessage(komunikat); RichEdit1.SetFocus; end else begin RichEdit1.SelStart:=pierwszyZnakWyniku-1; RichEdit1.SelLength:=Length(szukanyTekst); SendMessage(RichEdit1.Handle,EM_SCROLLCARET,0,0); end; end; end; 116 Wyszukiwanie tekstu w komponencie RichEdit z wykorzystaniem klawisza F3 procedure TForm1.Action1Execute(Sender: TObject); var pierwszyZnakWyniku,tempSelStart,tempSelLength: Integer; szukanyTekst,przeszukiwanyTekst: String; begin if Edit1.Text='' then begin Edit1.SetFocus; end else begin szukanyTekst:=AnsiLowerCase(Edit1.Text); przeszukiwanyTekst:=AnsiLowerCase(RichEdit1.Text); if not CheckBox1.Checked then begin tempSelStart:=RichEdit1.SelStart; if Copy(przeszukiwanyTekst,RichEdit1.SelStart+1,RichEdit1.SelLength)=szukanyTekst then tempSelStart:=tempSelStart+1; pierwszyZnakWyniku:=Pos(szukanyTekst,Copy(przeszukiwanyTekst,tempSelStart+1 ,Length(przeszukiwanyTekst)-tempSelStart)); if pierwszyZnakWyniku<>0 then pierwszyZnakWyniku:=pierwszyZnakWyniku+tempSelStart; end else begin tempSelLength:=RichEdit1.SelLength; if Copy(przeszukiwanyTekst,RichEdit1.SelStart+1,RichEdit1.SelLength)=szukanyTekst then tempSelLength:=tempSelLength-1; pierwszyZnakWyniku:=0; while Pos(szukanyTekst,Copy(przeszukiwanyTekst,pierwszyZnakWyniku+1 ,RichEdit1.SelStart+tempSelLength-pierwszyZnakWyniku))>0 do pierwszyZnakWyniku:=Pos(szukanyTekst,Copy(przeszukiwanyTekst,pierwszyZnakWyniku+1 ,RichEdit1.SelStart+tempSelLength-pierwszyZnakWyniku))+pierwszyZnakWyniku; end; if pierwszyZnakWyniku=0 then begin; ShowMessage('Nie znaleziono tekstu "'+Edit1.Text+'"'); end else begin RichEdit1.SelStart:=pierwszyZnakWyniku-1; RichEdit1.SelLength:=Length(szukanyTekst); SendMessage(RichEdit1.Handle,EM_SCROLLCARET,0,0); end; end; end;uwaga: należy umieścić na formie komponent Edit z zakładki Standard służący do wprowadzania wyszukiwanej frazy uwaga: należy umieścić na formie komponent CheckBox służący do określenia czy szukać w górę od kursora karetki uwaga: należy umieścić na formie komponent ActionList z zakładki Standard, dodać akcję i ustawić jej właściwość ShortCut na F3 uwaga: zamiast wywołania EM_SCROLLCARET można dla komponentu RichEdit ustawić właściwość HideSelection na False 117 Wprowadzanie tabulacji w komponencie RichEdit private procedure ObsluzTabulacje(var tcmDK: TCMDialogKey); message CM_DIALOGKEY; procedure TForm1.ObsluzTabulacje(var tcmDK: TCMDialogKey); begin if (tcmDK.CharCode=VK_TAB) and (ActiveControl.Name='RichEdit1') then begin RichEdit1.SelText:=Chr(9); tcmDK.Result:=1; end else begin inherited; end; end;uwaga: domyślnie wciśnięcie tabulacji nie zmienia tekstu tylko przenosi skupienie (focus) na inny komponent 118 Przesuwalna belka dzieląca dwa komponenty RichEdit uses Math; var x0,dx,formWidth0: Integer; re1Width0,re2Width0,re1WidthMin,re2WidthMin,re2Left0: Integer; przesuwanieBelki: Boolean; procedure TForm1.FormCreate(Sender: TObject); begin re1WidthMin:=50; re2WidthMin:=120; formWidth0:=Form1.Width; re1Width0:=RichEdit1.Width; re2Width0:=RichEdit2.Width; re2Left0:=RichEdit2.Left; Form1.Constraints.MinWidth:=Max(Form1.Constraints.MinWidth,Form1.Width -RichEdit1.Width-RichEdit2.Width+re1WidthMin+re2WidthMin); x0:=0; dx:=0; przesuwanieBelki:=False; end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (X>RichEdit1.Left+RichEdit1.Width) and (X<RichEdit2.Left) and (Y>Max(RichEdit1.Top,RichEdit2.Top)) and (Y<Min(RichEdit1.Top+RichEdit1.Height,RichEdit2.Top+RichEdit2.Height)) then begin x0:=X-dx; przesuwanieBelki:=True; end; end; procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer); begin if (X>RichEdit1.Left+RichEdit1.Width) and (X<RichEdit2.Left) and (Y>Max(RichEdit1.Top,RichEdit2.Top)) and (Y<Min(RichEdit1.Top+RichEdit1.Height,RichEdit2.Top+RichEdit2.Height)) then Cursor:=crSizeWE else Cursor:=crDefault; if (przesuwanieBelki) and (Floor((Form1.Width-formWidth0)/2)+re1Width0+(X-x0)+1>re1WidthMin) and (Ceil((Form1.Width-formWidth0)/2)+re2Width0-(X-x0)+1>re2WidthMin) then begin dx:=X-x0; Perform(WM_SETREDRAW,WParam(False),0); FormResize(Sender); Perform(WM_SETREDRAW,WParam(True),0); RedrawWindow(Form1.Handle,nil,0,RDW_FRAME or RDW_INVALIDATE or RDW_ALLCHILDREN); Repaint; end; end; procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin przesuwanieBelki:=False; end; procedure TForm1.FormResize(Sender: TObject); begin if Floor((Form1.Width-formWidth0)/2)+re1Width0+dx<re1WidthMin then dx:=re1WidthMin-(Floor((Form1.Width-formWidth0)/2)+re1Width0); if Ceil((Form1.Width-formWidth0)/2)+re2Width0-dx<re2WidthMin then dx:=Ceil((Form1.Width-formWidth0)/2)+re2Width0-re2WidthMin; RichEdit1.Width:=Floor((Form1.Width-formWidth0)/2)+re1Width0+dx; RichEdit2.Left:=Floor((Form1.Width-formWidth0)/2)+re2Left0+dx; RichEdit2.Width:=Ceil((Form1.Width-formWidth0)/2)+re2Width0-dx; end;uwaga: tymczasowa blokada WM_SETREDRAW poprawia wyświetlanie komponentów podczas przesuwania belki 119 Synchronizacja suwaków dwóch komponentów RichEdit private procedure RichEdWndProc1(var msg: TMessage); procedure RichEdWndProc2(var msg: TMessage); var PRichEdWndProc1,POldWndProc1,PRichEdWndProc2,POldWndProc2: Pointer; implementation procedure TForm1.FormCreate(Sender: TObject); begin PRichEdWndProc1:=Classes.MakeObjectInstance(RichEdWndProc1); POldWndProc1:=Pointer(SetWindowLong(RichEdit1.Handle,GWL_WNDPROC,Integer(PRichEdWndProc1))); PRichEdWndProc2:=Classes.MakeObjectInstance(RichEdWndProc2); POldWndProc2:=Pointer(SetWindowLong(RichEdit2.Handle,GWL_WNDPROC,Integer(PRichEdWndProc2))); end; procedure TForm1.RichEdWndProc1(var msg: TMessage); var pierwszyWiersz: Double; begin if msg.Msg=WM_VSCROLL then begin if ((RichEdit1.Lines.Count<4096) and (RichEdit2.Lines.Count<4096)) or (RichEdit1.Lines.Count=RichEdit2.Lines.Count) then begin RichEdit2.Perform(msg.Msg,msg.WParam,msg.LParam); end else begin if RichEdit1.Lines.Count<4096 then pierwszyWiersz:=HIWORD(msg.WParam)/16 else pierwszyWiersz:=HIWORD(msg.WParam)*(RichEdit1.Lines.Count/65536) if RichEdit2.Lines.Count<4096 then RichEdit2.Perform(msg.Msg,Min(Round(pierwszyWiersz*16) ,65535)*65536+LOWORD(msg.WParam),msg.LParam) else RichEdit2.Perform(msg.Msg,Min(Round(pierwszyWiersz*(65536/RichEdit2.Lines.Count)) ,65535)*65536+LOWORD(msg.WParam),msg.LParam); end; end; if msg.Msg=WM_MOUSEWHEEL then begin if msg.WParam<0 then begin SendMessage(RichEdit1.Handle,EM_LINESCROLL,0,1); SendMessage(RichEdit2.Handle,EM_LINESCROLL,0,1); SendMessage(RichEdit1.Handle,EM_LINESCROLL,0,1); SendMessage(RichEdit2.Handle,EM_LINESCROLL,0,1); SendMessage(RichEdit1.Handle,EM_LINESCROLL,0,1); SendMessage(RichEdit2.Handle,EM_LINESCROLL,0,1); end else begin SendMessage(RichEdit1.Handle,EM_LINESCROLL,0,-1); SendMessage(RichEdit2.Handle,EM_LINESCROLL,0,-1); SendMessage(RichEdit1.Handle,EM_LINESCROLL,0,-1); SendMessage(RichEdit2.Handle,EM_LINESCROLL,0,-1); SendMessage(RichEdit1.Handle,EM_LINESCROLL,0,-1); SendMessage(RichEdit2.Handle,EM_LINESCROLL,0,-1); end; end; if msg.Msg<>WM_MOUSEWHEEL then msg.Result:=CallWindowProc(POldWndProc1,RichEdit1.Handle,msg.Msg,msg.WParam,msg.LParam); end; procedure TForm1.RichEdWndProc2(var msg: TMessage); var pierwszyWiersz: Double; begin if msg.Msg=WM_VSCROLL then begin if ((RichEdit1.Lines.Count<4096) and (RichEdit2.Lines.Count<4096)) or (RichEdit1.Lines.Count=RichEdit2.Lines.Count) then begin RichEdit1.Perform(msg.Msg,msg.WParam,msg.LParam); end else begin if RichEdit2.Lines.Count<4096 then pierwszyWiersz:=HIWORD(msg.WParam)/16 else pierwszyWiersz:=HIWORD(msg.WParam)*(RichEdit2.Lines.Count/65536) if RichEdit1.Lines.Count<4096 then RichEdit1.Perform(msg.Msg,Min(Round(pierwszyWiersz*16) ,65535)*65536+LOWORD(msg.WParam),msg.LParam) else RichEdit1.Perform(msg.Msg,Min(Round(pierwszyWiersz*(65536/RichEdit2.Lines.Count)) ,65535)*65536+LOWORD(msg.WParam),msg.LParam); end; end; if msg.Msg=WM_MOUSEWHEEL then begin if msg.WParam<0 then begin SendMessage(RichEdit1.Handle,EM_LINESCROLL,0,1); SendMessage(RichEdit2.Handle,EM_LINESCROLL,0,1); SendMessage(RichEdit1.Handle,EM_LINESCROLL,0,1); SendMessage(RichEdit2.Handle,EM_LINESCROLL,0,1); SendMessage(RichEdit1.Handle,EM_LINESCROLL,0,1); SendMessage(RichEdit2.Handle,EM_LINESCROLL,0,1); end else begin SendMessage(RichEdit1.Handle,EM_LINESCROLL,0,-3); SendMessage(RichEdit2.Handle,EM_LINESCROLL,0,-3); end; end; if msg.Msg<>WM_MOUSEWHEEL then msg.Result:=CallWindowProc(POldWndProc2,RichEdit2.Handle,msg.Msg,msg.WParam,msg.LParam); end; procedure TForm1.FormDestroy(Sender: TObject); begin if Assigned(PRichEdWndProc1) then begin SetWindowLong(RichEdit1.Handle,GWL_WNDPROC,Integer(POldWndProc1)); Classes.FreeObjectInstance(PRichEdWndProc1); end; if Assigned(PRichEdWndProc2) then begin SetWindowLong(RichEdit2.Handle,GWL_WNDPROC,Integer(POldWndProc2)); Classes.FreeObjectInstance(PRichEdWndProc2); end; end;uwaga: w przypadku wiadomości WM_VSCROLL, pozycję suwaka określa parametr HIWORD(msg.WParam) liczbą od 0 do 65535 uwaga: gdy RichEdit ma nie więcej niż 4096 wierszy, każdy przewinięty wiersz zwiększa pozycję suwaka o 16 uwaga: gdy RichEdit ma ponad 4096 wierszy, pozycja suwaka jest skalowana dynamicznie (pozycja górna to 0 a dolna 65535) uwaga: w obsłudze WM_MOUSEWHEEL, trzykrotne przewinięcie o 1 wiersz w dół przeciwdziała wyjechaniu poza koniec tekstu uwaga: procedura RichEdWndProc umożliwia także obsługę innych zdarzeń (np. WM_LBUTTONDBLCLK lub WM_MBUTTONDOWN) 120 Zmienna TStringList jako usprawnienie komponentu RichEdit var sl: TStringList; procedure TForm1.FormCreate(Sender: TObject); begin sl:=TStringList.Create; end; procedure TForm1.WczytajZmodyfikujZapisz; begin sl.LoadFromFile('C:\sciezka\nazwa.roz'); sl.Add('Nowy wiersz dodany na końcu'); sl.Insert(0,'Wiersz wstawiony na początku'); sl.Delete(0); sl[0]:='Zmodyfikowany wiersz pierwszy'; sl[sl.Count-1]:='Zmodyfikowany wiersz ostatni'; sl.CaseSensitive:=True; sl.Sort; sl.SaveToFile('C:\sciezka\nazwa.roz'); RichEdit1.Text:=sl.Text; end; procedure TForm1.FormDestroy(Sender: TObject); begin sl.Free; end;uwaga: operowanie na zawartości StringList jest szybsze niż w przypadku komponentu RichEdit uwaga: parametr sl.CaseSensitive określa o sposób realizacji procedury sl.Sort (wartość domyślna to False) Operacje związane z wyglądem i zachowaniem okna aplikacji 121 Ukrycie okna aplikacji 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 122 Ukrycie paska tytułowego okna aplikacji procedure TForm1.FormCreate(Sender: TObject); begin SetWindowLong(Form1.Handle,GWL_STYLE,GetWindowLong(Form1.Handle,GWL_STYLE) and not WS_CAPTION); Height:=ClientHeight; end; 123 Ustawienie przeźroczystości dla okna aplikacji procedure TForm1.FormCreate(Sender: TObject); begin Form1.BorderStyle:=bsNone; Form1.Brush.Style:=bsClear; Form1.Refresh; end; 124 Ustawienie trybu zawsze na wierzchu dla okna aplikacji Form1.FormStyle:=fsStayOnTop;uwaga: aby wyłączyć tryb zawsze na wierzchu należy zamienić parametr fsStayOnTop na fsNormal 125 Zmiana tytułu aplikacji wyświetlanego na pasku zadań Application.Title:='Tytuł'; 126 Włączenie migania przycisku aplikacji na pasku zadań procedure TForm1.Timer1Timer(Sender: TObject); begin FlashWindow(Application.Handle,True); end;uwaga: należy umieścić na formie komponent Timer z parametrem Interval ustawionym na 500 127 Ukrycie przycisku aplikacji 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; 128 Blokada rozciągania okna aplikacji Form1.BorderStyle:=bsSingle;uwaga: właściwość tę ustawić można również w inspektorze obiektów 129 Zmiana ograniczenia systemowego maksymalnych wymiarów okna aplikacji private procedure WMGetMinMaxInfo(var msg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO; procedure TForm1.WMGetMinMaxInfo(var msg: TWMGetMinMaxInfo); begin msg.MinMaxInfo^.ptMaxTrackSize.x:=8000; msg.MinMaxInfo^.ptMaxTrackSize.y:=6000; msg.Result:=0; end; 130 Wywołanie akcji z chwilą maksymalizacji okna aplikacji private procedure WMSysCommand(var msg: TWMSysCommand); message WM_SYSCOMMAND; procedure TForm1.WMSysCommand(var msg: TWMSysCommand); var stan: TWindowState; begin stan:=Form1.WindowState; inherited; if (stan<>wsMaximized) and (Form1.WindowState=wsMaximized) then ShowMessage('Okno aplikacji zostało zmaksymalizowane'); end; 131 Blokada wybranych przycisków z prawego górnego rogu okna aplikacji 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 132 Odświeżenie wyglądu okna aplikacji Application.ProcessMessages; Operacje związane z myszą i klawiaturą 133 Sprawdzenie czy klawisz ScrollLock jest wciśnięty if GetKeyState(VK_SCROLL)=1 then ShowMessage('Klawisz ScrollLock jest wciśnięty'); 134 Wywołanie wciśnięcia klawisza na klawiaturze keybd_event(Ord(Chr(32)),0,0),0,0); keybd_event(Ord(Chr(32)),0,0),KEYEVENTF_KEYUP,0);uwaga: numer klawisza (w przykładzie 32 oznacza spację) sprawdzić można wywołując procedurę OnKeyDown dla RichEdit: procedure TForm1.RichEdit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin ShowMessage(IntToStr(Key)); end; 135 Wpisanie znaków z łańcucha String w miejsce ustawienia kursora karetki uses Clipbrd; procedure TForm1.Wpisz(s: String); begin Clipboard.AsText:=s; keybd_event(VK_CONTROL,0,0,0); keybd_event(Ord('V'),0,0,0); keybd_event(Ord('V'),0,0),KEYEVENTF_KEYUP,0); keybd_event(VK_CONTROL,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 136 Nadpisanie akcji 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('Wciśnięto spację'); if msg.WParam=$0002 then ShowMessage('Wciśnięto znak ą'); if msg.WParam=$0003 then ShowMessage('Wciśnięto znak @'); if msg.WParam=$0004 then ShowMessage('Wciśnięto F12'); end;uwaga: reakcja domyślna (np. zrobienie odstępu dla klawisza Space) po nadpisaniu nie zostanie wywołana uwaga: niemożliwe jest nadpisanie tą metodą zdarzenia wywołanego dla kombinacji klawiszy Alt+Ctrl+Del uwaga: poniżej lista oznaczeń klawiszy w notacji 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 liczbowym którego wartość sprawdzić można przez procedurę OnKeyDown dla komponentu RichEdit: procedure TForm1.RichEdit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin ShowMessage(IntToStr(Key)); end;uwaga: stosowanie wartości liczbowych pozwala zmienić obsługę klawiszy nie posiadających oznaczenia VK 137 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; 138 Blokada myszy oraz blokada klawiatury uses ShellApi; ShellExecute(Handle,PChar('open'),PChar('rundll32'),PChar('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 139 Przesunięcie kursora myszy 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; 140 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 141 Ograniczenie pola w którym może poruszać się kursor myszy procedure TForm1.OgraniczPoleKursoraMyszy(x1,x2,y1,y2: Integer); var r: TRect; begin r.Left:=x1; r.Right:=x2; r.Top:=y1; r.Bottom:=y2; ClipCursor(@r); end; 142 Zamiana przycisków myszy SwapMouseButton(True);uwaga: aby przywrócić pierwotne ustawienia przycisków myszy należy zamienić parametr True na False 143 Ukrycie kursora myszy ShowCursor(False);uwaga: aby ponownie pokazać kursor myszy należy zamienić parametr False na True Operacje związane z ekranem i pulpitem 144 Sprawdzenie wymiarów obszaru roboczego ekranu procedure TForm1.ObszarRoboczy; var r: TRect; begin SystemParametersInfo(SPI_GETWORKAREA,0,@r,0); ShowMessage('Od ('+IntToStr(r.Left)+','+IntToStr(r.Top)+') do (' +IntToStr(r.Right)+','+IntToStr(r.Bottom)+')'); end; 145 Sprawdzenie rozdzielczości ekranu szerokosc:=GetSystemMetrics(SM_CXSCREEN); wysokosc:=GetSystemMetrics(SM_CYSCREEN); 146 Zmiana rozdzielczości ekranu procedure TForm1.ZmienRozdzielczoscEkranu(w,h: Integer); var dm: TDeviceMode; begin with dm do begin dmSize:=SizeOf(dm); dmBitsPerPel:=16; dmPelsWidth:=w; dmPelsHeight:=h; dmFields:=DM_PELSWIDTH+DM_PELSHEIGHT; ChangeDisplaySettings(dm,0) end; end; 147 Zapisanie do pliku BMP widoku ekranu procedure TForm1.ZapiszWidokEkranuDoBMP; var bmp: TBitmap; begin bmp:=TBitmap.Create; bmp.PixelFormat:=pf24bit; bmp.Width:=Screen.Width; bmp.Height:=Screen.Height; BitBlt(bmp.Canvas.Handle,0,0,bmp.Width,bmp.Height,GetWindowDC(GetDesktopWindow),0,0,SRCCOPY); bmp.SaveToFile('nazwa.bmp'); bmp.Free; end; 148 Zapisanie do pliku BMP widoku aktywnego okna procedure TForm1.ZapiszWidokOknaDoBMP; var bmp: TBitmap; h: THandle; r: TRect; begin h:=GetForeGroundWindow; GetWindowRect(h,r); bmp:=TBitmap.Create; bmp.PixelFormat:=pf24bit; bmp.Width:=r.Right-r.Left; bmp.Height:=r.Bottom-r.Top; BitBlt(bmp.Canvas.Handle,0,0,bmp.Width,bmp.Height,GetWindowDC(h),0,0,SRCCOPY); bmp.SaveToFile('nazwa.bmp'); bmp.Free; end;uwaga: funkcja GetWindowDC zwraca DC (device context) całego okna, razem z paskiem tytułowym i obwódką uwaga: zastosowana poniżej funkcja GetDC zwraca DC obszaru roboczego okna procedure TForm1.ZapiszWidokObszaruRoboczegoOknaDoBMP; var bmp: TBitmap; h: THandle; r: TRect; begin h:=GetForeGroundWindow; Windows.GetClientRect(h,r); bmp:=TBitmap.Create; bmp.PixelFormat:=pf24bit; bmp.Width:=r.Right-r.Left; bmp.Height:=r.Bottom-r.Top; BitBlt(bmp.Canvas.Handle,0,0,bmp.Width,bmp.Height,GetDC(h),0,0,SRCCOPY); bmp.SaveToFile('nazwa.bmp'); bmp.Free; end;uwaga: powyższa procedura pozwala zapisać widok konkretnego komponentu na oknie, po przypisaniu jego uchwytu: h:=Edit1.Handle; 149 Sprawdzenie czy kolor piksela na ekranie oddalonego o X od lewej oraz Y od góry jest czerwony procedure TForm1.CzyPikselCzerwny(x,y: Integer): Boolean; var cnv: TCanvas; begin cnv:=TCanvas.Create; cnv.Handle:=GetWindowDC(GetDesktopWindow); if cnv.Pixels[x,y]=RGB(255,0,0) then Result:=True else Result:=False; cnv.Free; end; 150 Zmiana tapety pulpitu uses Registry; procedure TForm1.UstawTapete; var reg: TRegistry; begin reg:=TRegistry.Create; try reg.RootKey:=HKEY_CURRENT_USER; reg.OpenKey('Control Panel\Desktop',True); reg.WriteString('TileWallpaper','0'); reg.WriteString('WallpaperStyle','2'); finally reg.CloseKey(); reg.Free; end; SystemParametersInfo(SPI_SETDESKWALLPAPER,0,PChar('sciezka\nazwa.bmp') ,SPIF_UPDATEINIFILE or SPIF_SENDWININICHANGE); end;uwaga: plik nazwa.bmp musi być bitmapą uwaga: aby nadać tapecie położenie Do środka należy zastosować wartości TileWallpaper=0 oraz WallpaperStyle=0 uwaga: aby nadać tapecie położenie Sąsiadująco należy zastosować wartości TileWallpaper=1 oraz WallpaperStyle=0 uwaga: aby nadać tapecie położenie Rozciągnięcie należy zastosować wartości TileWallpaper=0 oraz WallpaperStyle=2 151 Ukrycie ikon na pulpicie procedure TForm1.UkryjIkonyPulpitu; var uchwyt: HWND; begin uchwyt:=FindWindow(PChar('Progman'),nil); ShowWindow(uchwyt,SW_HIDE); end;uwaga: aby ponownie pokazać ikony pulpitu należy zamienić parametr SW_HIDE na SW_SHOW Operacje związane z plikami i folderami 152 Sprawdzenie czy plik istnieje if FileExists('C:\sciezka\nazwa.roz') then ShowMessage('Plik istnieje');uwaga: powyższa funkcja nie uwzględnia wielkości liter (wyświetli komunikat np. gdy istnieje plik NAZWA.ROZ) 153 Kopiowanie pliku CopyFile(PChar('C:\sciezka1\nazwa1.roz1'),PChar('C:\sciezka2\nazwa2.roz2'),True);uwaga: parametr True określa czy pozostawić plik C:\sciezka2\nazwa2.roz2 w przypadku gdy będzie istniał taki plik 154 Zmiana nazwy pliku RenameFile('C:\sciezka\nazwa1.roz1','C:\sciezka\nazwa2.roz2');uwaga: nazwa nie zostanie zmieniona jeżeli nowa nazwa jest zajęta 155 Kasowanie pliku procedure TForm1.SkasujPlik(plik: String); begin FileSetAttr(plik,FileGetAttr(plik) and not (faReadOnly or faHidden)); DeleteFile(plik); end; 156 Sprawdzenie czy folder istnieje if DirectoryExists('C:\sciezka\folder') then ShowMessage('Folder istnieje');uwaga: powyższa funkcja nie uwzględnia wielkości liter (wyświetli komunikat np. gdy istnieje folder C:\ScIeZkA\FoLdEr) 157 Tworzenie nowego folderu 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'); 158 Kopiowanie folderu wraz z zawartością procedure TForm1.KopiujFolder(folder1,folder2: String); var sr: TSearchRec; czyKoniec: Integer; begin czyKoniec:=FindFirst(folder1+'\*',faAnyFile,sr); while czyKoniec=0 do begin if (sr.Name<>'.') and (sr.Name<>'..') then begin if not DirectoryExists(folder2) then ForceDirectories(folder2); if DirectoryExists(folder1+'\'+sr.Name) then KopiujFolder(folder1+'\'+sr.Name,folder2+'\'+sr.Name) else CopyFile(PChar(folder1+'\'+sr.Name),PChar(folder2+'\'+sr.Name),True); end; czyKoniec:=FindNext(sr); end; FindClose(sr); end; 159 Przenoszenie folderu wraz z zawartością uses ShellApi; procedure TForm1.PrzeniesFolder(folder1,folder2: String); var fileOp: TSHFileOpStruct; begin FillChar(fileOp,SizeOf(fileOp),#0); fileOp.Wnd:=GetDesktopWindow(); fileOp.wFunc:=FO_MOVE; fileOp.pFrom:=PChar(folder1+#0); fileOp.pTo:=PChar(folder2+#0); fileOp.fFlags:=FOF_NOCONFIRMMKDIR; ShFileOperation(fileOp); end;uwaga: parametr FOF_NOCONFIRMMKDIR wyłącza okno dialogowe potwierdzające tworzenie nowych folderów 160 Kasowanie pustego folderu RemoveDir('C:\sciezka\folder'); 161 Kasowanie folderu w którym mogą znajdować się pliki lub podfoldery procedure TForm1.UsunFolder(folder: String); var sr: TSearchRec; czyKoniec: Integer; begin czyKoniec:=FindFirst(folder+'\*',faAnyFile,sr); while czyKoniec=0 do begin if (sr.Name<>'.') and (sr.Name<>'..') then begin if DirectoryExists(folder+'\'+sr.Name) then UsunFolder(folder+'\'+sr.Name) else begin FileSetAttr(folder+'\'+sr.Name,FileGetAttr(folder+'\'+sr.Name) and not (faReadOnly or faHidden)); DeleteFile(folder+'\'+sr.Name); end; end; czyKoniec:=FindNext(sr); end; FindClose(sr); RemoveDir(folder); end;uwaga: proszę zachować ostrożność bo przypadkowe wywołanie UsunFolder('') rozpocznie usuwanie zawartości wszystkich dysków 162 Zmiana nazwy folderu MoveFile(PChar('C:\sciezka\folder1'),PChar('C:\sciezka\folder2'));uwaga: nazwa nie zostanie zmieniona jeżeli nowa nazwa jest zajęta 163 Sprawdzenie rozmiaru pliku w bajtach function TForm1.RozmiarPliku(plik: String): Integer; var sr: TSearchRec; begin if FindFirst(plik,faAnyFile,sr)=0 then Result:=sr.Size else Result:=0; FindClose(sr); end;uwaga: powyższa funkcja zwraca nieprawidłową wartość (także ujemną) dla plików o rozmiarze przekraczającym 2 GB uwaga: dla większych plików należy zastosować poniższą funkcję: function TForm1.RozmiarPlikuExt(plik: String): Extended; var sr: TSearchRec; begin if FindFirst(plik,faAnyFile,sr)=0 then Result:=sr.FindData.nFileSizeHigh*4294967296+sr.FindData.nFileSizeLow else Result:=0; FindClose(sr); end; 164 Sprawdzenie czy dwa pliki są identyczne function TForm1.CzyPlikiSaIdentyczne(plik1,plik2: String): Boolean; var ms1,ms2: TMemoryStream; begin Result:=False; if FileExists(plik1) and FileExists(plik2) then begin ms1:=TMemoryStream.Create; ms2:=TMemoryStream.Create; try ms1.LoadFromFile(plik1); ms2.LoadFromFile(plik2); if ms1.Size=ms2.Size then Result:=CompareMem(ms1.Memory,ms2.Memory,ms1.Size); finally ms2.Free; ms1.Free; end; end; end; 165 Wczytanie do komponentu ListBox nazw plików typu *.roz znajdujących się w danym folderze procedure TForm1.DodajPlikiFolderu(folder: String); var sr: TSearchRec; czyKoniec: Integer; begin czyKoniec:=FindFirst(folder+'\*',faAnyFile,sr); while czyKoniec=0 do begin if (sr.Name<>'.') and (sr.Name<>'..') then begin if (FileExists(folder+'\'+sr.Name)) and (AnsiLowerCase(Copy(sr.Name,Length(sr.Name)-3,4))='.roz') then ListBox1.Items.Add(folder+'\'+sr.Name); end; czyKoniec:=FindNext(sr); end; FindClose(sr); end; 166 Wczytanie do komponentu ListBox nazw plików typu *.roz znajdujących się w folderze i jego podfolderach procedure TForm1.DodajPlikiFolderu(folder: String); var sr: TSearchRec; czyKoniec: Integer; begin czyKoniec:=FindFirst(folder+'\*',faAnyFile,sr); while czyKoniec=0 do begin if (sr.Name<>'.') and (sr.Name<>'..') then begin if DirectoryExists(folder+'\'+sr.Name) then DodajPlikiFolderu(folder+'\'+sr.Name) else if AnsiLowerCase(Copy(sr.Name,Length(sr.Name)-3,4))='.roz' then ListBox1.Items.Add(folder+'\'+sr.Name); end; czyKoniec:=FindNext(sr); end; FindClose(sr); end; 167 Wczytanie do komponentu ListBox nazw plików i folderów po przeniesieniu ich na formę uses ShellApi; private procedure WMDropFiles(var msg: TWMDropFiles); message WM_DROPFILES; implementation procedure TForm1.WMDropFiles(var msg: TWMDropFiles); var cNazwaObiektu: array [0..MAX_PATH] of Char; i,liczbaObiektow: Integer; begin liczbaObiektow:=DragQueryFile(msg.Drop,$FFFFFFFF,nil,0); for i:=0 to liczbaObiektow-1 do if DragQueryFile(msg.Drop,i,cNazwaObiektu,DragQueryFile(msg.Drop,i,nil,0)+1)>0 then ListBox1.Items.Add(cNazwaObiektu); end; procedure TForm1.FormCreate(Sender: TObject); begin DragAcceptFiles(Handle,True); end; 168 Wczytanie do komponentu ListBox nazw plików i folderów po przeniesieniu ich na jego obszar uses ShellApi; private procedure WMDropFilesListBox1(var msg: TMessage); procedure LBWindowProcListBox1(var msg: TMessage); var OldLBWindowProcListBox1: TWndMethod; implementation procedure TForm1.LBWindowProcListBox1(var msg: TMessage); begin if msg.Msg=WM_DROPFILES then WMDropFilesListBox1(msg) else OldLBWindowProcListBox1(msg); end; procedure TForm1.WMDropFilesListBox1(var msg: TMessage); var cNazwaObiektu: array [0..MAX_PATH] of Char; i,liczbaObiektow: Integer; begin liczbaObiektow:=DragQueryFile(msg.WParam,$FFFFFFFF,nil,0); for i:=0 to liczbaObiektow-1 do if DragQueryFile(msg.WParam,i,cNazwaObiektu,DragQueryFile(msg.WParam,i,nil,0)+1)>0 then ListBox1.Items.Add(cNazwaObiektu); end; procedure TForm1.FormCreate(Sender: TObject); begin OldLBWindowProcListBox1:=ListBox1.WindowProc; ListBox1.WindowProc:=LBWindowProcListBox1; DragAcceptFiles(ListBox1.Handle,True); end; 169 Wczytanie do komponentu Edit nazwy pliku lub folderu po przeniesieniu go na jego obszar uses ShellApi; private procedure WMDropFilesEdit1(var msg: TMessage); procedure LBWindowProcEdit1(var msg: TMessage); var OldLBWindowProcEdit1: TWndMethod; implementation procedure TForm1.LBWindowProcEdit1(var msg: TMessage); begin if msg.Msg=WM_DROPFILES then WMDropFilesEdit1(msg) else OldLBWindowProcEdit1(msg); end; procedure TForm1.WMDropFilesEdit1(var msg: TMessage); var cNazwaObiektu: array [0..MAX_PATH] of Char; begin if DragQueryFile(msg.WParam,0,cNazwaObiektu,DragQueryFile(msg.WParam,0,nil,0)+1)>0 then Edit1.Text:=cNazwaObiektu; end; procedure TForm1.FormCreate(Sender: TObject); begin OldLBWindowProcEdit1:=Edit1.WindowProc; Edit1.WindowProc:=LBWindowProcEdit1; DragAcceptFiles(Edit1.Handle,True); end; 170 Wczytanie do komponentu ListBox nazw plików i folderów po przeniesieniu ich na ikonę aplikacji procedure TForm1.FormCreate(Sender: TObject); var i: Integer; begin for i:=1 to ParamCount do ListBox1.Items.Add(ParamStr(i)); end;uwaga: ścieżki plików przeniesionych na ikonę aplikacji przekazywane są do niego w formie parametrów wiersza poleceń uwaga: maksymalna długość wiersza poleceń wynosi 2047 znaków dla Windows 2000 oraz 8191 dla Windows XP lub nowszego 171 Sortowanie listy plików w komponencie ListBox z uwzględnieniem drzewa folderów function PorownanieFolderowe(sl: TStringList; i1,i2: Integer): Integer; var folder1,folder2,nazwa1,nazwa2: String; begin folder1:=ExtractFilePath(sl[i1]); folder1:=StringReplace(folder1,' ','|',[rfReplaceAll]); folder2:=ExtractFilePath(sl[i2]); folder2:=StringReplace(folder2,' ','|',[rfReplaceAll]); nazwa1:=ExtractFileName(sl[i1]); nazwa2:=ExtractFileName(sl[i2]); Result:=AnsiCompareText(folder1,folder2)*2+AnsiCompareText(nazwa1,nazwa2); end; procedure TForm1.Sortuj; var sl: TStringList; begin sl:=TStringList.Create; sl.Assign(ListBox1.Items); sl.CustomSort(PorownanieFolderowe); ListBox1.Items.Assign(sl); sl.Free; end; 172 Otwarcie folderu zawierającego wskazany plik i zaznaczenie tego pliku WinExec(PChar('explorer.exe /n, /select, "C:\sciezka\nazwa.roz"'),SW_SHOWNORMAL); 173 Przenoszenie pliku lub folderu do kosza uses ShellApi; procedure TForm1.PrzeniesDoKosza(obiekt: String); var fileOp: TSHFileOpStruct; begin FillChar(fileOp,SizeOf(fileOp),#0); fileOp.Wnd:=Application.Handle; fileOp.wFunc:=FO_DELETE; fileOp.pFrom:=PChar(obiekt+#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 uwaga: w przypadku pamięci flash przenoszenie pliku lub folderu do kosza powoduje zwykłe usunięcie 174 Wybranie innej nazwy pliku lub folderu gdy wybrana jest zajęta function TForm1.PierwszaWolnaNazwaObiektu(obiekt: String): String; var n: Integer; begin if (FileExists(obiekt)) or (DirectoryExists(obiekt)) then begin n:=1; while (FileExists(Copy(obiekt,1,Length(obiekt)-Length(ExtractFileExt(obiekt))) +' ('+IntToStr(n)+')'+ExtractFileExt(obiekt))) or (DirectoryExists(Copy(obiekt,1,Length(obiekt)-Length(ExtractFileExt(obiekt))) +' ('+IntToStr(n)+')'+ExtractFileExt(obiekt))) do n:=n+1; Result:=Copy(obiekt,1,Length(obiekt)-Length(ExtractFileExt(obiekt))) +' ('+IntToStr(n)+')'+ExtractFileExt(obiekt); end else begin Result:=obiekt; end; end; 175 Wybranie innej nazwy folderu gdy wybrana jest zajęta function TForm1.PierwszaWolnaNazwaFolderu(folder: String): String; var n: Integer; begin if DirectoryExists(folder) then begin n:=1; while DirectoryExists(Copy(folder,1,Length(folder)-Length(ExtractFileExt(folder)))+' (' +IntToStr(n)+')'+ExtractFileExt(folder)) do n:=n+1; Result:=Copy(folder,1,Length(folder)-Length(ExtractFileExt(folder)))+' (' +IntToStr(n)+')'+ExtractFileExt(folder); end else begin Result:=folder; end; end; 176 Wczytanie zawartości pliku do komponentu RichEdit RichEdit1.Lines.LoadFromFile('C:\sciezka\nazwa.roz'); 177 Zapisanie zawartości komponentu RichEdit do pliku RichEdit1.Lines.SaveToFile('C:\sciezka\nazwa.roz');uwaga: plik nazwa.roz może mieć dowolne rozszerzenie, przykładowo nazwa.txt lub nazwa.html 178 Wczytanie zawartości pliku do łańcucha String function TForm1.WczytajPlikDoString(plik: String): String; var fs: TFileStream; s: String; begin fs:=TFileStream.Create(plik,fmOpenRead); try SetLength(s,fs.Size); fs.Position:=0; fs.ReadBuffer(Pointer(s)^,fs.Size); finally fs.Free; end; Result:=s; end;uwaga: plik może zawierać zarówno znaki czytelne (np. litery) jak i nieczytelne (np. Escape) uwaga: poniżej metoda alternatywna z wykorzystaniem funkcji BlockRead (zajmująca więcej czasu): function TForm1.WczytajPlikDoStringBlokami(plik: String): String; var b: Integer; f: File; cBuffer: array [1..65536] of Char; begin FileSetAttr(plik,FileGetAttr(plik) and not faReadOnly); AssignFile(f,plik); Reset(f,1); b:=1; Result:=''; while b>0 do begin BlockRead(f,cBuffer,SizeOf(cBuffer),b); Result:=Result+Copy(cBuffer,1,b); end; CloseFile(f); end; 179 Zapisanie łańcucha String do pliku procedure TForm1.ZapiszStringDoPliku(s,plik: String); var fs: TFileStream; begin fs:=TFileStream.Create(plik,fmCreate); try fs.WriteBuffer(Pointer(s)^,Length(s)); finally fs.Free; end; end;uwaga: plik może zawierać zarówno znaki czytelne (np. litery) jak i nieczytelne (np. Escape) uwaga: poniżej metoda alternatywna z wykorzystaniem funkcji BlockWrite (zajmująca więcej czasu): procedure TForm1.ZapiszStringDoPlikuBlokami(s,plik: String); var i,b: Integer; f: File; cBuffer: array [1..65536] of Char; begin AssignFile(f,plik); if FileExists(plik) then Reset(f,1) else Rewrite(f,1); while Length(s)>0 do begin if Length(s)<SizeOf(cBuffer) then b:=Length(s) else b:=SizeOf(cBuffer); for i:=1 to b do cBuffer[i]:=s[i]; BlockWrite(f,cBuffer,b); s:=Copy(s,b+1,Length(s)-b); end; CloseFile(f); end;uwaga: funkcje BlockRead i BlockWrite bardzo dobrze sprawdzają się na poziomie tablicy (bez korzystania z łańcucha String) 180 Zapisanie ustawień aplikacji do pliku nazwa.ini uses IniFiles; procedure TForm1.ZapiszUstawienia; var ini: TIniFile; b: Boolean; n: Integer; s: String; dt: TDateTime; x: Double; begin b:=False; n:=99; s:='tekst'; dt:=Now; x:=3.14; ini:=TIniFile.Create(ExtractFilePath(Application.ExeName)+'nazwa.ini'); ini.WriteString('ustawienia','s',s); ini.WriteBool('ustawienia','b',b); ini.WriteInteger('ustawienia','n',n); ini.WriteDateTime('ustawienia','dt',dt); ini.WriteFloat('ustawienia','x',x); ini.UpdateFile; ini.Free; end;uwaga: plik ustawienia.ini utworzony zostanie w tym samym folderze co plik exe uruchomionej aplikacji 181 Wczytanie ustawień aplikacji z pliku nazwa.ini uses IniFiles; procedure TForm1.WczytajUstawienia; var ini: TIniFile; b: Boolean; n: Integer; s: String; dt: TDateTime; x: Double; begin ini:=TIniFile.Create(ExtractFilePath(Application.ExeName)+'nazwa.ini'); b:=ini.ReadBool('ustawienia','b',True); n:=ini.ReadInteger('ustawienia','n',0); s:=ini.ReadString('ustawienia','s',''); dt:=ini.ReadDateTime('ustawienia','dt',Now); x:=ini.ReadFloat('ustawienia','x',0); ini.Free; end; 182 Ustawienie plikowi 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); 183 Ustawienie plikowi 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); 184 Ustawienie plikowi atrybutu systemowy FileSetAttr('C:\sciezka\plik.roz',FileGetAttr('C:\sciezka\plik.roz') or faSysFile);uwaga: usunięcie tego atrybutu odbywa się poprzez polecenie: FileSetAttr('C:\sciezka\plik.roz',FileGetAttr('C:\sciezka\plik.roz') and not faSysFile); 185 Ustawienie plikowi atrybutu archiwalny FileSetAttr('C:\sciezka\plik.roz',FileGetAttr('C:\sciezka\plik.roz') or faArchive);uwaga: usunięcie tego atrybutu odbywa się poprzez polecenie: FileSetAttr('C:\sciezka\plik.roz',FileGetAttr('C:\sciezka\plik.roz') and not faArchive); 186 Sprawdzenie daty utworzenia, modyfikacji i ostatniego dostępu do pliku procedure TForm1.SprawdzDatyPliku(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); FindClose(sr); ShowMessage('Data utworzenia: '+FormatDateTime('yyyy-mm-dd hh:mm:ss',u)+Chr(13)+Chr(10) +'Data ostatniej modyfikacji: '+FormatDateTime('yyyy-mm-dd hh:mm:ss',m)+Chr(13)+Chr(10) +'Data ostatniego dostępu: '+FormatDateTime('yyyy-mm-dd hh:mm:ss',d)); end; end; 187 Zmiana daty utworzenia, modyfikacji i ostatniego dostępu do pliku procedure TForm1.ZmienDatyPliku(plik: String; dataU,dataM,dataD: TDateTime); var f: File; ddtU,ddtM,ddtD,fHandle: Integer; lftU,lftM,lftD,ftU,ftM,ftD: TFileTime; begin if FileExists(plik) then begin try FileSetAttr(plik,FileGetAttr(plik) and not faReadOnly); AssignFile(f,plik); Reset(f); fHandle:=TFileRec(f).Handle; ddtU:=DateTimeToFileDate(dataU); ddtM:=DateTimeToFileDate(dataM); ddtD:=DateTimeToFileDate(dataD); DosDateTimeToFileTime(LongRec(ddtU).Hi,LongRec(ddtU).Lo,lftU); DosDateTimeToFileTime(LongRec(ddtM).Hi,LongRec(ddtM).Lo,lftM); DosDateTimeToFileTime(LongRec(ddtD).Hi,LongRec(ddtD).Lo,lftD); LocalFileTimeToFileTime(lftU,ftU); LocalFileTimeToFileTime(lftM,ftM); LocalFileTimeToFileTime(lftD,ftD); SetFileTime(fHandle,@ftU,@ftU,@ftD); finally CloseFile(f); end; end; end;uwaga: zmiennym dataU, dataM i dataD należy przypisać odpowiednio daty utworzenia, modyfikacji i ostatniego dostępu do pliku uwaga: data i czas muszą być wprowadzone z sensem (przykładowo data 30 luty lub godzina 33:86 spowodują wystąpienie błędu) 188 Sprawdzenie ścieżki oraz nazwy pliku exe uruchomionek aplikacji s:=Application.ExeName; 189 Obsługa pliku metodą "Otwórz za pomocą..." ze wskazaniem na własną aplikację if ParamCount=1 then plik:=ParamStr(1);uwaga: po wykonaniu powyższego polecenia do zmiennej plik przypisana zostanie pełna ścieżka pliku "Otwartego za pomocą..." 190 Dodanie pliku do autostartu w rejestrze systemowym 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.CloseKey(); reg.Free; end; end;uwaga: w obrębie pojedynczego klucza rejestru każdy wpis musi mieć inną nazwę (w przeciwnym wypadku zostanie nadpisany) 191 Tworzenie pliku z zasobu TResourceStream Aby dodać plik do zasobów należy: 1) umieścić w dowolnym folderze cztery pliki: a) plik który ma zostać dołączony do zasobów (np. nazwa.roz) 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 o treści: PROGRAM RCDATA "nazwa.roz"2) uruchomić wiersz poleceń (np. poprzez Start => Uruchom => cmd) 3) komendą "cd sciezka/folder" przejść do wspomnianego wcześniej folderu 4) skompilować zasoby poleceniem "brcc32 zasoby.rc" 5) powstały plik zasoby.res przenieść do folderu projektu 6) w części implementacyjnej projektu wstawić kod: {$R ZASOBY.RES}7) uruchomić aplikację Do wypakowania pliku z zasobów służy następująca procedura: procedure TForm1.WypakujZasoby(plik: String); var res: TResourceStream; begin res:=TResourceStream.Create(hInstance,'PROGRAM',RT_RCDATA); res.SaveToFile(plik); res.Free; end; 192 Tworzenie twardego linku CreateHardLink(PChar('C:\sciezka2\nazwa2.roz2'),PChar('C:\sciezka1\nazwa1.roz1'),nil);uwaga: powyższa funkcja tworzy plik nazwa2.roz2 i dowiązuje go do istniejącego pliku nazwa1.roz1 (tzw. twardy link) uwaga: by usunąć dowiązanie wystarczy skasować jeden z tych plików 193 Wczytanie wartości wybranej komórki z pliku Excel uses ComObj; function TForm1.WartoscKomorkiExcel(wiersz,kolumna: Integer; plik: String): String; var excelApp: OleVariant; begin try excelApp:=CreateOleObject('Excel.Application'); except ShowMessage('Brak oprogramowania Excel'); Exit; end; excelApp.Workbooks.Open(plik); Result:=excelApp.Cells[wiersz,kolumna].Value; if not VarIsEmpty(excelApp) then excelApp.Quit; end;uwaga: powyższa funkcja wczytuje wartości dla różnych typów pliku Excel (np. xls, xlsx i csv) uwaga: wartości komórek o niektórych formatach (np. czas) mogą zostać wczytane nieprawidłowo Operacje związane z systemem Windows 194 Sprawdzenie wersji systemu Windows ShowMessage(IntToStr(Win32MajorVersion)+'.'+IntToStr(Win32MinorVersion)+'.'+IntToStr(Win32BuildNumber));uwaga: numerację major.minor określa https://learn.microsoft.com/en-us/windows/win32/sysinfo/operating-system-version uwaga: wartość build rośnie wraz z kolejnymi kompilacjami (poniższa tabela zawiera wartości początkowe)
uwaga: po uruchomieniu aplikacji w tzw. trybie zgodności komenda zwraca wartości przypisane do wskazanego systemu uwaga: w trybie zgodności można sprawdzić wersję jakiegoś systemowego pliku poprzez poniższą funkcję: function TForm1.WersjaSystemuWindows: String; var cBuffer: array [0..MAX_PATH] of Char; verInfoSize,verValueSize,dummy: Cardinal; pVerInfo: Pointer; pVerValue: PVSFixedFileInfo; major,minor,build: String; begin Result:=''; GetSystemDirectory(cBuffer,SizeOf(cBuffer)); verInfoSize:=GetFileVersionInfoSize(PChar(cBuffer+'\ntdll.dll'),dummy); if verInfoSize>0 then begin GetMem(pVerInfo,verInfoSize); try if GetFileVersionInfo(PChar(cBuffer+'\ntdll.dll'),0,verInfoSize,pVerInfo) then begin if VerQueryValue(pVerInfo,'\',Pointer(pVerValue),verValueSize) then begin major:=IntToStr(HIWORD(pVerValue^.dwFileVersionMS)); minor:=IntToStr(LOWORD(pVerValue^.dwFileVersionMS)); build:=IntToStr(HIWORD(pVerValue^.dwFileVersionLS)); Result:=major+'.'+minor+'.'+build; end; end; finally FreeMem(pVerInfo,verInfoSize); end; end; end; 195 Sprawdzenie ścieżki katalogu w którym jest zainstalowany system Windows function TForm1.SciezkaWindows: String; var cBuffer: array [0..MAX_PATH] of Char; begin GetWindowsDirectory(cBuffer,SizeOf(cBuffer)); Result:=cBuffer; end; 196 Sprawdzenie ścieżki katalogu systemowego function TForm1.SciezkaSystemu: String; var cBuffer: array [0..MAX_PATH] of Char; begin GetSystemDirectory(cBuffer,SizeOf(cBuffer)); Result:=cBuffer; end; 197 Sprawdzenie ścieżki pulpitu i innych katalogów systemowych uses ActiveX, ShlObj; function TForm1.SciezkaPulpitu: String; var shellMalloc: IMalloc; pIIL: PItemIdList; begin pIIL:=nil; try if SHGetMalloc(shellMalloc)=NOERROR then begin SHGetSpecialFolderLocation(Form1.Handle,CSIDL_DESKTOP,pIIL); SetLength(Result,MAX_PATH); SHGetPathFromIDList(pIIL,PChar(Result)); SetLength(Result,StrLen(PChar(Result))); end; finally if pIIL<>nil then shellMalloc.Free(pIIL); end; end;uwaga: poniżej wybrane identyfikatory CSIDL katalogów systemowych:
uwaga: pozostałe identyfikatory CSIDL określa https://learn.microsoft.com/en-us/windows/win32/shell/csidl 198 Wylogowanie użytkownika, wyłączenie lub zrestartowanie komputera function TForm1.Wyjscie(tryb: Longword): Boolean; var h: 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,h); 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 (h,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) 199 Wykonanie komendy w wierszu poleceń WinExec(PChar('command.com /c ipconfig /renew'),SW_HIDE);uwaga: komenda "ipconfig /renew" powoduje odnowienie konfiguracji sieci IP dla wszystkich kart sieciowych 200 Sprawdzenie czy istnieje klucz w rejestrze systemowym uses Registry; function TForm1.CzyIstniejeKluczRejestru(korzen: HKEY; klucz: String): Boolean; var reg: TRegistry; begin reg:=TRegistry.Create; try reg.RootKey:=korzen; Result:=reg.KeyExists(klucz); finally reg.Free; end; end;uwaga: zmiennej korzen przypisać należy korzeń klucza rejestru (np. HKEY_LOCAL_MACHINE) uwaga: zmiennej klucz przypisać należy ścieżkę klucza rejestru (np. 'SOFTWARE\Microsoft\Windows NT\CurrentVersion\') 201 Sprawdzenie czy istnieje wartość klucza w rejestrze systemowym uses Registry; function TForm1.CzyIstniejeWartoscKluczaRejestru(korzen: HKEY; klucz,wartosc: String): Boolean; var reg: TRegistry; begin reg:=TRegistry.Create; try reg.RootKey:=korzen; reg.OpenKey(klucz,False); Result:=reg.ValueExists(wartosc); finally reg.CloseKey(); reg.Free; end; end;uwaga: zmiennej korzen przypisać należy korzeń klucza rejestru (np. HKEY_LOCAL_MACHINE) uwaga: zmiennej klucz przypisać należy ścieżkę klucza rejestru (np. 'SOFTWARE\Microsoft\Windows NT\CurrentVersion\') uwaga: zmiennej wartość przypisać należy nazwę wartości klucza rejestru (np. 'ProductName') 202 Odczytanie danych z wartości klucza w rejestrze systemowym uses Registry; function TForm1.OdczytajWartoscKluczaRejestru(korzen: HKEY; klucz,wartosc: String): String; var reg: TRegistry; begin reg:=TRegistry.Create; try reg.RootKey:=korzen; reg.OpenKey(klucz,False); Result:=reg.ReadString(wartosc); finally reg.CloseKey(); reg.Free; end; end;uwaga: funkcja ReadBinaryData odczytuje wartość typu REG_BINARY uwaga: funkcja ReadInteger odczytuje wartość typu REG_DWORD uwaga: funkcja ReadString odczytuje wartość typu REG_SZ uwaga: aby dodać wartość (Default) należy zastosować pustą zmienną nazwa 203 Dodanie wartości klucza do rejestru systemowego uses Registry; procedure TForm1.DodajWartoscKluczaRejestru(korzen: HKEY; klucz,wartosc,dane: String); var reg: TRegistry; begin reg:=TRegistry.Create; try reg.RootKey:=korzen; reg.OpenKey(klucz,True); reg.WriteString(wartosc,dane); finally reg.CloseKey(); reg.Free; end; end;uwaga: funkcja WriteBinaryData dodaje wartość typu REG_BINARY uwaga: funkcja WriteInteger dodaje wartość typu REG_DWORD uwaga: funkcja WriteString dodaje wartość typu REG_SZ uwaga: aby dodać wartość (Default) należy zastosować pustą zmienną nazwa 204 Usunięcie wartości klucza z rejestru systemowego uses Registry; procedure TForm1.UsunWartoscKluczaRejestru(korzen: HKEY; klucz,wartosc: String); var reg: TRegistry; begin reg:=TRegistry.Create; try reg.RootKey:=korzen; reg.OpenKey(klucz,True); reg.DeleteValue(wartosc); finally reg.CloseKey(); reg.Free; end; end; Operacje związane z procesami 205 Uruchomienie procesu uses ShellApi; ShellExecute(Handle,PChar('open'),PChar('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 ale z niewidocznym oknem 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 206 Uruchomienie procesu i wstrzymanie aplikacji do jego zakończenia function TForm1.UruchomCzekajNaZakonczenie(plik: String): Integer; var processSI: STARTUPINFO; processPI: PROCESS_INFORMATION; exitCode: DWORD; begin GetStartupInfo(processSI); processSI.dwFlags:=STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW; processSI.wShowWindow:=SW_HIDE; Result:=-1; if CreateProcess(nil,PChar(plik),nil,nil,False,CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS ,nil,nil,processSI,processPI) then begin WaitforSingleObject(processPI.hThread,INFINITE); GetExitCodeProcess(processPI.hProcess,exitCode); Result:=exitCode; CloseHandle(processPI.hProcess); CloseHandle(processPI.hThread); end; end;uwaga: funkcja zwraca ExitCode procesu lub wartość -1 jeśli procesu nie udało się uruchomić uwaga: wartość INFINITE powodującą czekanie do skutku zastąpić można limitem czasu wyrażonym w milisekundach 207 Sprawdzenie identyfikatora procesu aplikacji GetCurrentProcessId; 208 Sprawdzenie identyfikatora procesu okna o danym uchwycie function TForm1.SprawdzPidOkna(h: THandle): Integer; begin GetWindowThreadProcessId(h,@Result); end; 209 Zmiana priorytetu procesu aplikacji SetPriorityClass(GetCurrentProcess,NORMAL_PRIORITY_CLASS);uwaga: dopuszczalne ustawienia priorytetu to: REALTIME_PRIORITY_CLASS - czasu rzeczywistego HIGH_PRIORITY_CLASS - wysoki $8000 - powyżej normalnego NORMAL_PRIORITY_CLASS - normalny $4000 - poniżej normalnego IDLE_PRIORITY_CLASS - niski uwaga: dla priorytetów powyżej i poniżej normalnego konieczne jest stosowanie wartości liczbowych uwaga: priorytet domyślny to NORMAL_PRIORITY_CLASS 210 Zmiana priorytetu danego procesu SetPriorityClass(OpenProcess(PROCESS_SET_INFORMATION,False,pID),NORMAL_PRIORITY_CLASS); 211 Wczytanie do komponentu ListBox informacji o wszystkich uruchomionych procesach uses Tlhelp32; procedure TForm1.ListaProcesow; var next: Boolean; h: THandle; pe32: TProcessEntry32; begin h:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0); pe32.dwSize:=SizeOf(pe32); next:=Process32First(h,pe32); while next do begin ListBox1.Items.Add('plik='+pe32.szExeFile +' pID='+IntToStr(pe32.th32ProcessID) +' nadrzedny_pID='+IntToStr(pe32.th32ParentProcessID) +' priorytet='+IntToStr(pe32.pcPriClassBase) +' liczba_watkow='+IntToStr(pe32.cntThreads)); next:=Process32Next(h,pe32); end; CloseHandle(h); end; 212 Wczytanie do komponentu ListBox informacji o wszystkich uruchomionych wątkach uses Tlhelp32; procedure TForm1.ListaWatkow; var next: Boolean; h: THandle; te32: TThreadEntry32; begin h:=CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD,0); if h<>INVALID_HANDLE_VALUE then try te32.dwSize:=SizeOf(te32); next:=Thread32First(h,te32); while next do begin ListBox1.Items.Add('tID='+IntToStr(te32.th32ThreadID) +' nadrzedny_pID='+IntToStr(te32.th32OwnerProcessID)); next:=Thread32Next(h,te32); end; finally CloseHandle(h); end; end; 213 Wczytanie do komponentu ListBox wszystkich uchwytów danego procesu procedure TForm1.ListaUchwytowProcesu(pID: Cardinal); var uchwyt: HWND; pID2: Cardinal; begin uchwyt:=GetWindow(Application.Handle,GW_HWNDFIRST); while uchwyt<>0 do begin GetWindowThreadProcessId(uchwyt,pID2); if pID2=pID then ListBox1.Items.Add(IntToStr(uchwyt)); uchwyt:=GetWindow(uchwyt,GW_HWNDNEXT); end; end;uwaga: zazwyczaj do jednego procesu przypisanych jest wiele uchwytów okien z których część jest niewidoczna 214 Zakończenie danego procesu TerminateProcess(OpenProcess(PROCESS_TERMINATE,False,pID),0);uwaga: wywołanie powyższego polecenia dla nieprzydzielonej wartości pID może spowodować zakończenie innego procesu Operacje związane z uchwytami okien 215 Wczytanie do komponentu ListBox tytułów, typów oraz uchwytów wszystkich otwartych okien function EnumWindowsProc(wHandle: HWND): Boolean; StdCall; Export; var titleBuffer,classBuffer: array [0..128] of Char; begin Result:=True; GetWindowText(wHandle,titleBuffer,SizeOf(titleBuffer)); GetClassName(wHandle,classBuffer,SizeOf(classBuffer)); if IsWindowVisible(wHandle) then Form1.ListBox1.Items.Add(titleBuffer+'/'+classBuffer+'/'+IntToStr(wHandle)); end; EnumWindows(@EnumWindowsProc,0);uwaga: usuwając warunek IsWindowVisible(wHandle) otrzymamy listę wszystkich uruchomionych procesów, również tych ukrytych 216 Ustalenie uchwytu i tytułu aktywnego okna function TForm1.TytulAktywnegoOkna: String; var h: THandle; tytul: String; dlugoscTytulu: Longint; begin Result:=''; h:=GetForegroundWindow; if h<>0 then begin dlugoscTytulu:=GetWindowTextLength(h)+1; SetLength(tytul,dlugoscTytulu); GetWindowText(h,PChar(tytul),dlugoscTytulu); Result:=TrimRight(tytul); end; end; 217 Ustalenie 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 218 Ustalenie 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 219 Sprawdzenie czy okno o danym uchwycie istnieje if IsWindow(uchwyt) then ShowMessage('Okno istnieje') else ShowMessage('Okno nie istnieje'); 220 Sprawdzenie czy okno o danym uchwycie jest widoczne if IsWindowVisible(uchwyt) then ShowMessage('Okno jest widoczne') else ShowMessage('Okno nie jest widoczne'); 221 Sprawdzenie czy okno o danym uchwycie jest zminimalizowane if IsIconic(uchwyt) then ShowMessage('Okno jest zminimalizowane') else ShowMessage('Okno nie jest zminimalizowane'); 222 Sprawdzenie czy okno o danym uchwycie jest zmaksymalizowane if IsZoomed(uchwyt) then ShowMessage('Okno jest zmaksymalizowane') else ShowMessage('Okno nie jest zmaksymalizowane'); 223 Sprawdzenie czy okno o danym uchwycie jest w trybie zawsze na wierzchu if (GetWindowLong(uchwyt,GWL_EXSTYLE) and WS_EX_TOPMOST)=WS_EX_TOPMOST then ShowMessage('Okno jest w trybie zawsze na wierzchu') else ShowMessage('Okno nie jest w trybie zawsze na wierzchu'); 224 Zminimalizowanie lub ukrycie okna gdy znany jest jego uchwyt ShowWindow(uchwyt,SW_MINIMIZE);uwaga: parametr SW_MINIMIZE spowoduje że okno zostanie zminimalizowane uwaga: parametr SW_MAXIMIZE spowoduje że okno zostanie zmaksymalizowane uwaga: parametr SW_HIDE spowoduje że okno zostanie ukryte uwaga: parametr SW_SHOWNORMAL spowoduje że okno stanie się widoczne 225 Przeniesienie 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 uwaga: parametr HWND_TOPMOST spowoduje że okno przejdzie w tryb zawsze na wierzchu uwaga: parametr HWND_NOTOPMOST spowoduje że okno wyjdzie z trybu zawsze na wierzchu 226 Zamknięcie okna gdy znany jest jego uchwyt SendMessage(uchwyt,WM_CLOSE,0,0); Operacje związane z siecią i Internetem 227 Sprawdzenie czy komputer jest połączony z Internetem var polaczony: Boolean; function TForm1.CzyJestPolaczenie: Boolean; begin IdIcmpClient1.Host:='www.witryna.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: należy umieścić na formie komponent IdHTTP z zakładki Indy Clients uwaga: w polu Host zamiast www.witryna.pl należy podać adres 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 aplikacja nie zamrażała się przy nawiązywaniu połączenia należy dodać komponent IdAntiFreeze z zakładki Indy Misc 228 Sprawdzenie adresu IP komputera uses WinSock; function TForm1.MojAdresIP: String; var cBuffer: array [0..63] of Char; pHE: PHostEnt; wsaData: TWSAData; begin WSAStartup($101,wsaData); GetHostName(cBuffer,SizeOf(cBuffer)); pHE:=GetHostByName(@cBuffer); Result:=iNet_ntoa(PInAddr(pHE^.h_addr_list^)^); WSACleanup; end;uwaga: adresy 0.0.0.0 oraz 127.0.0.1 oznaczają że komputer nie jest podłączony do sieci 229 Sprawdzenie wszystkich adresów IP komputera uses WinSock; function TForm1.MojeAdresyIP: String; type tPInAddr = array [0..63] of PInAddr; pPInAddr = ^tPInAddr; var cBuffer: array [0..63] of Char; pHE: PHostEnt; wsaData: TWSAData; n: Integer; pPIA: pPInAddr; begin WSAStartup($101,wsaData); GetHostName(cBuffer,SizeOf(cBuffer)); pHE:=GetHostByName(cBuffer); if pHE<>nil then begin pPIA:=pPInAddr(pHE^.h_addr_list); Result:=iNet_ntoa(pPIA^[0]^); n:=1; while pPIA^[n]<>nil do begin Result:=Result+','+iNet_ntoa(pPIA^[n]^); n:=n+1; end; end; WSACleanup; end; 230 Sprawdzenie adresu MAC karty sieciowej uses WinSock; function TForm1.MojAdresMAC: String; var i: Integer; lEnum: PlanaEnum; systemID: String; ncb: PNCB; adapter: PAdapterStatus; retCode: Char; begin Result:=''; systemID:=''; GetMem(ncb,SizeOf(TNCB)); FillChar(ncb^,SizeOf(TNCB),0); GetMem(lEnum,SizeOf(TLanaEnum)); FillChar(lEnum^,SizeOf(TLanaEnum),0); GetMem(adapter,SizeOf(TAdapterStatus)); FillChar(adapter^,SizeOf(TAdapterStatus),0); lEnum.Length:=Chr(0); ncb.ncb_command:=Chr(NCBENUM); ncb.ncb_buffer:=Pointer(lEnum); ncb.ncb_length:=SizeOf(lEnum); retCode:=Netbios(ncb); i:=0; repeat FillChar(ncb^,SizeOf(TNCB),0); ncb.ncb_command:=Chr(NCBRESET); ncb.ncb_lana_num:=lEnum.lana[i]; retCode:=Netbios(ncb); FillChar(ncb^,SizeOf(TNCB),0); ncb.ncb_command:=Chr(NCBASTAT); ncb.ncb_lana_num:=lEnum.lana[i]; ncb.ncb_callname:='* '; ncb.ncb_buffer:=Pointer(adapter); ncb.ncb_length:=SizeOf(TAdapterStatus); retCode:=Netbios(ncb); if (retCode=Chr(0)) or (retCode=Chr(6)) then begin systemID:=IntToHex(Ord(adapter.adapter_address[0]),2)+'-' +IntToHex(Ord(adapter.adapter_address[1]),2)+'-' +IntToHex(Ord(adapter.adapter_address[2]),2)+'-' +IntToHex(Ord(adapter.adapter_address[3]),2)+'-' +IntToHex(Ord(adapter.adapter_address[4]),2)+'-' +IntToHex(Ord(adapter.adapter_address[5]),2); end; Inc(i); until (i>=Ord(lEnum.Length)) or (systemID<>'00-00-00-00-00-00'); FreeMem(ncb); FreeMem(adapter); FreeMem(lEnum); Result:=systemID; end; 231 Zapisanie na dysku pliku z Internetu uses UrlMon; UrlDownloadToFile(nil,PChar('http://www.witryna.pl/nazwa.roz'),PChar('C:\sciezka\nazwa.roz'),0,nil); 232 Zapisanie na dysku pliku z Internetu z podaniem identyfikatora aplikacji uses Wininet; procedure TForm1.PobierzPlik(adres,plik: String); var hSession,hService: HINTERNET; dwBytesRead: DWORD; fs: TFileStream; cBuffer: array [0..4096+1] of Char; begin fs:=TFileStream.Create(plik,fmCreate); hSession:=InternetOpen(PChar('identyfikator aplikacji'),INTERNET_OPEN_TYPE_PRECONFIG,nil,nil,0); try if Assigned(hSession) then begin hService:=InternetOpenUrl(hSession,PChar(adres),nil,0,0,0); if Assigned(hService) then try while True do begin dwBytesRead:=4096; InternetReadFile(hService,@cBuffer,4096,dwBytesRead); if dwBytesRead=0 then break; cBuffer[dwBytesRead]:=#0; fs.Write(cBuffer,dwBytesRead*SizeOf(Char)); end; finally InternetCloseHandle(hService); end; end; finally InternetCloseHandle(hSession); end; fs.Free; end; 233 Zapisanie na dysku pliku z Internetu z paskiem postępu pobierania i obsługą błędów uses IdException; procedure TForm1.PobierzPlik(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: należy umieścić na formie komponent IdHTTP z zakładki Indy Clients uwaga: aby aplikacja nie zamrażała się przy nawiązywaniu połączenia należy dodać komponent IdAntiFreeze z zakładki Indy Misc 234 Otwarcie strony internetowej w przeglądarce domyślnej uses ShellApi; ShellExecute(Handle,PChar('open'),PChar('http://www.witryna.pl/'),nil,nil,SW_SHOW); 235 Otwarcie strony internetowej we wskazanej przeglądarce uses ShellApi; ShellExecute(Handle,PChar('open'),PChar('C:\Program Files\Mozilla Firefox\firefox.exe') ,PChar('http://www.witryna.pl/'),nil,SW_SHOW); 236 Wczytanie do komponentu RichEdit kodu źródłowego strony internetowej RichEdit1.Text:=IdHTTP1.Get('http://www.witryna.pl');uwaga: 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 aplikacja nie zamrażała się przy nawiązywaniu połączenia należy dodać komponent IdAntiFreeze z zakładki Indy Misc Pozostałe 237 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 238 Struktura pętli z użyciem etykiety i polecenia goto procedure TForm1.PetlaGoToLabel; var i: Integer; label A; begin i:=0; A: i:=i+1; if i<8 then goto A; end;uwaga: polecenie goto powoduje zaniechanie wykonywania dalszych poleceń i przeskok do etykiety A: 239 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'); 240 Tablica dynamiczna var tablica: array of String; SetLength(tablica,2); tablica[0]:='1'; tablica[1]:='2'; 241 Ukrycie wszystkich komponentów Button na oknie aplikacji 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; 242 Ustawienie kursora karetki na końcu tekstu wyświetlanego w komponencie Edit Edit1.SetFocus; Edit1.SelStart:=Length(Edit1.Text); 243 Zaznaczenie całego tekstu z komponentu Edit poprzez Ctrl+A Aby nadpisać procedurę Ctrl+A komponentu Edit należy: 1) umieścić na formie komponent ActionList z zakładki Standard 2) utworzyć akcję i ustawić jej właściwość Enabled na False 3) uzupełnić następujące procedury: uses Clipbrd, Menus; procedure TForm1.Edit1Enter(Sender: TObject); begin Action1.ShortCut:=TextToShortCut('Ctrl+A'); Action1.Enabled:=True; end; procedure TForm1.Edit1Exit(Sender: TObject); begin Action1.Enabled:=False; Action1.ShortCut:=TextToShortCut(''); end; procedure TForm1.Action1Execute(Sender: TObject); begin Edit1.SelectAll; end; 244 Komponent Edit 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 245 Powiązanie komponentów Edit i UpDown by działały jak SpinEdit procedure TForm1.Edit1Change(Sender: TObject); begin if Edit1.Text='' then Edit1.Text:=IntToStr(UpDown1.Min); if StrToIntDef(Edit1.Text,0)=StrToIntDef(Edit1.Text,1) then UpDown1.Position:=Max(Min(StrToInt(Edit1.Text),UpDown1.Max),UpDown1.Min); Edit1.Text:=IntToStr(UpDown1.Position); end; procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType); begin Edit1.Text:=IntToStr(UpDown1.Position); end;uwaga: komponentom Edit i UpDown można zmieniać wymiary Width i Height w większym zakresie niż komponentowi SpinEdit 246 Poziomy suwak w komponencie ListBox procedure TForm1.PoziomySuwakListBox; var i,w: Integer; begin ListBox1.Canvas.Font:=ListBox1.Font; w:=0; for i:=0 to ListBox1.Items.Count-1 do if ListBox1.Canvas.TextWidth(ListBox1.Items[i])>w then w:=ListBox1.Canvas.TextWidth(ListBox1.Items[i]); SendMessage(ListBox1.Handle,LB_SETHORIZONTALEXTENT,w+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 247 Przesunięcie obszaru roboczego komponentu StringGrid tak aby widoczna była komórka [x,y] procedure TForm1.PrzesunStringGrid(x,y: Integer); begin StringGrid1.LeftCol:=x; StringGrid1.TopRow:=y; end; 248 Ustawienie kursora karetki w komórce [x,y] komponentu StringGrid StringGrid1.SetFocus; StringGrid1.Selection:=TGridRect(Rect(x,y,x,y));uwaga: jeżeli SetFocus ustawiony zostanie na innym komponencie to pole [x,y] zostanie podświetlone 249 Sprawdzenie szerokości i wysokości tekstu komponentu Label szerokosc:=Label1.Canvas.TextWidth(Label1.Caption); wysokosc:=Label1.Canvas.TextHeight(Label1.Caption); 250 Umieszczenie komponentu Label na komponencie ProgressBar Label1.Parent:=ProgressBar1; Label1.Top:=1; Label1.Left:=2; 251 Zmiana koloru komponentu ProgressBar uses CommCtrl; SendMessage(ProgressBar1.Handle,PBM_SETBARCOLOR,0,clRed); 252 Ograniczenie częstotliwości aktualizacji komponentu ProgressBar w przypadku bardzo długiej pętli liczbaPrzebiegow:=1000000; ProgressBar1.Max:=liczbaPrzebiegow; for i:=1 to liczbaPrzebiegow do begin JakasProcedura; if (i mod ((ProgressBar1.Max div 100)+1))=0 then begin ProgressBar1.Position:=ProgressBar1.Position+((ProgressBar1.Max div 100)+1); Application.ProcessMessages; end; end;uwaga: powyższy warunek ogranicza liczbę aktualizacji do 100 (milion aktualizacji wydłużyłby pętlę nawet o kilka minut) 253 Ustawienie niestandardowego skrótu dla akcji komponentu ActionList uses Menus; Action1.ShortCut:=TextToShortCut('Shift+Ctrl+Alt+Enter'); ShowMessage(ShortCutToText(Action1.ShortCut));uwaga: skrót Shift+Ctrl+Alt+Enter ustawić można także następującą procedurą: Action1.ShortCut:=ShortCut(VK_RETURN,[ssAlt,ssCtrl,ssShift]); 254 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 255 Wyłączenie migania zaznaczonego komponentu ScrollBar ScrollBar1.TabOrder:=False; 256 Wczytanie do komponentu Image obrazu z pliku JPEG uses Jpeg; Image1.Picture.LoadFromFile('C:\sciezka\nazwa.jpeg'); 257 Zmiana wymiarów obrazu komponentu Image bez zmiany proporcji procedure TForm1.DopasujRozmiarObrazu(wMax,hMax: Integer); begin Image1.Width:=wMax; Image1.Height:=hMax; Image1.Proportional:=True; Image1.Stretch:=True; end; 258 Odtworzenie dźwięku w komponencie MediaPlayer uses MMsystem; procedure TForm1.Alarm; var natezenie: Double; begin natezenie:=0.25; waveOutSetVolume(-1,((Round(65535*natezenie)) shl 16)+Round(65535*natezenie)); MediaPlayer1.FileName:='alarm.wav'; MediaPlayer1.Open; MediaPlayer1.Play; end;uwaga: należy umieścić na formie komponent MediaPlayer z zakładki System uwaga: wartość 0.25 określa natężenie dźwięku w zakresie od 0 (cisza) do 1 (maksimum) uwaga: w ten sam sposób odtwarzać można dźwięki zapisane w innych formatach (np. mp3) 259 Przeniesienie skupienia (focus) na inny komponent procedure TForm1.PrzestawFocus; var wc: TWinControl; begin wc:=Screen.ActiveControl; Button1.SetFocus; wc.SetFocus; end;uwaga: ustawienie skupienia na niewidocznym obiekcie (np. w procedurze FormCreate) można wykonać poleceniem: ActiveControl:=wc; 260 Dynamiczne tworzenie komponentów oraz nadpisywanie ich procedur uses StdCtrls; procedure TForm1.GenerujLabel; var nowyLabel: TLabel; begin nowyLabel:=TLabel.Create(Form1); nowyLabel.Parent:=Form1; nowyLabel.Name:=Label1; nowyLabel.Caption:='Label1'; nowyLabel.Left:=10; nowyLabel.Top:=10; nowyLabel.Font.Name:='Verdana'; nowyLabel.Font.Size:=10; nowyLabel.Font.Style:=[fsBold]; nowyLabel.OnClick:=LabelClick; end; procedure TForm1.LabelClick(Sender: TObject); begin (Sender as TLabel).Caption:='To jest '+(Sender as TLabel).Name; end; 261 Odwołanie się do komponentu o danej nazwie TLabel(FindComponent('Label'+IntToStr(1))).Caption:='tekst'; 262 Konwersja koloru na składowe RGB formatu HTML function TForm1.KolorToHex(c: TColor): String; var r,g,b: Integer; begin r:=GetRValue(c); g:=GetGValue(c); b:=GetBValue(c); Result:=AnsiLowerCase('#'+IntToHex(r,2)+IntToHex(g,2)+IntToHex(b,2)); end; 263 Bezwarunkowe zamknięcie aplikacji Halt;uwaga: jeżeli aplikacja ma przerwać wykonywanie tylko danej procedury to zamiast polecenia Halt można wstawić Exit uwaga: wywołanie Exit w procedurze FormCreate nie wstrzymuje procedur OnShow, OnActivate, OnPaint, OnResize i OnPaint uwaga: polecenie Application.Terminate nie wstrzymuje wykonywania dalszych instrukcji ani równoległych procedur 264 Zamkniecie aplikacji jeżeli jest już uruchomiona jej kopia var h: THandle; procedure TForm1.FormCreate(Sender: TObject); begin h:=CreateFileMapping(THandle($FFFFFFFF),nil,PAGE_READONLY,0,32,PChar('iDeNtYfIkAtOr')); if GetLastError=ERROR_ALREADY_EXISTS then Halt; end; procedure TForm1.FormDestroy(Sender: TObject); begin CloseHandle(h); end;uwaga: ciąg znaków "iDeNtYfIkAtOr" musi być niepowtarzalny więc warto zastąpić go możliwie długim ciągiem losowych znaków 265 Zamknięcie aplikacji z wyświetleniem komunikatu o błędzie krytycznym FatalAppExit(0,'Wystąpił błąd 408E a to bardzo źle...');uwaga: wywołane okienko wygląda groźnie, ale niczego złego nie powoduje 266 Wyłączenie powiadomień o błędach aplikacji private procedure MyAppException(Sender: TObject; e: Exception); procedure TForm1.FormCreate(Sender: TObject); begin Application.OnException:=MyAppException; end; procedure TForm1.MyAppException(Sender: TObject; e: Exception); begin //tu można wpisać polecenia wykonywane w przypadku dowolnego błędu end; 267 Wyświetlenie komunikatu ShowMessage z podziałem tekstu na linie ShowMessage('Pierwsza linia'+Chr(13)+Chr(10)+'Druga linia'+#13#10+'Trzecia linia'); 268 Wyświetlenie komunikatu MessageBox z opcjami tak lub nie if MessageBox(0,'Pytanie','Potwierdzenie',MB_YESNO)=mrYes then ShowMessage('Wcisnieto Tak'); else ShowMessage('Wcisnieto Nie'); 269 Wyświetlenie komunikatu MessageDlg z wieloma opcjami case MessageDlg('Pytanie',mtConfirmation,[mbOk,mbCancel,mbAbort,mbRetry,mbIgnore,mbYes,mbNo],0) of 1: ShowMessage('Wcisnieto OK); 2: ShowMessage('Wcisnieto Cancel lub zamknięto okno pytania krzyżykiem); 3: ShowMessage('Wcisnieto Abort); 4: ShowMessage('Wcisnieto Retry); 5: ShowMessage('Wcisnieto Ignore); 6: ShowMessage('Wcisnieto Yes); 7: ShowMessage('Wcisnieto No); end;uwaga: typ komunikatu mtConfirmation można zmienić na mtWarning, mtError, mtInformation lub mtCustom 270 Zamaskowanie gwiazdkami tekstu wprowadzanego w okno InputBox private procedure SetInputBoxPasswordChar(var msg: TMessage); message WM_USER+200; procedure TForm1.SetInputBoxPasswordChar(var msg: TMessage); var hInputForm,hEdit: HWND; begin hInputForm:=Screen.Forms[0].Handle; if (hInputForm<>0) then begin hEdit:=FindWindowEx(hInputForm,0,PChar('TEdit'),nil); SendMessage(hEdit,EM_SETPASSWORDCHAR,Ord('*'),0); end; end; procedure TForm1.UstalHaslo; var haslo: String; begin PostMessage(Handle,WM_USER+200,0,0); haslo:=InputBox('','Hasło:',''); end;uwaga: polecenie PostMessage działa jednorazowo i należy je ponowić przed każdym wywołaniem InputBox uwaga: polecenie PostMessage nie wstrzymuje wykonywania kolejnych instrukcji (działa asynchronicznie) uwaga: polecenie SendMessage wstrzymuje wykonywanie kolejnych instrukcji do czasu zakończenia obsługi SendMessage 271 Wykonywanie wielu operacji równolegle z wykorzystaniem wątków uses Classes; type TWatek = class(TThread) private n,x: Integer; procedure Procedura; procedure ProceduraKoncowa; protected procedure Execute; override; public constructor Create(numer: Integer); end; implementation constructor TWatek.Create(numer: Integer); begin inherited Create(True); n:=numer; x:=0; end; procedure TWatek.Execute; begin FreeOnTerminate:=True; while not Terminated do begin x:=x+1; Sleep(100); Synchronize(Procedura); end; Synchronize(ProceduraKoncowa); end; procedure TWatek.Procedura; begin TLabel(Form1.FindComponent('Label'+IntToStr(n))).Caption:=IntToStr(x); end; procedure TWatek.ProceduraKoncowa; begin TLabel(Form1.FindComponent('Label'+IntToStr(n))).Caption:='koniec'; end; procedure TForm1.Button1Click(Sender: TObject); begin watek1:=TWatek.Create(1); watek2:=TWatek.Create(2); watek1.Priority:=tpLower; watek1.Resume; watek2.Resume; end; procedure TForm1.Button2Click(Sender: TObject); begin watek1.Suspend; end; procedure TForm1.Button3Click(Sender: TObject); begin watek1.Resume; end; procedure TForm1.Button4Click(Sender: TObject); begin watek1.Terminate; end; 272 Sprawdzenie jakimi literami oznaczone są poszczególne partycje dysku function TForm1.ListaPartycji: String; var p: Char; begin Result:=''; for p:='A' to 'Z' do if GetDriveType(PChar(p+':\'))=DRIVE_FIXED then Result:=Result+p; end;uwaga: w przypadku dysku przenośnego funkcja GetDriveType zwraca wartość DRIVE_REMOVABLE 273 Sprawdzenie wolnej i całkowitej przestrzeni na dysku procedure TForm1.PrzestrzenDyskowa; var bajtyWolne,pojemnoscDysku: Int64; begin if SysUtils.GetDiskFreeSpaceEx(PChar('C:\'),bajtyWolne,pojemnoscDysku,nil) then ShowMessage('Dysk C ma '+IntToStr(pojemnoscDysku)+' bajtów ('+IntToStr(bajtyWolne)+' wolnych)'); end; 274 Sprawdzenie numeru seryjnego partycji uses Tlhelp32; function TForm1.NumerSeryjnyPartycji(p: String): DWORD; var cBuffer: array [0..255] of Char; maxCompLength,fileSystemFlags,serial: DWORD; begin GetVolumeInformation(PChar(p+':\'),cBuffer,SizeOf(cBuffer) ,@serial,maxCompLength,fileSystemFlags,nil,0); Result:=serial; end; |
||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
© Łasica |