StackOverflow2013

Note that there are some explanatory texts on larger screens.

plurals

PO
text
Body
copied!<p>You could use the <a href="http://docwiki.embarcadero.com/Libraries/XE4/en/Vcl.ButtonGroup.TButtonGroup" rel="nofollow noreferrer">TButtonGroup</a> component.</p> <p>Using VCL Styles is by far the easiest solution but as like you said, using styles in XE2 is quite uncomfortable, in my opinion this feature only really became viable in XE3.</p> <p>Per your request to use the default painting methods I'm submitting my solution, </p> <p>source code of the project available <a href="https://www.dropbox.com/s/9vedoahe6vixvuy/TButtonGroupPV.rar" rel="nofollow noreferrer">here</a>.</p> <p>This project requires an image, the image is zipped together with the project.</p> <p><em>Compiled and tested in XE4.</em></p> <p><img src="https://i.stack.imgur.com/MBp83.png" alt="Example of TButtonGroup with custom visual effects"> </p> <hr> <hr> <pre><code>type TButtonGroup = class(Vcl.ButtonGroup.TButtonGroup) protected procedure Paint; override; end; TForm1 = class(TForm) ButtonGroup1: TButtonGroup; Panel1: TPanel; procedure ButtonGroup1DrawButton(Sender: TObject; Index: Integer; Canvas: TCanvas; Rect: TRect; State: TButtonDrawState); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; MBitmap : TBitmap; implementation {$R *.dfm} procedure TButtonGroup.Paint; var R : TRect; begin inherited; R := GetClientRect; R.Top := Self.Items.Count * Self.ButtonHeight; {Remove the clBtnFace background default Painting} Self.Canvas.FillRect(R); end; procedure TForm1.ButtonGroup1DrawButton(Sender: TObject; Index: Integer; Canvas: TCanvas; Rect: TRect; State: TButtonDrawState); var TextLeft, TextTop: Integer; RectHeight: Integer; ImgTop: Integer; Text : String; TextOffset: Integer; ButtonItem: TGrpButtonItem; InsertIndication: TRect; DrawSkipLine : TRect; TextRect: TRect; OrgRect: TRect; begin //OrgRect := Rect; //icon Canvas.Font := TButtonGroup(Sender).Font; if bdsSelected in State then begin Canvas.CopyRect(Rect,MBitmap.Canvas, System.Classes.Rect(0, 0, MBitmap.Width, MBitmap.Height)); Canvas.Brush.Color := RGB(255,228,138); end else if bdsHot in State then begin Canvas.Brush.Color := RGB(194,221,244); Canvas.Font.Color := clBlack; end else Canvas.Brush.color := clWhite; if not (bdsSelected in State) then Canvas.FillRect(Rect); InflateRect(Rect, -2, -1); { Compute the text location } TextLeft := Rect.Left + 4; RectHeight := Rect.Bottom - Rect.Top; TextTop := Rect.Top + (RectHeight - Canvas.TextHeight('Wg')) div 2; { Do not localize } if TextTop < Rect.Top then TextTop := Rect.Top; if bdsDown in State then begin Inc(TextTop); Inc(TextLeft); end; ButtonItem := TButtonGroup(Sender).Items.Items[Index]; TextOffset := 0; { Draw the icon - if you need to display icons} // if (FImages <> nil) and (ButtonItem.ImageIndex > -1) and // (ButtonItem.ImageIndex < FImages.Count) then // begin // ImgTop := Rect.Top + (RectHeight - FImages.Height) div 2; // if ImgTop < Rect.Top then // ImgTop := Rect.Top; // if bdsDown in State then // Inc(ImgTop); // FImages.Draw(Canvas, TextLeft - 1, ImgTop, ButtonItem.ImageIndex); // TextOffset := FImages.Width + 1; // end; { Show insert indications } if [bdsInsertLeft, bdsInsertTop, bdsInsertRight, bdsInsertBottom] * State <> [] then begin Canvas.Brush.Color := clSkyBlue; InsertIndication := Rect; if bdsInsertLeft in State then begin Dec(InsertIndication.Left, 2); InsertIndication.Right := InsertIndication.Left + 2; end else if bdsInsertTop in State then begin Dec(InsertIndication.Top); InsertIndication.Bottom := InsertIndication.Top + 2; end else if bdsInsertRight in State then begin Inc(InsertIndication.Right, 2); InsertIndication.Left := InsertIndication.Right - 2; end else if bdsInsertBottom in State then begin Inc(InsertIndication.Bottom); InsertIndication.Top := InsertIndication.Bottom - 2; end; Canvas.FillRect(InsertIndication); //Canvas.Brush.Color := FillColor; end; if gboShowCaptions in TButtonGroup(Sender).ButtonOptions then begin { Avoid clipping the image } Inc(TextLeft, TextOffset); TextRect.Left := TextLeft; TextRect.Right := Rect.Right - 1; TextRect.Top := TextTop; TextRect.Bottom := Rect.Bottom -1; Text := ButtonItem.Caption; Canvas.TextRect(TextRect, Text, [tfEndEllipsis]); end; end; procedure TForm1.FormCreate(Sender: TObject); begin MBitmap := TBitmap.Create; try MBitmap.LoadFromFile('bg.bmp'); except on E : Exception do ShowMessage(E.ClassName+' error raised, with message : '+E.Message); end; end; procedure TForm1.FormDestroy(Sender: TObject); begin MBitmap.Free; end; </code></pre> <p>DFM :</p> <pre><code>object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 398 ClientWidth = 287 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False Position = poScreenCenter StyleElements = [] OnCreate = FormCreate OnDestroy = FormDestroy PixelsPerInch = 96 TextHeight = 13 object Panel1: TPanel AlignWithMargins = True Left = 5 Top = 5 Width = 137 Height = 388 Margins.Left = 5 Margins.Top = 5 Margins.Right = 5 Margins.Bottom = 5 Align = alLeft BevelKind = bkFlat BevelOuter = bvNone Color = clWhite ParentBackground = False TabOrder = 0 StyleElements = [seFont] object ButtonGroup1: TButtonGroup AlignWithMargins = True Left = 4 Top = 4 Width = 125 Height = 378 Margins.Left = 4 Margins.Top = 4 Margins.Right = 4 Margins.Bottom = 2 Align = alClient BevelInner = bvNone BevelOuter = bvNone BorderStyle = bsNone ButtonOptions = [gboFullSize, gboGroupStyle, gboShowCaptions] DoubleBuffered = True Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Segoe UI' Font.Style = [] Items = < item Caption = 'General' end item Caption = 'Display' end item Caption = 'Proofing' end item Caption = 'Save' end item Caption = 'Language' end item Caption = 'Advanced' end> ParentDoubleBuffered = False TabOrder = 0 OnDrawButton = ButtonGroup1DrawButton end end end </code></pre> <p>There is a Panel container in there hosting the TButtonGroup, it is not needed, simply added for visual improvement.</p> <p>If you want to change the color of the selection at runtime then I suggest using <a href="http://www.efg2.com/Lab/Library/Delphi/Graphics/ChangeHueSaturation.ZIP" rel="nofollow noreferrer">efg's Hue/Saturation method</a> to change the Hue of the image, that way the color panel remains but the color will change.</p> <p>To gain support for VCL Styles simply detach the ButtonGroup1DrawButton Event from the TButtonGroup component, that way the default DrawButton Event can kick in which adds support for that.</p>

Querying!

Guidance

An individual column

Larger individual text columns get their own page to allow for proper reading.

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload