Delphi FAQ (2)
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).
VER80 |
Delphi 1.x |
VER90 |
Delphi 2.x |
VER93 |
CBuilder 1.0 |
VER100 |
Delphi 3.x |
VER120 |
Delphi 4.x |
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.
Źródło informacji: Michał
Młynarczyk.
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
Dostępny jest również skrypt
do darmowego instalatora InnoSetup korzystający z opisanej metody.
Ź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.
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;
Teraz wystarczy dodać do listy plik przy pomocy procedury:
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
Zamiast Refresh można użyć konstrukcji:
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.
|