Skip to content

Commit f5efbf8

Browse files
BobanSpasicBobanSpasic
authored
Merge pull request #193 from bgrabitmap/dev-bgracontrols
Merge 9.0.1.6
2 parents caa4183 + 2865a51 commit f5efbf8

11 files changed

+299
-7
lines changed

‎bcleaboard.pas‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,12 @@
1+
{
2+
*****************************************************************************
3+
See the file COPYING.modifiedLGPL.txt, included in this distribution,
4+
for details about the license.
5+
*****************************************************************************
6+
7+
Author: Boban Spasic
8+
}
9+
110
unit BCLeaBoard;
211

312
{$mode objfpc}{$H+}

‎bcleaengrave.pas‎

Lines changed: 272 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,272 @@
1+
{
2+
*****************************************************************************
3+
See the file COPYING.modifiedLGPL.txt, included in this distribution,
4+
for details about the license.
5+
*****************************************************************************
6+
7+
Author: Boban Spasic
8+
}
9+
10+
unit BCLeaEngrave;
11+
12+
{$mode ObjFPC}{$H+}
13+
14+
interface
15+
16+
uses
17+
Classes, SysUtils, Controls, Graphics, ExtCtrls, LResources,
18+
BGRABitmapTypes, BGRABitmap, BGRATextFX, BGRATransform;
19+
20+
type
21+
TBCLeaEngrave = class(TCustomControl)
22+
private
23+
FBitmap: TBGRABitmap;
24+
FFontShadowColor: TColor;
25+
FFontShadowOffsetX: integer;
26+
FFontShadowOffsetY: integer;
27+
FFontShadowRadius: integer;
28+
FLayerZoom: integer;
29+
FLayerOffsetX: integer;
30+
FLayerOffsetY: integer;
31+
FBlendOperation: TBlendOperation;
32+
FInvBlending: boolean;
33+
FLayerColor: TColor;
34+
FAngle: integer;
35+
procedure SetFFontShadowColor(AValue: TColor);
36+
procedure SetFFontShadowOffsetX(AValue: integer);
37+
procedure SetFFontShadowOffsetY(AValue: integer);
38+
procedure SetFFontShadowRadius(AValue: integer);
39+
procedure SetLayerZoom(AValue: integer);
40+
procedure SetBlendOperation(AValue: TBlendOperation);
41+
procedure SetInvBlending(AValue: boolean);
42+
procedure SetLayerColor(AValue: TColor);
43+
procedure SetLayerOffsetX(AValue: integer);
44+
procedure SetLayerOffsetY(AValue: integer);
45+
procedure SetAngle(AValue: integer);
46+
protected
47+
procedure SetVisible(Value: boolean); override;
48+
procedure Paint; override;
49+
procedure Redraw;
50+
public
51+
constructor Create(AOwner: TComponent); override;
52+
destructor Destroy; override;
53+
54+
published
55+
property Align;
56+
property Caption;
57+
property Color default clBtnFace;
58+
property Cursor;
59+
property Font;
60+
property ParentShowHint;
61+
property ShowHint;
62+
property Anchors;
63+
property Constraints;
64+
property Visible;
65+
property FontShadowColor: TColor read FFontShadowColor write SetFFontShadowColor default clBlack;
66+
property FontShadowOffsetX: integer read FFontShadowOffsetX write SetFFontShadowOffsetX default 2;
67+
property FontShadowOffsetY: integer read FFontShadowOffsetY write SetFFontShadowOffsetY default 2;
68+
property FontShadowRadius: integer read FFontSHadowRadius write SetFFontShadowRadius default 4;
69+
property BlendOperation: TBlendOperation read FBlendOperation write SetBlendOperation default boSubtractInverse;
70+
property LayerZoom: integer read FLayerZoom write SetLayerZoom default 102;
71+
property InverseBlending: boolean read FInvBlending write SetInvBlending default False;
72+
property LayerColor: TColor read FLayerColor write SetLayerColor default clBlack;
73+
property LayerOffsetX: integer read FLayerOffsetX write SetLayerOffsetX default 0;
74+
property LayerOffsetY: integer read FLayerOffsetY write SetLayerOffsetY default 0;
75+
property Angle: integer read FAngle write SetAngle default 0;
76+
end;
77+
78+
procedure Register;
79+
80+
implementation
81+
82+
procedure Register;
83+
begin
84+
RegisterComponents('BGRA Controls', [TBCLeaEngrave]);
85+
end;
86+
87+
constructor TBCLeaEngrave.Create(AOwner: TComponent);
88+
begin
89+
inherited Create(AOwner);
90+
91+
with GetControlClassDefaultSize do
92+
SetInitialBounds(0, 0, 100, 100);
93+
Font.Color := clBlack;
94+
Font.Height := 20;
95+
FLayerZoom := 102;
96+
FBlendOperation := boSubtractInverse;
97+
FFontShadowRadius := 4;
98+
FFontShadowOffsetX := 2;
99+
FFontShadowOffsetY := 2;
100+
FFontShadowColor := clBlack;
101+
Color := clBtnFace;
102+
FLayerColor := clBlack;
103+
FLayerOffsetX := 0;
104+
FLayerOffsetY := 0;
105+
FAngle := 0;
106+
FInvBlending := False;
107+
FBitmap := TBGRABitmap.Create(Width, Height, Color);
108+
end;
109+
110+
destructor TBCLeaEngrave.Destroy;
111+
begin
112+
FreeAndNil(FBitmap);
113+
inherited Destroy;
114+
end;
115+
116+
procedure TBCLeaEngrave.SetVisible(Value: boolean);
117+
begin
118+
inherited SetVisible(Value);
119+
Invalidate;
120+
end;
121+
122+
procedure TBCLeaEngrave.Paint;
123+
begin
124+
inherited Paint;
125+
Redraw;
126+
end;
127+
128+
procedure TBCLeaEngrave.Redraw;
129+
var
130+
TextBmp, LayerTextBmp: TBGRABitmap;
131+
Zoom, UnZoom, RotBmp: TBGRABitmap;
132+
CopyRect: TRect;
133+
ZFactor: single;
134+
Rad: single;
135+
Affine: TBGRAAffineBitmapTransform;
136+
begin
137+
ZFactor := FLayerZoom / 100;
138+
FBitmap.SetSize(Width, Height);
139+
FBitmap.Fill(Color);
140+
141+
TextBmp := TextShadow(Width, Height, Caption, Font.Height,
142+
Font.Color, FontShadowColor, FontShadowOFfsetX,
143+
FontShadowOffsetY, FontShadowRadius, Font.Style, Font.Name) as TBGRABitmap;
144+
LayerTextBmp := TextShadow(Width, Height, Caption, Font.Height,
145+
LayerColor, FontShadowColor, FontShadowOFfsetX,
146+
FontShadowOffsetY, FontShadowRadius, Font.Style, Font.Name) as TBGRABitmap;
147+
Zoom := LayerTextBmp.Resample(round(Width * ZFactor), round(Height * ZFactor)) as TBGRABitmap;
148+
CopyRect.Left := (Zoom.Width - Width) div 2 + FLayerOffsetX;
149+
CopyRect.Right := CopyRect.Left + Width + FLayerOffsetX;
150+
CopyRect.Top := (Zoom.Height - Height) div 2 + FLayerOffsetY;
151+
CopyRect.Bottom := CopyRect.Top + Height + FLayerOffsetY;
152+
UnZoom := Zoom.GetPart(CopyRect) as TBGRABitmap;
153+
if FInvBlending then
154+
begin
155+
FBitmap.PutImage(0, 0, UnZoom, dmDrawWithTransparency);
156+
FBitmap.BlendImageOver(0, 0, TextBmp, FBlendOperation);
157+
end
158+
else
159+
begin
160+
FBitmap.PutImage(0, 0, TextBmp, dmDrawWithTransparency);
161+
FBitmap.BlendImageOver(0, 0, UnZoom, FBlendOperation);
162+
end;
163+
if FAngle <> 0 then
164+
begin
165+
RotBmp := TBGRABitmap.Create(Width, Height, Color);
166+
Affine := TBGRAAffineBitmapTransform.Create(FBitmap);
167+
Affine.Translate(-FBitmap.Width div 2, -FBitmap.Height div 2);
168+
Affine.RotateDeg(FAngle);
169+
Affine.Translate(FBitmap.Width div 2, FBitmap.Height div 2);
170+
RotBmp.Fill(Affine);
171+
FBitmap.Fill(Color);
172+
FBitmap.PutImage(0, 0, RotBmp, dmDrawWithTransparency);
173+
Affine.Free;
174+
RotBmp.Free;
175+
end;
176+
177+
if Visible then
178+
FBitmap.Draw(Canvas, 0, 0, True);
179+
TextBmp.Free;
180+
Zoom.Free;
181+
UnZoom.Free;
182+
end;
183+
184+
procedure TBCLeaEngrave.SetFFontShadowColor(AValue: TColor);
185+
begin
186+
if FFontShadowColor = AValue then
187+
Exit;
188+
FFontShadowColor := AValue;
189+
Invalidate;
190+
end;
191+
192+
procedure TBCLeaEngrave.SetFFontShadowOffsetX(AValue: integer);
193+
begin
194+
if FFontShadowOffsetX = AValue then
195+
Exit;
196+
FFontShadowOffsetX := AValue;
197+
Invalidate;
198+
end;
199+
200+
procedure TBCLeaEngrave.SetFFontShadowOffsetY(AValue: integer);
201+
begin
202+
if FFontShadowOffsetY = AValue then
203+
Exit;
204+
FFontShadowOffsetY := AValue;
205+
Invalidate;
206+
end;
207+
208+
procedure TBCLeaEngrave.SetFFontShadowRadius(AValue: integer);
209+
begin
210+
if FFontSHadowRadius = AValue then
211+
Exit;
212+
FFontSHadowRadius := AValue;
213+
Invalidate;
214+
end;
215+
216+
procedure TBCLeaEngrave.SetBlendOperation(AValue: TBlendOperation);
217+
begin
218+
if FBlendOperation = AValue then
219+
Exit;
220+
FBlendOperation := AValue;
221+
Invalidate;
222+
end;
223+
224+
procedure TBCLeaEngrave.SetLayerZoom(AValue: integer);
225+
begin
226+
if FLayerZoom = AValue then
227+
Exit;
228+
FLayerZoom := AValue;
229+
Invalidate;
230+
end;
231+
232+
procedure TBCLeaEngrave.SetInvBlending(AValue: boolean);
233+
begin
234+
if FInvBlending = AValue then
235+
Exit;
236+
FInvBlending := AValue;
237+
Invalidate;
238+
end;
239+
240+
procedure TBCLeaEngrave.SetLayerColor(AValue: TColor);
241+
begin
242+
if FLayerColor = AValue then
243+
Exit;
244+
FLayerColor := AValue;
245+
Invalidate;
246+
end;
247+
248+
procedure TBCLeaEngrave.SetLayerOffsetX(AValue: integer);
249+
begin
250+
if FLayerOffsetX = AValue then
251+
Exit;
252+
FLayerOffsetX := AValue;
253+
Invalidate;
254+
end;
255+
256+
procedure TBCLeaEngrave.SetLayerOffsetY(AValue: integer);
257+
begin
258+
if FLayerOffsetY = AValue then
259+
Exit;
260+
FLayerOffsetY := AValue;
261+
Invalidate;
262+
end;
263+
264+
procedure TBCLeaEngrave.SetAngle(AValue: integer);
265+
begin
266+
if FAngle = AValue then
267+
Exit;
268+
FAngle := AValue;
269+
Invalidate;
270+
end;
271+
272+
end.

