分享:可在Delphi XE3下過的 win32 generic.dpr

看板Programming作者 (三重國小旁的鄉民)時間13年前 (2012/10/11 11:08), 編輯推噓0(001)
留言1則, 1人參與, 最新討論串1/1
程式從 win16 就有的 改一改 昨天趕在 XE3 試用期到前,試了一下下 可以跑 win32 有30k的執行檔 win64 有62k的執行檔 沒用的程式,就分享一下 // 2013.6.20. XE4 compiler pass program generic; {$APPTYPE GUI} {$R *.res} uses system.types, winapi.windows, winapi.messages; const AppName = 'Generic'; CW_USEDEFAULT = $8000; CmdShow= SW_SHOW ; var HInstance:tHandle; logFont:TLOGFONT ; hFont:thandle ; function WindowProc(Window: HWnd; Message:longint; WParam: wparam; LParam: Lparam): Lresult;stdcall; export; var ps:tpaintstruct; dc:hdc; rect:trect; begin result := 0; case Message of wm_create: begin logFont.lfHeight :=18; logFont.lfWidth := 0; logFont.lfEscapement := 0; logFont.lfOrientation := 0; logFont.lfWeight := FW_REGULAR; logFont.lfItalic := 0; logFont.lfUnderline := 0; logFont.lfStrikeOut := 0; logFont.lfCharSet := CHINESEBIG5_CHARSET; logFont.lfOutPrecision := OUT_DEFAULT_PRECIS; logFont.lfClipPrecision := CLIP_DEFAULT_PRECIS; logFont.lfQuality := PROOF_QUALITY; logFont.lfPitchAndFamily := VARIABLE_PITCH; logFont.lfFaceName:='Tahoma'; exit; end; wm_paint: begin dc:=beginpaint(window,ps); GetclientRect(window,rect); hFont := CreateFontIndirect(&logFont); SelectObject(dc,hFont); drawtext(dc,'嗨, 大家好',-1,rect,0); DeleteObject(hFont); endpaint(window,ps); exit; end; wm_Destroy: begin PostQuitMessage(0); Exit; end; end; result := DefWindowProc(Window, Message, WParam, LParam); end; procedure WinMain; var Window: HWnd; Msg: TMsg; WindowClass: TWndClassex; begin Windowclass.cbSize := sizeof (Windowclass) ; WindowClass.style:= cs_hredraw or cs_vredraw;; WindowClass.lpfnWndProc:= @WindowProc; WindowClass.cbClsExtra:= 0; WindowClass.cbWndExtra:= 0; WindowClass.hInstance:= HInstance; WindowClass.hIcon:= LoadIcon(0, 'main_icon'); WindowClass.hCursor:= LoadCursor(0, idc_Arrow); WindowClass.hbrBackground:= GetStockObject(white_BRUSH); WindowClass.lpszMenuName:= AppName; WindowClass.lpszClassName:= AppName; WindowClass.hInstance := HINST(HInstance); WindowClass.hIconSm:= LoadIcon(0, MakeIntResource(32516)); if RegisterClassex(WindowClass)=0 then Halt(255); Window := CreateWindowex( WS_EX_OVERLAPPEDWINDOW , AppName, 'Delphi Generic', ws_OverlappedWindow , cw_UseDefault, cw_UseDefault, cw_UseDefault, cw_UseDefault, 0, 0, HInstance, nil); ShowWindow(Window, CmdShow); UpdateWindow(Window); while GetMessage(Msg, 0, 0, 0) do begin TranslateMessage(Msg); DispatchMessage(Msg); end; Halt(Msg.wParam); end; begin WinMain; end. -- ※ 發信站: 批踢踢實業坊(ptt.cc) ◆ From: 123.204.28.209

10/11 11:14, , 1F
過陣子就又得改成 Free Pascal編譯得過的了
10/11 11:14, 1F
※ 編輯: gg3210 來自: 123.204.111.192 (06/21 06:49)
文章代碼(AID): #1GTZWpWH (Programming)
文章代碼(AID): #1GTZWpWH (Programming)