unit uRibbon; {$mode objfpc}{$H+} interface uses Controls, Graphics, BCButton, BCTypes, BGRABitmap, BGRABitmapTypes, LResources; type TBCRibbonStyle = (rsTab, rsButton, rsSeparator, rsMenu); var MainColor,TabFntColor,BtnFntColor:TColor; BtnNormalColor, BtnHoverColor, BtnClickedColor:TColor; TabNormalColor, TabHoverColor, TabClickedColor:TColor; ToolNormalColor,ToolHoverColor,ToolClickedColor:TColor; { StyleButtons } procedure StyleRibbonButtonsSample(AControl: TControl; AStyle: TBCRibbonStyle); procedure StyleRibbonBody(AControl: TControl); { Drawings } procedure DrawTabGradient(ABitmap: TBGRABitmap); procedure DrawTitleGradient(ABitmap: TBGRABitmap); procedure DrawBodyGradient(ABitmap: TBGRABitmap); procedure DrawFormGradient(ABitmap: TBGRABitmap); { Buttons } procedure RibbonTab(AButton: TBCButton); procedure RibbonTool(AButton: TBCButton); procedure RibbonButton(AButton: TBCButton); procedure RibbonSeparator(AButton: TBCButton); procedure RibbonMenu(AButton: TBCButton); implementation { StyleButtons } procedure StyleButtons(AControl: TControl; AButton: TBCButton); var i, prevNormalFontHeight, prevHoverFontHeight, prevClickedFontHeight: integer; WinControl: TWinControl; begin if AControl is TBCButton then begin with TBCButton(AControl) do begin prevNormalFontHeight := StateNormal.FontEx.Height; prevHoverFontHeight := StateHover.FontEx.Height; prevClickedFontHeight := StateClicked.FontEx.Height; AControl.Assign(AButton); StateNormal.FontEx.Height := prevNormalFontHeight; StateHover.FontEx.Height := prevHoverFontHeight; StateClicked.FontEx.Height := prevClickedFontHeight; end; end; if AControl is TWinControl then begin WinControl := TWinControl(AControl); if WinControl.ControlCount = 0 then exit; for i := 0 to WinControl.ControlCount - 1 do StyleButtons(WinControl.Controls[i], AButton); end; end; procedure StyleRibbonButtonsSample(AControl: TControl; AStyle: TBCRibbonStyle); var tempBCButton: TBCButton; begin tempBCButton := TBCButton.Create(nil); case AStyle of rsTab: RibbonTab(tempBCButton); rsButton: RibbonButton(tempBCButton); rsSeparator: RibbonSeparator(tempBCButton); rsMenu: RibbonMenu(tempBCButton); end; StyleButtons(AControl, tempBCButton); tempBCButton.Free; end; procedure StyleRibbonBody(AControl: TControl); var i: integer; WinControl: TWinControl; begin if AControl is TWinControl then begin WinControl := TWinControl(AControl); if WinControl.ControlCount = 0 then exit; for i := 0 to WinControl.ControlCount - 1 do begin if WinControl.Controls[i] is TBCButton then begin if WinControl.Controls[i].Caption = '-' then begin StyleRibbonButtonsSample(WinControl.Controls[i], rsSeparator); WinControl.Controls[i].Caption := ''; end else StyleRibbonButtonsSample(WinControl.Controls[i], rsButton); end; end; end; end; { Drawings } procedure DrawTabGradient(ABitmap: TBGRABitmap); var r: TLResource; bmp: TBGRABitmap; begin with ABitmap do begin Fill(MainColor); try begin // bmp := TBGRABitmap.Create('back5.png'); r:=LazarusResources.Find('ribbon'); bmp := TBGRABitmap.Create('back5.png'); ABitmap.PutImage(width-220,1,bmp,dmDrawWithTransparency); bmp.Free; end; except end; // DrawHorizLine(0, 0, Width - 1, ColorToBGRA(MainColor)); DrawHorizLine(1, Height - 1, Width - 2, $00F1F1F1); end; end; procedure DrawTitleGradient(ABitmap: TBGRABitmap); var bmp: TBGRABitmap; begin with ABitmap do begin Fill(MainColor); try begin bmp := TBGRABitmap.Create('back5.png'); ABitmap.PutImage(width-300,-68,bmp,dmDrawWithTransparency); bmp.Free; end; except end; end; end; procedure DrawBodyGradient(ABitmap: TBGRABitmap); begin with ABitmap do begin { GradientFill(0, 0, Width, Height, BGRA(247, 251, 255, 255), BGRA(220, 231, 245, 255), gtLinear, PointF(0, 0), PointF(0, Height - 3), dmSet); Rectangle(0, 0, Width, Height - 2, BGRA(255, 255, 255, 75), BGRAPixelTransparent, dmDrawWithTransparency); } DrawHorizLine(1, Height - 1, Width - 2, $00D2D2D2); //Top // DrawVertLine(Width-1, 0, Height-1, ColorToBGRA(MainColor)); //Right // DrawVertLine(0, 0, Height-1, ColorToBGRA(MainColor)); //Left end; end; procedure DrawFormGradient(ABitmap: TBGRABitmap); begin with ABitmap do begin // DrawVertLine(Width-1, 0, Height-1, ColorToBGRA(MainColor)); //Right // DrawHorizLine(0, Height - 1, Width - 1, ColorToBGRA(MainColor)); // Bottom // DrawVertLine(0, 0, Height-1, ColorToBGRA(MainColor)); //Left DrawHorizLine(1, 0, Width - 2, $00E6E6E6); // Top // GradientFill(0, 0, Width, Height, BGRA(197, 207, 223, 255), // BGRA(220, 229, 242, 255), gtLinear, PointF(0, 0), PointF(0, Height), dmSet); end; end; { Buttons } procedure RibbonTab(AButton: TBCButton); begin with AButton do begin Rounding.RoundX := 0; Rounding.RoundY := 0; BorderSpacing.Top := 4; with StateNormal do begin FontEx.Color := clWhite; Border.Style := bboNone; Background.Color := TabNormalColor; Background.Style := bbsColor; end; with StateHover do begin FontEx.Color := clWhite; Border.Style := bboNone; Background.Color := TabHoverColor; Background.Style := bbsColor; end; with StateClicked do begin FontEx.Color := TabFntColor; Border.Style := bboNone; Background.Color := TabClickedColor; Background.Style := bbsColor; end; end; end; procedure RibbonButton(AButton: TBCButton); begin with AButton do begin Rounding.RoundX := 0; Rounding.RoundY := 0; BorderSpacing.Top := 2; BorderSpacing.Left := 2; BorderSpacing.Right := 0; BorderSpacing.Bottom := 16; with StateNormal do begin Border.Style := bboNone; Background.Color := BtnNormalColor; Background.Style := bbsColor; FontEx.Name:='Segoe UI'; FontEx.Shadow:=FALSE; FontEx.Color:=BtnFntColor; FontEx.WordBreak:= true; FontEx.TextAlignment := bcaCenterTop; FontEx.Style:=[]; end; with StateHover do begin Border.Style := bboNone; Background.Color := BtnHoverColor; Background.Style := bbsColor; FontEx.Name:='Segoe UI'; FontEx.Shadow:=FALSE; FontEx.Color:=BtnFntColor; FontEx.WordBreak:= true; FontEx.TextAlignment := bcaCenterTop; FontEx.Style:=[]; end; with StateClicked do begin Border.Style := bboNone; Background.Color := BtnClickedColor; Background.Style := bbsColor; FontEx.Name:='Segoe UI'; FontEx.Shadow:=FALSE; FontEx.Color:=BtnFntColor; FontEx.WordBreak:= true; FontEx.TextAlignment := bcaCenterTop; FontEx.Style:=[]; end; end; end; procedure RibbonTool(AButton: TBCButton); begin with AButton do begin Rounding.RoundX := 0; Rounding.RoundY := 0; BorderSpacing.Around := 2; BorderSpacing.Bottom := 2; with StateNormal do begin FontEx.Color := clWhite; Border.Style := bboNone; Background.Color := ToolNormalColor; Background.Style := bbsColor; end; with StateHover do begin FontEx.Color := clWhite; Border.Style := bboNone; Background.Color := ToolHoverColor; Background.Style := bbsColor; end; with StateClicked do begin FontEx.Color := clWhite; Border.Style := bboNone; Background.Color := ToolClickedColor; Background.Style := bbsColor; end; end; end; procedure RibbonSeparator(AButton: TBCButton); begin with AButton do begin StaticButton := True; Color:=clNone; BorderSpacing.Top:=2; BorderSpacing.Bottom:=2; ParentColor:= FALSE; with StateNormal do begin Border.Color := $00D2D0CF; Border.ColorOpacity := 255; Border.Style:=bboSolid; Background.Color := $00d2d2d2; Background.Style := bbsColor; end; end; end; procedure RibbonMenu(AButton: TBCButton); begin with AButton do begin Rounding.RoundX := 0; Rounding.RoundY := 0; BorderSpacing.Top := 4; with StateNormal do begin FontEx.Color := clWhite; Border.Style := bboNone; Background.Color := TabNormalColor; Background.Style := bbsColor; end; with StateHover do begin FontEx.Color := clWhite; Border.Style := bboNone; Background.Color := TabHoverColor; Background.Style := bbsColor; end; with StateClicked do begin FontEx.Color := $009A572A; Border.Style := bboNone; Background.Color := TabClickedColor; Background.Style := bbsColor; end; end; end; end.