Текущий архив: 2004.05.02;
Скачать: CL | DM;

Вниз

ToolBar в MDI   Найти похожие ветки 

← →
EvgeniyR ©   (2004-04-09 08:42) [0]

Есть MDI-приложении, сделал что-бы при открытии дочерних окон на главной форме внизу появлялся ToolBar с кнопками (как, например в 1:С 7.7 - 8):
--------------------------------------------
ToolButton := TToolButton.Create(FormOwner);
  with ToolButton do
    begin
      Parent := ToolBar1;
      Style := tbsCheck;
      Grouped := true;
      Down := true;
      OnClick := ChildButtonClick;
    end;
------------------------------------
При нажатии на кнопки активизируется соответствующая форма:
TChildForm(TToolButton(Sender).Owner).BringToFront;
------------------------------------
Все работает прекрасно, но как сделать, что бы при активизации формы "вручную", нажималась соответствующая кнопка на ToolBar"е?
Заранее спасибо.

---

← →
Rule ©   (2004-04-09 10:13) [1]

2EvgeniyR ©   (09.04.04 08:42)

Отлавливай событие формы онактивайт и нажимай соответствующую кнопку (естественно каждая кнопка должна быть пристегнута к каждому окну)

---

← →
Игорь Шевченко ©   (2004-04-09 11:16) [2]

Можно.
unit main;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus, ExtCtrls, UserMessages, Buttons;

type
 TfMain = class(TForm)
   MainMenu: TMainMenu;
   New1: TMenuItem;
   Child1: TMenuItem;
   Iterate1: TMenuItem;
   Window1: TMenuItem;
   ilehorizontal1: TMenuItem;
   ilevertical1: TMenuItem;
   Cascade1: TMenuItem;
   ButtonsPanel: TPanel;
   Childwithicon1: TMenuItem;
   procedure Child1Click(Sender: TObject);
   procedure ilehorizontal1Click(Sender: TObject);
   procedure ilevertical1Click(Sender: TObject);
   procedure Cascade1Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure Childwithicon1Click(Sender: TObject);
   procedure ButtonsPanelResize(Sender: TObject);
 private
   FButtons : TList;
   FClientInstance : TFarProc;
   FPrevClientProc : TFarProc;
   procedure ClientWndProc(var Message: TMessage);
   procedure AddButtonToPanel (AWindowHandle : HWND);
   procedure RemoveButtonFromPanel (AWindowHandle : HWND);
   procedure UmMDIActive (var Message : TMessage); message UM_MDIACTIVE;
   procedure RedrawButtons;
   procedure WindowButtonClick (Sender : TObject);
   procedure DrawWindowButton (AButton : TSpeedButton; ADown : Boolean);
 end;

var
 fMain: TfMain;

implementation
uses
 Child, ChildWithIcon;

{$R *.dfm}

const MaxButtonWidth = 140;

procedure TfMain.Child1Click(Sender: TObject);
begin
 with TfChild.Create(Application) do
   Show;
end;

procedure TfMain.ilehorizontal1Click(Sender: TObject);
begin
 TileMode := tbHorizontal;
 Tile;
end;

procedure TfMain.ilevertical1Click(Sender: TObject);
begin
 TileMode := tbVertical;
 Tile;
end;

procedure TfMain.Cascade1Click(Sender: TObject);
begin
 Cascade;
end;

procedure TfMain.UmMDIActive (var Message : TMessage);
var
 I : Integer;
begin
 for I:=0 to Pred(FButtons.Count) do
   with TSpeedButton(FButtons[I]) do
     if Tag = Message.WParam then
       DrawWindowButton (TSpeedButton(FButtons[I]), true)
     else if Tag = Message.LParam then
       DrawWindowButton (TSpeedButton(FButtons[I]), false);
end;

procedure TfMain.FormCreate(Sender: TObject);
begin
 FButtons := TList.Create;
 FClientInstance := MakeObjectInstance(ClientWndProc);
 FPrevClientProc := Pointer(GetWindowLong(ClientHandle,
   GWL_WNDPROC));
 SetWindowLong(ClientHandle, GWL_WNDPROC,
   LongInt(FClientInstance));
end;

procedure TfMain.ClientWndProc(var Message: TMessage);
begin
 with Message do
   case Msg of
   WM_MDICREATE:
     begin
       Result := CallWindowProc(FPrevClientProc,
         ClientHandle, Msg, wParam, lParam);
       AddButtonToPanel (Result);
     end;
   WM_MDIDESTROY:
     begin
       RemoveButtonFromPanel(wParam);
       Result := CallWindowProc(FPrevClientProc,
         ClientHandle, Msg, wParam, lParam);
     end;
   else
     Result := CallWindowProc(FPrevClientProc,
        ClientHandle, Msg, wParam, lParam);
   end;
