main.pas

jvcl driver development envionment

    Frm.Name := CreateUniqueName
  else
    Frm.Name := AName;
  Frm.Caption := StyleToStr(AStyle) + ' _ ' + IntToStr(FormCount[AStyle]);
  FormCount[AStyle] := FormCount[AStyle] + 1;
  Frm.DockClient.DockStyle := AStyle;

  LStyle := StyleToID(AStyle);
  Frm.DockClient.DirectDrag :=
    (LStyle = cVisualCStyleID) or (LStyle = cDelphiStyleID);
  Frm.DockClient.EachOtherDock :=
    (LStyle = cVisualStudioNetStyleID) or
    (LStyle = cVisualInterDevVisualCStyleID) or
    (LStyle = cVisualInterDevStyleID);

  AddRunTimeItemToShowDockMenu(Frm);
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  TopDocked.Checked := lbDockServer1.TopDock;
  BottomDocked.Checked := lbDockServer1.BottomDock;
  LeftDocked.Checked := lbDockServer1.LeftDock;
  RightDocked.Checked := lbDockServer1.RightDock;
  AllDocked.Checked := lbDockServer1.EnableDock;
  Memo1.WordWrap := True;
  UpdateCaption;
  {$IFDEF USEJVCL}
  FJvAppRegistryStorage := TJvAppRegistryStorage.Create(self);
  FJvAppRegistryStorage.Path := '\Software\JVCL\Examples\JvDocking\AdvancePro';
  FJvAppRegistryStorage.AutoFlush := True;
  FJvAppRegistryStorage.AutoReload := True;
  FJvAppIniFileStorage := TJvAppIniFileStorage.Create(self);
  FJvAppIniFileStorage.FileName := 'DockInfo.ini';
  FJvAppIniFileStorage.AutoFlush := True;
  FJvAppIniFileStorage.AutoReload := True;
  FJvAppXmlStorage := TJvAppXmlFileStorage.Create(self);
  FJvAppXMLStorage.FileName := 'DockInfo.xml';
  FJvAppXMLStorage.AutoFlush := True;
  FJvAppXMLStorage.AutoReload := True;
  {$ENDIF}
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  {$IFDEF USEJVCL}
  { Prevent last Flush by setting Path/FileName to '' }
  FJvAppRegistryStorage.Path := '';
  FreeAndNil(FJvAppRegistryStorage);
  FJvAppIniFileStorage.FileName := '';
  FreeAndNil(FJvAppIniFileStorage);
  FJvAppXmlStorage.FileName := '';
  FreeAndNil(FJvAppXmlStorage);
  {$ENDIF}
end;

{$IFDEF USEJVCL}
procedure TMainForm.FreeRunTimeForms;
var
  I: Integer;
  Frm: TForm;
  ADockClient: TJvDockClient;
begin
  for I := Screen.FormCount - 1 downto 0 do
    if Screen.Forms[I] is TRunTimeForm then
    begin
      Frm := Screen.Forms[I];
      ADockClient := FindDockClient(Frm);
      if ADockClient <> nil then
        DoFloatForm(Frm);
      Frm.Free;
    end;
end;
{$ENDIF USEJVCL}

function TMainForm.GetFormCount(AStyle: TJvDockBasicStyle): Integer;
begin
  Result := FFormCount[StyleToID(AStyle)];
end;

function TMainForm.IDToStyle(const ID: Integer): TJvDockBasicStyle;
begin
  case ID of
    cDelphiStyleID: Result := JvDockDelphiStyle1;
    cVisualCStyleID: Result := JvDockVCStyle1;
    cVisualInterDevStyleID: Result := JvDockVIDStyle1;
    cVisualStudioNetStyleID: Result := JvDockVSNetStyle1;
    cVisualInterDevVisualCStyleID: Result := JvDockVIDVCStyle1;
  else
    Result := nil;
  end;
end;

procedure TMainForm.LeftDockedClick(Sender: TObject);
begin
  LeftDocked.Checked := not LeftDocked.Checked;
  lbDockServer1.LeftDock := LeftDocked.Checked;
end;

{$IFDEF USEJVCL}

procedure TMainForm.LoadFormsFromAppStorage(
  AppStorage: TJvCustomAppStorage);
var
  I: Integer;
  OldPath: string;
  Count: Integer;
  APath: string;

  FrmName: string;
  StyleID: Integer;
