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

Вниз

Уважаемые Мастера, как можно сделать панельки как в Photoshop   Найти похожие ветки 

← →
brrrr   (2004-04-11 10:16) [0]

Они ведь никогда не скрываются и у них ведь всегда активные заголовки. А у меня так не получается

---

← →
ПЛОВ   (2004-04-11 10:23) [1]

не было времени расдупляться по-полной, но это древнее мое творение работает

unit Ztlsw;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics,
 Controls;

type
 { TZMoveCaption }

 TZMoveCaption = class(TCustomControl)
 private
   FCaptionHeight: Integer;
   FCaption: TCaption;
   FAnsiVarFont: TFont;
   FMove,FCloseButton, FCloseButtonDown: Boolean;
   procedure SetCaption(Value: TCaption);
   procedure SetCloseButton(Value: Boolean);
   procedure CloseParent;
   procedure MoveParent;
 protected
   procedure Paint; override;
   procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
   procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 published
   property Caption: TCaption read FCaption write SetCaption;
   property CloseButton: Boolean read FCloseButton write SetCloseButton;
   property Align;
 end;

 { TZToolWindow }
 
 TZToolWindow = class(TCustomControl)
 private
   FResizeTWin: Boolean;
   FOnSize: TNotifyEvent;
   procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
//    procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
   procedure WMSize(var Msg: TWMSize); message WM_SIZE;
   procedure SetResizeTWin(Value: Boolean);
 protected
   procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
   procedure CreateParams(var Params: TCreateParams); override;
   procedure Paint; override;
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 published
   property ResizeTWin: Boolean read FResizeTWin write SetResizeTWin;
   property Visible;
   property OnSize: TNotifyEvent read FOnSize write FOnSize;
 end;

procedure Register;

implementation

{ TZMoveCaption }

constructor TZMoveCaption.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAnsiVarFont:=TFont.Create;
FAnsiVarFont.Handle:=GetStockObject(ANSI_VAR_FONT);
FAnsiVarFont.Color:=clCaptionText;
FMove:=False;
CloseButton:=True;
FCloseButtonDown:=False;
end;

destructor TZMoveCaption.Destroy;
begin
FAnsiVarFont.Free;
inherited Destroy;
end;

procedure TZMoveCaption.SetCaption(Value: TCaption);
begin
FCaption:=Value;
Invalidate;
end;

procedure TZMoveCaption.SetCloseButton(Value: Boolean);
begin
FCloseButton:=Value;
Invalidate;
end;

procedure TZMoveCaption.Paint;
var
 ARect: TRect;

 procedure DrawCloseButton(const State: Boolean);
 begin
 ARect:=Rect(Width-FCaptionHeight+2, 2, Width-2, FCaptionHeight-2);
 if State then DrawFrameControl(Canvas.Handle, ARect, DFC_CAPTION, DFCS_CAPTIONCLOSE or DFCS_PUSHED) else DrawFrameControl(Canvas.Handle, ARect, DFC_CAPTION, DFCS_CAPTIONCLOSE);
 end;

begin
FCaptionHeight:=GetSystemMetrics(SM_CYSMCAPTION);
with Canvas do
begin
Font:=FAnsiVarFont;

Pen.Color:=clActiveCaption;
Brush.Color:=clActiveCaption;
Pen.Style:=psSolid;
Brush.Style:=bsSolid;
Rectangle(0, 0, Width, FCaptionHeight);

TextOut(2, FCaptionHeight div 2-Canvas.TextHeight(FCaption) div 2, FCaption);

if FCloseButton then DrawCloseButton(FCloseButtonDown);

end;
Height:=FCaptionHeight;
end;

procedure TZMoveCaption.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Parent<>nil then Parent.BringToFront;
if (X>Width-FCaptionHeight) and FCloseButton then
begin
FCloseButtonDown:=True;
Invalidate;
end else MoveParent;
end;

procedure TZMoveCaption.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if FCloseButtonDown and (Parent<>nil) then CloseParent;
end;

procedure TZMoveCaption.CloseParent;
begin
if Parent<>nil then
 begin
 FCloseButtonDown:=False;
 Invalidate;
 Parent.Visible:=False;
 end;
end;

procedure TZMoveCaption.MoveParent;
begin
if Parent<>nil then
 begin
 ReleaseCapture;
 Parent.Perform(WM_SYSCOMMAND, $F012, 0);
 end;
end;

{ TZToolWindow }

constructor TZToolWindow.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle:=[csAcceptsControls, csCaptureMouse, csClickEvents, csOpaque, csReplicatable];
Width:=185;
Height:=41;
FResizeTWin:=True;
end;

destructor TZToolWindow.Destroy;
begin
inherited Destroy;
end;

procedure TZToolWindow.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
if FResizeTWin then
Params.Style:=Params.Style or WS_BORDER or WS_THICKFRAME else
Params.ExStyle:=Params.ExStyle or WS_EX_DLGMODALFRAME or WS_EX_TOOLWINDOW;
end;

procedure TZToolWindow.Paint;
begin
with Canvas do
 begin
 Pen.Color:=clBtnFace;
 Pen.Style:=psSolid;
 Brush.Color:=clBtnFace;
 Brush.Style:=bsSolid;
 Rectangle(ClientRect);
 end;
end;

procedure TZToolWindow.WMWindowPosChanged(var Message: TWMWindowPosChanged);
var
 ARect: TRect;
begin
ARect:=ClientRect;
InvalidateRect(Handle, @ARect, True);
inherited;
end;
{
procedure TZToolWindow.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
begin
inherited;
if not FResizeTWin then
begin
 with Msg.MinMaxInfo^ do
 begin
 ptMinTrackSize.x:=Width;
 ptMaxTrackSize.x:=Width;
 ptMinTrackSize.y:=Height;
 ptMaxTrackSize.y:=Height;
 end;
end;
end;
}
procedure TZToolWindow.WMSize(var Msg: TWMSize);
begin
inherited;
if Assigned(FOnSize) then FOnSize(Self);
end;

procedure TZToolWindow.SetResizeTWin(Value: Boolean);
begin
FResizeTWin:=Value;
RecreateWnd;
end;

procedure TZToolWindow.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
BringToFront;
end;

procedure Register;
begin
 RegisterComponents("ZTOOLS", [TZMoveCaption, TZToolWindow]);
end;

end.

А вообще есть пакет ABC

---

← →
brrrr   (2004-04-11 10:33) [2]

Brrrrr
Я с этим через полгода разберусь. Может че нибудь попроще найдется

---

← →
ПЛОВ   (2004-04-11 10:41) [3]

Чего там полгода!
Это ж 2 компонента, инсталишь их и работай... Берешь панельку, кидаешь на форму, если надо, заголовок на панельку и окно готово! Почти как в фотошопе :)

---

← →
brrrr   (2004-04-11 10:45) [4]

Ну да. Спасибо Плов.

---

← →
brrrr   (2004-04-11 10:52) [5]

слушай плов ты сам такое написал? Ну ты крут.

---

← →
ПЛОВ   (2004-04-11 11:01) [6]

Чесно приятно что хоть что-то мое работает :)
Смотри там еще можно дописать некоторые свойства (типа ограничение мин/макс размера окна и т.п.) вроде что-то из этой лабуды там даже закоментировано... Вообщем, експерементируй

---

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

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

Наверх

Память: 0.49 MB
Время: 0.024 c