end;

procedure TfMain.FormDestroy(Sender: TObject);
begin
 FButtons.Free;
end;

procedure TfMain.AddButtonToPanel (AWindowHandle : HWND);
var
 mdiButton : TSpeedButton;
 AText : array[0..MAX_PATH] of char;
begin
 GetWindowText(AWindowHandle, AText, SizeOf(AText));
 mdiButton := TSpeedButton.Create(Self);
 with mdiButton do begin
   Tag := AWindowHandle;
   Parent := ButtonsPanel;
   Width := 70;
   Height := 22;
   Left := FButtons.Count * (Width + 2) + 8;
   Top := 4;
   GroupIndex := 1;
   AllowAllUp := true;
   Glyph.Width := 16;
   Glyph.Height := 16;
   Glyph.TransparentColor := clCaptionText;
   Layout := blGlyphLeft;
   Margin := 2;
   OnClick := WindowButtonClick;
   FButtons.Add(mdiButton);
 end;
 RedrawButtons;
end;

procedure TfMain.RemoveButtonFromPanel (AWindowHandle : HWND);
var
 I : Integer;
begin
 for I:=0 to Pred(FButtons.Count) do
   if TSpeedButton(FButtons[I]).Tag = Integer(AWindowHandle) then begin
     TSpeedButton(FButtons[I]).Free();
     FButtons.Delete(I);
     Break;
   end;
 RedrawButtons;
end;

procedure TfMain.RedrawButtons;
var
 ButtonWidth : Integer;
 I : Integer;
begin
 ButtonsPanel.Invalidate();
 if FButtons.Count = 0 then
   Exit;
 ButtonWidth := (ButtonsPanel.Width - 16 - (FButtons.Count * 2)) div
FButtons.Count;
 if ButtonWidth > MaxButtonWidth then
   ButtonWidth := MaxButtonWidth;
 for I:=0 to Pred(FButtons.Count) do
   with TSpeedButton(FButtons[I]) do begin
     Width := ButtonWidth;
     Left := I * (Width + 2) + 8;
   end;
end;

procedure TfMain.WindowButtonClick(Sender: TObject);
begin
 with Sender as TSpeedButton do
   PostMessage(ClientHandle, WM_MDIACTIVATE, Tag, 0);
end;

procedure TfMain.DrawWindowButton(AButton: TSpeedButton; ADown : Boolean);
var
 AText : array[0..255] of char;
 Icon : TIcon;
 IconHandle : THandle;
 AWindowHandle : THandle;
begin
 AWindowHandle := THandle(AButton.Tag);
 GetWindowText(AWindowHandle, AText, SizeOf(AText));
 AButton.Caption := AText;
 AButton.Down := ADown;
 IconHandle := GetClassLong(AWindowHandle, GCL_HICONSM);
 if IconHandle = 0 then
   IconHandle := GetClassLong(AWindowHandle, GCL_HICON);
 if IconHandle = 0 then
   IconHandle := SendMessage(AWindowHandle, WM_GETICON, ICON_SMALL, 0);
 if IconHandle = 0 then
   Iconhandle := SendMessage(AWindowHandle, WM_GETICON, ICON_BIG, 0);
 if IconHandle = 0 then
   IconHandle := Application.Icon.Handle;
 if IconHandle <> 0 then begin
   Icon := TIcon.Create;
   Icon.Handle := IconHandle;
   try
     DrawIconEx(AButton.Glyph.Canvas.Handle, 0, 0, Icon.Handle,
          AButton.Glyph.Width, AButton.Glyph.Height, 0, 0, DI_NORMAL);
   finally
     Icon.ReleaseHandle;
     Icon.Free;
   end;
 end;
end;

procedure TfMain.Childwithicon1Click(Sender: TObject);
begin
 with TfChildWithIcon.Create(Application) do
   Show;
end;

procedure TfMain.ButtonsPanelResize(Sender: TObject);
begin
 RedrawButtons;
end;

end.


---

← →
Игорь Шевченко ©   (2004-04-09 11:17) [3]

unit UserMessages;

interface
uses
 Messages;
const
 UM_MDIACTIVE = WM_USER + 555;

implementation

end.


Дочерние окна:

unit Child;

interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;

