Funkcje matematyczne

001 Zamiana radianów na stopnie >>

002 Zamiana stopni na radiany >>

003 Podniesienie liczby x do potęgi y >>

004 Wartość losowa rozkładu normalnego Gaussa >>

005 Logarytm o podstawie n z liczby x >>

006 Funkcja arctg >>

007 Funkcja arcctg >>

008 Deklaracja i zapis liczb zespolonych typu TZesp >>

009 Konwersja liczby zespolonej do postaci kanonicznej >>

010 Dodawanie liczb zespolonych >>

011 Odejmowanie liczb zespolonych >>

012 Mnożenie liczb zespolonych >>

013 Dzielenie liczb zespolonych >>

014 Pierwiastek z liczby zespolonej >>

015 Sprawdzenie czy liczba x jest parzysta >>

016 Sprawdzenie czy liczba x jest podzielna przez y >>

017 Największy wspólny dzielnik dla dwóch lub więcej liczb naturalnych >>

018 Najmniejsza wspólna wielokrotność dwóch lub więcej liczb naturalnych >>

019 Konwersja liczby typu Cardinal do Integer >>

020 Obliczanie odległości między dwoma współrzędnymi geograficznymi >>


Operacje na ciągach znakowych typu String

021 Sprawdzenie czy ciąg znaków s typu String jest liczbą >>

022 Sprawdzenie czy ciąg znaków s typu String jest liczbą naturalną >>

023 Sprawdzenie czy ciąg znaków s typu String jest liczbą heksadecymalną >>

024 Konwersja liczby naturalnej na heksadecymalną >>

025 Konwersja liczby heksadecymalnej na naturalną >>

026 Konwersja liczby rzeczywistej na ciąg znaków typu String z zaokrągleniem >>

027 Alfabetyczne sortowanie tablicy ciągów znakowych typu String >>

028 Odwórcenie kolejności znaków w zmiennej s typu String >>

029 Sprawdzenie czy n-ty znak ciągu s typu String jest cyfrą >>

030 Sprawdzenie pierwszej pozycji ciągu znaków s1 w innym ciągu znaków s2 >>

031 Sprawdzenie ostatniej pozycji ciągu znaków s1 w innym ciągu znaków s2 >>

032 Sprawdzenie czy zmienna s1 typu String zawiera ciąg znaków s2 >>

033 Sprawdzenie ostatniej pozycji dowolnego ze znaków a, b lub c w ciągu znaków s >>

034 Sprawdzenie czy ciąg znaków s pasuje do maski typu Mic?oso?t Win*s >>

035 Zamiana ciągu znaków s typu String na małe lub na duże litery >>

036 Zamiana w zmiennej s typu String wszystkich ciągów s1 na s2 >>

037 Formatowanie liczby całkowitej do stałej ilości cyfr >>

038 Odczytanie zawartości wskazanej kolumny wiersza z wyborem znaku separatora kolumn >>

039 Sprawdzenie ilości kolumn w wierszu z wyborem znaku separatora kolumn >>

040 Sprawdzenie czy ciąg znaków s przechowuje poprawny adres IP >>

041 Konwersja ścieżki zawierającej długie nazwy LFN do formatu DOS 8.3 >>

042 Odczytanie ścieżki dostępowej z ciągu znaków typu C:\sciezka\nazwa.roz >>

043 Odczytanie nazwy pliku z ciągu znaków typu C:\sciezka\nazwa.roz >>

044 Odczytanie rozszerzenia pliku z ciągu znaków typu C:\sciezka\nazwa.roz >>

045 Odczytanie nazwy pliku z pominięciem rozszerzenia z ciągu znaków typu C:\sciezka\nazwa.roz >>

046 Zamiana rozszerzenia pliku w ciągu znaków zawierającym jego nazwę lub pełną ścieżkę >>


Operacje na plikach i folderach

047 Sprawdzenie czy plik C:\sciezka\nazwa.roz istnieje >>

048 Sprawdzenie czy folder C:\sciezka\folder istnieje >>

049 Sprawdzenie czy ciąg znaków ma prawidłową składnię ścieżki pliku lub folderu >>

050 Sprawdzenie rozmiaru pliku C:\sciezka\nazwa.roz w bajtach >>

051 Wczytanie do komponentu ListBox nazw plików typu *.roz znajdujących się w folderze C:\sciezka\folder >>

052 Wczytanie do komponentu ListBox nazw plików typu *.roz znajdujących się w folderze i jego podfolderach >>

053 Wczytanie do komponentu ListBox nazw plików i folderów po przeniesieniu ich na formę programu >>

054 Wczytanie do komponentu ListBox nazw plików i folderów po przeniesieniu ich na obszar ListBox >>

055 Wczytanie do komponentu Edit nazwy pliku lub folderu po przeniesieniu go na obszar Edit >>

056 Wczytanie do komponentu ListBox nazw plików i folderów po przeniesieniu ich na ikonę programu >>

057 Synchronizacja suwaków dwóch komponentów RichEdit >>

058 Otwarcie pliku C:\sciezka\nazwa.roz >>

059 Otwarcie folderu zawierającego plik C:\sciezka\nazwa.roz i zaznaczenie go >>

060 Kopiowanie pliku z C:\sciezka1\nazwa1.roz1 do C:\sciezka2\nazwa2.roz2 >>

061 Kopiowanie folderu C:\sciezka\folder1 wraz z zawartością do C:\sciezka\folder2 >>

062 Przenoszenie folderu C:\sciezka1\folder1 wraz z zawartością do C:\sciezka2\folder2 >>

063 Kasowanie pliku C:\sciezka\nazwa.roz >>

064 Kasowanie pustego folderu C:\sciezka\folder >>

065 Kasowanie folderu C:\sciezka\folder w którym mogą znajdować się pliki lub podfoldery >>

066 Przenoszenie pliku lub folderu do kosza >>

067 Zmiana nazwy pliku z C:\sciezka\nazwa1.roz1 na C:\sciezka\nazwa2.roz2 >>

068 Zmiana nazwy folderu z C:\sciezka\nazwa1 na C:\sciezka\nazwa2 >>

069 Określenie innej nazwy pliku lub folderu gdy wybrana jest zajęta >>

070 Określenie innej nazwy folderu gdy wybrana jest zajęta >>

071 Wczytanie zawartości pliku C:\sciezka\nazwa.roz do komponentu RichEdit >>

072 Zapisanie zawartości komponentu RichEdit do pliku C:\sciezka\nazwa.roz >>

073 Wczytanie rekordu z pliku C:\sciezka\nazwa.roz >>

074 Zapisanie rekordu do pliku C:\sciezka\nazwa.roz >>

075 Wczytanie ustawień programu z pliku >>

076 Zapisanie ustawień programu do pliku >>

077 Tworzenie nowego folderu C:\sciezka\folder >>

078 Tworzenie pliku z zasobu TResourceStream >>

079 Nadanie plikowi C:\sciezka\plik.roz atrybutu tylko do odczytu >>

080 Nadanie plikowi C:\sciezka\plik.roz atrybutu ukryty >>

081 Nadanie plikowi C:\sciezka\plik.roz atrybutu systemowy >>

082 Nadanie plikowi C:\sciezka\plik.roz atrybutu archiwalny >>

083 Odczytanie daty utworzenia, modyfikacji i ostatniego dostępu do pliku C:\sciezka\plik.roz >>

084 Zmiana daty utworzenia i ostatniej modyfikacji pliku C:\sciezka\plik.roz >>

085 Odczytanie ścieżki oraz nazwy pliku exe uruchomionego programu >>

086 Obsługa pliku metodą "Otwórz za pomocą..." ze wskazaniem na program stworzony w Delphi >>

087 Dodanie pliku C:\sciezka\nazwa.roz do autostartu rejestrowego >>


Działania związane z myszą i klawiaturą

088 Kliknięcie lewym przyciskiem myszy w punkcie x od lewej i y od góry na ekranie >>

089 Przesunięcie kursora o x w poziomie oraz y w pionie >>

090 Wciśnięcie dowolnego klawisza klawiatury z poziomu programu >>

091 Wpisanie ciągu znaków s typu String w miejsce ustawienia kursora tekstowego >>

092 Blokada myszy oraz blokada klawiatury >>

093 Zamiana przycisków myszy >>

094 Reakcja po wciśnięciu określonego klawisza lub kombinacji klawiszy na klawiaturze >>

095 Nadpisanie instrukcji wykonywanej przez system po wciśnięciu określonego klawisza na klawiaturze >>

096 Blokada klawisza PrintScreen >>

097 Ukrycie kursora myszy >>

098 Ograniczenie pola w którym może poruszać się kursor myszy >>


Internet i powiązania sieciowe

099 Zapisanie na dysku pliku z Internetu >>

100 Zapisanie na dysku pliku z Internetu z podaniem identyfikatora aplikacji >>

101 Zapisanie na dysku pliku z Internetu z paskiem postępu pobierania i obsługą błędów >>

102 Wczytanie do komponentu RichEdit kodu źródłowego strony internetowej >>

103 Odczytanie adresu URL aktywnego okna przeglądarki Internet Explorer 6 >>

104 Odczytanie adresu URL aktywnego okna przeglądarki Internet Explorer 8 >>

105 Odczytanie adresu URL aktywnego okna przeglądarki Firefox >>

106 Otwarcie strony internetowej >>

107 Określenie adresu IP komputera >>

108 Określenie adresu MAC karty sieciowej >>

109 Wypisanie w komponencie ListBox adresów URL ze wszystkich otwartych okien przeglądarki >>

110 Sprawdzanie czy komputer jest połączony z Internetem >>


Operacje związane z ekranem, pulpitem i wyglądem okna programu

111 Ukrycie formy programu >>

112 Przezroczyste okno programu >>

113 Włączenie trybu zawsze na wierzchu dla okna programu >>

114 Ukrycie paska tytułowego okna programu >>

115 Ukrycie przycisku programu na pasku zadań >>

116 Miganie przycisku programu na pasku zadań >>

117 Wyświetlenie ciągu znaków s na przycisku programu na pasku zadań >>

118 Blokada rozciągania okna programu >>

119 Zmiana ograniczenia systemowego maksymalnych wymiarów okna programu >>

120 Wykonanie polecenia z chwilą maksymalizacji okna programu >>

121 Blokada wybranych przycisków z prawego górnego rogu okna programu >>

122 Odświeżenie wyglądu okna programu >>

123 Zmiana tapety pulpitu >>

124 Ukrycie ikon z pulpitu >>

125 Sprawdzenie ścieżki pulpitu >>

126 Sprawdzenie czy kolor piksela na ekranie oddalonego o x od lewej oraz y od góry jest czerwony >>

127 Sprawdzenie wymiarów obszaru roboczego ekranu >>

128 Sprawdzenie rozdzielczości ekranu >>

129 Zmiana rozdzielczości ekranu >>

130 Sprawdzenie szerokości i wysokości tekstu komponentu Label >>

131 Umieszczenie komponentu Label na komponencie ProgressBar >>

132 Zmiana koloru komponentu ProgressBar >>

133 Zamaskowanie gwiazdkami tekstu wprowadzanego w okno InputQuery >>


Operacje związane z datą i czasem

134 Konwersja czasu z liczby sekund do postaci hh:mm:ss >>

135 Konwersja czasu z liczby milisekund do postaci hh:mm:ss >>

136 Konwersja czasu do postaci 2000-12-31 23:59:59 999 >>

137 Określenie aktualnej daty >>

138 Precyzyjne określenie czasu pracy systemu >>

139 Uśpienie aplikacji na zadany okres czasu >>

140 Wstrzymanie wątku na zadany okres czasu >>

141 Przesuwanie zmiennej dt typu TDateTime o zadany okres czasu >>

142 Sprawdzenie czy dany dzień wypada w okresie stosowania czasu letniego >>

143 Sprawdzenie godziny wschodu słońca dla danego dnia i współrzędnych geograficznych >>

144 Sprawdzenie godziny zachodu słońca dla danego dnia i współrzędnych geograficznych >>

145 Sprawdzenie czy dany rok jest przestępny >>

146 Sprawdzenie czy ciąg znaków zawiera datę postaci RRRR-MM-DD >>

147 Sprawdzenie czy ciąg znaków zawiera czas postaci GG:MM:SS >>

148 Sprawdzenie czy ciąg znaków zawiera czas postaci RRRR-MM-DD GG:MM:SS >>


