Кто-нибудь знает, как сделать заголовок у 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;
Все, дерзайте!
Комментарии