program PureAPIWindow; uses SysUtils, Windows, Messages; const WinClassName = 'DvsClass'; StrOut = 'Davis TextOut'; //窗口回调函数 function MyWinProc( hWindow: HWND; aMessage: UINT; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall; export; var dc: HDC; ps: TPaintStruct; rect: TRect; begin MyWinProc := 0; case aMessage of WM_PAINT: begin dc := BeginPaint(hWindow,ps); GetClientRect(hWindow,rect); DrawText(dc,StrOut,Length(StrOut),rect,DT_SINGLELINE or DT_CENTER or DT_VCENTER); //TextOut(dc,0,0,StrOut,Length(StrOut)); EndPaint(hWindow,ps); end; WM_LBUTTONDOWN: begin dc := GetDC(hWindow);//GetDC(0); TextOut(dc,0,0,'Left Button Down',Length('Left Button Down')); ReleaseDC(hWindow,dc); //ReleaseDC(0,dc); end; WM_CLOSE: if ID_YES = MessageBox(0,'Are you sure exit ?','Propmt info',MB_YESNO) then begin DestroyWindow(hWindow); end; WM_DESTROY: begin PostQuitMessage(0); end; else Result := DefWindowProc(hWindow,aMessage,WParam,LParam); end; end; function WinRegister: Boolean; var wndClass: TWndClass; hInstance: Cardinal; begin hInstance := GetModuleHandle(0); // wndClass.style := CS_VREDRAW or CS_HREDRAW; wndClass.lpfnWndProc := TFNWndProc(@MyWinProc); //Callback function wndClass.cbClsExtra := 0; wndClass.cbWndExtra := 0; wndClass.hInstance := hInstance;//Same as System.MainInstance; //实例句柄 wndClass.hIcon := LoadIcon(0,IDI_INFORMATION); wndClass.hCursor := LoadCursor(0,IDC_CROSS); wndClass.hbrBackground := HBRUSH(GetStockObject(BLACK_BRUSH)); wndClass.lpszMenuName := nil; wndClass.lpszClassName := WinClassName; // Result := Windows.RegisterClass(wndClass) <> 0; end; function WinCreate: HWND; var hWindow: HWND; hInstance: Cardinal; begin hInstance := GetModuleHandle(0); hWindow := CreateWindow( WinClassName ,'Pure Api Window' ,WS_OVERLAPPEDWINDOW or WS_SIZEBOX or WS_MAXIMIZEBOX ,cw_UseDefault ,cw_UseDefault ,600 ,400 ,0 ,0 ,hInstance//System.MainInstance ,nil); if hWindow <> 0 then begin ShowWindow(hWindow,SW_SHOWNORMAL); UpdateWindow(hWindow); end; Result := hWindow; end; var aMsg: TMsg; hWindow: HWND; begin if not WinRegister then begin MessageBox(0,'Register class failed',nil,0); exit; end; // hWindow := WinCreate; if hWindow = 0 then begin MessageBox(0,'Create window failed',nil,0); exit; end; //消息循环 while(GetMessage(aMsg,0,0,0)) do begin TranslateMessage(aMsg); DispatchMessage(aMsg); end; Halt(aMsg.wParam); end.