Thema: Delphi wndproc geht nicht

Einzelnen Beitrag anzeigen

milurt

Registriert seit: 16. Dez 2020
30 Beiträge
 
#8

AW: wndproc geht nicht

  Alt 20. Jun 2022, 12:03
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.
  Mit Zitat antworten Zitat