!!! 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. |