1.Jak zrobić pasek gradientowy?
gradient, tło, instalator

Należy narysować wiele prostokątów (poziomo lub pionowo) stopniowo zmieniając im kolor. Np.:

procedure TForm1.FormPaint(Sender: TObject);
const N=100;
var Y:Integer;
    Cl:TColor;
begin
 for Y:=0 to N-1 do
 with Canvas do
 begin
  Cl:=RGB(0,0,Round(50+205*(Y/N)));
  Pen.Color:=Cl;
  Brush.Color:=cl;
  Rectangle(0,Round(ClientHeight*(Y/N)),ClientWidth,Round(ClientHeight*((Y+1)/N)));
 end;
end;

Spowoduje to dodanie do formy tła jakie często występuje w programach instalacyjnych. Aby nie występowały problemy przy zmianie rozmiarów formy należy dodać jeszcze poniższy kod:

procedure TForm1.FormResize(Sender: TObject);
begin
 Invalidate;
end;

2.Jak przejść z jednego komponentu TEdit do drugiego przy pomocy Entera (domyślnie przechodzi się przy pomocy Tab)?
Tab, Enter, TEdit, klawisz

Należy zmienić obsługę klawisza Enter w każdym z komponentów. Przykładowy kod:

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
 if Key=#13 then
 begin
  Perform(wm_NextDlgCtl,0,0);
  Key:=#0;
 end;
end;

Do każdego komponentu TEdit należy podstawić powyższą procedurę jako obsługę zdarzenia OnKeyPress.Można to zrobić klikając na formie z wciśniętym klawiszem Shift na każdym komponencie TEdit a następnie w okienku ObjectInspector klikając podwójnie na polu OnKeyPress (w okienku nie będzie widoczna nazwa komponentu).

Krzysztof Świątkowski zwrócił mi uwagę na trochę odmienne podejście. Zamiast powyższego dodajemy do formy obsługę:

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if (Key=VK_RETURN) and ([ssCtrl,ssShift]*Shift=[]) then
  Perform(WM_NEXTDLGCTL,0,0);
end;

Dodatkowo ustawiamy właściwość formy KeyPreview na True. Wtedy Enter działa jak Tab na całej formie a nie tylko wybranych kontrolkach.

Źródło informacji: Krzysztof Świątkowski.

3.Gdzie można znaleźć archiwum grupy pl.comp.lang.delphi?
archiwum, pl.comp.lang.delphi

Na stronie DejaNews znajduje się archiwum wszystkich grup dyskusyjnych. Korzystając z tamtejszej wyszukiwarki należy zdefiniować filtr obejmujący szukaną grupę. Można też ściągnąć archiwum grupy wraz z przeszukiwarką z mojej strony.

4.Gdzie można znaleźć informacje i nagłówki do DirectX?
DirectX, Blake Stone, DelphiX, DelphiJedi

Informacje o DirectX oraz pliki nagłówkowe w formacie *.H (do języka C) można znaleźć na stronach firmy Microsoft dotyczących Microsoft Software Development Network. Jeśli jesteś tam po raz pierwszy to będziesz musiał się zarejestrować (jest to bezpłatne). Czasem można znaleźć DirectX SDK (Software Development Kit) na płytach CD dołączanych do czasopism komputerowych. Przetłumaczone pliki nagłówkowe znajdują się na stronach Blake'a Stone chociaż trudno jest się tam dostać. Mirror nagłówków prowadzi również Radosław Przybył. Na DSP znajduje się również biblioteka DelphiX znacznie ułatwiająca pisanie programów pod DirectX. Warto też zajrzeć na strony projektu JEDI.

5.Co to jest DSP?
DSP, sunsite.icm.edu.pl

Delphi Super Page prowadzona jest przez Roberta Czerwińskiego na serwerze ICM. Jest to jedna z największych (o ile nie największa) biblioteka komponentów do Delphi, C++Buildera i JBuildera na świecie. Jeśli czegoś nie ma na DSP to raczej małe są szanse, że w ogóle istnieje :-). DSP ma również wiele mirrorów poza Polską.

6.Co się stało z procedurą Delay z TurboPascala? Jak mam zrobić w Delphi pauzę?
Delay, pauza

Nie ma w Delphi zaimplementowanej procedury Delay. Można jako jej zamiennika użyć funkcji WinAPI o nazwie Sleep. Powoduje ona zawieszenie wykonania programu na określoną liczbę milisekund. Jednakże w tym czasie Twoja aplikacja nie będzie mogła obsługiwać komunikatów Windows. Dlatego też czasem lepszym rozwiązaniem jest użycie takiego kodu:

procedure TForm1.Button1Click(Sender: TObject);
var Teraz:TDateTime;
begin
 // Tu wstawiamy operacje wykonywane przed pauzą

 Teraz:=Now;
 repeat
  Application.ProcessMessages; // Pozwalamy aplikacji obsłużyć komunikaty
 until Teraz+5/SecsPerDay<Now;  // 5 to liczba sekund pauzy

 // Tu operacje wykonywane po pauzie
end;

Należy pamiętać o ważnej rzeczy: powyższy kod nie gwarantuje że inne procedury obsługi zdarzeń nie zostaną wykonane a tylko, że wykonanie kodu tej procedury zostanie wstrzymane na kilka sekund.

7.Jak drukować tekstowo w Delphi?
drukowanie, tekst

Należy korzystać z funkcji WinAPI operujących na drukarkach:

uses WinSpool,Printers;

procedure TForm1.Button1Click(Sender: TObject);
var Size,n:Integer;
    H:THandle;
    Info:PAddJobInfo1;
    F:TextFile;
    sPrinterName,sDriver,sPort:array[0..255]of Char; // sDriver i sPort nie będą
                                                     // wykorzystane
begin
 Printer.GetPrinter(sPrinterName,sDriver,sPort,h);

 OpenPrinter(sPrinterName,H,nil);
 try
  AddJob(H,1,nil,0,Size); // pobranie rozmiaru bufora

  GetMem(Info,Size);

  try
   // Poniższa funkcja zwraca nam nazwę pliku do którego możemy zapisywać
   AddJob(H,1,Info,Size,n);

   // Tutaj zapisujemy do pliku
   AssignFile(F,Info^.Path);Rewrite(F);
   try
    Writeln(F,'Hello world!');
    Writeln(F,'To jest test drukowania tekstowego...');
   finally
    CloseFile(F);
   end;

   // Wrzucamy plik do kolejki drukowania, potem Windows go skasuje
   ScheduleJob(H,Info^.JobId);
   finally
    // Zwalniamy pamięć...
    FreeMem(Info,Size);
   end;
 finally
  // ...i drukarkę
  ClosePrinter(H);
 end;
end;

Można też spróbować innego sposobu. Użyć CreateFile aby otrzymać uchwyt do LPT1:

LPTHandle:=CreateFile('LPT1',GENERIC_WRITE,0,PSecurityAttributes(nil),
                      OPEN_EXISTING, FILE_FLAG_OVERLAPPED,0);

Następnie użyć WriteFile aby wysłać kolejne znaki lub:

while not TransmitCommChar(LPTHandle,CharToSend) do Application.ProcessMessages;

Powyższy kod wysyła kolejne znaki na port równoległy za każdym razem czekając na obsłużenie znaku przez drukarkę.

Bogdan Polak zwrócił mi uwagę, że w nowszych wersjach Delphi deklaracja nagłówka funkcji AddJob w pliku winspool.pas wygląda tak:

parametr pcbNeeded jest typu DWORD, a w powyższym przykładzie użyto zmiennych Integer.

Krzysztof Świątkowski zwrócił uwagę na wadę powyższego rozwiązania. Nie zawsze działa ono poprawnie dla drukarek sieciowych. Oto jego propozycja:

function DirectPrint( const PrinterName : string;Data : PByte;
                      DataLen : Cardinal; out Error : string) : Boolean;
var
  hPrinter : THandle;
  DocInfo : TDocInfo1;
  Job, DataWritten : Cardinal;
begin
  Error := 'Unknown Error';
  Result := False;
  if not OpenPrinter(PChar(PrinterName), hPrinter, nil) then begin
    Error := SysErrorMessage(GetLastError);
    Exit;
  end;
  DocInfo.pDocName := 'My Document name';
  DocInfo.pOutputFile := nil;
  DocInfo.pDatatype := 'RAW';

  Job := StartDocPrinter(hPrinter, 1, @DocInfo);
  if Job=0 then begin
    Error := SysErrorMessage(GetLastError);
    ClosePrinter(hPrinter);
    Exit;
  end;

  if not StartPagePrinter( hPrinter ) then begin
    Error := SysErrorMessage(GetLastError);
    EndDocPrinter(hPrinter);
    ClosePrinter(hPrinter);
    Exit;
  end;

  if not WritePrinter(hPrinter, Data, DataLen, DataWritten) then begin
    Error := SysErrorMessage(GetLastError);
    EndPagePrinter(hPrinter);
    EndDocPrinter(hPrinter);
    ClosePrinter(hPrinter);
    Exit;
  end;

  if not EndPagePrinter(hPrinter) then begin
    Error := SysErrorMessage(GetLastError);
    EndDocPrinter(hPrinter);
    ClosePrinter(hPrinter);
    Exit;
  end;

  if not EndDocPrinter(hPrinter) then begin
    Error := SysErrorMessage(GetLastError);
    EndDocPrinter(hPrinter);
    ClosePrinter(hPrinter);
    Exit;
  end;

  ClosePrinter(hPrinter);

  Result := DataWritten=DataLen;
end;

procedure PrintString(s : string);
var
  h : Cardinal;
  sPrinterName,sDriver,sPort:array[0..255]of Char; // sDriver i sPort nie będą
                                                                 // wykorzystane
  Err : string;
begin
  Printer.GetPrinter(sPrinterName,sDriver,sPort,h);
  if not DirectPrint(sPrinterName,PByte(PChar(s)),length(s),Err) then
    ShowMessage(Err);
end;

Źródło informacji: Tomasz Pytlik, Krzysztof Świątkowski, Chris Monson, Bogdan Polak

8.Jak wywołać domyślny program pocztowy z wpisanym już adresem odbiorcy?
email, adres, poczta

Należy skorzystać z funkcji WinAPI ShellExecute na przykład w ten sposób:

uses ShellApi;

procedure TForm1.Button1Click(Sender: TObject);
begin
 ShellExecute(Handle,'open','mailto:wieczor@polbox.com','','',sw_Normal);
end;

Oprócz samego nadawcy można też podać tytuł i treść listu umieszczając jako argument ShellExecute następujący tekst:

mailto:s_dusza@koti.com.pl?subject=test&body=Tu+jest+tresc

W podobny sposób można otworzyć okno Exploratora Windows podając nazwę katalogu a także wywołać aplikację obsługującą dany format pliku.

Marcin Qfel Zaleski podesłał kod krzystający z funkcji MAPI. Dzięki MAPI można w pełni kontrolować proces wysyłania poczty, w szczególności dodać do listu plik jako załącznik:

procedure cos_tam;
var
  MAPIFileDesc    : TMAPIFileDesc;
  MAPIMessage     : TMAPIMessage;
  MAPIRecipDesc   : TMapiRecipDesc;
  hMAPIDLL        : THandle;
  pfnMAPISendMail : TFNMAPISendMail;
begin

  //załadowanie biblioteki
  hMAPIDLL := LoadLibrary('MAPI32.DLL');
  if hMAPIDLL=0 then
    begin
      //zle się dzieje
    end;

  //pobranie adresu funkcji
  @pfnMAPISendMail := GetProcAddress(hMAPIDLL,'MAPISendMail');
  if @pfnMAPISendMail=nil then
    begin
      FreeLibrary(hMAPIDLL);
      //zle się dzieje
    end;

  //przygotowanie opisu adresata
  FillChar(MAPIRecipDesc,SizeOf(TMAPIRecipDesc),0);
  with MAPIRecipDesc do
    begin
      ulRecipClass := MAPI_TO;
      lpszName := 'John Smith';
      lpszAddress := 'johnsmith@server.com';
    end;

  //przygotowanie opisu załącznika
  FillChar(MAPIFileDesc,SizeOf(TMAPIFileDesc),0);
  with MAPIFileDesc do
    begin
      nPosition := Cardinal(-1);
      lpszPathName := 'C:\Moje dokumenty\list.doc';
      lpszFileName := 'list.doc';
    end;

  //przygotowanie rekordu wiadomości
  FillChar(MAPIMessage,SizeOf(TMAPIMessage),0);
  with MAPIMessage do
    begin
      lpszSubject := 'temat listu';
      lpszNoteText := 'tresc listu';
      nRecipCount := 1;
      lpRecips := @MAPIRecipDesc;
      nFileCount := 1;
      lpFiles := @MAPIFileDesc;
    end;

  //wysłanie
  if
pfnMAPISendMail(0,Handle,MAPIMessage,MAPI_DIALOG,0)<>SUCCESS_SUCCESS
then
    begin
      FreeLibrary(hMAPIDLL);
      //zle się dzieje
    end;
  //zwolnienie zasobów
  FreeLibrary(hMAPIDLL);
end;

Źródło informacji: Sebastian A. Dusza, Marcin Qfel Zaleski.

9.Dlaczego programy napisane w Delphi nie "fruną" na pasek zadań a po prostu się minimalizują, jak Windows 3.11?
minimalizacja, animacja, Win95, pasek zadań

Dlaczego, że programiści z Borland Int. wyłączyli animację okienek. Oddaję głos Krzyśkowi Świątkowskiemu:

"Dlatego że przy minimalizacji chłopcy z Borlanda animację wyłączają, jak się ją włączy to to głupio wygląda bo tak naprawdę minimalizuje się nie to okienko co trzeba. Na upartego można to zrobić samemu funkcją API ale nie pamiętam jak się nazywała."

Dlaczego Borland tak to rozwiązał?

"Żeby można było w każdej chwili wołać funkcje które wymagają uchwytu do okna Application [Delphi M.W.] tworzy prawdziwe okno główne u siebie. To okno o którym my mówimy że jest główne (MainForm) jest po prostu widoczne a prawdziwe okno główne to od kolejki komunikatów aplikacji siedzi w TApplication. Po zmianie tej funkcji o której wspomniałem widać animację okna głównego, czyli tego co siedzi w Application a nie głównej formy i dlatego wygląda głupio. Ktoś kiedyś mówił że na DSP jest komponent który pozwala to jako obejść. Ja znalazłem jedynie obejście w postaci funkcji rysującej animacje ramki okna."

Jak to obejść?

"Przekompilować unit Forms tam jest jakaś taka funkcyjka która wyłącza animacje, jak chcesz to mogę sprawdzić bo gdzieś mam chyba stare posty na ten temat"

Podejrzewam, że Krzyśkowi chodziło o funkcję:

procedure ShowWinNoAnimate(Handle: HWnd; CmdShow: Integer);
var
  Animation: Boolean;
begin
  Animation := GetAnimation;
  if Animation then SetAnimation(False);
  ShowWindow(Handle, CmdShow);
  if Animation then SetAnimation(True);
end;

Jest ona wywoływana w kilku miejscach modułu Forms i należałoby ją zmienić na:

procedure ShowWinNoAnimate(Handle: HWnd; CmdShow: Integer);
begin
  ShowWindow(Handle, CmdShow);
end;

W tym miejscu muszę dodać, że dobrze jest zrobić sobie kopię zapasową wszystkich plików bibliotecznych (PAS, DCU, DPL itp.) przed rekompilacją bibliotek standardowych.

Suplement

Ostatnio (dzięki Darkowi Brzezińskiemu) doszły nowe informacje. Aby poprawnie działało minimalizowanie okien w Windows 95 należy:

W module projektu:

• dodać do uses Windows,
• zadeklarować zmienną np. ES : Integer;
• po Application.Initialize dopisać:

ES:=GetWindowLong(Application.Handle, GWL_EXSTYLE);
ES:=ES or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW;
SetWindowLong(Application.Handle,GWL_EXSTYLE,ES);

Okno z ustawionym stylem WS_EX_TOOLWINDOW nie jest pokazywane na pasku zadań.

W module głównego formularza aplikacji należy dodać:

procedure CreateParams(var Params:TCreateParams);override;
procedure WMSysCommand(var Message:TWMSysCommand);message WM_SYSCOMMAND;
...
procedure TForm1.CreateParams(var Params:TCreateParams);
begin
 inherited CreateParams(Params);
 with Params do ExStyle:=ExStyle or WS_EX_APPWINDOW;
end;

procedure TForm1.WMSysCommand(var Message:TWMSysCommand);
begin
 if (Message.CmdType and $FFF0=SC_MINIMIZE) then WindowState:=wsMinimized
 else inherited;
end;

Ominięcie domyślnej obsługi komunikatu, która wywołuje Application.Minimize. Po tych zmianach minimalizuje się formularz (z animacją), a nie ukryte okno aplikacji.

Źródło informacji: Darek Brzeziński, Krzysztof Świątkowski

10. Co to znaczy: okienko ładowane dynamicznie?
forma, ładowanie dynamiczne

Standardowo Delphi tworzy wszystkie formy przy starcie programu (spójrz do pliku *.DPR). Tak stworzone formy istnieją przez cały czas działania aplikacji i zasoby przez nie zajmowane zwalniane są dopiero po jej zakończeniu. Przez większość czasu formy są ukryte i pokazują się dopiero gdy wywołamy procedurę Show. Aby dynamicznie ładować okienka należy przesunąć je w opcjach projektu z listy Auto-Create Forms na Available Froms. Potem jeśli będziemy chcieli skorzystać z okienka dialogowego dynamicznie to możemy to zrobić na przykład w ten sposób:

procedure TForm1.Button1Click(Sender: TObject);
begin
 Form2:=TForm2.Create(Application);
 try
  Form2.ShowModal;
 finally
  Form2.Free;
 end;
end;

Widać tu ręczne utworzenie formy-obiektu, jego wywołanie i skasowanie. Z oknami niemodalnymi jest inaczej bo nie zachowują się one jak "procedury" (wybaczcie mi ten skrót myślowy). Jeśli chcemy utworzyć okno niemodalne w jednym egzemplarzu to możemy zrobić to tak:

procedure TForm1.Button1Click(Sender: TObject);
begin
 if not Assigned(Form2)then Form2:=TForm2.Create(Application);
 Form2.Show;
end;

Czyli najpierw sprawdzamy czy już utworzyliśmy formę (jeśli nie to ją tworzymy) a potem pokazujemy ją na ekranie. Od tej chwili forma żyje własnym życiem. Jeśli chcemy zwolnić zajmowaną przez nią pamięć gdy użytkownik ją zamknie to należy oprogramować jej zdarzenie OnClose (zwracam uwagę na nazwę formy: Form2 a nie Form1):

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Action:=caFree; // None, Hide, Minimize
 Form2:=Nil;
end;

Tu mieliśmy do wyboru: zwolnić pamięć zajmowaną przez formę, nic nie robić (wtedy nie da się zamknąć takiego okienka), ukryć formę lub ją zminimalizować. Ostatnia linia jest potrzebna gdyż zwalniana forma nie aktualizuje zmiennej Form2. W efekcie przy ponownym wywołaniu TForm1.Button1Click pojawiłby się błąd.

