{ Free DB Manager Copyright (C) 2005-2012 Lagunov Aleksey alexs75 at hotbox.ru 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. } unit RxMDI; {$I rx.inc} interface uses Classes, SysUtils, Forms, Buttons, Menus, ExtCtrls, Graphics, Controls; type TRxMDIPanel = class; TRxMDITasks = class; { TRxMDIButton } TRxMDIButton = class(TSpeedButton) private FNavForm: TForm; FNavPanel:TRxMDITasks; FSaveClose:TCloseEvent; procedure SetRxMDIForm(AValue: TForm); procedure DoCreateMenuItems; procedure DoCloseMenu(Sender: TObject); procedure DoCloseAllMenu(Sender: TObject); procedure DoCloseAllExcepThisMenu(Sender: TObject); procedure DoActivateMenu(Sender: TObject); procedure DoCreateButtonImage; private FMenu:TPopupMenu; procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); public constructor CreateButton(AOwner:TRxMDITasks; AForm:TForm); procedure Click; override; // make Click public procedure UpdateCaption; property NavForm:TForm read FNavForm write SeTRxMDIForm; end; { TRxMDITasks } TRxMDITasks = class(TCustomPanel) private FBtnScrollLeft:TSpeedButton; FBtnScrollRigth:TSpeedButton; FMainPanel: TRxMDIPanel; procedure UpdateScrollBtnStatus; procedure ScrollLeftExecute(Sender: TObject); procedure ScrollRigthExecute(Sender: TObject); procedure ShowHiddenBtnOnResize; procedure ChildWindowsShowLast; procedure DoCloseAll(AIgnoreBtn:TRxMDIButton); protected procedure Paint; override; procedure Resize; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(TheOwner: TComponent); override; destructor Destroy; override; procedure AddButton(Btn:TRxMDIButton); procedure ShowWindow(F:TForm); property MainPanel:TRxMDIPanel read FMainPanel write FMainPanel; published property Align; end; { TRxMDICloseButton } TRxMDICloseButton = class(TCustomSpeedButton) private FInfoLabel:TBoundLabel; FLabelSpacing:integer; FMDIPanel:TRxMDIPanel; protected procedure SetParent(AParent: TWinControl); override; procedure Loaded; override; procedure DoPositionLabel; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure CreateInternalLabel; public constructor Create(AOwner: TComponent); override; published property Align; property Anchors; property Glyph; property Flat; end; { TRxMDIPanel } TRxMDIPanel = class(TCustomPanel) private FCurrentChildWindow: TForm; FCloseButton: TRxMDICloseButton; FTaskPanel: TRxMDITasks; procedure SetCurrentChildWindow(AValue: TForm); procedure navCloseButtonClick(Sender: TObject); procedure SetRxMDICloseButton(AValue: TRxMDICloseButton); procedure SetTaskPanel(AValue: TRxMDITasks); protected procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure Loaded; override; public constructor Create(TheOwner: TComponent); override; procedure ShowWindow(F:TForm); procedure ChildWindowsAdd(F:TForm); procedure ChildWindowsCreate(var AForm; FC:TFormClass); procedure ChildWindowsUpdateCaption(F:TForm); procedure CloseAll; property CurrentChildWindow:TForm read FCurrentChildWindow write SetCurrentChildWindow; published property CloseButton:TRxMDICloseButton read FCloseButton write SetRxMDICloseButton; property TaskPanel:TRxMDITasks read FTaskPanel write SetTaskPanel; property Align; property BevelInner; property BevelOuter; end; implementation uses LResources, vclutils, rxconst; { TRxMDICloseButton } procedure TRxMDICloseButton.SetParent(AParent: TWinControl); begin inherited SetParent(AParent); DoPositionLabel; end; procedure TRxMDICloseButton.Loaded; begin inherited Loaded; DoPositionLabel; end; procedure TRxMDICloseButton.DoPositionLabel; begin if FInfoLabel = nil then exit; if Parent<>nil then Parent.DisableAlign; //DebugLn(['TCustomLabeledEdit.DoPositionLabel ']); FInfoLabel.Parent := Parent; FInfoLabel.Visible := Visible; { case FLabelPosition of lpAbove: begin FInfoLabel.AnchorParallel(akLeft,0,Self); FInfoLabel.AnchorToCompanion(akBottom,FLabelSpacing,Self); end; lpBelow: begin FInfoLabel.AnchorParallel(akLeft,0,Self); FInfoLabel.AnchorToCompanion(akTop,FLabelSpacing,Self); end; lpLeft : begin} FInfoLabel.AnchorToCompanion(akRight,FLabelSpacing,Self); FInfoLabel.AnchorVerticalCenterTo(Self); { end; lpRight: begin FInfoLabel.AnchorToCompanion(akLeft,FLabelSpacing,Self); FInfoLabel.AnchorVerticalCenterTo(Self); end; end;} if Parent<>nil then Parent.EnableAlign; end; procedure TRxMDICloseButton.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if (AComponent = FInfoLabel) and (Operation = opRemove) then FInfoLabel := nil else if (AComponent = FMDIPanel) and (Operation = opRemove) then begin FMDIPanel:=nil; OnClick:=nil; end; end; procedure TRxMDICloseButton.CreateInternalLabel; begin if FInfoLabel<>nil then exit; FInfoLabel := TBoundLabel.Create(Self); FInfoLabel.ControlStyle := FInfoLabel.ControlStyle + [csNoDesignSelectable]; //FInfoLabel.FocusControl := Self; end; constructor TRxMDICloseButton.Create(AOwner: TComponent); begin inherited Create(AOwner); // FLabelPosition := lpAbove; FLabelSpacing := 3; CreateInternalLabel; Glyph:=LoadLazResBitmapImage('RxMDICloseIcon'); end; { TRxMDIPanel } procedure TRxMDIPanel.SetCurrentChildWindow(AValue: TForm); begin FCurrentChildWindow:=AValue; if Assigned(FCloseButton) then begin FCloseButton.Enabled:=Assigned(FCurrentChildWindow); if FCloseButton.Enabled then FCloseButton.FInfoLabel.Caption:=FCurrentChildWindow.Caption else FCloseButton.FInfoLabel.Caption:=''; end; if Assigned(TaskPanel) then TaskPanel.Visible:=Assigned(FCurrentChildWindow); end; procedure TRxMDIPanel.navCloseButtonClick(Sender: TObject); begin if Assigned(FCurrentChildWindow) then FCurrentChildWindow.Close; end; procedure TRxMDIPanel.SeTRxMDICloseButton(AValue: TRxMDICloseButton); begin if FCloseButton=AValue then Exit; if Assigned(FCloseButton) then begin FCloseButton.OnClick:=nil; FCloseButton.FMDIPanel:=nil; end; FCloseButton:=AValue; if Assigned(FCloseButton) then begin FCloseButton.OnClick:=@navCloseButtonClick; FCloseButton.FMDIPanel:=Self; end; end; procedure TRxMDIPanel.SetTaskPanel(AValue: TRxMDITasks); begin if FTaskPanel=AValue then Exit; FTaskPanel:=AValue; if Assigned(FTaskPanel) then FTaskPanel.FMainPanel:=Self; end; procedure TRxMDIPanel.Notification(AComponent: TComponent; Operation: TOperation ); begin inherited Notification(AComponent, Operation); if (AComponent = FCloseButton) and (Operation = opRemove) then FCloseButton := nil else if (AComponent = FTaskPanel) and (Operation = opRemove) then FTaskPanel:=nil; end; procedure TRxMDIPanel.Loaded; begin inherited Loaded; CurrentChildWindow:=nil; end; constructor TRxMDIPanel.Create(TheOwner: TComponent); begin inherited Create(TheOwner); Caption:=''; Align:=alClient; BevelOuter:=bvLowered; end; procedure TRxMDIPanel.ShowWindow(F: TForm); begin TaskPanel.ShowWindow(F); end; procedure TRxMDIPanel.ChildWindowsAdd(F: TForm); var B:TRxMDIButton; begin F.BorderStyle:=bsNone; F.Align:=alClient; F.Parent:=Self; F.Visible:=true; F.BringToFront; Application.MainForm.ActiveControl:=F; B:=TRxMDIButton.CreateButton(TaskPanel, F); end; procedure TRxMDIPanel.ChildWindowsCreate(var AForm; FC: TFormClass); var FForm:TForm absolute AForm; begin if not Assigned(FForm) then begin FForm:=FC.Create(Self); ChildWindowsAdd(FForm); end else ShowWindow(FForm) end; procedure TRxMDIPanel.ChildWindowsUpdateCaption(F: TForm); var i:integer; B:TRxMDIButton; begin for i:=0 to TaskPanel.ComponentCount -1 do begin if TRxMDIButton(TaskPanel.Components[i]).NavForm = F then begin TRxMDIButton(TaskPanel.Components[i]).UpdateCaption; exit; end; end; end; procedure TRxMDIPanel.CloseAll; begin if Assigned(FTaskPanel) then FTaskPanel.DoCloseAll(nil); end; { TRxMDITasks } procedure TRxMDITasks.UpdateScrollBtnStatus; var i, W:Integer; B:TRxMDIButton; begin W:=FBtnScrollLeft.Width + FBtnScrollRigth.Width; FBtnScrollLeft.Enabled:=false; for i:=0 to ComponentCount-1 do begin B:=TRxMDIButton(Components[i]); if not B.Visible then FBtnScrollLeft.Enabled:=true else W:=W+B.Width + 2; end; FBtnScrollRigth.Enabled:=W > Width; end; procedure TRxMDITasks.ScrollLeftExecute(Sender: TObject); var i:Integer; B:TRxMDIButton; begin for i:=0 to ComponentCount-1 do begin if (Components[i] is TRxMDIButton) then begin B:=TRxMDIButton(Components[i]); if not B.Visible then begin B.Visible:=true; B.Left:=FBtnScrollLeft.Width; break; end; end; end; UpdateScrollBtnStatus; Invalidate; end; procedure TRxMDITasks.ScrollRigthExecute(Sender: TObject); var i:Integer; B:TRxMDIButton; begin for i:=0 to ComponentCount - 1 do begin if (Components[i] is TRxMDIButton) then begin B:=TRxMDIButton(Components[i]); if B.Visible then begin B.Visible:=false; break; end; end; end; UpdateScrollBtnStatus; Invalidate; end; procedure TRxMDITasks.ShowHiddenBtnOnResize; begin end; procedure TRxMDITasks.ChildWindowsShowLast; var CC:TControl; begin if (FMainPanel.ControlCount>1) then begin CC:=FMainPanel.Controls[FMainPanel.ControlCount-2]; if Assigned(CC) then ShowWindow(CC as TForm) end else FMainPanel.CurrentChildWindow:=nil; Invalidate; end; procedure TRxMDITasks.DoCloseAll(AIgnoreBtn: TRxMDIButton); var i:integer; begin for i:=ComponentCount-1 downto 0 do begin if (Components[i] is TRxMDIButton) and (TRxMDIButton(Components[i]) <> AIgnoreBtn) then TRxMDIButton(Components[i]).DoCloseMenu(nil); end; end; procedure TRxMDITasks.Paint; var i:integer; H:integer; B:TRxMDIButton; begin inherited Paint; Canvas.Pen.Color:=clBlack; H:=Height - 2; for i:=0 to ComponentCount - 1 do begin if (Components[i] is TRxMDIButton) then begin B:=TRxMDIButton(Components[i]); if (B.Visible) and (B.Left > B.Width) then begin Canvas.Pen.Color:=clBtnShadow; Canvas.Line(B.Left - 2, 2, B.Left - 2, H); Canvas.Pen.Color:=clWindow; Canvas.Line(B.Left - 1, 2, B.Left - 1, H); end; end; end; end; procedure TRxMDITasks.Resize; begin inherited Resize; if Assigned(FBtnScrollLeft) and Assigned(FBtnScrollRigth) then UpdateScrollBtnStatus; end; procedure TRxMDITasks.Notification(AComponent: TComponent; Operation: TOperation ); begin inherited Notification(AComponent, Operation); if (AComponent = FMainPanel) and (Operation = opRemove) then FMainPanel := nil end; constructor TRxMDITasks.Create(TheOwner: TComponent); begin inherited Create(TheOwner); Caption:=''; FBtnScrollLeft:=TSpeedButton.Create(Self); FBtnScrollLeft.Parent:=Self; FBtnScrollLeft.Align:=alLeft; FBtnScrollLeft.AnchorSide[akLeft].Control:=Self; FBtnScrollLeft.Anchors:=[akLeft, akTop, akBottom]; FBtnScrollLeft.OnClick:=@ScrollLeftExecute; FBtnScrollLeft.Caption:='<'; FBtnScrollLeft.ShowCaption:=true; FBtnScrollLeft.AutoSize:=true; FBtnScrollLeft.Flat:=true; FBtnScrollLeft.Transparent:=false; FBtnScrollRigth:=TSpeedButton.Create(Self); FBtnScrollRigth.Parent:=Self; FBtnScrollRigth.Align:=alRight; FBtnScrollRigth.Anchors:=[akRight, akTop, akBottom]; FBtnScrollRigth.AnchorSide[akRight].Control:=Self; FBtnScrollRigth.OnClick:=@ScrollRigthExecute; FBtnScrollRigth.Caption:='>'; FBtnScrollRigth.ShowCaption:=true; FBtnScrollRigth.AutoSize:=true; FBtnScrollRigth.Flat:=true; FBtnScrollRigth.Transparent:=false; Align:=alBottom; Height:=25; end; destructor TRxMDITasks.Destroy; begin FBtnScrollRigth:=nil; FBtnScrollLeft:=nil; inherited Destroy; end; procedure TRxMDITasks.AddButton(Btn: TRxMDIButton); begin Btn.Parent:=Self; Btn.Left:=Width-1; Btn.Down:=true; Btn.BorderSpacing.Left:=3; Btn.BorderSpacing.Right:=3; FBtnScrollRigth.BringToFront; FBtnScrollLeft.BringToFront; UpdateScrollBtnStatus; end; procedure TRxMDITasks.ShowWindow(F: TForm); var i:integer; begin for i:=0 to ComponentCount -1 do begin if (Components[i] is TRxMDIButton) and (TRxMDIButton(Components[i]).NavForm = F) then begin TRxMDIButton(Components[i]).Click; TRxMDIButton(Components[i]).Visible:=true; exit; end; end; end; { TRxMDIButton } procedure TRxMDIButton.SetRxMDIForm(AValue: TForm); var FImageIndex:integer; B:TBitmap; begin if FNavForm=AValue then Exit; FNavForm:=AValue; if Assigned(FNavForm) then begin FSaveClose:=FNavForm.OnClose; FNavForm.OnClose:=@FormClose; Caption:=' '+FNavForm.Caption+' '; DoCreateButtonImage; if Assigned(FNavPanel) then FNavPanel.FMainPanel.CurrentChildWindow:=NavForm; end; { if NavForm is TfbmDBObjectEditorForm then begin B:=TBitmap.Create; try B.Width:=fbManagerMainForm.ImageList2.Width; B.Height:=fbManagerMainForm.ImageList2.Height; B.Canvas.Brush.Color:=Color; B.Canvas.FillRect(0,0, B.Width, B.Height); FImageIndex:=ord(TfbmDBObjectEditorForm(NavForm).DBObject.DBObjectKind) + 2; fbManagerMainForm.ImageList2.Draw(B.Canvas, 0,0,FImageIndex); Glyph.Assign(B); finally B.Free; end; end;} end; procedure TRxMDIButton.DoCreateMenuItems; var Item: TMenuItem; begin Item:=TMenuItem.Create(Self); Item.Caption:=Caption; Item.OnClick:=@DoActivateMenu; FMenu.Items.Add(Item); Item:=TMenuItem.Create(Self); Item.Caption:='-'; FMenu.Items.Add(Item); Item:=TMenuItem.Create(Self); Item.Caption:=sCloseWindows; Item.OnClick:=@DoCloseMenu; FMenu.Items.Add(Item); Item:=TMenuItem.Create(Self); Item.Caption:='-'; FMenu.Items.Add(Item); Item:=TMenuItem.Create(Self); Item.Caption:=sCloseAllExceptThis; Item.OnClick:=@DoCloseAllExcepThisMenu; FMenu.Items.Add(Item); Item:=TMenuItem.Create(Self); Item.Caption:=sCloseAllWindows; Item.OnClick:=@DoCloseAllMenu; FMenu.Items.Add(Item); end; procedure TRxMDIButton.DoCloseMenu(Sender: TObject); begin if Assigned(FNavForm) then FNavForm.Close; end; procedure TRxMDIButton.DoCloseAllMenu(Sender: TObject); begin FNavPanel.DoCloseAll(nil); end; procedure TRxMDIButton.DoCloseAllExcepThisMenu(Sender: TObject); begin FNavPanel.DoCloseAll(Self); end; procedure TRxMDIButton.DoActivateMenu(Sender: TObject); begin Click; end; procedure TRxMDIButton.DoCreateButtonImage; var FImageIndex:integer; B:TBitmap; begin if Assigned(NavForm.Icon) and (NavForm.Icon.Count>0) then begin B:=TBitmap.Create; try B.Width:=NavForm.Icon.Width; B.Height:=NavForm.Icon.Height; B.Canvas.Brush.Color:=Color; B.Canvas.FillRect(0,0, B.Width, B.Height); B.Canvas.Draw(0, 0, NavForm.Icon); Glyph.Assign(B); finally B.Free; end; end; end; procedure TRxMDIButton.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin if Assigned(FSaveClose) then FSaveClose(Sender, CloseAction); FNavPanel.ChildWindowsShowLast; FNavPanel.ShowHiddenBtnOnResize; Free; end; constructor TRxMDIButton.CreateButton(AOwner: TRxMDITasks; AForm: TForm); begin inherited Create(AOwner); FNavPanel:=AOwner; Align:=alLeft; NavForm:=AForm; AutoSize:=true; Flat:=true; GroupIndex:=1; FMenu:=TPopupMenu.Create(Self); FMenu.Parent:=Self; PopupMenu:=FMenu; DoCreateMenuItems; AOwner.AddButton(Self); end; procedure TRxMDIButton.Click; begin inherited Click; if Assigned(FNavForm) then begin FNavForm.BringToFront; FNavPanel.FMainPanel.CurrentChildWindow:=NavForm; Application.MainForm.ActiveControl:=NavForm.ActiveControl; end; Down:=true; end; procedure TRxMDIButton.UpdateCaption; begin if Assigned(FNavForm) then Caption:=' '+FNavForm.Caption+' ' else Caption:='---'; AdjustSize; end; initialization {$I RxMDICloseIcon.lrs} end.