type
 TfChild = class(TForm)
   ListBox: TListBox;
   procedure FormCreate(Sender: TObject);
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
 private
   procedure WM_MDIACTIVATE (var Message : TMessage); message WM_MDIACTIVATE;
 end;

var
 fChild: TfChild;
 GlobalChildCount : Integer = 0;

implementation
uses
 UserMessages;

{$R *.dfm}

procedure TfChild.FormCreate(Sender: TObject);
begin
 Inc(GlobalChildCount);
 Caption := Format("%d", [GlobalChildCount]);
end;

procedure TfChild.WM_MDIACTIVATE (var Message : TMessage);
var
 Buf : array[0..255] of char;
begin
 if THandle(Message.WParam) = Handle then begin
   ListBox.Items.Add("Ich bin deactivated :-(");
   if Message.LParam <> 0 then begin
     GetWindowText(Message.LParam, Buf, sizeof(Buf));
     ListBox.Items.Add (Format("%s is more lucky guy", [Buf]));
   end;
   SendMessage (Application.MainForm.Handle, UM_MDIACTIVE, Message.WParam,
     Handle);
 end else if THandle(Message.LParam) = Handle then begin
   ListBox.Items.Add("Hurray! I am active again!");
   if Message.WParam <> 0 then begin
     GetWindowText(Message.WParam, Buf, sizeof(Buf));
     ListBox.Items.Add (Format("%s is gone loser", [Buf]));
   end;
   SendMessage (Application.MainForm.Handle, UM_MDIACTIVE, Handle,
     Message.LParam);
 end;
end;

procedure TfChild.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Action := caFree;
end;

end.


---

← →
EvgeniyR ©   (2004-04-09 12:02) [4]

Я, наверно, неправильно выразился. Кнопки(работают как радио кнопки) создаются и уничтожаются при уничтожении формы, при нажатии на них - выносятся наверх соответствующии дочернии формы. Надо что бы при "ручной" активизации формы, "топилась" (Down := true) соответствующая кнопка на ToolBar"е.

---

← →
lgz   (2004-04-09 14:05) [5]

EvgeniyR ©
У меня есть что-то наподобие панели задач виндовса для приложения с MDI. Там панелька внизу главной формы и TSpeedButton-кнопки создаются, нажимаются и убиваются вместе c MDIChild-окнами. Прислать на мыло?

---

← →
EvgeniyR ©   (2004-04-09 14:16) [6]

> lgz   (09.04.04 14:05) [5]

Да, пожалуйста.

---

← →
Wizard_Ex ©   (2004-04-09 17:54) [7]

Подкину компонент, кстати Игорь Шевченко мне как-то помог именно по этому случаю, за что ему спасибо.
Компонент называется TMDIPanel,
регистрируется на панель Win32, полностью самодостаточен. Ничего больше писать не надо и особенно оконные функции изменять.
Только модератор удалит наверно, а хотелось бы код в студию

---

← →
Wizard_Ex ©   (2004-04-09 18:06) [8]

Почему кладовка не работает?
Итого код в студию (объедините в один юнит)
{******************************************}
{                                          }
{               TMDIPanel                  }
{                                          }
{         Copyright(c) Wizard_Ex           }
{                                          }
{  Спасибо Galera за помощь в написании    }
{  части кода (Portion Copyright Ж-)       }
{                                          }
{  Отдельное спасибо Игорю Шевченко        }
{  за помощь в разрешении проблемы         }
{  с получением иконки                     }
{                                          }
{******************************************}

// извините, но код написан на коленке, в нем есть сопли, и самое главное он неплохо работает, блин, не смотря ни на что
// for free use only

// докладывать не будем, не будем,... а проблему решать будем...
// "Мама не горюй"

unit MDIPanel;

interface
uses Classes, SysUtils, Menus, Forms, Controls, Graphics, Dialogs, Buttons,
    ExtCtrls, Messages, Windows, RxCtrls {JvxCtrls}; //

type

 TMDIPanel = class(TPanel)
 private
   Form: TForm;
   OldWndClientProc: Pointer;
   InstanceWndClientProc: Pointer;
   FFlat: boolean;
   FDefaultButtonWidth: integer;
   procedure SetFlat(const Value: boolean);
   procedure Restructure(Needed : boolean = False);
   procedure SetDefaultButtonWidth(const Value: integer);
   procedure WMSize(var Message: TWMSize); message WM_SIZE;
   procedure WMEXITSIZEMOVE(var Message: TMessage); message WM_EXITSIZEMOVE;
 protected
     procedure WndClientProc(var Message: TMessage); virtual;
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 published
   property Flat : boolean read FFlat write SetFlat;
   property DefaultButtonWidth : integer read FDefaultButtonWidth write SetDefaultButtonWidth;
 end;
 
 TMDIButton = class(TRxSpeedButton)    // у RX кнопки в Caption троеточие в конце пишется - красиво блин ;-0