Pozostałe

149 Automatyczne zamkniecie programu jeżeli jest już uruchomiona jego kopia >>

150 Bezwarunkowe zamknięcie programu >>

151 Zamknięcie programu z wyświetleniem komunikatu o błędzie krytycznym >>

152 Zmiana wymiarów obrazu bez zmiany proporcji >>

153 Wyświetlenie obrazu typu jpeg >>

154 Ukrycie wszystkich przycisków typu Button >>

155 Pojedyncze odtworzenie dźwięku >>

156 Okno wyboru tak lub nie w języku polskim >>

157 Zamknięcie okna dowolnego programu o tytule t >>

158 Przesunięcie obszaru roboczego komponentu typu StringGrid tak aby widoczna była komórka [x,y] >>

159 Przeniesienie kursora do komórki [x,y] komponentu StringGrid >>

160 Ustawienie kursora na końcu tekstu wyświetlanego w komponencie Edit >>

161 Ustawienie kursora na początku 10 wiersza w komponencie RichEdit >>

162 Dynamiczne tworzenie komponentów oraz nadpisywanie ich procedur >>

163 Odwołanie się do komponentu o danej nazwie >>

164 Blokada menu Alt+Ctrl+Del >>

165 Usunięcie nazwy programu z listy menu Alt+Ctrl+Del >>

166 Wypisanie w komponencie ListBox tytułów, typów oraz uchwytów wszystkich otwartych okien >>

167 Określenie uchwytu okna o znanym tytule >>

168 Określenie uchwytu okna danego typu >>

169 Zamknięcie okna gdy znany jest jego uchwyt >>

170 Zminimalizowanie lub zmaksymalizowanie okna gdy znany jest jego uchwyt >>

171 Przesunięcie okna na wierzch lub na spód względem innych okien gdy znany jest jego uchwyt >>

172 Sprawdzenie czy okno o danym uchwycie istnieje >>

173 Sprawdzenie czy okno jest widoczne gdy znany jest jego uchwyt >>

174 Sprawdzenie czy okno jest zminimalizowane gdy znany jest jego uchwyt >>

175 Sprawdzenie czy okno jest zmaksymalizowane gdy znany jest jego uchwyt >>

176 Sprawdzenie czy okno jest w trybie zawsze na wierzchu gdy znany jest jego uchwyt >>

177 Określenie identyfikatora procesu danego uchwytu >>

178 Wypisanie w komponencie ListBox wszystkich uchwytów danego procesu >>

179 Określenie identyfikatora procesu należącego do pliku nazwa.exe >>

180 Wypisanie w komponencie ListBox identyfikatorów i plików wszystkich uruchomionych procesów >>

181 Zakończenie procesu >>

182 Wypisanie w komponencie ListBox identyfikatorów wszystkich wątków danego procesu >>

183 Prawidłowe wyświetlanie polskich liter przy zapisywaniu zawartości komponentu RichEdit do pliku typu HTML >>

184 Zapisanie zawartości komponentu RichEdit do pliku bez dodatkowych, automatycznie generowanych znaków >>

185 Struktura pętli z użyciem polecenia break >>

186 Struktura pętli z użyciem polecenia goto >>

187 Deklaracja tablic >>

188 Tablica dynamiczna >>

189 Zmiana czcionki fragmentu tekstu w komponencie RichEdit >>

190 Zwiększenie maksymalnej pojemności komponentu RichEdit do 1 GB teskstu >>

191 Utworzenie listy liter którymi oznaczone są dostępne partycje >>

192 Automatyczne przerzucanie tekstu do następnej linijki w komponencie RichEdit >>

193 Poziomy suwak w komponencie ListBox >>

194 Usunięcie konkretnego wiersza z komponentów RichEdit i ListBox >>

195 Białe kontenery kolorów niestandardowych w komponencie ColorDialog >>

196 Ustawienie tekstowego kursora w komponencie RichEdit w wierszu Y oraz na pozycji X >>

197 Przesunięcie obszaru roboczego komponentu RichEdit na samą górę >>

198 Przesunięcie obszaru roboczego komponentu RichEdit o 10 wierszy w dół >>

199 Przesunięcie obszaru roboczego komponentu RichEdit o 10 wierszy w górę >>

200 Przesunięcie obszaru roboczego komponentu RichEdit tak aby widoczny był kursor tekstowy >>

201 Określenie numeru pierwszego wiersza widocznego w komponencie RichEdit >>

202 Przesunięcie obszaru roboczego komponentu RichEdit tak aby n-ty wiersz był pierwszym widocznym >>

203 Powiązanie komponentu FindDialog z komponentem RichEdit >>

204 Powiązanie komponentu ReplaceDialog z komponentem RichEdit >>

205 Określenie ścieżki katalogu w którym jest zainstalowany system Windows >>

206 Określenie ścieżki katalogu systemowego >>

207 Określenie ścieżki profilu użytkownika >>

208 Pole edycyjne do którego można wpisać tylko liczbę naturalną >>

209 Konwersja koloru na składowe RGB formatu HTML >>

210 Wylogowanie użytkownika, wyłączenie lub zrestartowanie komputera >>

211 Zmiana priorytetu programu >>

212 Uruchomienie komendy wiersza poleceń >>

213 Prawidłowe wyświetlanie tekstu zawierającego znak "ń" w komponencie RichEdit >>

214 Zmienna typu StringList jako usprawnienie komponentu RichEdit >>

215 Sprawdzenie czy schowek zawiera tekst >>

216 Skopiowanie tekstu z komponentu RichEdit do schowka >>

217 Kopiowanie tekstu z komponentu RichEdit poprzez Ctrl+C jako zwykły tekst >>

218 Wklejanie tekstu do komponentu RichEdit poprzez Ctrl+V jako zwykły tekst >>

219 Wycinanie tekstu z komponentu RichEdit poprzez Ctrl+X jako zwykły tekst >>

220 Ustawienie niestandardowego skrótu dla akcji komponentu ActionList >>

221 Wyłączenie powiadomień o błędach programu >>

222 Wyłączenie migania zaznaczonego komponentu ScrollBar >>

223 Sprawdzenie czy klucz rejestru istnieje >>

224 Sprawdzenie czy wartość klucza rejestru istnieje >>

225 Dodanie wartości klucza rejestru >>

226 Usunięcie wartości klucza rejestru >>

227 Wyświetlenie komunikatu ShowMessage z podziałem tekstu na linie >>

228 Równoległe wykonywanie operacji z wykorzystaniem wątków >>

229 Określenie numeru seryjnego partycji >>

230 Wczytanie wartości wybranej komórki z pliku Excel >>


001 Zamiana radianów na stopnie

function TForm1.RadSto(rad: Double): Double;
begin
Result:=(360*rad)/(2*Pi);
end;


002 Zamiana stopni na radiany

function TForm1.StoRad(sto: Double): Double;
begin
Result:=(sto*2*Pi)/360;
end;


003 Podniesienie liczby x do potęgi y

function TForm1.Potega(x,y: Double): Double;
begin
if x=0
 then Result:=0
 else Result:=exp(y*ln(abs(x)));
end;

uwaga: powyższa funkcja działa poprawnie również dla potęg ujemnych, oraz ułamkowych (czyli pierwiastków)


004 Wartość losowa rozkładu normalnego Gaussa

procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
end;

n:=RandG(0,1);

uwaga: pierwszy parametr powyższej funkcji to wartość średnia rozkładu, drugi to odchylenie standardowe


005 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


006 Funkcja arctg

uses Math;

function TForm1.ArcTg(x: Double): Duoble;
begin
Result:=ArcSin((x)/(Sqrt(1+x*x)));
end;

uwaga: wynik podawany jest w radianach, aby zamienić go na stopnie należy zastosować dodatkowe polecenie:

Result:=(360*Result)/(2*Pi);


007 Funkcja arcctg

uses Math;

function TForm1.ArcCtg(x: Double): Duoble;
begin
Result:=ArcCos((x)/(Sqrt(1+x*x)));
end;

uwaga: wynik podawany jest w radianach, aby zamienić go na stopnie należy zastosować dodatkowe polecenie:

Result:=(360*Result)/(2*Pi);


008 Deklaracja i zapis liczb zespolonych typu TZesp

type
 TZesp = record
  X,Y: Double
  end;

uwaga: tworzenie liczby zespolonej odbywa się poprzez poniższą funkcję:

function TForm1.Zesp(x,y: Double): TZesp;
begin
Result.X:=x;
Result.Y:=y;
end;

uwaga: x jest częścią rzeczywistą zaś y częścią urojoną liczby zespolonej


009 Konwersja liczby zespolonej do postaci kanonicznej

function TForm1.PostacKanonicznaZesp(z: TZesp): String;
begin
if (z.X=0) and (z.Y=0)
 then Result:='0'
 else
  if z.X=0
   then Result:=FloatToStr(z.Y)+'i'
   else
    if z.Y=0
     then Result:=FloatToStr(z.X)
     else
      if z.Y<0
       then Result:=FloatToStr(z.X)+FloatToStr(z.Y)+'i'
       else Result:=FloatToStr(z.X)+'+'+FloatToStr(z.Y)+'i'
end;


010 Dodawanie liczb zespolonych

function TForm1.DodawanieZesp(z1,z2: TZesp): TZesp;
begin
Result.X:=z1.X+z2.X;
Result.Y:=z1.Y+z2.Y;
end;


011 Odejmowanie liczb zespolonych

function TForm1.OdejmowanieZesp(z1,z2: TZesp): TZesp;
begin
Result.X:=z1.X-z2.X;
Result.Y:=z1.Y-z2.Y;
end;


012 Mnożenie liczb zespolonych

function TForm1.MnozenieZesp(z1,z2: TZesp): TZesp;
begin
Result.X:=z1.X*z2.X-z1.Y*z2.Y;
Result.Y:=z1.X*z2.Y+z1.Y*z2.X;
end;


013 Dzielenie liczb zespolonych

function TForm1.DzielenieZesp(z1,z2: TZesp): TZesp;
begin
Result.X:=(z1.X*z2.X+z1.Y*z2.Y)/(z2.X*z2.X+z2.Y*z2.Y);
Result.Y:=(z1.Y*z2.X-z2.Y*z1.X)/(z2.X*z2.X+z2.Y*z2.Y);
end;

uwaga: przy dzieleniu przez 0+0i wyskoczy błąd taki sam jak w przypadku dzielenia liczby rzeczywistej przez zero


014 Pierwiastek z liczby zespolonej

function TForm1.PierwiastekZesp(z: TZesp): TZesp;
begin
Result.X:=sqrt((z.X+sqrt(z.X*z.X+z.Y*z.Y))/2);
if z.Y<0
 then Result.Y:=(-1)*sqrt((-z.X+sqrt(z.X*z.X+z.Y*z.Y))/2)
 else Result.Y:=sqrt((-z.X+sqrt(z.X*z.X+z.Y*z.Y))/2);
end;


015 Sprawdzenie czy liczba x jest parzysta

if not Odd(x) then ShowMessage('Ta liczba jest parzysta');

uwaga: funkcja Odd(x) zwraca wartość True jeżeli liczba x jest nieparzysta i dlatego należy zastosować negację


016 Sprawdzenie czy liczba x jest podzielna przez y

function TForm1.CzyPodzielne(x,y: Double): Boolean;
begin
if y=0
 then Result:=False
 else
  if x/y=Round(x/y)
   then Result:=True
   else Result:=False;
end;


017 Największy wspólny dzielnik dla dwóch lub więcej liczb naturalnych

function TForm1.NWD(x,y: Integer): Integer;
begin
while (x>0) and (y>0) do
 begin
 if x>y
  then x:=x mod y
  else y:=y mod x;
 end;
Result:=0;
if (x>0) and (y=0) then Result:=x;
if (y>0) and (x=0) then Result:=y;
end;

uwaga: szukając NWD dla więcej niż dwóch liczb należy zastosować rekurencję, przykładowo dla czterech liczb będzie to:

NWD(liczba1,NWD(liczba2,NWD(liczba3,liczba4)));


018 Najmniejsza wspólna wielokrotność dwóch lub więcej liczb naturalnych

function TForm1.NWW(x,y: Integer): Integer;
var xy: Integer;
begin
xy:=x*y;
while (x>0) and (y>0) do
 begin
 if x>y
  then x:=x mod y
  else y:=y mod x;
 end;
