wndproc geht nicht

[milurt]

i habe ein program, aber die vierecke reagieren nicht auf
tastatur und maus:

Delphi-Quellcode:

program bspforum01;

  uses
  wintypes,
  Winprocs;

  Var
    Cls:WNDCLASSEX;
    dk,db,dm:ShortInt;

Function wndproc(hwnd:HWND;m,w:word;l:longint):LongInt;
  Begin
    case m of
      $100:dk:=-1*dk;
      $201:db:=-1*db;
      $200:dm:=-1*dm;
      $204:db:=2;
    end;
  End;

  Function regwin:Integer;
  Begin
    cls.cbSize:=sizeof(cls);
    cls.style:=CS_HREDRAW Or CS_VREDRAW;
    cls.lpfnWndProc:=Addr(wndproc);
    cls.cbClsExtra:=0;
    cls.cbWndExtra:=0;
    cls.hInstance:=GetModuleHandle(nil);; {IH}
    cls.hIcon:=winprocs.LoadIcon(0, IDI_APPLICATION);
    cls.hCursor:=0;
    cls.hCursor:=0;
    cls.hbrBackground:=(14 + 1);
    cls.lpszMenuName:=NiL;
    cls.lpszClassName:='Win here'#0;
    cls.hIconSm:=LoadIcon(cls.hInstance, IDI_APPLICATION);

    regwin:=winprocs.RegisterClassEx(cls);
  End;

  Function creWin:word;
    Var
      s2,s1:pchar;
      wndparent:hwnd;
      menu:hmenu;
      instance:thandle;
      param:pointer;
  Begin
    S2:='STATIC'#0;
    S1:='Win here'#0;
    wndparent:=0;
    menu:=0;
    instance:=0;
    param:=NiL;
    creWin:=winprocs.createwindow(s2,s1,ws_popup,20,40,300,200,
      wndparent,menu,instance,param);
  End;

  Var hwnd:Word;

  procedure draw4(hwnd,x,y,wid,hei:word;r,g,b:byte);
    Var
      DC,bp:HDC;
      xx,yy,Pos:LongInt;
      PaintStrc:wintypes.TPAINTSTRUCT;
  Begin
    DC:=winprocs.getdc(hwnd); {device context of window}
    PaintStrc.hdc:=DC;
    PaintStrc.ferase:=false;
    PaintStrc.rcpaint.left:=0;
    PaintStrc.rcpaint.top:=0;
    PaintStrc.rcpaint.right:=X+wid;
    PaintStrc.rcpaint.bottom:=Y+hei;
    bp:=winprocs.BeginPaint(hwnd,PaintStrc);
    for yy:=1 To hei Do
      For xx:=1 To wid Do
      Begin
        winprocs.SetPixel(dc,x+xx,y+yy,(((r*256)+g)*256)+b);
      End;
    winprocs.EndPaint(hwnd,PaintStrc);
    releasedc(hwnd,dc);
  end;

Begin
  dk:=-1;db:=-1;dm:=-1;
  regwin;
  hwnd:=crewin;
  showwindow(hwnd,sw_show);
  updatewindow(hwnd);
  Repeat
    if dk=-1 Then draw4(hwnd,02,02,20,20,$C0,$00,$00)
      else draw4(hwnd,02,02,20,20,$40,$40,$00);
    if db=-1 Then draw4(hwnd,24,02,20,20,$00,$C0,$00)
      else draw4(hwnd,24,02,20,20,$00,$40,$40);
    if dm=-1 Then draw4(hwnd,46,02,20,20,$00,$00,$C0)
      else draw4(hwnd,46,02,20,20,$40,$00,$40);
    showwindow(hwnd,sw_show);
    updatewindow(hwnd);
  Until db=2;
end.

[Daniel]

Moin,

Du hast - allem Anschein nach - von irgendwoher einen sehr alten Programmcode (die Units WinProcs und WinTypes sind hier ein Indikator) und möchtest nun was genau erreichen?
Alles selbst machen zu wollen, ist am Anfang vielleicht etwas ambitioniert.

Lasse Delphi das Fenster selbst erstellen und dann nimm vielleicht zunächst irgendwas Fertiges wie z.B. einen Button oder ein Panel. Und dann mache Dich damit vertraut, wie man auf Tastatur-Eingaben reagiert (OnKeyPress z.B.) - sobald Du da Erkenntnisse gewonnen hast, baut sich das Mosaik nach und nach zusammen und Du könntest Objekte auf dem Canvas herumschubsen.

Als offenes Wort: Wenn Dir nicht klar ist, warum Dein Code nicht auf Tastatur-Eingaben reagiert, hast Du noch ein paar Lern-Schritte dort Dir. Das ist nicht schlimm, wir alle haben mal angefangen - es ist nur wichtig, dies zu realisieren.

