{ $Id$ } { *************************************************************************** * * * This source is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * * This code 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 * * General Public License for more details. * * * * A copy of the GNU General Public License is available on the World * * Wide Web at . You can also * * obtain it by writing to the Free Software Foundation, * * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * * * *************************************************************************** Author: Mattias Gaertner Abstract: TNonControlForm is a designer form to design non TControl components like TDataModule. } unit NonControlForms; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Graphics, GraphType, Forms, Controls, IDEProcs; type { TNonControlForm } TNonControlForm = class(TForm) private FFrameWidth: integer; FLookupRoot: TComponent; FOnLoadBounds: TNotifyEvent; FOnSaveBounds: TNotifyEvent; protected procedure SetFrameWidth(const AValue: integer); virtual; procedure SetLookupRoot(const AValue: TComponent); virtual; public constructor Create(TheOwner: TComponent); override; destructor Destroy; override; procedure Paint; override; procedure DoLoadBounds; virtual; procedure DoSaveBounds; virtual; public property LookupRoot: TComponent read FLookupRoot write SetLookupRoot; property FrameWidth: integer read FFrameWidth write SetFrameWidth; property OnLoadBounds: TNotifyEvent read FOnLoadBounds write FOnLoadBounds; property OnSaveBounds: TNotifyEvent read FOnSaveBounds write FOnSaveBounds; end; { TDataModuleForm } TDataModuleForm = class(TNonControlForm) private function GetDataModule: TDataModule; procedure SetDataModule(const AValue: TDataModule); protected procedure SetLookupRoot(const AValue: TComponent); override; public procedure DoLoadBounds; override; procedure DoSaveBounds; override; public property DataModule: TDataModule read GetDataModule write SetDataModule; end; function CompareNonControlForms(Data1, Data2: Pointer): integer; function CompareLookupRootAndNonControlForm(Key, Data: Pointer): integer; implementation function CompareNonControlForms(Data1, Data2: Pointer): integer; var Form1: TNonControlForm; Form2: TNonControlForm; begin Form1:=TNonControlForm(Data1); Form2:=TNonControlForm(Data2); Result:=integer(Form1.LookupRoot)-integer(Form2.LookupRoot); end; function CompareLookupRootAndNonControlForm(Key, Data: Pointer): integer; var LookupRoot: TComponent; Form: TNonControlForm; begin LookupRoot:=TComponent(Key); Form:=TNonControlForm(Data); Result:=integer(LookupRoot)-integer(Form.LookupRoot); end; { TNonControlForm } procedure TNonControlForm.SetLookupRoot(const AValue: TComponent); begin if FLookupRoot=AValue then exit; DoSaveBounds; FLookupRoot:=AValue; if FLookupRoot<>nil then begin Caption:=FLookupRoot.Name; end; DoLoadBounds; end; procedure TNonControlForm.SetFrameWidth(const AValue: integer); begin if FFrameWidth=AValue then exit; FFrameWidth:=AValue; Invalidate; end; constructor TNonControlForm.Create(TheOwner: TComponent); begin inherited Create(TheOwner); FFrameWidth:=1; ControlStyle:=ControlStyle-[csAcceptsControls]; end; destructor TNonControlForm.Destroy; begin inherited Destroy; end; procedure TNonControlForm.Paint; var ARect: TRect; begin inherited Paint; with Canvas do begin Brush.Color:=clWhite; ARect:=Rect(FrameWidth,FrameWidth, ClientWidth-FrameWidth,ClientHeight-FrameWidth); FillRect(ARect); ARect:=Rect(0,0,ClientWidth+1,ClientHeight+1); Pen.Color:=clBlack; Frame3d(ARect, FrameWidth, bvLowered); end; end; procedure TNonControlForm.DoLoadBounds; begin if Assigned(OnLoadBounds) then OnLoadBounds(Self); end; procedure TNonControlForm.DoSaveBounds; begin if Assigned(OnSaveBounds) then OnSaveBounds(Self); end; { TDataModuleForm } procedure TDataModuleForm.SetDataModule(const AValue: TDataModule); begin LookupRoot:=AValue; end; function TDataModuleForm.GetDataModule: TDataModule; begin Result:=TDataModule(LookupRoot); end; procedure TDataModuleForm.SetLookupRoot(const AValue: TComponent); begin if AValue=LookupRoot then exit; if (AValue<>nil) and (not (AValue is TDataModule)) then RaiseException('TDataModuleForm.SetLookupRoot AValue.ClassName=' +AValue.ClassName); inherited SetLookupRoot(AValue); end; procedure TDataModuleForm.DoLoadBounds; var CurDataModule: TDataModule; NewLeft: Integer; NewTop: Integer; NewWidth: Integer; NewHeight: Integer; begin inherited DoLoadBounds; CurDataModule:=DataModule; if CurDataModule<>nil then begin NewLeft:=CurDataModule.DesignOffset.X; NewTop:=CurDataModule.DesignOffset.Y; NewWidth:=CurDataModule.DesignSize.X; NewHeight:=CurDataModule.DesignSize.Y; SetBounds(NewLeft,NewTop,NewWidth,NewHeight); end; end; procedure TDataModuleForm.DoSaveBounds; var CurDataModule: TDataModule; begin CurDataModule:=DataModule; if CurDataModule<>nil then begin CurDataModule.DesignOffset.X:=Left; CurDataModule.DesignOffset.Y:=Top; CurDataModule.DesignSize.X:=Width; CurDataModule.DesignSize.Y:=Height; end; inherited DoSaveBounds; end; end.