Result:=0;
if (x>0) and (y=0) then Result:=x;
if (y>0) and (x=0) then Result:=y;
if Result>0 then Result:=Round(xy/Result);
end;

uwaga: szukając NWW dla więcej niż dwóch liczb należy zastosować rekurencję, przykładowo dla czterech liczb będzie to:

NWW(liczba1,NWW(liczba2,NWW(liczba3,liczba4)));


019 Konwersja liczby typu Cardinal do Integer

function TForm1.CardToInt(n: Cardinal): Integer;
begin
if n>2147483647
 then Result:=2147483647
 else Result:=n;
end;

uwaga: typ Cardinal przewiduje zakres liczb od 0 do 4294967295, natomiast typ Integer zakres od -2147483648 do 2147483647


020 Obliczanie odległości między dwoma współrzędnymi geograficznymi

function TForm1.OdlegloscGeograficzna(lat1,lat2,lon1,lon2: Double): Double;
var pi,rmax,rmin,r,a,b,lon11,lon22: Double;
begin
pi:=3.14159265358979;
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


021 Sprawdzenie czy ciąg znaków s typu String jest liczbą

function TForm1.CzyLiczba(s: String): Boolean;
begin
if StrToFloatDef(s,0)=StrToFloatDef(s,1)
 then Result:=True
 else Result:=False;
end;


022 Sprawdzenie czy ciąg znaków s typu String jest liczbą naturalną

function TForm1.CzyLiczbaNaturalna(s: String): Boolean;
begin
if StrToInt64Def(s,-1)<0
 then Result:=False
 else Result:=True;
end;


023 Sprawdzenie czy ciąg znaków s typu 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;


024 Konwersja liczby naturalnej na heksadecymalną

function TForm1.DecToHex(d: Int64): String;
begin
Result:=IntToHex(d,1);
end;


025 Konwersja liczby heksadecymalnej na naturalną

function TForm1.HexToDec(h: String): Int64;
begin
Result:=StrToInt64('$'+h);
end;


026 Konwersja liczby rzeczywistej na ciąg znaków typu String z zaokrągleniem

function TForm1.Zaokraglij(x: Double): String;
begin
Result:=FormatFloat('0.000',x);
end;


027 Alfabetyczne sortowanie tablicy ciągów znakowych typu String

procedure TForm1.SortujAlfabetycznie(var t: array of String);
var temp: String; i,j: Integer;
begin
for i:=Low(t) to High(t)-1 do
 for j:=i+1 to High(t) do
  if AnsiCompareText(t[i],t[j])>0
   then
    begin
    temp:=t[i];
    t[i]:=t[j];
    t[j]:=temp;
    end;
end;


028 Odwórcenie kolejności znaków w zmiennej s typu String

uses StrUtils;

s:=ReverseString(s);


029 Sprawdzenie czy n-ty znak ciągu s typu String jest cyfrą

function TForm1.CzyCyfraN(s: String; n: Integer): Boolean;
begin
if s[n] in ['0','1','2','3','4','5','6','7','8','9']
 then Result:=True
 else Result:=False;
end;


030 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


031 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


032 Sprawdzenie czy zmienna s1 typu String zawiera ciąg znaków s2

if Pos(s2,s1)<>0 ShowMessage('Ciąg znaków '+s1+' zawiera sekwencję '+s2);


033 Sprawdzenie ostatniej pozycji dowolnego ze znaków a, b lub c w ciągu znaków s

n:=LastDelimiter('abc',s);

uwaga: powyższa funkcja zwraca liczbę 0 jeżeli ciąg znaków s nie zawiera ani jednego z wymienionych


034 Sprawdzenie czy ciąg znaków s pasuje do maski typu Mic?oso?t Win*s

uses Masks;

function TForm1.CzyPasujeDoMaski(s,maska: string): Boolean;
var cMask: TMask;
begin
cMask:=TMask.Create(maska);
try
  Result:=cMask.Matches(s);
 finally
  cMask.Free;
 end;
end;

uwaga: znak zapytania to dowolna litera (ale dokładnie jedna), zaś gwiazdka oznacza dowolny ciąg znaków (również pusty)


035 Zamiana ciągu znaków s typu String na małe lub na duże litery

s:=AnsiLowerCase(s);

uwaga: zamiana ciągu znaków na duże litery odbywa się poprzez poniższe polecenie:

s:=AnsiUpperCase(s);


036 Zamiana w zmiennej s typu String wszystkich ciągów s1 na s2

s:=StringReplace(s,s1,s2,[rfReplaceAll]);

uwaga: jeżeli wielkość liter nie ma znaczenia to należy zastosować następujące polecenie:

s:=StringReplace(s,s1,s2,[rfReplaceAll,rfIgnoreCase]);


037 Formatowanie liczby całkowitej do stałej ilości cyfr

function TForm1.SIC(n,c: Integer): String;
begin
Result:=IntToStr(n);
while Length(Result)<c do
 Result:='0'+Result;
end;


038 Odczytanie zawartości wskazanej kolumny wiersza z wyborem znaku separatora kolumn

function TForm1.KolumnaN(s,sep: String; n: Integer): String;
var n2,p,k: Integer; s2: String;
begin
Result:='';
if (n>0) and (Length(sep)=1)
 then
  begin
  s2:=sep+s;
  n2:=0;
  p:=1;
  while (n2<n) and (p<Length(s2)) do
   begin
   while (p<Length(s2)) and (s2[p]=sep) do
    p:=p+1;
   if s2[p]<>sep
    then n2:=n2+1;
   k:=p;
   while (k<Length(s2)) and (s2[k+1]<>sep) do
    k:=k+1;
   if n2=n
    then Result:=Copy(s2,p,k-p+1)
    else p:=k+1;
   end;
  end;
end;

uwaga: zmiennej sep przypisać należy znak który traktowany będzie jako separator kolumn (np. spacja)

uwaga: powyższa funkcja rozpoznaje kolumny bez względu na ilość znaków separatora między nimi


039 Sprawdzenie ilości kolumn w wierszu z wyborem znaku separatora kolumn

function TForm1.IloscKolumn(s,sep: String): Integer;
var i: Integer; s2: String;
begin
Result:=0;
s2:=s+sep;
for i:=1 to Length(s2)-1 do
 if (s2[i]<>sep) and (s2[i+1]=sep)
  then Result:=Result+1;
end;

uwaga: zmiennej sep przypisać należy znak który traktowany będzie jako separator kolumn (np. spacja)

uwaga: powyższa funkcja rozpoznaje kolumny bez względu na ilość znaków separatora między nimi


040 Sprawdzenie czy ciąg znaków s przechowuje poprawny adres IP

function TForm1.CzyAdresIP(ip: String): Boolean;
var s: String;
begin
Result:=True;
if not (StrToIntDef(Copy(ip,1,Pos('.',ip)-1),256) in [0..255])
 then Result:=False;
s:=Copy(ip,Pos('.',ip)+1,Length(ip)-Pos('.',ip));
if not (StrToIntDef(Copy(s,1,Pos('.',s)-1),256) in [0..255])
 then Result:=False;
s:=Copy(s,Pos('.',s)+1,Length(s)-Pos('.',s));
if not (StrToIntDef(Copy(s,1,Pos('.',s)-1),256) in [0..255])
 then Result:=False;
if not (StrToIntDef(Copy(s,Pos('.',s)+1,Length(s)-Pos('.',s)),256) in [0..255])
 then Result:=False;
end;


041 Konwersja ścieżki zawierającej długie nazwy LFN do formatu DOS 8.3

function TForm1.LFNto83(longName: String): String;
var shortName: String; shortNameLen: Integer;
begin
SetLength(shortName,MAX_PATH);
shortNameLen:=GetShortPathName(PChar(longName),PChar(shortName),MAX_PATH-1);
SetLength(shortName,shortNameLen);
Result:=shortName;
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


042 Odczytanie ścieżki dostępowej z ciągu znaków typu C:\sciezka\nazwa.roz

s:=ExtractFilePath('C:\sciezka\nazwa.roz');


043 Odczytanie nazwy pliku z ciągu znaków typu C:\sciezka\nazwa.roz

s:=ExtractFileName('C:\sciezka\nazwa.roz');


044 Odczytanie rozszerzenia pliku z ciągu znaków typu C:\sciezka\nazwa.roz

s:=ExtractFileExt('C:\sciezka\nazwa.roz');

uwaga: powyższa funkcja zwraca również kropkę zatem wynikiem powyższego przykładu będzie ".roz"


045 Odczytanie nazwy pliku z pominięciem rozszerzenia z ciągu znaków typu C:\sciezka\nazwa.roz

function TForm1.BezRozszerzenia(s: String): String;
begin
Result:=ExtractFileName(Copy(s,1,Length(s)-Length(ExtractFileExt(s))));
end;


046 Zamiana rozszerzenia pliku w ciągu znaków zawierającym jego nazwę lub pełną ścieżkę

s:=ChangeFileExt('C:\sciezka\nazwa.roz1','.roz2');


047 Sprawdzenie czy plik C:\sciezka\nazwa.roz istnieje

if FileExists('C:\sciezka\nazwa.roz') then ShowMessage('Plik istnieje');

uwaga: powyższa funkcja nie uwzględnia wielkości liter


048 Sprawdzenie czy folder C:\sciezka\folder istnieje

if DirectoryExists('C:\sciezka\folder') then ShowMessage('Folder istnieje');

uwaga: powyższa funkcja nie uwzględnia wielkości liter


049 Sprawdzenie czy ciąg znaków ma prawidłową składnię ścieżki pliku lub folderu

function TForm1.CzySciezkaPoprawna(sciezka: String): Boolean;
begin
if Pos(':',sciezka)<>2
 then Result:=False
 else Result:=True;
if (Result) and (LastDelimiter(':',sciezka)>2)
 then Result:=False;
if (Result) and (not (AnsiLowerCase(sciezka)[1] in ['a'..'z']))
 then Result:=False;
