Skip to content

Commit 2b121af

Browse files
lainzlainz
authored
Merge pull request #168 from bgrabitmap/dev-bgracontrols
Dev bgracontrols
2 parents a1220e6 + 11f2cb5 commit 2b121af

37 files changed

+5908
-9455
lines changed

‎BCExpandPanels.lrs‎

Lines changed: 286 additions & 0 deletions
Large diffs are not rendered by default.

‎BCExpandPanels.pas‎

Lines changed: 2631 additions & 0 deletions
Large diffs are not rendered by default.

‎BCExpandPanels.txt‎

Lines changed: 65 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,65 @@
1+
// ExpandPanels Version 3.0
2+
3+
2024-01-31 MaxM: First port from original code in BGRAControls (formally Ver. 3.0)
4+
5+
// ExpandPanels Version 2.2
6+
7+
30-06-2016 MaxM :
8+
Added Button.Style as bbsLineTop,bbsLineBottom,bbsLineDoubleTop,bbsLineDoubleBottom
9+
Fixed Some Paint Coordinate position of Button elements and Lines
10+
11+
21-06-2016 MaxM :
12+
Added Button.GlyphKind (default to gkArrows)
13+
Added gkClose (EXP_PANEL_CLOSE.png),
14+
gkMinMax (EXP_PANEL_MIN_*.png, EXP_PANEL_MAX_*.png) Glyphs
15+
Added TExpandPanels properties ButtonGlyphLayout,ButtonGlyphKind,ButtonStyle,ButtonTextLayout,ButtonTabWidth
16+
17+
15-06-2016 MaxM :
18+
Added Button.Style as bbsLine and bbsLineDouble
19+
20+
09-06-2016 MaxM :
21+
Completed Painting of Button.Style as bbsTab
22+
23+
05-2016 MaxM :
24+
Added Owner Draw of Panel so we can Draw Rounded Borders and don't draw Borders when Collapsed
25+
Added Style property on Button (bbsButton, bbsTab) (bbsTab paint is incomplete do not use)
26+
Deleted BevenInner/Outer redefinition no more needed because now we draw the borders
27+
Changed using of writeln with debugln because strange exceptions under Windows
28+
Moved TMyRollOut.Loaded Code to CreateWnd because on RunTime creation is never Called
29+
Fixed More OnCollapsed events
30+
Fixed PositionButton is called only after Loaded is complete
31+
Updated Copyright and Created separeted txt files
32+
Added development test with only one panel (to simplify my life)
33+
34+
// ExpandPanels Version 2.1
35+
36+
23-07-2015 MaxM :
37+
Added Owner Draw of Button so we can Draw Vertically when ButtonPosition is akLeft or akRight
38+
Added Glyphs Support (Automatically Loaded from Resources or User Passed)
39+
Solved Bugs About BevelOuter and Starting in Collapsed State
40+
Moved Colors inside Button
41+
42+
// TO-DO:
43+
44+
- MaxM:
45+
46+
Fix User components have 2 Pixels visible over the Button when Button Position
47+
is akRight and is Collapsed SEE PROJECT1 DEVELOPMENT - ONLY ADDED IN TExpandPanels?
48+
Fix Shadows incoerence when Button.Style is bbsTab, the Panel attached side may not have borders.
49+
50+
51+
- Alex
52+
53+
simplyfy everything with verctor addition and scalar multiplication (orthogonal basis vectors... and so on)
54+
if horizonatal and vertical would be described by a unity vector, I could calculate if a certain operation should be performed
55+
and I could just multiply the basis vector with an operation to get a delta movement (or none)
56+
57+
58+
59+
Known Bugs:
60+
61+
- the TExpandPanels lacks a arrange on bottom and right
62+
63+
- (Solved?) Button.Color Setted to clBtnFace at DesignTime -> Color = clSkyBlue in RunTime
64+
(is not Loaded because is The inherited Default Color of TCustomSpeedButton)
65+

‎bcfluentprogressring.pas‎

