Entwickler-Ecke

Windows API - [nonVCL] Messages aus WNDProc in eigene Klasse leiten


NeoInDerMATRIX - Sa 26.06.04 21:34
Titel: [nonVCL] Messages aus WNDProc in eigene Klasse leiten
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:

Delphi-Quelltext 
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.



Delphi-Quelltext 
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; // RGBA Pixel Type
  PFD.cColorBits:=vColorDepth; // 24-bit color (Anzahl der Farben)
  PFD.cDepthBits:=vDepthBits; // 32-bit depth buffer
  PFD.iLayerType:=pfd_Main_Plane;
  nPixelFormat:=ChoosePixelFormat(_DeviceContext, @PFD);
  SetPixelFormat(_DeviceContext, nPixelFormat, @PFD);
  // Farbpalettenoptimierung wenn erforderlich
  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 - 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 - 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 [http://www.delphipraxis.net/topic7339_wndproc+in+klasse.html] wird die Problematik angesprochen.


NeoInDerMATRIX - 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 - 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: http://alf.ki.fh-mannheim.de/~m.leim/TAppbase.zip


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

Delphi-Quelltext 
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;
//             Function GetGlobalWNDProc: Pointer;
            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, // Pop ECX
              $E9  // Jmp StdWndProc
             );
 Var
  Block: pInstanceBlock;
  Instance: pObjectInstance;
 Begin
  If (InstFreeList = NIL) Then
   Begin
    Block:=VirtualAlloc(NIL, 4{PageSize}, 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; // Call Near PTR Offset
     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;
                   // dbClsExtra: 0;
                   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, 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 - 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..!


NeoInDerMATRIX - Mo 28.06.04 22:37
Jo, das kann ich probieren!

CU Neo


Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2026 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!