if (Result) and (Length(sciezka)>2) and (sciezka[3]<>'\')
 then Result:=False;
if (Result) and (Pos('\\',sciezka)>0)
 then Result:=False;
if (Result) and (Pos('.\',sciezka)>0)
 then Result:=False;<br>
if (Result) and (sciezka[Length(sciezka)]='.')
 then Result:=False;
if (Result) and (sciezka[Length(sciezka)]=' ')
 then Result:=False;
if (Result) and (LastDelimiter('/*?"<>|',sciezka)>0)
 then Result:=False;
end;


050 Sprawdzenie rozmiaru pliku C:\sciezka\nazwa.roz w bajtach

function TForm1.RozmiarPliku(plik: String): Int64;
var sr: TSearchRec;
begin
if FindFirst(plik,faAnyFile,sr)=0
 then Result:=sr.Size
 else Result:=0;
SysUtils.FindClose(sr);
end;


051 Wczytanie do komponentu ListBox nazw plików typu *.roz znajdujących się w folderze C:\sciezka\folder

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;
sysutils.FindClose(sr);
end;


052 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;
sysutils.FindClose(sr);
end;


053 Wczytanie do komponentu ListBox nazw plików i folderów po przeniesieniu ich na formę programu

uses ShellApi;

private
 procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;

implementation

procedure TForm1.WMDropFiles(var Msg: TWMDropFiles);
var cNazwaObiektu: array [0..MAX_PATH] of Char; i,iloscObiektow: Integer;
begin
iloscObiektow:=DragQueryFile(Msg.Drop,$FFFFFFFF,nil,0);
for i:=0 to iloscObiektow-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;


054 Wczytanie do komponentu ListBox nazw plików i folderów po przeniesieniu ich na obszar ListBox

uses ShellApi;

private
 procedure WMDropFilesListBox1(var Msg: TMessage);
 procedure LBWindowProcListBox1(var Message: TMessage);

var
 OldLBWindowProcListBox1: TWndMethod;

implementation

procedure TForm1.LBWindowProcListBox1(var Message: TMessage);
begin
if Message.Msg=WM_DROPFILES
 then WMDropFilesListBox1(Message);
OldLBWindowProcListBox1(Message);
end;

procedure TForm1.WMDropFilesListBox1(var Msg: TMessage);
var cNazwaObiektu: array [0..MAX_PATH] of Char; i,iloscObiektow: Integer;
begin
iloscObiektow:=DragQueryFile(Msg.wParam,$FFFFFFFF,nil,0);
for i:=0 to iloscObiektow-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;


055 Wczytanie do komponentu Edit nazwy pliku lub folderu po przeniesieniu go na obszar Edit

uses ShellApi;

private
 procedure WMDropFilesEdit1(var Msg: TMessage);
 procedure LBWindowProcEdit1(var Message: TMessage);

var
 OldLBWindowProcEdit1: TWndMethod;

implementation

procedure TForm1.LBWindowProcEdit1(var Message: TMessage);
begin
if Message.Msg=WM_DROPFILES
 then WMDropFilesEdit1(Message);
OldLBWindowProcEdit1(Message);
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;


056 Wczytanie do komponentu ListBox nazw plików i folderów po przeniesieniu ich na ikonę programu

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ę programu 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


057 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);
begin
Msg.Result:=CallWindowProc(POldWndProc1,RichEdit1.Handle,Msg.Msg,Msg.wParam,Msg.lParam);
if (Msg.Msg=WM_VSCROLL) and (LOWORD(Msg.wParam)=SB_THUMBTRACK)
 then
  begin
  RichEdit2.Perform(Msg.Msg,Msg.wParam,Msg.lParam);
  SetScrollPos(RichEdit2.Handle,SB_VERT,HIWORD(Msg.wParam),True);
  end;
end;

procedure TForm1.RichEdWndProc2(var Msg: TMessage);
begin
Msg.Result:=CallWindowProc(POldWndProc2,RichEdit2.Handle,Msg.Msg,Msg.wParam,Msg.lParam);
if (Msg.Msg=WM_VSCROLL) and (LOWORD(Msg.wParam)=SB_THUMBTRACK)
 then
  begin
  RichEdit1.Perform(Msg.Msg,Msg.wParam,Msg.lParam);
  SetScrollPos(RichEdit1.Handle,SB_VERT,HIWORD(Msg.wParam),True);
  end;
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;


058 Otwarcie pliku C:\sciezka\nazwa.roz

uses ShellApi;

ShellExecute(Handle,'Open','C:\sciezka\nazwa.roz',nil,nil,SW_SHOW);

uwaga: parametr SW_SHOW spowoduje że plik zostanie otwarty w trybie normalnym

uwaga: parametr SW_HIDE spowoduje że plik zostanie otwarty i od razu zamknięty

uwaga: parametr SW_MAXIMIZE spowoduje że plik zostanie otwarty w trybie pełnoekranowym

uwaga: parametr SW_MINIMIZE spowoduje że plik zostanie otwarty i od razu zminimalizowany


059 Otwarcie folderu zawierającego plik C:\sciezka\nazwa.roz i zaznaczenie go

WinExec(PChar('explorer.exe /n, /select, "C:\sciezka\nazwa.roz"'),SW_SHOWNORMAL);


060 Kopiowanie pliku z C:\sciezka1\nazwa1.roz1 do C:\sciezka2\nazwa2.roz2

CopyFile(PChar('C:\sciezka1\nazwa1.roz1'),PChar('C:\sciezka2\nazwa2.roz2'),True);

uwaga: parametr True określa czy pozostawić plik C:\sciezka2\nazwa2.roz2 w przypadku gdy plik taki już istnieje


061 Kopiowanie folderu C:\sciezka\folder1 wraz z zawartością do C:\sciezka\folder2

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;


062 Przenoszenie folderu C:\sciezka1\folder1 wraz z zawartością do C:\sciezka2\folder2

uses ShellApi;

procedure TForm1.PrzeniesFolder;
var fileOp: TSHFileOpStruct;
begin
FillChar(fileOp,SizeOf(fileOp),#0);
fileOp.Wnd:=GetDesktopWindow();
fileOp.wFunc:=FO_MOVE;
fileOp.pFrom:=PChar('C:\sciezka1\folder1'+#0#0);
fileOp.pTo:=PChar('C:\sciezka2\folder2'+#0#0);
fileOp.fFlags:=FOF_NOCONFIRMMKDIR;
ShFileOperation(fileOp);
end;

uwaga: parametr FOF_NOCONFIRMMKDIR wyłącza okno dialogowe potwierdzające tworzenie nowych folderów


063 Kasowanie pliku C:\sciezka\nazwa.roz

procedure TForm1.SkasujPlik(plik: String);
begin
FileSetAttr(plik,FileGetAttr(plik) and not (faReadOnly or faHidden));
DeleteFile(plik);
end;


064 Kasowanie pustego folderu C:\sciezka\folder

RemoveDir('C:\sciezka\folder');


065 Kasowanie folderu C:\sciezka\folder w którym mogą znajdować się pliki lub podfoldery

procedure TForm1.UsunFolder(folder: String);
var sr: TSearchRec; czyKoniec: Integer;
begin
czyKoniec:=FindFirst(folder+'\*',faAnyFile,sr);
while czyKoniec=0 do
 begin
 if (sr.Name<>'.') and (sr.Name<>'..')
  then
   begin
   if DirectoryExists(folder+'\'+sr.Name)
    then UsunFolder(folder+'\'+sr.Name)
    else
     begin
     FileSetAttr(folder+'\'+sr.Name,FileGetAttr(folder+'\'+sr.Name) and not (faReadOnly or faHidden));
     DeleteFile(folder+'\'+sr.Name);
     end;
   end;
 czyKoniec:=FindNext(sr);
 end;
FindClose(sr);
RemoveDir(folder);
end;

uwaga: proszę zachować ostrożność bo przypadkowe wywołanie UsunFolder('') rozpocznie usuwanie zawartości wszystkich dysków


066 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#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


067 Zmiana nazwy pliku z C:\sciezka\nazwa1.roz1 na C:\sciezka\nazwa2.roz2

RenameFile('C:\sciezka\nazwa1.roz1','C:\sciezka\nazwa2.roz2');


068 Zmiana nazwy folderu z C:\sciezka\nazwa1 na C:\sciezka\nazwa2

MoveFile(Pchar('C:\sciezka\nazwa1'),Pchar('C:\sciezka\nazwa2'));


069 Określenie 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;


070 Określenie 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;


071 Wczytanie zawartości pliku C:\sciezka\nazwa.roz do komponentu RichEdit

RichEdit1.Lines.LoadFromFile('C:\sciezka\nazwa.roz');

uwaga: powyższe polecenie wygląda identycznie dla komponentu RichEdit


072 Zapisanie zawartości komponentu RichEdit do pliku C:\sciezka\nazwa.roz

RichEdit1.Lines.SaveToFile('C:\sciezka\nazwa.roz');

uwaga: plik nazwa.roz może mieć dowolne rozszerzenie, przykładowo nazwa.txt lub nazwa.html

uwaga: powyższe polecenie wygląda identycznie dla komponentu RichEdit


073 Wczytanie rekordu z pliku C:\sciezka\nazwa.roz

type
 rec = record
  n: Integer;
  s: String[255];
  end;

procedure TForm1.WczytajRekord(var r: rec; plik: String);
var f: file of rec;
begin
FileSetAttr(plik,FileGetAttr(plik) and not faReadOnly);
AssignFile(f,plik);
Reset(f);
Read(f,r);
CloseFile(f);
end;


074 Zapisanie rekordu do pliku C:\sciezka\nazwa.roz

type
 rec = record
  n: Integer;
  s: String[255];
  end;

procedure TForm1.ZapiszRekord(r: rec; plik: String);
var f: file of rec;
begin
FileSetAttr(plik,FileGetAttr(plik) and not (faReadOnly or faHidden or faSysFile));
AssignFile(f,plik);
Rewrite(f);
Write(f,r);
CloseFile(f);
end;


075 Wczytanie ustawień programu z pliku

uses IniFiles;

procedure TForm1.WczytajUstawienia;
var ini: TIniFile; b: Boolean; n: Integer; s: String; d: TDateTime; f: Double;
begin
ini:=TIniFile.Create(ExtractFilePath(Application.ExeName)+'ustawienia.ini');
b:=ini.ReadBool('ustawienia','b',True);
n:=ini.ReadInteger('ustawienia','n',0);
s:=ini.ReadString('ustawienia','s','');
d:=ini.ReadDateTime('ustawienia','d',now);
f:=ini.ReadFloat('ustawienia','f',0);
ini.Free;
end;


076 Zapisanie ustawień programu do pliku

uses IniFiles;

procedure TForm1.ZapiszUstawienia;
var ini: TIniFile; b: Boolean; n: Integer; s: String; d: TDateTime; f: Double;
begin
b:=False;
n:=99;
s:='tekst';
d:=now;
f:=3.14;
ini:=TIniFile.Create(ExtractFilePath(Application.ExeName)+'ustawienia.ini');
ini.WriteString('ustawienia','s',s);
ini.WriteBool('ustawienia','b',b);
ini.WriteInteger('ustawienia','n',n);
ini.WriteDateTime('ustawienia','d',d);
ini.WriteFloat('ustawienia','f',f);
ini.UpdateFile;
ini.Free;
end;

uwaga: plik ustawienia.ini utworzony zostanie w tym samym folderze co plik exe uruchomionego programu


077 Tworzenie nowego folderu C:\sciezka\folder

CreateDir('C:\sciezka\folder');

uwaga: w przypadku gdy nie ma pewności czy istnieją foldery nadrzędne (czyli ścieżka) to należy zastosować polecenie:

ForceDirectories('C:\sciezka\folder');


078 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. program.exe)
b) plik brcc32.exe z folderu Bin w katalogu Delphi
c) plik rw32core.dll z folderu Bin w katalogu Delphi
d) plik tekstowy zasoby.rc o treści:

PROGRAM RCDATA "program.exe"

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;


079 Nadanie plikowi C:\sciezka\plik.roz atrybutu tylko do odczytu

FileSetAttr('C:\sciezka\plik.roz',FileGetAttr('C:\sciezka\plik.roz') or (faReadOnly));

uwaga: usunięcie tego atrybutu odbywa się poprzez polecenie::

FileSetAttr('C:\sciezka\plik.roz',FileGetAttr('C:\sciezka\plik.roz') and not (faReadOnly));


080 Nadanie plikowi C:\sciezka\plik.roz atrybutu ukryty

FileSetAttr('C:\sciezka\plik.roz',FileGetAttr('C:\sciezka\plik.roz') or (faHidden));

uwaga: usunięcie tego atrybutu odbywa się poprzez polecenie::

FileSetAttr('C:\sciezka\plik.roz',FileGetAttr('C:\sciezka\plik.roz') and not (faHidden));


081 Nadanie plikowi C:\sciezka\plik.roz 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));


082 Nadanie plikowi C:\sciezka\plik.roz 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));


083 Odczytanie daty utworzenia, modyfikacji i ostatniego dostępu do pliku C:\sciezka\plik.roz

procedure TForm1.OdczytajDatyPliku(plik: String);
var sr: TSearchRec; u,m,d: TDateTime; localFileTime: TFileTime; systemTime: TSystemTime;
begin
if FindFirst(plik,faAnyFile,sr)=0
 then
  begin
  FileTimeToLocalFileTime(sr.FindData.ftCreationTime,localFileTime);
  FileTimeToSystemTime(localFileTime,systemTime);
  u:=SystemTimeToDateTime(systemTime);
  FileTimeToLocalFileTime(sr.FindData.ftLastWriteTime,localFileTime);
  FileTimeToSystemTime(localFileTime,systemTime);
  m:=SystemTimeToDateTime(systemTime);
  FileTimeToLocalFileTime(sr.FindData.ftLastAccessTime,localFileTime);
  FileTimeToSystemTime(localFileTime,systemTime);
  d:=SystemTimeToDateTime(systemTime);
  FindClose(sr);
  ShowMessage('Data utworzenia pliku to: '+FormatDateTime('yyyy-mm-dd hh:mm:ss',u));
  ShowMessage('Data ostatniej modyfikacji pliku to: '+FormatDateTime('yyyy-mm-dd hh:mm:ss',m));
  ShowMessage('Data ostatniego dostępu do pliku to: '+FormatDateTime('yyyy-mm-dd hh:mm:ss',d));
  end;
end;


084 Zmiana daty utworzenia i ostatniej modyfikacji pliku C:\sciezka\plik.roz

procedure TForm1.ZmienDatePliku(plik: String; data: TDateTime);
var fDate,fHandle: Integer; localFileTime,fileTime: TFileTime; bufor: File;
begin
if FileExists(plik)
 then
  begin
  try
    FileSetAttr(plik,FileGetAttr(plik) and not faReadOnly);
    AssignFile(bufor,plik);
    Reset(bufor);
    fDate:=DateTimeToFileDate(data);
    fHandle:=TFileRec(bufor).Handle;
    DosDateTimeToFileTime(LongRec(fDate).Hi,LongRec(fDate).Lo,localFileTime);
    LocalFileTimeToFileTime(localFileTime,fileTime);
    SetFileTime(fHandle,@fileTime,@fileTime,@fileTime);
   finally
    CloseFile(bufor);
   end;
  end;
end;

ZmienDatePliku('C:\sciezka\plik.roz',EnCodeDate(1999,12,31)+EnCodeTime(23,59,59,999));

uwaga: data i czas muszą być wprowadzone z sensem (przykładowo data 30 luty lub godzina 33:86 spowodują błąd programu)


085 Odczytanie ścieżki oraz nazwy pliku exe uruchomionego programu

s:=Application.ExeName;


086 Obsługa pliku metodą "Otwórz za pomocą..." ze wskazaniem na program stworzony w Delphi

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ą..."


087 Dodanie pliku C:\sciezka\nazwa.roz do autostartu rejestrowego

uses Registry;

procedure TForm1.DodajDoKluczaRun(nazwa,plik: String);
var reg: TRegistry;
begin
reg:=TRegistry.Create;
try
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',True);
  reg.WriteString(nazwa,plik);
 finally
  reg.Free;
 end;
end;

uwaga: w obrębie pojedynczego klucza rejestru każdy wpis musi mieć inną nazwę (w przeciwnym wypadku zostanie nadpisany)


088 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


089 Przesunięcie kursora o x w poziomie oraz y w pionie

procedure TForm1.Przesun(dx,dy: Integer);
var p: TPoint;
begin
GetCursorPos(p);
SetCursorPos(p.X+dx,p.Y+dy);
end;


090 Wciśnięcie dowolnego klawisza klawiatury z poziomu programu

keybd_event(Ord(Chr(32)),MapVirtualKey(Ord(Chr(32)),0),0,0);
keybd_event(Ord(Chr(32)),MapVirtualKey(Ord(Chr(32)),0),KEYEVENTF_KEYUP,0);

uwaga: numer klawisza (w przykładzie 32 oznacza spację) sprawdzić można wywołując procedurę OnKeyDown dla RichEdit:

procedure TForm1.RichEdit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
ShowMessage(IntToStr(Key));
end;


091 Wpisanie ciągu znaków s typu String w miejsce ustawienia kursora tekstowego

uses ClipBrd;

procedure TForm1.Wpisz(s: String);
begin
ClipBoard.AsText:=s;
keybd_event(VK_CONTROL,MapVirtualKey(VK_CONTROL,0),0,0);
keybd_event(Ord('V'),MapVirtualKey(Ord('V'),0),0,0);
keybd_event(Ord('V'),MapVirtualKey(Ord('V'),0),KEYEVENTF_KEYUP,0);
keybd_event(VK_CONTROL,MapVirtualKey(VK_CONTROL,0),KEYEVENTF_KEYUP,0);
end;

uwaga: powyższa procedura kopiuje tekst s do schowka a następnie symuluje wciśnięcie kombinacji klawiszy Ctrl+V


092 Blokada myszy oraz blokada klawiatury

uses ShellApi;

ShellExecute(Handle,'Open','rundll32','mouse,disable',nil,SW_SHOWNORMAL);

uwaga: aby zablokować klawiaturę należy zamienić parametr mouse na keyboard

uwaga: jedynym znanym mi sposobem odblokowania myszy lub klawiatury jest ponowne uruchomienie komputera


093 Zamiana przycisków myszy

SwapMouseButton(True);

uwaga: aby przywrócić pierwotne ustawienia przycisków myszy należy zamienić parametr True na False


094 Reakcja po wciśnięciu określonego klawisza lub kombinacji klawiszy na klawiaturze

var mainHook: hHook;

function KeyHook(code: Integer; wPar: wParam; lPar: lParam): Longint; StdCall;
var kState: TKeyboardState;
begin
GetKeyboardState(kState);
if (kState[32] and $80)<>0
 then ShowMessage('Wciśnięto spację');
if (kState[65] and kState[66] and not kState[67] and $80)<>0
 then ShowMessage('Wciśnięto jednocześnie klawisze A i B a klawisz C nie był wciśnięty');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
mainHook:=SetWindowsHookEx(WH_Keyboard,KeyHook,hInstance,0);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
UnhookWindowsHookEx(mainHook);
end;

uwaga: numer klawisza (w przykładzie 32 oznacza spację) sprawdzić można wywołując procedurę OnKeyDown dla RichEdit:

procedure TForm1.RichEdit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
ShowMessage(IntToStr(Key));
end;


095 Nadpisanie instrukcji wykonywanej przez system po wciśnięciu określonego klawisza na klawiaturze

private
 procedure WMHotKey(var Msg: TMessage); message WM_HOTKEY;

procedure TForm1.FormCreate(Sender: TObject);
begin
RegisterHotKey(Handle,$0001,0,VK_SPACE);
RegisterHotKey(Handle,$0002,MOD_ALT,VK_A);
RegisterHotKey(Handle,$0003,MOD_SHIFT,VK_2);
RegisterHotKey(Handle,$0004,0,VK_F12);
end;

procedure TForm1.WMHotKey(var Msg: TMessage);
begin
if Msg.wParam=$0001 then ShowMessage('Wybrano spację');
if Msg.wParam=$0002 then ShowMessage('Wybrano znak ą');
if Msg.wParam=$0003 then ShowMessage('Wybrano znak @');
if Msg.wParam=$0004 then ShowMessage('Wybrano F12');
end;

uwaga: reakcja domyślna (np. zrobienie odstępu dla klawisza Space) po nadpisaniu nie zostanie wywołana

uwaga: niemożliwe jest nadpisanie tą metodą zdarzenia wywołanego dla kombinacji klawiszy Alt+Ctrl+Del

uwaga: poniżej zamieszczam wszystkie znane mi oznaczenia klawiszy typu VK (ang. Virtual-Key):

VK_SHIFT - Shift
VK_CONTROL - Ctrl
VK_MENU - Alt
VK_BACK - BackSpace
VK_TAB - Tab
VK_RETURN - Enter
VK_PAUSE - Pause
VK_SNAPSHOT - PrintScreen
VK_CAPITAL - Caps Lock
VK_NUMLOCK - Num Lock
VK_SCROLL - Scroll Lock
VK_ESCAPE - Esc
VK_SPACE - Space
VK_PRIOR - Page Up
VK_NEXT - Page Down
VK_END - End
VK_HOME - Home
VK_INSERT - Insert
VK_DELETE - Delete
VK_LEFT - strzałka w lewo
VK_UP - strzałka do góry
VK_RIGHT - strzałka w prawo
VK_DOWN - strzałka w dół
VK_F1 - F1 (pozostałe analogicznie)
VK_A - litera A (pozostałe analogicznie)
VK_0 - cyfra 0 (pozostałe analogicznie)
VK_NUMPAD0 - cyfra 0 w części numerycznej (pozostałe analogicznie)
VK_MULTIPLY - gwiazdka w części numerycznej
VK_ADD - plus w części numerycznej
VK_SUBTRACT - minus w części numerycznej
VK_DECIMAL - kropka w części numerycznej
VK_DIVIDE - dzielenie w części numerycznej

uwaga: VK jest parametrem typu całkowitego i można go zastąpić numerem odczytanym z procedury OnKeyDown dla RichEdit:

procedure TForm1.RichEdit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
ShowMessage(IntToStr(Key));
end;

uwaga: rozwiązanie to pozwala nadpisać zdarzenia dla wszystkich klawiszy, również tych nie posiadających oznaczenia VK


096 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;


097 Ukrycie kursora myszy

ShowCursor(False);

uwaga: aby ponownie pokazać kursor myszy należy zamienić parametr False na True


098 Ograniczenie pola w którym może poruszać się kursor myszy

procedure TForm1.OgraniczPoleKursora(x1,x2,y1,y2: Integer);
var r: TRect;
begin
r.Left:=x1;
r.Right:=x2;
r.Top:=y1;
r.Bottom:=y2;
ClipCursor(@r);
end;


099 Zapisanie na dysku pliku z Internetu

uses UrlMon;

UrlDownloadToFile(nil,'http://www.witryna.pl/nazwa.roz','C:\sciezka\nazwa.roz',0,nil);


100 Zapisanie na dysku pliku z Internetu z podaniem identyfikatora aplikacji

uses Wininet

procedure TForm1.PobierzPlik(url,sciezka: String);
var hSession,hService: HINTERNET; dwBytesRead: DWORD;
    fs: TFileStream; lpBuffer: array [0..4096+1] of Char;
begin
fs:=TFileStream.Create(sciezka,fmCreate);
hSession:=InternetOpen('identyfikator aplikacji',INTERNET_OPEN_TYPE_PRECONFIG,nil,nil,0);
try
  if Assigned(hSession)
   then
    begin
    hService:=InternetOpenUrl(hSession,PChar(url),nil,0,0,0);
    if Assigned(hService)
     then
      try
        while True do
         begin
         dwBytesRead:=4096;
         InternetReadFile(hService,@lpBuffer,4096,dwBytesRead);
         if dwBytesRead=0
          then break;
         lpBuffer[dwBytesRead]:=#0;
         fs.Write(lpBuffer,dwBytesRead*SizeOf(Char));
         end;
       finally
        InternetCloseHandle(hService);
       end;
    end;
 finally
  InternetCloseHandle(hSession);
 end;
fs.Free;
end;


101 Zapisanie na dysku pliku z Internetu z paskiem postępu pobierania i obsługą błędów

uses IdException;

procedure TForm1.Pobierz(adres,plik: String);
var fs: TFileStream; e: Exception;
begin
try
  IdHTTP1.Head(adres);
  fs:=TFileStream.Create(plik,fmCreate);
  IdHTTP1.Get(adres,fs);
  fs.Free;
  IdHTTP1.Disconnect;
 except
  on e: EIdProtocolReplyError do
   begin
   //tu można wpisać polecenia wykonywane w przypadku braku pliku
   end;
  on e: EIdSocketError do
   begin
   //tu można wpisać polecenia wykonywane w przypadku przekierowania
   end;
 end;
end;

procedure TForm1.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
ProgressBar1.Max:=AWorkCountMax;
end;

procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
ProgressBar1.Position:=AWorkCount;
end;

procedure TForm1.IdHTTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
ProgressBar1.Position:=0;
end;

uwaga: przed uruchomieniem programu należy umieścić na formie komponent IdHTTP z zakładki Indy Clients

uwaga: aby program nie zamrażał się przy nawiązywaniu połączenia należy dodać komponent IdAntiFreeze z zakładki Indy Misc


102 Wczytanie do komponentu RichEdit kodu źródłowego strony internetowej

RichEdit1.Text:=IdHTTP1.Get('http://www.witryna.pl');

uwaga: przed uruchomieniem programu należy umieścić na formie komponent IdHTTP z zakładki Indy Clients

uwaga: adres strony musi zaczynać się od ciągu znaków http://

uwaga: aby program nie zamrażał się przy nawiązywaniu połączenia należy dodać komponent IdAntiFreeze z zakładki Indy Misc


103 Odczytanie adresu URL aktywnego okna przeglądarki Internet Explorer 6

function TForm1.AdresURL: String;
var hWndIE,hWndIEChild: HWND; buffer: array [0..255] of Char;
begin
hWndIE:=GetForegroundWindow;
if hWndIE>0
 then
  begin
  GetClassName(hWndIE,buffer,255);
  if buffer='IEFrame'
   then
    begin
    hWndIEChild:=FindWindowEx(hWndIE,0,'WorkerW',nil);
    if hWndIEChild>0
     then
      begin
      hWndIEChild:=FindWindowEx(hWndIEChild,0,'ReBarWindow32',nil);
      if hWndIEChild>0
       then
        begin
        hWndIEChild:=FindWindowEx(hWndIEChild,0,'ComboBoxEx32',nil);
        if hWndIEChild>0
         then
          begin
          SendMessage(hWndIEChild,WM_GETTEXT,255,integer(@buffer));
          Result:=buffer;
          end;
        end;
      end;
    end;
  end;
end;

uwaga: w przypadku braku otwartego okna przeglądarki internetowej powyższa funkcja zwraca pusty ciąg znaków


104 Odczytanie adresu URL aktywnego okna przeglądarki Internet Explorer 8

function TForm1.AdresURL: String;
var hWndIE,hWndIEChild: HWND; buffer: array [0..255] of Char;
begin
hWndIE:=GetForegroundWindow;
if hWndIE>0
 then
  begin
  GetClassName(hWndIE,buffer,255);
  if buffer='IEFrame'
   then
    begin
    hWndIEChild:=FindWindowEx(hWndIE,0,'WorkerW',nil);
    if hWndIEChild>0
     then
      begin
      hWndIEChild:=FindWindowEx(hWndIEChild,0,'ReBarWindow32',nil);
      if hWndIEChild>0
       then
        begin
        hWndIEChild:=FindWindowEx(hWndIEChild,0,'Address Band Root',nil);
        if hWndIEChild>0
         then
          begin
          hWndIEChild:=FindWindowEx(hWndIEChild,0,'Edit',nil);
          if hWndIEChild>0
           then
            begin
            SendMessage(hWndIEChild,WM_GETTEXT,255,integer(@buffer));
            Result:=buffer;
            end;
          end;
        end;
      end;
    end;
  end;
end;

uwaga: w przypadku braku otwartego okna przeglądarki internetowej powyższa funkcja zwraca pusty ciąg znaków


105 Odczytanie adresu URL aktywnego okna przeglądarki Firefox

uses DDEMan;

function TForm1.AdresURL: String;
var ddeClient: TDDEClientConv; s: String;
begin
s:='';
ddeClient:=TDDEClientConv.Create(Self);
if ddeClient.SetLink('Firefox','WWW_GetWindowInfo')
 then s:=ddeClient.RequestData('0xFFFFFFFF,sURL,sTitle');
s:=Copy(s,2,Length(s)-1);
Result:=Copy(s,1,Pos('","',s)-1);
end;

uwaga: w przypadku braku otwartego okna przeglądarki internetowej powyższa funkcja zwraca pusty ciąg znaków


106 Otwarcie strony internetowej

uses ShellApi;

ShellExecute(Handle,'Open','http://www.witryna.pl/',nil,nil,SW_SHOW);


107 Określenie adresu IP komputera

uses WinSock;

function TForm1.MojAdresIP: String;
var p: PHostEnt; s: array [0..128] of Char; p2: PChar;
begin
GetHostName(@s,128);
p:=GetHostByName(@s);
Result:=iNet_ntoa(PInAddr(p^.h_addr_list^)^);
end;

procedure TForm1.FormCreate(Sender: TObject);
var wVersionRequested: Word; wsaData: TWSAData;
begin
wVersionRequested:=MakeWord(1,1);
WSAStartup(wVersionRequested,wsaData);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
WSACleanup;
end;

uwaga: adresy 0.0.0.0 oraz 127.0.0.1 oznaczają że komputer nie jest podłączony do sieci


108 Określenie 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;


109 Wypisanie w komponencie ListBox adresów URL ze wszystkich otwartych okien przeglądarki

uses SHDocVw;

procedure TForm1.WypiszAdresyOkienPrzegladarki;
var i: Integer; sw: Ishellwindows; ie: IWebbrowser2;
begin
ListBox1.Items.Clear;
sw:=CoShellWindows.Create;
for i:=0 to sw.count-1 do
 begin
  ie:=sw.Item(i) as IWebbrowser2;
  if ie<>nil
   then
    ListBox1.Items.Add(AnsiLowerCase(ie.LocationUrl));
 end;
end;


110 Sprawdzanie czy komputer jest połączony z Internetem

var polaczony: Boolean;

function TForm1.CzyJestPolaczenie: Boolean;
begin
IdIcmpClient1.Host:='www.wp.pl';
IdIcmpClient1.Port:=80;
IdIcmpClient1.Ping;
Result:=polaczony;
end;

procedure TForm1.IdIcmpClient1Reply(ASender: TComponent; const AReplyStatus: TReplyStatus);
begin
if AReplyStatus.BytesReceived=0
 then polaczony:=False
 else polaczony:=True;
end;

uwaga: przed uruchomieniem programu należy umieścić na formie komponent IdHTTP z zakładki Indy Clients

uwaga: w polu Host zamiast www.wp.pl można wpisać dowolny serwer który nie odrzuca wiadomości Ping

uwaga: w polu Port zamiast 80 można wpisać dowolną liczbę całkowitą od 0 do 65535

uwaga: aby program nie zamrażał się przy nawiązywaniu połączenia należy dodać komponent IdAntiFreeze z zakładki Indy Misc


111 Ukrycie formy programu

Application.ShowMainForm:=False;

uwaga: można również zastosować polecenie:

Form1.Visible:=False;

uwaga: właściwość tę ustawić można również w inspektorze obiektów


112 Przezroczyste okno programu

procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.BorderStyle:=bsNone;
Form1.Brush.Style:=bsClear;
Form1.Refresh;
end;


113 Włączenie trybu zawsze na wierzchu dla okna programu

Form1.FormStyle:=fsStayOnTop;

uwaga: aby wyłączyć tryb zawsze na wierzchu należy zamienić parametr fsStayOnTop na fsNormal


114 Ukrycie paska tytułowego okna programu

procedure TForm1.FormCreate(Sender: TObject);
begin
SetWindowLong(Form1.Handle,GWL_STYLE,GetWindowLong(Form1.Handle,GWL_STYLE)
and not WS_CAPTION);
Height:=ClientHeight;
end;


115 Ukrycie przycisku programu 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;


116 Miganie przycisku programu na pasku zadań

procedure TForm1.Timer1Timer(Sender: TObject);
begin
FlashWindow(Application.Handle,True);
end;

uwaga: przed uruchomieniem programu należy umieścić na formie komponent Timer z parametrem Interval równym 250


117 Wyświetlenie ciągu znaków s na przycisku programu na pasku zadań

Application.Title:=s;


118 Blokada rozciągania okna programu

Form1.BorderStyle:=bsSingle;

uwaga: właściwość tę ustawić można również w inspektorze obiektów


119 Zmiana ograniczenia systemowego maksymalnych wymiarów okna programu

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;


120 Wykonanie polecenia z chwilą maksymalizacji okna programu

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 programu zostało zmaksymalizowane');
end;


121 Blokada wybranych przycisków z prawego górnego rogu okna programu

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


122 Odświeżenie wyglądu okna programu

Application.ProcessMessages;


123 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.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 zastosoać wartości TileWallpaper=0 oraz WallpaperStyle=0

uwaga: aby nadać tapecie położenie Sąsiadująco należy zastosoać wartości TileWallpaper=1 oraz WallpaperStyle=0

uwaga: aby nadać tapecie położenie Rozciągnięcie należy zastosoać wartości TileWallpaper=0 oraz WallpaperStyle=2


124 Ukrycie ikon z pulpitu

procedure TForm1.UkryjIkonyPulpitu;
var uchwyt: HWND;
begin
uchwyt:=FindWindow('Progman',nil );
ShowWindow(uchwyt,SW_HIDE);
end;

uwaga: aby ponownie pokazać ikony pulpitu należy zamienić parametr SW_HIDE na SW_SHOW


125 Sprawdzenie ścieżki pulpitu

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,lStrLen(PChar(Result)));
    end;
 finally
  if pIIL<>nil
   then shellMalloc.Free(pIIL);
 end;
