1 unit umain;
2 
3 {$mode objfpc}{$H+}
4 
5 interface
6 
7 uses
8   Forms, Controls, Graphics, ExtCtrls, ComCtrls, Types,
9   { BGRABitmap }
10   BGRABitmap, BGRABitmapTypes,
11   { BGRAControls }
12   BGRACustomDrawn, BCPanel, BCToolBar, Classes;
13 
14 type
15 
16   { TfrmMain }
17 
18   TfrmMain = class(TForm)
19     BCDButton1: TBCDButton;
20     BCDButton2: TBCDButton;
21     BCDCheckBox3: TBCDCheckBox;
22     BCDCheckBox4: TBCDCheckBox;
23     BCDEdit1: TBCDEdit;
24     BCDEdit2: TBCDEdit;
25     BCDProgressBar1: TBCDProgressBar;
26     BCDRadioButton1: TBCDRadioButton;
27     BCDRadioButton2: TBCDRadioButton;
28     BCDRadioButton3: TBCDRadioButton;
29     BCDRadioButton4: TBCDRadioButton;
30     BCDSpinEdit1: TBCDSpinEdit;
31     BCDSpinEdit2: TBCDSpinEdit;
32     BCDStaticText1: TBCDStaticText;
33     BCDStaticText2: TBCDStaticText;
34     BCPanel1: TBCPanel;
35     BCToolBar1: TBCToolBar;
36     BCDCheckBox1: TBCDCheckBox;
37     BCDCheckBox2: TBCDCheckBox;
38     Timer1: TTimer;
39     ToolButton1: TToolButton;
40     ToolButton2: TToolButton;
41     ToolButton3: TToolButton;
42     ToolButton4: TToolButton;
43     procedure BCDButton1Click(Sender: TObject);
44     procedure BCToolBar1PaintButton(Sender: TToolButton; State: integer);
45     procedure BCToolBar1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
46     procedure FormCreate(Sender: TObject);
47     procedure Timer1Timer(Sender: TObject);
48   private
49     { private declarations }
50   public
51     { public declarations }
52     procedure AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy;
53       const AFromDPI, AToDPI, AOldFormWidth, ANewFormWidth: integer); override;
54   end;
55 
56 var
57   frmMain: TfrmMain;
58 
59 implementation
60 
61 {$R *.lfm}
62 
63 { TfrmMain }
64 
65 procedure TfrmMain.FormCreate(Sender: TObject);
66 begin
67   //Self.AutoAdjustLayout(lapAutoAdjustForDPI, Self.DesignTimeDPI,
68   //  Screen.PixelsPerInch, Self.Width, ScaleX(Self.Width, Self.DesignTimeDPI));
69 end;
70 
71 procedure TfrmMain.BCToolBar1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
72 begin
73   Bitmap.Rectangle(0, 0, Bitmap.Width, Bitmap.Height, BGRA(83, 83, 83),
74     BGRA(83, 83, 83), dmSet);
75   Bitmap.SetHorizLine(0, Bitmap.Height - 2, Bitmap.Width - 1, BGRA(106, 106, 106));
76   Bitmap.SetHorizLine(0, Bitmap.Height - 1, Bitmap.Width - 1, BGRA(40, 40, 40));
77 end;
78 
79 procedure TfrmMain.BCToolBar1PaintButton(Sender: TToolButton; State: integer);
80 var
81   Bitmap: TBGRABitmap;
82   ts: TSize;
83 begin
84   Bitmap := TBGRABitmap.Create(Sender.Width, Sender.Height);
85 
86   if Sender.Style = tbsButton then
87   begin
88     if Sender.Enabled then
89     begin
90       if State = 3 then
91       begin
92         { Button Down }
93         Bitmap.Rectangle(0, 0, Sender.Width, Sender.Height - 1, BGRA(48, 48, 48),
94           BGRA(61, 61, 61), dmSet);
95         Bitmap.Rectangle(1, 1, Sender.Width - 1, Sender.Height - 2, BGRA(55, 55, 55),
96           BGRA(61, 61, 61), dmSet);
97         Bitmap.SetHorizLine(0, Sender.Height - 1, Sender.Width - 1, BGRA(83, 83, 83));
98       end
99       else
100       begin
101         if State = 2 then
102         begin
103           { Button Hovered }
104           Bitmap.GradientFill(0, 0, Sender.Width, Sender.Height, BGRA(132, 132, 132),
105             BGRA(109, 109, 109), gtLinear, PointF(0, 0),
106             PointF(0, Sender.Height), dmSet);
107           Bitmap.Rectangle(0, 0, Sender.Width, Sender.Height - 1,
108             BGRA(48, 48, 48), dmSet);
109           Bitmap.SetHorizLine(1, 1, Sender.Width - 2, BGRA(160, 160, 160));
110           Bitmap.SetHorizLine(0, Sender.Height - 1, Sender.Width - 1, BGRA(83, 83, 83));
111         end
112         else
113           { Button Normal }
114           Bitmap.Fill(BGRA(83, 83, 83));
115       end;
116     end
117     else
118     begin
119       { Button Disabled }
120       Bitmap.Rectangle(0, 0, Sender.Width, Sender.Height - 1, BGRA(66, 66, 66),
121         BGRA(71, 71, 71), dmSet);
122       Bitmap.SetHorizLine(0, Sender.Height - 1, Sender.Width - 1, BGRA(83, 83, 83));
123     end;
124 
125     Bitmap.FontName := Sender.Font.Name;
126     Bitmap.FontStyle := Sender.Font.Style;
127     Bitmap.FontHeight := Sender.Font.Height;
128     Bitmap.FontQuality := fqSystemClearType;
129     ts := Bitmap.TextSize(Sender.Caption);
130 
131     if Sender.Enabled then
132     begin
133       { Text Enabled }
134       Bitmap.TextOut((Sender.Width - ts.cx) div 2, ((Sender.Height - ts.cy) div 2) -
135         1, Sender.Caption, BGRA(47, 47, 47));
136       Bitmap.TextOut((Sender.Width - ts.cx) div 2, (Sender.Height - ts.cy) div 2,
137         Sender.Caption, BGRA(229, 229, 229));
138     end
139     else
140       { Text Disabled }
141       Bitmap.TextOut((Sender.Width - ts.cx) div 2, (Sender.Height - ts.cy) div 2,
142         Sender.Caption, BGRA(170, 170, 170));
143   end;
144 
145   Bitmap.Draw(Sender.Canvas, 0, 0, True);
146   Bitmap.Free;
147 end;
148 
149 procedure TfrmMain.BCDButton1Click(Sender: TObject);
150 begin
151   BCDButton2.Enabled := not BCDButton2.Enabled;
152   BCDEdit2.Enabled := not BCDEdit2.Enabled;
153   BCDSpinEdit2.Enabled := not BCDSpinEdit2.Enabled;
154   BCDStaticText2.Enabled := not BCDStaticText2.Enabled;
155   BCDCheckBox3.Enabled := not BCDCheckBox3.Enabled;
156   BCDCheckBox4.Enabled := not BCDCheckBox4.Enabled;
157   BCDRadioButton3.Enabled := not BCDRadioButton3.Enabled;
158   BCDRadioButton4.Enabled := not BCDRadioButton4.Enabled;
159 end;
160 
161 procedure TfrmMain.Timer1Timer(Sender: TObject);
162 begin
163   if BCDProgressBar1.Position <> BCDProgressBar1.Max then
164     BCDProgressBar1.Position := BCDProgressBar1.Position + 1
165   else
166     Timer1.Enabled := False;
167 end;
168 
169 procedure TfrmMain.AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy;
170   const AFromDPI, AToDPI, AOldFormWidth, ANewFormWidth: integer);
171 begin
172   inherited AutoAdjustLayout(AMode, AFromDPI, AToDPI, AOldFormWidth,
173     ANewFormWidth);
174 
175   //BCToolBar1.ButtonWidth := ScaleX(BCToolBar1.ButtonWidth, Self.DesignTimeDPI);
176   //BCToolBar1.ButtonHeight := ScaleY(BCToolBar1.ButtonHeight, Self.DesignTimeDPI);
177   BCToolBar1.Height := BCToolBar1.ButtonHeight + 4;
178 end;
179 
180 end.
181