| Autor |
Beitrag |
NeoInDerMATRIX
 
Beiträge: 245
Win95, Win98(+se), WinNT, Win2000, WinME, WinXP(+pro), VISTA, Linux(SuSe), DOS [MultiMon(3)], Vista
D6 PeE + (FP 2.0l) + D3 Pe + D2005+ D2006 Arch
|
Verfasst: Sa 26.06.04 21:34
Hallo,
ich habe ein problem! Ich möchte eine Klasse "tWindow" erstellen die natürlich auch Messages über die WNDProc verarbeiten kann! Leider bekomme ich das nicht so hin wie ich es mir vorstelle!!!!
Zur Erklärung:
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
| Unit Control;
Interface
Uses
Windows, Messages;
Type
ponMessage = Function(vWindowHandle: hWnd; vMsg: uInt; wParam: wParam; lParam: lParam): lResult;
pControl = ^tControl;
tControl = Class
Constructor Create;
Destructor Destroy; Override;
Function GetGlobalWNDProc: Pointer;
Private
Function WNDProc(vWindowHandle: hWnd; vMsg: uInt; wParam: wParam; lParam: lParam): lResult;
Public
onMessage: ponMessage;
Published
End;
Implementation
Var
ControlList : Array of tControl;
Function ControlListCount: Integer;
Begin
Result:=Length(ControlList);
End;
Function GlobalWNDProc(vWindowHandle: hWnd; vMsg: uInt; wParam: wParam; lParam: lParam): lResult; StdCall;
Var
Lauf: Integer;
Begin
Result:=0;
If (ControlListCount=-1) Then
Begin
Result:=DefWindowProc(vWindowHandle, vMsg, wParam, lParam);
Exit;
End;
For Lauf:=0 to ControlListCount do
If (Assigned(ControlList[Lauf])) Then
Result:=ControlList[Lauf].WndProc(vWindowHandle, vMsg, wParam, lParam);
End;
Function RegistControl(vControl: tControl): Boolean;
Var
Lauf: Integer;
Begin
Result:=FALSE;
If Not(Assigned(vControl)) Then
Exit;
Lauf:=ControlListCount;
SetLength(ControlList, Lauf + 1);
ControlList[Lauf]:=vControl;
Result:=TRUE;
End;
Function FindControl(vControl: tControl): Integer;
Var
Lauf: Integer;
Begin
Result:=-1;
For Lauf:=0 to ControlListCount do
If (Assigned(ControlList[Lauf])) Then
Begin
Result:=Lauf;
Exit;
End;
End;
Function UnRegistControl(vControl: tControl): Boolean;
Var
Lauf: Integer;
Begin
Result:=FALSE;
If Not(Assigned(vControl)) Then
Exit;
Lauf:=ControlListCount;
If (Lauf>1) Then
Move(ControlList[Lauf + 1], ControlList[Lauf], ControlListCount - Lauf);
SetLength(ControlList, Lauf - 1);
Result:=TRUE;
End;
Constructor tControl.Create;
Begin
Inherited;
RegistControl(Self);
End;
Destructor tControl.Destroy;
Begin
UnRegistControl(Self);
Inherited;
End;
Function tControl.GetGlobalWNDProc: Pointer;
Begin
Result:=@GlobalWNDProc;
End;
Function tControl.WNDProc(vWindowHandle: hWnd; vMsg: uInt; wParam: wParam; lParam: lParam): lResult;
Begin
If (Assigned(onMessage)) Then
Result:=onMessage(vWindowHandle, vMsg, wParam, lParam)
Else
Result:=DefWindowProc(vWindowHandle, vMsg, wParam, lParam);
End;
END. |
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
| Unit Window;
Interface
Uses
Control, Windows;
Type
tScreenXY = Record
X: Integer;
Y: Integer;
End;
tWindow = Class(tControl)
Constructor Create;
Destructor Destroy; Override;
Procedure UpDate;
Private
Instance: hInst;
WindowClassName: pChar;
WindowClassHandle: Integer;
Position: tScreenXY;
Size: tScreenXY;
WindowCaption: pChar;
WindowHandle: hWnd;
DeviceContext: hDC;
Palette: hPalette;
FullScreen: Boolean;
MinSize: tScreenXY;
Procedure CreateWindowClass(vClassName: String);
Procedure DestroyWindowClass;
Procedure CreateWindow(vCaption: String);
Procedure DestroyWindow;
Procedure CreatePixelFormat(vColorDepth, vDepthBits: Integer);
Procedure DestroyPixelFormat;
Procedure CreateDeviceContext;
Procedure DestroyDeviceContext;
Public
Published
End;
Implementation
Constructor tWindow.Create;
Begin
Inherited;
Instance:=GetModuleHandle(NIL);
CreateWindowClass('Test');
CreateWindow('Test');
CreatePixelFormat(32, 32);
CreateDeviceContext;
End;
Destructor tWindow.Destroy;
Begin
DestroyDeviceContext;
DestroyPixelFormat;
DestroyWindow;
DestroyWindowClass;
Inherited;
End;
Procedure tWindow.UpDate;
Begin
End;
Procedure tWindow.CreateWindowClass(vClassName: String);
Var
WndClass: tWndClass;
Begin
ZeroMemory(@WndClass, SizeOf(WndClass));
WndClass.style:=cs_HRedraw or cs_VRedraw or cs_OwnDC;
WndClass.lpfnWndProc:=GetGlobalWNDProc;
WndClass.hInstance:=_Instance;
WndClass.hCursor:=LoadCursor(0, idc_Arrow);
WndClass.lpszClassName:=pChar(vClassName);
WindowClassHandle:=RegisterClass(WndClass);
WindowClassName:=pChar(vClassName);
End;
Procedure tWindow.DestroyWindowClass;
Begin
WindowClassHandle:=Integer(UnRegisterClass(WindowClassName, Instance) = TRUE);
End;
Procedure tWindow.CreateWindow(vCaption: String);
Var
dwStyle: DWord;
dwExStyle: DWord;
Begin
If (FullScreen) Then
Begin
dwStyle:=ws_Popup or ws_ClipChildren or ws_ClipSiblings;
dwExStyle:=ws_Ex_AppWindow;
End Else Begin
dwStyle:=ws_OverlappedWindow or ws_ClipChildren or ws_ClipSiblings;
dwExStyle:=ws_Ex_AppWindow or ws_Ex_WindowEdge;
End;
WindowCaption:=pChar(vCaption);
WindowHandle:=CreateWindowEx(dwExStyle, WindowClassName, WindowCaption, dwStyle, Position.X, Position.Y, Size.X, Size.Y, 0, 0, Instance, NIL);
End;
Procedure tWindow.DestroyWindow;
Begin
Windows.DestroyWindow(WindowHandle);
End;
Procedure tWindow.CreatePixelFormat(vColorDepth, vDepthBits: Integer);
Var
hHeap: THandle;
nColors, I: Integer;
lpPalette : PLogPalette;
byRedMask, byGreenMask, byBlueMask: Byte;
nPixelFormat: Integer;
PFD: TPixelFormatDescriptor;
Begin
ZeroMemory(@Pfd, SizeOf(Pfd));
PFD.nSize:=SizeOf(PFD);
PFD.nVersion:=1;
PFD.dwFlags:=pfd_Draw_To_Window or
pfd_Support_OpenGL or
pfd_DoubleBuffer;
PFD.iPixelType:=pfd_Type_RGBA; PFD.cColorBits:=vColorDepth; PFD.cDepthBits:=vDepthBits; PFD.iLayerType:=pfd_Main_Plane;
nPixelFormat:=ChoosePixelFormat(_DeviceContext, @PFD);
SetPixelFormat(_DeviceContext, nPixelFormat, @PFD);
DescribePixelFormat(_DeviceContext, nPixelFormat, SizeOf(PFD), PFD);
If ((PFD.dwFlags and pfd_Need_Palette) <> 0) Then
Begin
nColors:=1 Shl PFD.cColorBits;
hHeap:=GetProcessHeap;
lpPalette:=HeapAlloc(hHeap, 0, SizeOf(tLogPalette) + (nColors * SizeOf(tPaletteEntry)));
lpPalette^.palVersion:=$300;
lpPalette^.palNumEntries:=nColors;
byRedMask:=(1 Shl PFD.cRedBits) - 1;
byGreenMask:=(1 Shl PFD.cGreenBits) - 1;
byBlueMask:=(1 Shl PFD.cBlueBits) - 1;
For I := 0 to nColors - 1 do
Begin
lpPalette^.palPalEntry[i].peRed:=(((I Shr PFD.cRedShift) and byRedMask) * 255) div byRedMask;
lpPalette^.palPalEntry[i].peGreen:=(((I Shr PFD.cGreenShift) and byGreenMask) * 255) div byGreenMask;
lpPalette^.palPalEntry[i].peBlue:=(((I Shr PFD.cBlueShift) and byBlueMask) * 255) div byBlueMask;
lpPalette^.palPalEntry[i].peFlags:=0;
End;
Palette:=CreatePalette(lpPalette^);
HeapFree(hHeap, 0, lpPalette);
If (Palette <> 0) Then
Begin
SelectPalette(DeviceContext, Palette, False);
RealizePalette(DeviceContext);
End;
End;
End;
Procedure tWindow.DestroyPixelFormat;
Begin
If (Palette=0) Then
Exit;
Palette:=0;
End;
Procedure tWindow.CreateDeviceContext;
Begin
DeviceContext:=GetDC(WindowHandle);
End;
Procedure tWindow.DestroyDeviceContext;
Begin
DeviceContext:=ReleaseDC(WindowHandle, DeviceContext);
End;
END. |
Tja und wenn ich das nun Debuge oder starte, dann gibt es ein Hardwarereset bei meinem Rechner!!
Ist das den normal???? Wenn ihr einen Fehler seht sagt ihn mir, ich bin echt langsam am Verzweifeln! 
Ich danke euch
Neo
P.s.: Sorry das ich den Code so jetzt Poste! Und auch das er nicht dokomentiert ist!
|
|
NeoInDerMATRIX 
Beiträge: 245
Win95, Win98(+se), WinNT, Win2000, WinME, WinXP(+pro), VISTA, Linux(SuSe), DOS [MultiMon(3)], Vista
D6 PeE + (FP 2.0l) + D3 Pe + D2005+ D2006 Arch
|
Verfasst: Mo 28.06.04 18:40
Hallo,
schade das mir keiner Helfen will oder kann!
Tja, mus ich wohl selber damit klar kommen! Schade!
OK, cu
Neo
|
|
UC-Chewie
Beiträge: 531
WinXP
D5 Ent
|
Verfasst: Mo 28.06.04 19:06
Die WndProc muss eine globale Prozedur sein, keine Methode einer Klasse. Das liegt daran, dass bei Methoden immer ein unsichtbarer Parameter Self mitgeführt wird, der auf die jeweilige Instanz zeigt.
Hier wird die Problematik angesprochen. _________________ Egal wie dumm man selbst ist, es gibt immer andere, die noch dümmer sind
|
|
NeoInDerMATRIX
Beiträge: 245
Win95, Win98(+se), WinNT, Win2000, WinME, WinXP(+pro), VISTA, Linux(SuSe), DOS [MultiMon(3)], Vista
D6 PeE + (FP 2.0l) + D3 Pe + D2005+ D2006 Arch
|
Verfasst: Mo 28.06.04 19:41
Hallo,
@UC-Chewie:
Das die WndProc Globla sein mus ist mir eigentlich auch bewust gewesen! In "GlobalWNDProc" sollten dann die Messages per Array gespeicherte Objecte an die Objecte weitergeleitet werden! Und was ich nicht verstehe ist das dan nicht gehen soll! Weil ich doch eigentlich dadurch wie ihr es im Forum beschreibt das Problem mit dem nicht sichtbaren "Self" Parameter umgehe oder nicht???
Also das was dort besprochen wird ist glaube ich genau das was ich brauche! Aber leider habe ich das meiste nicht wirklich verstanden! Es wurde auch davon gesprochen das es in der VCL-Code das auch gemacht wird! Wo finde ich das im VCL-Code!
CU
Neo
|
|
UC-Chewie
Beiträge: 531
WinXP
D5 Ent
|
Verfasst: Mo 28.06.04 20:44
Ich hab die im Thread angesprochenen Möglichkeiten auch nur sehr vage verstanden. Aber falls es dir hilft, dann schau dir mal meine Klasse an, die ein Fenster ohne die VCL erstellt. Ich such die Unit mal raus.
Hier ist sie: alf.ki.fh-mannheim.de/~m.leim/TAppbase.zip_________________ Egal wie dumm man selbst ist, es gibt immer andere, die noch dümmer sind
|
|
NeoInDerMATRIX
Beiträge: 245
Win95, Win98(+se), WinNT, Win2000, WinME, WinXP(+pro), VISTA, Linux(SuSe), DOS [MultiMon(3)], Vista
D6 PeE + (FP 2.0l) + D3 Pe + D2005+ D2006 Arch
|
Verfasst: Mo 28.06.04 20:55
Ist es nach deiner meinung nach möglich das so weiter auszubauen, das man mehr als nur ein Fenster erzeugen kann! Also mit nem Array wo die Fenster Objecte gespeichert werden?
|
|
NeoInDerMATRIX
Beiträge: 245
Win95, Win98(+se), WinNT, Win2000, WinME, WinXP(+pro), VISTA, Linux(SuSe), DOS [MultiMon(3)], Vista
D6 PeE + (FP 2.0l) + D3 Pe + D2005+ D2006 Arch
|
Verfasst: Mo 28.06.04 21:25
Habe gerade mir das von Borland in der VCL verwendete mal raus genommen! Aber ich glaube das ist nicht wirklich gut! So weit ich mit bekommen habe werden keine wm_Create etc. empfangen oder besser zur abarbeitung geleitet! Bei deiner Version sehe ich das das möglich ist!
Das hab ich zur zeit!
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
| Unit Control;
Interface
Uses
Windows, Messages;
Type
ponMessage = Function(vWindowHandle: hWnd; vMsg: uInt; wParam: wParam; lParam: lParam): lResult;
pControl = ^tControl;
tControl = Class
Constructor Create;
Destructor Destroy; Override;
Private
Handle: hWnd;
Procedure WNDProc(Var vMessage: tMessage);
Public
onMessage: ponMessage;
Published
End;
Implementation
Const
InstanceCount = 313;
Type
tWndMethod = Procedure(Var vMessage: TMessage) of Object;
Type
pObjectInstance = ^tObjectInstance;
tObjectInstance = Packed Record
Code: Byte;
Offset: Integer;
Case Integer of
0: (Next: pObjectInstance);
1: (Method: tWndMethod);
End;
Type
pInstanceBlock = ^tInstanceBlock;
tInstanceBlock = Packed Record
Next: pInstanceBlock;
Code: Array[1..2]of Byte;
WndProcPtr: Pointer;
Instances: Array[0..InstanceCount]of tObjectInstance;
End;
Var
InstBlockList: pInstanceBlock;
InstFreeList: pObjectInstance;
Function StdWndProc(vWindow: hWnd; vMessage, wParam, lParam: LongInt): LongInt; StdCall; Assembler;
Asm
Xor EAX, EAX;
Push EAX;
Push lParam;
Push wParam;
Push vMessage;
Mov EDX, ESP;
Mov EAX, [ECX].LongInt[4];
Call [ECX].Pointer;
Add ESP, 12;
Pop EAX;
End;
Function CalcJmpOffset(vSrc, vDest: Pointer): LongInt;
Begin
Result:=LongInt(vDest) - (LongInt(vSrc) + 5);
End;
Function MakeObjectInstance(vMEthod: tWndMethod): Pointer;
Const
BlockCode: Array[1..2]of Byte
= ($59, $E9 );
Var
Block: pInstanceBlock;
Instance: pObjectInstance;
Begin
If (InstFreeList = NIL) Then
Begin
Block:=VirtualAlloc(NIL, 4, mem_Commit, Page_Execute_ReadWrite);
Block^.Next:=InstBlockList;
Move(BlockCode, Block^.Code, SizeOf(BlockCode));
Block^.WndProcPtr:=Pointer(CalcJmpOffset(@Block^.Code[2], @StdWndProc));
Instance:=@Block^.Instances;
Repeat
Instance^.Code:=$E8; Instance^.Offset:=CalcJmpOffset(Instance, @Block^.Code);
Instance^.Next:=InstFreeList;
InstFreeList:=Instance;
Inc(LongInt(Instance), SizeOf(tObjectInstance));
Until (LongInt(Instance) - LongInt(Block) >= SizeOf(tInstanceBlock));
InstBlockList:=Block;
End;
Result:=InstFreeList;
Instance:=InstFreeList;
InstFreeList:=Instance^.Next;
Instance^.Method:=vMethod;
End;
Procedure FreeObjectInstance(vObjectInstance: Pointer);
Begin
If (vObjectInstance <> NIL) Then
Begin
pObjectInstance(vObjectInstance)^.Next:=InstFreeList;
InstFreeList:=vObjectInstance;
End;
End;
Var
UtilWindowClass: tWndClass
= (Style: 0;
lpfnWndProc: @DefWindowProc;
cbWndExtra: 0;
hInstance: 0;
hIcon: 0;
hCursor: 0;
hbrBackground: 0;
lpszMenuName: NIL;
lpszClassName: 'NoName'
);
Function CreateWindow(vWndMethod: tWndMethod; vWindowClassName, vWindowCaption: pChar): hWnd;
Var
TempClass: tWndClass;
ClassRegisted: Boolean;
Begin
UtilWindowClass.hInstance:=hInstance;
UtilWindowClass.lpfnWndProc:=@DefWindowProc;
UtilWindowClass.lpszClassName:=vWindowClassName;
ClassRegisted:=GetClassInfo(hInstance, UtilWindowClass.lpszClassName, TempClass);
If Not(ClassRegisted) or (TempClass.lpfnWndProc<>@DefWindowProc) Then
Begin
If (ClassRegisted) Then
Windows.UnregisterClass(UtilWindowClass.lpszClassName, hInstance);
Windows.RegisterClass(UtilWindowClass);
End;
Result:=CreateWindowEx(ws_Ex_ToolWindow, UtilWindowClass.lpszClassName, vWindowCaption, ws_Popup , 0, 0, 0, 0, 0, 0, hInstance, NIL);
If (Assigned(vWndMethod)) Then
SetWindowLong(Result, gwl_WndProc, LongInt(MakeObjectInstance(vWndMethod)));
End;
Procedure DestroyWindow(vWindowHandle: hWnd);
Var
Instance: Pointer;
Begin
Instance:=Pointer(GetWindowLong(vWindowHandle, gwl_WndProc));
Windows.DestroyWindow(vWindowHandle);
If (Instance <> @DefWindowProc) Then
FreeObjectInstance(Instance);
End;
Constructor tControl.Create;
Begin
Inherited;
Handle:=CreateWindow(Self.WNDProc, 'TestClass', 'Test Fenster');
End;
Destructor tControl.Destroy;
Begin
DestroyWindow(Handle);
Inherited;
End;
Procedure tControl.WNDProc(Var vMessage: tMessage);
Begin
Exit;
End;
END. |
Neo
|
|
Motzi
Beiträge: 2931
XP Prof, Vista Business
D6, D2k5-D2k7 je Prof
|
Verfasst: Mo 28.06.04 22:29
Code den man nicht versteht zu verwenden ist immer schlecht..!
Kämpf dich mal durch den Thread aus der DP durch, der dürft recht interessant sein, und auch wenn du den Code der dort gepostet wurde auch nicht verstehst, so ist dieser sicher doch besser erklärt als der aus der VCL..!
_________________ gringo pussy cats - eef i see you i will pull your tail out by eets roots!
|
|
NeoInDerMATRIX
Beiträge: 245
Win95, Win98(+se), WinNT, Win2000, WinME, WinXP(+pro), VISTA, Linux(SuSe), DOS [MultiMon(3)], Vista
D6 PeE + (FP 2.0l) + D3 Pe + D2005+ D2006 Arch
|
Verfasst: Mo 28.06.04 22:37
Jo, das kann ich probieren!
CU Neo
|
|
|