Lines changed: 252 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,252 @@
1+
{
2+
2024 by hedgehog
3+
}
4+
5+
unit BCFluentProgressRing;
6+
7+
{$mode ObjFPC}{$H+}
8+
9+
interface
10+
11+
uses
12+
Classes, SysUtils, Controls, Graphics, ExtCtrls,
13+
BGRAGraphicControl, BGRABitmapTypes;
14+
15+
type
16+
17+
{ TBCFluentProgressRing }
18+
19+
TBCFluentProgressRing = class(TBGRAGraphicControl)
20+
private
21+
FPeriod: Int64;
22+
FIndeterminate: boolean;
23+
FStartTickCount: QWord;
24+
FAnimationTime: Int64;
25+
FTimer: TTimer;
26+
FMaxValue: integer;
27+
FMinValue: integer;
28+
FValue: integer;
29+
FLineColor: TColor;
30+
FLineBkgColor: TColor;
31+
FLineWidth: integer;
32+
33+
procedure SetIndeterminate(AValue: boolean);
34+
procedure SetLineBkgColor(AValue: TColor);
35+
procedure SetLineColor(AValue: TColor);
36+
procedure SetMaxValue(AValue: integer);
37+
procedure SetMinValue(AValue: integer);
38+
procedure SetValue(AValue: integer);
39+
procedure SetLineWidth(AValue: integer);
40+
protected
41+
procedure SetEnabled(Value: Boolean); override;
42+
procedure SetVisible(Value: Boolean); override;
43+
procedure RedrawBitmapContent; override;
44+
45+
procedure TimerEvent({%H-}Sender: TObject);
46+
procedure TimerStart({%H-}Sender: TObject);
47+
public
48+
constructor Create(AOwner: TComponent); override;
49+
published
50+
property MinValue: integer read FMinValue write SetMinValue default 0;
51+
property MaxValue: integer read FMaxValue write SetMaxValue default 100;
52+
property Value: integer read FValue write SetValue default 0;
53+
property LineColor: TColor read FLineColor write SetLineColor default
54+
TColor($009E5A00);
55+
property LineBkgColor: TColor read FLineBkgColor write SetLineBkgColor default
56+
TColor($00D3D3D3);
57+
property LineWidth: integer read FLineWidth write SetLineWidth default 0;
58+
property Indeterminate: boolean read FIndeterminate write SetIndeterminate default false;
59+
end;
60+
61+
procedure Register;
62+
63+
implementation
64+
65+
procedure Register;
66+
begin
67+
RegisterComponents('BGRA Controls', [TBCFluentProgressRing]);
68+
end;
69+
70+
{ TBCFluentProgressRing }
71+
72+
procedure TBCFluentProgressRing.SetMaxValue(AValue: integer);
73+
begin
74+
if FMaxValue = AValue then
75+
exit;
76+
FMaxValue := AValue;
77+
if FValue > FMaxValue then
78+
FValue := FMaxValue;
79+
if FMinValue > FMaxValue then
80+
FMinValue := FMaxValue;
81+
DiscardBitmap;
82+
end;
83+
84+
procedure TBCFluentProgressRing.SetLineBkgColor(AValue: TColor);
85+
begin
86+
if FLineBkgColor = AValue then
87+
Exit;
88+
FLineBkgColor := AValue;
89+
DiscardBitmap;
90+
end;
91+
92+
procedure TBCFluentProgressRing.SetIndeterminate(AValue: boolean);
93+
begin
94+
if FIndeterminate=AValue then Exit;
95+
FIndeterminate:=AValue;
96+
if Enabled and Visible then
97+
begin
98+
FTimer.Enabled:= FIndeterminate;
99+
DiscardBitmap;
100+
end;
101+
end;
102+
103+
procedure TBCFluentProgressRing.SetLineColor(AValue: TColor);
104+
begin
105+
if FLineColor = AValue then
106+
Exit;
107+
FLineColor := AValue;
108+
DiscardBitmap;
109+
end;
110+
111+
procedure TBCFluentProgressRing.SetMinValue(AValue: integer);
112+
begin
113+
if FMinValue = AValue then
114+
exit;
115+
FMinValue := AValue;
116+
if FValue < FMinValue then
117+
FValue := FMinValue;
118+
if FMaxValue < FMinValue then
119+
FMaxValue := FMinValue;
120+
DiscardBitmap;
121+
end;
122+
123+
procedure TBCFluentProgressRing.SetValue(AValue: integer);
124+
begin
125+
if FValue = AValue then
126+
exit;
127+
FValue := AValue;
128+
if FValue < FMinValue then
129+
FValue := FMinValue;
130+
if FValue > FMaxValue then
131+
FValue := FMaxValue;
132+
DiscardBitmap;
133+
end;
134+
135+
procedure TBCFluentProgressRing.SetLineWidth(AValue: integer);
136+
begin
137+
if FLineWidth = AValue then exit;
138+
FLineWidth := AValue;
139+
if Visible then DiscardBitmap;
140+
end;
141+
142+
procedure TBCFluentProgressRing.SetEnabled(Value: Boolean);
143+
begin
144+
inherited SetEnabled(Value);
145+
FTimer.Enabled := Value and Visible and FIndeterminate;
146+
DiscardBitmap;
147+
end;
148+
149+
procedure TBCFluentProgressRing.SetVisible(Value: Boolean);
150+
begin
151+
inherited SetVisible(Value);
152+
FTimer.Enabled := Enabled and Value and FIndeterminate;
153+
DiscardBitmap;
154+
end;
155+
156+
procedure TBCFluentProgressRing.RedrawBitmapContent;
157+
const
158+
pi2= 2*pi;
159+
pi15 = pi*1.5;
160+
var
161+
EffectiveSize: integer;
162+
EffectiveLineWidth: single;
163+
a, da, r: single;
164+
165+
procedure DoDrawArc(a, b: single; c: TColor);
166+
begin
167+
Bitmap.Canvas2D.strokeStyle(c);
168+
Bitmap.Canvas2D.beginPath;
169+
Bitmap.Canvas2D.arc(0, 0, r, a, b, false);
170+
Bitmap.Canvas2D.stroke;
171+
end;
172+
173+
begin
174+
if Width< Height then
175+
EffectiveSize:= Width
176+
else
177+
EffectiveSize:= Height;
178+
179+
if EffectiveSize<2 then exit;
180+
181+
182+
Bitmap.Canvas2D.resetTransform;
183+
Bitmap.Canvas2D.translate(Bitmap.Width/2, Bitmap.Height/2);
184+
Bitmap.Canvas2D.rotate(pi15);
185+
186+
187+
if FLineWidth=0 then
188+
EffectiveLineWidth:=EffectiveSize / 12
189+
else
190+
EffectiveLineWidth:= FLineWidth;
191+
r:= (EffectiveSize -EffectiveLineWidth)/2;
192+
193+
Bitmap.Canvas2D.lineWidth:= EffectiveLineWidth;
194+
// background line
195+
if (FValue < FMaxValue) and (FLineBkgColor<>clNone) then
196+
DoDrawArc(0, pi2, FLineBkgColor);
197+
Bitmap.Canvas2D.lineCapLCL:= pecRound;
198+
199+
if FIndeterminate and FTimer.Enabled then
200+
begin
201+
a:= 3*FAnimationTime*pi2/FPeriod - pi;
202+
da:= 2*abs(1 - 2*FAnimationTime/FPeriod);
203+
if da>0.005 then
204+
DoDrawArc(a-da, a+da, FLineColor);
205+
end
206+
else if FValue > FMinValue then
207+
begin
208+
if Enabled then
209+
DoDrawArc(0, pi2 * FValue / FMaxValue, FLineColor)
210+
else
211+
DoDrawArc(0, pi2 * FValue / FMaxValue, clGray);
212+
end;
213+
end;
214+
215+
procedure TBCFluentProgressRing.TimerEvent(Sender: TObject);
216+
var
217+
TickCount: QWord;
218+
begin
219+
TickCount:= GetTickCount64;
220+
FAnimationTime:= (TickCount - FStartTickCount) mod FPeriod;
221+
DiscardBitmap;
222+
end;
223+
224+
procedure TBCFluentProgressRing.TimerStart(Sender: TObject);
225+
begin
226+
FStartTickCount:= GetTickCount64;
227+
FAnimationTime:=0;
228+
end;
229+
230+
constructor TBCFluentProgressRing.Create(AOwner: TComponent);
231+
begin
232+
inherited Create(AOwner);
233+
FPeriod:= 2400;
234+
FTimer:= TTimer.Create(self);
235+
FTimer.Interval := 15;
236+
FTimer.Enabled := false;
237+
FTimer.OnTimer := @TimerEvent;
238+
FTimer.OnStartTimer:= @TimerStart;
239+
240+
with GetControlClassDefaultSize do
241+
SetInitialBounds(0, 0, 100, 100);
242+
FMaxValue := 100;
243+
FMinValue := 0;
244+
FValue := 0;
245+
FLineWidth:=0;
246+
FLineColor := TColor($009E5A00);
247+
FLineBkgColor := TColor($00D3D3D3);
248+
end;
249+
250+
251+
end.
252+

‎bclistbox.pas‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -176,5 +176,6 @@ constructor TBCListBox.Create(TheOwner: TComponent);
176176
end;
177177

178178
initialization
179+
{$I bcpaperlistbox.lrs}
179180

180181
end.

‎bcmaterialdesignbutton.pas‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -72,6 +72,7 @@ TBCMaterialDesignButton = class(TBGRAGraphicCtrl)
7272
public
7373
constructor Create(AOwner: TComponent); override;
7474
destructor Destroy; override;
75+
procedure ClickMe;
7576
published
7677
property RoundBorders: single read FRoundBorders write SetFRoundBorders {$IFDEF FPC}default 5{$ENDIF};
7778
property NormalColor: TColor read FNormalColor write SetFNormalColor default clWhite;
@@ -518,4 +519,11 @@ destructor TBCMaterialDesignButton.Destroy;
518519
inherited Destroy;
519520
end;
520521

522+
procedure TBCMaterialDesignButton.ClickMe;
523+
begin
524+
FMousePos := Point(Width div 2, Height div 2);
525+
FTimer.Enabled := True;
526+
inherited Click;
527+
end;
528+
521529
end.

0 commit comments

Comments
 (0)