[himitsu]

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.

[milurt]

tut mir leid himitsu,
bei deinem program reagieren die vierecke
auch nicht auf tastatur und maus.
und das ist wohl ein fehler, denn microsoft
sagt classname muss der 2te parameter sein,
zudem s1 nicht deklariert wurde:
ClassName := 'MyClassName';
Caption := 'Text';
Result := CreateWindow(S1, Caption, WS_POPUP, 20, 40, 300, 200,
wndparent, menu, instance, param);
ausserdem habe ich es jetzt so und es geht auch nicht:
Function wndproc(hwnd1:HWND;m,w:word;l:longint):LongInt;std call;
Begin
case m of
$100:dk:=-1*dk;
$201:db:=-1*db;
$200:dm:=-1*dm;
$204:db:=2;
end;
wndproc:=DefWindowProc(hwnd1,m,w,l);
End;

[himitsu]

Zitat von milurt:

bei deinem program reagieren die vierecke
auch nicht auf tastatur und maus.

ja, weil das fenster noch nicht richtig initialisiert war.

Es fehlten noch sehr viele Messages, welche nicht behandelt wurden.
Unter Anderem war daher auch das Fenster selber unsichtbar, bis auf diese paar gemalten Rechtecke.

Aber das mit dem DefWindowProc hattest du schon bemerkt.
Oben hatte ich es auch schon nachgetragen, mit dem Unterschied des ELSE, aber ist erstmal egal, da das Fenster auf diese Messages eh keine Behandlung hat und es praktisch keine Konflikte gibt.
else Result := DefWindowProc(Wnd, Msg, WParam, LParam);

Zitat von milurt:

und das ist wohl ein fehler, denn microsoft
sagt classname muss der 2te parameter sein,

Nein, das sagt Microsoft nicht.
1: ClassName = die Klasse ... Eine der vordefinierten System-Klassen, oder etwas aus RegisterClass/RegisterClassEx
2: WindowName = die Caption

Tipp: Bei Quellcode bitte [CODE]...[/CODE] drumrum. bzw. [DELPHI]...[/DELPHI] für Delphi-Code, damit man es besser lesen kann.

[milurt]

ich hatte bei createwindowex nachgesehen, aber S1 ist wirklich nicht definiert.
ist bei deinem program denn das fenster richtig initialisiert gewesen? warum
hast Du Dir den soviel mühe gemacht?
wie liest man also von der tastatur und maus?

[hoika]

Hallo,

Tastatus: GetAsyncKeyState
https://docs.microsoft.com/en-us/win...tasynckeystate

Maus: WM_MOUSE_X abfangen

[milurt]

jetzt habe ich das und es funktioniert immer noch nicht:

Code:

program bspforum01chg2;

  uses
  wintypes,
  Winprocs;

  Var
    Cls:WNDCLASSEX;
    dk,db,dm:ShortInt;

  Function wndproc(hwnd1:HWND;m,w:word;l:longint):LongInt;stdcall;
  Begin
    wndproc:=DefWindowProc(hwnd1,m,w,l);
  End;

  Function regwin:Integer;
  Begin
    cls.cbSize:=sizeof(cls);
    cls.style:=CS_HREDRAW Or CS_VREDRAW;
    cls.lpfnWndProc:=Addr(wndproc);
    cls.cbClsExtra:=0;
    cls.cbWndExtra:=0;
    cls.hInstance:=GetModuleHandle(nil);; {IH}
    cls.hIcon:=winprocs.LoadIcon(0, IDI_APPLICATION);
    cls.hCursor:=0;
    cls.hCursor:=0;
    cls.hbrBackground:=(14 + 1);
    cls.lpszMenuName:=NiL;
    cls.lpszClassName:='Win here'#0;
    cls.hIconSm:=LoadIcon(cls.hInstance, IDI_APPLICATION);

    regwin:=winprocs.RegisterClassEx(cls);
  End;

  Function creWin:word;
    Var
      s2,s1:pchar;
      wndparent:hwnd;
      menu:hmenu;
      instance:thandle;
      param:pointer;
  Begin
    S1:='STATIC'#0;
    S2:='Win here'#0;
    wndparent:=0;
    menu:=0;
    instance:=0;
    param:=NiL;
    creWin:=winprocs.createwindow(s2,s1,ws_popup,60,40,300,200,
      wndparent,menu,instance,param);
  End;

  Var hwnd1:hwnd;

  procedure draw4(hwnd1:hwnd;x,y,wid,hei:word;r,g,b:byte);
    Var
      DC,bp:HDC;
      xx,yy:LongInt;
      PaintStrc:wintypes.TPAINTSTRUCT;
  Begin
    DC:=winprocs.getdc(hwnd1); {device context of window}
    PaintStrc.hdc:=DC;
    PaintStrc.ferase:=false;
    PaintStrc.rcpaint.left:=0;
    PaintStrc.rcpaint.top:=0;
    PaintStrc.rcpaint.right:=X+wid;
    PaintStrc.rcpaint.bottom:=Y+hei;
    bp:=winprocs.BeginPaint(hwnd1,PaintStrc);
    for yy:=1 To hei Do
      For xx:=1 To wid Do
      Begin
        winprocs.SetPixel(dc,x+xx,y+yy,(((r*256)+g)*256)+b);
      End;
    winprocs.EndPaint(hwnd1,PaintStrc);
    releasedc(hwnd1,dc);
  end;

  var msgptr:tagmsg;
  hAccelTable:Haccel;

  procedure readkm;
  begin
    while GetMessage(msgptr, hwnd1, 0, 0) do
    begin
      if (TranslateAccelerator(msgptr.hwnd, hAccelTable,msgptr))<>0 then begin
        TranslateMessage(msgptr);
        DispatchMessage(msgptr);
      end;
    end;
    case msgptr.message of
      $100:dk:=+1;
      $101:dk:=-1;
      $201:db:=+1;
      $202:db:=-1;
      $200:dm:=-1*dm;
      $204:db:=2;
