Industrial: Add button icons to TOnOffSwitch and image blending and rotation animations.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9027 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-11-14 23:47:08 +00:00
parent 3952a66b63
commit 51c5415881

View File

@ -19,7 +19,7 @@ interface
uses
LCLIntf, LCLType, LMessages,
Graphics, Classes, SysUtils, Types, Controls, ExtCtrls;
Graphics, GraphType, Classes, SysUtils, Types, Controls, ExtCtrls, ImgList;
type
TSwitchBorderStyle = (
@ -28,7 +28,7 @@ type
);
TSwitchMode = (smClick, smDblClick, smSlide, smSlideDblClick);
TSwitchOrientation = (soHorizontal, soVertical);
TSwitchAnimationEffect = (saeBlendColors);
TSwitchAnimationEffect = (saeBlendColors, saeBlendImages, saeRotateImages);
TSwitchAnimationEffects = set of TSwitchAnimationEffect;
TCustomOnOffSwitch = class(TCustomControl)
@ -42,7 +42,7 @@ type
FBorderStyle: TSwitchBorderStyle;
FButtonPos: Integer;
FButtonSize: Integer;
FCaptions: array[0..1] of string;
FCaptions: array[boolean] of string;
FChecked: Boolean;
FCheckedAfterAnimation: Boolean;
FColors: array [0..2] of TColor;
@ -60,21 +60,28 @@ type
FSwitchMode: TSwitchMode;
FOnChange: TNotifyEvent;
FDblClickTimer: TTimer;
FPicture: array[0..1] of TPicture;
FPicture: array[boolean] of TPicture;
FImageIndex: array[boolean] of TImageIndex;
FImageListChangeLink: TChangeLink;
FImages: TCustomImagelist;
FImagesWidth: Integer;
function GetBorderWidth: Integer;
function GetCaptions(AIndex: Integer): String;
function GetCaptions(AChecked: Boolean): String;
function GetColors(AIndex: Integer): TColor;
function GetImageIndex(AChecked: Boolean): TImageIndex;
function GetOrientation: TSwitchOrientation;
function GetPicture(AIndex: Integer): TPicture;
function GetPicture(AChecked: Boolean): TPicture;
procedure SetAnimated(AValue: Boolean);
procedure SetBorderStyle(AValue: TSwitchBorderStyle); reintroduce;
procedure SetButtonSize(AValue: Integer);
procedure SetCaptions(AIndex: Integer; AValue: string);
procedure SetCaptions(AChecked: Boolean; AValue: string);
procedure SetChecked(AValue: Boolean);
procedure SetColors(AIndex: Integer; AValue: TColor);
procedure SetFlippedColors(AValue: Boolean);
procedure SetImageIndex(AChecked: Boolean; AValue: TImageIndex);
procedure SetImages(const AValue: TCustomImageList);
procedure SetInverse(AValue: Boolean);
procedure SetPicture(AIndex: Integer; AValue: TPicture);
procedure SetPicture(AChecked: Boolean; AValue: TPicture);
procedure SetShowButtonBorder(AValue: Boolean);
procedure SetShowCaption(AValue: Boolean);
procedure SetShowFocusRect(AValue: Boolean);
@ -93,6 +100,7 @@ type
procedure DoChange; virtual;
procedure DoEnter; override;
procedure DoExit; override;
procedure DoImageListChange(Sender: TObject);
function DraggedToON: Boolean;
procedure DrawButton(ARect: TRect); virtual;
procedure DrawCaption(ARect: TRect; AChecked: Boolean); virtual;
@ -104,22 +112,27 @@ type
procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
function MouseOnButton(X, Y: Integer): Boolean; virtual;
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure Paint; override;
property Animated: Boolean read FAnimated write SetAnimated default false;
property AnimationEffects: TSwitchAnimationEffects read FAnimationEffects write FAnimationEffects default [];
property AnimationEffects: TSwitchAnimationEffects read FAnimationEffects write FAnimationEffects default [saeBlendColors, saeBlendImages];
property BorderColor: TColor index 2 read GetColors write SetColors default clGray;
property BorderStyle: TSwitchBorderStyle read FBorderStyle write SetBorderStyle default bsThin;
property ButtonSize: Integer read FButtonSize write SetButtonSize default DEFAULT_BUTTON_SIZE;
property CaptionOFF: String index 0 read GetCaptions write SetCaptions;
property CaptionON: String index 1 read GetCaptions write SetCaptions;
property CaptionOFF: String index false read GetCaptions write SetCaptions;
property CaptionON: String index true read GetCaptions write SetCaptions;
property Checked: Boolean read FChecked write SetChecked default false;
property Color default clWindow;
property ColorOFF: TColor index 0 read GetColors write SetColors default clMaroon;
property ColorON: TColor index 1 read GetColors write SetColors default clGreen;
property FlippedColors: Boolean read FFlippedColors write SetFlippedColors default false;
property ImageIndexOFF: TImageIndex index false read GetImageIndex write SetImageIndex default -1;
property ImageIndexON: TImageIndex index true read GetImageIndex write SetImageIndex default -1;
property Images: TCustomImageList read FImages write SetImages;
property ImagesWidth: Integer read FImagesWidth write FImagesWidth default 0;
property Inverse: Boolean read FInverse write SetInverse default false;
property PictureOFF: TPicture index 0 read GetPicture write SetPicture;
property PictureON: TPicture index 1 read GetPicture write SetPicture;
property PictureOFF: TPicture index false read GetPicture write SetPicture;
property PictureON: TPicture index true read GetPicture write SetPicture;
property ReadOnly: boolean read FReadOnly write FReadOnly default false;
property ShowButtonBorder: Boolean read FShowButtonBorder write SetShowButtonBorder default true;
property ShowFocusRect: Boolean read FShowFocusRect write SetShowFocusRect default true;
@ -148,6 +161,10 @@ type
property ColorON;
property Enabled;
property FlippedColors;
property ImageIndexON;
property ImageIndexOFF;
property Images;
property ImagesWidth;
property Inverse;
property PictureOFF;
property PictureON;
@ -193,21 +210,66 @@ type
implementation
uses
Math;
Math, FPImage, GraphMath, IntfGraphics;
function BlendColors(AFactor: Double; AColor1, AColor2: TColor): TColor;
var
f1, f2: Double;
r, g, b: Byte;
begin
f1 := AFactor;
f2 := 1.0 - f1;
f1 := 1.0 - AFactor;
f2 := AFactor;
r := EnsureRange(round(GetRValue(AColor1) * f1 + GetRValue(AColor2) * f2), 0, 255);
g := EnsureRange(round(GetGValue(AColor1) * f1 + GetGValue(AColor2) * f2), 0, 255);
b := EnsureRange(round(GetBValue(AColor1) * f1 + GetBValue(AColor2) * f2), 0, 255);
Result := RGBToColor(r, g, b);
end;
procedure BlendImages(Img, Img1, Img2: TFPCustomImage; AFactor: Double);
var
x, y: Integer;
r,g,b,a: Word;
f1, f2: Double;
begin
f1 := 1.0 - AFactor;
f2 := AFactor;
for y := 0 to Img1.Height-1 do
for x := 0 to Img1.Width-1 do
begin
r := round(f1 * Img1.Colors[x, y].Red + f2 * Img2.Colors[x, y].Red);
g := round(f1 * Img1.Colors[x, y].Green + f2 * Img2.Colors[x, y].Green);
b := round(f1 * Img1.Colors[x, y].Blue + f2 * Img2.Colors[x, y].Blue);
a := round(f1 * Img1.Colors[x, y].Alpha + f2 * Img2.Colors[x, y].Alpha);
Img.Colors[x, y] := FPColor(r, g, b, a);
end;
end;
procedure RotateImage(Img: TFPCustomImage; Angle: Double);
var
Buffer: TFPCustomImage;
x, y: Integer;
C, P: TPoint;
begin
Buffer := TFPMemoryImage.Create(Img.Width, Img.Height);
try
C := Point(Img.Width div 2, Img.Height div 2);
for y := 0 to Buffer.Height-1 do
for x := 0 to Buffer.Width-1 do
begin
P := RotatePoint(Point(x, y) - C, Angle) + C;
if (P.X >= 0) and (P.Y >= 0) and (P.X < Img.Width) and (P.Y < Img.Height) then
Buffer.Colors[x, y] := Img.Colors[P.X, P.Y]
else
Buffer.Colors[x, y] := colTransparent;
end;
for y := 0 to Img.Height-1 do
for x := 0 to Img.Width-1 do
Img.Colors[x, y] := Buffer[x, y];
finally
Buffer.Free;
end;
end;
function TintedColor(AColor: TColor; ADelta: Integer): TColor;
var
r, g, b: Byte;
@ -236,15 +298,20 @@ begin
inherited;
TabStop := true;
Color := clWindow;
FAnimationEffects := [saeBlendColors, saeBlendImages];
FBorderStyle := bsThin;
FButtonSize := DEFAULT_BUTTON_SIZE;
FColors[0] := clMaroon; // unchecked color
FColors[1] := clGreen; // checked color
FColors[2] := clGray; // Border color
FCaptions[0] := 'OFF';
FCaptions[1] := 'ON';
FPicture[0] := TPicture.Create;
FPicture[1] := TPicture.Create;
FCaptions[false] := 'OFF';
FCaptions[true] := 'ON';
FImageListChangeLink := TChangeLink.Create;
FImageListChangeLink.OnChange := @DoImageListChange;
FImageIndex[false] := -1;
FImageIndex[true] := -1;
FPicture[false] := TPicture.Create;
FPicture[true] := TPicture.Create;
FShowCaption := true;
FShowButtonBorder := true;
FShowFocusRect := true;
@ -259,43 +326,13 @@ end;
destructor TCustomOnOffSwitch.Destroy;
begin
FPicture[0].Free;
FPicture[1].Free;
FPicture[false].Free;
FPicture[true].Free;
FImageListChangeLink.Free;
inherited;
end;
function TCustomOnOffSwitch.CalcButtonRect: TRect;
(*
function GetOffset(AMaxSize, ABtnSize: Integer): Integer;
var
pStart, pEnd, margin: Integer;
begin
margin := CalcMargin;
if FInverse xor FChecked then
begin
// Button at right (or bottom), ADelta is negative
pStart := AMaxSize - ABtnSize - margin;
pEnd := margin;
if ADelta < pEnd - pStart then
result := pEnd
else if ADelta > 0 then
result := pStart
else
Result := pStart + ADelta;
end else begin
// Button at left (or top), ADelta is positive
pStart := margin;
pEnd := AMaxSize - ABtnSize - margin;
if ADelta < 0 then
Result := pStart
else if ADelta > pEnd - pStart then
Result := pEnd
else
Result := pStart + ADelta;
end;
end;
*)
begin
Result := FButtonRect;
case Orientation of
@ -369,29 +406,7 @@ begin
DoChange;
end;
end;
{
if FCheckedAfterAnimation xor FInverse then
begin
inc(FMovedDistance, 3);
if FMovedDistance > FMaxDistance then
begin
FMovedDistance := FMaxDistance;
FAnimationTimer.Enabled := false;
FChecked := FCheckedAfterAnimation;
DoChange;
end;
end else
begin
dec(FMovedDistance, 3);
if FMovedDistance < -FMaxDistance then
begin
FMovedDistance := -FMaxDistance;
FAnimationTimer.Enabled := false;
FChecked := FCheckedAfterAnimation;
DoChange;
end;
end;
}
Invalidate;
end;
@ -412,6 +427,11 @@ begin
Invalidate;
end;
procedure TCustomOnOffSwitch.DoImageListChange(Sender: TObject);
begin
Invalidate;
end;
{ Determines whether the dragged distance lands in the part of the
ON (Result = true) or OFF state (Result = false) }
function TCustomOnOffSwitch.DraggedToON: Boolean;
@ -421,6 +441,14 @@ begin
end;
procedure TCustomOnOffSwitch.DrawButton(ARect: TRect);
var
rawON, rawOFF: TRawImage;
Img, ImgOn, ImgOff: TLazIntfImage;
bmp: TBitmap;
ImgSize: TSize;
x, y: Integer;
idx: Integer;
ppi: Integer;
begin
if not Enabled then begin
Canvas.Brush.Color := clGrayText;
@ -430,7 +458,7 @@ begin
Canvas.Brush.Color := Color
else
if (saeBlendColors in FAnimationEffects) then
Canvas.Brush.Color := BlendColors(FButtonPos/FMaxDistance, ColorON, ColorOFF)
Canvas.Brush.Color := BlendColors(FButtonPos/FMaxDistance, ColorOFF, ColorON)
else
if FChecked then
Canvas.Brush.Color := ColorON
@ -449,6 +477,52 @@ begin
Canvas.Ellipse(ARect);
end else
Canvas.Rectangle(ARect);
if FImages <> nil then
begin
ppi := Font.PixelsPerInch;
imgSize := FImages.SizeForPPI[FImagesWidth, ppi];
x := (ARect.Left + ARect.Right - imgSize.CX) div 2;
y := (ARect.Top + ARect.Bottom - imgSize.CY) div 2;
idx := FImageIndex[FChecked];
if idx <> -1 then
begin
if ([saeBlendImages, saeRotateImages] * FAnimationEffects <> []) then
begin
bmp := TBitmap.Create;
try
bmp.PixelFormat := pf32Bit;
rawOFF.Init;
rawON.Init;
FImages.GetRawImage(FImageIndex[false], rawOFF);
FImages.GetRawImage(FImageIndex[true], rawON);
imgON := TLazIntfImage.Create(rawON, false);
imgOFF := TLazIntfImage.Create(rawOFF, false);
img := TLazIntfImage.CreateCompatible(imgOFF, imgOFF.Width, imgOFF.Height);
try
if saeBlendImages in FAnimationEffects then
BlendImages(img, imgOFF, imgON, FButtonPos/FMaxDistance)
else
if FChecked then
img.Assign(imgON)
else
img.Assign(imgOFF);
if saeRotateImages in FAnimationEffects then
RotateImage(img, 2*pi * FButtonPos/FMaxDistance);
bmp.Assign(img);
Canvas.Draw(x, y, bmp);
finally
img.Free;
imgON.Free;
imgOFF.Free;
end;
finally
bmp.Free;
end;
end else
FImages.DrawForPPI(Canvas, x, y, idx, FImagesWidth, ppi, GetCanvasScaleFactor, Enabled);
end;
end;
end;
procedure TCustomOnOffSwitch.DrawCaption(ARect: TRect; AChecked: Boolean);
@ -506,9 +580,9 @@ begin
end;
end;
function TCustomOnOffSwitch.GetCaptions(AIndex: Integer): string;
function TCustomOnOffSwitch.GetCaptions(AChecked: Boolean): string;
begin
Result := FCaptions[AIndex];
Result := FCaptions[AChecked];
end;
function TCustomOnOffSwitch.GetColors(AIndex: Integer): TColor;
@ -522,19 +596,24 @@ begin
Result.CY := 30;
end;
function TCustomOnOffSwitch.GetImageIndex(AChecked: Boolean): TImageIndex;
begin
Result := FImageIndex[AChecked];
end;
function TCustomOnOffSwitch.GetOrientation: TSwitchOrientation;
begin
if Width > Height then Result := soHorizontal else Result := soVertical;
end;
function TCustomOnOffSwitch.GetPicture(AIndex: Integer): TPicture;
function TCustomOnOffSwitch.GetPicture(AChecked: Boolean): TPicture;
begin
Result := FPicture[AIndex];
Result := FPicture[AChecked];
end;
function TCustomOnOffSwitch.HasPicture: Boolean;
begin
Result := (FPicture[0].Width <> 0) or (FPicture[1].Width <> 0);
Result := (FPicture[false].Width <> 0) or (FPicture[true].Width <> 0);
end;
procedure TCustomOnOffSwitch.KeyDown(var Key: Word; Shift: TShiftState);
@ -607,27 +686,33 @@ begin
end;
end;
procedure TCustomOnOffSwitch.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = Images) then
SetImages(nil);
end;
procedure TCustomOnOffSwitch.Paint;
var
R: TRect;
margin: Integer;
diam: Integer;
newChecked: Boolean;
picIdx: Integer;
begin
R := Rect(0, 0, Width, Height);
picIdx := IfThen(FChecked, 1, 0);
if HasPicture then
begin
Canvas.StretchDraw(R, FPicture[picIdx].Graphic);
Canvas.StretchDraw(R, FPicture[FChecked].Graphic);
exit;
end;
if Enabled then begin
if FFlippedColors then begin
if (saeBlendColors in FAnimationEffects) then
Canvas.Brush.Color := BlendColors(FButtonPos/FMaxDistance, ColorON, ColorOFF)
Canvas.Brush.Color := BlendColors(FButtonPos/FMaxDistance, ColorOFF, ColorON)
else
if FChecked then
Canvas.Brush.Color := ColorON
@ -655,25 +740,26 @@ begin
Canvas.Rectangle(1, 1, Width, Height);
bsThin3D, bsThick3D:
begin
Canvas.Pen.Width := 1;
Canvas.Pen.Color := clBtnShadow;
Canvas.Line(R.Right, R.Top, R.Left, R.Top);
Canvas.Line(R.Left, R.Top, R.Right, R.Top);
Canvas.Line(R.Left, R.Top, R.Left, R.Bottom);
if FBorderStyle = bsThick3D then begin
InflateRect(R, -1, -1);
Canvas.Line(R.Right, R.Top, R.Left, R.Top);
Canvas.Line(R.Left, R.Top, R.Left, R.Bottom);
InflateRect(R, +1, +1);
Canvas.Line(R.Left+1, R.Top+1, R.Right-1, R.Top+1);
Canvas.Line(R.Left+1, R.Top+1, R.Left+1, R.Bottom-1);
end;
Canvas.Pen.Color := clBtnHighlight;
Canvas.Line(R.Left, R.Bottom, R.Right, R.Bottom);
Canvas.Line(R.Right, R.Bottom, R.Right, R.Top);
InflateRect(R, -1, -1);
if FBorderStyle = bsThin then
Canvas.FillRect(R)
else begin
Canvas.Line(R.Left, R.Bottom, R.Right, R.Bottom);
Canvas.Line(R.Right, R.Bottom, R.Right, R.Top);
Canvas.Line(R.Left, R.Bottom-1, R.Right, R.Bottom-1);
Canvas.Line(R.Right-1, R.Top, R.Right-1, R.Bottom);
if FBorderStyle = bsThin3D then
begin
InflateRect(R, -1, -1);
Canvas.FillRect(R)
end else
begin
InflateRect(R, -2, -2);
Canvas.Line(R.Left-1, R.Bottom, R.Right+1, R.Bottom);
Canvas.Line(R.Right, R.Top-1, R.Right, R.Bottom);
Canvas.FillRect(R);
end;
end;
@ -783,10 +869,10 @@ begin
Invalidate;
end;
procedure TCustomOnOffSwitch.SetCaptions(AIndex: Integer; AValue: String);
procedure TCustomOnOffSwitch.SetCaptions(AChecked: Boolean; AValue: String);
begin
if AValue = FCaptions[AIndex] then exit;
FCaptions[AIndex] := AValue;
if AValue = FCaptions[AChecked] then exit;
FCaptions[AChecked] := AValue;
Invalidate;
end;
@ -825,6 +911,30 @@ begin
Invalidate;
end;
procedure TCustomOnOffSwitch.SetImageIndex(AChecked: Boolean; AValue: TImageIndex);
begin
if FImageIndex[AChecked] = AValue then Exit;
FImageIndex[AChecked] := AValue;
Invalidate;
end;
procedure TCustomOnOffSwitch.SetImages(const AValue: TCustomImageList);
begin
if FImages = AValue then Exit;
if FImages <> nil then
begin
FImages.UnRegisterChanges(FImageListChangeLink);
FImages.RemoveFreeNotification(Self);
end;
FImages := AValue;
if FImages <> nil then
begin
FImages.FreeNotification(Self);
FImages.RegisterChanges(FImageListChangeLink);
end;
DoImageListChange(Self);
end;
procedure TCustomOnOffSwitch.SetInverse(AValue: boolean);
begin
if AValue = FInverse then exit;
@ -833,14 +943,14 @@ begin
Invalidate;
end;
procedure TCustomOnOffSwitch.SetPicture(AIndex: Integer; AValue: TPicture);
procedure TCustomOnOffSwitch.SetPicture(AChecked: Boolean; AValue: TPicture);
begin
if AValue = FPicture[AIndex] then
if AValue = FPicture[AChecked] then
exit;
if AValue = nil then
FPicture[AIndex].Clear
FPicture[AChecked].Clear
else
FPicture[AIndex].Assign(AValue);
FPicture[AChecked].Assign(AValue);
Invalidate;
end;