‎bgracontrols.lpk‎

Lines changed: 7 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -33,8 +33,8 @@
3333
</CompilerOptions>
3434
<Description Value="BGRA Controls is a set of graphical UI elements that you can use with Lazarus LCL applications."/>
3535
<License Value="Modified LGPL"/>
36-
<Version Major="9" Release="1" Build="4"/>
37-
<Files Count="78">
36+
<Version Major="9" Release="1" Build="6"/>
37+
<Files Count="79">
3838
<Item1>
3939
<Filename Value="atshapelinebgra.pas"/>
4040
<HasRegisterProc Value="True"/>
@@ -416,6 +416,11 @@
416416
<HasRegisterProc Value="True"/>
417417
<UnitName Value="BCLeaBoard"/>
418418
</Item78>
419+
<Item79>
420+
<Filename Value="bcleaengrave.pas"/>
421+
<HasRegisterProc Value="True"/>
422+
<UnitName Value="BCLeaEngrave"/>
423+
</Item79>
419424
</Files>
420425
<CompatibilityMode Value="True"/>
421426
<LazDoc Paths="fpdoc"/>

‎bgracontrols.pas‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,8 @@ interface
2424
ColorSpeedButton, DTAnalogClock, DTAnalogCommon, DTAnalogGauge,
2525
dtthemedclock, dtthemedgauge, MaterialColors, bgrasvgimagelistform,
2626
BCLeaLCDDisplay, BCLeaLED, BCLeaQLED, BCLeaRingSlider, BCLeaSelector,
27-
BCLeaTheme, BCLeaLCDDisplay_EditorRegister, BCLeaBoard, LazarusPackageIntf;
27+
BCLeaTheme, BCLeaLCDDisplay_EditorRegister, BCLeaBoard, BCLeaEngrave,
28+
LazarusPackageIntf;
2829