end;


126 Sprawdzenie czy kolor piksela na ekranie oddalonego o x od lewej oraz y od góry jest czerwony

var cnv: TCanvas;

procedure TForm1.FormCreate(Sender: TObject);
begin
cnv:=TCanvas.Create;
end;

procedure TForm1.CzyPikselCzerwny(x,y: Integer): Boolean;
begin
cnv.Handle:=GetDC(0);
if cnv.Pixels[x,y]=RGB(255,0,0)
 then Result:=True
 else Result:=False;
end;


127 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;


128 Sprawdzenie rozdzielczości ekranu

szerokosc:=GetSystemMetrics(SM_CXSCREEN);
wysokosc:=GetSystemMetrics(SM_CYSCREEN);


129 Zmiana rozdzielczości ekranu

procedure TForm1.ZmienRozdzielczoscEkranu(szerokosc,wysokosc: Integer);
var mode: TDeviceMode;
begin
with mode do
 begin
 dmSize:=SizeOf(mode);
 dmBitsPerPel:=16;
 dmPelsWidth:=szerokosc;
 dmPelsHeight:=wysokosc;
 dmFields:=DM_PELSWIDTH+DM_PELSHEIGHT;
 ChangeDisplaySettings(mode,0)
 end;
end;


130 Sprawdzenie szerokości i wysokości tekstu komponentu Label

