Обрамление KOL формы.

← →
Watcher (2005-03-05 01:44) [0]

Доброе время суток. Мне необходимо создать обрамление формы, причем за ее пределами. Реализация с использованием KOL вызывает у меня затруднения. Привожу "свою версию". Буду признателен за помощь.

type
PForm1=^TForm1;
TForm1=object(TObj)
Form: PControl;
private
procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
public
end;

procedure NewForm1(var Result: PForm1; AParent: PControl);

var
Form1: PForm1;

implementation

procedure NewForm1(var Result: PForm1; AParent: PControl);
begin
New(Result,Create);
with Result^ do
begin
Form:=NewForm(AParent,"Form1").SetSize(400,210);
Applet:=Form
end
end;

procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
var
DC: HDC;
Pen,Pen1: hPen;
Brush1: hBrush;
Handle: THandle;
Canvas: TCanvas;
begin
inherited;
DC:=GetWindowDC(Handle);
Msg.Result:=1;
Pen:=CreatePen(PS_SOLID,10,RGB(0,255,0));
Pen1:=SelectObject(DC,Pen);
Brush1:=SelectObject(DC,GetStockObject(NULL_BRUSH));
Rectangle(DC,0,0,Form.Width,Form.Height);
SelectObject(DC,Brush1);
SelectObject(DC,Pen1);
DeleteObject(Pen);
ReleaseDC(Handle,Canvas.Handle)
end;

← →
thaddy (2005-03-05 06:19) [1]

Like this:

[CODE]

unit Unit_test1;

interface
uses
Windows, Messages, Kol;

type
PForm1=^TForm1;
TForm1=object(Tobj)
Form:pControl;
public
// Add your eventhandlers here, example:
function DoMessage(var Msg:Tmsg;var Rslt:integer):boolean;
end;

procedure NewForm1( var Result: PForm1; AParent: PControl );

var
Form1:pForm1;

implementation

procedure NewForm1( var Result: PForm1; AParent: PControl );
begin
New(Result,Create);
with Result^ do
begin
Form:= NewForm(AParent,"NC PAINT").SetSize(600,400).centeronparent.Tabulate;
Applet:=Form;
Form.OnMessage:=DoMessage;
Form.Add2AutoFree(Result);
end;
end;

function TForm1.DoMessage(var Msg:TMsg;var Rslt:integer):Boolean;
var
DC: HDC;
Pen,pen1:HPen;
Brush: hBrush;
Handle: THandle;
Canvas: TCanvas;
begin
result:=false;
if msg.message = WM_NCPAINT then
begin
DC:=getwindowdc(form.Handle);
Rslt:=1;Result:=true;
Pen:=CreatePen(PS_SOLID, 10, RGB(0, 255, 0));
Pen1:=SelectObject(DC,Pen);
Brush:=SelectObject(DC,GetStockObject(NULL_BRUSH));
Rectangle(DC, 0, 0, Form.width,Form.height);
SelectObject(DC,Brush);
SelectObject(DC,Pen);
DeleteObject(Pen);
ReleaseDC(form.Handle,DC)
end;
end;

end.
[/CODE]

You can also use Attachproc and define a wndproc to handle NC_PAINT

← →
Boguslaw Brandys (2005-03-06 12:35) [2]

By the way . I always usedResult := true to stop processing message after , what is the purpose of using Rslt := 1 ?

← →
Watcher (2005-03-06 13:38) [3]

2 thaddy>

It’s pretty good, but I can’t resize shaped window in compiled project and border still unshaped. Also I can’t understand what’s wrong in my code?

← →
thaddy (2005-03-06 13:57) [4]

Untested, from memory:

Last lines change to:

DeleteObject(Pen);
ReleaseDC(.form.Handle.DC)
form.canvas.fillrect(form.canvas.cliprect);
end;

← →
thaddy (2005-03-06 14:00) [5]

To Boguslaw: the rslt param idicates status of paint operation in TWmPaintmsg struct, which *may* be important to the defwindowproc or even other paint operarions. Result is only valid for KOL painting, as I understood it to be the case. I may be wrong.

← →
thaddy (2005-03-06 23:14) [6]

This is the other method, with some refinements that also work in the above:

[CODE]
unit Unit_test1;

interface
uses
Windows, Messages, Kol;

type
PForm1=^TForm1;
TForm1=object(Tobj)
Form:pControl;
public
end;

procedure NewForm1( var Result: PForm1; AParent: PControl );

var
Form1:pForm1;

implementation

function WndProcPaintBorder( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var
p: TPaintStruct;
DC: HDC;
Pen,pen1:HPen;
Brush: hBrush;
R:TRect;
begin
Result := False;
case msg.message of
WM_NCPAINT:
begin
DefWindowProc(sender.handle,Msg.Message,msg.wparam,msg.lparam);
BeginPaint(Sender.Handle, p);
DC:=getwindowdc(sender.Handle);
Rslt:=1;Result:=true;
Pen:=CreatePen(PS_SOLID, 10, RGB(0, 255, 0));
Pen1:=SelectObject(DC,Pen);
Brush:=SelectObject(DC,GetStockObject(NULL_BRUSH));
Rectangle(DC, 0, 0, sender.width,sender.height);
SelectObject(DC,Brush);
SelectObject(DC,Pen);
DeleteObject(Pen);
ReleaseDC(sender.Handle,DC);
EndPaint(Sender.Handle, p);
Result := True;
end;
WM_ERASEBKGND:
begin
BeginPaint(Sender.Handle, p);
R:=sender.canvas.cliprect;
InvalidateRect(sender.handle,@R,true);
EndPaint(Sender.Handle, p);
end;
end;
end;

procedure NewForm1( var Result: PForm1; AParent: PControl );
begin
New(Result,Create);
with Result^ do
begin
Form:= NewForm(AParent,"NC PAINT").SetSize(600,400).centeronparent.Tabulate;
Applet:=Form;
Form.Add2AutoFree(Result);
Form.AttachProc(WndProcPaintBorder);
end;
end;

end.
[/CODE]

Обрамление KOL формы. Найти похожие ветки