unit TB2MDI; {$MODE Delphi} { Toolbar2000 Copyright (C) 1998-2008 by Jordan Russell All rights reserved. The contents of this file are subject to the "Toolbar2000 License"; you may not use or distribute this file except in compliance with the "Toolbar2000 License". A copy of the "Toolbar2000 License" may be found in TB2k-LICENSE.txt or at: http://www.jrsoftware.org/files/tb2k/TB2k-LICENSE.txt Alternatively, the contents of this file may be used under the terms of the GNU General Public License (the "GPL"), in which case the provisions of the GPL are applicable instead of those in the "Toolbar2000 License". A copy of the GPL may be found in GPL-LICENSE.txt or at: http://www.jrsoftware.org/files/tb2k/GPL-LICENSE.txt If you wish to allow use of your version of this file only under the terms of the GPL and not to allow others to use your version of this file under the "Toolbar2000 License", indicate your decision by deleting the provisions above and replace them with the notice and other provisions required by the GPL. If you do not delete the provisions above, a recipient may use your version of this file under either the "Toolbar2000 License" or the GPL. $jrsoftware: tb2k/Source/TB2MDI.pas,v 1.15 2008/04/23 21:54:37 jr Exp $ } interface {$I TB2Ver.inc} uses LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus, TB2Item, TB2Toolbar; type TTBMDIButtonsItem = class; TTBMDISystemMenuItem = class; TTBMDIHandler = class(TComponent) private FButtonsItem: TTBMDIButtonsItem; FSystemMenuItem: TTBMDISystemMenuItem; FToolbar: TTBCustomToolbar; procedure SetToolbar(Value: TTBCustomToolbar); protected procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property Toolbar: TTBCustomToolbar read FToolbar write SetToolbar; end; TTBMDIWindowItem = class(TTBCustomItem) private FForm: TForm; FOnUpdate: TNotifyEvent; FWindowMenu: TMenuItem; procedure ItemClick(Sender: TObject); procedure SetForm(AForm: TForm); protected procedure EnabledChanged; override; procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(AOwner: TComponent); override; procedure InitiateAction; override; published property Enabled; property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate; end; TTBMDISystemMenuItem = class(TTBCustomItem) private FImageList: TImageList; procedure CommandClick(Sender: TObject); protected function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override; public constructor Create(AOwner: TComponent); override; procedure Click; override; end; TTBMDISystemMenuItemViewer = class(TTBItemViewer) protected procedure CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer); override; procedure Paint(const Canvas: TCanvas; const ClientAreaRect: TRect; IsSelected, IsPushed, UseDisabledShadow: Boolean); override; end; TTBMDIButtonType = (tbmbMinimize, tbmbRestore, tbmbClose); TTBMDIButtonItem = class(TTBCustomItem) private FButtonType: TTBMDIButtonType; protected function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override; public constructor Create(AOwner: TComponent); override; end; TTBMDIButtonItemViewer = class(TTBItemViewer) protected procedure CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer); override; procedure Paint(const Canvas: TCanvas; const ClientAreaRect: TRect; IsSelected, IsPushed, UseDisabledShadow: Boolean); override; end; TTBMDISepItem = class(TTBSeparatorItem) protected function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override; end; TTBMDISepItemViewer = class(TTBSeparatorItemViewer) protected procedure CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer); override; end; TTBMDIButtonsItem = class(TTBCustomItem) private FMinimizeItem: TTBMDIButtonItem; FRestoreItem: TTBMDIButtonItem; FCloseItem: TTBMDIButtonItem; FSep1, FSep2: TTBMDISepItem; procedure InvalidateSystemMenuItem; procedure ItemClick(Sender: TObject); procedure UpdateState(W: HWND; Maximized: Boolean); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; end; implementation uses {$IFDEF CLR} System.Text, System.Runtime.InteropServices, WinUtils, {$ENDIF} TB2Common, TB2Consts, CommCtrl; type TTBCustomToolbarAccess = class(TTBCustomToolbar); function GetMenuItemStr(const AMenu: HMENU; const APos: Integer): String; {$IFNDEF CLR} var Buf: array[0..1023] of Char; begin if GetMenuString(AMenu, APos, Buf, SizeOf(Buf) div SizeOf(Buf[0]), MF_BYPOSITION) > 0 then Result := Buf else Result := ''; end; {$ELSE} var Buf: StringBuilder; begin Buf := StringBuilder.Create(1024); if GetMenuString(AMenu, APos, Buf, Buf.Capacity, MF_BYPOSITION) > 0 then Result := Buf.ToString else Result := ''; end; {$ENDIF} { TTBMDIHandler } constructor TTBMDIHandler.Create(AOwner: TComponent); begin inherited; FSystemMenuItem := TTBMDISystemMenuItem.Create(Self); FButtonsItem := TTBMDIButtonsItem.Create(Self); end; destructor TTBMDIHandler.Destroy; begin Toolbar := nil; inherited; end; procedure TTBMDIHandler.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (AComponent = FToolbar) and (Operation = opRemove) then Toolbar := nil; end; procedure TTBMDIHandler.SetToolbar(Value: TTBCustomToolbar); var Rebuild: Boolean; begin if FToolbar <> Value then begin if Assigned(FToolbar) then begin Rebuild := False; if TTBCustomToolbarAccess(FToolbar).FMDIButtonsItem = FButtonsItem then begin TTBCustomToolbarAccess(FToolbar).FMDIButtonsItem := nil; Rebuild := True; end; if TTBCustomToolbarAccess(FToolbar).FMDISystemMenuItem = FSystemMenuItem then begin TTBCustomToolbarAccess(FToolbar).FMDISystemMenuItem := nil; Rebuild := True; end; if Rebuild and Assigned(FToolbar.View) then FToolbar.View.RecreateAllViewers; end; FToolbar := Value; if Assigned(Value) then begin Value.FreeNotification(Self); TTBCustomToolbarAccess(Value).FMDIButtonsItem := FButtonsItem; TTBCustomToolbarAccess(Value).FMDISystemMenuItem := FSystemMenuItem; Value.View.RecreateAllViewers; end; end; end; { TTBMDISystemMenuItem } constructor TTBMDISystemMenuItem.Create(AOwner: TComponent); begin inherited; ItemStyle := ItemStyle + [tbisSubMenu, tbisDontSelectFirst] - [tbisRedrawOnSelChange, tbisRedrawOnMouseOverChange]; Caption := '&-'; {$R TB2MDI.res} FImageList := TImageList.Create(Self); FImageList.Handle := ImageList_LoadBitmap(HInstance, 'TB2SYSMENUIMAGES', 16, 0, clSilver); SubMenuImages := FImageList; end; function TTBMDISystemMenuItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass; begin Result := TTBMDISystemMenuItemViewer; end; procedure TTBMDISystemMenuItem.Click; var I: Integer; Form: TForm; M: HMENU; State: UINT; ID: Word; Item: TTBCustomItem; begin inherited; Clear; if Application.MainForm = nil then Exit; Form := Application.MainForm.ActiveMDIChild; if Form = nil then Exit; M := GetSystemMenu(Form.Handle, False); for I := 0 to GetMenuItemCount(M)-1 do begin State := GetMenuState(M, I, MF_BYPOSITION); if State and MF_SEPARATOR <> 0 then Add(TTBSeparatorItem.Create(Self)) else begin Item := TTBCustomItem.Create(Self); if State and MF_GRAYED <> 0 then Item.Enabled := False; Item.Caption := GetMenuItemStr(M, I); ID := Word(GetMenuItemID(M, I)); Item.Tag := {$IFDEF CLR}TTag{$ENDIF}(ID); case ID and $FFF0 of SC_RESTORE: Item.ImageIndex := 3; SC_MINIMIZE: Item.ImageIndex := 2; SC_MAXIMIZE: Item.ImageIndex := 1; SC_CLOSE: begin Item.ImageIndex := 0; Item.Options := Item.Options + [tboDefault]; end; end; Item.OnClick := CommandClick; Add(Item); end; end; end; procedure TTBMDISystemMenuItem.CommandClick(Sender: TObject); var Form: TForm; begin if Assigned(Application.MainForm) then begin Form := Application.MainForm.ActiveMDIChild; if Assigned(Form) then SendMessage(Form.Handle, WM_SYSCOMMAND, Word(TTBCustomItem(Sender).Tag), LPARAM(GetMessagePos())); end; end; { TTBMDISystemMenuItemViewer } procedure TTBMDISystemMenuItemViewer.CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer); begin AWidth := GetSystemMetrics(SM_CXSMICON) + 2; AHeight := GetSystemMetrics(SM_CYSMICON) + 2; end; procedure TTBMDISystemMenuItemViewer.Paint(const Canvas: TCanvas; const ClientAreaRect: TRect; IsSelected, IsPushed, UseDisabledShadow: Boolean); function GetIconHandle: HICON; var Form: TForm; begin Result := 0; if Assigned(Application.MainForm) then begin Form := Application.MainForm.ActiveMDIChild; if Assigned(Form) then Result := Form.Icon.Handle; end; if Result = 0 then Result := Application.Icon.Handle; if Result = 0 then Result := LoadIcon(0, IDI_APPLICATION); end; var R: TRect; TempIcon: HICON; begin R := ClientAreaRect; InflateRect(R, -1, -1); TempIcon := CopyImage(GetIconHandle, IMAGE_ICON, R.Right - R.Left, R.Bottom - R.Top, LR_COPYFROMRESOURCE); DrawIconEx(Canvas.Handle, R.Left, R.Top, TempIcon, 0, 0, 0, 0, DI_NORMAL); DestroyIcon(TempIcon); end; { TTBMDIButtonItem } constructor TTBMDIButtonItem.Create(AOwner: TComponent); begin inherited; ItemStyle := ItemStyle - [tbisSelectable, tbisRedrawOnSelChange] + [tbisRightAlign]; end; function TTBMDIButtonItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass; begin Result := TTBMDIButtonItemViewer; end; { TTBMDIButtonItemViewer } procedure TTBMDIButtonItemViewer.CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer); begin if NewStyleControls then begin AWidth := GetSystemMetrics(SM_CXMENUSIZE) - 2; if AWidth < 0 then AWidth := 0; AHeight := GetSystemMetrics(SM_CYMENUSIZE) - 4; if AHeight < 0 then AHeight := 0; end else begin AWidth := 16; AHeight := 14; end; end; procedure TTBMDIButtonItemViewer.Paint(const Canvas: TCanvas; const ClientAreaRect: TRect; IsSelected, IsPushed, UseDisabledShadow: Boolean); const ButtonTypeFlags: array[TTBMDIButtonType] of UINT = (DFCS_CAPTIONMIN, DFCS_CAPTIONRESTORE, DFCS_CAPTIONCLOSE); PushedFlags: array[Boolean] of UINT = (0, DFCS_PUSHED); EnabledFlags: array[Boolean] of UINT = (DFCS_INACTIVE, 0); begin DrawFrameControl(Canvas.Handle, ClientAreaRect, DFC_CAPTION, ButtonTypeFlags[TTBMDIButtonItem(Item).FButtonType] or PushedFlags[IsPushed] or EnabledFlags[Item.Enabled]); end; { TTBMDISepItem } function TTBMDISepItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass; begin Result := TTBMDISepItemViewer; end; { TTBMDISepItemViewer } procedure TTBMDISepItemViewer.CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer); begin if View.Orientation <> tbvoVertical then begin AWidth := 2; AHeight := 6; end else begin AWidth := 6; AHeight := 2; end; end; { TTBMDIButtonsItem } var CBTHookHandle: HHOOK; MDIButtonsItems: TList; function WindowIsMDIChild(W: HWND): Boolean; var I: Integer; MainForm, ChildForm: TForm; begin MainForm := Application.MainForm; if Assigned(MainForm) then for I := 0 to MainForm.MDIChildCount-1 do begin ChildForm := MainForm.MDIChildren[I]; if ChildForm.HandleAllocated and (ChildForm.Handle = W) then begin Result := True; Exit; end; end; Result := False; end; function CBTHook(Code: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT; {$IFNDEF CLR} stdcall; {$ENDIF} var Maximizing: Boolean; WindowPlacement: TWindowPlacement; I: Integer; begin case Code of HCBT_SETFOCUS: begin if WindowIsMDIChild(HWND(WParam)) and Assigned(MDIButtonsItems) then begin for I := 0 to MDIButtonsItems.Count-1 do TTBMDIButtonsItem(MDIButtonsItems[I]).InvalidateSystemMenuItem; end; end; HCBT_MINMAX: begin if WindowIsMDIChild(HWND(WParam)) and Assigned(MDIButtonsItems) and (Word(LParam) in [SW_SHOWNORMAL, SW_SHOWMAXIMIZED, SW_MINIMIZE, SW_RESTORE]) then begin Maximizing := (Word(LParam) = SW_MAXIMIZE); if (Word(LParam) = SW_RESTORE) and not IsZoomed(HWND(WParam)) then begin {$IFNDEF CLR} WindowPlacement.length := SizeOf(WindowPlacement); {$ELSE} WindowPlacement.length := Marshal.SizeOf(TypeOf(TWindowPlacement)); {$ENDIF} GetWindowPlacement(HWND(WParam), {$IFNDEF CLR}@{$ENDIF} WindowPlacement); Maximizing := (WindowPlacement.flags and WPF_RESTORETOMAXIMIZED <> 0); end; for I := 0 to MDIButtonsItems.Count-1 do TTBMDIButtonsItem(MDIButtonsItems[I]).UpdateState(HWND(WParam), Maximizing); end; end; HCBT_DESTROYWND: begin if WindowIsMDIChild(HWND(WParam)) and Assigned(MDIButtonsItems) then begin for I := 0 to MDIButtonsItems.Count-1 do TTBMDIButtonsItem(MDIButtonsItems[I]).UpdateState(HWND(WParam), False); end; end; end; Result := CallNextHookEx(CBTHookHandle, Code, WParam, LParam); end; const { Note: On .NET, we must keep a reference to the delegate alive for as long as the hook is installed, otherwise the GC will collect it and the app will crash. Storing the delegate in a typed constant will do the trick. } CBTHookDelegate: TFNHookProc = CBTHook; constructor TTBMDIButtonsItem.Create(AOwner: TComponent); function CreateItem(const AType: TTBMDIButtonType): TTBMDIButtonItem; begin Result := TTBMDIButtonItem.Create(Self); Result.FButtonType := AType; Result.OnClick := ItemClick; end; begin inherited; ItemStyle := ItemStyle + [tbisEmbeddedGroup]; FMinimizeItem := CreateItem(tbmbMinimize); FRestoreItem := CreateItem(tbmbRestore); FCloseItem := CreateItem(tbmbClose); FSep1 := TTBMDISepItem.Create(Self); FSep1.Blank := True; FSep1.ItemStyle := FSep1.ItemStyle + [tbisRightAlign, tbisNoLineBreak]; FSep2 := TTBMDISepItem.Create(Self); FSep2.Blank := True; FSep2.ItemStyle := FSep2.ItemStyle + [tbisRightAlign, tbisNoLineBreak]; Add(FSep1); Add(FMinimizeItem); Add(FRestoreItem); Add(FSep2); Add(FCloseItem); UpdateState(0, False); if not(csDesigning in ComponentState) then begin AddToList(MDIButtonsItems, Self); if CBTHookHandle = 0 then CBTHookHandle := SetWindowsHookEx(WH_CBT, CBTHookDelegate, 0, GetCurrentThreadId); end; end; destructor TTBMDIButtonsItem.Destroy; begin RemoveFromList(MDIButtonsItems, Self); if (MDIButtonsItems = nil) and (CBTHookHandle <> 0) then begin UnhookWindowsHookEx(CBTHookHandle); CBTHookHandle := 0; end; inherited; end; procedure TTBMDIButtonsItem.UpdateState(W: HWND; Maximized: Boolean); var HasMaxChild, VisibilityChanged: Boolean; procedure UpdateVisibleEnabled(const Item: TTBCustomItem; const AEnabled: Boolean); begin if (Item.Visible <> HasMaxChild) or (Item.Enabled <> AEnabled) then begin Item.Visible := HasMaxChild; Item.Enabled := AEnabled; VisibilityChanged := True; end; end; var MainForm, ActiveMDIChild, ChildForm: TForm; I: Integer; begin HasMaxChild := False; ActiveMDIChild := nil; if not(csDesigning in ComponentState) then begin MainForm := Application.MainForm; if Assigned(MainForm) then begin for I := 0 to MainForm.MDIChildCount-1 do begin ChildForm := MainForm.MDIChildren[I]; if ChildForm.HandleAllocated and (((ChildForm.Handle = W) and Maximized) or ((ChildForm.Handle <> W) and IsZoomed(ChildForm.Handle))) then begin HasMaxChild := True; Break; end; end; ActiveMDIChild := MainForm.ActiveMDIChild; end; end; VisibilityChanged := False; UpdateVisibleEnabled(TTBMDIHandler(Owner).FSystemMenuItem, True); UpdateVisibleEnabled(FSep1, True); UpdateVisibleEnabled(FMinimizeItem, (ActiveMDIChild = nil) or (GetWindowLong(ActiveMDIChild.Handle, GWL_STYLE) and WS_MINIMIZEBOX <> 0)); UpdateVisibleEnabled(FRestoreItem, True); UpdateVisibleEnabled(FSep2, True); UpdateVisibleEnabled(FCloseItem, True); if VisibilityChanged and Assigned((Owner as TTBMDIHandler).FToolbar) then begin TTBMDIHandler(Owner).FToolbar.View.InvalidatePositions; TTBMDIHandler(Owner).FToolbar.View.TryValidatePositions; end; end; procedure TTBMDIButtonsItem.ItemClick(Sender: TObject); var MainForm, ChildForm: TForm; Cmd: WPARAM; begin MainForm := Application.MainForm; if Assigned(MainForm) then begin ChildForm := MainForm.ActiveMDIChild; if Assigned(ChildForm) then begin { Send WM_SYSCOMMAND messages so that we get sounds } if Sender = FRestoreItem then Cmd := SC_RESTORE else if Sender = FCloseItem then Cmd := SC_CLOSE else Cmd := SC_MINIMIZE; SendMessage(ChildForm.Handle, WM_SYSCOMMAND, Cmd, LPARAM(GetMessagePos())); end; end; end; procedure TTBMDIButtonsItem.InvalidateSystemMenuItem; var View: TTBView; begin if Assigned((Owner as TTBMDIHandler).FToolbar) then begin View := TTBMDIHandler(Owner).FToolbar.View; View.Invalidate(View.Find(TTBMDIHandler(Owner).FSystemMenuItem)); end; end; { TTBMDIWindowItem } constructor TTBMDIWindowItem.Create(AOwner: TComponent); var Form: TForm; begin inherited; ItemStyle := ItemStyle + [tbisEmbeddedGroup]; Caption := STBMDIWindowItemDefCaption; FWindowMenu := TMenuItem.Create(Self); if not(csDesigning in ComponentState) then begin { Need to set WindowMenu before MDI children are created. Otherwise the list incorrectly shows the first 9 child windows, even if window 10+ is active. } Form := Application.MainForm; if (Form = nil) and (Screen.FormCount > 0) then Form := Screen.Forms[0]; SetForm(Form); end; end; procedure TTBMDIWindowItem.GetChildren(Proc: TGetChildProc; Root: TComponent); begin end; procedure TTBMDIWindowItem.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (Operation = opRemove) and (AComponent = FForm) then SetForm(nil); end; procedure TTBMDIWindowItem.SetForm(AForm: TForm); begin if FForm <> AForm then begin if Assigned(FForm) and (FForm.WindowMenu = FWindowMenu) then FForm.WindowMenu := nil; FForm := AForm; if Assigned(FForm) then FForm.FreeNotification(Self); end; if Assigned(FForm) then FForm.WindowMenu := FWindowMenu; end; procedure TTBMDIWindowItem.EnabledChanged; var I: Integer; begin inherited; for I := 0 to Count-1 do Items[I].Enabled := Enabled; end; procedure TTBMDIWindowItem.InitiateAction; var MainForm: TForm; I: Integer; M: HMENU; Item: TTBCustomItem; ItemCount: Integer; begin inherited; if csDesigning in ComponentState then Exit; MainForm := Application.MainForm; if Assigned(MainForm) then SetForm(MainForm); if FForm = nil then Exit; if FForm.ClientHandle <> 0 then { This is needed, otherwise windows selected on the More Windows dialog don't move back into the list } SendMessage(FForm.ClientHandle, WM_MDIREFRESHMENU, 0, 0); M := FWindowMenu.Handle; ItemCount := GetMenuItemCount(M) - 1; if ItemCount < 0 then ItemCount := 0; while Count < ItemCount do begin Item := TTBCustomItem.Create(Self); Item.Enabled := Enabled; Item.OnClick := ItemClick; Add(Item); end; while Count > ItemCount do Items[Count-1].Free; for I := 0 to ItemCount-1 do begin Item := Items[I]; Item.Tag := {$IFDEF CLR}TTag{$ENDIF}(Word(GetMenuItemID(M, I+1))); Item.Caption := GetMenuItemStr(M, I+1); Item.Checked := GetMenuState(M, I+1, MF_BYPOSITION) and MF_CHECKED <> 0; end; if Assigned(FOnUpdate) then FOnUpdate(Self); end; procedure TTBMDIWindowItem.ItemClick(Sender: TObject); var Form: TForm; begin Form := Application.MainForm; if Assigned(Form) then PostMessage(Form.Handle, WM_COMMAND, Word(TTBCustomItem(Sender).Tag), 0); end; end.