begin
  OldPath := AppStorage.Path;
  AppStorage.Path := AppStorage.ConcatPaths([OldPath, 'ExtraInfo']);
  try
    { Read and set the dock style of the dockserver component }
    StyleID := AppStorage.ReadInteger('ServerStyle');
    lbDockServer1.DockStyle := IDToStyle(StyleID);
    UpdateCaption;

    { Read the name and dock style of the forms and create the forms }
    Count := AppStorage.ReadInteger('Count');
    for I := 0 to Count - 1 do
    begin
      APath := Format('Item%d', [I]);
      FrmName := AppStorage.ReadString(AppStorage.ConcatPaths([APath, 'Name']));
      StyleID := AppStorage.ReadInteger(AppStorage.ConcatPaths([APath, 'StyleID']));

      ConstructRunTimeForm(IDToStyle(StyleID), FrmName);
    end;
  finally
    AppStorage.Path := OldPath;
  end;
end;

procedure TMainForm.LoadFromAppStorage(AppStorage: TJvCustomAppStorage);
begin
  FreeRunTimeForms;

  AppStorage.BeginUpdate;
  try
    LoadFormsFromAppStorage(AppStorage);
    LoadDockTreeFromAppStorage(AppStorage);
  finally
    AppStorage.EndUpdate;
  end;
end;

{$ENDIF USEJVCL}

procedure TMainForm.LoadFromIniFileClick(Sender: TObject);
begin
  {$IFDEF USEJVCL}
  LoadFromAppStorage(FJvAppIniFileStorage);
  {$ELSE}
  LoadDockTreeFromFile(ExtractFilePath(Application.ExeName) + 'DockInfo.ini');
  {$ENDIF}
end;

procedure TMainForm.LoadFromRegClick(Sender: TObject);
begin
  {$IFDEF USEJVCL}
  LoadFromAppStorage(FJvAppRegistryStorage);
  {$ELSE}
  LoadDockTreeFromReg(HKEY_CURRENT_USER, '\Software\DockInfo');
  {$ENDIF}
end;

procedure TMainForm.LoadFromXmlFileClick(Sender: TObject);
begin
  {$IFDEF USEJVCL}
  LoadFromAppStorage(FJvAppXmlStorage);
  {$ELSE}
  ShowMessage('Not supported unless USEJVCL is defined');
  {$ENDIF}
end;

procedure TMainForm.NewWindowExecute(Sender: TObject);
begin
  if Sender is TAction then
    ConstructRunTimeForm(ActionToStyle(TAction(Sender)), '');
end;