// Могут быть варианты:
//  TMDIButton = class(TJvxSpeedButton)   //  используется библиотека Jedy  - в uses раскоментарьте JvxCtrls
//  TMDIButton = class(TSpeedButton)      // используется стандартный SpeedButton
 private
   AHandle: THandle;
   OldChildWndProc: Pointer;
   InstanceChildWndProc: Pointer;
   PopupMenu: TPopupMenu;
   procedure ChildWndProc(var Message: TMessage);
   procedure ClickActivate(Sender: TObject);
   procedure CloseMDIWindow(Sender: TObject);
   procedure MaximizeMDIWindow(Sender: TObject);
   procedure MDIButtonMouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure MinimizeMDIWindow(Sender: TObject);
   procedure OnPopupMenu(Sender: TObject);
   procedure RestoreMDIWindow(Sender: TObject);
   procedure CascadeMDIWindow(Sender: TObject);
   procedure IconArrangeMDIWindow(Sender: TObject);
   procedure TileHorMDIWindow(Sender: TObject);
   procedure TileVertMDIWindow(Sender: TObject);
   procedure MinimizeAllMDIWindow(Sender: TObject);
   procedure CloseAllMDIWindow(Sender: TObject);
   procedure ClientSizeMDIWindow(Sender: TObject);
   procedure ClientSizeAllMDIWindow(Sender: TObject);
 public
   constructor CreateBtn(sHandle: THandle; AOwner: TComponent); virtual;
   destructor Destroy; override;
 end;

procedure Register;

implementation

{ TMDIPanel }

procedure Register;
begin
 RegisterComponents("Win32", [TMDIPanel]);
end;

{Выдираем иконку всеми возможными средствами}
// Thanks to Игорь Шевченко
function GetIconFromWindow(hWnd:HWND):HICON;
var
 Ico:HICON;
begin
 Ico:=0;
 SendMessageTimeout(hwnd, WM_GETICON, ICON_SMALL, 0, SMTO_ABORTIFHUNG, 1000, LongWord(ico));
 if (ico = 0) then ico := GetClassLong(hwnd, GCL_HICONSM);
 if (ico = 0) then SendMessageTimeout(hwnd, WM_GETICON, ICON_BIG, 0, SMTO_ABORTIFHUNG, 1000, LongWord(ico));
 if (ico = 0) then ico := GetClassLong(hwnd, GCL_HICON);
 
 {вот именно эта строка работает за всех, кто бы знал}
 if (ico = 0) then SendMessageTimeout(hwnd, WM_QUERYDRAGICON, 0, 0, SMTO_ABORTIFHUNG, 1000, LongWord(ico));
 
 if (ico = 0) then ico:=LoadIcon(0,IDI_APPLICATION);
 Result:=Ico;
end;

constructor TMDIPanel.Create(AOwner: TComponent);
var
 Component: TComponent;
begin
 inherited;
 Align:=alBottom;
 Caption:="";
 ShowHint:=True;
 Height:=27;
 BorderWidth:=1;
 BevelInner:=bvLowered;
 BevelOuter:=bvRaised;
 Flat:=True;
 DefaultButtonWidth:=165;

 if not (csDesigning in ComponentState) then
 begin
   Component := Owner;
   while Assigned(Component) and not (Component is TForm) do Component:= Component.Owner;
   if not Assigned(Component) then exit;
   Form := Component as TForm;

   if Form.Handle=Form.ClientHandle then ; //бда, а был ли мальчик

   if (not (csDesigning in ComponentState)) and (Form.FormStyle=fsMDIForm) then
   begin
     InstanceWndClientProc := MakeObjectInstance(WndClientProc);
     OldWndClientProc := Pointer(GetWindowLong(Form.ClientHandle, GWL_WNDPROC));
     SetWindowLong(Form.ClientHandle, GWL_WNDPROC, Longint(InstanceWndClientProc));
   end;
 end;
end;

---

← →
Wizard_Ex ©   (2004-04-09 18:07) [9]

Далее
destructor TMDIPanel.Destroy;
begin
 inherited;

end;

procedure TMDIPanel.SetFlat(const Value: boolean);
begin
 FFlat := Value;
end;

procedure TMDIPanel.WndClientProc(var Message: TMessage);
var mdiButton : TMDIButton;
      Icon: TIcon;
   ACaption: array[0..255] of Char;
begin
 case Message.Msg of
   WM_MDICREATE:
     begin
       Message.Result := CallWindowProc(OldWndClientProc, Form.ClientHandle, Message.Msg, Message.WParam, Message.LParam);

       mdiButton:=TMDIButton.CreateBtn(Message.Result, Self);
       mdiButton.Parent:=Self;
       if ControlCount>1 then
       begin
         mdiButton.Left:=Controls[ControlCount-2].Left+Controls[ControlCount-2].Width+1;
         mdiButton.Width:=Controls[ControlCount-2].Width;
       end else
           begin
             mdiButton.Left:=BevelWidth+BorderWidth+1;
             mdiButton.Width:=FDefaultButtonWidth;
           end;
       mdiButton.Top:=BevelWidth+BorderWidth+1;
       mdiButton.Height:=Height-BevelWidth*2-BorderWidth*2-2;
       mdiButton.GroupIndex:=10;
       mdiButton.Down:=True;
       mdiButton.Layout:=blGlyphLeft;
       mdiButton.Margin:=0;
       mdiButton.Flat:=FFlat;
       
       // шо це таке, га  (с украинским акцентом)
       
       GetWindowText(Message.Result, ACaption, 255);
//        mdiButton.Caption:=ACaption;
//        mdiButton.Hint:=ACaption;

       Icon := TIcon.Create;
       Icon.Handle := GetIconFromWindow(Message.Result);

       mdiButton.Glyph.Width := 16;
       mdiButton.Glyph.Height := 16;

       // ну-ка сделаем из большого слона маленького причем 16 на 16
       DrawIconEx(mdiButton.Glyph.Canvas.Handle,0,0,Icon.Handle,16,16,0,0,DI_NORMAL);
       Icon.ReleaseHandle; // однако нужна еще, иконка-то
       Icon.Free;

       Restructure;  // всем строиться

       Exit;
     end;
   WM_MDIREFRESHMENU :
     begin
       GetWindowText(GetTopWindow(Application.MainForm.ClientHandle), ACaption, 255);
     end;
   WM_DESTROY:
     begin
       SetWindowLong(Form.ClientHandle, GWL_WNDPROC, Longint(OldWndClientProc));
       FreeObjectInstance(InstanceWndClientProc);
     end;
 end;
 Message.Result:= CallWindowProc(OldWndClientProc, Form.ClientHandle, Message.Msg, Message.WParam, Message.LParam);
end;

procedure TMDIPanel.Restructure(Needed : boolean = False);
var I : integer;
   AllButtonWidth : integer;
   AWidth : integer;
begin
// вот это код ;-(
 if ControlCount=0 then exit;
 AllButtonWidth:=0;
 for I:=0 to ControlCount-1 do AllButtonWidth:=AllButtonWidth+Controls[i].Width;
 AllButtonWidth:=AllButtonWidth+BevelWidth*2-BorderWidth*2+ControlCount;
 AWidth:=Round((Width-(BevelWidth*2+BorderWidth*2+ControlCount))/ControlCount);
 for I:=0 to ControlCount-1 do
 begin
   if (AllButtonWidth>(Width+1)) or Needed then Controls[i].Width:=AWidth;
   if (Controls[i].Width>DefaultButtonWidth) then Controls[i].Width:=DefaultButtonWidth;
   if I=0 then Controls[i].Left:=BevelWidth+BorderWidth+1
     else Controls[i].Left:=Controls[i-1].Left+Controls[i-1].Width;
 end;
end;

procedure TMDIPanel.SetDefaultButtonWidth(const Value: integer);
begin
 FDefaultButtonWidth := Value;
end;

procedure TMDIPanel.WMSize(var Message: TWMSize);
begin
 inherited;
 Restructure(True);
 // думаю это повесить на событие когда изменение размера уже завершилось (на WMEXITSIZEMOVE)
 // а то так накладно
end;

procedure TMDIPanel.WMEXITSIZEMOVE(var Message: TMessage);
begin
 inherited;
 // но что-то не работает
end;

{ TMDIButton }

constructor TMDIButton.CreateBtn(sHandle: THandle; AOwner: TComponent);
var
 mi: TMenuItem;
