fdmain.pas.svn-base

TFormDesigner allows you move and resize any control on your form. You need not prepare your form to

(*  GREATIS FORM DESIGNER PRO                 *)
(*  unit version 3.50.265                     *)
(*  Copyright (C) 2001-2003 Greatis Software  *)
(*  http://www.greatis.com/formdes.htm        *)
(*  [e-mail]                        *)

unit FDMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, IniFiles, AXCtrls, Clipbrd;

type

  TGrabPosition = (
    gpNone,
    gpLeftTop,
    gpLeftMiddle,
    gpLeftBottom,
    gpMiddleTop,
    gpMiddleBottom,
    gpRightTop,
    gpRightMiddle,
    gpRightBottom);

  TCustomFormDesigner = class;

  // container component for non-control components
  TComponentContainer = class(TCustomControl)
  private
    FComponent: TComponent;
    FBitmap: TBitmap;
  protected
    procedure Paint; override;
    procedure WndProc(var Msg: TMessage); override;
  public
    constructor CreateWithComponent(AOwner,AComponent: TComponent);
    destructor Destroy; override;
    property Component: TComponent read FComponent write FComponent;
  end;

  // special reader class
  TFDReader = class(TReader)
  private
    Designer: TCustomFormDesigner;
  protected
    function Error(const Message: string): Boolean; override;
    procedure SetName(Component: TComponent; var Name: string); override;
  public
    constructor Create(AStream: TStream; ADesigner: TCustomFormDesigner);
  end;

  // resize handle
  TGrabHandle = class(TCustomControl)
  private
    FPosition: TGrabPosition;
    FRect: TRect;
    FLocked: Boolean;
    procedure SetPosition(Value: TGrabPosition);
    procedure SetRect(Value: TRect);
    procedure SetLocked(Value: Boolean);
    procedure UpdateCoords;
    procedure SetArrowCursor;
  protected
    procedure Paint; override;
    procedure WndProc(var Msg: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
    property Position: TGrabPosition read FPosition write SetPosition;
    property Rect: TRect read FRect write SetRect;
    property Locked: Boolean read FLocked write SetLocked;
  end;

  // resize handles group
  TGrabHandles = class(TComponent)
  private
    FItems: array[TGrabPosition] of TGrabHandle;
    FControl: TControl;
    FVisible: Boolean;
    FEnabled: Boolean;
    procedure SetControl(Value: TControl);
    procedure SetVisible(Value: Boolean);
    procedure SetEnabled(Value: Boolean);
    function GetParentForm: TCustomForm;
    function GetDesigner: TCustomFormDesigner;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Update(MustHide: Boolean);
    procedure BringToFront;
    function FindHandle(AHandle: HWND): TGrabPosition;
    function FindHandleControl(AHandle: HWND): TGrabHandle;
    function IsGrabHandle(AControl: TControl): Boolean;
    property Control: TControl read FControl write SetControl;
    property Visible: Boolean read FVisible write SetVisible;
    property Enabled: Boolean read FEnabled write SetEnabled;
    property ParentForm: TCustomForm read GetParentForm;
    property Designer: TCustomFormDesigner read GetDesigner;
  end;

  // type for controls list editor
  TListType = (ltLocked,ltProtected,ltTransparent);

  // mode type for LockedControls and ProtectedControls
  TChildrenMode = (cmNone,cmNormal,cmRecurse);

  // type for protect mode
  TProtectMode = (pmUnselect,pmLockKeyboard);

  // message processing type
  TMessageProcessor = (mpEvent,mpHook);

  // internal type for mouse action
  TMouseAction = (maNone,maDragging,maSelecting);

  // internal type for hint window offset
  THintMode = (hmMove,hmSize);

  // grab type for DrawGrab procedure
  TGrabType = (gtNormal,gtMulti,gtLocked);

  // align mode for AlignControls procedure
  TAlignMode = (amNoChange,amLeftTop,amCenters,amRightBottom,amSpace,amWindowCenter);

  // size mode for SizeControls procedure
  TSizeMode = (smNoChange,smToSmallest,smToLargest,smValue);

  // alignment palette modes
  TAlignmentPaletteOption = (apAutoShow,apStayOnTop,apShowHints,apFlatButtons);
  TAlignmentPaletteOptions = set of TAlignmentPaletteOption;

  // DFM formats
  TDFMFormat = (dfmBinary,dfmText);

  // TCustomFormDesigner event types
  TControlNotifyEvent = procedure (Sender: TObject; TheControl: TControl) of object;
  TLoadSaveEvent = procedure (Sender: TObject; TheControl: TControl; IniFile: TIniFile) of object;
  TDesignerMessageEvent = procedure(Sender: TObject; var Msg: TMsg) of object;
  TMoveLimitEvent = procedure (Sender: TObject; TheControl: TControl; var LimitRect: TRect) of object;
  TSizeLimitEvent = procedure (Sender: TObject; TheControl: TControl; var MinSize,MaxSize: TPoint) of object;

  // main class
  TCustomFormDesigner = class(TComponent)
  private
    { Private declarations }
    FAPForm: TForm;
    FClearBeforeLoad: Boolean;
    FMustClear: Boolean;
    FGrabSize: Integer;
    FNormalGrabBorder: TColor;
    FNormalGrabFill: TColor;
    FMultiGrabBorder: TColor;
    FMultiGrabFill: TColor;
    FLockedGrabBorder: TColor;
    FLockedGrabFill: TColor;
    FNormalGrab: TBitmap;
    FMultiGrab: TBitmap;
    FLockedGrab: TBitmap;
    FHintWindow: THintWindow;
    FCanvas: TCanvas;
    FClickPos: LPARAM;
    FDesignerBrush: TBitmap;
    FDefaultBrush: TBrush;
    FActive: Boolean;
    FMessageProcessor: TMessageProcessor;
    FLockCounter: Integer;
    FControls: TList;
    FSelectControl: TWinControl;
    FMenuControl: TControl;
    FGrabHandles: TGrabHandles;
    FGridStep: Integer;
    FSnapToGrid: Boolean;
    FDisplayGrid: Boolean;
    FDesignerColor: TColor;
    FGridColor: TColor;
    FPopupMenu: TPopupMenu;
    FLockedControls: TStrings;
    FLockedInverse: Boolean;
    FLockChildren: TChildrenMode;
    FProtectedControls: TStrings;
    FProtectedInverse: Boolean;
    FProtectChildren: TChildrenMode;
    FProtectMode: TProtectMode;
    FTransparentControls: TStrings;
    FTransparentInverse: Boolean;
    FTransparentChildren: TChildrenMode;
    FShowMoveSizeHint: Boolean;
    FAlignmentPalette: TAlignmentPaletteOptions;
    FMouseAction: TMouseAction;
    FDragPoint: TPoint;
    FDragRect: TRect;
    FSelectRect: TRect;
    FSelectCounter: Integer;
    FDragHandle: TGrabPosition;
    FUseContainers: Boolean;
    FOnApplicationMessage: TMessageEvent;
    FOnMoveSizeControl: TControlNotifyEvent;
    FOnLoadControl: TLoadSaveEvent;
    FOnSaveControl: TLoadSaveEvent;
    FOnSelectControl: TControlNotifyEvent;
    FOnControlDblClick: TControlNotifyEvent;
    FOnCreateControl: TControlNotifyEvent;
    FOnAddControl: TControlNotifyEvent;
    FOnDeleteControl: TControlNotifyEvent;
    FOnActivate: TNotifyEvent;
    FOnDeactivate: TNotifyEvent;
    FOnKeyDown: TKeyEvent;
    FOnKeyUp: TKeyEvent;
    FOnMessage: TDesignerMessageEvent;
    FOnMoveLimit: TMoveLimitEvent;
    FOnSizeLimit: TSizeLimitEvent;
    FOnReadError: TReaderError;
    // properties access methods
    function GetControlCount: Integer;
    function GetLocked: Boolean;
    function GetParentForm: TCustomForm;
    function GetFormData: string;
    procedure SetFormData(const Value: string);
    procedure SetActive(Value: Boolean);
    procedure SetMessageProcessor(Value: TMessageProcessor);
    function GetControl: TControl;
    procedure SetControl(Value: TControl);
    function GetControlByIndex(Index: Integer): TControl;
    procedure SetGridStep(Value: Integer);
    procedure SetDisplayGrid(Value: Boolean);
    procedure SetDesignerColor(Value: TColor);
    procedure SetGridColor(Value: TColor);
    procedure SetLockedControls(Value: TStrings);
    procedure SetLockedInverse(Value: Boolean);
    procedure SetLockChildren(Value: TChildrenMode);
    procedure SetProtectedControls(Value: TStrings);
    procedure SetProtectedInverse(Value: Boolean);
    procedure SetProtectChildren(Value: TChildrenMode);
    procedure SetProtectMode(Value: TProtectMode);
    procedure SetTransparentControls(Value: TStrings);
    procedure SetTransparentInverse(Value: Boolean);
    procedure SetTransparentChildren(Value: TChildrenMode);
    procedure SetMoveSizeHint(Value: Boolean);
    procedure SetGrabSize(Value: Integer);
    procedure SetAlignmentPalette(Value: TAlignmentPaletteOptions);
    procedure SetNormalGrabBorder(Value: TColor);
    procedure SetNormalGrabFill(Value: TColor);
    procedure SetMultiGrabBorder(Value: TColor);
    procedure SetMultiGrabFill(Value: TColor);
    procedure SetLockedGrabBorder(Value: TColor);
    procedure SetLockedGrabFill(Value: TColor);
    // internal methods
    procedure ApplicationMessage(var Msg: TMsg; var Handled: Boolean);
    procedure DrawDragRects;
    procedure DrawSelectRect;
    procedure DrawMultiSelect(AControl: TControl);
    function InTheList(List: TStrings; AControl: TControl): Boolean;
    procedure UpdateGrid;
    procedure ShowHint(AHint: string; Mode: THintMode);
    procedure HideHint;
    function GetControlsOrigin: TPoint;
    function CheckParent(AControl: TControl): Boolean;
    procedure SetArrowCursor;
    procedure ClearForm;
    function ValidControl(AControl: TControl): Boolean;
    procedure CreateContainers;
    procedure DestroyContainers;
    {$IFDEF TFDTRIAL}
    procedure ShowTrialWarning;
    {$ENDIF}
    // event handler for TStringList.OnChange
    procedure ListChange(Sender: TObject);
  protected
    { Protected declarations }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure MessageProc(var Msg: TMSG); virtual;
    procedure DoMoveSizeControl; virtual;
    procedure DoSelectControl(AControl: TControl); virtual;
    procedure DoCreateControl(AControl: TControl); virtual;
    procedure DoAddControl(AControl: TControl); virtual;
    procedure DoDeleteControl(AControl: TControl); virtual;
    {$IFDEF TFD1COMPATIBLE}
    property OnDragControl: TControlNotifyEvent read FOnMoveSizeControl write FOnMoveSizeControl;
    {$ELSE}
    property OnMoveSizeControl: TControlNotifyEvent read FOnMoveSizeControl write FOnMoveSizeControl;
    {$ENDIF}
    property OnLoadControl: TLoadSaveEvent read FOnLoadControl write FOnLoadControl;
    property OnSaveControl: TLoadSaveEvent read FOnSaveControl write FOnSaveControl;
    property OnSelectControl: TControlNotifyEvent read FOnSelectControl write FOnSelectControl;
    property OnControlDblClick: TControlNotifyEvent read FOnControlDblClick write FOnControlDblClick;
    property OnCreateControl: TControlNotifyEvent read FOnCreateControl write FOnCreateControl;
    property OnAddControl: TControlNotifyEvent read FOnAddControl write FOnAddControl;
    property OnDeleteControl: TControlNotifyEvent read FOnDeleteControl write FOnDeleteControl;
    property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
    property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;
    property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;
    property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp;
    property OnMessage: TDesignerMessageEvent read FOnMessage write FOnMessage;
    property OnMoveLimit: TMoveLimitEvent read FOnMoveLimit write FOnMoveLimit;
    property OnSizeLimit: TSizeLimitEvent read FOnSizeLimit write FOnSizeLimit;
    property OnReadError: TReaderError read FOnReadError write FOnReadError;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Update; virtual;
    function IsLocked(AControl: TControl): Boolean;
    function IsProtected(AControl: TControl): Boolean;
    function IsTransparent(AControl: TControl): Boolean;
    function FindNextControl(GoForward: Boolean): TControl;
    function ControlAtPos(AParent: TWinControl; P: TPoint): TControl;
    function FindWinControl(Wnd: HWND): TWinControl;
    function FindComponentContainer(AComponent: TComponent): TComponentContainer;
    procedure SaveToFile(FileName: string);
    procedure LoadFromFile(FileName: string);
    procedure SaveToDFM(FileName: string; DFMFormat: TDFMFormat);
    procedure LoadFromDFM(FileName: string; DFMFormat: TDFMFormat);
    procedure SaveToStream(Stream: TStream; DFMFormat: TDFMFormat);
    procedure LoadFromStream(Stream: TStream; DFMFormat: TDFMFormat);
    procedure CopyToClipboard;
    procedure CutToClipboard;
    procedure PasteFromClipboard;
    procedure AlignToGrid(TheControl: TControl);
    function EditControlLists(DefaultList: TListType): Boolean;
    procedure AlignDialog;
    procedure SizeDialog;
    procedure TabOrderDialog;
    procedure ShowAlignmentPalette;
    procedure HideAlignmentPalette;
    procedure AlignControls(Hor,Ver: TAlignMode);
    procedure SizeControls(WMode: TSizeMode; WValue: Integer; HMode: TSizeMode; HValue: Integer);
    procedure Lock;
    procedure Unlock;
    procedure LeaveMouseAction;
    procedure AddControl(AControl: TControl);
    procedure DeleteControl(AControl: TControl);
    procedure SelectAll;
    procedure ClearControls;
    function ControlIndex(AControl: TControl): Integer;
    procedure DrawGrab(Canvas: TCanvas; R: TRect; GrabType: TGrabType); virtual;
    procedure UpdateGrabs;
    property ControlCount: Integer read GetControlCount;
    property Locked: Boolean read GetLocked;
    property MouseAction: TMouseAction read FMouseAction;
    property Active: Boolean read FActive write SetActive;
    property MessageProcessor: TMessageProcessor read FMessageProcessor write SetMessageProcessor;
    property Control: TControl read GetControl write SetControl;
    property Controls[Index: Integer]: TControl read GetControlByIndex;
    property ParentForm: TCustomForm read GetParentForm;
    property AlignmentPaletteForm: TForm read FAPForm;
    property MenuControl: TControl read FMenuControl;
    property FormData: string read GetFormData write SetFormData;
    property ClearBeforeLoad: Boolean read FClearBeforeLoad write FClearBeforeLoad;
    {$IFDEF TFD1COMPATIBLE}
    property FixedControls: TStrings read FLockedControls write SetLockedControls;
    property FixedInverse: Boolean read FLockedInverse write SetLockedInverse;
    property FixChildren: TChildrenMode read FLockChildren write SetLockChildren;
    {$ELSE}
    property LockedControls: TStrings read FLockedControls write SetLockedControls;
    property LockedInverse: Boolean read FLockedInverse write SetLockedInverse;
    property LockChildren: TChildrenMode read FLockChildren write SetLockChildren;
    {$ENDIF}
    property ProtectedControls: TStrings read FProtectedControls write SetProtectedControls;
    property ProtectedInverse: Boolean read FProtectedInverse write SetProtectedInverse;
    property ProtectChildren: TChildrenMode read FProtectChildren write SetProtectChildren;
    property ProtectMode: TProtectMode read FProtectMode write SetProtectMode;
    property TransparentControls: TStrings read FTransparentControls write SetTransparentControls;
    property TransparentInverse: Boolean read FTransparentInverse write SetTransparentInverse;
    property TransparentChildren: TChildrenMode read FTransparentChildren write SetTransparentChildren;
    property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
    property GridStep: Integer read FGridStep write SetGridStep;
    property SnapToGrid: Boolean read FSnapToGrid write FSnapToGrid;
    property DisplayGrid: Boolean read FDisplayGrid write SetDisplayGrid;
    property DesignerColor: TColor read FDesignerColor write SetDesignerColor;
    property GridColor: TColor read FGridColor write SetGridColor;
    property ShowMoveSizeHint: Boolean read FShowMoveSizeHint write SetMoveSizeHint;
    property GrabSize: Integer read FGrabSize write SetGrabSize;
    property AlignmentPalette: TAlignmentPaletteOptions read FAlignmentPalette write SetAlignmentPalette;
    property NormalGrabBorder: TColor read FNormalGrabBorder write SetNormalGrabBorder;
    property NormalGrabFill: TColor read FNormalGrabFill write SetNormalGrabFill;
    property MultiGrabBorder: TColor read FMultiGrabBorder write SetMultiGrabBorder;
    property MultiGrabFill: TColor read FMultiGrabFill write SetMultiGrabFill;
    property LockedGrabBorder: TColor read FLockedGrabBorder write SetLockedGrabBorder;
    property LockedGrabFill: TColor read FLockedGrabFill write SetLockedGrabFill;
  end;

  TFormDesigner = class(TCustomFormDesigner)
  published
    { Published declarations }
    property ClearBeforeLoad;
    property MessageProcessor;
    {$IFDEF TFD1COMPATIBLE}
    property FixedControls;
    property FixedInverse;
    property FixChildren;
    {$ELSE}
    property LockedControls;
    property LockedInverse;
    property LockChildren;
    {$ENDIF}
    property ProtectedControls;
    property ProtectedInverse;
    property ProtectChildren;
    property ProtectMode;
    property TransparentControls;
    property TransparentInverse;
    property TransparentChildren;
    property PopupMenu;
    property GridStep;
    property SnapToGrid;
    property DisplayGrid;
    property DesignerColor;
    property GridColor;
    property ShowMoveSizeHint;
    property GrabSize;
    property AlignmentPalette;
    property NormalGrabBorder;
    property NormalGrabFill;
    property MultiGrabBorder;
    property MultiGrabFill;
    property LockedGrabBorder;
    property LockedGrabFill;
    {$IFDEF TFD1COMPATIBLE}
    property OnDragControl;
    {$ELSE}
    property OnMoveSizeControl;
    {$ENDIF}
    property OnLoadControl;
    property OnSaveControl;
    property OnSelectControl;
    property OnCreateControl;
    property OnAddControl;
    property OnDeleteControl;
    property OnControlDblClick;
    property OnActivate;
    property OnDeactivate;
    property OnKeyDown;
    property OnKeyUp;
    property OnMessage;
    property OnMoveLimit;
    property OnSizeLimit;
    property OnReadError;
  end;

  // exception class for TCustomFormDesigner
  EFormDesigner = class(Exception);

function Designing: Boolean;

implementation

{$R FDMAIN.RES}