Einzelnen Beitrag anzeigen

Benutzerbild von Rastaman
Rastaman

Registriert seit: 6. Jan 2005
Ort: Lübbecke
575 Beiträge
 
Turbo C++
 
#1

Problem mit eigener Klasse und Fensterprozedur

  Alt 6. Jan 2006, 18:40
Nabend, hab da ein kleines Problem.
Ich wollte nämlich einen kleinen VCL Ersatz schreiben, so dass man leicht nonVCL (Kann man das dann noch sagen?) Programme hinbekommt, so ähnlich halt wie mit der VCL, nur kleiner.
Dazu wollt ich erstma mit der Forms unit anfangen, klappt aber an einer Stelle nicht so toll.
Hier ma der bis jetz ziemlich kleine Code.

Delphi-Quellcode:
unit NonVCLForms;

interface

uses
  Windows, Messages;

type
  TPosition = (poNone, poCenter);

  TWndStyle = packed record
    Left, Top, Width, Height: Integer;
    Caption: PChar;
    Color: Cardinal;
    Position: TPosition;
  end;

  TWindow = class
  private
    { Private-Deklarationen }
    type
      TNotifyEvent = procedure of object;
    var
      FHandle: HWND;
      FOnCreate: TNotifyEvent;
      WndClass: TWndClassEx;
    procedure CenterWindow(wndParent, wndChild: HWND);
  public
    { Public-Deklarationen }
    constructor Create(WndStyle: TWndStyle);
    function WndProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM;
      lParam: LPARAM): LRESULT; stdcall;
  published
    property Handle: HWND read FHandle;
    property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
  end;

implementation

(* Private *)

(* Zentriert ein Fenster anhand seines Parents *)
procedure TWindow.CenterWindow(wndParent, wndChild: HWND);
var
  PRec,
  CRec: TRect;
begin
  // Fensterkoordinaten ins TRect laden
  GetClientRect(WndParent, PRec);
  GetClientRect(WndChild, CRec);
  // Parent muss größer sein als Child
  if ((PRec.Right - PRec.Left) < (CRec.Right - CRec.Left)) or
     ((PRec.Bottom - PRec.Top) < (CRec.Bottom - CRec.Top)) then
  begin
    Exit;
  end;
  // Position setzen
  SetWindowPos(WndChild, HWND_TOP, (PRec.Right - CRec.Right) div 2,
    (PRec.Bottom - CRec.Bottom) div 2, 0, 0, SWP_NOSIZE or SWP_NOACTIVATE);
end;

(* Public *)

constructor TWindow.Create(WndStyle: TWndStyle);
var
  lgBr: TLogBrush;
  hBr: HBRUSH;
begin

  case WndStyle.Color of
    COLOR_WINDOW,
    COLOR_APPWORKSPACE:
      begin
        lgBr.lbColor := GetSysColor(WndStyle.Color);
      end;
  else
    lgBr.lbColor := WndStyle.Color;
  end;
  lgBr.lbStyle := BS_SOLID;
  hBr := CreateBrushIndirect(lgBr);

  WndClass.cbSize := SizeOf(WndClass);
  WndClass.style := CS_OWNDC;
  WndClass.lpfnWndProc := @TWindow.WndProc;
  WndClass.hInstance := hInstance;
  WndClass.hCursor := LoadCursor(0, IDC_ARROW);
  WndClass.hbrBackground := hBr;
  WndClass.lpszClassName := 'TWindow';
  RegisterClassEx(WndClass);

  With WndStyle do
  begin
    FHandle := CreateWindow('TWindow', Caption, WS_VISIBLE or WS_SYSMENU,
                 Left, Top, Width, Height, 0, 0, hInstance, nil);

    if Position = poCenter then
      CenterWindow(FindWindow('ProgMan', nil), Handle);
  end;

end;

function TWindow.WndProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM;
  lParam: LPARAM): LRESULT; stdcall;
begin
  case uMsg of
    WM_CREATE:
      begin
        if Assigned(OnCreate) then
          OnCreate;
        Result := 0;
      end;
  else
    Result := DefWindowProc(hwnd, uMsg, wParam, lParam);
  end;
end;

end.
Das Problem liegt da, wo der Fensterklasse die Fensterprozedur übermittelt wird.
Das Fenster taucht einfach nicht auf. Wenn ich nur @WndProc schreibe, kommt der Fehler "Variable erwartet", und wenn ich die Prozedur aus der TWindow Klasse rausnehme, klappt es zwar, aber ich kann dann ja halt auch keine Ereignisse wie "OnCreate" zuweisen. Was könnte man da machen
Chuck Norris has counted to infinity ... twice!
  Mit Zitat antworten Zitat