Object Pascal開發windows原生程式

program Project1;

uses
  Windows ,Messages ,SysUtils;
const
  appname='fancydemo';
  function windowproc(window:HWND ;amessage:UINT ;wparam:WPARAM ;
  lparam:LPARAM ):LRESULT ;stdcall ;export ;
  var
    dc:HDC ;
    ps:TPaintStruct ;
    r:TRect ;

begin
  windowproc:=0;
  case amessage of
  WM_PAINT :
  begin
    dc:=BeginPaint(window ,ps);
    GetClientRect(window ,r);
    DrawText(dc,'op 語言寫的windows程式',-1,r,DT_SINGLELINE or DT_CENTER );
    EndPaint(window ,ps);
    exit;
  end;
  WM_DESTROY :
  begin
    PostQuitMessage(0);
    Exit;
  end;
  end;
  windowproc:=DefWindowProc(window,amessage ,wparam ,lparam );
end;
     function winregister:Boolean ;
     var
       windowclass:WNDCLASS ;
       begin
         windowclass .style :=CS_HREDRAW or CS_VREDRAW ;
         windowclass .lpfnWndProc :=TFNWndProc(@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;
       function wincreate:HWND ;
       var
        hwindow:HWND ;
        begin
          hwindow :=CreateWindow(appname ,'hello,fancy',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.