procedure TMainForm.PopupMenu2Popup(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 := DockClient.TopDock;
      ClientBottomDocked.Checked := DockClient.BottomDock;
      ClientLeftDocked.Checked := DockClient.LeftDock;
      ClientRightDocked.Checked := DockClient.RightDock;
      ClientEachOtherDocked.Checked := DockClient.EachOtherDock;
      ClientAllDocked.Checked := DockClient.EnableDock;
      if DockClient.DockState = JvDockState_Floating then
        ClientDockorFloat.Caption := 'Dock'
      else
        ClientDockorFloat.Caption := 'Float';
    end;
  end;
end;

procedure TMainForm.RightDockedClick(Sender: TObject);
begin
  RightDocked.Checked := not RightDocked.Checked;
  lbDockServer1.RightDock := RightDocked.Checked;
end;

{$IFDEF USEJVCL}

procedure TMainForm.SaveFormsToAppStorage(AppStorage: TJvCustomAppStorage);
var
  I: Integer;
  OldPath: string;
  APath: string;
  Count: Integer;

  Frm: TForm;
  FrmDockClient: TJvDockClient;
begin
  Count := 0;
  OldPath := AppStorage.Path;
  AppStorage.Path := AppStorage.ConcatPaths([OldPath, 'ExtraInfo']);
  try
    AppStorage.WriteInteger('ServerStyle', StyleToID(lbDockServer1.DockStyle));
    for I := 0 to Screen.FormCount - 1 do
      if Screen.Forms[I] is TRunTimeForm then
      begin
        Frm := Screen.Forms[I];
        FrmDockClient := FindDockClient(Frm);
        if Assigned(FrmDockClient) then
        begin
          APath := Format('Item%d', [Count]);
          AppStorage.WriteString(AppStorage.ConcatPaths([APath, 'Name']), Frm.Name);
          AppStorage.WriteInteger(AppStorage.ConcatPaths([APath, 'StyleID']),
            StyleToID(FrmDockClient.DockStyle));
          Inc(Count);
        end;
      end;
    AppStorage.WriteInteger('Count', Count);
  finally
    AppStorage.Path := OldPath;
  end;
end;

procedure TMainForm.SaveToAppStorage(AppStorage: TJvCustomAppStorage);
begin
  AppStorage.BeginUpdate;
  try
    SaveDockTreeToAppStorage(AppStorage);
    { SaveDockTreeToAppStorage clears the storage, so we save the forms after the
      SaveDockTreeToAppStorage call }
    SaveFormsToAppStorage(AppStorage);
  finally
    AppStorage.EndUpdate;
  end;
end;

{$ENDIF USEJVCL}

procedure TMainForm.SaveToIniFileClick(Sender: TObject);
begin
  {$IFDEF USEJVCL}
  SaveToAppStorage(FJvAppIniFileStorage);
  {$ELSE}
  SaveDockTreeToFile(ExtractFilePath(Application.ExeName) + 'DockInfo.ini');
  {$ENDIF}
end;

procedure TMainForm.SaveToRegClick(Sender: TObject);
begin
  {$IFDEF USEJVCL}
  SaveToAppStorage(FJvAppRegistryStorage);
  {$ELSE}
  SaveDockTreeToReg(HKEY_CURRENT_USER, '\Software\DockInfo');
  {$ENDIF}
end;

procedure TMainForm.SaveToXmlFileClick(Sender: TObject);
begin
  {$IFDEF USEJVCL}
  SaveToAppStorage(FJvAppXmlStorage);
  {$ELSE}
  ShowMessage('Not supported unless USEJVCL is defined');
  {$ENDIF}
end;

procedure TMainForm.SetFormCount(AStyle: TJvDockBasicStyle;
  const Value: Integer);
begin
  FFormCount[StyleToID(AStyle)] := Value;
end;

procedure TMainForm.ShowDockWindowMenuClick(Sender: TObject);
var
  MenuItem: TMenuItem;
  Frm: TForm;
begin
  MenuItem := TMenuItem(Sender);
  Frm := TForm(MenuItem.Tag);
  if MenuItem.Checked then
  begin
    if GetFormVisible(Frm) then
    begin
      HideDockForm(Frm);
      MenuItem.Checked := False;
    end
    else
      ShowDockForm(Frm);
  end
  else
  begin
    ShowDockForm(Frm);
    MenuItem.Checked := True;
  end;
end;

function TMainForm.StyleToID(AStyle: TJvDockBasicStyle): Integer;
begin
  if AStyle is TJvDockVSNetStyle then
    Result := cVisualStudioNetStyleID
  else
  if AStyle is TJvDockVIDVCStyle then
    Result := cVisualInterDevVisualCStyleID
  else
  if AStyle is TJvDockVIDStyle then
    Result := cVisualInterDevStyleID
  else
  if AStyle is TJvDockVCStyle then
    Result := cVisualCStyleID
  else
  if AStyle is TJvDockDelphiStyle then
    Result := cDelphiStyleID
  else
    raise Exception.Create('Unknown style');
end;

function TMainForm.StyleToStr(AStyle: TJvDockBasicStyle): string;
begin
  Result := cStyleStr[StyleToID(AStyle)];
end;

procedure TMainForm.TopDockedClick(Sender: TObject);
begin
  TopDocked.Checked := not TopDocked.Checked;
  lbDockServer1.TopDock := TopDocked.Checked;
end;

procedure TMainForm.UpdateCaption;
begin
  Caption := 'Main Window (docking is set to ' + lbDockServer1.DockStyle.ClassName + ')';
end;

//=== { TRunTimeForm } =======================================================

constructor TRunTimeForm.Create(AOwner: TComponent);
begin
  CreateNew(AOwner);
  Width := 186;
  Height := 188;
  BorderStyle := bsSizeToolWin;
  DockSite := True;
  DragKind := dkDock;
  DragMode := dmAutomatic;
  Font.Name := 'MS Shell Dlg 2';
  FormStyle := fsStayOnTop;
  Position := poDefaultPosOnly;
  //  Visible := F;
  with TMemo.Create(Self) do
  begin
    Align := alClient;
    BorderStyle := bsNone;
  end;
  FDockClient := TJvDockClient.Create(Self);
  with FDockClient do
  begin
    OnFormShow := lbDockClient1FormShow;
    OnFormHide := lbDockClient1FormHide;
    NCPopupMenu := MainForm.PopupMenu2;
    DirectDrag := True;
    ShowHint := True;
    EnableCloseButton := True;
    EachOtherDock := False;
  end
end;

destructor TRunTimeForm.Destroy;
begin
  MenuItem.Free;
  inherited Destroy;
end;

procedure TRunTimeForm.lbDockClient1FormHide(Sender: TObject);
begin
  if Assigned(MenuItem) then
    MenuItem.Checked := False;
end;

procedure TRunTimeForm.lbDockClient1FormShow(Sender: TObject);
begin
  if Assigned(MenuItem) then
    MenuItem.Checked := True;
end;

procedure TRunTimeForm.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = MenuItem) and (Operation = opRemove) then
    MenuItem := nil;
end;

procedure TRunTimeForm.SetMenuItem(AMenuItem: TMenuItem);
begin
  if FMenuItem <> nil then
    RemoveFreeNotification(Self);
  FMenuItem := AMenuItem;
  if FMenuItem <> nil then
    FreeNotification(Self);
end;

end.