閉じるボタンを表示しないようにするには？ (ID:22234)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

こんなとこかな〜

type
  TMyDockTree =class(TDockTree)
  protected
    FOrgWndProc: TWndMethod;
  public
    constructor Create(DockSite: TWinControl); override;
    destructor Destroy; override;
  protected
    procedure PaintDockFrame(Canvas: TCanvas; Control: TControl;
      const ARect: TRect); override;
    procedure MyWindowProc(var Message: TMessage);

end;

constructor TMyDockTree.Create(DockSite: TWinControl);
begin
  inherited Create(DockSite);
  if not (csDesigning in DockSite.ComponentState) then begin
    FOrgWndProc := DockSite.WindowProc;
    DockSite.WindowProc := MyWindowProc;
  end;
end;

destructor TMyDockTree.Destroy;
begin
  if @FOrgWndProc <> nil then DockSite.WindowProc := FOrgWndProc;
  inherited Destroy;
end;

procedure TMyDockTree.PaintDockFrame(Canvas: TCanvas; Control: TControl; const ARect: TRect);
  procedure DrawGrabberLine(Left, Top, Right, Bottom: Integer);
  begin
    with Canvas do begin
      Pen.Color := clBtnHighlight;
      MoveTo(Right, Top);
      LineTo(Left, Top);
      LineTo(Left, Bottom);
      Pen.Color := clBtnShadow;
      LineTo(Right, Bottom);
      LineTo(Right, Top-1);
    end;
  end;

begin
  with ARect do begin
    if DockSite.Align in [alTop, alBottom] then begin
      DrawGrabberLine(Left+3, Top+1, Left+5, Bottom-2);
      DrawGrabberLine(Left+6, Top+1, Left+8, Bottom-2);
    end
    else begin
      DrawGrabberLine(Left+2, Top+3, Right-2, Top+5);
      DrawGrabberLine(Left+2, Top+6, Right-2, Top+8);
    end;
  end;
end;

procedure TMyDockTree.MyWindowProc(var Message: TMessage);
var
  mp: TPoint;
  hitTestValue: Integer;
begin
  case Message.Msg of
    WM_LBUTTONDBLCLK,
    WM_LBUTTONDOWN:begin
      mp := SmallPointToPoint(TWMMouse(Message).Pos);
      HitTest(mp, hitTestValue);
      while hitTestValue = HTCLOSE do begin
        if DockSite.Align in [alTop, alBottom] then begin
          mp.Y := mp.Y + 10{これは適当};
        end
        else begin
          mp.X := mp.X - 10{これも適当};
        end;
        HitTest(mp, hitTestValue);
      end;
      TWMMouse(Message).Pos.x := mp.X;
      TWMMouse(Message).Pos.y := mp.Y;
    end;
  end;
  {処理を(TDockTree.WindowProcに放り投げ)}
  FOrgWndProc(Message);
end;

initialization
  Controls.DefaultDockTreeClass := TMyDockTree;

←解決時は質問者本人がここをチェックしてください。

戻る