MyGroupBox

　MyGroupBox これは単純に、Caption に色をつけられる様にしたものです。

　標準では、Caption の色は、ClWindowText から色を変更できません。
色の指定をしても、反映されません。
又、ｂｏｘも色の変更が出来ないので、色変更を可能にしました。
そこで　MyGroupBoxは、　Caption と、Box色の指定が反映されるようにしただけの物です。
Captionを描画するとき、テーマモードを使用せず、非テーマモードで出力しています。

unit MyGroupBox;

interface

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

type
  TMyGroupBox = class(TCustomGroupBox)
  private
    { Private 宣言 }
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  protected
    { Protected 宣言 }
    procedure Paint; override;
  public
    { Public 宣言 }
  published
    { Published 宣言 }
    property Align;
    property Anchors;
    property BiDiMode;
    property Caption;
    property Color;
    property Constraints;
    property Ctl3D;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ParentBackground default True;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDockDrop;
    property OnDockOver;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;

procedure Register;

implementation

uses Themes;

procedure Register;
begin
  RegisterComponents('MyVCL', [TMyGroupBox]);
end;

procedure TMyGroupBox.Paint;
var
  H: Integer;
  R: TRect;
  Flags: Longint;
  CaptionRect,
  OuterRect: TRect;
  Size: TSize;
  Box: TThemedButton;
  Details: TThemedElementDetails;
begin
  with Canvas do
  begin
    Font := Self.Font;
    H := TextHeight('0');
    R := Rect(0, 0, Width, Height);

    if ThemeServices.ThemesEnabled then
    begin
      if Text <> '' then
      begin
        GetTextExtentPoint32(Handle, PChar(Text), Length(Text), Size);
        CaptionRect := Rect(0, 0, Size.cx, Size.cy);
        if not UseRightToLeftAlignment then
          OffsetRect(CaptionRect, 8, 0)
        else
          OffsetRect(CaptionRect, Width - 8 - CaptionRect.Right, 0);
      end
      else
        CaptionRect := Rect(0, 0, 0, 0);

      OuterRect := ClientRect;
      OuterRect.Top := (CaptionRect.Bottom - CaptionRect.Top) div 2;
      with CaptionRect do
        ExcludeClipRect(Handle, Left, Top, Right, Bottom);
      if Enabled then
        Box := tbGroupBoxNormal
      else
        Box := tbGroupBoxDisabled;
      Details := ThemeServices.GetElementDetails(Box);
      ThemeServices.DrawElement(Handle, Details, OuterRect);
      SelectClipRgn(Handle, 0);
//      if Text <> '' then
//        ThemeServices.DrawText(Handle, Details, Text, CaptionRect, DT_LEFT, 0);
    end
    else
    begin
      Brush.Color := Color;
      FillRect(Rect(0, 0, Width, Height));

      R := Rect(0, H div 2 - 1, Width, Height);
      if Ctl3D then
      begin
        Inc(R.Left);
        Inc(R.Top);
        Brush.Color := clBtnHighlight;
        FrameRect(R);
        OffsetRect(R, -1, -1);
        Brush.Color := clBtnShadow;
      end else
        Brush.Color := clWindowFrame;
      FrameRect(R);
    end;
    if Text <> '' then
    begin
      if not UseRightToLeftAlignment then
        R := Rect(8, 0, 0, H)
      else
        R := Rect(R.Right - Canvas.TextWidth(Text) - 8, 0, 0, H);
      Brush.Style := bsClear;
      Font.Color := Font.Color;
      Flags := DrawTextBiDiModeFlags(DT_SINGLELINE);
      DrawText(Handle, PChar(Text), Length(Text), R, Flags or DT_CALCRECT);
      Brush.Color := Color;
      DrawText(Handle, PChar(Text), Length(Text), R, Flags);
      if not Enabled then
        DrawState(Handle, Brush.Handle, nil, Integer(Caption), 0, R.Left, R.Top,
                  0, 0, DST_TEXT or DSS_DISABLED);
    end;
  end;
end;

procedure TMyGroupBox.CMEnabledChanged(var Message: TMessage);
begin
  Invalidate;
  if HandleAllocated and not (csDesigning in ComponentState) then
    EnableWindow(Handle, Enabled);
end;

end.

　　　　　MyGroupBox.zip

　　　　　　コンポーネント一覧へ戻る