贡献一个Delphi的轮播图控件，好用

近来做一个项目，考虑安全性使用Delphi开发，需要轮播图片，考虑后期版权还是自造轮子，话不多说直接上代码。使用就不说了，就几个属性：
Interval：多久轮播一次；

ImageLists：图片列表

ImageExistFilename：图片列表中图片文件不存在的时候显示这个图片，为空时直接绘制一个不存在

注意：目前只支持了PNG，其他 的图片请自行完善其中的TPngImage那里，判断文件类型加载

unit uSwiper;

interface

uses
  System.SysUtils, System.Classes, System.Types, Vcl.Controls, Vcl.ExtCtrls,
  Vcl.StdCtrls,
  Vcl.Imaging.pngimage, Vcl.Imaging.jpeg, Vcl.Graphics, Vcl.ImgList,
  Winapi.CommCtrl;

type

  TSwiper = class(TPaintBox)
  private
    { Private declarations }
    FCurrentImage, FPos: Integer;
    FTimerInterval: Integer;
    FMemo: TMemo;
    FTimer: TTimer;
    FTimer1: TTimer;
    FLines: TStrings;
    FImageExistFilename: String;
    FTmpBmpFirst, FTmpBmpSecond: TBitmap;
  protected
    { Protected declarations }
    procedure onTimer(Sender: TObject);
    procedure onTimer1(Sender: TObject);
    procedure SetInterval(Value: Integer);
    procedure SetLines(Value: TStrings);
    procedure PaintOneImage(Sender: TObject);
    procedure Paint;override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property Interval: Integer read FTimerInterval write SetInterval;
    property ImageLists: TStrings read FLines write SetLines;
    property ImageExistFilename: String read FImageExistFilename write FImageExistFilename;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TSwiper]);
end;

{ TSwiper }

destructor TSwiper.Destroy;
begin
  FTimer.free;
  FTimer1.free;
  FLines.free;
  FTmpBmpFirst.free;
  FTmpBmpSecond.free;
  inherited;
end;

procedure TSwiper.onTimer1(Sender: TObject);
var
  bmpbuff: TBitmap;
begin
  //第一张图
  bmpbuff := TBitmap.Create;

  bmpbuff.Width := Width - FPos;
  bmpbuff.Height := Height;
  bmpbuff.Canvas.CopyRect(Rect(0, 0, bmpbuff.Width, bmpbuff.Height), FTmpBmpFirst.Canvas,
    Rect(FPos, 0, FTmpBmpFirst.Width, FTmpBmpFirst.Height));
  Canvas.StretchDraw(Rect(0, 0, Width-FPos, Height), bmpbuff);

  //第二张图
//  bmpbuff := TBitmap.Create;
  bmpbuff.Canvas.Rectangle(0, 0, bmpbuff.Width, bmpbuff.Height);
  bmpbuff.Width := FPos;
  bmpbuff.Height := Height;
  bmpbuff.Canvas.CopyRect(Rect(0, 0, bmpbuff.Width, bmpbuff.Height), FTmpBmpSecond.Canvas,
    Rect(0, 0, FPos, FTmpBmpSecond.Height));
  Canvas.StretchDraw(Rect(Width-FPos, 0, Width, Height), bmpbuff);
  bmpbuff.Destroy;

  // 计算宽度与循环次数，1秒内循环完成，1000/width
  FPos := FPos + Width div 25;
  // Inc(FPos);
  if (FPos > Width) or ((Width - FPos) < (Width div 25)) then
  begin
    FPos := 0;
    FTimer1.Enabled := false;
    FCurrentImage := FCurrentImage + 1;
    if FCurrentImage >= FLines.Count then
      FCurrentImage := 0;

    PaintOneImage(self);
  end;
end;

procedure TSwiper.Paint;
begin
  inherited;
  if not FTimer1.Enabled then
  begin
    PaintOneImage(self);
  end;
  if FTimer.Enabled then  exit;

  if FLines.Count > 0 then  begin
    if FCurrentImage<0 then
      FCurrentImage := 0;
    PaintOneImage(self);
    FTimer.Enabled := true;
  end;
end;

procedure TSwiper.PaintOneImage(Sender: TObject);
var
  bmp: TBitmap;
  g: TGraphic;
  fname,sError: String;
