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.
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.
Recent