11. Jak sprawdzić w jakim trybie graficznym działa program?
tryb graficzny, rozdzielczość ekranu

W module Forms jest zadeklarowany obiekt Screen którego dwie właściwości Screen.Width i Screen.Height określają rozmiary ekranu.

12. Jak zapisać do pliku zawartość komponentu TMemo?
TMemo, plik, zapisywanie

Skorzystać z metody SaveToFile. Memo ma również kilka innych ciekawych możliwości:

Właściwość Lines jest typu TStrings (dokładniej pochodzi od tego typu) i da się z nią zrobić to samo co z obiektem typu TStringList. Aby skopiować zaznaczony w memo tekst do schowka należy wykonać:

Memo1.CopyToClipboard;

zaś aby zaznaczyć cały tekst w memo:

Memo1.SelectAll;

Po więcej informacji proponuję zajrzeć do helpa.

13. Jak w Delphi wykryć wejście i wyjście myszki w obszar przycisku?
myszka, przycisk, wejście, wyjście

Ten problem pojawia się najczęściej przy pisaniu własnych komponentów i najprościej rozwiązać go właśnie pisząc komponent. Poniżej podaję deklarację przykładowego komponentu wykorzystującego komunikaty cm_MouseEnter i cm_MouseLeave generowane przez Delphi do sprawdzenia pozycji myszki (za uwagi dotyczące tego kodu dziękuję Markowi Parfianowiczowi):

unit Button1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;
type
  TMyButton = class(TButton)
    protected  
    FMouseOver, FMouseOut : TNotifyEvent;
    procedure CMMouseEnter(var Message:TMessage);message cm_MouseEnter;
    procedure CMMouseLeave(var Message:TMessage);message cm_MouseLeave;
    published 
    property OnMouseOver: TNotifyEvent read FMouseOver write FMouseOver;
    property OnMouseOut: TNotifyEvent read FMouseOut write FMouseOut;
  end;

procedure Register;

implementation

procedure TMyButton.CMMouseEnter(var Message:TMessage);
begin
  if Assigned(FMouseOver)then OnMouseOver(Self);
  Message.Result:=1;
end;

procedure TMyButton.CMMouseLeave(var Message:TMessage);
begin
  if Assigned(FMouseOut)then OnMouseOut(Self);
  Message.Result:=1;
end;

procedure Register;
begin
  RegisterComponents('T-1000', [TMyButton]);
end;

Po dodaniu komponentu do palety możemy już z niego korzystać.

14. Jak zmierzyć długość tekstu w pikselach a nie znakach?
tekst, TCanvas, długość, font, czcionka

Należy użyć metody TCanvas.TextWidth('Ala ma kota') podającej szerokość tekstu właśnie w pikselach na konkretnym urządzeniu (ekranie, drukarce) przy aktualnie ustawionym foncie.

15. Jak z poziomu Delphi wykonać program DOSa?
Exec, DOS, program, uruchomić

Należy użyć funkcji WinExec z WinAPI. Na przykład:

procedure TForm1.Button1Click(Sender: TObject);
begin
 WinExec('rar.exe a archiwum *.*',sw_Normal);
end;

Spowoduje to wywołanie programu RAR z odpowiednimi parametrami i utworzenie przez niego archiwum.

16. Jak obsłużyć komunikat Windows którego forma nie obsługuje np. wm_NCHitTest?
komunikaty

Należy dopisać w sekcji public:

type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
    procedure WMNCHitTest(var Message:TWMNCHitTest);message wm_NCHitTest;
  end;

zaś w części implementation:

procedure TForm1.WMNCHitTest(var Message : TWMNCHitTest);
var P:TPoint;
begin
  inherited;
  P:=ScreenToClient(SmallPointToPoint(Message.Pos));
  with Label1,Message do
    if (P.X>=Left) and (P.X<Left+Width) and
        (P.Y>=Top) and (P.Y<Top+Height) then
      Result:=htCaption;
end;

W tym przypadku powierzchnia etykiety Label1 zachowuje się jak jej pasek tytułowy. Za poprawki w powyższym kodzie dziękuję Maciejowi "MACiASowi" Pilichowskiemu

17. Jak dostosować wydruk do różnych drukarek?
drukowanie, drukarka, rozdzielczość

Należy skorzystać z funkcji GetDeviceCaps z WinAPI i z modułu Printers. Na przykład:

procedure TForm1.Button1Click(Sender: TObject);
var XD,YD:Integer;
begin
 XD:=GetDeviceCaps(Printer.Handle,LogPixelSX); // liczba pikseli na cal w poziomie
 YD:=GetDeviceCaps(Printer.Handle,LogPixelSY); // liczba pikseli na cal w poziomie
 with Printer,Printer.Canvas do
 begin
  Title:='Wydruk próbny';
  BeginDoc;
  try
   // Linia w poprzek całej kartki
   MoveTo(PageWidth,0);LineTo(0,PageHeight);
   // Linia o długości 1 cala
   MoveTo(0,0);LineTo(XD,YD);
  finally
   EndDoc;
  end;
 end;
end;

To jednak nie koniec. Okazuje się, że NetManiak ma do tego kilka uwag:

"Już znalazłem formułę, dzięki której można dokładnie obliczyć ile musi mieć pixeli linia, by na drukarce objawiła się jako 1 calowa. Teoretycznie powinno to być (jak sugeruje kolega BACIK, tudzież dokumentacja windows) LOGPIXELSX i LOGPIXELSY. Moje doświadczenia wskazują jednakże, iż rzeczywista wartość wynosi:

w poziomie: LOGPIXELX * PHYSICALWIDTH / HORZRES
w pionie: LOGPIXELSY * PHYSICALHEIGHT / VERTRES

gdzie LOGPIXELX - wynik funkcji GetDeviceCaps(LOGPIXELX ) itd...

Sprawdziłem to na 2 drukarkach: Cannon BJC4300 i HP (atramentówka, A4, oznaczenia nie pamiętam)."

Źródło informacji: Adam K. "NetManiak".

18. Jak sprawić aby dymki z podpowiedziami nie znikały?
dymki, hint

Należy ustawić HintHidePause na dość dużą wartość:

Application.HintHidePause:=100000;

19. Mam problem z przesiadką z Delphi 1.0 na Delphi 2.0. Pliki binarne zapisywane przez program po rekompilacji przestały się wczytywać.
błędy odczytu, plik, rekordy, record

Problemem może być zarówno zmiana wielkości typu Integer (teraz jest 4 bajtowy czyli dawne Longint) jak i wyrównywanie przez Delphi zmiennych w pamięci do adresów podzielnych przez 4. Na to pierwsze pomoże zmiana typów zmiennych w programie z Integer na SmallInt (które jest 2 bajtowe). Aby obejść ten drugi problem trzeba albo wyłączyć wyrównywanie zmiennych w ustawieniach kompilatora (ale spowolni to program) albo rekordy zapisywane na dysk zadeklarować ze słówkiem packed co lokalnie wyłączy wyrównywanie zmiennych.

20. Jak załadować bitmapę z zasobów pod Delphi 1.0?
bitmapa, zasoby, ładowanie

Skorzystaj z funkcji LoadBitmap:

Image.Picture.Bitmap.Handle:=LoadBitmap(hInstance,'NAZWA_BITMAPY');

21. Jak sprawdzić gdzie znajduje się mysz?
myszka, pozycja, ekran

Pozycję myszy (we współrzędnych ekranowych) podaje funkcja GetCursorPos.

22. Dlaczego nie działa StretchDraw dla ikon?
ikony, StretchDraw, rysowanie

Niedoróbka Delphi. Aby narysować rozciągniętą ikonę należy skorzystać z funkcji:

DrawIconEx(Canvas.Handle, 0, 0, Icon.Handle, szerokosc, wysokość, 0, 0,DI_NORMAL);

23. Jak zrobić listę otwartych okien w Windows?
lista okien, Windows, pulpit, pasek zadań

Oto przykładowy kod wykorzystujący funkcje WinAPI:

function EnumWindowsProc(WHandle: HWND; LParM: LParam): Boolean;StdCall;Export;
var Title,ClassName:array[0..128] of char;
    sTitle,sClass,Linia:STRING ;
begin
 Result:=True;
 GetWindowText(wHandle, Title,128);
 GetClassName(wHandle, ClassName,128);
 sTitle:=Title;
 sClass:=ClassName;
 if IsWindowVisible(wHandle) then
 begin
  Linia:=sTitle+'        '+sClass+'       '+IntToHex(wHandle,4);
  Form1.Listbox1.Items.Add(Linia);
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 EnumWindows(@EnumWindowsProc,0);
end;

Na formie powinien być komponent typu TListBox. Zostanie on wypełniony listą aktywnych okien.

Źródło informacji: Sławomir Świder

24. Dlaczego program korzystający z baz danych po przeniesieniu na inny komputer nie chce działać?
bazy danych, BDE, błąd

Delphi korzysta z BDE (Borland Database Engine). Jest to program pośredniczący pomiędzy Delphi a bazami danych i musi być zainstalowany na docelowym komputerze. Można to zrobić "ręcznie" - na kompakcie z Delphi jest katalog z wersją instalacyjną samego BDE. Można też użyć InstallShield Express - jest to okrojona wersja programu do tworzenia programów instalacyjnych. Znajduje się na płycie z Delphi. Jedną z jego opcji jest właśnie instalowanie programów wymagających BDE. Jest szybki i robi to całkiem nieźle.

Najczęstszym objawem braku BDE jest błąd nr 2109 z komunikatem "brak pliku IDAPI32.DLL".

25. Jak reagować na zmianę rozdzielczości w trakcie działania programu?
rozdzielczość, ekran, zmiana

Należy obsłużyć komunikat wm_DisplayChange dopisując do formy procedurę:

procedure WMDisplayChange(var msg : TWMDisplayChange);message wm_DisplayChange;   

Dodatkowo w Delphi 2.0 trzeba dopisać definicję typu:

type TWMDisplayChange = record
      Msg: Cardinal;
      BitsPerPixel: Integer;// ilość kolorów - 8-256, 15-32k, 16-64k,24/32-16mln
      Width: Word;    //szerokość
      Height: Word;   //wysokość
     end;

Należy ją umieścić przed deklaracją procedury. Aby przeczytać o dodawaniu własnej obsługi komunikatów zajrzyj do pytania 16.

Uwaga: Komunikat wm_DisplayChange jest specyficzny dla Windows 95 nie występuje ani w Windows NT ani w Win32s API. Wczesne wersje Windows 95 mogą wysyłać ten komunikat dwukrotnie - przed i po zmianie rozdzielczości.

Źródło informacji: Krzysztof Świątkowski.

26. Jak dodać wizytówkę programu (ang. splash screen)?
wizytówka, logo, splash, ładowanie

Należy stworzyć nową formę, nazwać ją np. TLogo, ustawić właściwości

Do formy dodać TImage z obrazkiem. Tak przygotowaną formę należy jeszcze usunąć z listy automatycznie tworzonych form (jak to zrobić patrz pytanie 10). Teraz przechodzimy do kodu źródłowego projektu.

begin
  Application.Initialize;
  // Utworzenie i pokazanie formy
  Logo:=TLogo.Create(Application);
  Logo.Show;
  Logo.Update;
 
  // Tu wstawia Delphi utworzenie automatycznych form
  Application.Run;
end;

Do okna głównego dodajemy:

procedure TForm1.FormShow(Sender : TObject);
begin
 if assigned(Logo) then 
 begin
  Logo.Free; 
  Logo:=nil;
 end;
end;

I gotowe. W katalogu DEMOS na płycie z Delphi znajduje się program MASTAPP z winietą.

27. Jak dodać właściwości do formy aby były widoczne w okienku ObjectInspector?
właściwości, ObjectInspector, dziedziczenie, forma

Dokładnej odpowiedzi nie znam. Przytoczę tu fragment listu Roberta Perlińskiego:

"Niestety nie mogę odnaleźć kawałka kodu, który napisałem jakiś czas temu, a który implementował dokładnie to o czym mówimy. Z głowy i z tego co pamiętam:

1. Tworzymy moduł z definicją formy np. TPawelForm, która zawiera "custom property" np. PawelProperty. Forma powinna przeciążać konstruktor Create, ale zamiast standardowego inherited powinna wołać CreateNew i InitInheritedComponent (patrz TCustomForm.Create zdefiniowane w pliku forms.pas)

2. Tworzymy "Module Creator" np. TPawelFormCreator = class(TIModuleCreator)

3. Tworzymy "Expert" np. TPawelFormExpert = class(TIExpert)

4. Rejestrujemy TPawelForm i TPawelFormExpert

5. Jeśli w p. 1-4 zrobiliśmy wszystko jak należy, każda nowa forma utworzona przy pomocy TPawelFormExpert, posiadać powinna PawelPropety dostępną z poziomu Object Inspectora. Obiecuję, że jeśli odnajdę pełny tekst programu, wyślę go na listę."

I tyle Robert. Niestety programu chyba nie wysłał (przynajmniej ja go nie zauważyłem).

Źródło informacji: Robert Perliński

28. Jak pobrać listę właściwości obiektu w trakcie wykonywania programu?
właściwości, RTTI, runtime

Poniżej jest tłumaczenie Delphi TI 3166:

Czasem przydatna jest informacja o właściwościach komponentu w momencie wykonywania programu. Listę właściwości można uzyskać przy pomocy funkcji GetPropList. Typy, funkcje i procedury (włączając w to GetPropList) pozwalające na dostęp do właściwości znajdują się w pliku TYPINFO.PAS.

GetPropList jest zdefiniowana jako:

function GetPropList(TypeInfo: PTypeInfo; TypeKinds: TTypeKinds;
  PropList: PPropList): Integer; 

Pierwszym parametrem GetPropList jest zmienna typu PTypeInfo, jest to część RTTI (Run Time Type Information) dostępnej dla każdego obiektu. Typ ten jest zdefiniowany następująco:

PPTypeInfo = ^PTypeInfo;  
PTypeInfo = ^TTypeInfo;  
TTypeInfo = record
    Kind: TTypeKind;    
    Name: ShortString;   
    {TypeData: TTypeData}  
end;

Rekord TTypeInfo może być odczytany przy pomocy właściwości ClassInfo obiektu. Na przykład, jeśli pobieramy informacje o TButton wywołanie może wyglądać następująco:

