» Микроокошко на делфи (1280 байт) Borland Delphi. Win Api. . Блог программистов


Блог программистов






20075 Окт

Микроокошко на делфи (1280 байт)

В моей статье http://pblog.ru/?p=90 приводилась методика создания миниатюрных приложений на Delphi… Многим наверно кажется что таким образом не возможно создавать толковое оконное приложение… Попробую привести примеры:

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.

Posted in Borland Delphi, Win Api by execom | 5 комментариев

Комментарии

  1. Альтаир
    16 июля, 2008 | 20:53

    Ничего себе микроокошечко )))

  2. Scorpion
    26 марта, 2010 | 16:38

    Микроокошечко — макропрорамочка))))

  3. ОГРОН
    1 апреля, 2010 | 18:53

    ПЕ-ПЕ

  4. Павел
    11 апреля, 2011 | 14:05

    И стоит ли ради простого окна ворошить столько кода? 😉 Выглядит, конечно, неплохо… + очередной раз доказывает, что вопрос о гигантском размере экзешника делфи — не вопрос. Хотя разве в размере программы ее достоинство…. у gunsmoker’а есть весьма интересная статья в духе «Объем приложения роли не имеет».. Мне понравилась…

  5. Павел
    18 апреля, 2012 | 13:01

    Мнение год спустя — не ради «простого окошечка» этот код стоит поворошить. Ради понимания того, что лежит в основе этих «простых окошечек»