formcont.pas

Do your applications look a little boring? Would you like to get spectacular yet easy to use visual

unit FormCont;

interface

{$INCLUDE teDefs.inc}

uses
  SysUtils, Classes, TransEff, teBkgrnd, teRender,
  {$ifdef CLX}
  QForms, QGraphics, QControls, QDialogs, QStdCtrls, QActnList;
  {$else}
  {$ifndef D3C3}ActnList,{$endif D3C3}
  Windows, Messages, Forms, Graphics, Controls, Dialogs, StdCtrls;
  {$endif CLX}

type
  TFCFormAlign = (fcfaDefault, fcfaNone, fcfaCenter, fcfaClient, fcfaTopLeft,
    fcfaMainFormCenter);

  TFCFormChangeEvent = procedure(Sender: TObject;
    const OldForm, NewForm: TCustomForm; var CanChange: Boolean) of object;
  TFCFormCreateEvent = procedure(Sender: TObject;
    const Form: TCustomForm) of object;
  TFCFormDestroyEvent = procedure(Sender: TObject;
    const Form: TCustomForm) of object;

  EFormContainerError = class(Exception);

  {$ifdef D3C3}
  TCustomFormClass = class of TCustomForm;
  {$endif D3C3}

  TFCExtraData = class
  end;

  TFCExtraDataClass = class of TFCExtraData;

  TFCGetExtraDataClass = function: TFCExtraDataClass        of object;
  TFCGetExtraData      = procedure(ExtraData: TFCExtraData) of object;
  TFCSetExtraData      = procedure(ExtraData: TFCExtraData) of object;

  TFCFormData = class
  private
    FFormClass: TCustomFormClass;
    FForm: TCustomForm;

    FOnHide: TNotifyEvent;
    FOnShow: TNotifyEvent;
  protected
    DoneShow: Boolean;

    procedure ReadData(AForm: TCustomForm);
    procedure DoHide;
    procedure DoShow;
  public
    FAlign: TFCFormAlign;
    FPosition: TPosition;
    FBorderIcons: TBorderIcons;
    FDescription: String;
    FExtraData: TFCExtraData;

    constructor Create(AForm: TCustomForm);
    destructor  Destroy; override;

    property Align: TFCFormAlign read FAlign write FAlign;
    property Position: TPosition read FPosition write FPosition;
    property BorderIcons: TBorderIcons read FBorderIcons write FBorderIcons;
    property Description: String read FDescription write FDescription;
    property ExtraData: TFCExtraData read FExtraData write FExtraData;
    property FormClass: TCustomFormClass read FFormClass;
    property Form: TCustomForm read FForm;
  end;

  TFormContainer = class(TScrollingWinControl)
  private
    FCanvas: TCanvas;
    FBackgroundOptions: TFCBackgroundOptions;
    FBorderStyle: TBorderStyle;
    FFlickerFree,
    DoCheckOnClose: Boolean;
    FForm: TCustomForm;
    FForms: TList;
    AllFormsData: TList;
    Locked: Boolean;
    FLRUForms: TList;
    FLRUFormIndex,
    NewLRUFormIndex,
    FLRUFormCapacity: Integer;
    FSaveLRUDestroyedForms: Boolean;
    FSafeFormDestroy: Boolean;
    FOnFormChange: TFCFormChangeEvent;
    FOnFormCreate: TFCFormCreateEvent;
    FOnFormDestroy: TFCFormDestroyEvent;

    procedure SetBackgroundOptions(Value: TFCBackgroundOptions);
    procedure SetBorderStyle(Value: TBorderStyle);
    function  GetForms(Index: Integer): TCustomForm;
    procedure SetForm(Value: TCustomForm; DestroyCurrent: Boolean);
    function  GetFormData(Index: Integer): TFCFormData;
    function  GetLRUForm(Index: Integer): TCustomForm;
    function  GetLRUFormData(Index: Integer): TFCFormData;
    procedure SetLRUFormCapacity(Value: Integer);
    function  GetPicture: TPicture;
    procedure SetPicture(const Value: TPicture);
    function  GetVersion: String;
    procedure SetVersion(const Value: String);
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
    
    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
  protected
    function  GetFormAlignToUse(Form: TCustomForm): TFCFormAlign;
    procedure AdjustForm(CheckVisible: Boolean); virtual;
    procedure AlignControls(AControl: TControl; var Rect: TRect); override;
    function  CheckFormsData: Boolean;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DestroyingLRUForm(FormData: TFCFormData);
    procedure DeleteFormData(FData: TFCFormData);
    function  DeleteLRUForm(F: TCustomForm): Boolean;
    function  DeleteLRUFormByIndex(Index: Integer): Boolean;
    function  FormAlign: TFCFormAlign;
    function  GetPalette: HPALETTE; override;
    procedure Paint; virtual;
    procedure PaintWindow(DC: HDC); override;
{$ifndef D3C3}
//    procedure AddActionList(ActionList: TCustomActionList);
//    procedure RemoveActionList(ActionList: TCustomActionList);
//    procedure Notification(AComponent: TComponent;
//      Operation: TOperation); override;
{$endif D3C3}
    procedure SetName(const NewName: TComponentName); override;
    procedure SetParent(AParent: TWinControl); override;

    property  Canvas: TCanvas read FCanvas;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;

    function  FormCount: Integer;
    function  LRUFormCount: Integer;
    function  CloseQuery: Boolean;
    function  CloseQueryAll: Boolean;
    function  FormData: TFCFormData;
    function  IndexOf(Value: TCustomForm): Integer;
    function  CheckOnClose(Default: Boolean): Boolean;
    function  CreateForm(AClass: TCustomFormClass): TCustomForm;
    function  CreateShowForm(AClass: TCustomFormClass;
      DestroyCurrent: Boolean{$ifdef DP} = True{$endif}): TCustomForm;
    function  CreateShowFormEx(AClass: TCustomFormClass;
      DestroyCurrent: Boolean{$ifdef DP} = True{$endif};
      Transition: TTransitionEffect{$ifdef DP} = nil{$endif};
      BackgrOptions: TFCBackgroundOptions{$ifdef DP} = nil{$endif};
      Align: TFCFormAlign{$ifdef DP} = fcfaDefault{$endif}): TCustomForm;
    procedure ShowForm(AForm: TCustomForm;
      DestroyCurrent: Boolean{$ifdef DP} = True{$endif});
    procedure ShowFormEx(AForm: TCustomForm{$ifdef DP} = nil{$endif};
      DestroyCurrent: Boolean{$ifdef DP} = True{$endif};
      Transition: TTransitionEffect{$ifdef DP} = nil{$endif};
      BackgrOptions: TFCBackgroundOptions{$ifdef DP} = nil{$endif};
      Align: TFCFormAlign{$ifdef DP} = fcfaDefault{$endif});
    function ShowLRUForm(Index: Integer;
      DestroyCurrent: Boolean{$ifdef DP} = True{$endif}): Boolean;
    function ShowLRUFormEx(Index: Integer;
      DestroyCurrent: Boolean{$ifdef DP} = True{$endif};
      Transition: TTransitionEffect{$ifdef DP} = nil{$endif};
      BackgrOptions: TFCBackgroundOptions{$ifdef DP} = nil{$endif};
      Align: TFCFormAlign{$ifdef DP} = fcfaDefault{$endif}): Boolean;
    function  HasNextLRUForm: Boolean;
    function  HasPriorLRUForm: Boolean;
    function  ShowNextLRUForm(DestroyCurrent: Boolean{$ifdef DP} = True{$endif}): Boolean;
    function  ShowNextLRUFormEx(DestroyCurrent: Boolean{$ifdef DP} = True{$endif};
      Transition: TTransitionEffect{$ifdef DP} = nil{$endif};
      BackgrOptions: TFCBackgroundOptions{$ifdef DP} = nil{$endif};
      Align: TFCFormAlign{$ifdef DP} = fcfaDefault{$endif}): Boolean;
    function  ShowPriorLRUForm(DestroyCurrent: Boolean{$ifdef DP} = True{$endif}): Boolean;
    function  ShowPriorLRUFormEx(DestroyCurrent: Boolean{$ifdef DP} = True{$endif};
      Transition: TTransitionEffect{$ifdef DP} = nil{$endif};
      BackgrOptions: TFCBackgroundOptions{$ifdef DP} = nil{$endif};
      Align: TFCFormAlign{$ifdef DP} = fcfaDefault{$endif}): Boolean;
    procedure DestroyForm(F: TCustomForm);
    procedure DestroyAllForms;

    property  Form: TCustomForm read FForm;
    property  Forms[Index: Integer]: TCustomForm read GetForms; default;
    property  FormsData[Index: Integer]: TFCFormData read GetFormData;
    property  LRUFormIndex: Integer read FLRUFormIndex;
    property  LRUForms[Index: Integer]: TCustomForm read GetLRUForm;
    property  LRUFormsData[Index: Integer]: TFCFormData read GetLRUFormData;
  published
    property  Align;
    property  AutoScroll default False;
    property  BackgroundOptions: TFCBackgroundOptions read FBackgroundOptions write SetBackgroundOptions;
    property  BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone;
    property  DragCursor;
    property  DragMode;
    property  Enabled;
    property  Color nodefault;
    property  Ctl3D;
    property  FlickerFree: Boolean read FFlickerFree write FFlickerFree default True;
    property  Font;
    property  HorzScrollBar;
    property  LRUFormCapacity: Integer read FLRUFormCapacity write SetLRUFormCapacity default 20;
    property  ParentColor;
    property  ParentCtl3D;
    property  ParentFont;
    {$ifdef D7UP}
    property  ParentBackground;
    {$endif D7UP}
    property  ParentShowHint;
    property  Picture: TPicture read GetPicture write SetPicture stored False; // For backwards compatibility with V1.x
    property  PopupMenu;
    property  SafeFormDestroy: Boolean read FSafeFormDestroy write FSafeFormDestroy default True;
    property  SaveLRUDestroyedForms: Boolean read FSaveLRUDestroyedForms write FSaveLRUDestroyedForms default False;
    property  ShowHint;
    property  TabOrder;
    property  TabStop;
    property  Version: String read GetVersion write SetVersion stored False;
    property  VertScrollBar;
    property  Visible;
    property  OnClick;
    property  OnDblClick;
    property  OnDragDrop;
    property  OnDragOver;
    property  OnEndDrag;
    property  OnEnter;
    property  OnExit;
    property  OnFormChange: TFCFormChangeEvent read FOnFormChange write FOnFormChange;
    property  OnFormCreate: TFCFormCreateEvent read FOnFormCreate write FOnFormCreate;
    property  OnFormDestroy: TFCFormDestroyEvent read FOnFormDestroy write FOnFormDestroy;
    property  OnMouseDown;
    property  OnMouseMove;
    property  OnMouseUp;
{$ifndef D3C3}
    property  Anchors;
    property  BevelEdges;
    property  BevelInner;
    property  BevelOuter;
    property  BevelKind;
    property  BevelWidth;
    property  BiDiMode;
    property  BorderWidth;
    property  Constraints;
    property  DragKind;
    property  ParentBiDiMode;
    property  OnEndDock;
    property  OnStartDock;
    property  OnStartDrag;
{$endif D3C3}
  end;

  TFCGetExtraDataClassEvent = procedure(Sender: TObject;
    var ExtraDataClass: TFCExtraDataClass) of object;
  TFCExtraDataEvent = procedure(Sender: TObject;
    ExtraData: TFCExtraData) of object;

  TTECustomForm = class(TCustomForm);

  TFCEmbeddedForm = class(TCustomForm)
  private
    FBackgroundOptions: TFCBackgroundOptions;
    FOnGetExtraDataClass: TFCGetExtraDataClassEvent;
    FOnGetExtraData,
    FOnSetExtraData: TFCExtraDataEvent;
    FAlignment: TFCFormAlign;

    function  GetVersion: String;
    procedure SetVersion(const Value: String);
    procedure SetBackgroundOptions(Value: TFCBackgroundOptions);

    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
    procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
    procedure CMParentFontChanged(var Message: TMessage); message CM_ParentFontChanged; //V34
    {$ifdef BCB}
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    {$endif BCB}
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    function  GetPalette: HPALETTE; override;
    {$ifdef BCB}
    procedure Paint; override;
    {$else}
    procedure PaintWindow(DC: HDC); override;
    {$endif BCB}
    procedure SetParent(AParent: TWinControl); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    function    ParentFormContainer: TFormContainer;
  published
    // TCustomForm properties / events
    {$ifndef D3C3}
    property Action;
    {$endif D3C3}
    property ActiveControl;
    {$ifndef D3C3}
    {$endif D3C3}
    {$ifndef D3C3}
    property BiDiMode;
    {$endif D3C3}
    property Caption;
    property ClientHeight stored True;
    property ClientWidth stored True;
    property Color;
    {$ifndef D3C3}
    {$endif D3C3}
    property Ctl3D;
    {$ifndef D3C3}
    property UseDockManager;
    property DockSite;
    property DragKind;
    property DragMode;
    {$endif D3C3}
    property Enabled;
    property ParentFont default False;
    property Font;
    property Height stored False;
    property HelpFile;
    property KeyPreview;
    property Menu;
    {$ifndef D3C3}
    property OldCreateOrder;
    {$endif D3C3}
    property ObjectMenuItem;
    {$ifdef D7UP}
    property  ParentBackground;
    {$endif D7UP}
    {$ifndef D3C3}
    property ParentBiDiMode;
    {$endif D3C3}
    property PixelsPerInch;
    property PopupMenu;
    property Scaled;
    property ShowHint;
    property Width stored False;
    {$ifndef D3C3}
    property OnCanResize;
    {$endif D3C3}
    property OnClick;
    property OnClose;
    property OnCloseQuery;
    {$ifndef D3C3}
    property OnConstrainedResize;
    {$endif D3C3}
    {$ifdef D6}
    property OnContextPopup;
    {$endif D6}
    property OnCreate;
    property OnDblClick;
    property OnDestroy;
    {$ifndef D3C3}
    property OnDockDrop;
    property OnDockOver;
    {$endif D3C3}
    property OnDragDrop;
    property OnDragOver;
    {$ifndef D3C3}
    property OnEndDock;
    property OnGetSiteInfo;
    {$endif D3C3}
    property OnHide;
    property OnHelp;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    {$ifndef D3C3}
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    {$endif D3C3}
    property OnPaint;
    property OnResize;
    {$ifndef D3C3}
    property OnShortCut;
    {$endif D3C3}
    property OnShow;
    {$ifndef D3C3}
    property OnStartDock;
    property OnUnDock;
    {$endif D3C3}

    // Added properties / events
    property Alignment: TFCFormAlign read FAlignment write FAlignment default fcfaCenter;
    property BackgroundOptions: TFCBackgroundOptions read FBackgroundOptions write SetBackgroundOptions;
    property Version: String read GetVersion write SetVersion stored False;

    property OnEnter;
    property OnExit;

    property OnGetExtraDataClass: TFCGetExtraDataClassEvent read FOnGetExtraDataClass write FOnGetExtraDataClass;
    property OnGetExtraData: TFCExtraDataEvent read FOnGetExtraData write FOnGetExtraData;
    property OnSetExtraData: TFCExtraDataEvent read FOnSetExtraData write FOnSetExtraData;
  end;

  procedure FCKeyPreview(WinControl: TWinControl; var Key: Word;
    Shift: TShiftState);
  {$ifndef D3C3}
  procedure FCIsShortCut(WinControl: TWinControl; var Msg: TWMKey;
    var Handled: Boolean);
  {$endif D3C3}

