How to create a TCheckBox with a transparent caption

Mirror

How to create a TCheckBox with a transparent caption (Views: 34)

Problem/Question/Abstract:

Does anyone know how to make the label on a TCheckbox transparent. Just like TLabel?

Answer:

In order to make a check box transparent, you should include the WS_EX_Transparent constant to the extended window style and try to draw caption on your own. Example:

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

procedure TMyCheckBox.CNDrawItem(var Message: 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(Message.DrawItemStruct.hDC, PChar(Caption), length(Caption),
      XCaptionRect, xXFormat);
  end;

begin
  XGlyphRect := Message.DrawItemStruct.rcItem;
  XGlyphRect.Right := 20;
  XCaptionRect := Message.DrawItemStruct.rcItem;
  XCaptionRect.Left := XGlyphRect.Right;
  XCanvas := TCanvas.Create;
  try
    XCanvas.Handle := Message.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;

<< Back to main page