szerokosc:=Label1.Canvas.TextWidth(Label1.Caption);
wysokosc:=Label1.Canvas.TextHeight(Label1.Caption);


131 Umieszczenie komponentu Label na komponencie ProgressBar

Label1.Parent:=ProgressBar1;
Label1.Top:=1;
Label1.Left:=2;


132 Zmiana koloru komponentu ProgressBar

uses CommCtrl;

SendMessage(Progressbar1.Handle,PBM_SETBARCOLOR,0,clRed);


133 Zamaskowanie gwiazdkami tekstu wprowadzanego w okno InputQuery

private
 procedure InputQueryPassword(var msg: TMessage); message WM_USER+123;

procedure TForm1.InputQueryPassword(var msg: TMessage);
var f: TForm; e: TEdit; i: Integer;
begin
f:=Screen.ActiveForm;
if (f<>nil) and (f.Handle=GetLastActivePopup(Application.Handle))
 then
  begin
  e:=nil;
  i:=0;
  while (i<f.ComponentCount) and (e=nil) do
   begin
   if f.Components[i] is TEdit
    then e:=TEdit(f.Components[i]);
   Inc(i);
   end;
  if e<>nil
   then e.PasswordChar:='*';
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var haslo: String;
begin
PostMessage(Handle,WM_USER+123,0,0);
if InputQuery('','Wprowadz hasło',haslo)
 then ShowMessage(haslo);
end;


134 Konwersja czasu z liczby sekund do postaci hh:mm:ss

