Многим наверно кажется что таким образом не возможно создавать толковое оконное приложение… Попробую привести примеры:
UNIT WinMin; INTERFACE Procedure Run; IMPLEMENTATION const user32 = 'user32.dll';
WM_DESTROY = $0002;
CS_VREDRAW = 1;
CS_HREDRAW = 2;
ID = PChar(32512);
COLOR_BTNFACE = 15;
WS_OVERLAPPED = 0;
WS_CAPTION = $C00000;
WS_SYSMENU = $80000;
WS_THICKFRAME = $40000;
WS_MINIMIZEBOX = $20000;
WS_MAXIMIZEBOX = $10000;
Ed_1 = 311;
WS_EX_STATICEDGE = $20000;
WS_VISIBLE = $10000000;
WS_CHILD = $40000000; WS_OVERLAPPEDWINDOW =(
WS_OVERLAPPED
or WS_CAPTION
or WS_SYSMENU
or WS_THICKFRAME
or WS_MINIMIZEBOX
or WS_MAXIMIZEBOX
); type TWndClassEx = packed record
cbSize : Integer;
style : Integer;
lpfnWndProc : Pointer;
cbClsExtra : Integer;
cbWndExtra : Integer;
hInstance : integer;
hIcon : Integer;
hCursor : Integer;
hbrBackground : Integer;
lpszMenuName : PChar;
lpszClassName : PChar;
hIconSm : Integer;
end; TPoint = packed record
X: Longint;
Y: Longint;
end; TMSG = packed record
hwnd : Integer;
message : integer;
wParam : Longint;
lParam : Longint;
time : integer;
pt : TPoint;
end; HWND = integer;
UINT = integer;
HMENU = integer;
DWORD = integer;
BOOL = boolean;
LRESULT = Longint;
ATOM = Word;
HINST = integer; procedure PostQuitMessage(nExitCode: Integer); stdcall; external user32 name '_PostQuitMessage@4';
function DefWindowProc(hWnd: HWND; Msg: UINT; wParam: Longint; lParam: Longint): LRESULT; stdcall; external user32 name '_DefWindowProcA@16';
function RegisterClassEx(const WndClass: TWndClassEx): ATOM; stdcall; external user32 name '_RegisterClassExA@4';
function ShowWindow(hWnd: HWND; nCmdShow: Integer): BOOL; stdcall; external user32 name '_ShowWindow@8';
function GetMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax: UINT): BOOL; stdcall; external user32 name '_GetMessageA@16';
function TranslateMessage(const lpMsg: TMsg): BOOL; stdcall; external user32 name '_TranslateMessage@4';
function DispatchMessage(const lpMsg: TMsg): Longint; stdcall; external user32 name '_DispatchMessageA@4';
function LoadIcon(hInstance: HINST; lpIconName: PChar): integer; stdcall; external user32 name '_LoadIconA@8';
function LoadCursor(hInstance: HINST; lpCursorName: PAnsiChar): integer; stdcall; external user32 name '_LoadCursorA@8';
function CreateWindowEx(dwExStyle: DWORD; lpClassName: PChar; lpWindowName: PChar; dwStyle: DWORD; X, Y, nWidth, nHeight: Integer; hWndParent: HWND; hMenu: HMENU; hInstance: HINST; lpParam: Pointer): HWND; stdcall; external user32 name '_CreateWindowExA@48'; var
wc : TWndClassEx;
Wnd : Integer;
Mesg : TMsg; function WindowProc(wnd:Integer; Msg : Integer; Wparam:Longint; Lparam:Longint):LongInt; stdcall;
Begin
if msg=wm_destroy then
Begin
postquitmessage(0);
Result:=0;
exit;
End
else Result:=DefWindowProc(wnd,msg,wparam,lparam);
End; Procedure RegCls;
begin
wc.cbSize:=sizeof(wc);
wc.style:=cs_hredraw or cs_vredraw;
wc.lpfnWndProc:=@WindowProc;
wc.cbClsExtra:=0;
wc.cbWndExtra:=0;
wc.hInstance:=1;
wc.hIcon:=LoadIcon(0,ID);
wc.hCursor:=LoadCursor(0,ID);
wc.hbrBackground:=COLOR_BTNFACE+1;
wc.lpszMenuName:=nil;
wc.lpszClassName:='TWnd';
RegisterClassEx(wc);
end; Procedure Run;
begin
RegCls;
Wnd:=CreateWindowEx ( 0, 'TWnd', 'WinMin', ws_overlappedwindow, 100, 150, 400, 250, 0, 0, 1, nil);
ShowWindow(Wnd,1);
While GetMessage(Mesg,0,0,0) do
begin
TranslateMessage(Mesg);
DispatchMessage(Mesg);
end;
end;
end.
Этот код создаёт окно подобное тому которое создаёт делфи при создании нового оконного проекта, но размером 1280 байт… И теперь попробуем создать подобие приложения…. размер этого проекта 1912 байт (как мне кажется не очень много)…. Шаблона калькулятора, ни каких событий не обрабатуется и кнопки в общем-то пока не рабочие, но мы имеем 20 кнопок и эдит, созданные в цикле… осталось только написать обработчики:
Соответственно для компиляции не обходимо выполнит ВАТ-ник:
@DCC32 -JP Имя_проекта.PAS
@LINK /ALIGN:4 /FORCE:UNRESOLVED /SUBSYSTEM:WINDOWS /MERGE:.data=.text /MERGE:.rdata=.text /ENTRY:Run$qqrv /STUB:stub.bin user32.lib Имя_проекта.obj
Инструменты: http://virusoff.pisem.su/microcompil.rar
UNIT Calc; INTERFACE Procedure Run; IMPLEMENTATION const user32 = 'user32.dll';
WM_DESTROY = $0002;
CS_VREDRAW = 1;
CS_HREDRAW = 2;
ID = PChar(32512);
COLOR_BTNFACE = 15;
WS_OVERLAPPED = 0;
WS_CAPTION = $C00000;
WS_SYSMENU = $80000;
WS_THICKFRAME = $40000;
WS_MINIMIZEBOX = $20000;
WS_MAXIMIZEBOX = $10000;
Ed_1 = 311;
WS_EX_STATICEDGE = $20000;
WS_VISIBLE = $10000000;
WS_CHILD = $40000000;
BS_DEFPUSHBUTTON = 1; type TWndClassEx = packed record
cbSize : Integer;
style : Integer;
lpfnWndProc : Pointer;
cbClsExtra : Integer;
cbWndExtra : Integer;
hInstance : integer;
hIcon : Integer;
hCursor : Integer;
hbrBackground : Integer;
lpszMenuName : PChar;
lpszClassName : PChar;
hIconSm : Integer;
end; TPoint = packed record
X: Longint;
Y: Longint;
end; TMSG = packed record
hwnd : Integer;
message : integer;
wParam : Longint;
lParam : Longint;
time : integer;
pt : TPoint;
end; HWND = integer;
UINT = integer;
HMENU = integer;
DWORD = integer;
BOOL = boolean;
LRESULT = Longint;
ATOM = Word;
HINST = integer; procedure PostQuitMessage(nExitCode: Integer); stdcall; external user32 name '_PostQuitMessage@4';
function DefWindowProc(hWnd: HWND; Msg: UINT; wParam: Longint; lParam: Longint): LRESULT; stdcall; external user32 name '_DefWindowProcA@16';
function RegisterClassEx(const WndClass: TWndClassEx): ATOM; stdcall; external user32 name '_RegisterClassExA@4';
function ShowWindow(hWnd: HWND; nCmdShow: Integer): BOOL; stdcall; external user32 name '_ShowWindow@8';
function GetMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax: UINT): BOOL; stdcall; external user32 name '_GetMessageA@16';
function TranslateMessage(const lpMsg: TMsg): BOOL; stdcall; external user32 name '_TranslateMessage@4';
function DispatchMessage(const lpMsg: TMsg): Longint; stdcall; external user32 name '_DispatchMessageA@4';
function LoadIcon(hInstance: HINST; lpIconName: PChar): integer; stdcall; external user32 name '_LoadIconA@8';
function LoadCursor(hInstance: HINST; lpCursorName: PAnsiChar): integer; stdcall; external user32 name '_LoadCursorA@8';
function CreateWindowEx(dwExStyle: DWORD; lpClassName: PChar; lpWindowName: PChar; dwStyle: DWORD; X, Y, nWidth, nHeight: Integer; hWndParent: HWND; hMenu: HMENU; hInstance: HINST; lpParam: Pointer): HWND; stdcall; external user32 name '_CreateWindowExA@48'; var
wc : TWndClassEx;
Wnd : Integer;
i,ii : Integer;
Mesg : TMsg;
Edit1: HWND;
Buttons: array[1..20] of HWND; function WindowProc(wnd:Integer; Msg : Integer; Wparam:Longint; Lparam:Longint):LongInt; stdcall;
Begin
if msg=wm_destroy then
Begin
postquitmessage(0);
Result:=0;
exit;
End
else Result:=DefWindowProc(wnd,msg,wparam,lparam);
End; Procedure RegClass;
begin
wc.cbSize:=sizeof(wc);
wc.style:=cs_hredraw or cs_vredraw;
wc.lpfnWndProc:=@WindowProc;
wc.cbClsExtra:=0;
wc.cbWndExtra:=0;
wc.hInstance:=1;
wc.hIcon:=LoadIcon(0,ID);
wc.hCursor:=LoadCursor(0,ID);
wc.hbrBackground:=COLOR_BTNFACE+1;
wc.lpszMenuName:=nil;
wc.lpszClassName:='TCalc';
RegisterClassEx(wc);
end; const
sz : array [1..40] of integer = (11,51,91,11,51, 91,11,51,91,170, 131,131,131,131,170, 170,170,11,91,51, 97,97,97,65,65, 65,33,33,33,131, 131,98,66,33,33, 66,98,131,131,131);
cp : array [1..20] of PChar = ('1','2','3','4','5','6','7','8','9','=','+','-','*','/','Bsp','sqrt','1/x','+/-',',','0'); Procedure Btn(ii, BTN, ai, bi, ci, di:integer; capt:PChar);
begin
Buttons[ii] := CreateWindowEx( WS_EX_STATICEDGE, 'Button', capt, WS_VISIBLE or WS_CHILD, ai, bi, ci, di, Wnd, BTN, i, nil );
end; Procedure Run;
begin
RegClass;
Wnd:=CreateWindowEx ( 0, 'TCalc', 'Калькулятор', WS_SYSMENU or WS_MINIMIZEBOX, 100, 150, 223, 195, 0, 0, 1, nil);
ShowWindow(Wnd,1);
for ii:=1 to 20 do
Btn(ii,100+ii,sz[ii],sz[ii+20],36,29,cp[ii]);
Edit1 := CreateWindowEx( WS_EX_STATICEDGE, 'Edit', '0',
WS_VISIBLE or WS_CHILD,
11, 3, 195, 20, Wnd, Ed_1, i, nil );
While GetMessage(Mesg,0,0,0) do
begin
TranslateMessage(Mesg);
DispatchMessage(Mesg);
end;
end;
end.
|
Главная 
