!!! mit Delphi ab Version 3 !!!
May the source be with you, stranger
... |
GoPyright © 2001 by -=Assarbad
[GoP]=-
Nun, ich habe von vielen Leuten schon die Frage gehört, wieso ist eine leere Delphi-Anwendung eigentlich schon fast 300 kB groß? Ganz einfach, weil die VCL eine generische Schnittstelle für alle möglichen Funktionen der Win32 API bereitstellt. Nehmen wir mal OLE. Die meisten Leute benötigen kaum ein OLE-Interface in ihrer Anwendung. Allerdings erlaubt Delphi bzw. Smart-Compiling nicht, daß diese nicht benötigten Teile harausgelassen werden. Dies hat dann zu XCL und anderen Heldentaten geführt.
Die Tatsache, daß Objekte (Klassen) auch diverse Informationen mitspeichern, die nicht vital für das eigentliche Programm sind, tut ein übriges.
Die Antwort für alle Übergrößen-Geplagten lautet nonVCL. Damit bezeichnen wir in kleinerem Kreise derzeit das Programmieren unter direkter Benutzung der Win32 API.
Es gibt zwei (im Zweifelsfall auch drei) Möglichkeiten.
Um das Fensterprinzip zu verstehen muß man die TForms erstmal hinter sich lassen. Fenster unter Windows haben dem System den Namen gegeben. Jedes Fenster hat diverse Eigenschaften, die es beschreiben. Windows kennt hierbei zwei grundlegende Varianten. Basisstruktur und erweiterte Struktur.
Betrachten wir die Basisstruktur.
type tagWNDCLASSA = packed record style: UINT; lpfnWndProc: TFNWndProc; cbClsExtra: Integer; cbWndExtra: Integer; hInstance: HINST; hIcon: HICON; hCursor: HCURSOR; hbrBackground: HBRUSH; lpszMenuName: PAnsiChar; lpszClassName: PAnsiChar; end; |
Der Einfachheit halber hier nur die Ansi-Version. Auf NT Plattformen finden sich entsprechende Unicode-(Wide-)Pendants. Die Struktur ist ausdeklariert als TWndClass.
Die erweiterte Struktur ("...Ex"), in der WINDOWS.PAS als TWndClassEx deklariert, sieht man hier.
type tagWNDCLASSEXA = packed record cbSize: UINT; style: UINT; lpfnWndProc: TFNWndProc; cbClsExtra: Integer; cbWndExtra: Integer; hInstance: HINST; hIcon: HICON; hCursor: HCURSOR; hbrBackground: HBRUSH; lpszMenuName: PAnsiChar; lpszClassName: PAnsiChar; hIconSm: HICON; end; |
Wie man sehen kann, unterscheiden sich beide Varianten nur dadurch, daß in der erweiterten Version die Größe der Struktur angegeben werden muß und ein kleines ICON angegeben werden kann.
Beide Strukturen beschreiben eine Fensterklasse (und zwar nicht Klasse im OOP-Sinn) ;)
Um die Klasse benutzen zu können, muß sie mindestens einen Namen ["lpszClassName"] die Instanz des aufrufenden Moduls [üblicherweise "hInstance" unter Delphi] und in der erweiterten Version die Größe der Struktur erhalten.
procedure initacomctl; var wc: TWndClassEx; begin wc.style := CS_HREDRAW or CS_VREDRAW or CS_GLOBALCLASS; wc.cbSize := sizeof(TWNDCLASSEX); wc.lpfnWndProc := @HyperlinkWndProc; wc.cbClsExtra := 0; wc.cbWndExtra := 0; wc.hInstance := hInstance; wc.hbrBackground := COLOR_WINDOW; wc.lpszMenuName := nil; wc.lpszClassName := AHyperlink; wc.hIcon := 0; wc.hIconSm := 0; wc.hCursor := 0; RegisterClassEx(wc); end; {HLinkTest Beispiel} |
Der abschließende Aufruf von RegisterClassEx() [bzw. RegisterClass()] registriert die Fensterklasse für die Programminstanz und ermöglicht den Aufruf von CreateWindowEx() [bzw. CreateWindow()].
Obige Prozedur ist die Initialisierungsroutine zu einem Demonstrationsprogramm meiner Wenigkeit. Ziel wird es sein zu zeigen, wie man
Eine gewöhnliche Fensterprozedur:
FUNCTION WndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; STDCALL;
Eine gewöhnliche Dialogprozedur:
FUNCTION DlgProc(hWnd: HWND; uMsg: dword; wParam: WPARAM; lParam: LPARAM): BOOL; STDCALL;
Beachte: es muß immer STDCALL defniert werden!
Vergleicht man beide Statements, liegt der eigentliche Unterschied nur noch im Rückgabetyp. Tatsächlich erfüllen beide eine ähnliche Aufgabe: das Auswerten und Bearbeiten von Fensternachrichten.
Fensternachrichten sind einfache Integerwerte, die ein bestimmtes Ereignis in bezug zum Fenster signalisieren. Es kann sich hier um einen einfachen Mausklick, aber genausogut um ein Winsock-Ereignis handeln.
Nachrichten, die nicht von der jeweiligen Fensterprozedur bearbeitet werden, sollten von einem Defaulthandler, also einer Standardprozedur, bearbeitet werden. Dazu signalisiert die Dialogprozedur FALSE um zu zeigen, daß der Defaulthandler noch ran muß. Und die "echte" Fensterprozedur ruft den Defaulthandler selbst auf:
Result:=DefWindowProc(hWnd, uMsg, wParam, lParam);
Aus all diesen Annahmen läßt sich dann folgendes kleine Programmgerüst entwickeln.
program test1; uses windows, messages; {$WARNINGS OFF} {$HINTS OFF} const windowleft: integer = 100; windowtop: integer = 100; windowwidth: integer = 265; windowheight: integer = 202; ClassName = 'ATestWndClassEx'; {$IFDEF VER90} tagNONCLIENTMETRICSA = packed record cbSize: UINT; iBorderWidth: Integer; iScrollWidth: Integer; iScrollHeight: Integer; iCaptionWidth: Integer; iCaptionHeight: Integer; lfCaptionFont: TLogFontA; iSmCaptionWidth: Integer; iSmCaptionHeight: Integer; lfSmCaptionFont: TLogFontA; iMenuWidth: Integer; iMenuHeight: Integer; lfMenuFont: TLogFontA; lfStatusFont: TLogFontA; lfMessageFont: TLogFontA; end; TNonClientMetricsA = tagNONCLIENTMETRICSA; TNonClientMetrics = TNonClientMetricsA; NONCLIENTMETRICSA = tagNONCLIENTMETRICSA; NONCLIENTMETRICS = NONCLIENTMETRICSA; {$ENDIF} function WndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; var OKbtn: DWORD; begin Result := 0; case uMsg of WM_CREATE: begin OKbtn := createwindow('BUTTON', 'OK-Button', WS_VISIBLE or WS_CHILD, 100, 100, 100, 30, hwnd, IDOK, hInstance, nil); if OKbtn = INVALID_HANDLE_VALUE then messagebox(hwnd, 'Button nicht erzeugt', 'Meldung', 0); end; WM_DESTROY: begin PostQuitMessage(0); end; WM_COMMAND: case hiword(wparam) of BN_CLICKED: case loword(wparam) of IDOK: begin messagebox(hwnd, 'OK Button gedrückt', 'Meldung', 0); sendmessage(hwnd, WM_CLOSE, 0, 0); end; end; end; else Result := DefWindowProc(hWnd, uMsg, wParam, lParam); end; end; {$IFDEF VER100} type tagNONCLIENTMETRICSA = packed record cbSize: UINT; iBorderWidth: Integer; iScrollWidth: Integer; iScrollHeight: Integer; iCaptionWidth: Integer; iCaptionHeight: Integer; lfCaptionFont: TLogFontA; iSmCaptionWidth: Integer; iSmCaptionHeight: Integer; lfSmCaptionFont: TLogFontA; iMenuWidth: Integer; iMenuHeight: Integer; lfMenuFont: TLogFontA; lfStatusFont: TLogFontA; lfMessageFont: TLogFontA; end; tagNONCLIENTMETRICS = tagNONCLIENTMETRICSA; {$ENDIF} var wc: TWndClassEx = ( cbSize: SizeOf(TWndClassEx); style: CS_OWNDC or CS_HREDRAW or CS_VREDRAW; cbClsExtra: 0; cbWndExtra: 0; hbrBackground: COLOR_WINDOW; lpszMenuName: nil; lpszClassName: ClassName; hIconSm: 0; ); msg: TMSG; rect: trect; deskh, deskw: integer; ncm: tagNONCLIENTMETRICS; begin wc.hInstance := HInstance; wc.hIcon := LoadIcon(HInstance, MAKEINTRESOURCE(1)); wc.hCursor := LoadCursor(0, IDC_ARROW); wc.lpfnWndProc := @WndProc; systemparametersinfo(SPI_GETWORKAREA, 0, @rect, 0); deskw := rect.Right - rect.Left; deskh := rect.Bottom - rect.Top; ncm.cbSize := sizeof(ncm); systemparametersinfo(SPI_GETNONCLIENTMETRICS, sizeof(ncm), @ncm, 0); windowwidth := windowleft + windowwidth; windowheight := windowtop + windowheight + ncm.iMenuHeight + ncm.iCaptionHeight; Windowleft := (deskw div 2) - (windowwidth div 2); Windowtop := (deskh div 2) - (windowheight div 2); RegisterClassEx(wc); {mainwnd:=} CreateWindowEx(WS_EX_WINDOWEDGE or WS_EX_CONTROLPARENT or WS_EX_APPWINDOW, ClassName, 'Caption', WS_OVERLAPPED or WS_CAPTION or WS_SYSMENU or WS_MINIMIZEBOX or WS_VISIBLE, windowleft, windowtop, windowwidth, windowheight, 0, 0, hInstance, nil); while True do begin if not GetMessage(msg, 0, 0, 0) then break; //oops :o) translatemessage(msg); dispatchmessage(msg); end; ExitCode := GetLastError; end. |
Einige der Stellen sind aus obigen Erwägungen bekannt, die anderen werden nun erläutert.
Neu sind die folgenden Stellen. Eine Endlosschleife [WHILE True DO BEGIN], die unterbrochen wird, wenn keine Nachrichten mehr an das Fenster gehen [IF NOT GetMessage(msg, 0, 0, 0) THEN break;] und anderenfalls die Nachrichten übersetzt und an die Fensterprozedur weiterleitet.
Das Beispiel erzeugt ein Haupfenster, und darin einen Knopf. Außerdem wird gezeigt, wie man das Drücken auf den Knopf abfängt. Das ganze erfolgt ohne Verwendung von Dialogressourcen.
Nimmt man nun ein simples Beispiel für ein Programm, das exakt die gleiche Funktion hat, jedoch auf einer Dialog-Vorlage aufbaut, so sieht der Quelltext entsprechend simpler aus:
program Test2; uses windows, messages; {$WARNINGS OFF} {$HINTS OFF} {$R main.res} //hier kommt die Vorlage rein var hdlg: DWORD = 0; function dlgfunc(hwnd: hwnd; umsg: dword; wparam: wparam; lparam: lparam): bool; stdcall; begin result := true; case umsg of WM_CLOSE: EndDialog(hWnd, 0); WM_DESTROY: PostQuitMessage(0); WM_COMMAND: if hiword(wparam) = BN_CLICKED then begin case loword(wparam) of IDOK: begin messagebox(hwnd, 'OK Button gedrückt', 'Meldung', 0); sendmessage(hwnd, WM_CLOSE, 0, 0); end; end; end; else result := false; end; end; begin hdlg := DialogBoxParam(HInstance, MAKEINTRESOURCE(100), 0, @DlgFunc, 0); end. |
Der einzig neue Aufruf hier ist: hdlg := DialogBoxParam(HInstance, MAKEINTRESOURCE(100), 0, @DlgFunc, 0);.
Damit wird aus der Ressource mit der ID 100 der Dialog erzeugt. Eine Fensterprozedur zugewiesen und automatisch die Nachrichtenschleife [Messageloop] gestartet.
Was man an dieser Stelle leidlich gut sieht, ist das Einbinden der Dialog-Vorlage. Dies geschieht durch das Einbinden der MAIN.RES. Diese kompilierte Ressourcendatei wird mithilfe des Resourcecompiler [BRCC32.EXE] aus einem "Resource script" kompiliert.
In unserem Falle sieht das Skript wie folgt aus:
LANGUAGE LANG_NEUTRAL, SUBLANG_NEUTRAL 100 DIALOGEX 6, 18, 264, 85 STYLE DS_MODALFRAME | DS_CENTER | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU EXSTYLE WS_EX_TOOLWINDOW CAPTION "Fenster-Caption" FONT 8, "Arial" BEGIN PUSHBUTTON "OK", IDOK, 61, 65, 140, 14 END
Der Aufruf BRCC32 main.rc main.res erzeugt aus dem Skript das Kompilat.
Zum Bearbeiten eines Resource scripts existieren diverse Tools. Empfehlenswert ist der Editor aus MS Visual C++ sowie das Freewareprodukt WEDIT, das zu VIDE einer C-IDE gehört.
Es geht darum eine Hyperlink-Fensterklasse zu erstellen. Text, der sich, sobald die Maus darüber ist blau färbt und unterstrichen wird - und, der - wenn man draufklickt einen Hyperlink im SHELLEXECUTE()-Stil, also mit dem Standardbrowser öffnet.
Die meisten Delphi-Freunde würden an dieser Stelle die Farbe zB. eines TLabel im MouseOver Ereignis ändern und im OnClick Ereignis den Hyperlink aufrufen. Ein unschöner Nachteil dessen ist, daß das Control in diesem Fall bei jedem Mal bewegen der Maus neu gezeichnet wird, was zu einem Flackereffekt führt.
Hier zum Ersten die INCLUDE Datei HyperLink.PAS (Erklärungen rot im Source):
{$R handcursor.res} const AHyperlink = 'AHyperlinkWndClassEx'; var HLcursor: Cardinal = 0; inactivefont, activefont, inactivecolor, activecolor: Cardinal; {Fensterprozedur eines Hyperlink Controls} function HyperlinkWndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; var prop, DC: DWORD; point: TPoint; rect: TRect; ps: TPaintStruct; pc: array[0..$400] of char; procedure paint(txtcolor: Cardinal); var size: TSize; begin GetClientRect(hWnd, rect); if txtcolor = inactivecolor then selectobject(dc, inactivefont) else selectobject(dc, activefont); Fillrect(DC, rect, GetSysColorBrush(COLOR_3DFACE)); SetBkMode(DC, TRANSPARENT); Settextcolor(DC, txtcolor); SendMessage(hWnd, WM_GETTEXT, $400, LongInt(@pc[0])); GetWindowRect(hWnd, rect); GetTextExtentPoint32(DC, @pc[0], lstrlen(@pc[0]), size); //center text in control window ExtTextOut(DC, ((rect.right - rect.left) div 2) - (size.cx div 2), 0, 2, @rect, @pc[0], lstrlen(@pc[0]), nil); end; {Erstellt Font mit variabler Zeichenbreite} function varfont(DC: DWORD; size, weight: integer; underline: BOOL): DWORD; begin result := CreateFont(-MulDiv(size, GetDeviceCaps(DC, LOGPIXELSY), 72), 0, 0, 0, weight, 0, Cardinal(underline), 0, ANSI_CHARSET, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, VARIABLE_PITCH or FF_ROMAN, 'MS Sans Serif'); end; {Erstellt Font mit fester Zeichenbreite = diktengleich} function fixfont(DC: DWORD; size, weight: integer; underline: BOOL): DWORD; begin result := CreateFont(-MulDiv(size, GetDeviceCaps(DC, LOGPIXELSY), 72), 0, 0, 0, weight, 0, Cardinal(underline), 0, ANSI_CHARSET, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, FIXED_PITCH or FF_MODERN, 'Courier New'); end; begin Result := 0; case uMsg of WM_CREATE: begin result := DefWindowProc(hWnd, uMsg, wParam, lParam); {Für das Browser-Feeling der Handcursor beim Hyperlink} HLcursor := LoadCursor(hInstance, 'HandCursor'); DC := GetWindowDC(hWnd); inactivefont := fixfont(DC, 8, FW_NORMAL, FALSE); activefont := fixfont(DC, 8, FW_BOLD, TRUE); ReleaseDC(hWnd, DC); inactivecolor := rgb($0, $0, $0); activecolor := rgb($0, $0, $FF); SendMessage(hWnd, WM_CAPTURECHANGED, 0, 0); end; WM_RBUTTONUP, WM_LBUTTONUP: begin {Hier der Beweis, auch API Fenster können Properties haben! Gell, Nico ;) ...} prop := getprop(hwnd, 'Link'); if prop <> 0 then shellexecute(0, 'open', pchar(prop), '', '', SW_SHOWNORMAL); end; WM_CAPTURECHANGED, WM_MOUSEMOVE: {Gegen das unschöne Flackern fangen wir den Cursor ein und geben ihn beim Verlassen frei} begin GetCursorPos(point); GetWindowRect(hwnd, rect); if PtInRect(rect, point) then begin if GetCapture <> hWnd then begin SetCapture(hWnd); SetCursor(HLcursor); SendMessage(hWnd, WM_PAINT, activecolor, -1); end; end else begin ReleaseCapture; SendMessage(hWnd, WM_PAINT, inactivecolor, -1); end; end; WM_PAINT: begin case lParam of -1: begin DC := GetWindowDC(hWnd); paint(wParam); ReleaseDC(hWnd, DC); end; else begin DC := BeginPaint(hWnd, ps); paint(wParam); EndPaint(hWnd, ps); end; end; end; else result := DefWindowProc(hWnd, uMsg, wParam, lParam); end; end; {Initialisierung - siehe oben} procedure initacomctl; var wc: TWndClassEx; begin wc.style := CS_HREDRAW or CS_VREDRAW or CS_GLOBALCLASS; wc.cbSize := sizeof(TWNDCLASSEX); wc.lpfnWndProc := @HyperlinkWndProc; wc.cbClsExtra := 0; wc.cbWndExtra := 0; wc.hInstance := hInstance; wc.hbrBackground := COLOR_WINDOW; wc.lpszMenuName := nil; wc.lpszClassName := AHyperlink; wc.hIcon := 0; wc.hIconSm := 0; wc.hCursor := 0; RegisterClassEx(wc); end; |
Zum Verständnis dieser Routinen empfehle ich das MS Platform SDK für Win32. Damit kann man alle Funktionen in einer übersichtlichen Hilfe nachvollziehen.
Interessant mag sein, daß ein jedes auch noch so kleines Control unter Windows ein eigenes Fensterhandle hat, und somit ein eigenes vollwertiges Fenster ist! An dieser Stelle sei zu bemerken, daß Windows 95 nicht mal die 16 Bit-Grenze ausschöpfen kann. Bei rund 16000 Handles ist Schluß - Schöne 32-bit-Welt.
So sieht das Resource script dazu aus (man beachte die Klassennamen!):
LANGUAGE LANG_NEUTRAL, SUBLANG_NEUTRAL 100 DIALOGEX 6, 18, 264, 85 STYLE DS_MODALFRAME | DS_CENTER | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU EXSTYLE WS_EX_TOOLWINDOW CAPTION "HLinkTest" FONT 8, "Arial" BEGIN CONTROL "Schreib doch mal an Assarbad ;)", 102, "AHyperlinkWndClassEx", WS_TABSTOP,6, 12, 252, 12 CONTROL "Die tolle Homepage von Assarbad findest du HIER", 101, "AHyperlinkWndClassEx", WS_TABSTOP,6, 43, 252, 12 PUSHBUTTON "OK", IDOK, 61, 65, 40, 14 PUSHBUTTON "Abrechen", IDCANCEL, 160, 65, 40, 14 END
Erzeugt man nun einen solchen Dialog, muß der Klassenname vorher registriert sein - deshalb auch die UNIT Initialisierung.
Das Ganze sieht wie folgt aus:
program HLinkTest; uses windows, shellapi,//Für ShellExecute() messages; {$WARNINGS OFF} {$R main.res} {$INCLUDE Hyperlink.pas} const {$IFDEF VER90} mylink = 'http://assarbad.net' + #0; mymail = 'mailto: Assarbad@gmx.info' + #0; {$ELSE} mylink = 'assarbad.net'; mymail = 'mailto: Assarbad@gmx.info'; {$ENDIF} var hdlg: DWORD = 0; function dlgfunc(hwnd: hwnd; umsg: dword; wparam: wparam; lparam: lparam): bool; stdcall; begin result := true; case umsg of WM_INITDIALOG: begin { Interessant hier, die Nutzbarmachung von Properties. Die Property "Link" enthält den auszuführenden Teil. } setprop(getdlgitem(hwnd, 101), 'Link', DWORD(pchar(mylink))); setprop(getdlgitem(hwnd, 102), 'Link', DWORD(pchar(mymail))); end; WM_CLOSE: EndDialog(hWnd, 0); WM_DESTROY: begin PostQuitMessage(0); end; WM_COMMAND: if hiword(wparam) = BN_CLICKED then begin case loword(wparam) of IDCANCEL, IDOK: sendmessage(hwnd, WM_CLOSE, 0, 0); end; end; else result := false; end; end; begin initacomctl;//Eigenes Control initialisieren / bekanntmachen hdlg := DialogBoxParam(HInstance, MAKEINTRESOURCE(100), 0, @DlgFunc, 0); end. |
PS: Für weitere Beispiele:
-=Assarbad
[GoP]=- Mail an den Autor Die Weiterverbreitung in unveränderter Form ist ausdrücklich erlaubt. Eine modifizierte Version bedarf meiner Zustimmung. Bitte dazu Kontakt über obige Mail-Adresse aufnehmen. |