function TForm1.SecondsToStr(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;


135 Konwersja czasu z liczby milisekund do postaci hh:mm:ss

function TForm1.MilisekundyNaCzas(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;


136 Konwersja czasu do postaci 2000-12-31 23:59:59 999

s:=FormatDateTime('yyyy-mm-dd hh:mm:ss zzz',now);


137 Określenie aktualnej daty

s:=DateToStr(now);


138 Precyzyjne określenie czasu pracy systemu

n:=GetTickCount;

uwaga: powyższa funkcja zwraca liczbę milisekund od chwili uruchomienia komputera


139 Uśpienie aplikacji na zadany okres czasu

Sleep(1000);

uwaga: parametr powyższej funkcji to czas uśpienia w milisekundach

uwaga: uśpienie aplikacji wiąże się z całkowitym zamrożeniem programu


140 Wstrzymanie wątku na zadany okres czasu

procedure TForm1.DelayMS(ms: Cardinal);
var stopTime: Cardinal;
begin
stopTime:=GetTickCount+ms;
while (GetTickCount<stopTime) do
 begin
 Application.ProcessMessages;
 Sleep(1);
 end;
end;

uwaga: parametr powyższej procedury to czas wstrzymania w milisekundach

uwaga: powyższa procedura nie zamraża programu a jedynie wstrzymuje aktualny wątek


141 Przesuwanie zmiennej dt typu 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


142 Sprawdzenie czy dany dzień wypada w okresie stosowania czasu letniego

uses DateUtils;

function TForm1.CzyCzasLetni(data: TDateTime): Boolean;
var start,stop: TDateTime; tz: TTimeZoneInformation; i: Integer;
begin
GetTimeZoneInformation(tz);
start:=EncodeDateTime(YearOf(data),tz.DaylightDate.wMonth,1,
       tz.DaylightDate.wHour,tz.DaylightDate.wMinute,tz.DaylightDate.wSecond,0);
if tz.DaylightDate.wDay=5
 then
  begin
  start:=DateOf(EndOfTheMonth(start))+TimeOf(start);
  while Pred(DayOfWeek(start))<>tz.DaylightDate.wDayOfWeek do
   start:=IncDay(start,-1)
  end
 else
  begin
  while Pred(DayOfWeek(start))<>tz.DaylightDate.wDayOfWeek do
   start:=IncDay(start);
  for i:=1 to Pred(tz.DaylightDate.wDay) do
   start:=IncWeek(start)
  end;
stop:=EncodeDateTime(YearOf(data),tz.StandardDate.wMonth,1,
      tz.StandardDate.wHour,tz.StandardDate.wMinute,tz.StandardDate.wSecond,0);
if tz.StandardDate.wDay=5
 then
  begin
  stop:=DateOf(EndOfTheMonth(stop))+TimeOf(stop);
  while Pred(DayOfWeek(stop))<>tz.StandardDate.wDayOfWeek do
   stop:=IncDay(stop,-1)
  end
 else
  begin
  while Pred(DayOfWeek(stop))<>tz.StandardDate.wDayOfWeek do
   stop:=IncDay(stop);
  for i:=1 to Pred(tz.StandardDate.wDay) do
   stop:=IncWeek(stop)
  end;
Result:=(data>=start) and (data<stop);
end;


143 Sprawdzenie 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,pi,w: Double;
begin
pi:=3.14159265358979;
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ę według czasu uniwersalnego (Greenwich)

uwaga: powyższa funkcja nie uwzględnia stosowania czasu letniego


144 Sprawdzenie 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,pi,z: Double;
begin
pi:=3.14159265358979;
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ę według czasu uniwersalnego (Greenwich)

uwaga: powyższa funkcja nie uwzględnia stosowania czasu letniego


145 Sprawdzenie czy dany rok jest przestępny

if IsLeapYear(r) then ShowMessage('Ten rok jest przestępny');


146 Sprawdzenie czy ciąg znaków zawiera datę 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;


147 Sprawdzenie czy ciąg znaków zawiera czas 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;


148 Sprawdzenie czy ciąg znaków zawiera czas 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;


149 Automatyczne zamkniecie programu jeżeli jest już uruchomiona jego kopia

var h: THandle;

procedure TForm1.FormCreate(Sender: TObject);
begin
h:=CreateFileMapping(THandle($FFFFFFFF),nil,PAGE_READONLY,0,32,'UniCodeG8BH76B6B6H8DS0');
if GetLastError=ERROR_ALREADY_EXISTS
 then Application.Terminate;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
CloseHandle(h);
end;

uwaga: ciąg znaków UniCode musi być niepowtarzalny, zatem sam stwórz ciąg przypadkowych znaków o dowolnej długości


150 Bezwarunkowe zamknięcie programu

Application.Terminate;


151 Zamknięcie programu 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


152 Zmiana wymiarów obrazu bez zmiany proporcji

procedure TForm1.DopasujRozmiarObrazu(maxSzerokosc,maxWysokosc: Integer);
begin
Image1.Width:=maxSzerokosc;
Image1.Height:=maxWysokosc;
Image1.Proportional:=True;
Image1.Stretch:=True;
end;


153 Wyświetlenie obrazu typu jpeg

uses Jpeg;

Image1.Picture.LoadFromFile('C:\sciezka\nazwa.jpeg');


154 Ukrycie wszystkich przycisków typu Button

procedure TForm1.UkryjPrzyciski;
var i: Integer;
begin
for i:=0 to ControlCount-1 do
 if Controls[i] is TButton
  then Controls[i].Visible:=False;
end;


155 Pojedyncze odtworzenie dźwięku

procedure TForm1.OdtworzDzwiek(plik: String);
begin
MediaPlayer1.FileName:=plik;
MediaPlayer1.Open;
MediaPlayer1.Play;
end;

uwaga: przed uruchomieniem programu należy umieścić na formie komponent MediaPlayer z zakładki System

uwaga: w ten sam sposób odtwarzać można dźwięki zapisane w innych formatach, przykładowo mp3 lub wmv


156 Okno wyboru tak lub nie w języku polskim

if MessageBox(0,'Czy jesteś pewien że chcesz to zrobić?','Potwierdzenie',MB_YESNO)=mrYes
 then ShowMessage('Wybrano opcję Tak');
 else ShowMessage('Wybrano opcję Nie');


157 Zamknięcie okna dowolnego programu o tytule t

procedure TForm1.ZamknijOkno(t: String);
var h: THandle;
begin
h:=FindWindow(nil,PChar(t));
SendMessage(h,WM_CLOSE,0,0);
end;


158 Przesunięcie obszaru roboczego komponentu typu StringGrid tak aby widoczna była komórka [x,y]

procedure TForm1.PrzesunStringGrid(x,y: Integer);
begin
StringGrid1.LeftCol:=x;
StringGrid1.TopRow:=y;
end;


159 Przeniesienie kursora do komórki [x,y] komponentu StringGrid

procedure TForm1.KursorDoKomorki(x,y: Integer);
begin
StringGrid1.SetFocus;
StringGrid1.Selection:=TGridRect(Rect(x,y,x,y));
end;

uwaga: jeżeli SetFocus ustawiony zostanie na innym komponencie to pole [x,y] zostanie podświetlone


160 Ustawienie kursora na końcu tekstu wyświetlanego w komponencie Edit

procedure TForm1.UstawKursor;
begin
Edit1.SetFocus;
Edit1.SelStart:=Length(Edit1.Text);
end;


161 Ustawienie kursora na początku 10 wiersza w komponencie RichEdit

procedure TForm1.UstawKursor;
begin
RichEdit1.SetFocus;
RichEdit1.SelStart:=RichEdit1.Perform(EM_LINEINDEX,9,0);
end;


162 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.OnMouseDown:=LabelMouseDown;
nowyLabel.OnMouseMove:=LabelMouseMove;
end;

procedure TForm1.LabelMouseMove(Sender: TObject);
begin
(Sender as TLabel).Caption:='To jest '+(Sender as TLabel).Name;
end;

procedure TForm1.LabelMouseDown(Sender: TObject);
begin
(Sender as TLabel).Free;
end;


163 Odwołanie się do komponentu o danej nazwie

TLabel(FindComponent('Label'+IntToStr(1))).Caption:='tekst';


164 Blokada menu Alt+Ctrl+Del

var oldValue: LongBool;

SystemParametersInfo(97,Word(True),@oldValue,0);

uwaga: aby odblokować menu Alt+Ctrl+Del należy zamienić parametr True na False


165 Usunięcie nazwy programu z listy menu Alt+Ctrl+Del

function RegisterServiceProcess(pid,num: Longint): Boolean; StdCall;
 External 'kernel32.dll' name 'RegisterServiceProcess';

procedure TForm1.FormCreate(Sender: TObject);
begin
RegisterServiceProcess(0,1);
end;

uwaga: pod Windows XP powyższe polecenie nie zadziała i należy zastosować poniższe polecenie:

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.Title:='';
end;


166 Wypisanie w komponencie ListBox tytułów, typów oraz uchwytów wszystkich otwartych okien

function EnumWindowsProc(wHandle: HWND): Boolean; StdCall; Export;
var title,className: array [0..128] of Char; sTitle,sClass,sLine: String;
begin
 Result:=True;
 GetWindowText(wHandle,title,128);
 GetClassName(wHandle,className,128);
 sTitle:=title;
 sClass:=className;
 if IsWindowVisible(wHandle)
  then
   begin
   sLine:=sTitle+'/'+sClass+'/'+IntToStr(wHandle);
   Form1.Listbox1.Items.Add(sLine);
   end;
end;

EnumWindows(@EnumWindowsProc,0);

uwaga: usuwając warunek IsWindowVisible(wHandle) otrzymamy listę wszystkich uruchomionych procesów, również tych ukrytych


167 Określenie uchwytu okna o znanym tytule

var uchwyt: HWND;

uchwyt:=FindWindow(nil,PChar('Tytuł okna'));

uwaga: w przypadku gdyby kilka okien miało ten sam tytuł to uchwycone zostanie to okno które było używane jako ostatnie


168 Określenie uchwytu okna danego typu

var uchwyt: HWND;

uchwyt:=FindWindow(PChar('Typ okna'),nil);

uwaga: w przypadku gdyby kilka okien było tego samego typu to uchwycone zostanie to okno które było używane jako ostatnie


169 Zamknięcie okna gdy znany jest jego uchwyt

PostMessage(uchwyt,WM_CLOSE,0,0);


170 Zminimalizowanie lub zmaksymalizowanie okna gdy znany jest jego uchwyt

ShowWindow(uchwyt,SW_MAXIMIZE);

uwaga: parametr SW_MAXIMIZE spowoduje że okno zostanie zmaksymalizowane

uwaga: parametr SW_MINIMIZE spowoduje że okno zostanie zminimalizowane


171 Przesunięcie okna na wierzch lub na spód względem innych okien gdy znany jest jego uchwyt

SetWindowPos(uchwyt,HWND_BOTTOM,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE);

uwaga: parametr HWND_BOTTOM spowoduje że okno zostanie przesunięte na spód

uwaga: parametr HWND_TOP spowoduje że okno zostanie przesunięte na wierzch

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


172 Sprawdzenie czy okno o danym uchwycie istnieje

if IsWindow(uchwyt)
 then ShowMessage('Okno istnieje')
 else ShowMessage('Okno nie istnieje');


173 Sprawdzenie czy okno jest widoczne gdy znany jest jego uchwyt

if IsWindowVisible(uchwyt)
 then ShowMessage('Okno jest widoczne')
 else ShowMessage('Okno nie jest widoczne');


174 Sprawdzenie czy okno jest zminimalizowane gdy znany jest jego uchwyt

if IsIconic(uchwyt)
 then ShowMessage('Okno jest zminimalizowane')
 else ShowMessage('Okno nie jest zminimalizowane');


175 Sprawdzenie czy okno jest zmaksymalizowane gdy znany jest jego uchwyt

if IsZoomed(uchwyt)
 then ShowMessage('Okno jest zmaksymalizowane')
 else ShowMessage('Okno nie jest zmaksymalizowane');


176 Sprawdzenie czy okno jest w trybie zawsze na wierzchu gdy znany jest jego uchwyt

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');


177 Określenie identyfikatora procesu danego uchwytu

function TForm1.HandleToPid(uchwyt: HWND): Cardinal;
var PID: DWORD;
begin
GetWindowThreadProcessId(uchwyt,@PID);
Result:=PID;
end;


178 Wypisanie w komponencie ListBox wszystkich uchwytów danego procesu

procedure TForm1.HandleListOfPid(PID: Cardinal);
var uchwyt: HWND; tPID: Cardinal;
begin
uchwyt:=GetWindow(Application.Handle,GW_HWNDFIRST);
GetWindowThreadProcessId(uchwyt,tPID);
while uchwyt<>0 do
 begin
 GetWindowThreadProcessId(uchwyt,tPID);
 uchwyt:=GetWindow(uchwyt,GW_HWNDNEXT);
 if tPID=PID
  then ListBox1.Items.Add(IntToStr(uchwyt));
 end;
end;

uwaga: zazwyczaj do jednego procesu przypisanych jest wiele uchwytów okien z których część jest niewidoczna


179 Określenie identyfikatora procesu należącego do pliku nazwa.exe

uses Tlhelp32;

function TForm1.GetPid(name: String): Cardinal;
var next: Boolean; h: THandle; p: TProcessEntry32;
begin
Result:=0;
h:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
p.dwSize:=Sizeof(p);
next:=Process32First(h,p);
while next do
 begin
 if (AnsiLowerCase(ExtractFileName(p.szExeFile))=AnsiLowerCase(name))
  then Result:=p.th32ProcessID;
 next:=Process32Next(h,p);
 end;
CloseHandle(h);
end;


180 Wypisanie w komponencie ListBox identyfikatorów i plików wszystkich uruchomionych procesów

uses Tlhelp32;

procedure TForm1.ListaProcesow;
var next: Boolean; h: THandle; p: TProcessEntry32;
begin
h:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
p.dwSize:=Sizeof(p);
next:=Process32First(h,p);
while next do
 begin
 ListBox1.Items.Add('PID='+IntToStr(p.th32ProcessID)+' ('+p.szExeFile+')');
 next:=Process32Next(h,p);
 end;
CloseHandle(h);
end;


181 Zakończenie procesu

uses Tlhelp32;

procedure TForm1.KillProcess(pid: Cardinal);
var next: Boolean; h: THandle; p: TProcessEntry32;
begin
h:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
p.dwSize:=SizeOf(p);
next:=Process32First(h,p);
while next do
 begin
 if p.th32ProcessID=pid
  then TerminateProcess(OpenProcess($0001,Boolean(0),p.th32ProcessID),0);
 next:=Process32Next(h,p);
 end;
CloseHandle(h);
end;


182 Wypisanie w komponencie ListBox identyfikatorów wszystkich wątków danego procesu

uses Tlhelp32;

procedure TForm1.ListaWatkowProcesu(pid: Cardinal);
var next: Boolean; h: THandle; t: TThreadEntry32;
begin
h:=CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD,0);
if h<>INVALID_HANDLE_VALUE
 then
  try
    t.dwSize:=SizeOf(t);
    next:=Thread32First(h,t);
    while next do
     begin
     if t.th32OwnerProcessID=pid
      then ListBox1.Items.Add('TID='+IntToStr(t.th32ThreadID));
     next:=Thread32Next(h,t);
     end;
    finally
     CloseHandle(h);
    end;
end;


183 Prawidłowe wyświetlanie polskich liter przy zapisywaniu zawartości komponentu RichEdit do pliku typu HTML

Należy zakodować dokumkent HTML zgodnie ze standardem ISO-8859-2, a przed zapisaniem zastosować funkcję:

function TForm1.CP2CP(srcStr:PChar; CP1,CP2: Integer; errorCode: PInteger): String;
var ws: PWideChar; ms: PChar; errorC,wSize,bSize: Integer; b: Bool; c: Char;
begin
b:=False;
c:='#';
Result:='';
try
  wSize:=MultiByteToWideChar(CP1,1 or 0,PChar(srcStr),-1,ws,0);
  GetMem(ws,wSize*SizeOf(WideChar));
  errorC:=MultiByteToWideChar(CP1,1 or 0,PChar(srcStr),-1,ws,wSize);
  if errorC<>0
   then
    try
      bSize:=WideCharToMultibyte(CP2,0,ws,-1,ms,0,@c,@b);
      GetMem(ms,BSize*SizeOf(Char));
      errorC:=WideCharToMultibyte(CP2,0,ws,-1,ms,bSize,@c,@b);
      if b
       then errorC:=-1;
      if errorC<>0
       then Result:=ms;
     finally
      FreeMem(ms,bSize*SizeOf(Char));
     end;
 finally
  FreeMem(ws,wSize*SizeOf(WideChar));
 end;
if errorCode<>nil
 then errorCode^:=errorC;
end;

RichEdit1.Text:=CP2CP(PChar(RichEdit1.Text),1250,28592,nil);

uwaga: przy wczytywaniu zawartości pliku html do RichEdit należy wywołać konwersję odwrotną:

RichEdit1.Text:=CP2CP(PChar(RichEdit1.Text),28592,1250,nil);


184 Zapisanie zawartości komponentu RichEdit do pliku bez dodatkowych, automatycznie generowanych znaków

RichEdit1.PlainText:=True;


185 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


186 Struktura pętli z użyciem polecenia goto

procedure TForm1.PetlaGoTo;
var i: integer; label A;
begin
i:=0;
A:
i:=i+1;
if i<8
 then goto A;
end;

uwaga: polecenie goto powoduje zakończenie wykonywania poleceń i ponowne rozpoczęcie od miejsca A: typu label


187 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');


188 Tablica dynamiczna

var tablica: array of String;

SetLength(tablica,2);
tablica[0]:='1';
tablica[1]:='2';


189 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


190 Zwiększenie maksymalnej pojemności komponentu RichEdit do 1 GB teskstu

RichEdit1.MaxLength:=1073741824;

uwaga: wartość 1073741824 wynika z podniesienia liczby 2 do potęgi 30


191 Utworzenie listy liter którymi oznaczone są dostępne partycje

function TForm1.ListaPartycji: String;
var litera: Char;
begin
Result:='';
for litera:='A' to 'Z' do
 if GetDriveType(PChar(litera+':\'))=DRIVE_FIXED
  then Result:=Result+litera;
end;


192 Automatyczne przerzucanie tekstu do następnej linijki w komponencie RichEdit

RichEdit1.WordWrap:=False;

uwaga: właściwość tę ustawić można również w inspektorze obiektów


193 Poziomy suwak w komponencie ListBox

procedure TForm1.PoziomySuwak;
var szerokosc: Integer;
begin
ListBox1.Canvas.Font:=ListBox1.Font;
szerokosc:=0;
for i:=0 to ListBox1.Items.Count-1 do
 if ListBox1.Canvas.TextWidth(ListBox1.Items[i])>szerokosc
  then szerokosc:=ListBox1.Canvas.TextWidth(ListBox1.Items[i]);
SendMessage(ListBox1.Handle,LB_SETHORIZONTALEXTENT,szerokosc+5,0);
end;

uwaga: powyższą procedurę należy wywołać po każdej zmianie zbioru elementów (dodanie lub usunięcie) w komponencie ListBox


194 Usunięcie konkretnego wiersza z komponentów RichEdit i ListBox

RichEdit1.Lines.Delete(n);

ListBox1.Items.Delete(n);


195 Białe kontenery kolorów niestandardowych w komponencie ColorDialog

ColorDialog1.CustomColors.Add('ColorA=FFFFFF');
ColorDialog1.CustomColors.Add('ColorB=FFFFFF');
ColorDialog1.CustomColors.Add('ColorC=FFFFFF');
ColorDialog1.CustomColors.Add('ColorD=FFFFFF');
ColorDialog1.CustomColors.Add('ColorE=FFFFFF');
ColorDialog1.CustomColors.Add('ColorF=FFFFFF');
ColorDialog1.CustomColors.Add('ColorG=FFFFFF');
ColorDialog1.CustomColors.Add('ColorH=FFFFFF');
ColorDialog1.CustomColors.Add('ColorI=FFFFFF');
ColorDialog1.CustomColors.Add('ColorJ=FFFFFF');
ColorDialog1.CustomColors.Add('ColorK=FFFFFF');
ColorDialog1.CustomColors.Add('ColorL=FFFFFF');
ColorDialog1.CustomColors.Add('ColorM=FFFFFF');
ColorDialog1.CustomColors.Add('ColorN=FFFFFF');
ColorDialog1.CustomColors.Add('ColorO=FFFFFF');
ColorDialog1.CustomColors.Add('ColorP=FFFFFF');

uwaga: właściwości te ustawić można również w inspektorze obiektów


196 Ustawienie tekstowego kursora w komponencie RichEdit w wierszu Y oraz na pozycji X

RichEdit1.CaretPos:=Point(X,Y);


197 Przesunięcie obszaru roboczego komponentu RichEdit na samą górę

SendMessage(RichEdit1.Handle,WM_VSCROLL,SB_TOP,0);


198 Przesunięcie obszaru roboczego komponentu RichEdit o 10 wierszy w dół

SendMessage(RichEdit1.Handle,EM_LINESCROLL,0,10);


199 Przesunięcie obszaru roboczego komponentu RichEdit o 10 wierszy w górę

SendMessage(RichEdit1.Handle,EM_LINESCROLL,0,-10);


200 Przesunięcie obszaru roboczego komponentu RichEdit tak aby widoczny był kursor tekstowy

SendMessage(RichEdit1.Handle,EM_SCROLLCARET,0,0);


201 Określenie numeru pierwszego wiersza widocznego w komponencie RichEdit

n:=RichEdit1.Perform(EM_GETFIRSTVISIBLELINE,0,0);


202 Przesunięcie obszaru roboczego komponentu RichEdit tak aby n-ty wiersz był pierwszym widocznym

SendMessage(RichEdit1.Handle,WM_VSCROLL,SB_TOP,0);
RichEdit1.Perform(EM_LINESCROLL,0,n);


203 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 tekstowego 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;


204 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 tekstowego 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 tekstowego 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;


205 Określenie ścieżki katalogu w którym jest zainstalowany system Windows

function TForm1.SciezkaWindows: String;
var wDir: array [0..255] of Char;
begin
GetWindowsDirectory(wDir,SizeOf(wDir));
Result:=wDir;
end;


206 Określenie ścieżki katalogu systemowego

function TForm1.SciezkaSystemu: String;
var wDir: array [0..255] of Char;
begin
GetSystemDirectory(wDir,SizeOf(wDir));
Result:=wDir;
end;


207 Określenie ścieżki profilu użytkownika

function TForm1.SciezkaProfiluUzytkownika: String;
var p: PChar; s: String;
begin
GetMem(p,128);
GetTempPath(144,p);
s:=PChar(p);
Result:=Copy(s,1,Length(s)-15);
FreeMem(p);
end;


208 Pole edycyjne do którego można wpisać tylko liczbę naturalną

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if not ((Key in ['0'..'9']) or (Ord(Key)=8))
 then Key:=#0;
end;

uwaga: liczba 8 jest numerem porządkowym klawisza BackSpace który również jest tym przypadku dozwolony


209 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;


210 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)


211 Zmiana priorytetu programu

SetPriorityClass(GetCurrentProcess,HIGH_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: priorytety powyżej i poniżej normalnego nie posiadają nazw i konieczne jest stosowanie wartości liczbowych

uwaga: priorytet domyślny to NORMAL_PRIORITY_CLASS


212 Uruchomienie komendy wiersza poleceń

WinExec('command.com /c ipconfig /renew',SW_HIDE);

uwaga: komenda "ipconfig /renew" powoduje odnowienie konfiguracji sieci IP dla wszystkich kart sieciowych


213 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


214 Zmienna typu StringList 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');
sl.Strings[0]:='Zmodyfikowany wiersz pierwszy';
sl.Strings[sl.Count-1]:='Zmodyfikowany wierwsz ostatni';
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 zmiennej typu StringList jest znacznie szybsze niż w przypadku komponentu RichEdit


215 Sprawdzenie czy schowek zawiera tekst

uses ClipBrd;

if Clipboard.HasFormat(CF_TEXT)
 then ShowMessage('Schowek zawiera tekst')
 else ShowMessage('Schowek nie zawiera tekstu');


216 Skopiowanie tekstu z komponentu RichEdit do schowka

uses ClipBrd;

ClipBoard.AsText:=RichEdit1.Text

uwaga: w analogiczny sposób można skopiować tekst ze schowka do komponentu RichEdit


217 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;


218 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);
var selStart: Integer;
begin
if Clipboard.HasFormat(CF_TEXT)
 then RichEdit1.SelText:=ClipBoard.AsText;
end;


219 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;


220 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]);


