| 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 wymienionych031 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.568038 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 separatoruwaga: 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-identifiers094 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.SelStart109 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 Falseuwaga: 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 frazyuwaga: 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 65535uwaga: 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 RichEdituwaga: 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+V136 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łanauwaga: 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 keyboarduwaga: 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_SHOWOperacje 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 plik154 Zmiana nazwy pliku
RenameFile('C:\sciezka\nazwa1.roz1','C:\sciezka\nazwa2.roz2');
uwaga: nazwa nie zostanie zmieniona jeżeli nowa nazwa jest zajęta155 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ów162 Zmiana nazwy folderu
MoveFile(PChar('C:\sciezka\folder1'),PChar('C:\sciezka\folder2'));
uwaga: nazwa nie zostanie zmieniona jeżeli nowa nazwa jest zajęta163 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.html178 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 aplikacji181 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 plikuuwaga: 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 sieciowych200 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 normalnymuwaga: 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 ostatnie218 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 ostatnie219 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 Clientsuwaga: 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ów255 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ów265 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 mtCustom270 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 InputBoxuwaga: 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 |