// SPDX-License-Identifier: LGPL-3.0-linking-exception {******************************* CONTRIBUTOR(S) ****************************** - Edivando S. Santos Brasil | mailedivando@gmail.com (Compatibility with delphi VCL 11/2018) ***************************** END CONTRIBUTOR(S) *****************************} unit BGRACustomDrawn; {$I bgracontrols.inc} interface uses Classes, Types, FPCanvas, Graphics, Controls, Math, LazUTF8, Forms, ExtCtrls, {$IFNDEF FPC}BGRAGraphics, GraphType, FPImage, {$ENDIF} BCThemeManager, { CustomDrawn } CustomDrawnControls, CustomDrawnDrawers, CustomDrawn_Common, { BGRABitmap } BGRABitmap, BGRABitmapTypes, BGRAGradients; type { TBCDButton } TBCDButton = class(TCDButton) private FBCThemeManager: TBCThemeManager; procedure SetFBCThemeManager(AValue: TBCThemeManager); published property ThemeManager: TBCThemeManager read FBCThemeManager write SetFBCThemeManager; end; { TBCDEdit } TBCDEdit = class(TCDEdit) private FBCThemeManager: TBCThemeManager; procedure SetFBCThemeManager(AValue: TBCThemeManager); published property ThemeManager: TBCThemeManager read FBCThemeManager write SetFBCThemeManager; end; { TBCDStaticText } TBCDStaticText = class(TCDStaticText) private FBCThemeManager: TBCThemeManager; procedure SetFBCThemeManager(AValue: TBCThemeManager); published property ThemeManager: TBCThemeManager read FBCThemeManager write SetFBCThemeManager; end; { TBCDProgressBar } TBCDProgressBar = class(TCDProgressBar) private FBCThemeManager: TBCThemeManager; procedure SetFBCThemeManager(AValue: TBCThemeManager); public constructor Create(AOwner: TComponent); override; published property ThemeManager: TBCThemeManager read FBCThemeManager write SetFBCThemeManager; end; { TBCDSpinEdit } TBCDSpinEdit = class(TCDSpinEdit) private FBCThemeManager: TBCThemeManager; procedure SetFBCThemeManager(AValue: TBCThemeManager); published property ThemeManager: TBCThemeManager read FBCThemeManager write SetFBCThemeManager; end; { TBCDCheckBox } TBCDCheckBox = class(TCDCheckBox) private FBCThemeManager: TBCThemeManager; procedure SetFBCThemeManager(AValue: TBCThemeManager); published property ThemeManager: TBCThemeManager read FBCThemeManager write SetFBCThemeManager; end; { TBCDRadioButton } TBCDRadioButton = class(TCDRadioButton) private FBCThemeManager: TBCThemeManager; procedure SetFBCThemeManager(AValue: TBCThemeManager); published property ThemeManager: TBCThemeManager read FBCThemeManager write SetFBCThemeManager; end; { TBCDPanel } TBCDPanel = class(TPanel) private FBCThemeManager: TBCThemeManager; FDarkTheme: boolean; procedure SetFBCThemeManager(AValue: TBCThemeManager); procedure SetFDarkTheme(AValue: boolean); protected procedure Paint; override; public constructor Create(TheOwner: TComponent); override; published property DarkTheme: boolean read FDarkTheme write SetFDarkTheme default True; published property Align; property Alignment; property Anchors; property AutoSize; property BorderSpacing; property BevelInner; property BevelOuter; property BevelWidth; property BidiMode; property BorderWidth; property BorderStyle; property Caption; property ChildSizing; property ClientHeight; property ClientWidth; property Color; property Constraints; property DockSite; property DragCursor; property DragKind; property DragMode; property Enabled; property Font; property FullRepaint; property ParentBidiMode; property ParentColor; property ParentFont; property ParentShowHint; property PopupMenu; property ShowHint; property TabOrder; property TabStop; property UseDockManager default True; property Visible; property OnClick; property OnContextPopup; property OnDockDrop; property OnDockOver; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEndDock; property OnEndDrag; property OnEnter; property OnExit; property OnGetSiteInfo; property OnGetDockCaption; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; property OnMouseWheel; property OnMouseWheelDown; property OnMouseWheelUp; property OnPaint; property OnResize; property OnStartDock; property OnStartDrag; property OnUnDock; published property ThemeManager: TBCThemeManager read FBCThemeManager write SetFBCThemeManager; end; { TBGRADrawer } TBGRADrawer = class(TCDDrawerCommon) private FRandSeed: integer; protected procedure AssignFont(Bitmap: TBGRABitmap; Font: TFont); public constructor Create; override; { General } function GetMeasures(AMeasureID: integer): integer; override; procedure DrawTickmark(ADest: TFPCustomCanvas; ADestPos: TPoint; AState: TCDControlState); override; function DPIAdjustment(const AValue: integer): integer; { Button } procedure DrawButton(ADest: TFPCustomCanvas; ADestPos: TPoint; ASize: TSize; AState: TCDControlState; AStateEx: TCDButtonStateEx); override; { Edit } procedure DrawEditBackground(ADest: TCanvas; ADestPos: TPoint; ASize: TSize; AState: TCDControlState; {%H-}AStateEx: TCDEditStateEx); override; procedure DrawEditFrame(ADest: TCanvas; ADestPos: TPoint; ASize: TSize; AState: TCDControlState; {%H-}AStateEx: TCDEditStateEx); override; procedure DrawCaret(ADest: TCanvas; ADestPos: TPoint; ASize: TSize; AState: TCDControlState; AStateEx: TCDEditStateEx); override; procedure DrawEdit(ADest: TCanvas; ASize: TSize; AState: TCDControlState; AStateEx: TCDEditStateEx); override; { Panel } procedure DrawPanel(ADest: TCanvas; ASize: TSize; {%H-}AState: TCDControlState; {%H-}AStateEx: TCDPanelStateEx); override; { Static Text } procedure DrawStaticText(ADest: TCanvas; ASize: TSize; AState: TCDControlState; AStateEx: TCDControlStateEx); override; { Progress Bar } procedure DrawProgressBar(ADest: TCanvas; ASize: TSize; {%H-}AState: TCDControlState; AStateEx: TCDProgressBarStateEx); override; { CheckBox } procedure DrawCheckBoxSquare(ADest: TCanvas; ADestPos: TPoint; ASize: TSize; AState: TCDControlState; {%H-}AStateEx: TCDControlStateEx); override; procedure DrawCheckBox(ADest: TCanvas; ASize: TSize; AState: TCDControlState; AStateEx: TCDControlStateEx); override; { RadioButton } procedure DrawRadioButtonCircle(ADest: TCanvas; {%H-}ADestPos: TPoint; {%H-}ASize: TSize; AState: TCDControlState; {%H-}AStateEx: TCDControlStateEx); override; procedure DrawRadioButton(ADest: TCanvas; ASize: TSize; AState: TCDControlState; AStateEx: TCDControlStateEx); override; end; {$IFDEF FPC}procedure Register;{$ENDIF} implementation {$IFDEF FPC}procedure Register; begin RegisterComponents('BGRA Custom Drawn', [TBCDButton, TBCDEdit, TBCDStaticText, TBCDProgressBar, TBCDSpinEdit, TBCDCheckBox, TBCDRadioButton, TBCDPanel]); end; {$ENDIF} { TBCDRadioButton } procedure TBCDRadioButton.SetFBCThemeManager(AValue: TBCThemeManager); begin if FBCThemeManager = AValue then Exit; FBCThemeManager := AValue; end; { TBCDCheckBox } procedure TBCDCheckBox.SetFBCThemeManager(AValue: TBCThemeManager); begin if FBCThemeManager = AValue then Exit; FBCThemeManager := AValue; end; { TBCDSpinEdit } procedure TBCDSpinEdit.SetFBCThemeManager(AValue: TBCThemeManager); begin if FBCThemeManager = AValue then Exit; FBCThemeManager := AValue; end; { TBCDStaticText } procedure TBCDStaticText.SetFBCThemeManager(AValue: TBCThemeManager); begin if FBCThemeManager = AValue then Exit; FBCThemeManager := AValue; end; { TBCDEdit } procedure TBCDEdit.SetFBCThemeManager(AValue: TBCThemeManager); begin if FBCThemeManager = AValue then Exit; FBCThemeManager := AValue; end; { TBCDButton } procedure TBCDButton.SetFBCThemeManager(AValue: TBCThemeManager); begin if FBCThemeManager = AValue then Exit; FBCThemeManager := AValue; end; { TBCDPanel } procedure TBCDPanel.SetFDarkTheme(AValue: boolean); begin if FDarkTheme = AValue then Exit; FDarkTheme := AValue; Invalidate; end; procedure TBCDPanel.SetFBCThemeManager(AValue: TBCThemeManager); begin if FBCThemeManager = AValue then Exit; FBCThemeManager := AValue; end; procedure TBCDPanel.Paint; begin if DarkTheme then begin if BevelOuter <> bvNone then begin Canvas.Pen.Color := RGBToColor(40, 40, 40); Canvas.Brush.Color := RGBToColor(83, 83, 83); Canvas.Rectangle(0, 0, Width, Height); Canvas.Pen.Color := RGBToColor(106, 106, 106); Canvas.Line(1, 1, Width - 1, 1); end else begin Canvas.Pen.Color := RGBToColor(83, 83, 83); Canvas.Brush.Color := RGBToColor(83, 83, 83); Canvas.Rectangle(0, 0, Width, Height); end; end else inherited Paint; end; constructor TBCDPanel.Create(TheOwner: TComponent); begin inherited Create(TheOwner); FDarkTheme := True; end; { TBCDProgressBar } procedure TBCDProgressBar.SetFBCThemeManager(AValue: TBCThemeManager); begin if FBCThemeManager = AValue then Exit; FBCThemeManager := AValue; end; constructor TBCDProgressBar.Create(AOwner: TComponent); begin inherited Create(AOwner); Color := BGRA(102, 163, 226); end; { TBGRADrawer } procedure TBGRADrawer.AssignFont(Bitmap: TBGRABitmap; Font: TFont); begin Bitmap.FontName := Font.Name; Bitmap.FontStyle := Font.Style; Bitmap.FontHeight := Font.Height; Bitmap.FontQuality := fqSystemClearType; end; constructor TBGRADrawer.Create; begin inherited Create; randomize; FRandSeed := randseed; end; function TBGRADrawer.GetMeasures(AMeasureID: integer): integer; begin case AMeasureID of TCDEDIT_LEFT_TEXT_SPACING: Result := 6; TCDEDIT_RIGHT_TEXT_SPACING: Result := 3; TCDEDIT_TOP_TEXT_SPACING: Result := 3; TCDEDIT_BOTTOM_TEXT_SPACING: Result := 3; TCDCHECKBOX_SQUARE_HALF_HEIGHT: Result := Floor(GetMeasures(TCDCHECKBOX_SQUARE_HEIGHT) / 2); TCDCHECKBOX_SQUARE_HEIGHT: Result := DPIAdjustment(13); TCDCOMBOBOX_DEFAULT_HEIGHT: Result := 21; TCDRADIOBUTTON_CIRCLE_HEIGHT: Result := DPIAdjustment(13); TCDSCROLLBAR_BUTTON_WIDTH: Result := 17; TCDSCROLLBAR_LEFT_SPACING: Result := 17; TCDSCROLLBAR_RIGHT_SPACING: Result := 17; TCDSCROLLBAR_LEFT_BUTTON_POS: Result := 0; TCDSCROLLBAR_RIGHT_BUTTON_POS: Result := -17; TCDTRACKBAR_LEFT_SPACING: Result := 9; TCDTRACKBAR_RIGHT_SPACING: Result := 9; TCDTRACKBAR_TOP_SPACING: Result := 5; TCDTRACKBAR_FRAME_HEIGHT: Result := DPIAdjustment(17); TCDLISTVIEW_COLUMN_LEFT_SPACING: Result := 10; TCDLISTVIEW_COLUMN_RIGHT_SPACING: Result := 10; TCDLISTVIEW_COLUMN_TEXT_LEFT_SPACING: Result := 5; TCDLISTVIEW_LINE_TOP_SPACING: Result := 3; TCDLISTVIEW_LINE_BOTTOM_SPACING: Result := 3; TCDTOOLBAR_ITEM_SPACING: Result := 2; TCDTOOLBAR_ITEM_ARROW_WIDTH: Result := 7; TCDTOOLBAR_ITEM_BUTTON_DEFAULT_WIDTH: Result := 23; TCDTOOLBAR_ITEM_ARROW_RESERVED_WIDTH: Result := 35 - 23; TCDTOOLBAR_ITEM_SEPARATOR_DEFAULT_WIDTH: Result := 8; TCDTOOLBAR_DEFAULT_HEIGHT: Result := 26; TCDCTABCONTROL_CLOSE_TAB_BUTTON_WIDTH: Result := 10; TCDCTABCONTROL_CLOSE_TAB_BUTTON_EXTRA_SPACING: Result := 10; else Result := 0; end; ; end; procedure TBGRADrawer.DrawTickmark(ADest: TFPCustomCanvas; ADestPos: TPoint; AState: TCDControlState); var i: integer; lSpacing5, lFirstLinesEnd, lSecondLinesEnd: integer; begin if csfPartiallyOn in AState then ADest.Pen.FPColor := TColorToFPColor($00AAAAAA) else ADest.Pen.FPColor := TColorToFPColor($00E5E5E5); ADest.Pen.Style := psSolid; if Screen.PixelsPerInch <= 125 then begin // 4 lines going down and to the right for i := 0 to 3 do ADest.Line(ADestPos.X + 1 + i, ADestPos.Y + 2 + i, ADestPos.X + 1 + i, ADestPos.Y + 5 + i); // Now 5 lines going up and to the right for i := 4 to 8 do ADest.Line(ADestPos.X + 1 + i, ADestPos.Y + 2 + 6 - i, ADestPos.X + 1 + i, ADestPos.Y + 5 + 6 - i); Exit; end; lSpacing5 := DPIAdjustment(5); lFirstLinesEnd := DPIAdjustment(4) - 1; lSecondLinesEnd := DPIAdjustment(9) - 1; // 4 lines going down and to the right for i := 0 to lFirstLinesEnd do ADest.Line(ADestPos.X + 2 + i, ADestPos.Y + 2 + i, ADestPos.X + 2 + i, ADestPos.Y + lSpacing5 + i); // Now 5 lines going up and to the right for i := lFirstLinesEnd + 1 to lSecondLinesEnd do ADest.Line(ADestPos.X + 2 + i, ADestPos.Y + 2 + lFirstLinesEnd * 2 - i, ADestPos.X + 2 + i, ADestPos.Y + 2 + lFirstLinesEnd * 2 + lSpacing5 - i); end; function TBGRADrawer.DPIAdjustment(const AValue: integer): integer; begin { Adjustment that works under Windows } Result := ScaleY(AValue, 96); end; procedure TBGRADrawer.DrawButton(ADest: TFPCustomCanvas; ADestPos: TPoint; ASize: TSize; AState: TCDControlState; AStateEx: TCDButtonStateEx); var Bitmap: TBGRABitmap; ts: TSize; begin Bitmap := TBGRABitmap.Create(ASize.cx, ASize.cy); if csfEnabled in AState then begin if csfSunken in AState then begin { Button Down } Bitmap.Rectangle(0, 0, ASize.cx, ASize.cy - 1, BGRA(48, 48, 48), BGRA(61, 61, 61), dmSet); Bitmap.Rectangle(1, 1, ASize.cx - 1, ASize.cy - 2, BGRA(55, 55, 55), BGRA(61, 61, 61), dmSet); Bitmap.SetHorizLine(0, ASize.cy - 1, ASize.cx - 1, BGRA(115, 115, 115)); end else begin if csfMouseOver in AState then begin { Button Hovered } Bitmap.GradientFill(0, 0, ASize.cx, ASize.cy, BGRA(132, 132, 132), BGRA(109, 109, 109), gtLinear, PointF(0, 0), PointF(0, ASize.cy), dmSet); Bitmap.Rectangle(0, 0, ASize.cx, ASize.cy - 1, BGRA(48, 48, 48), dmSet); Bitmap.SetHorizLine(1, 1, ASize.cx - 2, BGRA(160, 160, 160)); Bitmap.SetHorizLine(0, ASize.cy - 1, ASize.cx - 1, BGRA(115, 115, 115)); end else begin { Button Normal } Bitmap.GradientFill(0, 0, ASize.cx, ASize.cy, BGRA(107, 107, 107), BGRA(84, 84, 84), gtLinear, PointF(0, 0), PointF(0, ASize.cy), dmSet); Bitmap.Rectangle(0, 0, ASize.cx, ASize.cy - 1, BGRA(48, 48, 48), dmSet); Bitmap.SetHorizLine(1, 1, ASize.cx - 2, BGRA(130, 130, 130)); Bitmap.SetHorizLine(0, ASize.cy - 1, ASize.cx - 1, BGRA(115, 115, 115)); { Button Focused } if csfHasFocus in AState then Bitmap.Rectangle(1, 2, ASize.cx - 1, ASize.cy - 2, BGRA(80, 111, 172), dmSet); end; end; end else begin { Button Disabled } Bitmap.Rectangle(0, 0, ASize.cx, ASize.cy - 1, BGRA(66, 66, 66), BGRA(71, 71, 71), dmSet); Bitmap.SetHorizLine(0, ASize.cy - 1, ASize.cx - 1, BGRA(94, 94, 94)); end; AssignFont(Bitmap, AStateEx.Font); ts := Bitmap.TextSize(AStateEx.Caption); if csfEnabled in AState then begin { Text Enabled } Bitmap.TextOut((ASize.cx - ts.cx) div 2, ((ASize.cy - ts.cy) div 2) - 1, AStateEx.Caption, BGRA(47, 47, 47)); Bitmap.TextOut((ASize.cx - ts.cx) div 2, (ASize.cy - ts.cy) div 2, AStateEx.Caption, BGRA(229, 229, 229)); end else { Text Disabled } Bitmap.TextOut((ASize.cx - ts.cx) div 2, (ASize.cy - ts.cy) div 2, AStateEx.Caption, BGRA(170, 170, 170)); Bitmap.Draw(TCanvas(ADest), ADestPos.x, ADestPos.y, True); Bitmap.Free; end; procedure TBGRADrawer.DrawEditBackground(ADest: TCanvas; ADestPos: TPoint; ASize: TSize; AState: TCDControlState; AStateEx: TCDEditStateEx); var Bitmap: TBGRABitmap; begin Bitmap := TBGRABitmap.Create(ASize.cx, ASize.cy); if csfEnabled in AState then if csfHasFocus in AState then { Focused } Bitmap.Fill(BGRAWhite) else { Normal } Bitmap.Rectangle(1, 1, ASize.cx - 1, ASize.cy - 1, BGRA(41, 41, 41), BGRA(58, 58, 58), dmSet) else { Disabled } Bitmap.Rectangle(1, 1, ASize.cx - 1, ASize.cy - 1, BGRA(66, 66, 66), BGRA(71, 71, 71), dmSet); Bitmap.Draw(TCanvas(ADest), ADestPos.x, ADestPos.y, True); Bitmap.Free; end; procedure TBGRADrawer.DrawEditFrame(ADest: TCanvas; ADestPos: TPoint; ASize: TSize; AState: TCDControlState; AStateEx: TCDEditStateEx); var Bitmap: TBGRABitmap; begin Bitmap := TBGRABitmap.Create(ASize.cx, ASize.cy); if csfEnabled in AState then begin if csfHasFocus in AState then begin { Focused } Bitmap.Rectangle(0, 0, ASize.cx, ASize.cy, BGRA(80, 111, 172), dmSet); Bitmap.Rectangle(1, 1, ASize.cx - 1, ASize.cy - 1, BGRA(41, 41, 41), dmSet); end else begin { Normal } Bitmap.Rectangle(0, 0, ASize.cx, ASize.cy, BGRA(83, 83, 83), dmSet); Bitmap.Rectangle(1, 1, ASize.cx - 1, ASize.cy - 1, BGRA(41, 41, 41), dmSet); Bitmap.SetHorizLine(1, ASize.cy - 1, ASize.cx - 2, BGRA(105, 105, 105)); end; end else begin { Disabled } Bitmap.Rectangle(0, 0, ASize.cx, ASize.cy, BGRA(83, 83, 83), dmSet); Bitmap.Rectangle(1, 1, ASize.cx - 1, ASize.cy - 1, BGRA(66, 66, 66), dmSet); Bitmap.SetHorizLine(1, ASize.cy - 1, ASize.cx - 2, BGRA(94, 94, 94)); end; Bitmap.Draw(TCanvas(ADest), ADestPos.x, ADestPos.y, False); Bitmap.Free; end; procedure TBGRADrawer.DrawCaret(ADest: TCanvas; ADestPos: TPoint; ASize: TSize; AState: TCDControlState; AStateEx: TCDEditStateEx); begin inherited DrawCaret(ADest, ADestPos, ASize, AState, AStateEx); end; procedure TBGRADrawer.DrawEdit(ADest: TCanvas; ASize: TSize; AState: TCDControlState; AStateEx: TCDEditStateEx); var lVisibleText, lControlText: TCaption; lSelLeftPos, lSelLeftPixelPos, lSelLength, lSelRightPos: integer; lTextWidth, lLineHeight, lLineTop: integer; lControlTextLen: PtrInt; lTextLeftSpacing, lTextTopSpacing, lTextBottomSpacing: integer; lTextColor: TColor; i, lVisibleLinesCount: integer; begin // Background DrawEditBackground(ADest, Point(0, 0), ASize, AState, AStateEx); // General text configurations which apply to all lines // Configure the text color if csfEnabled in AState then lTextColor := $00E5E5E5 else lTextColor := $00AAAAAA; if csfHasFocus in AState then lTextColor := clBlack; ADest.Brush.Style := bsClear; ADest.Font.Assign(AStateEx.Font); ADest.Font.Color := lTextColor; lTextLeftSpacing := GetMeasures(TCDEDIT_LEFT_TEXT_SPACING); //lTextRightSpacing := GetMeasures(TCDEDIT_RIGHT_TEXT_SPACING); lTextTopSpacing := GetMeasures(TCDEDIT_TOP_TEXT_SPACING); lTextBottomSpacing := GetMeasures(TCDEDIT_BOTTOM_TEXT_SPACING); lLineHeight := ADest.TextHeight(cddTestStr) + 2; lLineHeight := Min(ASize.cy - lTextBottomSpacing, lLineHeight); // Fill this to be used in other parts AStateEx.LineHeight := lLineHeight; AStateEx.FullyVisibleLinesCount := ASize.cy - lTextTopSpacing - lTextBottomSpacing; AStateEx.FullyVisibleLinesCount := AStateEx.FullyVisibleLinesCount div lLineHeight; AStateEx.FullyVisibleLinesCount := Min(AStateEx.FullyVisibleLinesCount, AStateEx.Lines.Count); // Calculate how many lines to draw if AStateEx.Multiline then lVisibleLinesCount := AStateEx.FullyVisibleLinesCount + 1 else lVisibleLinesCount := 1; lVisibleLinesCount := Min(lVisibleLinesCount, AStateEx.Lines.Count); // Now draw each line for i := 0 to lVisibleLinesCount - 1 do begin lControlText := AStateEx.Lines.Strings[AStateEx.VisibleTextStart.Y + i]; lControlText := VisibleText(lControlText, AStateEx.PasswordChar); lControlTextLen := UTF8Length(lControlText); lLineTop := lTextTopSpacing + i * lLineHeight; // The text ADest.Pen.Style := psClear; ADest.Brush.Style := bsClear; // ToDo: Implement multi-line selection if (AStateEx.SelLength = 0) or (AStateEx.SelStart.Y <> AStateEx.VisibleTextStart.Y + i) then begin lVisibleText := UTF8Copy(lControlText, AStateEx.VisibleTextStart.X, lControlTextLen); ADest.TextOut(lTextLeftSpacing, lLineTop, lVisibleText); end // Text and Selection else begin lSelLeftPos := AStateEx.SelStart.X; if AStateEx.SelLength < 0 then lSelLeftPos := lSelLeftPos + AStateEx.SelLength; lSelRightPos := AStateEx.SelStart.X; if AStateEx.SelLength > 0 then lSelRightPos := lSelRightPos + AStateEx.SelLength; lSelLength := AStateEx.SelLength; if lSelLength < 0 then lSelLength := lSelLength * -1; // Text left of the selection lVisibleText := UTF8Copy(lControlText, AStateEx.VisibleTextStart.X, lSelLeftPos - AStateEx.VisibleTextStart.X + 1); ADest.TextOut(lTextLeftSpacing, lLineTop, lVisibleText); lSelLeftPixelPos := ADest.TextWidth(lVisibleText) + lTextLeftSpacing; // The selection background lVisibleText := UTF8Copy(lControlText, lSelLeftPos + 1, lSelLength); lTextWidth := ADest.TextWidth(lVisibleText); ADest.Brush.Color := $00C3C3C3; ADest.Brush.Style := bsSolid; ADest.Rectangle(Bounds(lSelLeftPixelPos, lLineTop, lTextWidth, lLineHeight)); ADest.Brush.Style := bsClear; // The selection text ADest.Font.Color := clWhite; ADest.TextOut(lSelLeftPixelPos, lLineTop, lVisibleText); lSelLeftPixelPos := lSelLeftPixelPos + lTextWidth; // Text right of the selection ADest.Brush.Color := clWhite; ADest.Font.Color := lTextColor; lVisibleText := UTF8Copy(lControlText, lSelLeftPos + lSelLength + 1, lControlTextLen); ADest.TextOut(lSelLeftPixelPos, lLineTop, lVisibleText); end; end; // And the caret DrawCaret(ADest, Point(0, 0), ASize, AState, AStateEx); // In the end the frame, because it must be on top of everything DrawEditFrame(ADest, Point(0, 0), ASize, AState, AStateEx); end; procedure TBGRADrawer.DrawPanel(ADest: TCanvas; ASize: TSize; AState: TCDControlState; AStateEx: TCDPanelStateEx); var Bitmap: TBGRABitmap; begin Bitmap := TBGRABitmap.Create(ASize.cx, ASize.cy); Bitmap.Rectangle(0, 0, ASize.cx, ASize.cy, BGRA(40, 40, 40), BGRA(83, 83, 83), dmSet); Bitmap.SetHorizLine(1, 1, ASize.cx - 2, BGRA(106, 106, 106)); Bitmap.Draw(TCanvas(ADest), ASize.cx, ASize.cy, True); Bitmap.Free; end; procedure TBGRADrawer.DrawStaticText(ADest: TCanvas; ASize: TSize; AState: TCDControlState; AStateEx: TCDControlStateEx); var lColor: TColor; begin // Background lColor := $00535353; //AStateEx.ParentRGBColor; ADest.Brush.Color := lColor; ADest.Brush.Style := bsSolid; ADest.Pen.Style := psClear; ADest.FillRect(0, 0, ASize.cx, ASize.cy); // Now the text ADest.Brush.Style := bsClear; ADest.Font.Assign(AStateEx.Font); if csfEnabled in AState then ADest.Font.Color := $00E5E5E5 else ADest.Font.Color := $00AAAAAA; ADest.TextOut(0, 0, AStateEx.Caption); end; procedure TBGRADrawer.DrawProgressBar(ADest: TCanvas; ASize: TSize; AState: TCDControlState; AStateEx: TCDProgressBarStateEx); function ApplyLightness(c: TBGRAPixel; lightness: word): TBGRAPixel; begin Result := GammaCompression(SetLightness(GammaExpansion(c), lightness)); end; procedure DrawBar(Bitmap: TBGRABitmap; bounds: TRect); var lCol: TBGRAPixel; begin lCol := AStateEx.RGBColor; DoubleGradientAlphaFill(Bitmap, bounds, ApplyLightness(lCol, 37000), ApplyLightness(lCol, 29000), ApplyLightness(lCol, 26000), ApplyLightness(lCol, 18000), gdVertical, gdVertical, gdVertical, 0.53); InflateRect(bounds, -1, -1); DoubleGradientAlphaFill(Bitmap, bounds, ApplyLightness(lCol, 28000), ApplyLightness(lCol, 22000), ApplyLightness(lCol, 19000), ApplyLightness(lCol, 11000), gdVertical, gdVertical, gdVertical, 0.53); end; var content: TRect; xpos, y, tx, ty: integer; grayValue: integer; Bitmap: TBGRABitmap; begin Bitmap := TBGRABitmap.Create(ASize.cx, ASize.cy); tx := ASize.cx; ty := ASize.cy; Bitmap.Fill(BGRA(83, 83, 83)); Bitmap.Rectangle(0, 0, tx, ty, BGRA(255, 255, 255, 6), dmDrawWithTransparency); if (tx > 2) and (ty > 2) then Bitmap.Rectangle(1, 1, tx - 1, ty - 1, BGRA(29, 29, 29), dmSet); if (tx > 4) and (ty > 4) then begin content := Rect(2, 2, tx - 2, ty - 2); randseed := FRandSeed; for y := content.Top to content.Bottom - 1 do begin if y = content.Top then grayValue := 33 else if y = content.Top + 1 then grayValue := 43 else grayValue := 47 + random(50 - 47 + 1); Bitmap.SetHorizLine(content.Left, y, content.Right - 1, BGRA( grayValue, grayValue, grayValue)); end; if tx >= 6 then Bitmap.DrawVertLine(content.Right - 1, content.Top, content.Bottom - 1, BGRA(0, 0, 0, 32)); xpos := round(AStateEx.PercentPosition * (content.right - content.left)) + content.left; if xpos > content.left then begin DrawBar(Bitmap, rect(content.left, content.top, xpos, content.bottom)); if xpos < content.right then begin Bitmap.SetPixel(xpos, content.top, BGRA(62, 62, 62)); Bitmap.SetVertLine(xpos, content.top + 1, content.bottom - 1, BGRA(40, 40, 40)); end; end; end; Bitmap.Draw(TCanvas(ADest), 0, 0, True); Bitmap.Free; end; procedure TBGRADrawer.DrawCheckBoxSquare(ADest: TCanvas; ADestPos: TPoint; ASize: TSize; AState: TCDControlState; AStateEx: TCDControlStateEx); var lHalf, lSquareHalf, lSquareHeight: integer; Bitmap: TBGRABitmap; r: TRect; begin Bitmap := TBGRABitmap.Create(ASize.cx, ASize.cy); lHalf := ASize.cy div 2; lSquareHalf := GetMeasures(TCDCHECKBOX_SQUARE_HALF_HEIGHT); lSquareHeight := GetMeasures(TCDCHECKBOX_SQUARE_HEIGHT); r := Bounds(1, lHalf - lSquareHalf, lSquareHeight, lSquareHeight); if csfEnabled in AState then begin if csfSunken in AState then begin { Down } Bitmap.Rectangle(r.Left, r.Top, r.Right, r.Bottom - 1, BGRA(48, 48, 48), BGRA(61, 61, 61), dmSet); Bitmap.Rectangle(r.Left + 1, r.Top + 1, r.Right - 1, r.Bottom - 2, BGRA(55, 55, 55), BGRA(61, 61, 61), dmSet); Bitmap.SetHorizLine(r.Left, r.Bottom - 1, r.Right - 1, BGRA(115, 115, 115)); end else begin if csfMouseOver in AState then begin { Hovered } Bitmap.GradientFill(r.Left, r.Top, r.Right, r.Bottom, BGRA(132, 132, 132), BGRA(109, 109, 109), gtLinear, PointF(0, 0), PointF(0, ASize.cy), dmSet); Bitmap.Rectangle(r.Left, r.Top, r.Right, r.Bottom - 1, BGRA(48, 48, 48), dmSet); Bitmap.SetHorizLine(r.Left + 1, r.Top + 1, r.Right - 2, BGRA(160, 160, 160)); Bitmap.SetHorizLine(r.Left, r.Bottom - 1, r.Right - 1, BGRA(115, 115, 115)); end else begin { Normal } Bitmap.GradientFill(r.Left, r.Top, r.Right, r.Bottom, BGRA(107, 107, 107), BGRA(84, 84, 84), gtLinear, PointF(0, 0), PointF(0, r.Bottom), dmSet); Bitmap.Rectangle(r.Left, r.Top, r.Right, r.Bottom - 1, BGRA(48, 48, 48), dmSet); Bitmap.SetHorizLine(r.Left + 1, r.Top + 1, r.Right - 2, BGRA(130, 130, 130)); Bitmap.SetHorizLine(r.Left, r.Bottom - 1, r.Right - 1, BGRA(115, 115, 115)); end; end; end else begin { Disabled } Bitmap.Rectangle(r.Left, r.Top, r.Right, r.Bottom - 1, BGRA(66, 66, 66), BGRA(71, 71, 71), dmSet); Bitmap.SetHorizLine(r.Left, r.Bottom - 1, r.Right - 1, BGRA(94, 94, 94)); end; Bitmap.Draw(TCanvas(ADest), ADestPos.x, ADestPos.y, False); Bitmap.Free; end; procedure TBGRADrawer.DrawCheckBox(ADest: TCanvas; ASize: TSize; AState: TCDControlState; AStateEx: TCDControlStateEx); var lColor: TColor; lSquareHeight, lValue3: integer; lTextHeight, lTextY: integer; begin lSquareHeight := GetMeasures(TCDCHECKBOX_SQUARE_HEIGHT); lValue3 := DPIAdjustment(3); // Background lColor := $00535353; //AStateEx.ParentRGBColor; ADest.Brush.Color := lColor; ADest.Brush.Style := bsSolid; ADest.Pen.Style := psClear; ADest.FillRect(0, 0, ASize.cx, ASize.cy); // The checkbox item itself DrawCheckBoxSquare(ADest, Point(0, 0), ASize, AState, AStateEx); // The Tickmark if (csfOn in AState) or (csfPartiallyOn in AState) then DrawTickmark(ADest, Point(lValue3, ASize.cy div 2 - GetMeasures(TCDCHECKBOX_SQUARE_HALF_HEIGHT) + lValue3), AState); // The text selection //if csfHasFocus in AState then // DrawFocusRect(ADest, Point(lSquareHeight+4, 0), // Size(ASize.cx-lSquareHeight-4, ASize.cy)); // Now the text ADest.Brush.Style := bsClear; ADest.Pen.Style := psClear; ADest.Font.Assign(AStateEx.Font); if csfEnabled in AState then ADest.Font.Color := $00E5E5E5 else ADest.Font.Color := $00AAAAAA; lTextHeight := ADest.TextHeight(cddTestStr); // put the text in the center if lSquareHeight > lTextHeight then lTextY := (lSquareHeight - ADest.TextHeight(cddTestStr)) div 2 else lTextY := 0; lTextY := Max(0, lTextY - 1); ADest.TextOut(lSquareHeight + 5, lTextY, AStateEx.Caption); end; procedure TBGRADrawer.DrawRadioButtonCircle(ADest: TCanvas; ADestPos: TPoint; ASize: TSize; AState: TCDControlState; AStateEx: TCDControlStateEx); var lCircleHeight, lCircleMid: integer; Bitmap: TBGRABitmap; bColor: TBGRAPixel; begin lCircleHeight := GetMeasures(TCDRADIOBUTTON_CIRCLE_HEIGHT); lCircleMid := lCircleHeight div 2; Bitmap := TBGRABitmap.Create(lCircleHeight, lCircleHeight); if csfEnabled in AState then begin if csfSunken in AState then bColor := BGRA(61, 61, 61) else begin if csfMouseOver in AState then bColor := BGRA(109, 109, 109) else bColor := BGRA(84, 84, 84); end; end else bColor := BGRA(71, 71, 71); if csfOn in AState then begin if csfEnabled in AState then Bitmap.EllipseAntialias(lCircleMid, lCircleMid, lCircleMid - 1, lCircleMid - 1, BGRA(48, 48, 48), 1, BGRA(229, 229, 229)) else Bitmap.EllipseAntialias(lCircleMid, lCircleMid, lCircleMid - 1, lCircleMid - 1, BGRA(48, 48, 48), 1, BGRA(170, 170, 170)); end else begin Bitmap.EllipseAntialias(lCircleMid, lCircleMid, lCircleMid - 1, lCircleMid - 1, BGRA(48, 48, 48), 1, bColor); end; Bitmap.Draw(TCanvas(ADest), 0, (ADest.Font.GetTextHeight('a') - lCircleHeight) div 2, False); end; procedure TBGRADrawer.DrawRadioButton(ADest: TCanvas; ASize: TSize; AState: TCDControlState; AStateEx: TCDControlStateEx); var lColor: TColor; lCircleHeight: integer; lTextHeight, lTextY: integer; begin lCircleHeight := GetMeasures(TCDRADIOBUTTON_CIRCLE_HEIGHT); // Background lColor := $00535353; //AStateEx.ParentRGBColor; ADest.Brush.Color := lColor; ADest.Brush.Style := bsSolid; ADest.Pen.Style := psClear; ADest.FillRect(0, 0, ASize.cx, ASize.cy); // The radiobutton circle itself DrawRadioButtonCircle(ADest, Point(0, 0), ASize, AState, AStateEx); // The text selection //if csfHasFocus in AState then // DrawFocusRect(ADest, Point(lCircleHeight+3, 0), // Size(ASize.cx-lCircleHeight-3, ASize.cy)); // Now the text ADest.Brush.Style := bsClear; ADest.Font.Assign(AStateEx.Font); if csfEnabled in AState then ADest.Font.Color := $00E5E5E5 else ADest.Font.Color := $00AAAAAA; lTextHeight := ADest.TextHeight(cddTestStr); // put the text in the center if lCircleHeight > lTextHeight then lTextY := (lCircleHeight - ADest.TextHeight(cddTestStr)) div 2 else lTextY := 0; lTextY := Max(0, lTextY - 1); ADest.TextOut(lCircleHeight + 5, lTextY, AStateEx.Caption); end; initialization RegisterDrawer(TBGRADrawer.Create, dsCommon); end.