begin
// если будете менять местами команды не забудьте заглянуть в TMDIButton.OnPopupMenu(Sender: TObject);
// очень рекомендую

 inherited Create(AOwner);
 AHandle:=sHandle;
 OnClick := ClickActivate;

 PopupMenu := TPopupMenu.Create(Self);

 mi := TMenuItem.Create(Self);
 mi.Caption := "Каскадом";
 mi.OnClick := CascadeMDIWindow;
 PopupMenu.Items.Add(mi);

 mi := TMenuItem.Create(Self);
 mi.Caption := "Встык горизонтально";
 mi.OnClick := TileHorMDIWindow;
 PopupMenu.Items.Add(mi);

 mi := TMenuItem.Create(Self);
 mi.Caption := "Встык вертикально";
 mi.OnClick := TileVertMDIWindow;
 PopupMenu.Items.Add(mi);

 mi := TMenuItem.Create(Self);
 mi.Caption := "Упорядочить значки";
 mi.OnClick := IconArrangeMDIWindow;
 PopupMenu.Items.Add(mi);

 mi := TMenuItem.Create(Self);
 mi.Caption := "Минимизировать все";
 mi.OnClick := MinimizeAllMDIWindow;
 PopupMenu.Items.Add(mi);

 mi := TMenuItem.Create(Self);
 mi.Caption := "Закрыть все";
 mi.OnClick := CloseAllMDIWindow;
 PopupMenu.Items.Add(mi);

 mi := TMenuItem.Create(Self);
 mi.Caption := "-";
 PopupMenu.Items.Add(mi);

 mi := TMenuItem.Create(Self);
 mi.Caption := "Активизировать";
 mi.OnClick := ClickActivate;
 mi.Bitmap.Handle := LoadBitmap(0, PChar(OBM_CHECK));
 PopupMenu.Items.Add(mi);

 mi := TMenuItem.Create(Self);
 mi.Caption := "-";
 PopupMenu.Items.Add(mi);

 mi := TMenuItem.Create(Self);
 mi.Caption := "Восстановить";
 mi.OnClick := RestoreMDIWindow;
 mi.Bitmap.Handle := LoadBitmap(0, PChar(OBM_RESTORED));
 PopupMenu.Items.Add(mi);

 mi := TMenuItem.Create(Self);
 mi.Caption := "Минимизировать";
 mi.OnClick := MinimizeMDIWindow;
 mi.Bitmap.Handle := LoadBitmap(0, PChar(OBM_REDUCED));
 PopupMenu.Items.Add(mi);

 mi := TMenuItem.Create(Self);
 mi.Caption := "Максимизировать";
 mi.OnClick := MaximizeMDIWindow;
 mi.Bitmap.Handle := LoadBitmap(0, PChar(OBM_ZOOMD));
 PopupMenu.Items.Add(mi);

 mi := TMenuItem.Create(Self);
 mi.Caption := "-";
 PopupMenu.Items.Add(mi);

 mi := TMenuItem.Create(Self);
 mi.Caption := "Клиентский размер";
 mi.OnClick := ClientSizeMDIWindow;
 PopupMenu.Items.Add(mi);

 mi := TMenuItem.Create(Self);
 mi.Caption := "Клиентский размер у всех";
 mi.OnClick := ClientSizeAllMDIWindow;
 PopupMenu.Items.Add(mi);

 mi := TMenuItem.Create(Self);
 mi.Caption := "-";
 PopupMenu.Items.Add(mi);

 mi := TMenuItem.Create(Self);
 mi.Caption := "Закрыть окно";
 mi.OnClick := CloseMDIWindow;
 PopupMenu.Items.Add(mi);

 PopupMenu.OnPopup := OnPopupMenu;

 OnMouseDown:=MDIButtonMouseDown;

 InstanceChildWndProc := MakeObjectInstance(ChildWndProc);
 OldChildWndProc := Pointer(GetWindowLong(AHandle,GWL_WNDPROC));
 SetWindowLong(AHandle, GWL_WNDPROC, Longint(InstanceChildWndProc));
end;

---

← →
Wizard_Ex ©   (2004-04-09 18:08) [10]

И еще:

