Ищу компонент (наверно какой-то TPanel)

← →
Интересующися (2013-11-03 11:57) [0]

Работающий как MDI child окна. В проекте многодокументность организована с помощью mdi form/childs. Не все в них нравится (слишком высоские заголовки mdi окон, невозможность создания нескольких mdi форм в одном проекте ну и еще некоторые вещи). Хочу найти какой-то компонент, который имел бы поведение похожее на окна MDI child. Может быть какой-то контейнер + окна (TPanel + TPanels) или еще что-то.

← →
все арамисы, а я Дартаньян (2013-11-03 12:04) [1]

Когда-то очень давно нарисовал такой компонентик. Что там и как и почему именно так — не спрашивать.

unit DragPanel; interface uses SysUtils, Classes, Controls, ExtCtrls, Messages; type TDragPanel = class(TCustomPanel) private FResizable: Boolean; FMoveable: Boolean; FBorderOuter: Boolean; FBorderInner: Boolean; procedure WMNCHITTEST(var M:TWmNcHitTest);message WM_NCHITTEST; procedure WMNCLBUTTONDBLCLICK(var M:TWMNCLBUTTONDBLCLK);message WM_NCLBUTTONDBLCLK; procedure SetBoderInner(const Value: Boolean); procedure SetBoderOuter(const Value: Boolean); protected procedure CreateParams(var Params:TCreateParams);override; procedure Paint;override; public constructor Create(AOwner:TComponent);override; property DockManager; published property Align; property Alignment; property Anchors; property AutoSize; property BiDiMode; property Caption; property Color; property Constraints; property Ctl3D; property UseDockManager default True; property DockSite; property DragCursor; property DragKind; property DragMode; property Enabled; property FullRepaint; property Font; property Locked; property ParentBiDiMode; property ParentBackground; property ParentColor; property ParentCtl3D; property ParentFont; property ParentShowHint; property PopupMenu; property ShowHint; property TabOrder; property TabStop; property Visible; property OnCanResize; property OnClick; property OnConstrainedResize; property OnContextPopup; property OnDockDrop; property OnDockOver; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEndDock; property OnEndDrag; property OnEnter; property OnExit; property OnGetSiteInfo; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnResize; property OnStartDock; property OnStartDrag; property OnUnDock; property Resizable:Boolean read FResizable write FResizable default False; property Moveable:Boolean read FMoveable write FMoveable default False; property Canvas; property BorderInner:Boolean read FBorderInner write SetBoderInner default False; property BorderOuter:Boolean read FBorderOuter write SetBoderOuter default True; end; procedure Register; implementation uses Windows; procedure Register; begin RegisterComponents("Drag", [TDragPanel]); end; { TDragPanel } constructor TDragPanel.Create(AOwner: TComponent); begin inherited; BevelOuter:=bvNone; FBorderOuter:=True; end; procedure TDragPanel.CreateParams(var Params: TCreateParams); begin inherited; if FBorderOuter then Params.Style:=Params.Style or WS_SIZEBOX; if FBorderInner then Params.ExStyle:=Params.ExStyle or WS_EX_CLIENTEDGE; end; procedure TDragPanel.Paint; begin inherited; Canvas.TextOut(5,5,"Qwerty"); end; procedure TDragPanel.SetBoderInner(const Value: Boolean); begin if FBorderInner<>Value then begin FBorderInner := Value; RecreateWnd; end; end; procedure TDragPanel.SetBoderOuter(const Value: Boolean); begin if FBorderOuter<>Value then begin FBorderOuter := Value; RecreateWnd; end; end; procedure TDragPanel.WMNCHITTEST(var M: TWmNcHitTest); var T,L,R,B:Boolean; P:TPoint; begin M.Result:=HTCLIENT; if FResizable then begin P.X:=M.XPos; P.Y:=M.YPos; P:=ScreenToClient(P); T:=P.Y<0; L:=P.X<0; B:=P.Y>=ClientHeight; R:=P.X>=ClientWidth; if T and L then M.Result:=HTTOPLEFT else if T and R then M.Result:=HTTOPRIGHT else if B and L then M.Result:=HTBOTTOMLEFT else if B and R then M.Result:=HTBOTTOMRIGHT else if T then M.Result:=HTTOP else if L then M.Result:=HTLEFT else if B then M.Result:=HTBOTTOM else if R then M.Result:=HTRIGHT end; if FMoveable and (M.Result=HTCLIENT) then M.Result:=HTCAPTION; end; procedure TDragPanel.WMNCLBUTTONDBLCLICK(var M: TWMNCLBUTTONDBLCLK); begin M.Result:=SendMessage(Handle,WM_LBUTTONDBLCLK,0,MAKELPARAM(M.XCursor,M.YCursor)) ; end; end.

← →
все арамисы, а я Дартаньян (2013-11-03 12:08) [2]

гы, чё-то в тестовой приложилке хит-тесты нифига не работают

вот ещё более поздний вариант нарыл, вроде работает прилично:

