Форум: "WinAPI";
Текущий архив: 2004.07.04;
Скачать: [xml.tar.bz2];
ВнизСобственный TaskBar Найти похожие ветки
← →
Dennisius (2004-05-23 11:49) [0]Мастера как сделать свой собственный TaskBar для MDI приложения,
может кто-нибудь делал подскажет подход. Спасибо.
← →
Mim1 © (2004-05-23 20:18) [1]Смысл такой что у меня есть базовы класс для mdichild окон, от которого я наследуюсь при их создании
код CLXный, но смысл уловить и модифицировать можно
На главной форме лежит AppWndBar: TToolBarunit 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.
Общий предок для MDIChildsunit 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 вся ветка
Форум: "WinAPI";
Текущий архив: 2004.07.04;
Скачать: [xml.tar.bz2];
Память: 0.53 MB
Время: 0.034 c