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

Вниз

Собственный TaskBar   Найти похожие ветки 

← →
Dennisius   (2004-05-23 11:49) [0]

Мастера как сделать свой собственный TaskBar для MDI приложения,
может кто-нибудь делал подскажет подход. Спасибо.

---

← →
Mim1 ©   (2004-05-23 20:18) [1]

Смысл такой что у меня есть базовы класс для mdichild окон, от которого я наследуюсь при их создании
код CLXный, но смысл уловить и модифицировать можно
На главной форме лежит AppWndBar: TToolBar
unit CkgMdiChild;

interface

uses
 SysUtils, Classes, QControls, QForms, QStdCtrls, QComCtrls;

type
 TCkgMdiChild = class(TForm)
   procedure ToolButtonClick(Sender: TObject);
 protected
   procedure TextChanged; override;
   procedure Activate; override;
   procedure Deactivate; override;
   procedure Notification(AComponent: TComponent; Operation: TOperation);
     override;
 private
   FFocusAccepter:TButton;
 public
   ToolButton:TToolButton;  //  нопка на панели задач
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   procedure AfterConstruction; override;
 end;

procedure Register;

implementation

uses CkgConst, CkgMainForm, QT;

procedure Register;
begin
//  RegisterComponents(DesignerTabName, [TCkgMdiChild]);
end;

{ TCkgMdiChild }

procedure TCkgMdiChild.Activate;
begin
 inherited;
 if (ActiveControl = nil) and (FFocusAccepter <> nil) then
   ActiveControl := FFocusAccepter;

 if ToolButton<> nil then ToolButton.Down := true;
end;

procedure TCkgMdiChild.AfterConstruction;
begin
 inherited;
 ToolButton.Enabled := true;

 if FFocusAccepter=nil then
   begin
     FFocusAccepter := TButton.Create(self);
     FFocusAccepter.Parent := self;
     FFocusAccepter.Left := - FFocusAccepter.Width;
     FFocusAccepter.Top := - FFocusAccepter.Height;
   end;
end;

constructor TCkgMdiChild.Create(AOwner: TComponent);
begin
 inherited;

 if Application.MainForm is TWndMain then
   begin
     ToolButton := TToolButton.Create(nil);
     with ToolButton do
       begin
         OnClick := ToolButtonClick;
         Parent := TWndMain(Application.MainForm).AppWndBar;
         Caption := "Loading ...";
         AutoSize := true;
         Enabled := false;
       end;
   end;
end;

procedure TCkgMdiChild.Deactivate;
begin
 inherited;
 if ToolButton<> nil then ToolButton.Down := false;
end;

destructor TCkgMdiChild.Destroy;
begin
 if ActiveControl = FFocusAccepter then ActiveControl := nil;
 FreeAndNil(ToolButton);
 inherited;
end;

procedure TCkgMdiChild.Notification(AComponent: TComponent;
 Operation: TOperation);
begin
 inherited;
 if (Operation = opRemove) then
 begin
   if AComponent = FFocusAccepter then
     FFocusAccepter := nil;
 end;
end;

procedure TCkgMdiChild.TextChanged;
begin
 inherited;
 if ToolButton <> nil then ToolButton.caption := Self.Caption;
end;

procedure TCkgMdiChild.ToolButtonClick(Sender: TObject);
begin
 if QWidget_isVisible(Handle) then
   begin
     if (Application.MainForm as tform).ActiveMDIChild = self then
       begin
         QWidget_clearFocus(Handle);
         QWidget_hide(Handle);
       end
     else
       begin
         QWidget_clearFocus(Handle);
         SetFocus;
       end;
   end
 else
   begin
     QWidget_clearFocus(Handle);
     QWidget_show(Handle);
     SetFocus;
   end;
end;

end.

---

← →
Gero ©   (2004-05-23 20:41) [2]

> Dennisius   (23.05.04 11:49)

Это нужно сделать на WinAPI?

---

← →
mutabor   (2004-05-24 11:46) [3]

в грубом приближении можно кидать на TPanel(delphpi) кнопки при создании новой формы. каждой кнопке опереляешь обработчик, показывающий то окно, на кот завязана кнопка

---

← →
Игорь Шевченко ©   (2004-05-24 12:04) [4]

Вот что я делал:

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;
   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));
 DEBUGSTR("Window Text = %s", [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-05-24 12:06) [5]

И еще два unit"а:
unit UserMessages;

interface
uses
 Messages;
const
 UM_MDIACTIVE = WM_USER + 555;

implementation

end.


Общий предок для MDIChilds
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
   SendMessage (Application.MainForm.Handle, UM_MDIACTIVE, Message.WParam,
     Handle);
 end else if THandle(Message.LParam) = Handle then begin
   SendMessage (Application.MainForm.Handle, UM_MDIACTIVE, Handle,
     Message.LParam);
 end;
end;

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

end.


---

← →
Dennisius   (2004-05-24 13:18) [6]

Спасибо всем огромное, кода навалом копаться буду долго :))))
но мне тут идея пришла пока в offline был может использовать
TabSet так сказать ретро стиль :))
Но
1) его легче реализовать
2) не будет проблем с resize поскольку у него есть спрокрутка,
а у toolbar кнопки будут просто будут исчезать прошу совета по этому вопросу.

---

← →
Dennisius   (2004-05-24 13:36) [7]

> Mim1 ©   (23.05.04 20:18) [1]
> Игорь Шевченко ©


Я вижу что вы неплохо знакомы с MDI  технологией почему же некто не ответил на этот топик :
http://delphimaster.net/view/4-1085204229/

---

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

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

Наверх

Память: 0.5 MB
Время: 0.028 c