//      $015:Begin showwindow(hwnd1,sw_show);
//        updatewindow(hwnd1);End;
    end;
  end;

Begin
  dk:=-1;db:=-1;dm:=-1;
  regwin;
  hwnd1:=crewin;
  msgptr.hwnd:=hwnd1;
  showwindow(hwnd1,sw_show);
  updatewindow(hwnd1);
  draw4(hwnd1,00,00,70,30,$40,$40,$40);
  Repeat
    readkm;
    if dk=-1 Then draw4(hwnd1,02,02,20,20,$C0,$00,$00)
      else draw4(hwnd1,02,02,20,20,$80,$80,$00);
    if db=-1 Then draw4(hwnd1,24,02,20,20,$00,$C0,$00)
      else draw4(hwnd1,24,02,20,20,$00,$80,$80);
    if dm=-1 Then draw4(hwnd1,46,02,20,20,$00,$00,$C0)
      else draw4(hwnd1,46,02,20,20,$80,$00,$80);
  Until db=2;
end.

[TurboMagic]

Vielleicht ist es einfacher wenn du uns sagst mit welcher Delphi Version du was erreichen willst? Evtl. ist dann ein ganz anderer Ansatz der richtige..?

[himitsu]

Zitat:

Vielleicht ist es einfacher wenn du uns sagst mit welcher Delphi Version du was erreichen willst? Evtl. ist dann ein ganz anderer Ansatz der richtige..?

joar

Zitat:

wie

Auf die Messages reagieren
oder GetAsyncKeyState
oder GetKeyState (innerhalb irgendeiner Message)
oder anderes Zeugs, z.B. aus DirectX und Co.


So wie in #3 (mit Message-Loop und der richtigen registrieren Klasse) funktioniert es, in halbwegs aktuellen Windowsen und in allen Delphis der letzten 15 Jahre und vermutlich auch mehr.



Was macht im readkm das CASE außerhalb der Schleife?


zum Code aus #8:
Wenn jemand (DU) den Debugger benutzten würde,
dann viele vielleicht auf, dass das Programm im CreateWindow in creWin hängen bleibt
und nachfolgend natürlich die externe Messagebeandlung & Tastenprüfung demnach auch garnichts machen kann.

Und ab Delphi 11 bekommt man auch noch wunderschön einen RuntimError 201 um die Ohren gehauen,
da dort die Bereichsprüfung (RangeCheck) nun im Debug-Profil standardmäßig aktiv ist.




Und wer ein eigentliches "HauptFenster" als Popup (WS_POPUP) deklariert, der braucht sich nicht wundern, wenn es etwas "anders" auf Tastatur/Maus/Fokusteuerung reagiert.




PeekMessage ohne Pausen, lässt die CPU nur ein bissl unnötig viel arbeiten.

PeekMessage+MsgWaitForMultipleObjects (siehe Delay) oder GetMessage sind da sparsamer. (aber funktionell ist es erstmal egal)







Lesetipps:

https://www.delphi-treff.de/tutorial...ierung/nonvcl/

und auch mal da durchstöbern

https://www.michael-puff.de/ (das menü unten funktioniert nicht mehr, daher siehe nachfolgenden Link)
http://web.archive.org/web/201804300...chael-puff.de/



PS: Wenn wndprocnur noch DefWindowProc macht, dann kann man das auch gleich ganz weglassen.