123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869 |
- // ***************************************************************************
- //
- // FMXComponents: Firemonkey Opensource Components Set from China
- //
- // A Simple Firemonkey Image Slider Component
- //
- // Copyright 2017 谢顿 (zhaoyipeng@hotmail.com)
- //
- // https://github.com/zhaoyipeng/FMXComponents
- //
- // ***************************************************************************
- // version history
- // 2017-01-20, v0.1.0.0 : first release
- // 2018-01-31, v0.2.0.0 : merged with loko's change
- // 2018-03-21, v0.3.0.0 : merged with kwon hwang-jung's change 2018-03-02
- // 1. add three Add methods to add bitmap directly
- // 2. add Next, Prev methods
- // 3. add AutoSlider property can auto slide
- // 4. add TimerInterval to control AutoSlider interval
- // 5. use ActivePage property move page, ex)ActivePage := 1
- // 6. add Datas property, can set tagstring on each page
- // 2018-03-21, v0.4.0.0 : merged with Mikkao's change 2018-03-01
- // 1. change OnPageChange event to TPageChangeEvent
- // 2. add OnPageAnimationFinish event
- // 3. add OnCanDragBegin event
- // 2018-03-21, v0.5.0.0 :
- // 1. rewrite slide method, now can support loop
- // 2018-03-22, v0.6.0.0 :
- // 1. add dot indicator, support dynamic change dot active/inactive color
- unit FMX.ImageSlider;
- interface
- {$I FMXComponents.inc}
- uses
- System.Classes,
- System.Generics.Collections,
- System.Types,
- System.UITypes,
- System.SysUtils,
- FMX.Types,
- FMX.Controls,
- FMX.Layouts,
- FMX.Objects,
- FMX.Ani,
- FMX.Utils,
- FMX.Graphics,
- FMX.ComponentsCommon,
- UI.Base, UI.Standard;
- type
- TPageChangeEvent = procedure(Sender: TObject; NewPage, OldPage: Integer) of object;
- TPageAnimationFinishEvent = procedure(Sender: TObject; NewPage: Integer) of object;
- TCanBeginDragEvent = procedure(Sender: TObject; var CanBegin: Boolean) of object;
- TFMXImageSlider = class;
- TSliderDots = class(TControl)
- private
- FDotContainer: TLayout;
- FDotSize: Single;
- FActiveColor: TAlphaColor;
- FInActiveColor: TAlphaColor;
- FActiveIndex: Integer;
- procedure SetDotCount(const Value: Integer);
- function GetDotCount: Integer;
- procedure CreateDotShape;
- procedure SetDotSize(const Value: Single);
- procedure SetActiveColor(const Value: TAlphaColor);
- procedure SetInActiveColor(const Value: TAlphaColor);
- procedure SetActiveIndex(const Value: Integer);
- protected
- procedure HitTestChanged; override;
- function GetDot(Index: Integer): TControl;
- {$IFDEF VER320_up}
- procedure DoResized; override;
- {$ELSE}
- procedure Resize; override;
- {$ENDIF}
- public
- constructor Create(AOwner: TComponent); override;
- property ActiveIndex: Integer read FActiveIndex write SetActiveIndex;
- property DotCount: Integer read GetDotCount write SetDotCount;
- property DotSize: Single read FDotSize write SetDotSize;
- property ActiveColor: TAlphaColor read FActiveColor write SetActiveColor;
- property InActiveColor: TAlphaColor read FInActiveColor write SetInActiveColor;
- end;
- [ComponentPlatformsAttribute(TFMXPlatforms)]
- TFMXImageSlider = class(TLayout)
- private
- FContainer: TControl;
- FIsTimer: Boolean;
- FAutoSlider: Boolean;
- FTimer: TTimer;
- FPages: TList<TControl>;
- FActivePage: Integer;
- FIsMove: Boolean;
- FStartDrag: Boolean;
- FBeforeDrag: Boolean;
- FDownPos: TPointF;
- FDownIndex: Integer;
- FAnimation: TAnimation;
- FOnPageAnimationFinish: TPageAnimationFinishEvent;
- FOnCanDragBegin: TCanBeginDragEvent;
- FOnItemTap: TTapEvent;
- FOnItemClick: TNotifyEvent;
- FOnPageChange: TPageChangeEvent;
- FAnimationInterval: Integer;
- FTransitionLayouts: array of TControl;
- FTranstionIsIn: Boolean;
- FTranstionStartX: Single;
- FDots: TSliderDots;
- FIsCanDrag: Boolean;
- procedure MoveToActivePage(IsIn: Boolean = True);
- procedure OnTimer(Sender: TObject);
- procedure AnimationProcess(Sender: TObject);
- procedure AnimationFinished(Sender: TObject);
- function GetAnimateDuration: Single;
- function GetDatas(Index: Integer): string;
- function GetPageCount: Integer;
- function GetTimerInterval: Integer;
- procedure SetActivePage(const Value: Integer); { change }
- procedure SetAnimateDuration(const Value: Single);
- procedure SetAutoSlider(const Value: Boolean);
- procedure SetPageCount(const Value: Integer);
- procedure SetDatas(Index: Integer; const Value: string);
- function SetDragBegin: Boolean;
- function GetDotsVisible: Boolean;
- procedure SetDotsVisible(const Value: Boolean);
- function GetDotActiveColor: TAlphaColor;
- function GetDotInActiveColor: TAlphaColor;
- procedure SetDotActiveColor(const Value: TAlphaColor);
- procedure SetDotInActiveColor(const Value: TAlphaColor);
- protected
- procedure SetTimerInterval(const Value: Integer);
- {$IFDEF VER320_up}
- procedure DoResized; override;
- {$ELSE}
- procedure Resize; override;
- {$ENDIF}
- procedure DoPageChange(NewPage, OldPage: Integer);
- procedure DoTap(Sender: TObject; const Point: TPointF);
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
- procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
- procedure AddImage(const Value: string; Image: TImageView);
- procedure AddPage(const Value: string; Page: TControl);
- procedure PrepareSlide(DeltaX: Single); overload;
- procedure PrepareSlide(IsIn: Boolean); overload;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure SetPage(Index: Integer; AImage: TImageView);
- procedure Add(Bitmap: TBitmap); overload; //add bitmap
- procedure Add(Value: string; Bitmap: TBitmap); overload; //add bitmap and value
- procedure Add(Value: string; Bitmap: TStream); overload; //add bitmap stream and value
- procedure Clear; //Page Clear;
- procedure Prev; //Previous Page
- procedure Next; //Next Page
- property Datas[Index: Integer]: string read GetDatas write SetDatas; //Page value(ex 0page = Datas[0])
- property IsCanDrag: Boolean read FIsCanDrag write FIsCanDrag default True;
- published
- property Align;
- property Height;
- property Position;
- property Width;
- property ActivePage: Integer read FActivePage write SetActivePage; //page move
- property AnimateDuration: Single read GetAnimateDuration write SetAnimateDuration;
- property AutoSlider: Boolean read FAutoSlider write SetAutoSlider; //auto slider property
- property DotActiveColor: TAlphaColor read GetDotActiveColor write SetDotActiveColor;
- property DotInActiveColor: TAlphaColor read GetDotInActiveColor write SetDotInActiveColor;
- property DotsVisible: Boolean read GetDotsVisible write SetDotsVisible;
- property PageCount: Integer read GetPageCount write SetPageCount;
- property TimerInterval: Integer read GetTimerInterval write SetTimerInterval; //auto slider timer
- property OnCanDragBegin: TCanBeginDragEvent read FOnCanDragBegin write FOnCanDragBegin;
- property OnItemClick: TNotifyEvent read FOnItemClick write FOnItemClick; //page click event(use Desktop)
- property OnItemTap: TTapEvent read FOnItemTap write FOnItemTap; //page tab event(use Mobile, Pad)
- property OnPageChange: TPageChangeEvent read FOnPageChange write FOnPageChange;
- property OnPageAnimationFinish: TPageAnimationFinishEvent read FOnPageAnimationFinish write FOnPageAnimationFinish;
- end;
- implementation
- type
- TMyAnimation = class(TAnimation)
- protected
- procedure ProcessAnimation; override;
- end;
- { TFMXImageSlider }
- procedure TFMXImageSlider.Add(Bitmap: TBitmap);
- begin
- Add('', Bitmap);
- end;
- procedure TFMXImageSlider.Add(Value: String; Bitmap: TBitmap);
- var
- Img : TImageView;
- begin
- Img := TImageView.Create(Self);
- Img.Image.SetBitmap(TViewState.None, Bitmap);
- AddImage(Value, Img);
- end;
- procedure TFMXImageSlider.Add(Value: String; Bitmap: TStream);
- var
- Img : TImageView;
- Bmp: TBitmap;
- begin
- Img := TImageView.Create(Self);
- Bmp := TBitmap.Create;
- try
- Bmp.LoadFromStream(Bitmap);
- Img.Image.SetBitmap(TViewState.None, Bmp);
- finally
- FreeAndNil(Bmp);
- end;
- AddImage(Value, Img);
- end;
- procedure TFMXImageSlider.AddImage(const Value: string; Image: TImageView);
- var
- Page: TLayout;
- begin
- Page := TLayout.Create(Self);
- Image.Stored := False;
- Image.ScaleType := TImageScaleType.CenterCrop;
- Image.Parent := Page;
- Image.HitTest := False;
- Image.Align := TAlignLayout.Client;
- AddPage(Value, Page);
- end;
- procedure TFMXImageSlider.AddPage(const Value: string; Page: TControl);
- begin
- Page.Parent := FContainer;
- Page.SetBounds(0,0, FContainer.Width, FContainer.Height);
- Page.Stored := False;
- Page.Visible := False;
- Page.TagString := Value;
- Page.Tag := FPages.Add(Page);
- FDots.DotCount := PageCount;
- end;
- procedure TFMXImageSlider.Clear;
- var
- I: Integer;
- begin
- for I := FPages.Count-1 downto 0 do
- begin
- FPages[I].DisposeOf;
- end;
- FPages.Clear;
- ActivePage := -1;
- FDots.DotCount := PageCount;
- end;
- constructor TFMXImageSlider.Create(AOwner: TComponent);
- begin
- inherited;
- FContainer := TControl.Create(Self);
- FContainer.Align := TAlignLayout.Client;
- FContainer.Stored := False;
- FContainer.HitTest := False;
- FContainer.ClipChildren := True;
- FContainer.Parent := Self;
- FDots := TSliderDots.Create(Self);
- FDots.Stored := False;
- FDots.SetBounds(0, FContainer.Height - FDots.Height, FContainer.Width, FDots.Height);
- FDots.Parent := Self;
- FTimer := TTimer.Create(Self);
- FTimer.Interval := 1000 * 5;
- FTimer.Enabled := False;
- FTimer.OnTimer := OnTimer;
- FAutoSlider := False;
- FAnimation := TMyAnimation.Create(Self);
- FAnimation.Stored := False;
- FAnimation.Interpolation := TInterpolationType.Quintic;
- FAnimation.Parent := Self;
- FAnimation.Duration := 0.2;
- FAnimation.OnProcess := AnimationProcess;
- FAnimation.OnFinish := AnimationFinished;
- FPages := TList<TControl>.Create;
- HitTest := True;
- FActivePage := -1;
- FStartDrag := False;
- AutoCapture := True;
- FIsCanDrag := True;
- end;
- destructor TFMXImageSlider.Destroy;
- begin
- FPages.Free;
- inherited;
- end;
- procedure TFMXImageSlider.DoPageChange(NewPage, OldPage: Integer);
- begin
- if Assigned(FOnPageChange) then
- FOnPageChange(Self, NewPage, OldPage);
- end;
- procedure TFMXImageSlider.DoTap(Sender: TObject; const Point: TPointF);
- begin
- if Assigned(FOnItemTap) then FOnItemTap(Sender, Point);
- end;
- function TFMXImageSlider.GetAnimateDuration: Single;
- begin
- Result := FAnimation.Duration;
- end;
- function TFMXImageSlider.GetDatas(Index: Integer): string;
- begin
- Result := FPages[Index].TagString;
- end;
- function TFMXImageSlider.GetDotActiveColor: TAlphaColor;
- begin
- Result := FDots.ActiveColor;
- end;
- function TFMXImageSlider.GetDotInActiveColor: TAlphaColor;
- begin
- Result := FDots.InActiveColor;
- end;
- function TFMXImageSlider.GetDotsVisible: Boolean;
- begin
- Result := FDots.Visible;
- end;
- function TFMXImageSlider.GetPageCount: Integer;
- begin
- Result := FPages.Count;
- end;
- function TFMXImageSlider.GetTimerInterval: Integer;
- begin
- Result := FTimer.Interval;
- end;
- procedure TFMXImageSlider.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
- begin
- inherited;
- FIsTimer := FTimer.Enabled;
- if FIsTimer then
- FTimer.Enabled := False;
- FIsMove := False;
- if IsCanDrag and (PageCount > 0) and (Button = TMouseButton.mbLeft) then
- begin
- FStartDrag := True;
- FBeforeDrag := True;
- FDownPos := PointF(X, Y);
- FDownIndex := FActivePage;
- end;
- end;
- procedure TFMXImageSlider.MouseMove(Shift: TShiftState; X, Y: Single);
- var
- DeltaX: Single;
- begin
- inherited;
- if FStartDrag then
- begin
- if FBeforeDrag and not SetDragBegin then
- exit;
- if Abs(FDownPos.X - X) > 5 then
- FIsMove := True;
- DeltaX := X - FDownPos.X;
- PrepareSlide(DeltaX);
- end;
- end;
- procedure TFMXImageSlider.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
- var
- DeltaX: Single;
- PrevPage: Integer;
- begin
- inherited;
- if (not FIsMove) and (FStartDrag or not IsCanDrag) then
- begin
- if FIsTimer then
- FTimer.Enabled := True;
- FStartDrag := False;
- if Assigned(FOnItemClick) then
- FOnItemClick(FPages[Self.ActivePage]);
- if Assigned(FOnItemTap) then
- FOnItemTap(FPages[Self.ActivePage], PointF(X, Y));
- Exit;
- end;
- if FStartDrag then
- begin
- FStartDrag := False;
- DeltaX := X - FDownPos.X;
- if (Abs(DeltaX) > Width * 0.4) and (PageCount > 0) then
- begin
- if (DeltaX > 0) then
- begin
- PrevPage := FActivePage;
- FActivePage := (FActivePage + PageCount - 1) mod PageCount;
- end
- else
- begin
- PrevPage := FActivePage;
- FActivePage := (FActivePage + 1) mod PageCount;
- end;
- DoPageChange(FActivePage, PrevPage);
- MoveToActivePage(DeltaX < 0);
- end
- else
- begin
- MoveToActivePage(DeltaX > 0);
- end;
- if FIsTimer then
- FTimer.Enabled := True;
- end;
- end;
- procedure TFMXImageSlider.MoveToActivePage(IsIn: Boolean);
- begin
- PrepareSlide(IsIn);
- FAnimation.Start;
- end;
- procedure TFMXImageSlider.Next;
- var
- PrevPage: Integer;
- begin
- if (PageCount < 2) or (FAnimation.Running) then Exit;
- PrevPage := FActivePage;
- FActivePage := (FActivePage + 1) mod PageCount;
- DoPageChange(FActivePage, PrevPage);
- MoveToActivePage(True);
- end;
- procedure TFMXImageSlider.OnTimer(Sender: TObject);
- begin
- Next;
- end;
- procedure TFMXImageSlider.PrepareSlide(DeltaX: Single);
- var
- Layout1, Layout2: TControl;
- Index2: Integer;
- begin
- Layout1 := FPages[FActivePage];
- Layout1.Position.X := DeltaX;
- if PageCount > 0 then
- begin
- if DeltaX > 0 then
- // Find the left page
- Index2 := (FActivePage + PageCount - 1) mod PageCount
- else
- Index2 := (FActivePage + 1) mod PageCount;
- Layout2 := FPages[Index2];
- Layout2.Visible := True;
- if DeltaX > 0 then
- Layout2.Position.X := Layout1.Position.X - Width
- else
- Layout2.Position.X := Layout1.BoundsRect.Right;
- end;
- end;
- procedure TFMXImageSlider.PrepareSlide(IsIn: Boolean);
- var
- Layout1, Layout2: TControl;
- Index2: Integer;
- X: Single;
- begin
- FTranstionIsIn := IsIn;
- Layout1 := FPages[FActivePage];
- if Layout1.Visible then
- FTranstionStartX := Layout1.Position.X
- else
- begin
- if IsIn then
- FTranstionStartX := Width
- else
- FTranstionStartX := -Width;
- Layout1.SetBounds(FTranstionStartX, 0, Width, Height);
- Layout1.Visible := true;
- end;
- if PageCount > 1 then
- begin
- if IsIn then
- Index2 := (FActivePage + PageCount - 1) mod PageCount
- else
- Index2 := (FActivePage + 1) mod PageCount;
- Layout2 := FPages[Index2];
- Layout2.Visible := True;
- if IsIn then
- X := Layout1.Position.X - Width
- else
- X := Layout1.BoundsRect.Right;
- Layout2.SetBounds(X, 0, Width, Height);
- SetLength(FTransitionLayouts, 2);
- FTransitionLayouts[0] := Layout1;
- FTransitionLayouts[1] := Layout2;
- end
- else
- begin
- SetLength(FTransitionLayouts, 1);
- FTransitionLayouts[0] := Layout1;
- end;
- end;
- procedure TFMXImageSlider.Prev;
- var
- PrevPage: Integer;
- begin
- if (PageCount < 2) or (FAnimation.Running) then Exit;
- PrevPage := FActivePage;
- FActivePage := (FActivePage - 1 + PageCount) mod PageCount;
- DoPageChange(FActivePage, PrevPage);
- MoveToActivePage(False);
- end;
- {$IFDEF VER320_up}
- procedure TFMXImageSlider.DoResized;
- {$ELSE}
- procedure TFMXImageSlider.Resize;
- {$ENDIF}
- var
- I: Integer;
- begin
- inherited;
- for I := 0 to FPages.Count - 1 do
- begin
- FPages[I].Width := FContainer.Width;
- FPages[I].Height := FContainer.Height;
- end;
- FDots.SetBounds(0, FContainer.Height - FDots.Height, FContainer.Width, FDots.Height);
- end;
- procedure TFMXImageSlider.SetActivePage(const Value: Integer);
- var
- IsIn: Boolean;
- PrevPage, Delta: Integer;
- begin
- if (Value < 0) or (Value > FPages.Count - 1) then // check if value valid
- exit;
- if FActivePage <> Value then
- begin
- PrevPage := FActivePage;
- if FActivePage = -1 then
- begin
- FActivePage := Value;
- FPages[FActivePage].SetBounds(0,0,Width,Height);
- FPages[FActivePage].Visible := True;
- DoPageChange(FActivePage, PrevPage);
- FDots.ActiveIndex := FActivePage;
- end
- else
- begin
- Delta := Abs(FActivePage - Value);
- // if current active page not neighbor of new active page, hide current page
- if (Delta <> 1) and (Delta <> (PageCount-1)) then
- FPages[FActivePage].Visible := False;
- IsIn := FActivePage < Value;
- FActivePage := Value; // set FActivePage
- DoPageChange(FActivePage, PrevPage);
- MoveToActivePage(IsIn);
- end;
- end;
- end;
- procedure TFMXImageSlider.SetAnimateDuration(const Value: Single);
- begin
- FAnimation.Duration := Value;
- end;
- procedure TFMXImageSlider.AnimationFinished(Sender: TObject);
- begin
- if FTransitionLayouts[0].Tag = FActivePage then
- begin
- if Length(FTransitionLayouts) = 2 then
- FTransitionLayouts[1].Visible := False;
- end
- else
- begin
- FTransitionLayouts[0].Visible := False;
- end;
- If Assigned(FOnPageAnimationFinish) then
- FOnPageAnimationFinish(Self, FActivePage);
- FBeforeDrag := True;
- FDots.ActiveIndex := FActivePage;
- end;
- procedure TFMXImageSlider.AnimationProcess(Sender: TObject);
- var
- Start, Stop: Single;
- begin
- Start := FTranstionStartX;
- Stop := 0;
- FTransitionLayouts[0].Position.X :=
- InterpolateSingle(Start, Stop, FAnimation.NormalizedTime);
- if Length(FTransitionLayouts) = 2 then
- begin
- if FTranstionIsIn then
- FTransitionLayouts[1].Position.X := FTransitionLayouts[0].Position.X - Width
- else
- FTransitionLayouts[1].Position.X := FTransitionLayouts[0].BoundsRect.Right;
- end;
- end;
- function TFMXImageSlider.SetDragBegin: Boolean;
- var
- CanBeginDrag: Boolean;
- begin
- Result := True;
- if Assigned(FOnCanDragBegin) then
- begin
- FBeforeDrag := False;
- FOnCanDragBegin(Self, CanBeginDrag);
- Result := CanBeginDrag;
- end;
- end;
- procedure TFMXImageSlider.SetAutoSlider(const Value: Boolean);
- begin
- FAutoSlider := Value;
- FTimer.Enabled := Value;
- end;
- procedure TFMXImageSlider.SetDatas(Index: Integer; const Value: string);
- begin
- FPages[Index].TagString := Value;
- end;
- procedure TFMXImageSlider.SetDotActiveColor(const Value: TAlphaColor);
- begin
- FDots.ActiveColor := Value;
- end;
- procedure TFMXImageSlider.SetDotInActiveColor(const Value: TAlphaColor);
- begin
- FDots.InActiveColor := Value;
- end;
- procedure TFMXImageSlider.SetDotsVisible(const Value: Boolean);
- begin
- FDots.Visible := Value;
- end;
- procedure TFMXImageSlider.SetPage(Index: Integer; AImage: TImageView);
- begin
- if (Index >= 0) and (Index < PageCount) then
- begin
- AImage.HitTest := False;
- AImage.Parent := FPages[Index];
- AImage.Align := TAlignLayout.Client;
- end;
- end;
- procedure TFMXImageSlider.SetPageCount(const Value: Integer);
- var
- OldCount: Integer;
- I: Integer;
- L: TControl;
- begin
- if Value <> PageCount then
- begin
- OldCount := PageCount;
- if OldCount < Value then
- begin
- for I := OldCount + 1 to Value do
- begin
- AddPage('', TLayout.Create(Self));
- end;
- end
- else if OldCount > Value then
- begin
- for I := OldCount - 1 downto Value do
- begin
- L := FPages[I];
- L.DisposeOf;
- end;
- FPages.Count := Value;
- end;
- if Value > 0 then
- begin
- ActivePage := 0;
- end
- else
- begin
- ActivePage := -1;
- end;
- end;
- end;
- procedure TFMXImageSlider.SetTimerInterval(const Value: Integer);
- begin
- FTimer.Interval := Value;
- end;
- { TMyAnimation }
- procedure TMyAnimation.ProcessAnimation;
- begin
- end;
- { TSliderDots }
- constructor TSliderDots.Create(AOwner: TComponent);
- begin
- inherited;
- FDotSize := 12;
- FActiveIndex := -1;
- FDotContainer := TLayout.Create(Self);
- FDotContainer.Stored := False;
- FDotContainer.Height := FDotSize;
- FDotContainer.HitTest := False;
- FDotContainer.Parent := Self;
- FInActiveColor := $FFDDDDDD;
- FActiveColor := $FF00B4FF;
- HitTest := False;
- Height := FDotSize * 2;
- end;
- procedure TSliderDots.CreateDotShape;
- var
- Dot: TShape;
- X, W: Single;
- B: TRectF;
- begin
- X := DotCount * DotSize * 2;
- Dot := TCircle.Create(Self);
- Dot.HitTest := False;
- Dot.SetBounds(X, 0, DotSize, DotSize);
- Dot.Stroke.Kind := TBrushKind.None;
- Dot.Fill.Kind := TBrushKind.Solid;
- Dot.Fill.Color := FInActiveColor;
- Dot.Parent := FDotContainer;
- X := (Self.Width - FDotContainer.Width) / 2;
- W := (DotCount * 2 - 1) * DotSize;
- B := TRectF.Create(X, 0, X + W, DotSize);
- if Assigned(Scene) then //fixed by kngstr
- B := B.SnapToPixel(Scene.GetSceneScale, False);
- FDotContainer.BoundsRect := B;
- end;
- {$IFDEF VER320_up}
- procedure TSliderDots.DoResized;
- {$ELSE}
- procedure TSliderDots.Resize;
- {$ENDIF}
- var
- X, W: Single;
- B: TRectF;
- begin
- inherited;
- X := (Self.Width - FDotContainer.Width) / 2;
- W := (DotCount * 2 - 1) * DotSize;
- B := TRectF.Create(X, 0, X + W, DotSize);
- // B := B.SnapToPixel(Scene.GetSceneScale, False);
- FDotContainer.BoundsRect := B;
- end;
- function TSliderDots.GetDot(Index: Integer): TControl;
- begin
- Result := TControl(FDotContainer.Children[Index]);
- end;
- function TSliderDots.GetDotCount: Integer;
- begin
- Result := FDotContainer.ChildrenCount;
- end;
- procedure TSliderDots.HitTestChanged;
- begin
- inherited;
- end;
- procedure TSliderDots.SetActiveColor(const Value: TAlphaColor);
- begin
- if FActiveColor <> Value then
- begin
- FActiveColor := Value;
- if (FActiveIndex >= 0) and (FActiveIndex < GetDotCount) then
- begin
- (GetDot(FActiveIndex) as TShape).Fill.Color := FActiveColor;
- end;
- end;
- end;
- procedure TSliderDots.SetActiveIndex(const Value: Integer);
- begin
- if FActiveIndex <> Value then
- begin
- if (FActiveIndex >= 0) and (FActiveIndex < DotCount) then
- begin
- (GetDot(FActiveIndex) as TShape).Fill.Color := FInActiveColor;
- end;
- FActiveIndex := Value;
- if (FActiveIndex >= 0) and (FActiveIndex < DotCount) then
- begin
- (GetDot(FActiveIndex) as TShape).Fill.Color := FActiveColor;
- end;
- end;
- end;
- procedure TSliderDots.SetDotCount(const Value: Integer);
- var
- OldCount: Integer;
- I: Integer;
- Dot: TFMXObject;
- begin
- if Value <> DotCount then
- begin
- OldCount := DotCount;
- if OldCount < Value then
- begin
- for I := OldCount + 1 to Value do
- begin
- CreateDotShape;
- end;
- end
- else
- begin
- for I := OldCount - 1 downto Value do
- begin
- Dot := FDotContainer.Children[I];
- Dot.DisposeOf;
- end;
- end;
- end;
- end;
- procedure TSliderDots.SetDotSize(const Value: Single);
- begin
- if FDotSize <> Value then
- begin
- FDotSize := Value;
- FDotContainer.Height := FDotSize;
- Height := FDotSize * 3;
- end;
- end;
- procedure TSliderDots.SetInActiveColor(const Value: TAlphaColor);
- var
- I: Integer;
- Dot: TShape;
- begin
- if FInActiveColor <> Value then
- begin
- FInActiveColor := Value;
- for I := 0 to DotCount-1 do
- begin
- if I <> FActiveIndex then
- begin
- Dot := GetDot(I) as TShape;
- Dot.Fill.Color := FInActiveColor;
- end;
- end;
- end;
- end;
- end.
|