diff --git a/components/industrialstuff/source/switches.pas b/components/industrialstuff/source/switches.pas index d309d8781..592419a41 100644 --- a/components/industrialstuff/source/switches.pas +++ b/components/industrialstuff/source/switches.pas @@ -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;