GetPropList(Button1.ClassInfo, ....

Drugi parametr (typu TTypeKinds) jest typu zbiorowego i działa jak filtr decydując o tym jakie rodzaje właściwości zamieścić w liście. Jest kilka możliwych wartości jakie można mu nadać jednakże tkProperties obsługuje najważniejsze. Teraz wywołanie ma postać:

GetPropList(Button1.ClassInfo, tkProperties ....

Ostatni parametr, PPropList jest tablicą typów PPropInfo:

PPropList = ^TPropList;  
TPropList = array[0..16379] of PPropInfo;

Teraz nasze wywołanie może mieć postać:

procedure TForm1.FormCreate(Sender: TObject);
var  PropList: PPropList;
begin
  PropList := AllocMem(SizeOf(PropList^));
  GetPropList(TButton.ClassInfo, tkProperties + [tkMethod], PropList);
...

Przykład przytoczony poniżej pokazuje nie tylko nazwę właściwości ale także jej typ. Nazwa typu znajduje się w dodatkowej strukturze w rekordzie TPropInfo. Zauważmy, że pole PropType wskazuje na rekord TTypeInfo zawierający nazwę typu właściwości:

PPropInfo = ^TPropInfo;  
TPropInfo = packed record    
             PropType: PPTypeInfo;
    	     GetProc: Pointer;    
	     SetProc: Pointer;    
             StoredProc: Pointer;
             Index: Integer;    
             Default: Longint;    
             NameIndex: SmallInt;
             Name: ShortString;  
            end;  

PPTypeInfo = ^PTypeInfo;  
PTypeInfo = ^TTypeInfo;
TTypeInfo = record    
             Kind: TTypeKind;    
             Name: ShortString;
             {TypeData: TTypeData}  
            end;

Poniższy kod przykładowy pokazuje jak wywołać GetPropList i jak odwoływać się do elementów zwróconej tablicy. Przykład wymaga obecności na formie TListBox:

uses TypInfo;

procedure TMainForm.FormCreate(Sender: TObject);
var PropList: PPropList;
    i: integer;
begin
 PropList:=AllocMem(SizeOf(PropList^));
 i:=0;
 try
  GetPropList(TForm.ClassInfo,tkProperties+[tkMethod],PropList);
  while (PropList^[i]<>Nil)and(i<High(PropList^)) do
  begin
   ListBox1.Items.Add(PropList^[i].Name+':'+PropList^[i].PropType^.Name);
   Inc(i);
  end;
 finally
  FreeMem(PropList);
 end;
end;

Tyle Borland. Ze swej strony dodam, że aby powyższe działało obiekt musi być kompilowany z włączeniem generowania RTTI lub być pochodną takiego obiektu. RTTI jest włączone dla jednego obiektu z VCL - TPersistent. Wystarczy więc, że nasz obiekt będzie pochodną TPersistent. To dla tych, którzy nie mają dostępu do źródeł bibliotek. Dla pozostałych informacja jak włączyć generowanie RTTI. Proszę spojrzeć na deklarację TPersistent:

{ TPersistent abstract class }

{$M+}

  TPersistent = class(TObject)
  private
    procedure AssignError(Source: TPersistent);
  protected
    procedure AssignTo(Dest: TPersistent); virtual;
    procedure DefineProperties(Filer: TFiler); virtual;
    function  GetOwner: TPersistent; dynamic;
  public
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); virtual;
    function  GetNamePath: string; dynamic;
  end;

{$M-}

Widać, że za RTTI jest odpowiedzialny przełącznik {$M+} (można go zapisać też jako {$TYPEINFO ON}). Polecam odpowiednią stronę w helpie. Jest tam między innymi napisane, że RTTI jest generowane tylko dla pól w części published (nad czym niezmiernie boleję).

Źródło informacji: Delphi TI 3166

29. Jak dodać własną pozycję do menu wywoływanego spod Exploratora po kliknięciu prawym przyciskiem myszy?
Explorer, Explorator, menu podręczne, prawy przycisk myszy

Odpowiedź podał Michał Jaskólski:

procedure JakasTam;

var
  Rejestr:TRegistry;
  NazwaTypu:string;

begin
  try  
    Rejestr:=TRegistry.Create;
    Rejestr.RootKey := HKEY_CLASSES_ROOT;
    Rejestr.OpenKey('\.rozszerzenie',true);
    NazwaTypu:=Reg.ReadString('');
    Rejestr.CloseKey;
    Rejestr.OpenKey('\'+NazwaTypuHtml+'\shell\Koduj',true);  
    Rejestr.WriteString('','Koduj do...');
    Rejestr.CloseKey;
    Rejestr.OpenKey('\'+NazwaTypuHtml+'\shell\Koduj\command',true);
    Rejestr.WriteString('','"'+Application.ExeName+'" "%1"');
    Rejestr.CloseKey;
  finally
    Rejestr.Free;
  end;
end;

Źródło informacji: Michał Jaskólski

30. Jak sprawdzić czy uruchomiony program jest już w pamięci?
powtórne uruchamianie, dwa programy

Odpowiedź podał Paweł Schmidt:

hMapping:=CreateFileMapping(THANDLE($FFFFFFFF),nil,
 PAGE_READONLY,0,32,'ApplicationTestMap');
if GetLastError=ERROR_ALREADY_EXISTS then
begin
 Application.MessageBox('Program jest już uruchomiony','Informacja',
  mb_OK+MB_IconInformation);
 Application.Terminate;
end;

Od siebie dodam, że przy końcu aplikacji warto zrobić CloseHandle(hMapping). W Delphi 1.0 wystarczy sprawdzić wartość parametru HPrevInstance, jeśli jest niezerowy to program został już uruchomiony.

31. Jak wyświetlić standardowe okno Windows służące do wybierania katalogu?
katalog, standardowe okno, dialog, wybór

Należy skorzystać z funkcji SHBrowseForFolder:

uses ShlObj,ActiveX;

procedure TForm1.Button1Click(Sender: TObject);
var BI:TBrowseInfo;
    Buf:PChar;
    Dir,Root:PItemIDList;
    Alloc:IMalloc;
begin
 // Pobieramy obiekt zarządzający pamięcią
 SHGetMalloc(Alloc);
 // Przydzielamy pamięć na string
 Buf:=Alloc.Alloc(Max_Path);

 // Ograniczamy wybór tylko do katalogu "Menu Start\Programs"
 SHGetSpecialFolderLocation(Handle,CSIDL_PROGRAMS,Root);

 with BI do
 begin
  hwndOwner:=Form1.Handle;
  pidlRoot:=Root; // Tu można podać NIL żeby można było wybrać każdy katalog
  pszDisplayName:=Buf;
  lpszTitle:='Wybierz katalog'; // Etykietka przed listą katalogów
  ulFlags:=0;
  lpfn:=nil;
 end;

 try
  Dir:=SHBrowseForFolder(BI);
  if Dir<>Nil then
  begin
   // Pobieramy pełną ścieżkę do katalogu
   SHGetPathFromIDList(Dir,Buf);
   // Przykładowe zastosowanie
   ShowMessage(Buf);
   Alloc.Free(Dir);
  end;
 finally
  Alloc.Free(Root);
  Alloc.Free(Buf);
 end;
end;

Inne możliwe do wybrania katalogi specjalne:

Wartości CSIDL_PROGRAMS można użyć przy dodawaniu własnych pozycji w menu Start.

32. Czy jest możliwe skompilowanie programu napisanego w Delphi 3.0 tak aby działał w Windows 3.11?
Windows 3.11, thunk, Win32s, 16-bit

Nie próbowałem tego w Delphi 3.0 ale kompilowałem kilka programów pod Delphi 2.0 korzystających z wielu komponentów Delphi (ale nie korzystałem bezpośrednio z WinAPI) i nie było żadnych problemów z uruchomieniem ich pod Windows 3.11. Oczywiście w docelowym systemie musi być zainstalowana nakładka Win32s. Jeśli chcesz korzystać bezpośrednio z WinAPI to sprawdź czy funkcja, której używasz ma swój odpowiednik w Win32s API. Pod Delphi 3.0 nie powinno być żadnych problemów pod warunkiem, że nie korzystamy z obiektów z zakładki Win32. Dodam jeszcze, że moje programy nie korzystały z baz danych (co nie znaczy, że takowe nie będą działać, po prostu testy musisz przeprowadzić we własnym zakresie).

33. Gdzie i za ile można kupić Delphi, gdzie można znaleźć informację o tym produkcie?
Delphi, kupno, BSC

Dystrybutorem produktów Borlanda w Polsce jest Borland Support Center. Tam też znajdują się aktualne ceny. Informacje można znaleźć na wspomnianym BSC jak również na stronach Inprise (dawniej Borland).

Niektórzy twierdzą, iż taniej jest sprowadzić Delphi ze Stanów niż kupować w Polsce.

34. Jak dodać do formy w czasie wykonywania programu kilka komponentów?
forma, komponenty, dodawanie

Należy dokładnie powtórzyć to co robi Delphi przy dodawaniu komponentów:

• utworzyć komponent przy pomocy TEdit.Create(Form1)
• ustawić właściwość parent na komponent nadrzędny (najczęściej formę ale czasem będzie to na przykład panel) wykonując Edit.Parent:=Form1
• Poustawiać resztę interesujących nas właściwości

procedure TForm1.Button1Click(Sender: TObject);
var I,Y:Integer;
    Edit:TEdit;
begin
 Y:=5; // Pozycja, od której zaczynamy dodawać obiekty
 for I:=1 to 5 do
 begin
  Edit:=TEdit.Create(Self);
  Edit.Parent:=Self;

  // Tyle wystarczy aby poprawnie dodać obiekt
  // Poniżej ustawiamy te właściwości, które chcemy
  Edit.Top:=Y;
  Edit.Left:=5;
  Edit.Text:=Format('Okienko nr %d',[I]);

  // Następne okno utworzymy poniżej z odstępem 2 pikseli
  Y:=Y+Edit.Height+2;
 end;
end;

Nie musimy martwić się o zniszczenie obiektów destruktorem. Są one automatycznie zwalniane przez formę.

35. Jak wydrukować zawartość memo?
TMemo, drukowanie

Należy skorzystać z modułu Printers i procedury AssignPrn.

procedure TForm1.Button1Click(Sender: TObject);
var I:Integer;
    F:TextFile;
begin
 AssignPrn(F);Rewrite(F);
 try
  // Wypisujemy nagłówek kursywą...
  Printer.Canvas.Font.Style:=[fsBold];
  Writeln(F,'Zawartość memo');Writeln(F);

  // ... i zawartość memo linia po linii
  Printer.Canvas.Font.Style:=[];
  for I:=0 to Memo1.Lines.Count-1 do
   Writeln(F,Memo1.Lines[I]);
 finally
  CloseFile(F);
 end;
end;

Plik zaraz po wydruku musimy zamknąć gdyż tylko jeden plik może być skojarzony z drukarką. Należy też dodać w sekcji Uses moduł Printers bo stamtąd pochodzi procedura AssignPrn.

36. Jak obsłużyć COM spod Delphi 2.0?
COM, port szeregowy, transmisja

Oto przykładowy kod nadesłany przez MARFI:

procedure TForm.Button1Click(Sender : TObject);
var hCOM:THandle;
    nrWrit:DWORD;
    nrRead:DWORD;
    Errors:DWORD;
    Dcb:TDCB;
    ComStat:TComStat;
    buf:array[0..2048] of char;
begin
 //Otwarcie łącza COM
 hCOM:=CreateFile('COM3',GENERIC_WRITE OR GENERIC_READ,0,nil,OPEN_EXISTING,0,0);

 //Ustawienie parametrów transmisji - jak  MODE w DOS'ie
 if hCOM<>INVALID_HANDLE_VALUE then
 begin
  GetCommState(hCOM,Dcb);
  BuildCommDCB('19200,n,8,2',Dcb);
  SetCommState(hCOM,Dcb);
 end
 else
 begin
  ShowMessage('Błąd otwarcia portu COM : '+IntToStr(GetLastError()));
  Exit;
 end;

 try
  //Przygotowanie bufora
  ZeroMemory(@buf,SizeOf(buf));
  StrCopy(buf,'AT&V'+#13+#10);

  //Zapis bufora
  if not WriteFile(hCOM,buf,StrLen(buf),nrwrit,nil) then
   ShowMessage('Błąd zapisu do portu COM.');

  //Sprawdzenie czy jest coś w buforze COM
  ClearCommError(hCOM,Errors,@ComStat);

  //Odczytanie bufora gdy są dane
  if ComStat.cbInQue>0 then
   ReadFile(hCOM,buf,ComStat.cbInQue,nrRead,nil);
 finally
  CloseHandle(hCOM);
 end;
end;

Źródło informacji: MARFI

37. Co to jest RxLib i skąd to można ściągnąć?
RxLib, RxHint

RxLib jest biblioteką komponentów do Delphi 1, 2 i 3 w postaci kodów źródłowych. Jej autorami są Rosjanie a ściągnąć ją można z DSP lub bezpośrednio od autorów.

38. Jak dodać nową wartość klucza do rejestru?
rejestr, klucz

Należy skorzystać z obiektu TRegistry. Przykład:

procedure TMainForm.Button1Click(Sender: TObject);
var Reg:TRegistry;
begin
 Reg:=TRegistry.Create;
 try
  Reg.RootKey:=HKEY_LOCAL_MACHINE;
  Reg.OpenKey('Firma',True);
  Reg.WriteString('Sciezka','c:\Program Files\Firma');
  Reg.WriteInteger('Wersja',1);
 finally
  Reg.Free;
 end;
end;

39. Jak zamienić liczbę na "słownie złotych"?
słownie, kwota

Tu możesz ściągnąć przykładowy moduł.

40. Jak wyrażenie matematyczne zamienić na liczbę?
obliczanie, VAL$, funkcje, kalkulator

Tu możesz ściągnąć przykładowy moduł do Turbo Pascala. Aby użyć go z Delphi trzeba go trochę przerobić bo w Delphi zmienił się sposób obsługi obiektów.

41. Jak odczytać numer seryjny dysku lub dyskietki?
numer seryjny, dysk, dyskietka, CD-ROM

Dla dyskietki działa poniższy kod:

var
 Buf:array[0..MAX_PATH] of Char;
 NotUsed,VolFlags:Integer;
 DriveChar:Char;
 Serial:PDWORD;
begin
 DriveChar := 'a';
 GetVolumeInformation(PChar(DriveChar + ':\'),Buf,sizeof(Buf),
  @Serial,NotUsed,VolFlags,nil,0);
end;

W zmiennej Serial jest numer dyskietki.

Krzysztof Świątkowski podesłał rozwiązanie tego problemu działające również dla twardych dysków:

// (c) Alex Konshin    mailto:alexk@mtgroup.ru      30 jul 2000 

program HDDSerial;

// PURPOSE: Simple console application that extract first IDE disk serial
number. 

uses
  Windows, 
  SysUtils; // only for Win32Platform and SysErrorMessage 

//------------------------------------------------------------- 
function GetIdeDiskSerialNumber : String; 
type 
  TSrbIoControl = packed record 
    HeaderLength : ULONG; 
    Signature    : Array[0..7] of Char; 
    Timeout      : ULONG; 
    ControlCode  : ULONG; 
    ReturnCode   : ULONG; 
    Length       : ULONG; 
  end; 
  SRB_IO_CONTROL = TSrbIoControl; 
  PSrbIoControl = ^TSrbIoControl; 

  TIDERegs = packed record 
    bFeaturesReg     : Byte; // Used for specifying SMART "commands". 
    bSectorCountReg  : Byte; // IDE sector count register 
    bSectorNumberReg : Byte; // IDE sector number register 
    bCylLowReg       : Byte; // IDE low order cylinder value 
    bCylHighReg      : Byte; // IDE high order cylinder value 
    bDriveHeadReg    : Byte; // IDE drive/head register 
    bCommandReg      : Byte; // Actual IDE command. 
    bReserved        : Byte; // reserved.  Must be zero. 
  end; 
  IDEREGS   = TIDERegs; 
  PIDERegs  = ^TIDERegs; 

  TSendCmdInParams = packed record 
    cBufferSize  : DWORD; 
    irDriveRegs  : TIDERegs; 
    bDriveNumber : Byte; 
    bReserved    : Array[0..2] of Byte; 
    dwReserved   : Array[0..3] of DWORD; 
    bBuffer      : Array[0..0] of Byte; 
  end; 
  SENDCMDINPARAMS   = TSendCmdInParams; 
  PSendCmdInParams  = ^TSendCmdInParams; 

  TIdSector = packed record 
    wGenConfig                 : Word; 
    wNumCyls                   : Word; 
    wReserved                  : Word; 
    wNumHeads                  : Word; 
    wBytesPerTrack             : Word; 
    wBytesPerSector            : Word; 
    wSectorsPerTrack           : Word; 
    wVendorUnique              : Array[0..2] of Word; 
    sSerialNumber              : Array[0..19] of Char; 
    wBufferType                : Word; 
    wBufferSize                : Word; 
    wECCSize                   : Word; 
    sFirmwareRev               : Array[0..7] of Char; 
    sModelNumber               : Array[0..39] of Char; 
    wMoreVendorUnique          : Word; 
    wDoubleWordIO              : Word; 
    wCapabilities              : Word; 
    wReserved1                 : Word; 
    wPIOTiming                 : Word; 
    wDMATiming                 : Word; 
    wBS                        : Word; 
    wNumCurrentCyls            : Word; 
    wNumCurrentHeads           : Word; 
    wNumCurrentSectorsPerTrack : Word; 
    ulCurrentSectorCapacity    : ULONG; 
    wMultSectorStuff           : Word; 
    ulTotalAddressableSectors  : ULONG; 
    wSingleWordDMA             : Word; 
    wMultiWordDMA              : Word; 
    bReserved                  : Array[0..127] of Byte; 
  end; 
  PIdSector = ^TIdSector; 

const 
  IDE_ID_FUNCTION = $EC; 
  IDENTIFY_BUFFER_SIZE       = 512; 
  DFP_RECEIVE_DRIVE_DATA        = $0007c088; 
  IOCTL_SCSI_MINIPORT           = $0004d008; 
  IOCTL_SCSI_MINIPORT_IDENTIFY  = $001b0501; 
  DataSize = sizeof(TSendCmdInParams)-1+IDENTIFY_BUFFER_SIZE; 
  BufferSize = SizeOf(SRB_IO_CONTROL)+DataSize; 
  W9xBufferSize = IDENTIFY_BUFFER_SIZE+16; 
var 
  hDevice : THandle; 
  cbBytesReturned : DWORD; 
  pInData : PSendCmdInParams; 
  pOutData : Pointer; // PSendCmdOutParams 
  Buffer : Array[0..BufferSize-1] of Byte; 
  srbControl : TSrbIoControl absolute Buffer; 

  procedure ChangeByteOrder( var Data; Size : Integer ); 
  var ptr : PChar; 
      i : Integer; 
      c : Char; 
  begin 
    ptr := @Data; 
    for i := 0 to (Size shr 1)-1 do 
    begin 
      c := ptr^; 
      ptr^ := (ptr+1)^; 
      (ptr+1)^ := c; 
      Inc(ptr,2); 
    end; 
  end; 

begin 
  Result := ''; 
  FillChar(Buffer,BufferSize,#0); 
  if Win32Platform=VER_PLATFORM_WIN32_NT then 
    begin // Windows NT, Windows 2000 
      // Get SCSI port handle 
      hDevice := CreateFile( '\\.\Scsi0:', 
        GENERIC_READ or GENERIC_WRITE, 
        FILE_SHARE_READ or FILE_SHARE_WRITE, 
        nil, OPEN_EXISTING, 0, 0 ); 
      if hDevice=INVALID_HANDLE_VALUE then Exit; 
      try 
        srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL); 
        System.Move('SCSIDISK',srbControl.Signature,8); 
        srbControl.Timeout      := 2; 
        srbControl.Length       := DataSize; 
        srbControl.ControlCode  := IOCTL_SCSI_MINIPORT_IDENTIFY; 
        pInData := PSendCmdInParams(PChar(@Buffer) 
                   +SizeOf(SRB_IO_CONTROL)); 
        pOutData := pInData; 
        with pInData^ do 
        begin 
          cBufferSize  := IDENTIFY_BUFFER_SIZE; 
          bDriveNumber := 0; 
          with irDriveRegs do 
          begin 
            bFeaturesReg     := 0; 
            bSectorCountReg  := 1; 
            bSectorNumberReg := 1; 
            bCylLowReg       := 0; 
            bCylHighReg      := 0; 
            bDriveHeadReg    := $A0; 
            bCommandReg      := IDE_ID_FUNCTION; 
          end; 
        end; 
        if not DeviceIoControl( hDevice, IOCTL_SCSI_MINIPORT, 
          @Buffer, BufferSize, @Buffer, BufferSize, 
          cbBytesReturned, nil ) then Exit; 
      finally 
        CloseHandle(hDevice); 
      end; 
    end 
  else 
    begin // Windows 95 OSR2, Windows 98 
      hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil, 
        CREATE_NEW, 0, 0 ); 
      if hDevice=INVALID_HANDLE_VALUE then Exit; 
      try 
        pInData := PSendCmdInParams(@Buffer); 
        pOutData := @pInData^.bBuffer; 
        with pInData^ do 
        begin 
          cBufferSize  := IDENTIFY_BUFFER_SIZE; 
          bDriveNumber := 0; 
          with irDriveRegs do 
          begin 
            bFeaturesReg     := 0; 
            bSectorCountReg  := 1; 
            bSectorNumberReg := 1; 
            bCylLowReg       := 0; 
            bCylHighReg      := 0; 
            bDriveHeadReg    := $A0; 
            bCommandReg      := IDE_ID_FUNCTION; 
          end; 
        end; 
        if not DeviceIoControl( hDevice, DFP_RECEIVE_DRIVE_DATA, 
          pInData, SizeOf(TSendCmdInParams)-1, pOutData, 
          W9xBufferSize, cbBytesReturned, nil ) then Exit; 
      finally 
        CloseHandle(hDevice); 
      end; 
    end; 
    with PIdSector(PChar(pOutData)+16)^ do 
    begin 
      ChangeByteOrder(sSerialNumber,SizeOf(sSerialNumber)); 
      SetString(Result,sSerialNumber,SizeOf(sSerialNumber)); 
    end; 
end; 


//============================================================= 
var s : String; 
    rc : DWORD; 
begin 
  s := GetIdeDiskSerialNumber; 
  if s='' then 
    begin 
      rc := GetLastError; 
      if rc=0 then MessageBox(0,'IDE drive is not support SMART
feature','',0)
      else MessageBox(0,PChar(SysErrorMessage(rc)),'',0);
    end
  else MessageBox(0,PChar('Disk serial number: '''+ s+''''),'',0);
end.

Źródło informacji: Artur Bajor, Krzysztof Świątkowski, Alex Konshin.

42. Czy w Delphi istnieje odpowiednik komend IN, OUT umożliwiających wysłanie pod określony adres urządzenia WE-WY określonej liczby?
Port, IN, OUT, porty

Zacytuję Artura Bajora:

"Nie istnieje.(...) Pisanie i odczyt portów można realizować przez wstawkę asm:

function PortIn(Port:word):Byte;
var Help:Byte;
begin
 asm
  mov DX   ,Port
  in  AL   ,DX
  mov Help ,AL
 end;
 PortIn:=Help;
end;

procedure PortOut(Port:word;Value:Byte);assembler;
asm
  mov DX,Port
  mov AL,Value
  out DX,AL
end;

"Podkreślam (co już było dyskutowane na tej liście), że Win95 skutecznie zabroni Ci dostępu do niektórych portów we/wy (np. HDD Controller) , co jest całkiem naturalne nawet w tak stabilnym systemie jak winda ;-) Jeżeli jednak są to porty np. Twojej karty, z powodzeniem będziesz mógł pisać i czytać we/wy, bo to samo robiłem w swojej."

Źródło informacji: Artur Bajor

43. Napisałem program korzystający z THTML i po przeniesieniu na inny komputer pojawia się błąd "Exception EOleSysError in module..." co się dzieje?
EOleSysError, OCX, HTML

Komponent THTML trzeba zarejestrować gdyż jest to kontrolka OCX. Można zrobić to używając programu regsrv32.exe lub ręcznie na początku programu. Większy problem to to, że ta kontrolka składa się z kilku plików i wszystkie trzeba przenieść do komputera docelowego do katalogu Windows\System lub katalogu z Twoim programem. Jakie pliki przenieść można sprawdzić w dokumentacji kontrolki lub sprawdzając w QuickView jakich bibliotek używa (poza standardowymi z Windows). Metodą czołgową można również kopiować po jednym pliku gdyż komunikaty o błędach podają czasem, którego pliku brakuje. Poniżej podaję procedury do rejestracji kontrolek OCX:

function CheckOCX:Boolean;
var Reg:TRegistry;
begin
 Reg:=TRegistry.Create;
 try
  Reg.RootKey:=HKEY_CLASSES_ROOT;
  // Poniżej jest UID kontrolki wyciągnięty z rejestru Windows
  Result:=Reg.OpenKey('CLSID\{B7FC3550-8CE7-11CF-9754-00AA00C00908}',False);
  if Result then Reg.CloseKey;  
 finally
  Reg.Free;
 end;
end;

procedure RegisterOCX;
var Lib:THandle;
    S:String;
    P:TProcedure;
begin
 OleInitialize(nil);
 try
  S:=ExtractFilePath(Application.ExeName)+'HTML.OCX';
  Lib:=LoadLibrary(PChar(S));
  if Lib<HINSTANCE_ERROR then
   raise Exception.CreateFmt('Cannot initialize library %s. '+
   'Internal Windows error %d',[S,Lib]);
  try
   P:=GetProcAddress(Lib,'DllRegisterServer');
   if not Assigned(P) then raise Exception.Create('Cannot find '+
    'procedure DllRegisterServer');
   P;
  finally
   FreeLibrary(Lib);
  end;
 finally
  OleUninitialize;
 end;
end;

procedure Uninstall;
var Lib:THandle;
    S:String;
    P:TProcedure;
begin
 S:=ExtractFilePath(Application.ExeName)+'HTML.OCX';
 Lib:=LoadLibrary(PChar(S));
 if Lib<HINSTANCE_ERROR then
  raise Exception.CreateFmt('Cannot initialize library %s.'+
      ' Internal Windows error %d',[S,Lib]);
 try
  P:=GetProcAddress(Lib,'DllUnregisterServer');
  if not Assigned(P) then raise Exception.Create('Cannot find procedure '+
   'DllUnregisterServer');
  P;
 finally
  FreeLibrary(Lib);
 end;
end;

Powinno się udostępnić opcję wymuszenia instalacji komponentu. Miałem problem gdy komponent był zarejestrowany ale nie było go na dysku.Wtedy pojawiał się błąd. Dzieje się tak najczęściej na komputerach, na których ktoś wcześniej instalował Delphi. Możliwe, że uninstall z Delphi nie usuwa wpisów w rejestrze a usuwa pliki. Aby powyższe działało można:

• wrzucić wszystkie pliki kontrolki do katalogu z programem
• na początku projektu sprawdzać czy kontrolka jest zarejestrowana
• jeśli nie jest to ją zarejestrować
• jeśli jest to zapamiętać, że jest
• na końcu programu (przy wyjściu) odrejestrować kontrolkę ale tylko wtedy gdy nie była zarejestrowana przed wywołaniem programu
• jeśli ktoś użyje parametru przy uruchomieniu programu to traktować ten przypadek jako brak instalacji kontrolki

Można też sprawdzanie instalacji zamienić na próbne utworzenie kontrolki. Jeśli Delphi rzuci wyjątek EOleSysError to znaczy, że trzeba ją zainstalować. IMHO OCX-y są trochę niewygodne. Wolę komponenty "100% pure Delphi". Przykładowe procedury były pisane do komponentu THTML. Aby rejestrować inne komponenty trzeba znać ich GUID i nazwę pliku, w którym się znajdują. Informacje te można wziąć z dokumentacji lub rejestru Windows.

44. Jak wywołać program 32-bitowy i poczekać na jego zakończenie?
wywołanie, 32-bit

Można skorzystać z poniższego przykładu:

procedure TForm1.Button1Click(Sender: TObject);
var SI:TStartupInfo;
    PI:TProcessInformation;
    S,Dir:String;
begin
 Dir:=ExtractFilePath(Application.ExeName);
 S:='winrar95.exe a '+Dir+'test.rar '+Dir+'*.*';

 FillChar(SI,sizeof(SI),0);
 with SI do
 begin
  dwFlags:=STARTF_USESHOWWINDOW;
  wShowWindow:=SW_SHOW;
  cb:=sizeof(TStartupInfo);
 end;

 if CreateProcess(nil,PChar(S),nil,nil,FALSE,NORMAL_PRIORITY_CLASS,nil,nil,SI,PI) then
  with PI do
  begin
   WaitForInputIdle(hProcess,1000);
   WaitForSingleObject(hProcess,10000);
   WaitForSingleObject(hThread,10000);
   CloseHandle(hProcess);
   CloseHandle(hThread);
  end;
end;

Oczywiście trzeba zmienić wartości przekazywane w zmiennej S ale idea pozostaje ta sama.

Źródło informacji: Marian Ficek

45. Jak wyświetlić plik JPG (instalacja jpeg.dcu z katalogu LIB nie pomaga)?
JPEG, JPG, LIB

Oto co proponuje Grzegorz Meus:

"Koniecznie wpisz w sekcji USES twojego modułu nazwę JPEG. Wtedy gdy wrzucisz na swój formularz np. komponent OpenPictureDialog (sekcja Dialogs z Delphi 3) będziesz miał dostęp do plików graficznych typu .JPG i od razu także ich podgląd w okienku tego dialogu. Aby samodzielnie taki obrazek wyświetlać dodatkowo wrzuć jakiś PaintBox na formularz, następnie zadeklaruj zmienną typu TPicture do przechowywania obrazu JPEG w pamięci

TForm1 = class(TForm)
  ...
  OpenPictureDialog1: TOpenPictureDialog;
  ...
private
  { Private declarations }
  FPicture : TPicture;
  ...
end;

Nie zapomnij o utworzeniu zmiennej FPicture zadeklarowanej wyżej (np. w TForm1.FormCreate):

FPicture := TPicture.Create;

oraz oczywiście jej zniszczeniu (np. w TForm1.FormDestroy)

FPicture.Free;

No i teraz w programie, zakładając że masz ścieżkę do pliku typu JPG w zmiennej FName : String, robisz coś takiego:

try
 FPicture.LoadFromFile(FName);
except
 on EInvalidGraphic do
 begin
  MessageDlg('Invalid graphic file: '+FName,mtError,[mbOk],0);
  Exit;
 end;
end;
PaintBox1.Invalidate;

a w procedurce TForm1.PaintBox1Paint:

with PaintBox1 do
begin
 DrawRect:=Rect(0,0,Width,Height); //ramka wokół ...
//i
 Canvas.Draw(Left+(Right-Left-FPicture.Width)div 2,
  Top+(Bottom-Top-FPicture.Height)div 2,FPicture.Graphic);
//lub
 Canvas.StretchDraw(DrawRect,FPicture.Graphic);
end;

Powodzenia !"

Źródło informacji: Grzegorz Meus

46. Jak zrobić wygaszacz w Delphi 1.0?
wygaszacz

Oto co proponuje Tomasz Witek:

"...napisałem kiedyś taki wygaszacz. Bardzo prosto. Forma bez ramek, bez linijki, maximized, czuła na myszkę, zawierająca description w postaci:

{$D SCRNSAVE:Wygaszacz}

{Tylko jedna kopia programu może być uruchomiona}
if hPrevInst = 0 then 
begin
 if (ParamCount > 0) and (UpperCase(ParamStr(1)) = '/S') 
 begin
  { Setup wygaszacza }
 end
 else
  begin
   { Wygaszacz }
  end;

Sam wygaszacz powinien uruchamiać się tylko po /C ale nie musi :)))
To by było wszystko."

Źródło informacji: Tomasz Witek

47. Jak dodać skrót do Desktopu lub Menu Start w Windows 95?
skrót, pasek Start, menu, desktop, ikona

Poniższe pochodzi z Delphi TI 3234:

Poniższy przykład pokazuje jak dodać skróty na desktop i menu Start w Windows 95 i Windows NT 4.0. Skrót zostanie dodany w jednym z tych miejsc (patrz kod). Położenie desktopu i menu Start pobierane jest z rejestru (z gałęzi HKEY_CURRENT_USER):

Software\MicroSoft\Windows\CurrentVersion\Explorer\Shell Folders

uses  ShlObj, ActiveX, ComObj, Registry;

procedure TForm1.Button1Click(Sender: TObject);
var  MyObject:IUnknown;
     MySLink:IShellLink; 
     MyPFile:IPersistFile;  
     FileName:String;
     Directory:String;  
     WFileName:WideString;  
     MyReg:TRegIniFile;
begin
 MyObject:=CreateComObject(CLSID_ShellLink);
 MySLink:=MyObject as IShellLink;  
 MyPFile:=MyObject as IPersistFile;
 FileName:='NOTEPAD.EXE';  
 with MySLink do 
 begin
  SetArguments('C:\AUTOEXEC.BAT');    
  SetPath(PChar(FileName));
  SetWorkingDirectory(PChar(ExtractFilePath(FileName)));  
 end;

 MyReg := TRegIniFile.Create('Software\MicroSoft\Windows\CurrentVersion\Explorer');

 // Poniższe dodaje skrót do desktopu
 Directory := MyReg.ReadString('Shell Folders','Desktop','');

 // A to do menu Start
 //  Directory := MyReg.ReadString('Shell Folders','Start Menu','')+
 //      '\Whoa!';//  CreateDir(Directory);

 WFileName := Directory+'\FooBar.lnk';  
 MyPFile.Save(PWChar(WFileName),False);
 MyReg.Free;
end;

Źródło informacji: Delphi TI 3234.

48. Mam problemy z bazami danych w sieci, nie pojawiają się zmiany w bazach.
sieć, BDE, bazy danych, Paradox

Oto co na ten temat pisze Krzysztof Szyszka

"Ponieważ już parę razy odpowiadałem na pytania dotyczące różnych problemów związanych z pracą w sieci na bazach dBase i Paradox, a pytania ciągle się pojawiają, więc pokuszę się o krótkie zebranie zaleceń wynikających z moich własnych doświadczeń. (...)

1. Ustawić w BDE Administratorze parametr Configuration/System/INIT/LOCAL SHARE na True na wszystkich stacjach, jeśli korzystamy z sieci typu peer-to-peer np. Microsoft Network.
2. Dla baz Paradoxa ustawić Configuration/Drivers/Native/PARADOX/NET DIR lub Session.NetFileDir na ten sam fizycznie plik PDOXUSRS.NET. Niektórzy zalecają umieścić ten plik w katalogu baz danych.
3. Ustawić Session.PrivateDir na roboczy katalog lokalnego dysku, chyba że mamy pewność, że bieżącym katalogiem przy starcie programu będzie katalog na lokalnym dysku.
4. Zostawić domyślne ustawienie Table.CachedUpdates na False. Przy ustawieniu na True należy być świadomym, że wszystkie operacje na bazie wykonywane są jedynie w pamięci bez zapisu na dysk, a więc i bez wykonywania funkcji sieciowych.
5. W zdarzeniu AfterPost każdej tabeli danych wymusić zapis buforów BDE na dysk poleceniem: Check(dbiSaveChanges(Table.Handle)). Dla tabel służących do przetwarzania większej porcji rekordów można wykonać to po zakończeniu aktualizacji, jeśli nie dokonujemy zmian w polach kluczowych dla pracy w sieci. Z punktu widzenia bezpieczeństwa danych lepiej wykonywać to po każdym Post, kosztem szybkości przetwarzania rekordów.
6. Po wykonaniu każdego polecenia dostępnego użytkownikowi, które operuje na bazach danych, należy wykonać Table.Refresh dla uwidocznienie zmian dokonanych ostatnio w bazie przez innych użytkowników. Ma to szczególne znaczenie wtedy, gdy polecenie zakończy się komunikatem o błędzie np. 'Record locked by another user.', 'No current record.', 'Rekord/Key deleted.', itp.
7. Dla tabel podłączonych do komponentów, które operują jednocześnie na więcej niż jednym rekordzie danych (np. DBGrid) wykonać dodatkowo DBGrid.Refresh, dla uwidocznienie zmian w pozostałych wierszach danych. W programach które prezentują jednocześnie kilka okien danych warto podłączyć Table.Refresh (i DBGrid.Refresh) pod zdarzenie OnActivate, żeby uczynienie okna aktywnym, wiązało się zawsze z odświeżeniem danych.
8. Wykonując instalacje programu wymagającego BDE przy pomocy InstallShielda można dopisać własne Aliasy, ale nie można spowodować zmian w parametrach z zakładki Configuration (w każdym razie mnie się to nie udało), dlatego warto zmodyfikować ręcznie plik \InstallShield\redist\IDAPI32.CNF, dokonując np. zmiany domyślnego ustawienia dla LOCAL SHARE na True."

Źródło informacji: Krzysztof Szyszka

49. Jak przeszukiwać Delphi Help i Win32 Help jednocześnie?
help, pomoc, przeszukiwanie

Należy dopisać poniższy tekst do Delphi3.CNT:

:Index Win32=win32.hlp

wtedy w indeksie jest zarówno Delphi jak i WinAPI.

Źródło informacji: Krzysztof Świątkowski

50. Gdzie mogę znaleźć dodatkowe informacje o Delphi?
linki

Poniżej jest kilka linków zebranych i opracowanych przez Tomasza Kustrę i Radosława "Radio Erewan" Przybyła:

I. Komponenty

Delphi Super Page
Torry's Delphi Page
Delphi Free Stuff
Animated Menus98
Artem's Delphi Stuff
CoolForm ("okrągłe okienka")
RX Library (lepiej ściągać z mirrora w Polsce)
Latające toolbary Jordana Russela
Delphi Games Creator
Une Page Delphi 2+
Delphi Companion
Programers Heaven
JG's Home Page
American Freehold C++Builder/Delphi Freeware
Delphi3.com
InfoTrade Virtual Code Library
http://www.balticsolutions.com
http://www.htmlreport.com

II. Wiedza/Żródła

Archiwum pl.comp.lang.delphi
Delphi Companion
Delphi Sites
The Unoficial Newsletter of Delphi Users
Dr Bob`s Delphi Clinic
Programers Heaven
The Delphi EXchange
Delphi3.com
eMEDES Software : Delphi Source Code
Ask the Delphi Pro
FreeCode
Delphi Developer on line
Zagozda Software - Delphi w przykładach
WinAPI-FAQ

III. Borland/Inprise:

Strona główna
Delphi Developer's Jurnal
Delphi Developer Support
Common Delphi Question and Answers
BSC (Borlsnd Support Center) - polski reprezentant Inprise

IV. Inne źródła:

MSDN Technologies
Win32 Development
COM Technologies
SWAG (Sourceware Archive Group) (np.formaty większości plików graficznych)

V. Linki

Delphi Sites
Programers Heaven
ITM - Delphi Search Engine
Delphi Developers
Delphi3.com
Turbo Pascal Programers Page
About Delphi Programming

Źródło informacji: Tomasz Kustra, Radosław "Radio Erewan" Przybył, Piotr Neil "Gawron" Gawronski, Paweł Świerzko.

51. Przy próbie dodania nowego rekordu do tabeli Paradoxa pojawia się błąd "Index is read-only". Przy ustawianiu nazwy indeksu wyskakuje wyjątek "Index is out of date".
Paradox, indeksy

Dla tabel Paradox'a indeksy typu secondary nie mogą być modyfikowane bez istnienia indeksu primary. Rozwiązać to można na 2 sposoby:
- przez dodanie primary index w Database Desktop,
- dodawanie danych do tabeli bez ustawionego indeksu, a następnie przez ponowne
utworzenie indeksów w Database Desktop ręcznie lub programowo przy użyciu poniższego kodu:

try
 Table1.Active:=False;
 Table1.Exclusive:=True;
 Table1.Active:=True;
 Check(DbiRegenIndexes(Table1.Handle));
finally
 Table1.Active:=False;
 Table1.Exclusive:=False;
 Table1.Active:=True;
end;

Table1 nie może posiadać ustawionego indeksu w IndexFieldNames ani IndexName.

Źródło informacji: Krzysztof Borys.

52. Delphi nie chce działać z kartą S3 Virge. Co robić?
Virge, S3

Należy zmniejszyć w ustawieniach karty akcelerację sprzętową na minimum lub nie instalować komponentów internetowych. Problem ten podobno występuje tylko na kartach czteromegowych.

Inne rozwiązanie opisał Konrad:

"Chcę dorzucić swoje 3 grosze do pytania nr.52.

Ze zmianą akceleracji nie sprawdzałem (nie lubię takich kompromisów), ale rozwiązałem ten problem w trochę inny sposób, pozwalający na utrzymanie pełnej akceleracji (ach te gierki...:)): Po reinstalacji windy i sformatowaniu twardziela (i tak trzeba to robić raz na kwartał), zainstalowałem oryginalne sterowniki do Virge i starego DirectX'a (dołączonego do Virge). Delphi (ver.3) jeszcze chodzi. Ale instalacja DirectX 6 albo 5 (z innymi nie sprawdzałem) rozwala Delphi całkowicie...

Można to ominąć podczas procesu instalacji nowej wersji DirectX, nie zgadzając się na próby zmiany sterowników karty graficznej. Wtedy i DirectX (gierki :)) i Delphi działają bez zarzutu. Ominięcie instalacji nowych sterowników nie wpływa na wydajność DirectX (przynajmniej w widoczny sposób)."

Artur Solich podał też inny sposób (sprawdzony na Delphi3 i Win98): należy w pliku system.ini w sekcji [Display] (jeżeli jej nie ma to trzeba ją utworzyć) dopisać DeviceBitmap=0. Po restarcie systemu Delphi powinno działać poprawnie.

Źródło informacji: Konrad Z, Artur Solich.

53. Jak usunąć przycisk programu z paska zadań?
pasek zadań, ikona, przycisk

Należy:

W module projektu:

• dodać do uses Windows,
• zadeklarować zmienną np. ES : Integer;
• po Application.Initialize dopisać

ES:=GetWindowLong(Application.Handle, GWL_EXSTYLE);
ES:=ES or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW;
SetWindowLong(Application.Handle,GWL_EXSTYLE,ES);

Okno z ustawionym stylem WS_EX_TOOLWINDOW nie jest pokazywane na pasku zadań.

Źródło informacji: Darek Brzeziński

54. Jak dodać swój program obok ikonki zegara w Windows 95?
pasek zadań, tray, szuflada, ikona, zegar

Poniżej znajduje się przetłumaczony tekst Brendana Delumpa (tu podziękowania dla Radka "Radio Erewan" Przybyła za wyszukanie go w odmętach Sieci):

"Zabawne jak niektóre rzeczy w Windows, które wyglądają na proste w implementacji okazują się być bardzo stresujące. I nie jest tak dlatego, że są to trudne rzeczy - często po porostu informacje potrzebne do ukończenia programu kryją się za wieloma odnośnikami WWW, stronami helpa lub nie ma ich tam gdzie spodziewalibyśmy się je znaleźć (częste luki w dokumentacji Delphi). Tak również jest z tworzeniem aplikacji umieszczającej ikonę w obszarze systemowego traya (szuflady). Implementacja tego efektu jest trywialna ale dotarcie do potrzebnych informacji nie jest proste.

Są dwie rzeczy, które trzeba wziąć pod uwagę tworząc aplikację do traya. Pierwsza to "ukrycie" aplikacji przed Windows. Mimo, że aplikacje takie wyglądają i zachowują się jak zwykłe aplikacje Windows, nie można się na nie przełączyć przy użyciu Alt-Tab ani nie mają swojego przycisku na pasku zadań. Tym zajmiemy się najpierw.

Każde okno posiadające styl WS_EX_TOOLWINDOW ani nie ma przycisku na pasku zadań ani nie można się na nie przełączyć. Z początku może wydawać się właściwym ustawienie tego stylu przy użyciu CreateParams. Niestety nie zadziała to dla formy. Tu mała dygresja. Główna forma aplikacji nie jest oknem (w terminologii Windows) aplikacji. Obiekt aplikacji ma swoje własne okno - nie można go zobaczyć ale ono "tam" jest. To jest właśnie to okno, do którego należy przypisać styl WS_EX_TOOLWINDOW. Gdzie więc należy wstawić kod? Oczywiście w źródle projektu. Po wybraniu View|Project Source należy skopiować poniższy kod:

program Project1;
uses Forms,
     Unit1 in 'Unit1.pas' {Form1},
     Windows; //To jest wymagane aby znana była stała WS_EX_TOOLWINDOW i pozostałe
{$R *.RES}
//Deklaracja zmiennej do przyjęcia informacji o stylu okna
var ExtendedStyle : Integer;
begin  
 Application.Initialize;
 //Pobranie informacji o oknie aplikacji przy użyciu GetWindowLong
 ExtendedStyle:=GetWindowLong(Application.Handle, GWL_EXSTYLE);

 //Teraz ustawiamy styl rozszerzony przy użyciu operacji na bitach
 //Przekształca to okno z okna-aplikacji do okna-narzędzia
 SetWindowLong(Application.Handle,GWL_EXSTYLE,
  ExtendedStyle or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
 Application.CreateForm(TForm1, Form1);  
 Application.Run;
end.

A teraz aby utworzyć właściwy efekt aplikacji w trayu będziemy potrzebowali przede wszystkim głównej formy aplikacji. Połóż na formie komponent TPopupMenu. Będzie to główny interfejs do naszej aplikacji. Popatrz na poniższy kod:

{ Poniższe umieszcza aplikację w trayu.
  Jest to główna forma aplikacji. Posiada ona menu popup używane do
  wyświetlenia formy i zamknięcia aplikacji.

  Używając modułu ShellApi w prosty sposób pokażemy ikonę aplikacji w trayu
  i spowodujemy aby reagowała na kliknięcia myszą }

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  ShellAPI, ExtCtrls, Menus;

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    ShowMainForm1: TMenuItem;
    N1: TMenuItem;
    ExitApplication1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure ShowMainForm1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ExitApplication1Click(Sender: TObject);
  private
    procedure WndProc(var Msg : TMessage); override;
  public
    IconNotifyData : TNotifyIconData;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Zostawiamy tylko przycisk zamykający okno
  BorderIcons := [biSystemMenu];

  // Teraz wypełniamy rekord IconNotifyData tak aby przyjmował
  // komunikaty wysyłane do aplikacji i pokazywał "dymki" podpowiedzi.
  with IconNotifyData do begin
    hIcon:=Application.Icon.Handle;
    uCallbackMessage:=WM_USER+1;
    cbSize:=SizeOf(IconNotifyData);
    Wnd:=Handle;
    uID:=100;
    uFlags:=NIF_MESSAGE+NIF_ICON+NIF_TIP;
  end;
  // Kopiujemy tytuł aplikacji jako "dymek"
  StrPCopy(IconNotifyData.szTip, Application.Title);

  // Dodajemy ikonę do traya
  Shell_NotifyIcon(NIM_ADD,@IconNotifyData);
end;

procedure TForm1.WndProc(var Msg : TMessage);
var
  p : TPoint;
begin
 if (Msg.Msg=WM_USER+1)and(Msg.lParam=WM_RBUTTONDOWN) then
 begin
  GetCursorPos(p);
  PopupMenu1.Popup(p.x, p.y);
 end;

 inherited;
end;

// To jedna z procedur obsługi elementów menu
procedure TForm1.ShowMainForm1Click(Sender: TObject);
begin
  Form1.Show;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caNone;
  Form1.Hide;
end;

procedure TForm1.ExitApplication1Click(Sender: TObject);
begin
  Shell_NotifyIcon(NIM_DELETE, @IconNotifyData);
  Application.ProcessMessages;
  Application.Terminate;
end;

end.

Jak widać nie ma wiele do zrobienia. Ale ważne jest aby rozumieć co zrobiliśmy w metodzie Create i jakie znaczenie ma rekord IconNotifyData. Jest to rekord zdefiniowany w module ShellAPI, który przechowuje informację o ikonie w trayu. Zauważ flagi, których użyliśmy: NIF_MESSAGE + NIF_ICON + NIF_TIP. Oznaczają one kolejno: obsługę komunikatów dla aplikacji, pokazywanie ikony aplikacji i pokazywanie "dymku" z podpowiedzią.

Następna sprawa to nadpisanie procedury WndProc (skrót od WindowProcedure). Dostaje ona wszystkie komunikaty przesyłane do okna i zachowuje się jak centralna rozdzielnia komunikatów. Można przejąć obsługę komunikatu pisząc własną jego obsługę i wywołując odziedziczoną procedurę. Przy obsłudze komunikatu sprawdzamy czy jest to nasz własny (wm_User+1) zdefiniowany w zmiennej IconNotifyData oraz czy nastąpiło kliknięcie prawym przyciskiem myszy. Pozostałe komunikaty przesyłamy bez zmian.[...]"

Źródło informacji; Brendan Delupma, Radosław "Radio Erewan" Przybył

55. Jak odegrać dźwięk przechowywany w zasobach?
dzwięk, zasoby, WAV, WAVE

Należy skorzystać z poniższego kodu:

var FindHandle, ResHandle: THandle;
    ResPtr: Pointer;
begin
 FindHandle:=FindResource(HInstance, 'TUTAJ NAZWA ZASOBU', 'WAVE');
 if FindHandle<>0 then 
 begin
  ResHandle:=LoadResource(HInstance, FindHandle);
  if ResHandle<>0 then 
  begin
   ResPtr:=LockResource(ResHandle);
   if ResPtr<>Nil then
    SndPlaySound(PChar(ResPtr), snd_ASync or snd_Memory);
   UnlockResource(ResHandle);
  end;
  FreeResource(FindHandle);
 end;
end;

Krzysztof Świątkowski zwrócił uwagę na prostszą metodę możliwą jednak do wykorzystania tylko w Win32. Jeśli mamy zasób typu WAVE wystarczy tylko wykonać:

PlaySound('MUZYKA', hInstance, SND_RESOURCE or SND_ASYNC);

hInstance jest uchwytem do instancji aplikacji lub biblioteki. W ten sposób można np odtworzyć WAVE zapisany w jakimś dll'u.

Źródło informacji: Stefan Westner, Krzysztof Świątkowski

56.Jak schować lub wyłączyć przycisk start w Win95?
przycisk Start, pasek zadań

Należy wykonać poniższy kod:

procedure TForm1.Button1Click(Sender: TObject);
var
  Rgn : hRgn;
begin
 //Ukrycie przycisku Start
  Rgn := CreateRectRgn(0, 0, 0, 0);
  SetWindowRgn(FindWindowEx(FindWindow('Shell_TrayWnd', nil),0,'Button',nil),Rgn,true);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 //Przywrócenie przycisku
  SetWindowRgn(FindWindowEx(FindWindow('Shell_TrayWnd', nil),0,'Button',nil),0,true);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 //Wyszarzenie przycisku Start
  EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil),0,'Button',nil),false);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
 //Ponowne włączenie przycisku
  EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil),0,'Button',nil),true);
end

57. Czy jest coś dokładniejszego niż TTimer?
TTimer, zegar, przerwanie

Należy użyć procedury QueryPerformanceFrequency. Oto przykład:

procedure TForm1.Button1Click(Sender: TObject);
var
  li : TLARGEINTEGER;
begin
  QueryPerformanceFrequency(li);
  ShowMessage(FloatToStr(Comp(li)));
  QueryPerformanceCounter(li);
  ShowMessage(FloatToStr(Comp(li)));
  QueryPerformanceCounter(li);
  ShowMessage(FloatToStr(Comp(li)));
end;

Jak widać TLargeInteger jest kompatybilny wewnętrznie z Comp i może być na niego rzutowany.

58. Jak wykryć obecność karty dźwiękowej?
karta dźwiękowa

Należy użyć funkcji WaveOutGetNumDevs:

uses MMSystem;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if WaveOutGetNumDevs > 0 then
    ShowMessage('Karta dźwiękowa jest zainstalowana')
  else
    ShowMessage('Brak karty dźwiękowej')
end;

59. Co zrobić aby w Delphi 4 używać polskich liter?
polskie litery

Należy dodać do rejestru klucz:

HKEY_CURRENT_USER\Software\Borland\Delphi\4.0\Editor\Options\NoCtrlAltKeys

z wartością "1".

60. Jak włączyć w Delphi 3 okno debugera?
debuger

Należy dodać do rejestru klucz:

HKEY_CURRENT_USER\Software\Borland\Delphi\3.0\Debugging\EnableCPU

z wartością "1".

61. Jak utworzyć lub odtworzyć indeksy dla istniejących tabel?
indeks, Paradox

Należy skorzystać z metody AddIndex:

Table1.AddIndex('NewIndex','CustNo;CustName',[ixUnique,ixCaseInsensitive]);

zaś aby odtworzyć indeks:

Check(dbiRegenIndexes(Table1.Handle));

Użycie dbiRegenIndexes może wymagać dodania modułu BDE do klauzuli uses, zaś tabele powinny być otwarte w trybie wyłączności.

Źródło informacji: Tomasz Hejman, Krzysztof Borys

62. Mam Delphi 2.0 i NT 4.0. Nie widzę polskich znaków, co robić?
polskie znaki, NT

Należy zmienić w rejestrze klucz:

HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\NLS\CodePage\1252

z "c_1252.nls" na "c_1250.nls". Problem ten pojawia się tylko gdy zainstalujemy Service Pack 3

Źródło informacji: Marian Ficek

63. Mimo że usuwam rekordy z bazy to jej rozmiar nie zmniejsza się, co robić?
rozmiar bazy, rekordy, BDE, pakowanie, kasowanie

Paradox (i inne bazy) nie usuwają fizycznie rekordu z bazy a tylko zaznaczają go jako usuniętego. Przyspiesza to operacje na rekordach. Aby odzyskać zajmowane przez te rekordy miejsce należy użyć procedur pakujących tabelę.

W klauzuli uses dopisujemy:

uses DbiProcs,DbiTypes,DbiErrs;

A potem:

function TForm1.PackTable():DbiResult;
var
   Props: CURProps;
   hDb: hDBIDb;
   TableDesc: CRTblDesc;
begin
   if Table1.Active then
      Table1.Active := False;
   try
     Table1.Exclusive:=True;
     Table1.Active:=True;
   except
     ShowMessage('Błąd: Nie mogę otworzyć tabeli ' + Table1.TableName + ' na wyłączność;'
        + #13#10 + 'prawdopodobnie jest uszkodzona, lub tabela jest w używana');
     Result:=66;
     Exit;
   end;

   // Pobieramy właściwości tabeli aby sprawdzić jej typ...
   Check(DbiGetCursorProps(Table1.Handle, Props));

  // Jeśli to tabela Paradoxa, wywołujemy DbiDoRestructure...
  if Props.szTableType = szPARADOX then
  begin
    // Zerujemy rekord...
    FillChar(TableDesc, sizeof(TableDesc), 0);
    //  Pobieramy uchwyt tabeli z uchwytu kursora...
    Check(DbiGetObjFromObj(hDBIObj(Table1.Handle), objDATABASE, hDBIObj(hDb)));
    // Przepisujemy nazwę tabeli...
    StrPCopy(TableDesc.szTblName, Table1.TableName);
    // i jej typ...
    StrPCopy(TableDesc.szTblType, Props.szTableType);
    // Ustawiamy opcję Pack na TRUE...
    TableDesc.bPack := True;
    // Zamykamy tabelę (dBase oczekuje otwartej tabeli)
    Table1.Close;
    // Wywołujemy DbiDoRestructure...
    Result:=DbiDoRestructure(hDb, 1, @TableDesc, nil, nil, nil, FALSE);
    Check(Result);
 end
 else
 begin
    // Jeśli to tabela dBASE to po prostu wywołujemy DbiPackTable...
    if Props.szTableType = szDBASE then
       Result:=DbiPackTable(Table1.DBHandle, Table1.Handle, nil, szDBASE, TRUE)
    else
      // To wszystko działa tylko dla tabel Paradoksa i dBASE...
      raise EDatabaseError.Create('Tabela musi być typu Paradox lub dBASE ' +
               'aby można ją było pakować');
 end;
 Table1.Active:=False;
 Table1.Exclusive:=False;
end;

Pozostaje jeszcze wywołać tę procedurę:

 if Form1.PackTable = DbiERR_NONE then
  begin
   MessageDlg('Pakowanie tabeli zakończone sukcesem.',mtInformation,[mbOK],0);
  end
 else
  MessageDlg('Pakowanie tabeli nie powiodło się.',mtWarning,[mbOK],0);

Źródło informacji: Piotr Murawski

64. Jak kompilować warunkowo dla różnych wersji Delphi?
kompilacja warunkowa

Każda wersja ma inny symbol (ang. conditional define).

Można tego użyć w następujący sposób:

{$IFDEF VER90} 
uses system, windows, oleaut; 
{$ENDIF}
{$IFDEF VER100}
uses system,windows, comobj;
{$ENDIF}

Źródło informacji: Grzegorz Skoczylas.

65. Jak odczytać lokalny adres IP?
adres IP, internet

Na przykład przy użyciu poniższego kodu:

uses Winsock;

procedure TForm1.FormCreate(Sender:TObject);
var wVersionRequested:WORD;
    wsaData:TWSAData;
begin
 //Ładujemy bibliotekę Winsock
 wVersionRequested := MAKEWORD(1, 1);
 WSAStartup(wVersionRequested, wsaData);
end;

procedure TForm1.Button1Click(Sender:TObject);
var p:PHostEnt;
    s:array[0..128] of char;
    p2:pchar;
begin
 //Pobieramy nazwę komputera
 GetHostName(@s, 128);
 p := GetHostByName(@s);
 Memo1.Lines.Add(p^.h_Name);
 //Pobieramy jego adres IP
 p2 := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
 Memo1.Lines.Add(p2);
end;

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

Na formie powinno znajdować się memo o nazwie Memo1. W podany sposób można też łatwo sprawdzić czy jesteśmy podłączeni do sieci. Gdy nie ma połączenia z Internetem to adres ma postać 0.0.0.0

66. Jak zablokować przełączanie zadań przy pomocy Alt-Tab lub Ctrl-Tab?
Alt, Tab, zadania, przełączanie

Należy oszukać Windows tak aby myślało, że nasza aplikacja jest wygaszaczem ekranu. Poniższy sposób działa tylko w Windows 95, nie działa w NT i nie ma gwarancji, żeby działał w przyszłych wersjach Windows.

var OldValue:LongBool;
begin
 //Włącza blokadę
 SystemParametersInfo(97,Word(True),@OldValue,0);

 //Wyłącza blokadę
 SystemParametersInfo(97,Word(False),@OldValue,0);
end;

67. Jak odczytać nazwę zalogowanego użytkownika?
nazwa użytkownika, sieć, użytkownik, logowanie

Trzeba skorzystać z funkcji Windows API o nazwie GetUserName:

procedure TForm1.Button2Click(Sender: TObject);
var buffer:string;
    buffSize:DWORD;
begin
 buffSize:=128;
 SetLength(buffer,BuffSize);
 GetUserName(PChar(buffer), buffSize);
 ShowMessage(buffer);
end;

68. Jak dodać nazwę dokumentu do listy ostatnio otwartych dokumentów w menu Start?
lista dokumentów, recent

Trzeba skorzystać z funkcji Windows API o nazwie SHAddToRecentDocs:

uses ShlOBJ;

procedure TForm1.Button1Click(Sender: TObject);
var s:string;
begin
 s:='C:\DownLoad\ntkfaq.html';
 SHAddToRecentDocs(SHARD_PATH,PChar(s));
end;

69. Jak programowo włączyć lub wyłączyć monitor?
monitor, VESA

Należy wysłać komunikat wm_SysCommand z parametrem wParam ustawionym na SC_MonitorPower zaś lParam ustawionym na:

• 0 - aby wyłączyć monitor
• 1 - aby go włączyć z powrotem

Wyłączenie monitora:

SendMessage(Application.Handle,wm_SysCommand,SC_MonitorPower,0);

Włączenie monitora:

SendMessage(Application.Handle,wm_SysCommand,SC_MonitorPower,-1);

Uśpienie maszyny:

SendMessage(Application.Handle,wm_SysCommand,SC_SCREENSAVE,-1);

Uwaga: Parametr SC_MonitorPower jest specyficzny dla Windows 95.

Uwaga: Comboy informuje, że pod WinME SC_MonitorPower też działa.

Źródło informacji: Michał Młynarczyk, Comboy.

70. Jak zmodyfikować menu systemowe formy?
menu systemowe, forma

Tak. Słyży do tego grupa funkcji: GetSystemMenu, AppendMenu, InsertMenu, ModifyMenu. Przy tworzeniu formy dodajemy do menu systemowego własny element. Jako jego identyfikator wybrałem liczbę zero zapisaną w stałej idTest.

const idTest=0;

procedure TMainForm.FormCreate(Sender: TObject);
var hMenu:THandle;
begin
 hMenu:=GetSystemMenu(Handle,False);
 AppendMenu(hMenu,mf_String,idTest,'&Test');
end;

Tak zdefiniowaną pozycję menu trzeba jeszcze samodzielnie obsłużyć. Robi to procedura wywoływana gdy aplikacja dostanie komunikat wm_SysCommand:

procedure TMainForm.WMSysCommand(var Message:TWMSysCommand);
begin
 if Message.CmdType=idTest then
 begin
  Message.Result:=0;      //Zaznaczamy, że obsłużyliśmy komunikat
  ShowMessage('Komunikat testowy');
 end
 else inherited;
end;

71. Jak odczytać wielkość wolnego obszaru na ekranie biorąc pod uwagę wysokość (szerokość) paska zadań?
pasek zadań, desktop, ekran, rozmiar

Należy skorzystać z funkcji SystemParametersInfo Windows API. Wywołana z parametrem SPI_GETWORKAREA poda rozmiar wolnego miejsca na ekranie:

procedure CenterForm(AForm:TForm);
var R:TRect;
begin
 SystemParametersInfo(SPI_GETWORKAREA,0,@R,0);
 with AForm do
 begin
  Left := R.Left + (R.Right - R.Left - Width) div 2;
  Top := R.Top + (R.Bottom - T.Top - Height) div 2;
 end;
end;

Pozostaje już tylko wywołać ją dla odpowiedniej formy:

CenterForm(Form1)

Źródło informacji: Krzysztof Szyszka.

72. Jak otworzyć bazę Access'a (*.MDB) poprzez sterownik MSACCESS?
Access, BDE, sterownik

Otwieranie baz Accessa jest możliwe tylko dla Delphi 3.0 i powyżej, w wersji Professional lub wyższej. Oprócz zainstalowanego BDE (najlepiej w wersji >= 4.51), na komputerze musi być zainstalowane DAO (jest w pakiecie Office 97, a wersję do redystrybucji należy mieć z któregoś z produktów Microsoft'u)

Po instalacji BDE należy uruchomić BDE Administratora i w zakładce Configuration znaleźć pozycję Configuration/Drivers/Native/MSACCESS. Tam trzeba przestawić wartość pola DLL32 z IDDAO32.DLL na IDDA3532.DLL.

Aby skorzystać z bazy w formacie MDB wystarczy teraz utworzyć alias w DatabaseDesktop lub utworzyć komponent TDatabase, a następnie ustawić wartości:

  Database1.DriverName:='MSACCESS';
  Database1.DatabaseName:='JakasNazwaDB';
  Database1.Params.Clear;
  Database1.Params.Add('DATABASE NAME=C:\Ścieżka_do\Pliku_bazy.mdb');
  Database1.Connected:=True;

Dla każdego użytego TQuery lub TTable należy ustawić wartość DatabaseName taką samą jak w Database1.DatabaseName.

Źródło informacji: Krzysztof Borys.

73. Jak programowo zmodyfikować ustawienia BDE sterownika MSACCESS i innych wartości BDE?
BDE, setup

Przy instalacji BDE domyślną wartością ustawień starownika MSACCESS jest sterownik IDDAO32.DLL (DAO 3.0), który wykorzystywany był w starej wersji Office, natomiast mając zainstalowany Office97 musimy zmienić ustawienia na IDDA3532.DLL (patrz poprzednie pytanie). Aby zrobić to programowo można skorzystać z poniższej procedury:

uses BDE;

procedure SetOffice97;
var Cursor:HDBICur;
    ConfigDesc:CFGDesc;
begin
 DBTables.Session.Active := true;
 try
  Check(DbiOpenCfgInfoList(nil,dbiREADWRITE,cfgPERSISTENT,
        PChar('\DRIVERS\MSACCESS\INIT'),Cursor));
  try
   while DbiGetNextRecord(Cursor,dbiNOLOCK,@ConfigDesc,nil)=0 do
    with ConfigDesc do
    begin
     OemToChar(szValue,szValue);
     if (AnsiCompareText(szNodeName,'DLL32')=0) and
        (AnsiCompareText(szValue,'IDDAO32.DLL')=0) then
     begin
      StrPCopy(szValue,'IDDA3532.DLL');
      CharToOem(szValue,szValue);
      Check(DbiModifyRecord(Cursor,@ConfigDesc,true));
      Break;
     end;
    end;
  finally
   DbiCloseCursor(Cursor);
  end;
 finally
  DBTables.Session.Active := true;
 end;
end;

W przypadku używania w programie komponentów TSession należy zamienić odwołanie z DBTables.Session na nazwę komponentu umieszczonego na formularzu

Źródło informacji: Krzysztof Borys.

74. Nie mogę stworzyć okienka MDIChild z ustawionym parametrem poDesigned.
MDIChild, MDI

Sprawdzane w Delphi 2.0.

Jeśli chcesz stworzyć okienko MDIChild o ściśle zadanej pozycji i ściśle zadanych wymiarach, to z czegoś będziesz musiał zrezygnować. Delphi zawiera błąd i wartość "poDesigned" wstawiona do pola "Position" formularza daje tyle samo co "poDefault". Użyj "poDefaultPosOnly" i ustaw pozycję ręcznie lub "poDefaultSizeOnly" i ręcznie ustaw rozmiar.

Źródło informacji: Maciej "MACiAS" Pilichowski.

75. Jak skopiować/skasować/przenieść cały katalog?
katalog, kopiowanie

Najwygodniej jest skorzystać z funkcji SHFileOperation znajdującej się w module ShellAPI:

uses ShellAPI;

procedure TForm1.Button1Click(Sender: TObject);
var FOS:TSHFileOpStructA;
begin
 with FOS do
 begin
  Wnd:=Handle;
  wFunc:=FO_COPY;
  pFrom:='c:\tip\źródło\*.*';
  pTo:='c:\tip\cel\';
  fFlags:=FOF_ALLOWUNDO	or FOF_NOCONFIRMMKDIR;
  lpszProgressTitle:='Kopiowanie...';
  fAnyOperationsAborted:=False;
 end;
 if SHFileOperation(FOS)<>0 then
  ShowMessage('Wystąpił błąd podczas kopiowania')
 else
  if FOS.fAnyOperationsAborted then
   ShowMessage('Kopiowanie zostało przerwane');
end;

76. Jak programowo zmienić rozdzielczość ekranu?
rozdzielczość ekranu, tryb graficzny

Wystarczy skorzystać z funkcji ChangeDisplaySettings:

procedure TForm1.Button2Click(Sender: TObject);
var Mode:TDeviceMode;
    S:String;
begin
 with Mode do
 begin
  dmSize:=SizeOf(Mode);
  dmBitsPerPel:=16;
  dmPelsWidth:=800;
  dmPelsHeight:=600;
  dmFields:=DM_PELSWIDTH+DM_PELSHEIGHT;
 end;
 case ChangeDisplaySettings(Mode,0)of
  DISP_CHANGE_SUCCESSFUL:S:='Operacja przebiegła pomyślnie';
  DISP_CHANGE_RESTART:S:='Aby zmiany odniosły skutek należy zrestartować systi';
  DISP_CHANGE_BADFLAGS:S:='Błędne pole dmFields';
  DISP_CHANGE_FAILED:S:='Błąd podczas ustawiania trybu';
  DISP_CHANGE_BADMODE:S:='Ten tryb nie jest obsługiwany';
  DISP_CHANGE_NOTUPDATED:S:='Rejestr nie został zaktualizowany';
  else S:='Nieznany kod wyniku';
 end;
 ShowMessage(S);
end;

77. Jak programowo podłączyć dysk sieciowy?
sieć, dysk, podłączanie

Należy skorzystać z funkcji WNetAddConnection2:

procedure TForm1.Button3Click(Sender: TObject);
var Res:TNetResource;
begin
 with Res do
 begin
  dwType:=RESOURCETYPE_ANY;
  lpLocalName:='X:'; // podłącz jako dysk X
  lpRioteName:='\\Komputer\Katalog'; // zdalny dysk
  lpProvider:=Nil;
 end;
 if WNetAddConnection2(Res,'Hasło','Użytkownik',CONNECT_UPDATE_PROFILE)<>NO_ERROR then
  ShowMessage('Błąd podczas podłączania dysku sieciowego');
end;

78. Jak ściągnąć plik z Internetu?
Internet, FTP, plik

Należy skorzystać z funkcji URLDownloadToFile z modułu URLMon:

uses URLMon;

procedure TForm1.Button4Click(Sender: TObject);
begin
 if URLDownloadToFile(Nil,'http://delphi.koti.com.pl/index.html',
                      'c:\temp\index.html',0,Nil)<>0 then
  ShowMessage('Błąd podczas ściągania pliku');
end;

79. Nie mogę ustawić ikony dla okna MDI.
MDI, ikona, forma

Oto co pisze na ten temat MACiAS:

"Tworzę aplikację z wykorzystaniem MDI i wbrew temu, co jest napisane w helpie, dla okienek MDIChild bez przypisanej ikony nie jest kopiowana ikona okna głównego.

Tak się rzeczywiście dzieje, ale tylko dla okienek ze stylem ramki bsDialog. Trudno mi powiedzieć, czyja to wina [pewnie Inprise'a :-) przyp. M.W.], ale faktycznie help na ten temat milczy. Należy po prostu zrezygnować z tego stylu ramki lub też "ręcznie" kopiować ikonę z okna głównego."

Źródło informacji: Maciej "MACiAS" Pilichowski.

80. Jak odczytać opis błędu funkcji API mając jego kod?
opis błędu, API

Należy skorzystać z funkcji Windows API o nazwie FormatMessage:

function GetErrorString(ErrorID:Integer):String;
var P:PChar;
begin
 if FormatMessage(Format_Message_Allocate_Buffer+Format_Message_From_System,Nil,
               ErrorId,0,@P,0,Nil)<>0 then
 begin
  Result:=P;
  LocalFree(Integer(P));
 end
 else Result:=Format('Error in GetErrorString(%d) : %d',[ErrorID,GetLastError]);
end;

function GetLastErrorString:String;
begin
 Result:=GetErrorString(GetLastError);
end;

81. Jak sprawdzić czy dany znak jest literą?
znak, litera

Ponieważ w systemie Windows możemy mieć do czynienia z wieloma językami to nie można na stałe wpisać reguły określającej czy znak jest literą czy nie. Ten sam kod może określać literę w jednym z języków a w drugim jakiś zupełnie inny znak. Należy więc odwołać się do jednej z funkcji API: IsCharAlpha, IsCharAlphanumeric, GetStringType.

Źródło informacji: Robin Wschód.

82. Jak programowo zmienić tapetę (tło pulpitu) Windows?
tapeta, tło, pulpit

Należy skorzystać z funkcji SystemParametersInfo podając jej parametr SPI_SETDESKWALLPAPER:

var s: String;
...
s:='plik.bmp';
SystemParametersInfo(SPI_SETDESKWALLPAPER,0,PChar(s),SPIF_UPDATEINIFILE
                     Or SPIF_SENDWININICHANGE);

Przy okazji widać jak najprościej przekonwertować zmienną typu String na PChar.

Źródło informacji: WiZZARD.

83. Za pomocą jakich funkcji mogę regulować głośność?
głośność, mixer

Można skorzystać z gotowych komponentów lub funkcji API:

uses MMSystem;

procedure WaveSetVolume(LVol,RVol:Byte);
begin
 waveOutSetVolume(WAVE_MAPPER,Integer(((LVol shl 8) or (RVol shl 24))));
end;

procedure WaveGetVolume(var LVol:Byte;var RVol:Byte);
var Vol: Integer;
begin
 waveOutGetVolume(WAVE_MAPPER,@Vol);
 LVol:=Hi(Vol);
 RVol:=Vol shr 24;
end;

Źródło informacji: WiZZARD.

84. Jak zmienić format wyświetlania i przechowywania dat dla bazy danych?
BDE, data, format

Należy uruchomić BDE Administratora i ustawić w konfiguracji odpowiedni separator danych i żądany format (ustawia się go inaczej niż w Windows, więc warto zerknąć do helpa).

W pliku naszego projektu (.dpr) w klauzuli uses należy dopisać deklarację użycia modułu SysUtils i zaraz po instrukcji:

Application.Initialize;

należy dopisać:

Application.UpdateFormatSettings:=FALSE;
DateSeparator:=...
Short/Long DateFormat:=...

Źródło informacji: Adam Jastrząbek, Maciej "MACiAS" Pilichowski.

85. Jak zrobić "inteligentne" okno z atrybutem StayOnTop?
StayOnTop, zawsze na wierzchu

Czasem chcielibyśmy aby jedna z form była cały czas na wierzchu naszej formy głównej nie przykrywając jednak okien innych aplikacji gdy się na nie przełączymy. Jak to zrobić? Oto co pisze na ten temat Hopbit:

procedure TFrmTaskFilters.CreateParams( var cp : TCreateParams );
begin
  inherited CreateParams( cp );
  cp.Style := WS_POPUP or WS_BORDER or WS_SYSMENU or WS_CAPTION or
              WS_MINIMIZEBOX or WS_SIZEBOX or WS_MAXIMIZEBOX;
  cp.ExStyle := WS_EX_TOOLWINDOW;
  cp.WndParent := Application.MainForm.Handle;
end;

"Wyjaśnienie:
Jeżeli okno(1) będzie parentem okna (2) i okno (2) będzie typu POPUP to okno (2) będzie zawsze nad oknem (1). Kruczek jest w tym że to musi być parent w rozumieniu Windows a nie Delphi.

Wadą tego rozwiązania jest to że dużą część parametrów okna trzeba ustawić samemu, choć pewnie można by modyfikować cp tak aby nie niszczyć ustawień Object Inspectora to mnie akurat tak było dużo wygodniej szczególnie że to było robione na chybcika."

Źródło informacji: Krzysztof Świątkowski.

86. Jak zamknąć inną aplikację?
zamykanie aplikacji, API

Poniższą procedurę podał Rafał Płatek:

function  KillProc(const ClassName:AnsiString):Boolean;
var
  hWnd,hProc:THandle;
  pid:DWORD;

begin
  Result:=False;
  hWnd := FindWindow(PCHAR(ClassName),nil);
  if IsWindow(hWnd) then begin
    GetWindowThreadProcessId(hWnd, @pid);
    hproc := OpenProcess(PROCESS_TERMINATE, FALSE, pid);
    if hproc<>0 then begin
      Result:=TerminateProcess(hProc,0);
      if Result then CloseHandle(hProc);
    end;
  end;
end;

Aby jej użyć należy podać nazwę klasy okna aplikacji np.:

KillProc('NOTEPAD');

Źródło informacji: podał Rafał Płatek.

87. Jak zablokować uruchamianie wygaszacza ekranu Windows?
wygaszacz ekranu, blokowanie

Aby zablokować uruchamianie wygaszacza należy skorzystać z funkcji WinAPI SystemParametersInfo:

SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, Word(False), nil, 0);

Odblokowanie to:

SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, Word(True), nil, 0);

Źródło informacji: Dominik Jesiołowski.

88. Jak skonwertować String na PChar?
String, PChar

Aby zrozumieć zawiłości typu String zmieniającego się poprzez kolejne wersje Delphi należałoby napisać więcej niż sam opis funkcji na nim działających. Dlatego pozwoliłem sobie wysmażyć mały artykulik opisujący budowę stringów, ich powiązania z typem PChar oraz niebezpieczeństwa czające się na młodych programistów przy konwersji jednego w drugi.

89. Jak z Delphi 1.0 odwołać się do 32-bitowej biblioteki DLL?
thunk, DLL

Czasem zachodzi potrzeba (fakt, że ostatnio coraz rzadziej) odwołania się z programu 16-bitowego do biblioteki 32-bitowej. Jest to możliwe chociaż niezalecane prze Microsoft. Jak to zrobić opisał Błażej Filimonow:

"Aby coś niecoś poczytać, należy wziąć win32.hlp z pakietu Dalphi3. Znajduje się w nim opis funkcji z 'KRNL386.EXE' :

LoadLibraryEx32W
FreeLibrary32W
GetProcAddress32W

Aby jednak znaleźć opis nie można korzystać z gotowego indeksu, bo jest niepełny. Trzeba sobie włączyć tworzenie słownika, co przy rozmiarze helpa może zając do 10 min. Później wyszukanie staje się banalnie proste. Problemem może byś użycie niektórych typów, a właściwie ich brak w D1 np. DWORD. Kawałek kodu który załatwia sprawę:

type TLoadLibraryEx32W=function(lpLibFileName:PChar;hFile:Pointer;
                                dwFlags:LongInt):Pointer;
     TFreeLibrary32W=function(hInst:Pointer):Pointer;

var Kernel386Handle:THandle;
    LoadLibraryEx32W:TLoadLibraryEx32W;
    FreeLibrary32W:TFreeLibrary32W;
    Handle_twojego_dll:Pointer;

begin
 Kernel386Handle:=LoadLibrary('KRNL386.Exe');
 @LoadLibraryEx32W:=GetProcAddress(Kernel386Handle,'LoadLibraryEx32W');
 @FreeLibrary32W:=GetProcAddress(Kernel386Handle,'FreeLibrary32W');
 Handle_twojego_dll:=LoadLibraryEx32W('twoj_dll',nil,0);
 //Tu użycie twojego DLL'a}
 FreeLibrary32W(Handle_twojego_dll);
 FreeLibrary(Kernel386Handle);
end;

Uwaga 1:
W mojej wersji helpa D3 nie działają odnośniki ze stron do powyższych funkcji ( wszystko trzeba wyszukiwać se słownika)

Uwaga 2:
Opisy powyższych funkcji zostały usunięte z Win32.hlp w wersji D4. ciekawe czemu ???? Czyżby w kolejnej wersji były już zbędne ???????

Uwaga 3:
Należy pamiętac, że GetProcAddress32W i pochodne są Case Sensitive. Ja na tym wpadłem i zmarnowałem godzinę czasu, zamnim zauważyłem, że mam jedną literę małą, zamiast dużą w nazwie funkcji."

Źródło informacji: Błażej Filimonow.

90. Jak zrobić z projektu MDI projekt SDI?
MDI, SDI, forma

Jeśli zamienimy formę główną z MDIForm na zwykłą oraz MDIChild również na zwykłą formę to nadal będzie ona pokazywana przy uruchamianiu aplikacji. Aby tego uniknąć należy ustawić właściwość Visible formy-dziecka na False.

Właściwość Visible formy może nam się przydać jeśli chcielibyśmy aby zaraz po uruchomieniu aplikacji oprócz głównego okna były widoczne również inne formy. Warto o tym pamiętać.

Źródło informacji: Adam Żukowski.

91. Dlaczego dane wysłane poprzez TCP/IP przychodzą w częściach?
TCP/IP, internet

Protokół TCP/IP nie gwarantuje wielkości danych dostarczanych do odbiorcy. Jeśli wyślemy 100KB danych mogą one dojść do miejsca przeznaczenia w 10-ciu kawałkach po 10KB. Na pewno wiemy tylko, że dojdą w tej samej kolejności w jakiej były wysłane.

Co zatem zrobić aby odebrać całość? Najlepiej wprowadzić własny protokół. Na przykład wysyłać najpierw rozmiar pakietu (jako 4 bajtowy licznik typu Integer) a potem właściwe dane. Odbiornik najpierw odczytuje 4 bajtowy rozmiar a potem tak długo czeka na dane aż odbierze cały przekaz.

92. Jak rozpoznać typ napędu?
napęd, CDROM, dyskietka

Oby rozpoznać czy dany napęd jest kompaktem, dyskiem czy dyskiem sieciowym należy użyć funkcji API GetDriveType:

case GetDriveType('d:\') of
 0:S:='Nie można rozpoznać rodzaju napędu';
 1:S:='Taki katalog nadrzędny nie istnieje';
 drive_Removable:S:='Dysk wymienny';
 drive_Fixed:S:='Dysk stały';
 drive_Remote:S:='Dysk sieciowy';
 drive_CDROM:S:='Napęd CD';
 drive_RamDisk:S:='Ramdysk';
end;

93. Jak ustawić akcelerator dla całej formy a nie jednego komponentu?
akcelerator, TActionList

Jeśli chcemy aby w obrębie formy działała konkretna kombinacja klawiszy nie musimy tworzyć jej obsługi ręcznie (korzystając z OnKeyDown lub OnKeyPress), można to zrobić łatwiej używając komponentu TActionList. Należy utworzyć nową akcję, podłączyć ją do formy i ustawić żądany akcelerator.

Uwaga: nie należy zrażać się jeśli na liście dostępnych akceleratorów nie będzie tego, o który nam chodzi. Wystarczy wpisać go wtedy ręcznie.

Źródło informacji: Maciej "MACiAS" Pilichowski, Marcin 'BACIK' Koteras.

94. Rysuję na canvasie obiektu TPaintBox ale wszystko znika gdy zasłonię i odsłonię formę innym oknem. Co się dzieje?
TPaintBox

W systemie Windows obowiązuje zasada, że okno ma się odrysować na żądanie systemu. Zawartość okien nie jest zapamiętywana i gdy zasłonięte do tej pory okno nagle dostaje się na wierzch pulpitu system każe mu narysować wnętrze (wysyłając komunikat wm_Paint). Korzystając zatem z komponentu TPainBox należy wykonywać operacje rysujące na canvasie za każdym razem gdy część okna zostaje odsłonięta. Aby tak się działo należy umieścić je w obsłudze zdarzenia OnPaint tego komponentu.

Z powyższego wynika również zalecenie aby minimalizować czas potrzebny na rysowanie komponentów. Jeśli np. masz obiekt rysujący wykres funkcji to dane powinieneś wyliczać raz (bo może to trwać długo) i zapamiętać je do wyrysowywania. Przy rysowaniu wykresu (a może on być rysowany wielokrotnie dla tych samych danych - w zależności od tego co robi z programem użytkownik) korzystasz już z wyliczonych wcześniej liczb.

Wielokrotnego rysowania można uniknąć (a raczej je zakamuflować) używając komponentu TImage. Umożliwia on rysowanie na canvasie przechowywanej przez siebie bitmapy i "zapamiętuje" wykonane operacje przyspieszając odświeżanie ekranu. Minusem tego rozwiązania jest zwiększenie wymagań pamięciowych programu.

95.Jak przekazywać dane między procesami?
pamiec wspoldzielona, share, DLL, proces

"Podstawą jest zrozumienie, czym jest pamięć procesu. W przeciwieństwie do środowiska Win31, gdzie programy (procesy) mogły hasać do woli po całej pamięci komputera, w środowisku 32-bit proces jest ograniczony tylko do kawałka pamięci, przydzielonej mu przez system. To oznacza, że ta sama wartość wskaźnika w dwu różnych procesach de facto oznacza różne obszary pamięci! To jest właśnie przyczyna, dla której początkujacy programiści tak często przekazuja do innego procesu jako argument wskaźnik do pamięci głównego programu i dziwią się, że program kładzie się z komunikatem Access Violation.

Najbardziej ogólnym rozwiązaniem jest polecenie systemowi, aby stworzył dla nas pewien obszar pamięci, który będzie przechowywał nasze dane. Obszar ten jest identyfikowany nazwą. Konkretny proces (główny program, DLL, procedura hooka, etc.), który chce coś zapisać lub przeczytać z takiego obszaru, otwiera obszar, tworzy widok tego obszaru i dopiero wtedy po nim pisze (czyta). Aktualizacja danych następuje po zamknięciu widoku. Zwolnienie głównego obszaru pamięci nastepuje oczywiście po wyraźnym sygnale ze strony programisty (wymagane także jest rzecz jasna wcześniejsze zamknięcie widoków).

Oto prosty przykład (bardzo prosty i bez kontroli błędow!):

// zmienne występujace zarówno w procesie 1 i 2
var
 uchwyt   : THandle;
 wskaznik : ^tu_nazwa_Twojej_struktury;

// 1 proces, nadrzędny

// utworzenie obszaru pamięci
  uchwyt:=CreateFileMapping($FFFFFFFF,nil,Page_ReadWrite,0,
                            rozmiar_pamieci,'naprawde unikalna nazwa');

// dowolnie hasamy z widokami na wyżej utworzony obszar
  wskaznik:=MapViewOfFile(uchwyt,File_Map_All_Access,0,0,0);
    // tu Twój kod operujacy na pamięci
  UnmapViewOfFile(wskaznik);

// 2 proces, podrzędny

// obszar pamieci jest tworzony przez proces nadrzędny, wiec ten proces
// tylko go otwiera
  uchwyt:=OpenFileMapping(File_Map_Write,TRUE,'naprawde unikalna nazwa');

// dowolnie hasamy z widokami na wyżej utworzony obszar
  wskaznik:=MapViewOfFile(uchwyt,File_Map_All_Access,0,0,0);
    // tu Twoj kod operujacy na pamięci
  UnmapViewOfFile(wskaznik);

// kończymy te zabawę z punktu widzenia procesu 2
  CloseHandle(uchwyt);

// 1 proces, nadrzędny

// kończymy tę zabawę definitywnie
  CloseHandle(uchwyt);

Wiecej informacji znajdziecie w helpie do powyżej użytych funkcji.

Jeśli chcemy przekazać coś na szybko z procesu do programu głównego, który posiada okno, możemy wysłać komunikat WM_COPYDATA. Przykładowo:

var
 copydata : TCopyDataStruct;
 s        : string;
begin
  s:='przyklad wysylania komunikatu WM_COPYDATA';
  copydata.cbData:=length(s);
  copydata.lpData:=@s[1];
  SendMessage(uchwyt_docelowego_okna,WM_COPYDATA,0,longint(@copydata));

I już naprawdę na koniec: o ile w Win31 można było przyjąć, iż program był tożsamy procesowi, tak w 32-bit jest to juz błędem. Proces jest wydzielonym kodem z własną pamięcią "operacyjną" - wyznacznikiem nie jest ani jego miejsce w naszym źrodle, ani powiązania, ani nasze pobożne życzenia. Najlepszym przykładem są funkcje hooka - funkcja ta jest transponowana do pamięci procesu adresata. Tj. jeśli napisaliśmy hooka systemowego, to system stworzy tyle jego bliźniakow, ilu może byc adresatów. Ma to swoje minusy (ból glowy programisty), ale też jest np. w miarę wygodnym mechanizmem wstrzykiwania własnej pamięci do zewnętrznych procesów (ale to już inna bajka)."

Źródło informacji: Maciej "MACiAS" Pilichowski.

96. W jaki sposób mogę śledzić przesyłane w systemie komunikaty?
hook, message, filtr, wiadomość

"Na drodze między nadawcą komunikatu, a jego odbiorcą, twórcy Windows umożliwili zaistnienie różnego rodzaju filtrów, do których dochodzi wiadomość i w zależności od decyzji takiego filtru, jest ona przekazywana dalej bądz też nie.
Oczywiscie filtr powinien elegancko koegzystowac z innymi, wcześniej zainstalowanymi filtrami. W tym celu Twoj filtr nie powinien bezpośrednio oddawać kontroli systemowi, ale wywoływać następny w kolejce filtr.

Piszac filtr pamiętaj, iż system przy każdej przesyłce komunikatu, będzie "wstrzykiwał" kod Twojego filtru do pamięci procesu adresata. Jeśli adresatów będzie wielu, Twoj filtr zostanie zduplikowany wiele, wiele razy. Jakie ma to konsekwencje? Nie możesz polegać na żadnych danych, które zadeklerowałeś na zewnątrz treści funkcji filtrującej w kodzie źrodłowym Twojego DLLa (filtr, który śledzi cały system musi znajdować się wewnątrz DLLa). Co wiecej - zmienne inicjowane wewnątrz Twojej funkcji zmieniają swoje tradycyjne znaczenie. Nie przechowują bowiem już wartości z poprzedniego wywołania tej funkcji, lecz przechowują poprzednią wartość z wywołania danej instancji funkcji (innymi słowy -- każdy duplikat Twojej funkcji, będzie posiadał własne wartości zmiennych inicjowanych).

Powyższe wiadomości powinny wystarczyć Ci do napisania własnego hooka (filtru). Poniżej znajduje się podstawowy schemat instalacji hooka - więcej informacji nt. argumentów i wywołań odnośnych funkcji znajdziesz w helpie:"

// nazwę mapy pamięci najlepiej przypisać stałej
const
 MySharedDataMapName = 'MojaNaPewnoUnikalnaNazwaMapyPamieci ;-)';

// jeśli w funkcji hooka będziecie operować jedynie uchwytem
// następnego filtru, to nie ma potrzeby pakowania tego do rekordu
type
 TSharedData = record
                 NextHookHandle : HHook;
               end;

// nagłówek hooka będzie zawsze wyglądał jak poniżej, argument code
// jest bardzo ważny, więc na pewno zerknijcie do helpa
// znaczenie wParam i lParam zależy od typu filtra
function MyHookProc(code   : longint;
                    wParam : longint;
                    lParam : longint) : longint; export; stdcall;
var
// uchwyt do mapy pamięci i wskaźnik do widoku mapy
 SharedDataHandle : THandle;
 SharedDataPtr    : ^TSharedData;
begin
// otwieramy mapę i tworzymy jej widok
  SharedDataHandle:=OpenFileMapping(File_Map_Write,TRUE,MySharedDataMapName);
  SharedDataPtr:=MapViewOfFile(SharedDataHandle,File_Map_All_Access,0,0,0);

// tutaj następuje Wasz kod
  ...
// koniec Waszej części

// wywołanie następnego hooka w łańcuchu filtrów
  CallNextHookEx(SharedDataPtr^.NextHookHandle,code,wParam,lParam);

// kasujemy widok i zamykamy mapę
  UnmapViewOfFile(SharedDataPtr)
  CloseHandle(SharedDataHandle);

  result:=0;       // przepuść meldunek
end;

var
 SharedDataHandle : THandle;
 SharedDataPtr    : ^TSharedData;

procedure InstallFilter(LibHandle : THandle); export;
begin
  SharedDataHandle:=CreateFileMapping($FFFFFFFF,nil,Page_ReadWrite,0,
       sizeof(TSharedData),MySharedDataMapName);
  SharedDataPtr:=MapViewOfFile(SharedDataHandle,File_Map_All_Access,0,0,0);
// drugi argument to oczywiście adres w DLLu naszej funkcji filtru
// czwarty argument to uchwyt okna, które chcemy śledzić, 0 oznacza
// wszystko co tylko znajduje się w systemie -- czyli hook systemowy
  SharedDataPtr^.NextHookHandle:=SetWindowsHookEx(WH_GETMESSAGE,
       GetProcAddress(LibHandle,'MyHookProc'),LibHandle,0);
end;

procedure RemoveFilter; export;
begin
  UnHookWindowsHookEx(SharedDataPtr^.NextHookHandle);
  UnmapViewOfFile(SharedDataPtr)
  CloseHandle(SharedDataHandle);
end;

Żródło informacji: Maciej "MACiAS" Pilichowski.

97. Kompilacja mojego programu przebiega poprawnie, ale kiedy go uruchamiam program sie wysypuje z komunikatem "klasa nieznaleziona". Co jest tego powodem?
forma, dziedziczenie, klasa

"Kompilator Delphi jest o tyle niedopracowany, że nie porównuje plików DFM z odpowiadającymi mu plikami pas. Przyczyną kłopotów jest dziedziczenie form, a dokładniej zmiany w formie podstawowej /skasowanie jednego z elementów/, które rzutują na klasy dziedziczące. Należy po wczytaniu projektu zrobić open dla wszystkich plików PAS. IDE wykaże wszystkie zawieszone w prożni komponenty."

Żródło informacji: Maciej "MACiAS" Pilichowski.

98. Jak znaleźć wszystkie pliki w katalogu i jego podkatalogach?
katalogi

Można użyć poniższej procedury:

procedure PenetrateDirectory(dir: String; list: TStrings; mask: String);
var
  SRec: TSearchRec;
  res: Integer;
  ec: Char;
begin
  ec := ':';
  if dir <> '' then ec := dir[Length(dir)];
  if (ec <> '\') and (ec <> ':') then dir := dir + '\';
  // dodanie '\' na koncu nazwy katalogu

  res := FindFirst(dir + mask, faArchive, SRec);
  while res = 0 do begin
    list.Add(dir + SRec.Name);
    res := FindNext(SRec);
  end;
  FindClose(SRec);
  // petla "zbierajaca" pliki

  res := FindFirst(dir + '*', faDirectory, SRec);
  while res = 0 do begin
    if (SRec.Attr and faDirectory <> 0)
    and (SRec.Name <> '.' ) and (SRec.Name <> '..') then
      PenetrateDirectory(dir + srec.Name, list, mask);
    res := FindNext(SRec);
  end;
  FindClose(SRec);
  // przeszukiwanie wglab
end;

Źródło informacji: Milosz Krajewski.

99. Jak zainstalować BDE?
BDE, instalacja

Według polskiego oddziału Borlanda jedynymi instalatorami, których powinno się używać do instalacji BDE to InstallShield i Wise. Są to jednak produkty komercyjne i drogie (lub jak w przypadku InstallShield Express Delphi Edition - mocno okrojone). Oczywiście istnieje techniczna możliwość samodzielnej instalacji BDE należy jednak pamiętać, że jest to niezgodne z licencją.

Sposób jest prosty:

• w katalogu {Delphi}\BIN odnajdujemy plik BDEINST.CAB
• rozpakowujemy go komendą

  cabarc x BDEINST.CAB

  (program cabarc jest w tym samym katalogu)
• powstały po rozpakowaniu plik BDEINST.DLL rejestrujemy wydając polecenie

  regsvr32.exe BDEINST.DLL

Źródło informacji: Radosław "Radio Erewan" Przybył.

100. Jak zidentyfikować komputer korzystając z numeru MAC karty sieciowej?
karta sieciowa, MAC

Można skorzystać z poniższego kodu:

Uses NB30;

Type
 TNBLanaResources = (lrAlloc, lrFree);
 PMACAddress      = ^TMACAddress;
 TMACAddress      = Array [0..5] Of Byte;

{Odczytuje liczbę kart sieciowych w komputerze}

Function GetLanaEnum(LanaEnum: PLanaEnum): Byte;
Var
 LanaEnumNCB: PNCB;
Begin
 New(LanaEnumNCB);
 ZeroMemory(LanaEnumNCB, SizeOf(TNCB));
 Try
   With LanaEnumNCB^ Do
    Begin
      ncb_buffer := PChar(LanaEnum);
      ncb_length := SizeOf(TLanaEnum);
      ncb_command  := Char(NCBENUM);
      NetBios(LanaEnumNCB);
      Result := Byte(ncb_cmd_cplt);
    End;
 Finally
   Dispose(LanaEnumNCB);
 End;
End;

{Odczytuje nr fizyczny karty sieciowej}
Function GetMACAddress(LanaNum: Byte; MACAddress: PMACAddress): Byte;
Var
 AdapterStatus: PAdapterStatus;
 StatNCB: PNCB;
Begin
  New(StatNCB);
  ZeroMemory(StatNCB, SizeOf(TNCB));
  StatNCB.ncb_length := SizeOf(TAdapterStatus) +  255 * SizeOf(TNameBuffer);
  GetMem(AdapterStatus, StatNCB.ncb_length);
  try
    with StatNCB^ do
    begin
      ZeroMemory(MACAddress, SizeOf(TMACAddress));
      ncb_buffer := PChar(AdapterStatus);
      ncb_callname := '*              ' + #0;
      ncb_lana_num := Char(LanaNum);
      ncb_command  := Char(NCBASTAT);
      NetBios(StatNCB);
      Result := Byte(ncb_cmd_cplt);
      if Result = NRC_GOODRET then
        MoveMemory(MACAddress, AdapterStatus, SizeOf(TMACAddress));
    end;
  finally
    FreeMem(AdapterStatus);
    Dispose(StatNCB);
  end;
End;

{"Tłumaczy" numer na postać strawną dla postronnych}

Function MACAddr : String;
var
  LanaNum: Byte;
  MACAddress: PMACAddress;
  RetCode: Byte;
begin
  LanaNum := 0;
  New(MACAddress);
  try
    RetCode := GetMACAddress(LanaNum, MACAddress);
    If RetCode = NRC_GOODRET then
     Begin
      Result := Format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x',
        [MACAddress[0], MACAddress[1], MACAddress[2],
         MACAddress[3], MACAddress[4], MACAddress[5]]);
     end
    else
     begin
      Beep;
      Result := 'Error';
      ShowMessage('GetMACAddress Error! RetCode = $' + IntToHex(RetCode,2));
     End;
  finally
    Dispose(MACAddress);
  End;
End;

Źródło informacji: Paweł Trzciński.

101. Jak wykryć moment wstawienia czegoś do schowka?
schowek

Należy w sekcji uses dopisać moduł Clipbrd:

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ClipBrd;

W formie dopisać deklaracje trzech procedur i zmiennej:

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    // zmienna i trzy procedury dla kontroli schowka
    FClipboardOwner: HWnd;
    procedure ClipboardChanged;
    procedure WMChangeCBChain(var Msg: TWMChangeCBChain); message WM_CHANGECBCHAIN;
    procedure WMDrawClipboard(var Msg: TWMDrawClipboard); message WM_DRAWCLIPBOARD;

w procedurze zdarzenia FormCreate dopisać:

FClipboardOwner := SetClipboardViewer(Handle);

w procedurze zdarzenia FormDestroy dopisać:

ChangeClipboardChain(Handle, FClipboardOwner);

Napisać poniższe procedury:

procedure TForm1.WMChangeCBChain(var Msg: TWMChangeCBChain);
begin
  if Msg.Remove = FClipboardOwner then FClipboardOwner := Msg.Next
  else SendMessage(FClipboardOwner, WM_CHANGECBCHAIN, Msg.Remove, Msg.Next);
  Msg.Result := 0;
end;

procedure TForm1.ClipboardChanged;
var
  Format: Word;
begin 
    {
    tu wpisac co ma sie dziac po wstawieniu czegos do schowka
    np. sprawdzenie formatu schowka i wywolanie pozadanego
    przez nas zdarzenia. Dla testu niech bedzie to zwykle 'beep' :-)
    }

    beep;
end;

procedure TForm1.WMDrawClipboard(var Msg: TWMDrawClipboard);
begin
  SendMessage(FClipboardOwner, WM_DRAWCLIPBOARD, 0, 0);
  Msg.Result := 0;
  ClipboardChanged;
end;

Źródło informacji: Dafi.

102. Jak zamknąć system?
zamykanie, Windows, API

Należy użyć funkcji API:

• ExitWindowsEx(EWX_SHUTDOWN,0)- zamknięcie systemu
• ExitWindowsEx(EWX_REBOOT,0) - reset
• ExitWindowsEx(EWX_LOGOFF,0)- wylogowanie

W tej formie funkcje zadziałają pod Windows 9x. Dla Windows NT należy je zmodyfikować tak aby podawały systemowy prawa użytkownika. Nie każdy użytkownik ma bowiem prawo zamykać system w NT. Oto jak to zrobić:

function DelphiExitWindows( Flags : Word):Boolean;
var
  iVersionInfo: TOSVersionInfo;
  iToken    : THandle;
  iPriveleg : TTokenPrivileges;
  iaresult  : Integer;
begin

  Result:=FALSE;
  FillChar (iPriveleg, SizeOf (iPriveleg), #0);
  iVersionInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  GetVersionEx(iVersionInfo);
  if iVersionInfo.dwPlatformId <> VER_PLATFORM_WIN32_NT then
    Result:=ExitWindowsEx (Flags, 0)
  else
    if OpenProcessToken (GetCurrentProcess,
        TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, iToken) then
      if LookupPrivilegeValue (NIL,'SeShutdownPrivilege',
            iPriveleg.Privileges[0].Luid) then
      begin
        iPriveleg.PrivilegeCount := 1;
        iPriveleg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
        if AdjustTokenPrivileges (iToken,False,iPriveleg,
                    Sizeof(iPriveleg),iPriveleg,iaresult) then
          Result:=ExitWindowsEx (Flags, 0);
      end;
end;

Przykład wywołania:

  DelphiExitWindows( EWX_REBOOT or EWX_FORCE );

Źródło informacji: Paweł Księżyk.

103. Jak obsłużyć upuszczanie plików na formę?
Drag&Drop

Należy skorzystać z komunikatu wm_DropFiles. Ma to tą zaletę, że zadziała nawet w Delphi 1.

uses
  ShellAPI; {obsługa D&D}

....

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := AppMessage;
  DragAcceptFiles (Handle, True);
end; {mówimy systemowi że chcemy obsłużyć D&D}

procedure TForm1.WMDropFiles (hDrop : THandle; hWindow : HWnd);
Var
  TotalNumberOfFiles,
  nFileLength : Integer;
  pszFileName : PChar;
  i : Integer;

Begin
  //liczba zrzuconych plików
  TotalNumberOfFiles := DragQueryFile (hDrop , $FFFFFFFF, Nil, 0); 

  for i := 0 to TotalNumberOfFiles - 1 do begin
    nFileLength := DragQueryFile (hDrop, i , Nil, 0) + 1;
    GetMem (pszFileName, nFileLength);
    DragQueryFile (hDrop , i, pszFileName, nFileLength);

    //pszFileName - nazwa upuszczonego pliku
    //tutaj robimy coś z nazwą pliku

    FreeMem (pszFileName, nFileLength);
  end;

  DragFinish (hDrop);
end; //sprawdzamy co zostało przeciągnięte i obsługujemy to

procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
  case Msg.Message of
    WM_DROPFILES :  WMDropFiles (Msg.wParam, Msg.hWnd);
  end;
end; //obsługujemy komunikat WM_DROPFILES 

procedure TForm1.FormClose (Sender: TObject; var Action: TCloseAction);
begin
  DragAcceptFiles (Handle, False);
end; //dziękujemy

Źródło informacji: Artur Prokopiuk.

104. Co zrobić aby forma główna nie pokazywała się po starcie programu?
forma

Należy w kodzie projektu przed Application.Run dodać kod:

Application.ShowMainForm:=False

105. Jak wywołać standardowe okno podłączania dysku sieciowego?
sieć, udziały

Należy użyć kodu:

WNetConnectionDialog(Application.Handle, RESOURCETYPE_DISK);

Poniższa procedura pokazuje okno odłączenia dysku:

WNetDisconnectDialog(Application.Handle, RESOURCETYPE_DISK);

Zaś zamiana stałej RESOURCETYPE_DISK na RESOURCETYPE_PRINT pokaże okno podłączenia drukarki sieciowej.

Źródło informacji: Konrad Pawlus.

106. Jak wydobyć systemową ikonę pliku?
ikona, Explorer

Należy skorzystać z funkcji SHGetFileInfo. Wygodnie będzie użyć również klasy TImageList. W pierwszym kroku deklarujemy listy ikon:

var SmallImages, LargeImages: TImageList;

Następnie tworzymy je i wypełniamy ikonami:

uses ShellAPI; {w sekcji uses należy dodać plik ShellAPI.pas}
procedure TMainForm.CreateImages;
var sfi: TSHFileInfo;
begin
 if not Assigned(SmallImages) then
  begin
   SmallImages := TImageList.Create(Self);
   SmallImages.Handle := SHGetFileInfo('nazwapliku', 0, sfi, SizeOf(TSHFileInfo),
    SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
   SmallImages.ShareImages := TRUE;
  end;
 if not Assigned(LargeImages) then
  begin
   Largeimages := TImageList.Create(self);
   LargeImages.Handle := SHGetFileInfo('nazwapliku', 0, sfi, SizeOf(TSHFileInfo),
    SHGFI_SYSICONINDEX or SHGFI_LARGEICON);
   LargeImages.ShareImages := TRUE;
  end;
end;

Teraz możemy już z nich korzystać. Na przykład wypełniając TListView nazwami plików i ich ikonami. Lista musi mieć trzy kolumny (Caption, SubItems[1], SubItems[2]). Należy też poinformować ją skąd ma czerpać ikony:

 Lista.SmallImages := SmallImages;
 Lista.LargeImages := LargeImages;

procedure TMainForm.DodajDoListy(Lista: TListView; Plik: String);
var NowyPlik: TListItem;
    Sfi: TSHFileInfo;
    Typ: String;
begin
 SHGetFileInfo(PChar(Plik), 0, Sfi, SizeOf(sfi),
  SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_DISPLAYNAME)
 NowyPlik := Lista.Items.Add;
 NowyPlik.Caption := ExtractFileName(Plik);
 NowyPlik.ImageIndex := Sfi.iIcon;
 NowyPlik.SubItems.Add(Sfi.szTypeName);
 NowyPlik.SubItems.Add(Typ);
end;

Źródło informacji: Konrad Pawlus.

107. Nie działa TQuery.Refresh. Co robić?
SQL, TQuery, Refresh

Close;Open;

Źródło informacji: Piotr Neil Gawronski.

108. Mam problemy z drukowaniem bitmap. Co robić?
drukowanie, bitmapa

Na niektórych drukarkach występują problemy z drukowaniem bitmap. Powinna pomóc poniższa procedura:

  procedure PrintBitmap(Bitmap: TBitmap; X, Y: Integer);
  var
    Info: PBitmapInfo;
    InfoSize: Integer;
    Image: Pointer;
    ImageSize: Longint;
  begin
    with Bitmap do
    begin
      GetDIBSizes(Handle, InfoSize, ImageSize);
      Info := AllocMem(InfoSize); {<-- MemAlloc dla D1}
      try
        Image := AllocMem(ImageSize); {<-- MemAlloc dla D1}
        try
          GetDIB(Handle, Palette, Info^, Image^);
          with Info^.bmiHeader do
            StretchDIBits(Printer.Canvas.Handle, X, Y, Width,
              Height, 0, 0, biWidth, biHeight, Image, Info^,
              DIB_RGB_COLORS, SRCCOPY);
        finally
          FreeMem(Image, ImageSize);
        end;
      finally
        FreeMem(Info, InfoSize);
      end;
    end;
  end;

Źródło informacji: Marcin BACIK Koteras.

109. Jak zapisać poprawnie datę w SQL?
lokalny SQL, format daty

W lkalnym SQL format daty jest niezmienny i niezależny od ustawień systemowych. Należy datę zapisywać w postaci: "MM/DD/YY(YY)". Jeśli datę wpisujemy w runtime pomocna może być konstrukcja:

 DataDlaSQLa:=''''+FormatDateTime('mm"/"dd"/"yyyy',d)+'''';

Źródło informacji: Maciej "MACiAS" Pilichowski.

110. W jaki sposób zasymulować kliknięcie myszy lub klawiatury, ale w taki sposób, żeby było wykrywalne przez inne programy?
mysz, klawiatura

Do symulacji kliknięć myszą służy funkcja WinAPI mouse_event:

  mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN, x, y, 0, 0);
  mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, x, y, 0, 0);

co daje symulację kliknięcia lewym przyciskiem myszy w punkcie (x,y), natomiast do symulacji klawiatury używamy funkcji keybd_event

  keybd_event(VK_UP, 0, 0, 0);
  keybd_event(VK_UP, 0, KEYEVENTF_KEYUP, 0);

Co powoduje symulację kliknięcia klawisza strzałki w górę.

Źródło informacji: Krzysztof Borys (Bask).

111. Jak spakować bazę danych MS Access?
baza danych, Access

Na to pytanie odpowiada Tomek Cwajda: "Należy skorzystać z obiektu TJetEngine jaki udostępnia biblioteka Microsoftu JRO (Jet and Replication Objects) będąca składnikiem pakietu MDAC (Microsoft Data Access Components). Jak dotąd najświerzszą wersją MDAC jest wersja 2.5 a jeżeli chodzi o JRO to jest to wersja 2.1. Aby skorzystać z wyżej wymienionej biblioteki należy "importować bibliotekę typów". po uruchomieniu komendy z menu "Project | Import Type Library" wskazujemy bibliotekę "Microsoft Jet and Replication Objects 2.1 Library (Version2.1)". Jeżeli tej biblioteki nie ma na liście a jesteśmy pewni, że mamy zainstalowane MDAC, to należy dodać je do listy wskazując plik "msjro.dll", który z regóły jest umiejscowiony w katalogu "C:\Program Files\Common Files\System\ado\". Po zainstalowaniu możemy powstały moduł uwzględniać w projekcie. Standardowa nazwa nadawana przez wizzard'a to JRO_TLB.

unit Unit1;

interface

uses
  ...,
  JRO_TLB ;

type
...

implementation
...

procedure CompressRepair;
var MyJetEngine:TJetEngine;
    strSourceConnection,strDestConnection,strJetType:WideString;
begin
 //Dla Access 2000 Engine Type =5 
 strJetType:='Jet OLEDB:Engine Type=4'; 
 strSourceConnection:='Data Source=D:\Program Files\'+
 'Borland Shared\Data\dbdemos.mdb;';
 strDestConnection:='Data Source=D:\Program Files\'+
 'Borland Shared\Data\dbdemos_compacted.mdb;'+strJetType;
 MyJetEngine:=TJetEngine.Create(nil);
 try
   MyJetEngine.CompactDatabase(strSourceConnection,strDestConnection);
 finally
   MyJetEngine.Free;
 end;
end;

end.

Mogę dodać, że procedura ta powinna również realizować naprawianie bazy, jednak nie przetestowałem tego."

Źródło informacji: Tomek Cwajda.

112. Jak wykonać konwersję z systemu dziesiętnego na binarny lub szesnastkowy i na odwrót?
konwersja, binarnie, szesnastkowo

Można użyć do tego celu funkcji napisanych przez Milosza Krajewskiego:

function Chr2Int(c: Char): Integer;
begin
  c := UpCase(c);
  if (c >= '0') and (c <= '9') then Result := Integer(c) - Integer('0')
  else Result := Integer(c) - Integer('A') + 10;
end;

function Int2Chr(i: Integer): Char;
begin
  if i < 10 then Result := Char(i + Integer('0')) else
  Result := Char(i - 10 + Integer('A'));
end;

function Str2Int(s: String; base: Integer): Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 1 to Length(s) do Result := (Result * base) + Chr2Int(s[i]);
end;

function Int2Str(v: Integer; base: Integer): String;
var
  m: Integer;
begin
  Result := '';
  while v <> 0 do begin
    m := v mod base; v := v div base; Result := Int2Chr(m) + Result;
  end;
  if Result = '' then Result := '0';
end;

Przykład użycia:

labelHex := Int2Str(157, 16);
labelBin := Int2Str(157, 2);
labelOct := Int2Str(157, 8);
label19  := Int2Str(157, 19); // to bedzie w 19-stkowym

ValueHex := Str2Int('110101010', 2);
ValueBin := Str2Int('AF16', 16);
ValueOct := Str2Int('740', 8);
Value7   := Str2Int('666', 7); // z systemu 7-kowego

labelBin := Int2Str(Str2Int(labelHex, 16), 2); // 16 -> 2

Źródło informacji: Milosz "Krashan" Krajewski.

113. Jak uzyskać posortowane drzewo katalogów?
drzewo katalogów, dysk

Na to pytanie odpowiada Przemysław Walasek:

"Oczywiście istnieją (jak zawsze) dwie metody: falenicka i otwocka. Różnią się one tylko w sposobie uzyskania struktury posortowanego drzewka. Podstawowym błędem jest używanie metody AlphaSort kontrolki TreeView.

1. Metoda falenicka.

procedure ListujKatalogi(tnRodzic : TTreeNode; strSciezka : string);
//Metoda falenicka
var
  sr : TSearchRec;
  iWynik : integer;
  tnDziecko : TTreeNode;
begin
  iWynik := FindFirst(strSciezka + '*.*', faAnyFile, sr);
  //czytamy pierwszy plik_katalog
   while iWynik = 0 do{odkiedy cos jest znajdywane}
   begin
    if ((sr.Attr and faDirectory) = faDirectory) and
       (sr.Name <> '.')and(sr.Name <> '..') then
        //jezeli jest to katalog
      begin{dopisujemy do drzewka}
        tnDziecko := frm.trv.Items.AddChild(tnRodzic, sr.Name);
        //dopisujemy katalog jako podrzedny
        Licznik := Licznik + 1;
        frm.Caption := 'Znalazlem : ' + IntToStr(Licznik) + ' 
                        katalog(ów).';
        ListujKatalogi(tnDziecko ,strSciezka + sr.Name + '\');
        //wywolujemy rekeurncyjnie metode, jako kat. nadrzedny bedzie teraz ostatnio znaleziony kat.
      end;
    iWynik := FindNext(sr);
    //szukamy nastepnych
   end;
  FindClose(sr);
  //zwalniamy pamiec
  if tnRodzic = Nil then
  else
    tnRodzic.AlphaSort;
  //i tu jest caly widz metody falenickiej!
  //ta linia wykona sie wtedy gdy kat. symbolizowany przez tnRodzic
  //ma juz znane wszystkie swoje podkatalogi, i tu nalezy wywolac
  //ALphaSort, ale NIE DLA TREEVIEW ale dla TREENODE tnRodzica!
  //roznica polega na tym ze AplhaSort TreeView sortuje cala zawartosc
  //a tn.AlphaSort Sortuje TYLKO swoje dzieci, efekt widac...
  //I co panie Lodku jest <30 lini kodu ;-)
end;

//procedura uruchamiajaca reakcje lancuchowa
procedure Tfrm.btnClick(Sender: TObject);
var
  i : byte;
  cDysk : Char;
  tdtStart, tdtKoniec : TDateTime;
begin
  trv.Items.Clear;
  //czyscimy drzekw
  tdtStart := Now;// *
  frm.trv.Items.BeginUpdate;
  for cDysk := 'C' to 'G' do
  begin
    ListujKatalogi(trv.Items.AddChild(nil, '(Dysk ' + cDysk + ':)'),                                                                             
                                        cDysk + ':\');
  //ako pierwsze wywolanie przekazujemu NIL, co oznacza ze pierwszym
  //tnRodzicem jest TreeView
  end;
  frm.trv.Items.EndUpdate;
  tdtKoniec := Now;{*}
  tdtKoniec := tdtKoniec - tdtStart; // *
  btn.Caption := 'Czas listowania: ' + DateTimeToStr(tdtKoniec); // *
//oczywiscie nie bede tu pisal jak rozpoznac ktora litera to dyk itd
//bo to jest w FAQ grupy
end;

2. Metoda otwocka. Opiera się na zgoła innym założeniu, mianowicie sortowaniu ulega tylko ta ilość Node-ów, która jest niezbędna. Jak to uzyskać najprościej? Ano w obsłudze zdarzenia kontrolki TreeView - Expanding (nie Expanded), które towarzyszy rozwijaniu node-ow. Procedury tej nie powinno się umieszczać w zdażeniach OnClick lub DblClick, bo rozwijanie jest możliwe z poziomu kodu, co nie spowoduje wykonania w/w zdarzeń.

procedure ListujKatalogi(tnRodzic : TTreeNode; strSciezka : string);
//Metoda otwocka
var
  sr : TSearchRec;
  iWynik : integer;
  tnDziecko : TTreeNode;
begin
  iWynik := FindFirst(strSciezka + '*.*', faAnyFile, sr);
  //czytamy pierwszy plik_katalog
   while iWynik = 0 do//jezeli znalazl cos
   begin
    if ((sr.Attr and faDirectory) = faDirectory) and
       (sr.Name <> '.')and(sr.Name <> '..') then
      begin{dopisujemy do drzewka}
        tnDziecko := frm.trv.Items.AddChild(tnRodzic, sr.Name);
        Licznik := Licznik + 1;
        frm.Caption := 'Znalazlem : ' + IntToStr(Licznik) + ' 
                                  katalog(ów).';
        ListujKatalogi(tnDziecko ,strSciezka + sr.Name + '\');
      end;
    iWynik := FindNext(sr);
   end;
  FindClose(sr);
end;

procedure Tfrm.trvExpanding(Sender: TObject; Node: TTreeNode;
  var AllowExpansion: Boolean);
//Metoda otwocka
begin
  trv.Items.BeginUpdate;
  while Node <> nil do
  //sprawdzamy czy istnieja jakies dzieci Node-a wywolujacego zdarzenie
  begin
    Node.AlphaSort;//jezeli tak, to sortujemy
    Node := Node.GetNextSibling;//i pobieramy nastepnego w szeregu
  end;
  trv.Items.EndUpdate;
end;

Widać, że nie ma różnicy przy ładowanu drzewka, czasy ładowania z sortowaniem i bez są porównywalne, więc metoda falenicka wydaje sie być atrakcyjniejsza, gdyż zwalnia nas od obsługi Expanding. Można oczywiście posortować samemu, podczas stanu jałowego aplikacji, można bezproblemowo dodać do tej listy pliki itd... Można oczywiście ładowac katalogi bezpośrednio z dysku w odpowiedni sposób na żądanie rozwinięcia, napisałem kiedyś taki właśnie sposób, mogę go sprobować odnaleźć. Jego zaletą jest to, iż pozwala na wyświetlanie aktualnego stanu katalogów. Wyżej podane sposoby ładują drzewo, ale są niewrażliwe na zmiany na dysku. Ale rozwiązanie też nie jest trudne. O późno się zrobiło, czas kończyć."

Źródło informacji: Przemysław Walasek.