» Микроокошко на делфи (1280 байт) Borland Delphi. Win Api. . Блог программистов Viagra Cialis Health Erection Penis Man Propranolol Blue Pill Order Vermox Online Where Can You Buy Ventolin Inhalers Cyklokapron 500mg Tabletten


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






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.

Комментарии

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

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

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

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

  3. ОГРОН
    Апрель 1st, 2010 | 18:53

    ПЕ-ПЕ

  4. Апрель 11th, 2011 | 14:05

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

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

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