Lazarus

Programming => Operating Systems => Windows => Topic started by: Goodman H__ on May 23, 2011, 08:43:08 am

Title: Pure win32 api created app issue
Post by: Goodman H__ on May 23, 2011, 08:43:08 am
Just realized previously posted to the wrong place so I remove the previous one and re-post here to get help.

The issue is when I test mouse left click & mouse move event,under xp mouse left click event  works only very rare case.Mouse move event does not work.Under win  7 both don't work.
The mouse I use is a 3 button mouse,that is,there is a middle button there.

Can anybody figure me out what the problem could be?Thanks in advance.

Code: [Select]
program sdkApp;
uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Interfaces, // this includes the LCL widgetset
  Forms,windows,lconvencoding;

{$R *.res}


const
  AppName = 'ObjectPascalHello';

function WindowProc(Window: HWnd; AMessage: UINT; WParam : WPARAM;
                    LParam: LPARAM): LRESULT; stdcall;

  var
     dc : hdc;
     ps : TPaintStruct;
     r : TRect;
     msg:string;

begin
  WindowProc := 0;

  case AMessage of
    WM_PAINT :
      begin
          msg:='使用WIN32 API 创建Native Windows Program.';
         dc := BeginPaint(Window,ps);
         GetClientRect(Window,r);
         DrawText(dc,pchar(utf8tocp936(msg)),-1,r,
           DT_SINGLELINE or DT_CENTER or DT_VCENTER);
         EndPaint(Window,ps);
         Exit;
      end;
    WM_MOUSEMOVE :
      begin
         dc := BeginPaint(Window,ps);
         GetClientRect(Window,r);
         DrawText(dc,pchar(utf8tocp936('移动了Mouse')),-1,r,
           DT_SINGLELINE or DT_CENTER or DT_VCENTER);
         EndPaint(Window,ps);
         Exit;
      end;
    WM_LBUTTONDOWN :
      begin
         dc := BeginPaint(Window,ps);
         GetClientRect(Window,r);
         DrawText(dc,pchar(utf8tocp936('点击了Mouse')),-1,r,
           DT_SINGLELINE or DT_CENTER or DT_VCENTER);
         EndPaint(Window,ps);
         Exit;
      end;
    wm_Destroy:
      begin
         PostQuitMessage(0);
         Exit;
      end;
  end;

  WindowProc := DefWindowProc(Window, AMessage, WParam, LParam);
end;

 { Register the Window Class }
function WinRegister: Boolean;
var
  WindowClass: WndClass;
begin
  WindowClass.Style := cs_hRedraw or cs_vRedraw;
  WindowClass.lpfnWndProc := @WindowProc;
  WindowClass.cbClsExtra := 0;
  WindowClass.cbWndExtra := 0;
  WindowClass.hInstance := system.MainInstance;
  WindowClass.hIcon := LoadIcon(0, idi_Application);
  WindowClass.hCursor := LoadCursor(0, idc_Arrow);
  WindowClass.hbrBackground := GetStockObject(WHITE_BRUSH);
  WindowClass.lpszMenuName := nil;
  WindowClass.lpszClassName := AppName;

  Result := RegisterClass(WindowClass) <> 0;
end;

 { Create the Window Class }
function WinCreate: HWnd;
var
  hWindow: HWnd;
begin
  hWindow := CreateWindow(AppName, 'Hello world Object Pascal program',
              ws_OverlappedWindow, cw_UseDefault, cw_UseDefault,
              cw_UseDefault, cw_UseDefault, 0, 0, system.MainInstance, nil);

  if hWindow <> 0 then begin
    ShowWindow(hWindow, CmdShow);
    ShowWindow(hWindow, SW_SHOW);
    UpdateWindow(hWindow);
  end;

  Result := hWindow;
end;


var
  AMessage: TMsg;
  hWindow: HWnd;

begin
  if not WinRegister then begin
    MessageBox(0, 'Register failed', nil, mb_Ok);
    Exit;
  end;
  hWindow := WinCreate;
  if longint(hWindow) = 0 then begin
    MessageBox(0, 'WinCreate failed', nil, mb_Ok);
    Exit;
  end;

  while GetMessage(AMessage, 0, 0, 0) do begin
    TranslateMessage(AMessage);
    DispatchMessage(AMessage);
  end;
  Halt(AMessage.wParam);
end.
                                                 
Title: Re: Pure win32 api created app issue
Post by: Laksen on May 23, 2011, 09:48:46 am
I think the problem lies in that BeginPaint/EndPaint only should be used in response to WM_PAINT(that's what MSDN says).

The following works fine for me:
Code: [Select]
    WM_MOUSEMOVE :
      begin
         dc := GetDC(Window);
         GetClientRect(Window,r);
         DrawText(dc,pchar(utf8tocp936('移动了Mouse')),-1,r,
           DT_SINGLELINE or DT_CENTER or DT_VCENTER);
         ReleaseDC(window,dc);
         Exit;
      end;
    WM_LBUTTONDOWN :
      begin
         dc := GetDC(Window);
         GetClientRect(Window,r);
         DrawText(dc,pchar(utf8tocp936('点击了Mouse')),-1,r,
           DT_SINGLELINE or DT_CENTER or DT_VCENTER);
         ReleaseDC(window,dc);
         Exit;
      end;
Title: Re: Pure win32 api created app issue
Post by: Goodman H__ on May 23, 2011, 11:04:22 am
I think the problem lies in that BeginPaint/EndPaint only should be used in response to WM_PAINT(that's what MSDN says).

The following works fine for me:
Code: [Select]
    WM_MOUSEMOVE :
      begin
         dc := GetDC(Window);
         GetClientRect(Window,r);
         DrawText(dc,pchar(utf8tocp936('移动了Mouse')),-1,r,
           DT_SINGLELINE or DT_CENTER or DT_VCENTER);
         ReleaseDC(window,dc);
         Exit;
      end;
    WM_LBUTTONDOWN :
      begin
         dc := GetDC(Window);
         GetClientRect(Window,r);
         DrawText(dc,pchar(utf8tocp936('点击了Mouse')),-1,r,
           DT_SINGLELINE or DT_CENTER or DT_VCENTER);
         ReleaseDC(window,dc);
         Exit;
      end;

Thank you so much!It works for me also.
TinyPortal © 2005-2018