unit ow;

interface

uses Windows;

 

Type

   TWindowAttr = record

   Title: PChar;

   Style: Longint;

   ExStyle: Longint;

   X, Y, W, H: Integer;

   Menu:HMenu;

   end;

 

Pwindow=^TWindow;

TWindow= object

HWindow,ParentWindow:HWnd;

CHief:PWindow;

wndClass:TwndClass;

Attr:TwindowAttr;

constructor Init(PChief:PWindow);

destructor Done;virtual;

Function AcceptMessage(Window: HWnd; AMessage :word; WParam, LParam: Longint):longint;virtual;

procedure Create(HParent:HWnd);virtual;

end;

 

procedure runapplication(MainWindow:Pwindow);

implementation

 

function WindowProc(Window: HWnd; AMessage :word; WParam,LParam: Longint): longint; stdcall;

var Pw:Pwindow;

begin

if Amessage=wm_create then begin

pw:=pcreatestruct(Lparam).lpCreateParams;

pw^.HWindow:=Window;

setWindowLong(Window,gwl_UserData,longint(pw));

end;

pw:=pointer(getwindowlong(window,gwl_Userdata));

if pw<>nil then windowproc:=pw^.AcceptMessage(Window,Amessage,wparam,lparam)

else windowProc:=defwindowproc(window,Amessage,wparam,lparam);

end;

 

constructor Twindow.init(PChief:PWindow);

begin

  WndClass.Style := cs_hRedraw or cs_vRedraw;

  WndClass.lpfnWndProc := @WindowProc;

  WndClass.cbClsExtra := 0;

  WndClass.cbWndExtra := 0;

  WndClass.hInstance := HInstance;

  WndClass.hIcon := LoadIcon(0, idi_Application);

  WndClass.hCursor := LoadCursor(0, idc_Arrow);

  WndClass.hbrBackground := color_window;

  WndClass.lpszMenuName := nil;

  wndClass.lpszClassName := 'zenIA';

  attr.Title:='Main Window';

  attr.Style:=ws_visible or ws_overlappedwindow;

  attr.ExStyle:= 0;

  attr.X:=cw_UseDefault;

  attr.Y:=cw_UseDefault;

  attr.w:=cw_UseDefault;

  attr.H:=cw_UseDefault;

  attr.Menu:=0;

  Chief:=PChief;

end;

 

destructor TWindow.done;

begin

DestroyWindow(HWindow);

end;

 

function TWindow.AcceptMessage(Window: HWnd; AMessage :word; WParam, LParam: Longint):longint;

begin

AcceptMessage:=0;

case AMessage of

wm_destroy:begin postquitmessage(0);exit;end;

wm_create: begin exit; end;

end;

AcceptMessage:=defwindowproc(window,Amessage,wparam,lparam);

end;

 

procedure TWindow.Create(HParent:Hwnd);

var wnd:TWndClass;

begin

ParentWindow:=HParent;

registerClass(wndClass);

CreatewindowEx(Attr.ExStyle,wndClass.lpszClassName,Attr.Title,attr.style,attr.x,

attr.y,attr.w,attr.h,ParentWindow,attr.menu,Hinstance,@self);

end;

 

procedure runapplication(MainWindow:Pwindow);

var AMessage:TMsg;

begin

MainWindow^.create(0);

UpdateWindow(MainWindow^.hWindow);

while GetMessage(AMessage, 0, 0, 0) do begin

TranslateMessage(AMessage);

DispatchMessage(AMessage);

end;

end;

 

begin

end.

var w:Twindow;

begin

w.init(nil);

w.attr.title:=’Hello Word!’;

RunApplication(@W);

end.

uses OW, Windows;

 

type {тип дочернего оконного объекта}

tChildWindow=object(TWindow)

constructor Init(pChief:Pwindow);

function AcceptMessage(Window:HWnd;AMessage:Word;WParam,LParam:longint):longint;virtual;

end;

 

constructor tChildWindow.Init(pChief:Pwindow);

begin

inherited init(PChief);

with Attr do

begin

Style:=ws_child or ws_visible or ws_dlgframe; {окно является дочерним, видимым и окружено толстой рамкой}

{далее устанавливаются положение и размеры дочернего окна}

x:=10;

y:=10;

w:=100;

h:=75;

end;

end;

 

{Функция обработки сообщений}

function tchildWindow.AcceptMessage(Window:HWnd;AMessage:Word;WParam,LParam:longint):longint;

begin

AcceptMessage:=0;

case Amessage of

{в ответ на получение сообщения в случае нажатия девой клавиши мыши выводится соответствующее сообщение}

wm_lButtonDown:begin MessageBox(HWindow,'Вы нажали левую клавишу мыши','Зафиксировано сообщение',mb_iconexclamation);exit;end;

end;

AcceptMessage:=DefWindowProc(Window,AMessage,WParam,LParam);

end;

 

{тип главного окна окна}

type

tMainWindow=object(TWindow)

Brush:Hbrush; {кисть, которой будет закрашен фон главного окна}

pChild:^tChildWindow; {указатель на тип дочернего оконного объекта}

constructor Init(pChief:Pwindow);

destructor done;virtual;

function AcceptMessage(Window:HWnd;AMessage:Word;WParam,LParam:longint):longint;virtual;

end;

 

constructor tMainWindow.Init(pChief:Pwindow);

begin

inherited init(PChief);

{создаем непрерывную кисть оранжевого цвета}

Brush:=CreatesolidBrush({text}bbff);

{хендл кисти соответствующему полю переменной wndClass}

wndClass.hbrBackground:=brush;

{необходимо изменить имя оконного класса, так как хочется, чтобы иные окна создаваемыми производными от tWindow сохраняли первоначальные свойства (в данном случае серый цвет)}

wndclass.lpszClassName:='PARENT';

{изменяем заголовок окна}

attr.title:='Нас не подолати!';

{создаем экземпляр оконного объекта дочернего окна}

New(pChild,init(@self));

end;

 

destructor tMainWindow.done;

begin

{создаваемые объекты, в том числе и кисти надо убирать после использования}

deleteobject(Brush);

{освобождаем память занятую дочерним оконным объектом}

dispose(pChild,done);

end;

 

{Функция обработки сообщений}

function tMAinWindow.AcceptMessage(Window:HWnd;AMessage:Word;WParam,LParam:longint):longint;

begin

AcceptMessage:=0;

case Amessage of

{если получено сообщение о создании главного окна создаем и дочернее}

wm_create:begin pChild.Create(HWindow);exit;end;

{если получено сообщение о разрушении главного окна, вызываем деструктор оконного объекта и завершаем приложение}

wm_destroy: begin done; PostQuitMessage(0);exit;end;

end;

AcceptMessage:=DefWindowProc(Window,AMessage,WParam,LParam);

end;

 

{экземпляр главного оконного объекта}

var MAinWindow:TMainWindow;

begin

MainWindow.init(nil);

runApplication(@Mainwindow);

end.