Внешний вид сайта:

Как создать TCheckBox с прозрачным заголовком

Кто-нибудь знает, как сделать заголовок у TCheckBox прозрачным, как у TLabel? Чтобы сделать TCheckBox прозрачным, нужно включить константу WS_EX_TRANSPARENT в стиль окна и перерисовать заголовок на Ваш собственный.

Пример:

{ ... }
type
  TMyCheckBox = class(TCheckBox)
  protected
    procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure SetButtonStyle;
  end;

procedure TMyCheckBox.CNDrawItem(var Msg: TWMDrawItem);
var
  XCanvas: TCanvas;
  XCaptionRect, XGlyphRect: TRect;

  procedure xxDrawBitMap(ACanvas: TCanvas);
  const
    xx_h = 13;
    xx_w = 13;
  var
    xxGlyph: TBitmap;
    xxX, xxY, xxStepY, xxStepX: integer;
  begin
    xxGlyph := TBitmap.Create;
    try
      xxGlyph.Handle := LoadBitmap(0, PChar(OBM_CHECKBOXES));
      xxY := XGlyphRect.Top +
        (XGlyphRect.Bottom - XGlyphRect.Top - xx_h) div 2;
      xxX := 2;
      xxStepX := 0;
      xxStepY := 0;
      case State of
        cbChecked: xxStepX := xxStepX + xx_w;
        cbGrayed:  xxStepX := xxStepX + xx_w * 3;
        end;
      ACanvas.CopyRect(
        Rect(xxX, xxY, xxX + xx_w,  xxY + xx_h),
        xxGlyph.Canvas,
        Rect(xxStepX, xxStepY, xx_w + xxStepX, xx_h + xxStepY)
      );
    finally
      xxGlyph.Free;
    end;
  end;

  procedure xxDrawCaption;
  var
    xXFormat: longint;
  begin
    xXFormat := DT_VCENTER + DT_SINGLELINE + DT_LEFT;
    xXFormat := DrawTextBiDiModeFlags(xXFormat);
    DrawText(
      Msg.DrawItemStruct.hDC,
      PChar(Caption),
      Length(Caption),
      XCaptionRect,
      xXFormat
    );
  end;

begin
  XGlyphRect := Msg.DrawItemStruct.rcItem;
  XGlyphRect.Right := 20;
  XCaptionRect := Msg.DrawItemStruct.rcItem;
  XCaptionRect.Left := XGlyphRect.Right;
  XCanvas := TCanvas.Create;
  try
    XCanvas.Handle := Msg.DrawItemStruct.hDC;
    XCanvas.Brush.Style := bsClear;
    xxDrawBitMap(XCanvas);
    xxDrawCaption;
  finally
    XCanvas.Free;
  end;
end;

procedure TMyCheckBox.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.ExStyle := Params.ExStyle or WS_EX_Transparent;
end;

procedure TMyCheckBox.CreateWnd;
begin
  inherited CreateWnd;
  SetButtonStyle;
end;

procedure TMyCheckBox.SetButtonStyle;
const
  BS_MASK = $000F;
var
  Style: Word;
begin
  if HandleAllocated then
  begin
    Style := BS_CHECKBOX or BS_OWNERDRAW;
    if GetWindowLong(Handle, GWL_STYLE) and BS_MASK <> Style then
      SendMessage(Handle, BM_SETSTYLE, Style, 1);
  end;
end;

Все, дерзайте!

Комментарии

Нет комментариев. Ваш будет первым!