procedure TMDIButton.MDIButtonMouseDown(Sender: TObject;
 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var T : TPoint;
begin
 if Button=mbRight then
 begin
   GetCursorPos(T);
   PopupMenu.Popup(T.X, T.Y);
 end;
end;

destructor TMDIButton.Destroy;
begin
 SetWindowLong(AHandle, GWL_WNDPROC, Longint(OldChildWndProc));
 FreeObjectInstance(InstanceChildWndProc);
 inherited;
end;

procedure TMDIButton.OnPopupMenu(Sender: TObject);
var I : integer;
begin
 I:=7;
 if GetTopWindow(Application.MainForm.ClientHandle)=AHandle then
   PopupMenu.Items[I+0].Enabled := False
 else
   PopupMenu.Items[I+0].Enabled := True;

 if IsIconic(AHandle) then begin
   PopupMenu.Items[I+2].Enabled := True;
   PopupMenu.Items[I+3].Enabled := False;
   PopupMenu.Items[I+4].Enabled := True;
 end
 else begin
   PopupMenu.Items[I+3].Enabled := True;
   if IsZoomed(AHandle) then begin
     PopupMenu.Items[I+2].Enabled := True;
     PopupMenu.Items[I+4].Enabled := False;
   end
   else begin
     PopupMenu.Items[I+2].Enabled := False;
     PopupMenu.Items[I+4].Enabled := True;
   end;
 end;
end;

procedure TMDIButton.ChildWndProc(var Message: TMessage);
var AMDIPanel : TMDIPanel;
begin
 case Message.Msg of
 WM_GETTEXT:
   begin
     Message.Result:= CallWindowProc(OldChildWndProc, AHandle, Message.Msg, Message.WParam, Message.LParam);
     Caption := PChar(Message.LParam);
     Hint := PChar(Message.LParam);
     Exit;
   end;
 WM_MDIACTIVATE:
   begin
     if HWND(Message.LParam)=AHandle then Down := True;
     if HWND(Message.WParam)=AHandle then Down := False;
   end;
 WM_DESTROY:
   begin
     PopupMenu.Free;
     AMDIPanel:=TMDIPanel(Parent);
     Free;
     AMDIPanel.Restructure(True);
   end;
 end;
 Message.Result:= CallWindowProc(OldChildWndProc, AHandle, Message.Msg, Message.WParam, Message.LParam);
end;

procedure TMDIButton.CascadeMDIWindow(Sender: TObject);
begin
 SendMessage(Application.MainForm.ClientHandle, WM_MDICASCADE, 0, 0);
end;

procedure TMDIButton.TileHorMDIWindow(Sender: TObject);
begin
 SendMessage(Application.MainForm.ClientHandle, WM_MDITile, MDITILE_HORIZONTAL, 0);
end;

procedure TMDIButton.TileVertMDIWindow(Sender: TObject);
begin
 SendMessage(Application.MainForm.ClientHandle, WM_MDITile, MDITILE_VERTICAL, 0);
end;

procedure TMDIButton.IconArrangeMDIWindow(Sender: TObject);
begin
 SendMessage(Application.MainForm.ClientHandle, WM_MDIICONARRANGE, 0, 0);
end;

procedure TMDIButton.MaximizeMDIWindow(Sender: TObject);
begin
 ShowWindow(AHandle,SW_MAXIMIZE);
end;

procedure TMDIButton.ClientSizeMDIWindow(Sender: TObject);
var Rect : TRect;
begin
 inherited;
 LockWindowUpdate(AHandle);
 try
     if isZoomed(AHandle) then ShowWindow(AHandle,SW_RESTORE);
     Windows.GetClientRect(Application.MainForm.ClientHandle,Rect);
     with Application.MainForm.ActiveMDIChild do
     if not ((Left=0) and (Top=0) and (Width=Rect.Right) and (Height=Rect.Bottom)) then
     begin
       Left:=0;
       Top:=0;
       // begin Как ни странно без этих строк не обойтись
       Width:=Rect.Right-80;  
       Height:=Rect.Bottom-80;
       // end

       Application.ProcessMessages;
       Windows.GetClientRect(Application.MainForm.ClientHandle,Rect);
       Width:=Rect.Right;
       Height:=Rect.Bottom;
     end;
 finally
   LockWindowUpdate(0);
 end;
end;

procedure TMDIButton.ClientSizeAllMDIWindow(Sender: TObject);
var Rect : TRect;
   I : integer;
   cHandle : THandle;
begin
 inherited;
 Screen.Cursor:=crHourGlass;
 LockWindowUpdate(Application.MainForm.ClientHandle);
 try
   for i:=0 to Application.MainForm.MDIChildCount-1 do
   begin
     cHandle:=Application.MainForm.MDIChildren[I].Handle;
     if isZoomed(cHandle) then ShowWindow(cHandle,SW_RESTORE);
   end;
{    if Application.MainForm.VertScrollBar.IsScrollBarVisible         // какая-то бредовая идея ей богу
     or Application.MainForm.HorzScrollBar.IsScrollBarVisible then}  // ...ные скролбары
   begin
     Windows.GetClientRect(Application.MainForm.ClientHandle,Rect);
     for i:=0 to Application.MainForm.MDIChildCount-1 do
     with Application.MainForm.MDIChildren[I] do
     begin
       Left:=0;
       Top:=0;
       // begin Как ни странно без этих строк не обойтись
       Width:=Rect.Right-80;
       Height:=Rect.Bottom-80;
       // end
     end;
   end;

   Application.ProcessMessages;  // ну так, на всякий случай, а то без этого кажись не работает
   Windows.GetClientRect(Application.MainForm.ClientHandle,Rect);
   for i:=0 to Application.MainForm.MDIChildCount-1 do
   with Application.MainForm.MDIChildren[I] do
   begin
     Left:=0;
     Top:=0;
     Width:=Rect.Right;
     Height:=Rect.Bottom;
   end;
 finally
   LockWindowUpdate(0);  // понеслась
   Screen.Cursor:=crDefault;
 end;
end;

procedure TMDIButton.ClickActivate(Sender: TObject);
begin
// здесь реализуем поведение как в Windows если активно, то минимизироваться
// если не активно то активизироваться
 if IsIconic(AHandle) then
 begin
   ShowWindow(AHandle,SW_RESTORE);
   Exit;
 end;

 if (GetTopWindow(Application.MainForm.ClientHandle)=AHandle) then
 begin
   ShowWindow(AHandle,SW_MINIMIZE);
 end
   else begin
          if not IsIconic(AHandle) then
          begin
            BringWindowToTop(AHandle);
          end;
          if isZoomed(GetTopWindow(Application.MainForm.ClientHandle)) then
          begin
            BringWindowToTop(AHandle);
            ShowWindow(AHandle,SW_MAXIMIZE)
          end
             else ShowWindow(AHandle,SW_RESTORE);
        end;
end;

procedure TMDIButton.CloseMDIWindow(Sender: TObject);
begin
 SendMessage(AHandle,WM_CLOSE,0,0);
end;

procedure TMDIButton.MinimizeMDIWindow(Sender: TObject);
begin
 ShowWindow(AHandle,SW_MINIMIZE);
end;

procedure TMDIButton.MinimizeAllMDIWindow(Sender: TObject);
var I : integer;
   isIcon : boolean;
begin
 // Minimize All работает по принципу кнопки ShowDesktop в Windows,
 // минимизирует если не свернуты
 // и наоборот
 isIcon:=True;
 for i:=TMDIPanel(Parent).ControlCount-1 downto 0 do
  if not IsIconic(TMDIButton(TMDIPanel(Parent).Controls[i]).AHandle) then
  begin
    isIcon:=False;
    Break;
  end;
 if not isIcon then
 for i:=TMDIPanel(Parent).ControlCount-1 downto 0 do
   ShowWindow(TMDIButton(TMDIPanel(Parent).Controls[i]).AHandle,SW_MINIMIZE)
   else
     for i:=0 to TMDIPanel(Parent).ControlCount-1  do
       ShowWindow(TMDIButton(TMDIPanel(Parent).Controls[i]).AHandle,SW_RESTORE);
end;

procedure TMDIButton.CloseAllMDIWindow(Sender: TObject);
var I : integer;
begin
 for i:=TMDIPanel(Parent).ControlCount-1 downto 0 do
 SendMessage(TMDIButton(TMDIPanel(Parent).Controls[i]).AHandle,WM_CLOSE,0,0);
end;

procedure TMDIButton.RestoreMDIWindow(Sender: TObject);
begin
 ShowWindow(AHandle,SW_RESTORE);
end;

end.

---

← →
Wizard_Ex ©   (2004-04-09 18:16) [11]

В итоге кидаете этот компонент на главную форму MDI и забываете как это вообще работает (в смысле не тревожитесь - забывать не надо, понимать надо)
Большое пожалуйста.

P.S.
Кстати когда-то я его в кладовку кажется выкладывал

---

← →
EvgeniyR ©   (2004-04-12 09:25) [12]

Огромное спасибо Wizard_Ex, Игорь Шевченко.

---

← →
Wizard_Ex ©   (2004-04-12 17:12) [13]

Работает?
Разобрался?

---

Страницы: 1 вся ветка

Текущий архив: 2004.05.02;
Скачать: CL | DM;

Наверх

Память: 0.56 MB
Время: 0.023 c