2930
implementation
3031

@@ -91,6 +92,7 @@ procedure Register;
9192
RegisterUnit('BCLeaLCDDisplay_EditorRegister',
9293
@BCLeaLCDDisplay_EditorRegister.Register);
9394
RegisterUnit('BCLeaBoard', @BCLeaBoard.Register);
95+
RegisterUnit('BCLeaEngrave', @BCLeaEngrave.Register);
9496
end;
9597

9698
initialization

‎bgrapascalscriptcomponent.lpk‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
<?xml version="1.0" encoding="UTF-8"?>
22
<CONFIG>
3-
<Package Version="4">
3+
<Package Version="5">
44
<PathDelim Value="\"/>
55
<Name Value="bgrapascalscriptcomponent"/>
66
<Type Value="RunAndDesignTime"/>
@@ -11,7 +11,7 @@
1111
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
1212
</SearchPaths>
1313
</CompilerOptions>
14-
<Version Major="9" Release="1" Build="5"/>
14+
<Version Major="9" Release="1" Build="6"/>
1515
<Files Count="3">
1616
<Item1>
1717
<Filename Value="bgrapascalscript.pas"/>
@@ -29,6 +29,7 @@
2929
<UnitName Value="BGRAScript"/>
3030
</Item3>
3131
</Files>
32+
<CompatibilityMode Value="True"/>
3233
<RequiredPkgs Count="3">
3334
<Item1>
3435
<PackageName Value="BGRABitmapPack"/>

‎images/TBCLeaEngrave.png‎

1.09 KB
Loading

‎images/TBCLeaEngrave_150.png‎

1.92 KB
Loading

‎images/TBCLeaEngrave_200.png‎

2.83 KB
Loading

‎images/bgracontrols_images.res‎

6.02 KB
Binary file not shown.

‎images/bgracontrols_images_list.txt‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -130,4 +130,7 @@ TBCLeaTheme_150.png
130130
TBCLeaTheme_200.png
131131
TBCLeaBoard.png
132132
TBCLeaBoard_150.png
133-
TBCLeaBoard_200.png
133+
TBCLeaBoard_200.png
134+
TBCLeaEngrave.png
135+
TBCLeaEngrave_150.png
136+
TBCLeaEngrave_200.png

0 commit comments

Comments
 (0)