type TMyPanel=class(TPanel) private FShowCaption: Boolean; procedure SetShowCaption(const Value: Boolean); protected procedure Paint;override; procedure WMNCHITTEST(var M:TWmNcHitTest);message WM_NCHITTEST; function NCSize:Integer; function GetClientRect:TRect;override; public constructor Create(AOwner:TComponent);override; published property ShowCaption:Boolean read FShowCaption write SetShowCaption default True; property Alignment default taLeftJustify; end; constructor TMyPanel.Create(AOwner: TComponent); var Metrics:TNonClientMetrics; begin inherited; FShowCaption:=True; Alignment:=taLeftJustify; Metrics.cbSize:=SizeOf(Metrics); SystemParametersInfo(SPI_GETNONCLIENTMETRICS,0,@Metrics,0); Font.Handle:=CreateFontIndirect(Metrics.lfCaptionFont); end; function TMyPanel.GetClientRect: TRect; var R:TRect; NC:Integer; begin Windows.GetClientRect(Handle,R); if FShowCaption then R.Top:=GetSystemMetrics(SM_CYCAPTION) else R.Top:=0; {if BevelInner<>bvNone then InflateRect(R,-BevelWidth,-BevelWidth); if BevelOuter<>bvNone then InflateRect(R,-BevelWidth,-BevelWidth); if BorderStyle<>bsNone then InflateRect(R,-BorderWidth,-BorderWidth);} NC:=-NCSize; InflateRect(R,NC,NC); Result:=R; end; function TMyPanel.NCSize: Integer; begin Result:=0; if BevelInner<>bvNone then Result:=Result+BevelWidth; if BevelOuter<>bvNone then Result:=Result+BevelWidth; if BorderStyle<>bsNone then Result:=Result+BorderWidth; end; procedure TMyPanel.Paint; const Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER); var Rect: TRect; TopColor, BottomColor: TColor; FontHeight, CapHeight: Integer; Flags: Longint; procedure AdjustColors(Bevel: TPanelBevel); begin TopColor := clBtnHighlight; if Bevel = bvLowered then TopColor := clBtnShadow; BottomColor := clBtnShadow; if Bevel = bvLowered then BottomColor := clBtnHighlight; end; begin Windows.GetClientRect(Handle,Rect); if FShowCaption then CapHeight:=GetSystemMetrics(SM_CYCAPTION) else CapHeight:=0; Rect.Top:=Rect.Top+CapHeight; if BevelOuter <> bvNone then begin AdjustColors(BevelOuter); Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth); end; Frame3D(Canvas, Rect, Color, Color, BorderWidth); if BevelInner <> bvNone then begin AdjustColors(BevelInner); Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth); end; with Canvas do begin if not ThemeServices.ThemesEnabled or not ParentBackground then begin Brush.Color := Color; FillRect(Rect); end; Brush.Style := bsClear; Font := Self.Font; FontHeight := TextHeight("W"); with Rect do begin Top := 0;//((Bottom + Top) - FontHeight) div 2; Left:=0; Bottom := Top + FontHeight; if Bottom<CapHeight then Bottom:=CapHeight; Right:=Width; end; if FShowCaption then begin Brush.Color:=clActiveCaption; FillRect(Rect); InflateRect(Rect,-8,-2); Flags := DT_EXPANDTABS or DT_SINGLELINE or DT_VCENTER or Alignments[Alignment]; Flags := DrawTextBiDiModeFlags(Flags); Font.Color:=clCaptionText; DrawText(Handle, PChar(Caption), -1, Rect, Flags); end; end; end; procedure TMyPanel.SetShowCaption(const Value: Boolean); begin FShowCaption := Value; Self.Refresh; end; procedure TMyPanel.WMNCHITTEST(var M: TWmNcHitTest); var T,L,R,B:Boolean; P:TPoint; CapHeight:Integer; begin CapHeight:=GetSystemMetrics(SM_CYCAPTION); M.Result:=HTCLIENT; P.X:=M.XPos; P.Y:=M.YPos; P:=ScreenToClient(P); T:=P.Y<NCSize; L:=P.X<NCSize; B:=P.Y>=ClientHeight; R:=P.X>=ClientWidth; if P.Y<CapHeight then M.Result:=HTCAPTION; if T and L then M.Result:=HTTOPLEFT else if T and R then M.Result:=HTTOPRIGHT else if B and L then M.Result:=HTBOTTOMLEFT else if B and R then M.Result:=HTBOTTOMRIGHT else if T then M.Result:=HTTOP else if L then M.Result:=HTLEFT else if B then M.Result:=HTBOTTOM else if R then M.Result:=HTRIGHT; end;

← →
jumping jack (2013-11-03 15:30) [3]

вот простой пример с превращением всех панелей в mdi-подобные формы
type TPanel = class(ExtCtrls.TPanel) // BEFORE your form description! // if placed into module, it should be BEFORE Forms in your "uses" procedure CreateParams(var Params: TCreateParams); override; procedure WndProc(var Msg : TMessage); override; end; TForm1 = class(TForm) .................................... implementation procedure TPanel.CreateParams(var Params: TCreateParams); begin inherited; Params.Style := Params.Style or WS_CAPTION; // turns panel into movable window end; procedure TPanel.WndProc(var Msg: TMessage); var i: integer; m: cardinal; begin inherited; if Msg.Msg = WM_PARENTNOTIFY then m:= Msg.wParam else m := Msg.Msg; // so clicks on child controls will be processed case m of WM_CREATE, WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_NCLBUTTONDOWN, WM_NCRBUTTONDOWN: for i := 0 to Self.Parent.ControlCount-1 do if (Self.Parent.Controls[i] is TPanel) then SendMessage(TPanel(Self.Parent.Controls[i]).Handle, WM_NCACTIVATE, integer(Self.Parent.Controls[i] = Self), 0); end; end;

Ищу компонент (наверно какой-то TPanel) Найти похожие ветки