Author: Tomas Rutkauskas
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:
1 { ... }
2 type
3 TMyCheckBox = class(TCheckBox)
4 protected
5 procedure CNDrawItem(var message: TWMDrawItem); message CN_DRAWITEM;
6 procedure CreateParams(var Params: TCreateParams); override;
7 procedure CreateWnd; override;
8 procedure SetButtonStyle;
9 end;
10
11 procedure TMyCheckBox.CNDrawItem(var message: TWMDrawItem);
12 var
13 XCanvas: TCanvas;
14 XCaptionRect, XGlyphRect: TRect;
15
16 procedure xxDrawBitMap(ACanvas: TCanvas);
17 const
18 xx_h = 13;
19 xx_w = 13;
20 var
21 xxGlyph: TBitmap;
22 xxX, xxY, xxStepY, xxStepX: integer;
23 begin
24 xxGlyph := TBitmap.Create;
25 try
26 xxGlyph.Handle := LoadBitmap(0, PChar(OBM_CHECKBOXES));
27 xxY := XGlyphRect.Top + (XGlyphRect.Bottom - XGlyphRect.Top - xx_h) div 2;
28 xxX := 2;
29 xxStepX := 0;
30 xxStepY := 0;
31 case State of
32 cbChecked: xxStepX := xxStepX + xx_w;
33 cbGrayed: xxStepX := xxStepX + xx_w * 3;
34 end;
35 ACanvas.CopyRect(Rect(xxX, xxY, xxX + xx_w, xxY + xx_h), xxGlyph.Canvas,
36 Rect(xxStepX, xxStepY, xx_w + xxStepX, xx_h + xxStepY));
37 finally
38 xxGlyph.Free;
39 end;
40 end;
41
42 procedure xxDrawCaption;
43 var
44 xXFormat: longint;
45 begin
46 xXFormat := DT_VCENTER + DT_SINGLELINE + DT_LEFT;
47 xXFormat := DrawTextBiDiModeFlags(xXFormat);
48 DrawText(message.DrawItemStruct.hDC, PChar(Caption), length(Caption),
49 XCaptionRect, xXFormat);
50 end;
51
52 begin
53 XGlyphRect := message.DrawItemStruct.rcItem;
54 XGlyphRect.Right := 20;
55 XCaptionRect := message.DrawItemStruct.rcItem;
56 XCaptionRect.Left := XGlyphRect.Right;
57 XCanvas := TCanvas.Create;
58 try
59 XCanvas.Handle := message.DrawItemStruct.hDC;
60 XCanvas.Brush.Style := bsClear;
61 xxDrawBitMap(XCanvas);
62 xxDrawCaption;
63 finally
64 XCanvas.Free;
65 end;
66 end;
67
68 procedure TMyCheckBox.CreateParams(var Params: TCreateParams);
69 begin
70 inherited CreateParams(Params);
71 Params.ExStyle := Params.ExStyle or WS_EX_Transparent;
72 end;
73
74 procedure TMyCheckBox.CreateWnd;
75 begin
76 inherited CreateWnd;
77 SetButtonStyle;
78 end;
79
80 procedure TMyCheckBox.SetButtonStyle;
81 const
82 BS_MASK = $000F;
83 var
84 Style: Word;
85 begin
86 if HandleAllocated then
87 begin
88 Style := BS_CHECKBOX or BS_OWNERDRAW;
89 if GetWindowLong(Handle, GWL_STYLE) and BS_MASK <> Style then
90 SendMessage(Handle, BM_SETSTYLE, Style, 1);
91 end;
92 end;
|
