diff --git a/.gitattributes b/.gitattributes index 1c783d642e..07513aae59 100644 --- a/.gitattributes +++ b/.gitattributes @@ -2360,6 +2360,18 @@ examples/designerbaseclass/example/demo1.lpr svneol=native#text/plain examples/designerbaseclass/example/unit1.lfm svneol=native#text/plain examples/designerbaseclass/example/unit1.lrs svneol=native#text/pascal examples/designerbaseclass/example/unit1.pas svneol=native#text/plain +examples/designnonlcl/README.txt svneol=native#text/plain +examples/designnonlcl/mywidgetdesigner.pas svneol=native#text/plain +examples/designnonlcl/mywidgetset.pas svneol=native#text/plain +examples/designnonlcl/notlcldesigner.lpk svneol=native#text/plain +examples/designnonlcl/notlcldesigner.pas svneol=native#text/plain +examples/designnonlcl/project/NonLCL1.ico -text svneol=unset#image/ico +examples/designnonlcl/project/NonLCL1.lpi svneol=native#text/plain +examples/designnonlcl/project/NonLCL1.lpr svneol=native#text/plain +examples/designnonlcl/project/NonLCL1.manifest svneol=native#text/plain +examples/designnonlcl/project/unit1.lfm svneol=native#text/plain +examples/designnonlcl/project/unit1.lrs svneol=native#text/plain +examples/designnonlcl/project/unit1.pas svneol=native#text/plain examples/dlgform.pp svneol=native#text/pascal examples/docking/project1.ico -text svneol=unset#image/icon examples/docking/project1.lpi svneol=native#text/plain diff --git a/examples/designnonlcl/README.txt b/examples/designnonlcl/README.txt new file mode 100644 index 0000000000..290b8c81da --- /dev/null +++ b/examples/designnonlcl/README.txt @@ -0,0 +1,2 @@ +This package is an example how to to use the lazarus IDE form designer to +design non LCL widgets. diff --git a/examples/designnonlcl/mywidgetdesigner.pas b/examples/designnonlcl/mywidgetdesigner.pas new file mode 100644 index 0000000000..6e6a62b3e7 --- /dev/null +++ b/examples/designnonlcl/mywidgetdesigner.pas @@ -0,0 +1,179 @@ +{ Example designer for the Lazarus IDE + + Copyright (C) 2009 Mattias Gaertner mattias@freepascal.org + + This library is free software; you can redistribute it and/or modify it + under the terms of the GNU Library General Public License as published by + the Free Software Foundation; either version 2 of the License, or (at your + option) any later version with the following modification: + + As a special exception, the copyright holders of this library give you + permission to link this library with independent modules to produce an + executable, regardless of the license terms of these independent modules,and + to copy and distribute the resulting executable under terms of your choice, + provided that you also meet, for each linked independent module, the terms + and conditions of the license of that module. An independent module is a + module which is not derived from or based on this library. If you modify + this library, you may extend this exception to your version of the library, + but you are not obligated to do so. If you do not wish to do so, delete this + exception statement from your version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License + for more details. + + You should have received a copy of the GNU Library General Public License + along with this library; if not, write to the Free Software Foundation, + Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +} + +unit MyWidgetDesigner; + +{$mode objfpc}{$H+} + +interface + +uses + LCLProc, LCLType, Classes, SysUtils, FormEditingIntf, LCLIntf, Graphics, + MyWidgetSet; + +type + + { TMyWidgetMediator } + + TMyWidgetMediator = class(TDesignerMediator,IMyWidgetDesigner) + private + FMyForm: TMyForm; + public + // needed by the lazarus form editor + class function CreateMediator(TheOwner, aForm: TComponent): TDesignerMediator; + override; + class function FormClass: TComponentClass; override; + procedure GetBounds(AComponent: TComponent; out CurBounds: TRect); override; + procedure SetBounds(AComponent: TComponent; NewBounds: TRect); override; + procedure Paint(aRect: TRect); override; + public + // needed by TMyWidget + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure InvalidateRect(Sender: TObject; ARect: TRect; Erase: boolean); + property MyForm: TMyForm read FMyForm; + end; + +procedure Register; + +implementation + +procedure Register; +begin + FormEditingHook.RegisterDesignerMediator(TMyWidgetMediator); +end; + +{ TMyWidgetMediator } + +constructor TMyWidgetMediator.Create(AOwner: TComponent); +begin + inherited Create(AOwner); +end; + +destructor TMyWidgetMediator.Destroy; +begin + inherited Destroy; +end; + +class function TMyWidgetMediator.CreateMediator(TheOwner, aForm: TComponent + ): TDesignerMediator; +begin + Result:=TMyWidgetMediator.Create(TheOwner); + TMyWidgetMediator(Result).FMyForm:=aForm as TMyForm; +end; + +class function TMyWidgetMediator.FormClass: TComponentClass; +begin + Result:=TMyForm; +end; + +procedure TMyWidgetMediator.GetBounds(AComponent: TComponent; out + CurBounds: TRect); +var + w: TMyWidget; +begin + if AComponent is TMyWidget then begin + w:=TMyWidget(AComponent); + CurBounds:=Bounds(w.Left,w.Top,w.Width,w.Height); + end; +end; + +procedure TMyWidgetMediator.InvalidateRect(Sender: TObject; ARect: TRect; + Erase: boolean); +begin + if (LCLForm=nil) or (not LCLForm.HandleAllocated) then exit; + LCLIntf.InvalidateRect(LCLForm.Handle,@ARect,Erase); +end; + +procedure TMyWidgetMediator.SetBounds(AComponent: TComponent; NewBounds: TRect + ); +begin + if AComponent is TMyWidget then + TMyWidget(AComponent).SetBounds(NewBounds.Left,NewBounds.Top, + NewBounds.Right-NewBounds.Left,NewBounds.Bottom-NewBounds.Top); +end; + +procedure TMyWidgetMediator.Paint(aRect: TRect); + + procedure PaintWidget(AWidget: TMyWidget); + var + i: Integer; + DC: LongInt; + SavedDC: LongInt; + Child: TMyWidget; + SavedDC2: LongInt; + begin + with LCLForm.Canvas do begin + // fill background + Brush.Style:=bsSolid; + Brush.Color:=clLtGray; + FillRect(0,0,AWidget.Width,AWidget.Height); + // outer frame + Pen.Color:=clRed; + Rectangle(0,0,AWidget.Width,AWidget.Height); + // inner frame + Pen.Color:=clMaroon; + Rectangle(AWidget.BorderLeft,AWidget.BorderTop, + AWidget.Width-AWidget.BorderRight, + AWidget.Height-AWidget.BorderBottom); + // caption + TextOut(5,2,AWidget.Caption); + // childs + DC:=Handle; + if AWidget.ChildCount>0 then begin + SavedDC:=SaveDC(DC); + // clip client area + MoveWindowOrgEx(DC,AWidget.BorderLeft,AWidget.BorderTop); + if IntersectClipRect(DC, 0, 0, AWidget.Width-AWidget.BorderLeft-AWidget.BorderRight, + AWidget.Height-AWidget.BorderTop-AWidget.BorderBottom)<>NullRegion + then begin + for i:=0 to AWidget.ChildCount-1 do begin + SavedDC2:=SaveDC(DC); + Child:=AWidget.Childs[i]; + // clip child area + MoveWindowOrgEx(DC,Child.Left,Child.Top); + if IntersectClipRect(DC,0,0,Child.Width,Child.Height)<>NullRegion then + PaintWidget(Child); + RestoreDC(DC,SavedDC2); + end; + end; + RestoreDC(DC,SavedDC); + end; + end; + end; + +begin + //debugln(['TMyWidgetMediator.Paint ',dbgs(aRect)]); + PaintWidget(MyForm); + inherited Paint(aRect); +end; + +end. + diff --git a/examples/designnonlcl/mywidgetset.pas b/examples/designnonlcl/mywidgetset.pas new file mode 100644 index 0000000000..396cce94ee --- /dev/null +++ b/examples/designnonlcl/mywidgetset.pas @@ -0,0 +1,273 @@ +{ Example widgetset. + It does not have any useful implementation, it only provides the classes + and published properties to define a child-parent relationship and some + coordinates. The Lazarus designer will do the rest: + Opening, closing, editing forms of this example widgetset. + At designtime the TMyWidgetMediator will paint. + + + Copyright (C) 2009 Mattias Gaertner mattias@freepascal.org + + This library is free software; you can redistribute it and/or modify it + under the terms of the GNU Library General Public License as published by + the Free Software Foundation; either version 2 of the License, or (at your + option) any later version with the following modification: + + As a special exception, the copyright holders of this library give you + permission to link this library with independent modules to produce an + executable, regardless of the license terms of these independent modules,and + to copy and distribute the resulting executable under terms of your choice, + provided that you also meet, for each linked independent module, the terms + and conditions of the license of that module. An independent module is a + module which is not derived from or based on this library. If you modify + this library, you may extend this exception to your version of the library, + but you are not obligated to do so. If you do not wish to do so, delete this + exception statement from your version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License + for more details. + + You should have received a copy of the GNU Library General Public License + along with this library; if not, write to the Free Software Foundation, + Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +} +unit MyWidgetSet; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Math, types; + +type + IMyWidgetDesigner = interface(IUnknown) + procedure InvalidateRect(Sender: TObject; ARect: TRect; Erase: boolean); + end; + + { TMyWidget } + + TMyWidget = class(TComponent) + private + FBorderBottom: integer; + FBorderLeft: integer; + FBorderRight: integer; + FBorderTop: integer; + FCaption: string; + FChilds: TFPList; // list of TMyWidget + FHeight: integer; + FLeft: integer; + FParent: TMyWidget; + FTop: integer; + FVisible: boolean; + FWidth: integer; + function GetChilds(Index: integer): TMyWidget; + procedure SetBorderBottom(const AValue: integer); + procedure SetBorderLeft(const AValue: integer); + procedure SetBorderRight(const AValue: integer); + procedure SetBorderTop(const AValue: integer); + procedure SetCaption(const AValue: string); + procedure SetHeight(const AValue: integer); + procedure SetLeft(const AValue: integer); + procedure SetParent(const AValue: TMyWidget); + procedure SetTop(const AValue: integer); + procedure SetVisible(const AValue: boolean); + procedure SetWidth(const AValue: integer); + protected + procedure InternalInvalidateRect(ARect: TRect; Erase: boolean); virtual; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + property Parent: TMyWidget read FParent write SetParent; + function ChildCount: integer; + property Childs[Index: integer]: TMyWidget read GetChilds; + procedure SetBounds(NewLeft, NewTop, NewWidth, NewHeight: integer); virtual; + procedure InvalidateRect(ARect: TRect; Erase: boolean); + procedure Invalidate; + published + property Left: integer read FLeft write SetLeft; + property Top: integer read FTop write SetTop; + property Width: integer read FWidth write SetWidth; + property Height: integer read FHeight write SetHeight; + property Visible: boolean read FVisible write SetVisible; + property BorderLeft: integer read FBorderLeft write SetBorderLeft default 5; + property BorderRight: integer read FBorderRight write SetBorderRight default 5; + property BorderTop: integer read FBorderTop write SetBorderTop default 20; + property BorderBottom: integer read FBorderBottom write SetBorderBottom default 5; + property Caption: string read FCaption write SetCaption; + end; + TMyWidgetClass = class of TMyWidget; + + { TMyForm } + + TMyForm = class(TMyWidget) + private + FDesigner: IMyWidgetDesigner; + protected + procedure InternalInvalidateRect(ARect: TRect; Erase: boolean); override; + public + constructor Create(AOwner: TComponent); override; + property Designer: IMyWidgetDesigner read FDesigner write FDesigner; + end; + +implementation + +{ TMyWidget } + +function TMyWidget.GetChilds(Index: integer): TMyWidget; +begin + Result:=TMyWidget(FChilds[Index]); +end; + +procedure TMyWidget.SetBorderBottom(const AValue: integer); +begin + if FBorderBottom=AValue then exit; + FBorderBottom:=AValue; + Invalidate; +end; + +procedure TMyWidget.SetBorderLeft(const AValue: integer); +begin + if FBorderLeft=AValue then exit; + FBorderLeft:=AValue; + Invalidate; +end; + +procedure TMyWidget.SetBorderRight(const AValue: integer); +begin + if FBorderRight=AValue then exit; + FBorderRight:=AValue; + Invalidate; +end; + +procedure TMyWidget.SetBorderTop(const AValue: integer); +begin + if FBorderTop=AValue then exit; + FBorderTop:=AValue; + Invalidate; +end; + +procedure TMyWidget.SetCaption(const AValue: string); +begin + if FCaption=AValue then exit; + FCaption:=AValue; + Invalidate; +end; + +procedure TMyWidget.SetHeight(const AValue: integer); +begin + SetBounds(Left,Top,Width,AValue); +end; + +procedure TMyWidget.SetLeft(const AValue: integer); +begin + SetBounds(AValue,Top,Width,Height); +end; + +procedure TMyWidget.SetParent(const AValue: TMyWidget); +begin + if FParent=AValue then exit; + if FParent<>nil then begin + Invalidate; + FParent.FChilds.Remove(Self); + end; + FParent:=AValue; + if FParent<>nil then begin + FParent.FChilds.Add(Self); + end; + Invalidate; +end; + +procedure TMyWidget.SetTop(const AValue: integer); +begin + SetBounds(Left,AValue,Width,Height); +end; + +procedure TMyWidget.SetVisible(const AValue: boolean); +begin + if FVisible=AValue then exit; + FVisible:=AValue; + Invalidate; +end; + +procedure TMyWidget.SetWidth(const AValue: integer); +begin + SetBounds(Left,Top,AValue,Height); +end; + +procedure TMyWidget.InternalInvalidateRect(ARect: TRect; Erase: boolean); +begin + +end; + +constructor TMyWidget.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FChilds:=TFPList.Create; + FBorderLeft:=5; + FBorderRight:=5; + FBorderBottom:=5; + FBorderTop:=20; +end; + +destructor TMyWidget.Destroy; +begin + Parent:=nil; + while ChildCount>0 do Childs[ChildCount-1].Free; + FreeAndNil(FChilds); + inherited Destroy; +end; + +function TMyWidget.ChildCount: integer; +begin + Result:=FChilds.Count; +end; + +procedure TMyWidget.SetBounds(NewLeft, NewTop, NewWidth, NewHeight: integer); +begin + if (Left=NewLeft) and (Top=NewTop) and (Width=NewWidth) and (Height=NewHeight) then + exit; + Invalidate; + FLeft:=NewLeft; + FTop:=NewTop; + FWidth:=NewWidth; + FHeight:=NewHeight; + Invalidate; +end; + +procedure TMyWidget.InvalidateRect(ARect: TRect; Erase: boolean); +begin + ARect.Left:=Max(0,ARect.Left); + ARect.Top:=Max(0,ARect.Top); + ARect.Right:=Min(Width,ARect.Right); + ARect.Bottom:=Max(Height,ARect.Bottom); + if Parent<>nil then begin + OffsetRect(ARect,Left+Parent.BorderLeft,Top+Parent.BorderTop); + Parent.InvalidateRect(ARect,Erase); + end else begin + InternalInvalidateRect(ARect,Erase); + end; +end; + +procedure TMyWidget.Invalidate; +begin + InvalidateRect(Rect(0,0,Width,Height),false); +end; + +{ TMyForm } + +procedure TMyForm.InternalInvalidateRect(ARect: TRect; Erase: boolean); +begin + if (Parent=nil) and (Designer<>nil) then + Designer.InvalidateRect(Self,ARect,Erase); +end; + +constructor TMyForm.Create(AOwner: TComponent); +begin + inherited Create(AOwner); +end; + +end. + diff --git a/examples/designnonlcl/notlcldesigner.lpk b/examples/designnonlcl/notlcldesigner.lpk new file mode 100644 index 0000000000..a3cafa27b2 --- /dev/null +++ b/examples/designnonlcl/notlcldesigner.lpk @@ -0,0 +1,47 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/examples/designnonlcl/notlcldesigner.pas b/examples/designnonlcl/notlcldesigner.pas new file mode 100644 index 0000000000..fe441c8cf5 --- /dev/null +++ b/examples/designnonlcl/notlcldesigner.pas @@ -0,0 +1,21 @@ +{ This file was automatically created by Lazarus. do not edit! + This source is only used to compile and install the package. + } + +unit NotLCLDesigner; + +interface + +uses + MyWidgetDesigner, MyWidgetSet, LazarusPackageIntf; + +implementation + +procedure Register; +begin + RegisterUnit('MyWidgetDesigner', @MyWidgetDesigner.Register); +end; + +initialization + RegisterPackage('NotLCLDesigner', @Register); +end. diff --git a/examples/designnonlcl/project/NonLCL1.ico b/examples/designnonlcl/project/NonLCL1.ico new file mode 100644 index 0000000000..0341321b5d Binary files /dev/null and b/examples/designnonlcl/project/NonLCL1.ico differ diff --git a/examples/designnonlcl/project/NonLCL1.lpi b/examples/designnonlcl/project/NonLCL1.lpi new file mode 100644 index 0000000000..fc5ef23399 --- /dev/null +++ b/examples/designnonlcl/project/NonLCL1.lpi @@ -0,0 +1,61 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/examples/designnonlcl/project/NonLCL1.lpr b/examples/designnonlcl/project/NonLCL1.lpr new file mode 100644 index 0000000000..f3e154e838 --- /dev/null +++ b/examples/designnonlcl/project/NonLCL1.lpr @@ -0,0 +1,15 @@ +program NonLCL1; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Classes, NotLCLDesigner, Interfaces, Unit1; + +{$IFDEF WINDOWS}{$R NonLCL1.rc}{$ENDIF} + +begin +end. + diff --git a/examples/designnonlcl/project/NonLCL1.manifest b/examples/designnonlcl/project/NonLCL1.manifest new file mode 100644 index 0000000000..515fedeef9 --- /dev/null +++ b/examples/designnonlcl/project/NonLCL1.manifest @@ -0,0 +1,17 @@ + + + + Your application description here. + + + + + + + + + + + + + \ No newline at end of file diff --git a/examples/designnonlcl/project/unit1.lfm b/examples/designnonlcl/project/unit1.lfm new file mode 100644 index 0000000000..9dbea1436d --- /dev/null +++ b/examples/designnonlcl/project/unit1.lfm @@ -0,0 +1,8 @@ +object MyForm1: TMyForm1 + Left = 319 + Top = 231 + Width = 400 + Height = 300 + Visible = False + Caption = 'MyForm1' +end diff --git a/examples/designnonlcl/project/unit1.lrs b/examples/designnonlcl/project/unit1.lrs new file mode 100644 index 0000000000..c00fa00f49 --- /dev/null +++ b/examples/designnonlcl/project/unit1.lrs @@ -0,0 +1,4 @@ +LazarusResources.Add('TMyForm1','FORMDATA',[ + 'TPF0'#8'TMyForm1'#7'MyForm1'#4'Left'#3'?'#1#3'Top'#3#231#0#5'Width'#3#144#1#6 + +'Height'#3','#1#7'Visible'#8#7'Caption'#6#7'MyForm1'#0#0 +]); diff --git a/examples/designnonlcl/project/unit1.pas b/examples/designnonlcl/project/unit1.pas new file mode 100644 index 0000000000..11ec6c6472 --- /dev/null +++ b/examples/designnonlcl/project/unit1.pas @@ -0,0 +1,27 @@ +unit Unit1; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, MyWidgetSet, LResources; + +type + TMyForm1 = class(TMyForm) + private + { private declarations } + public + { public declarations } + end; + +var + MyForm1: TMyForm1; + +implementation + +initialization + {$I unit1.lrs} + +end. +