Thema: Delphi wndproc geht nicht

Einzelnen Beitrag anzeigen

Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.164 Beiträge
 
Delphi 12 Athens
 
#3

AW: wndproc geht nicht

  Alt 19. Jun 2022, 14:28
Noch schlimmer. Es könnte eventuell sogar ein Code für Delphi 1 sein, also für ein 16 Bit Windows. (Windows 1.0 bis 3.11)
Hat dieser Code jemals funktioniert, dann wohl eher nur in uralten Windowsen. (vor allem die fehlende Messagebehandlung und die echt winzige Darstellung, schon bei FullHD)

Und es gibt unmassen Fehler:

* Rückgabewerte nicht zugewiesen -> WindowProc
* Aufrufconvention (stdcall) vergessen -> WindowProc
* Handle (HWND) sind seit laaangem eigentlich 32 Bit, aber hier Word (auch wenn es zufällig noch funktionieren könnte, aber nicht muß)

* es wird eine Fensterklasse "Win here" registriert (RegisterClass), aber Diese garnicht verwendet, da bei CreateWindow ein anderer Name "STATIC" angegeben wurde, während "Win here" dort als Caption genutzt wurde
** also die WindowProc wurde niemals verwendet (weil in anderer Klasse)

* UND, weil es keine MessageBehandlung gab, werden Mausereignisse auch niemals ausgeführt (das Fenster kann garnicht reagieren)


Tipp:
* es kann nie schaden die "richtigen" Typen-Bezeichner zu nutzen
* die Variablen/Funktionen verständlich zu benennen, verhindert vermindert bestimmt Verwechslungen
* und anstatt irgendwlecher unverständlicher Werte/Zahlen sind Konstanten zu bevorzugen

Delphi-Quellcode:
program Project21;

{$R *.res}

uses
  Types, SysUtils, Windows, Messages; // or System.Types, System.SysUtils Winapi.Windows, Winapi.Messages;

var
  Cls: WNDCLASSEX;
  DK, DB, DM, DE: Boolean;

function WindowProc(Wnd: HWND; Msg: LongInt; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall; // die CallingConvention fehlte !!!!!!!!
begin
  Result := 0; // der Rückgabewert fehlte !!!!!!!!!
  case Msg of
    WM_KEYDOWN: DK := not DK;
    WM_LBUTTONDOWN: DB := not DB;
    WM_MOUSEMOVE: DM := not DM;
    WM_RBUTTONDOWN: DE := True;
    else Result := DefWindowProc(Wnd, Msg, WParam, LParam); // als auch die Standardbehandlung für alle Messages, welche DU nicht behandelst
  end;
end;


function RegisterWindowClass: ATOM;
begin
  Cls.cbSize := SizeOf(Cls);
  Cls.style := CS_HREDRAW or CS_VREDRAW;
  Cls.lpfnWndProc := @WindowProc;
  Cls.cbClsExtra := 0;
  Cls.cbWndExtra := 0;
  Cls.hInstance := GetModuleHandle(nil);
  Cls.hIcon := LoadIcon(0, IDI_APPLICATION);
  Cls.hCursor := 0;
  Cls.hCursor := 0;
  Cls.hbrBackground := COLOR_BTNFACE; // 14 + 1;
  Cls.lpszMenuName := niL;
  Cls.lpszClassName := 'MyClassName';
  Cls.hIconSm := LoadIcon(Cls.hInstance, IDI_APPLICATION);

  Result := RegisterClassEx(Cls);
end;

function CreateMainWindow: HWND;
var
  ClassName, Caption: PChar;
  wndparent: HWND;
  menu: HMENU;
  instance: THandle;
  param: Pointer;
begin
  ClassName := 'MyClassName';
  Caption := 'Text';
  wndparent := 0;
  menu := 0;
  instance := 0;
  param := niL;

  Result := CreateWindow(ClassName, Caption, WS_POPUP, 20, 40, 300, 200,
    wndparent, menu, instance, param);
end;

procedure Draw4(Window: HWND; X, Y, Width, Height: Integer; R, G, B: Byte);
var
  DC, BP: HDC;
  XX, YY, Pos: LongInt;
  PaintStrc: TPaintStruct;
begin
  DC := GetDC(Window);
  PaintStrc.hdc := DC;
  PaintStrc.fErase := False;
  PaintStrc.rcPaint := Rect(0, 0, X + Width, Y + Height);

  BP := BeginPaint(Window, PaintStrc);
  for YY := 1 to Height do
    for XX := 1 to Width do begin
      //SetPixel(DC, X + XX, Y + YY, (((Integer(R) * 256) + G) * 256) + B);
      SetPixel(DC, X + XX, Y + YY, RGB(R, G, B));
    end;
  EndPaint(Window, PaintStrc);

  ReleaseDC(Window, DC);
end;

var
  Wnd: HWND;
  Msg: TMsg;

begin
  DK := False; DB := False; DM := False; DE := False;
  RegisterWindowClass;
  Wnd := CreateMainWindow;
  ShowWindow(Wnd, SW_SHOW);
  //UpdateWindow(Wnd);
  repeat
    if DK then
      Draw4(Wnd, 02, 02, 20, 20, $C0, $00, $00)
    else
      Draw4(Wnd, 02, 02, 20, 20, $40, $40, $00);
    if DB then
      Draw4(Wnd, 24, 02, 20, 20, $00, $C0, $00)
    else
      Draw4(Wnd, 24, 02, 20, 20, $00, $40, $40);
    if DM then
      Draw4(Wnd, 46, 02, 20, 20, $00, $00, $C0)
    else
      Draw4(Wnd, 46, 02, 20, 20, $40, $00, $40);
    //ShowWindow(Wnd, SW_SHOW);
    //UpdateWindow(Wnd);
    if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then begin
      if Msg.Message = WM_QUIT then
        Break;
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
  until DE;
end.
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests

Geändert von himitsu (19. Jun 2022 um 21:27 Uhr)
  Mit Zitat antworten Zitat