作者gg3210 (三重国小旁的乡民)
看板Programming
标题分享:可在Delphi XE3下过的 win32 generic.dpr
时间Thu Oct 11 11:08:32 2012
程式从 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
1F：→ gg3210:过阵子就又得改成 Free Pascal编译得过的了 123.204.28.209 10/11 11:14
※ 编辑: gg3210 来自: 123.204.111.192 (06/21 06:49)