221 Wyłączenie powiadomień o błędach programu

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;


222 Wyłączenie migania zaznaczonego komponentu ScrollBar

ScrollBar1.TabOrder:=False;


223 Sprawdzenie czy klucz rejestru istnieje

uses Registry;

function TForm1.CzyKluczIstnieje(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)


224 Sprawdzenie czy wartość klucza rejestru istnieje

uses Registry;

function TForm1.CzyWartoscKluczaIstnieje(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.Free;
 end;
end;


225 Dodanie wartości klucza rejestru

uses Registry;

procedure TForm1.DodajWartoscKluczaRejestru(korzen: HKEY; klucz,nazwa,wartosc: String);
var reg: TRegistry;
begin
reg:=TRegistry.Create;
try
  reg.RootKey:=korzen;
  reg.OpenKey(klucz,True);
  reg.WriteString(nazwa,wartosc);
 finally
  reg.Free;
 end;
end;

uwaga: funkcja WriteBinaryData dodaje wartość typu REG_BINARY

uwaga: funkcja WriteExpandString dodaje wartość typu REG_EXPAND_SZ

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


226 Usunięcie wartości klucza rejestru

uses Registry;

procedure TForm1.UsunWartoscKluczaRejestru(korzen: HKEY; klucz,nazwa: String);
var reg: TRegistry;
begin
reg:=TRegistry.Create;
try
  reg.RootKey:=korzen;
  reg.OpenKey(klucz,True);
  reg.DeleteValue(nazwa);
 finally
  reg.Free;
 end;
end;


227 Wyświetlenie komunikatu ShowMessage z podziałem tekstu na linie

ShowMessage('pierwsza linia'+#13#10+'druga linia'+#13#10+'trzecia linia');


228 Równoległe wykonywanie operacji 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;


229 Określenie numeru seryjnego partycji

uses Tlhelp32;

function TForm1.VolumeSerialNumber(volume: String): DWORD;
var bufor: array [0..255] of Char; maxCompLength,fileSystemFlags,serial: DWORD;
begin
GetVolumeInformation(PChar(volume+':\'),bufor,SizeOf(bufor)
,@serial,maxCompLength,fileSystemFlags,nil,0);
Result:=serial;
end;


230 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