Форум: "Основная";
Поиск по всему сайту: delphimaster.net;
Текущий архив: 2002.01.31;
Скачать: [xml.tar.bz2];




Вниз

Панель окон 


Slavan   (2002-01-14 13:35) [0]

Привет всем!

Может кто подскажет где взять компонент - панель дочерних окон MDI приложения.(При открытии дрочернего окна на панели появляется кнопка с иконкой окна и заголовком, как в Windows панель задач или в 1С панель окон )

Спасибо.



Gennady   (2002-01-15 10:35) [1]

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, ToolWin, ImgList, ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
ToolBar1: TToolBar;
ToolButton1: TToolButton;
tlbWins: TToolBar;
ilWins: TImageList;
procedure ToolButton1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
FClientInstance : TFarProc;
FPrevClientProc : TFarProc;
procedure MyMessager(var Message: TMessage);
procedure tbMDIClick(Sender: TObject);
procedure tbMDBIMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses Unit2;

{$R *.DFM}

procedure TForm1.tbMDBIMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var r: integer;
p: TPoint;
childHWND: HWND;
begin
SendMessage(Self.ClientHandle, WM_MDIACTIVATE, (Sender as TToolButton).Tag, 0);
if Button=mbRight then
begin
with (Sender as TControl) do
p:=ClientToScreen(Point(x, 0));
childHWND:=(Sender as TControl).Tag;
SendMessage(childHWND, WM_INITMENU, GetSystemMenu(childHWND, false), 0);
r:=integer(TrackPopupMenuEx(GetSystemMenu(childHWND, false), TPM_LEFTALIGN OR
TPM_RETURNCMD OR TPM_RIGHTBUTTON OR TPM_HORIZONTAL OR TPM_VERTICAL, p.x, p.y, childHWND, nil));
SendMessage(childHWND, WM_SYSCOMMAND, r, 0);
end;
end;

procedure TForm1.tbMDIClick(Sender: TObject);
begin
SendMessage(Self.ClientHandle, WM_MDIACTIVATE, (Sender as TToolButton).Tag, 0);
end;

procedure TForm1.MyMessager(var Message: TMessage);
procedure DoDefault;
begin
with Message do
Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
end;

var i: integer;
begin
with Message do
case Msg of
WM_MDICREATE:
begin
with TToolButton.Create(Self) do
begin
Parent:=tlbWins;
Caption:=PMDICreateStruct(Pointer(Message.LParam))^.szTitle;
Grouped:=True;
Style:=tbsCheck;
Down:=True;
Hint:=Caption;
AutoSize:=True;
OnClick:=tbMDIClick;
DoDefault;
tag:=Result;
for i:=0 to Self.MDIChildCount-1 do
if Self.MDIChildren[i].Handle=Tag then
ImageIndex:=ilWins.AddIcon(Self.MDIChildren[i].Icon);
OnMouseUp:=tbMDBIMouseUp;
end;
end;
WM_MDIDESTROY:
begin
DoDefault;
for i:=0 to tlbWins.ButtonCount-1 do
if tlbWins.Buttons[i].Tag=wParam then
begin
tlbWins.Buttons[i].Free;
exit;
end;
end;
WM_MDIACTIVATE:
begin
DoDefault;
for i:=0 to tlbWins.ButtonCount-1 do
if tlbWins.Buttons[i].Tag=wParam then
begin
tlbWins.Buttons[i].Down:=True;
exit;
end;
end;
WM_MDINEXT:
begin
DoDefault;
for i:=0 to tlbWins.ButtonCount-1 do
if tlbWins.Buttons[i].Tag=Self.ActiveMDIChild.Handle then
begin
tlbWins.Buttons[i].Down:=True;
exit;
end;
end;
else
DoDefault;
end;
end;


procedure TForm1.ToolButton1Click(Sender: TObject);
begin
with TForm2.Create(Application) do Show;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
FClientInstance := MakeObjectInstance(MyMessager);
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FreeObjectInstance(FClientInstance);
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FPrevClientProc));
end;

end.


пример не ахти какой, но рабочий.
думаю сложностей не возникнет.




Форум: "Основная";
Поиск по всему сайту: delphimaster.net;
Текущий архив: 2002.01.31;
Скачать: [xml.tar.bz2];




Наверх





Память: 0.73 MB
Время: 0.031 c
1-99971           @andrew               2002-01-11 18:35  2002.01.31  
ПРИВЕТ ВСЕМ!!! Не подскажите: как сделать так,


1-100012          Havez                 2002-01-13 18:45  2002.01.31  
Выделение строки DBGrid цветом


7-100073          Serega_2              2001-10-15 11:37  2002.01.31  
Помогите плз програмно прибить досувскую программу.


1-99984           helper                2002-01-13 07:03  2002.01.31  
Реестр


4-100103          neodiX                2001-11-29 15:30  2002.01.31  
Kak programno, na vremia, otkliucit mysh i klavu v WinNT ili Win2k? Ocen nado..