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

Тема в разделе "Delphi", создана пользователем WinHack, 24 ноя 2016.

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