main.pas

jvcl driver development envionment

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}

{$I jvcl.inc}

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Menus, ComCtrls, ToolWin, JvDockControlForm, JvDockTree,
  JvDockVCStyle, JvDockDelphiStyle, JvDockVIDStyle, JvDockVSNetStyle, JvDockVIDVCStyle, 
  JvDockSupportClass, ActnList
  {$IFDEF USEJVCL}
  , JvComponent, JvAppStorage, JvAppRegistryStorage, JvAppIniStorage, JvAppXmlStorage
  {$ENDIF}
  {$IFDEF VER150}, XPMan{$ENDIF};

type
  TRunTimeForm = class(TForm)
  private
    FMenuItem: TMenuItem;
    FDockClient: TJvDockClient;
    procedure SetMenuItem(AMenuItem: TMenuItem);
  protected
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure lbDockClient1FormHide(Sender: TObject);
    procedure lbDockClient1FormShow(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property MenuItem: TMenuItem read FMenuItem write SetMenuItem;
    property DockClient: TJvDockClient read FDockClient;
  end;

  TMainForm = class(TForm)
    MainMenu1: TMainMenu;
    DockForm_Menu: TMenuItem;
    DelphiStyle: TMenuItem;
    VCStyle: TMenuItem;
    VIDStyle: TMenuItem;
    ToolBar1: TToolBar;
    btnDelphi: TToolButton;
    btnVC: TToolButton;
    btnVID: TToolButton;
    ShowWindow_Menu: TMenuItem;
    DockInfo_Menu: TMenuItem;
    SaveToIniFile: TMenuItem;
    LoadFromIniFile: TMenuItem;
    SaveToReg: TMenuItem;
    LoadFromReg: TMenuItem;
    N24: TMenuItem;
    DockOption_Menu: TMenuItem;
    TopDocked: TMenuItem;
    BottomDocked: TMenuItem;
    LeftDocked: TMenuItem;
    RightDocked: TMenuItem;
    AllDocked: TMenuItem;
    N31: TMenuItem;
    lbDockServer1: TJvDockServer;
    JvDockDelphiStyle1: TJvDockDelphiStyle;
    JvDockVCStyle1: TJvDockVCStyle;
    JvDockVIDStyle1: TJvDockVIDStyle;
    StatusBar1: TStatusBar;
    btnVSNet: TToolButton;
    VSNETStyle: TMenuItem;
    PopupMenu2: TPopupMenu;
    ClientDockorFloat: TMenuItem;
    ClientHide: TMenuItem;
    ClientTopDocked: TMenuItem;
    ClientBottomDocked: TMenuItem;
    ClientLeftDocked: TMenuItem;
    ClientRightDocked: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    ClientEachOtherDocked: TMenuItem;
    ClientAllDocked: TMenuItem;
    Memo1: TMemo;
    JvDockVSNetStyle1: TJvDockVSNetStyle;
    N1: TMenuItem;
    SaveToXmlFile: TMenuItem;
    LoadFromXmlFile: TMenuItem;
    ToolButton1: TToolButton;
    JvDockVIDVCStyle1: TJvDockVIDVCStyle;
    ToolButton2: TToolButton;
    ServerStyle_Menu: TMenuItem;
    ServerDelphiStyle: TMenuItem;
    ServerVisualCStyle: TMenuItem;
    ServerVisualInterDevStyle: TMenuItem;
    ServerVisualStudionetStyle: TMenuItem;
    ActionList1: TActionList;
    actServerStyleDelphi: TAction;
    actServerStyleVC: TAction;
    actServerStyleVID: TAction;
    actServerStyleVSNet: TAction;
    actServerStyleVIDVC: TAction;
    VisualInterDevCStyle1: TMenuItem;
    actNewWindowDelphiStyle: TAction;
    actNewWindowVCStyle: TAction;
    actNewWindowVIDStyle: TAction;
    actNewWindowVSNetStyle: TAction;
    actNewWindowVIDVCStyle: TAction;
    VIDVCStyle1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure SaveToIniFileClick(Sender: TObject);
    procedure LoadFromIniFileClick(Sender: TObject);
    procedure SaveToRegClick(Sender: TObject);
    procedure LoadFromRegClick(Sender: TObject);
    procedure TopDockedClick(Sender: TObject);
    procedure BottomDockedClick(Sender: TObject);
    procedure LeftDockedClick(Sender: TObject);
    procedure RightDockedClick(Sender: TObject);
    procedure AllDockedClick(Sender: TObject);
    procedure PopupMenu2Popup(Sender: TObject);
    procedure ClientTopDockedClick(Sender: TObject);
    procedure ClientBottomDockedClick(Sender: TObject);
    procedure ClientLeftDockedClick(Sender: TObject);
    procedure ClientRightDockedClick(Sender: TObject);
    procedure ClientEachOtherDockedClick(Sender: TObject);
    procedure ClientAllDockedClick(Sender: TObject);
    procedure ClientDockorFloatClick(Sender: TObject);
    procedure ClientHideClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SaveToXmlFileClick(Sender: TObject);
    procedure LoadFromXmlFileClick(Sender: TObject);
    procedure CloseAllClick(Sender: TObject);
    procedure actServerStyleExecute(Sender: TObject);
    procedure actServerStyleUpdate(Sender: TObject);
    procedure NewWindowExecute(Sender: TObject);
  private
    { Private declarations }
    {$IFDEF USEJVCL}
    FJvAppRegistryStorage: TJvAppRegistryStorage;
    FJvAppIniFileStorage: TJvAppIniFileStorage;
    FJvAppXmlStorage: TJvAppXmlFileStorage;
    {$ENDIF}
    FFormCount: array[0..4] of Integer;
    procedure AddRunTimeItemToShowDockMenu(AForm: TRunTimeForm);
    procedure ShowDockWindowMenuClick(Sender: TObject);

    {$IFDEF USEJVCL}
    procedure LoadFromAppStorage(AppStorage: TJvCustomAppStorage);
    procedure SaveToAppStorage(AppStorage: TJvCustomAppStorage);

    procedure SaveFormsToAppStorage(AppStorage: TJvCustomAppStorage);
    procedure LoadFormsFromAppStorage(AppStorage: TJvCustomAppStorage);

    procedure FreeRunTimeForms;
    {$ENDIF}

    function GetFormCount(AStyle: TJvDockBasicStyle): Integer;
    procedure SetFormCount(AStyle: TJvDockBasicStyle;
      const Value: Integer);

    procedure ConstructRunTimeForm(AStyle: TJvDockBasicStyle; const AName: string);
  public
    function ActionToStyle(AAction: TAction): TJvDockBasicStyle;
    function IDToStyle(const ID: Integer): TJvDockBasicStyle;
    function StyleToStr(AStyle: TJvDockBasicStyle): string;
    function StyleToID(AStyle: TJvDockBasicStyle): Integer;

    procedure UpdateCaption;

    property FormCount[AStyle: TJvDockBasicStyle]: Integer read GetFormCount write SetFormCount;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

const
  // Used as value of the tags of the actions, for example actServerStyleVIDVC.Tag = 4
  cDelphiStyleID = 0;
  cVisualCStyleID = 1;
  cVisualInterDevStyleID = 2;
  cVisualStudioNetStyleID = 3;
  cVisualInterDevVisualCStyleID = 4;

  cStyleStr: array[0..4] of string = (
    'Delphi Style',
    'Visual C++ Style',
    'Visual InterDev Style',
    'Visual Studio.Net Style',
    'Visual InterDev C++ Style'
    );

//=== Local procedures =======================================================

function CreateUniqueName: string;
var
  I: Integer;

  function IsUnique(const AName: string): Boolean;
  var
    I: Integer;
  begin
    Result := False;
    for I := 0 to Screen.FormCount - 1 do
      if CompareText(AName, Screen.Forms[I].Name) = 0 then
        Exit;
    Result := True;
  end;

begin
  for I := 1 to MaxInt do
  begin
    Result := Format('RunTimeForm_%d', [I]);
    if IsUnique(Result) then
      Exit;
  end;
end;

//=== { TMainForm } ==========================================================

function TMainForm.ActionToStyle(AAction: TAction): TJvDockBasicStyle;
begin
  Result := IDToStyle(AAction.Tag);
end;

procedure TMainForm.actServerStyleExecute(Sender: TObject);
begin
  if Sender is TAction then
  begin
    lbDockServer1.DockStyle := ActionToStyle(TAction(Sender));
    UpdateCaption;
  end;
end;

procedure TMainForm.actServerStyleUpdate(Sender: TObject);
begin
  if Sender is TAction then
    TAction(Sender).Checked :=
      lbDockServer1.DockStyle = ActionToStyle(TAction(Sender));
end;

procedure TMainForm.AddRunTimeItemToShowDockMenu(AForm: TRunTimeForm);
var
  AMenuItem: TMenuItem;
begin
  AMenuItem := NewItem(AForm.Caption, 0, True, True,
    ShowDockWindowMenuClick, 0, '');
  ShowWindow_Menu.Add(AMenuItem);
  AMenuItem.Tag := Integer(AForm);
  AForm.MenuItem := AMenuItem;
end;

procedure TMainForm.AllDockedClick(Sender: TObject);
begin
  AllDocked.Checked := not AllDocked.Checked;
  lbDockServer1.EnableDock := AllDocked.Checked;
end;

procedure TMainForm.BottomDockedClick(Sender: TObject);
begin
  BottomDocked.Checked := not BottomDocked.Checked;
  lbDockServer1.BottomDock := BottomDocked.Checked;
end;

procedure TMainForm.ClientAllDockedClick(Sender: TObject);
var
  DockClient: TJvDockClient;
begin
  if PopupMenu2.PopupComponent is TForm then
  begin
    DockClient := FindDockClient(TForm(PopupMenu2.PopupComponent));
    if DockClient <> nil then
    begin
      ClientAllDocked.Checked := not ClientAllDocked.Checked;
      DockClient.EnableDock := ClientAllDocked.Checked;
    end;
  end;
end;

procedure TMainForm.ClientBottomDockedClick(Sender: TObject);
var
  DockClient: TJvDockClient;
begin
  if PopupMenu2.PopupComponent is TForm then
  begin
    DockClient := FindDockClient(TForm(PopupMenu2.PopupComponent));
    if DockClient <> nil then
    begin
      ClientBottomDocked.Checked := not ClientBottomDocked.Checked;
      DockClient.BottomDock := ClientBottomDocked.Checked;
    end;
  end;
end;

procedure TMainForm.ClientDockorFloatClick(Sender: TObject);
var
  DockClient: TJvDockClient;
begin
  if PopupMenu2.PopupComponent is TForm then
  begin
    DockClient := FindDockClient(TForm(PopupMenu2.PopupComponent));
    if DockClient <> nil then
      DockClient.RestoreChild;
  end;
end;

procedure TMainForm.ClientEachOtherDockedClick(Sender: TObject);
var
  DockClient: TJvDockClient;
begin
  if PopupMenu2.PopupComponent is TForm then
  begin
    DockClient := FindDockClient(TForm(PopupMenu2.PopupComponent));
    if DockClient <> nil then
    begin
      ClientEachOtherDocked.Checked := not ClientEachOtherDocked.Checked;
      DockClient.EachOtherDock := ClientEachOtherDocked.Checked;
    end;
  end;
end;

procedure TMainForm.ClientHideClick(Sender: TObject);
var
  DockClient: TJvDockClient;
begin
  if PopupMenu2.PopupComponent is TForm then
  begin
    DockClient := FindDockClient(TForm(PopupMenu2.PopupComponent));
    if DockClient <> nil then
      DockClient.HideParentForm;
  end;
end;

procedure TMainForm.ClientLeftDockedClick(Sender: TObject);
var
  DockClient: TJvDockClient;
begin
  if PopupMenu2.PopupComponent is TForm then
  begin
    DockClient := FindDockClient(TForm(PopupMenu2.PopupComponent));
    if DockClient <> nil then
    begin
      ClientLeftDocked.Checked := not ClientLeftDocked.Checked;
      DockClient.LeftDock := ClientLeftDocked.Checked;
    end;
  end;
end;

procedure TMainForm.ClientRightDockedClick(Sender: TObject);
var
  DockClient: TJvDockClient;
begin
  if PopupMenu2.PopupComponent is TForm then
  begin
    DockClient := FindDockClient(TForm(PopupMenu2.PopupComponent));
    if DockClient <> nil then
    begin
      ClientRightDocked.Checked := not ClientRightDocked.Checked;
      DockClient.RightDock := ClientRightDocked.Checked;
    end;
  end;
end;

procedure TMainForm.ClientTopDockedClick(Sender: TObject);
var
  DockClient: TJvDockClient;
begin
  if PopupMenu2.PopupComponent is TForm then
  begin
    DockClient := FindDockClient(TForm(PopupMenu2.PopupComponent));
    if DockClient <> nil then
    begin
      ClientTopDocked.Checked := not ClientTopDocked.Checked;
      DockClient.TopDock := ClientTopDocked.Checked;
    end;
  end;
end;

procedure TMainForm.CloseAllClick(Sender: TObject);
var
  aMenuItem: TMenuItem;
  Frm: TForm;
  DockClient: TJvDockClient;
  I: Integer;
begin
  for I := ShowWindow_Menu.Count -1 downto 0 do
  begin
    aMenuItem := ShowWindow_Menu.Items[I];
    Frm := TForm(aMenuItem.Tag);
    DockClient := FindDockClient(Frm);
    if DockClient <> nil then
      DoFloatForm(Frm);

    { It should also work with Frm.Free, but that gives problems, needs to be
      fixed }
    Frm.Release;

    { A TRunTimeForm form implicitly destroys its attached MenuItem }
    if not (Frm is TRunTimeForm) then
      ShowWindow_Menu.Delete(I);

    { Without the next call, not all helper forms will be destroyed. This needs
      to be fixed }
    Application.ProcessMessages;
  end;
end;

procedure TMainForm.ConstructRunTimeForm(AStyle: TJvDockBasicStyle; const AName: string);
var
  Frm: TRunTimeForm;
  LStyle: Integer;
begin
  Frm := TRunTimeForm.Create(Application);
  Frm.Visible := True;
  if AName = '' then