implementation

{$ifdef D7UP}
uses Themes, UxTheme;
{$endif D7UP}

resourcestring
  rsFCLockedFormCont = 'FomContainer is locked';
  rsFCUnknownForm    = 'Form ''%s'' unknown';
  rsFCBorderStyle    = '''BorderStyle'' property of ''%s'' must be ''bsNone''';
  rsFCVisible        = '''Visible'' property of ''%s'' must be ''False'' at design time';
  rsFCState          = '''WindowState'' property of ''%s'' must be ''wsNormal''';
  rsFCStyle          = '''FormStyle'' property of ''%s'' must be ''fsNormal''';

type
  TFCCustomForm = class(TCustomForm);
  TFCWinControl = class(TWinControl);

  TFCOnFormDestroyData = class
  public
    Form: TCustomForm;
    OnFormDestroyBack: TNotifyEvent;

    procedure OnFormDestroy(Sender: TObject);
  end;

var
  OnFormDestroyList: TList = nil;

procedure HideEmbeddedForms(WinControl: TWinControl);
var
  i: Integer;
begin
  for i:=WinControl.ControlCount-1 downto 0 do
  begin
    if WinControl.Controls[i] is TWinControl then
      HideEmbeddedForms(WinControl.Controls[i] as TWinControl);
  end;

  if(WinControl is TFormContainer)             and
    (TFormContainer(WinControl).FormCount > 0) then
    (WinControl as TFormContainer).ShowForm(nil, False);
end;

function GetOnFormDestroyData(Form: TCustomForm): TFCOnFormDestroyData;
var
  i: Integer;
begin
  Result := nil;

  if OnFormDestroyList = nil then
    Exit;

  for i:=0 to OnFormDestroyList.Count-1 do
  begin
    if TFCOnFormDestroyData(OnFormDestroyList[i]).Form = Form then
    begin
      Result := TFCOnFormDestroyData(OnFormDestroyList[i]);
      Break;
    end;
  end;
end;

procedure FCKeyPreview(WinControl: TWinControl; var Key: Word;
  Shift: TShiftState);
var
  i: Integer;
  ChildWinControl: TWinControl;
begin
  if Key <> 0 then
  begin
    for i:= 0 to WinControl.ControlCount-1 do
    begin
      if WinControl.Controls[i] is TWinControl then
      begin
        ChildWinControl := TWinControl(WinControl.Controls[i]);
        if ChildWinControl.Visible then
        begin
          FCKeyPreview(ChildWinControl, Key, Shift);
          if(ChildWinControl is TCustomForm)          and
            TCustomForm  (ChildWinControl).KeyPreview then
            TFCWinControl(ChildWinControl).KeyDown(Key, Shift);
        end;
      end;
    end;
  end;
end;

{$ifndef D3C3}
procedure FCIsShortCut(WinControl: TWinControl; var Msg: TWMKey;
 var Handled: Boolean);
var
 i: Integer;
 ChildWinControl: TWinControl;
begin
 for i:= 0 to WinControl.ControlCount-1 do
 begin
   if WinControl.Controls[i] is TWinControl then
   begin
     ChildWinControl := TWinControl(WinControl.Controls[i]);
     if ChildWinControl.Visible then
     begin
       FCIsShortCut(ChildWinControl, Msg, Handled);
       if WinControl.Controls[i] is TCustomForm then
         TFCCustomForm(WinControl.Controls[i]).OnShortCut(Msg,
           Handled);
     end;
   end;