begin

  sError :='文件不存在';
  if (FCurrentImage >= 0) and (FLines.Count > 0) then
  begin
    fname := FImageExistFilename;
    if not FileExists(FLines[FCurrentImage]) then
    begin
      if not FileExists(fname) then
      begin
        with Canvas do begin
          Brush.Color := clSkyBlue;
          FillRect(Rect(0,0,Width,Height));
          moveTo(0,0);lineTo(Width,Height);MoveTo(0,Height);lineTo(Width,0);
          TextOut((Width div 2) - (TextWidth(sError) div 2),(Height div 2) - (Textheight(sError) div 2),sError);
        end;
        exit;
      end;
    end else
      fname := FLines[FCurrentImage];

    g := TPngImage.Create;
    g.LoadFromFile(fname);
    bmp := TBitmap.Create;
    bmp.Width := Width;
    bmp.Height := Height;
    bmp.Canvas.StretchDraw(Rect(0, 0, Width, Height), g); // 源图复制过来，改变格式

    Canvas.StretchDraw(TRect.Create(0, 0, Width, Height), bmp);
    g.Destroy;
    bmp.Destroy;
  end;
end;

procedure TSwiper.onTimer(Sender: TObject);
var
  g: TGraphic;
  fname,sError: String;
begin
  sError := '文件不存在';
  if FLines.Count <= 1 then
    exit;
  FTmpBmpFirst.Width := Width;
  FTmpBmpFirst.Height := Height;
  FTmpBmpSecond.Width := Width;
  FTmpBmpSecond.Height := Height;
  g := TPngImage.Create;
  // 取第一张图
  fname := FImageExistFilename;
  if FileExists(FLines[FCurrentImage]) then
    fname := FLines[FCurrentImage];
  if FileExists(fname) then
  begin
    g.LoadFromFile(fname);
    FTmpBmpFirst.Canvas.StretchDraw(Rect(0, 0, Width, Height), g); // 源图复制过来，改变格式
  end else begin
    with FTmpBmpFirst.Canvas do begin
      Brush.Color := clSkyBlue;
      FillRect(Rect(0,0,Width,Height));
      moveTo(0,0);lineTo(Width,Height);MoveTo(0,Height);lineTo(Width,0);
      TextOut((Width div 2) - (TextWidth(sError) div 2),(Height div 2) - (Textheight(sError) div 2),sError);
    end;
  end;
  // 取第二张图
  g.Destroy;
  g := TPngImage.Create;
  fname := FImageExistFilename;
  if FCurrentImage = FLines.Count - 1 then
  begin
    if FileExists(FLines[0]) then
      fname := FLines[0];
  end
  else if FileExists(FLines[FCurrentImage + 1]) then
    fname := FLines[FCurrentImage + 1];
  if FileExists(fname) then
  begin
    g.LoadFromFile(fname);
    FTmpBmpSecond.Canvas.StretchDraw(Rect(0, 0, Width, Height), g); // 源图复制过来，改变格式
  end else begin
    with FTmpBmpSecond.Canvas do begin
      Brush.Color := clSkyBlue;
      FillRect(Rect(0,0,Width,Height));
      moveTo(0,0);lineTo(Width,Height);MoveTo(0,Height);lineTo(Width,0);
      TextOut((Width div 2) - (TextWidth(sError) div 2),(Height div 2) - (Textheight(sError) div 2),sError);
    end;
  end;
  FTimer1.Enabled := true;
  g.Destroy;
end;

procedure TSwiper.SetInterval(Value: Integer);
var
  oldVal: Boolean;
begin
  oldVal := FTimer.Enabled;
  if oldVal then
    FTimer.Enabled := false;
  FTimerInterval := Value;
  FTimer.Interval := Value;
  if oldVal then
    FTimer.Enabled := true;
end;

procedure TSwiper.SetLines(Value: TStrings);
begin
  if Assigned(FLines) then
    FLines.Assign(Value)
  else
    FLines := Value;

  // Invalidate;
  if FLines.Count = 0 then
    exit
  else if FLines.Count = 1 then
  begin
    FCurrentImage := 0;
    OnPaint := PaintOneImage;
  end
  else if FLines.Count > 1 then
  begin
    FCurrentImage := 0;
    OnPaint := PaintOneImage;
    FTimer.Enabled := true;
  end;
end;

constructor TSwiper.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 300;
  Height := 150;

  FTimer := TTimer.Create(self);
  FTimer.Name := '_TTimer';
  FTimerInterval := 2000;
  FTimer.Interval := FTimerInterval;
  FTimer.onTimer := onTimer;
  FTimer.Enabled := false;

  FTimer1 := TTimer.Create(self);
  FTimer1.Name := '_TTimer1';
  FTimer1.Interval := 1;
  FTimer1.onTimer := onTimer1;
  FTimer1.Enabled := false;

  FCurrentImage := -1;
  FPos := 0;

  FLines := TStringList.Create;
  FTmpBmpFirst := TBitmap.Create;
  FTmpBmpSecond := TBitmap.Create;
  FImageExistFilename := '';
end;

end.