RVGifAnimate.pas
上传用户:daoqigc
上传日期:2021-04-20
资源大小:2795k
文件大小:9k
源码类别:

RichEdit

开发平台:

Delphi

  1. {*******************************************************}
  2. {                                                       }
  3. {       RichView                                        }
  4. {       TRVGifImageAnimator: displaying animation for   }
  5. {       TGifImage by Anders Melander.                   }
  6. {                                                       }
  7. {       Copyright (c) Sergey Tkachenko                  }
  8. {       svt@trichview.com                               }
  9. {       http://www.trichview.com                        }
  10. {                                                       }
  11. {*******************************************************}
  12. {$I RV_Defs.inc}
  13. unit RVGifAnimate;
  14. interface
  15. {$IFNDEF RVDONOTUSEANIMATION}
  16. uses Windows, Classes, Graphics, DLines,
  17.      CRVFData, RVAnimate, RVItem, GifImage;
  18. type
  19.   { ---------------------------------------------------------------------------
  20.     TRVGifImageAnimator: displaying animations for gif images
  21.     (using TGifImage by Anders Melander)
  22.     Variables:
  23.       bmp: the current frame of animation
  24.       bmpsrc: background under the image (if it is not a plain color, otherwise
  25.         it's nil)
  26.       FX, FY - the stored values of image position. Used to check if the image
  27.         is moved.
  28.       FParaNo - the stored value of paragraph image. Used to check if the
  29.         paragraph is changed (may be it's background was changed?)
  30.       FLastDrawnFrameIndex - index of the frame drawn in bmp.
  31.   }
  32.   TRVGifImageAnimator = class (TRVAnimator)
  33.     private
  34.       bmp, bmpsrc: TBitmap;
  35.       FBackColor: TColor;
  36.       FX,FY, FParaNo, FLastDrawnFrameIndex: Integer;
  37.       procedure CalcInterval;
  38.     protected
  39.       function GetFrameCount: Integer; override;
  40.       procedure ResetBackground; override;
  41.     public
  42.       destructor Destroy; override;
  43.       procedure Reset; override;
  44.       procedure ChangeFrame; override;
  45.       procedure Draw(X, Y: Integer; Canvas: TCanvas; Animation: Boolean); override;
  46.   end;
  47. {$ENDIF}
  48. implementation
  49. {$IFNDEF RVDONOTUSEANIMATION}
  50. {================================= TRVGifImageAnimator ========================}
  51. { Destructor }
  52. destructor TRVGifImageAnimator.Destroy;
  53. begin
  54.   bmp.Free;
  55.   bmpsrc.Free;
  56.   inherited;
  57. end;
  58. {------------------------------------------------------------------------------}
  59. { Determines how long to display the current frame. }
  60. procedure TRVGifImageAnimator.CalcInterval;
  61. var gif: TGifImage;
  62. begin
  63.   gif := TGifImage(TRVGraphicItemInfo(item).Image);
  64.   Interval := 10; //GIFDefaultDelay;
  65.   if gif.Images[FrameIndex].GraphicControlExtension.Delay > 0 then begin
  66.     Interval := gif.Images[FrameIndex].GraphicControlExtension.Delay;
  67.     if (Interval < GIFMinimumDelay) then
  68.       Interval := GIFMinimumDelay;
  69.     if (Interval > GIFMaximumDelay) then
  70.       Interval := GIFMaximumDelay;
  71.   end;
  72.   Interval := Interval*10;
  73. end;
  74. {------------------------------------------------------------------------------}
  75. { Change frame to the next one. Updates Interval. }
  76. procedure TRVGifImageAnimator.ChangeFrame;
  77. begin
  78.   CalcNextFrameIndex;
  79.   CalcInterval;
  80. end;
  81. {------------------------------------------------------------------------------}
  82. { Clears the stored background info }
  83. procedure TRVGifImageAnimator.ResetBackground;
  84. begin
  85.   bmpsrc.Free;
  86.   bmpsrc := nil;
  87.   bmp.Free;
  88.   bmp := nil;
  89. end;
  90. {------------------------------------------------------------------------------}
  91. { Draws the current frame }
  92. procedure TRVGifImageAnimator.Draw(X, Y: Integer; Canvas: TCanvas; Animation: Boolean);
  93. var gif: TGifImage;
  94.     i: Integer;
  95.     UseSrcBitmap: Boolean;
  96.     r: TRect;
  97.     function ScaleRect(const DestRect: TRect; FrameIndex: Integer): TRect;
  98.     var
  99.       HeightMul  ,
  100.       HeightDiv  : integer;
  101.       WidthMul  ,
  102.       WidthDiv  : integer;
  103.     begin
  104.       with gif.Images[FrameIndex] do begin
  105.         HeightDiv := gif.Height;
  106.         HeightMul := DestRect.Bottom-DestRect.Top;
  107.         WidthDiv := gif.Width;
  108.         WidthMul := DestRect.Right-DestRect.Left;
  109.         Result.Left := DestRect.Left + muldiv(Left, WidthMul, WidthDiv);
  110.         Result.Top := DestRect.Top + muldiv(Top, HeightMul, HeightDiv);
  111.         Result.Right := DestRect.Left + muldiv(Left+Width, WidthMul, WidthDiv);
  112.         Result.Bottom := DestRect.Top + muldiv(Top+Height, HeightMul, HeightDiv);
  113.       end;
  114.     end;
  115.     procedure MakeBitmap(FrameIndex: Integer);
  116.     var r: TRect;
  117.     begin
  118.       if FrameIndex>0 then
  119.         case gif.Images[FrameIndex-1].GraphicControlExtension.Disposal of
  120.           dmBackground:
  121.             begin
  122.               r := gif.Images[FrameIndex-1].BoundsRect;
  123.               if bmpsrc<>nil then
  124.                 bmp.Canvas.CopyRect(r, bmpsrc.Canvas, r)
  125.               else begin
  126.                 bmp.Canvas.Brush.Color := FBackColor;
  127.                 bmp.Canvas.FillRect(r);
  128.               end;
  129.             end;
  130.         end
  131.       else begin
  132.         if bmpsrc<>nil then
  133.           bmp.Assign(bmpsrc)
  134.         else begin
  135.           bmp.Canvas.Brush.Color := FBackColor;
  136.           bmp.Canvas.FillRect(Rect(0,0,bmp.Width,bmp.Height));
  137.         end;
  138.       end;
  139.       gif.Images[FrameIndex].StretchDraw(bmp.Canvas,
  140.         ScaleRect(Rect(0, 0, item.GetImageWidth(nil), item.GetImageHeight(nil)), FrameIndex),
  141.         (goTransparent in gif.DrawOptions), (goTile in gif.DrawOptions));
  142.     end;
  143. begin
  144.   gif := TGifImage(TRVGraphicItemInfo(item).Image);
  145.   if (bmp=nil) or
  146.     (item.ParaNo<>FParaNo) or
  147.     (X<>FX) or
  148.     (Y<>FY) or
  149.     (bmp.Width<>item.GetImageWidth(nil)) or
  150.     (bmp.Height<>item.GetImageHeight(nil)) then begin
  151.     bmp.Free;
  152.     bmp := TBitmap.Create;
  153.     bmp.Width := item.GetImageWidth(nil);
  154.     bmp.Height := item.GetImageHeight(nil);
  155.     FParaNo := item.ParaNo;
  156.     FX := X;
  157.     FY := Y;
  158.     if (goTransparent in gif.DrawOptions) then begin
  159.       r := Rect(0,0,0,0);
  160.       RVData.GetItemBackground(RVData.DrawItems[item.DrawItemNo].ItemNo, r, True,
  161.         FBackColor, bmpsrc, UseSrcBitmap);
  162.       if not UseSrcBitmap then begin
  163.         bmp.Canvas.Brush.Color := RVData.GetColor;
  164.         bmp.Canvas.FillRect(Rect(0,0,bmp.Width,bmp.Height));
  165.       end;
  166.       end
  167.     else begin
  168.       FBackColor := clWhite;
  169.       UseSrcBitmap := False;
  170.     end;
  171.     if not UseSrcBitmap then begin
  172.       bmpsrc.Free;
  173.       bmpsrc := nil;
  174.     end;
  175.     for i := 0 to FrameIndex-1 do
  176.       MakeBitmap(i);
  177.     end
  178.   else if (FrameIndex=FLastDrawnFrameIndex) then begin
  179.     Canvas.Draw(X,Y,bmp);
  180.     exit;
  181.     end
  182.   else if (FrameIndex>0) and (FLastDrawnFrameIndex<>FrameIndex-1) then begin
  183.     if FLastDrawnFrameIndex<FrameIndex then begin
  184.       for i := FLastDrawnFrameIndex+1 to FrameIndex-1 do
  185.         MakeBitmap(i);
  186.       end
  187.     else
  188.       for i := 0 to FrameIndex-1 do
  189.         MakeBitmap(i);
  190.   end;
  191.   MakeBitmap(FrameIndex);
  192.   FLastDrawnFrameIndex := FrameIndex;
  193.   Canvas.Draw(X,Y,bmp);
  194. end;
  195. {------------------------------------------------------------------------------}
  196. { Returns a number of frames in gif }
  197. function GetGifFrameCount(gif: TGifImage): Integer;
  198. begin
  199.   Result := gif.Images.Count;
  200.   if (Result>1) and gif.Images[Result-1].Empty then
  201.     dec(Result);
  202. end;
  203. {------------------------------------------------------------------------------}
  204. { Returns a number of frames }
  205. function TRVGifImageAnimator.GetFrameCount: Integer;
  206. begin
  207.   Result := TGifImage(TRVGraphicItemInfo(item).Image).Images.Count;
  208.   if (Result>1) and TGifImage(TRVGraphicItemInfo(item).Image).Images[Result-1].Empty then
  209.     dec(Result);
  210. end;
  211. {------------------------------------------------------------------------------}
  212. { Rewinds to the first frame. Updates Interval. }
  213. procedure TRVGifImageAnimator.Reset;
  214. begin
  215.   bmp.Free;
  216.   bmp := nil;
  217.   bmpsrc.Free;
  218.   bmpsrc := nil;
  219.   FrameIndex := 0;
  220.   FLastDrawnFrameIndex := -1;
  221.   CalcInterval;
  222. end;
  223. {==============================================================================}
  224. var DefMakeAnimator: TRVMakeAnimatorProc;
  225. { This procedure creates an animator (anim) for the item, if it's necessary.
  226.   This procedure can create only TRVGifImageAnimator.
  227.   If it cannot be applied, it calls the stored value of RV_MakeAnimator. }
  228. procedure RV_MakeAnimatorGif(item: TCustomRVItemInfo; RVData: TCustomRVFormattedData;
  229.   var anim: TRVAnimator);
  230. begin
  231.   if (item is TRVGraphicItemInfo) and
  232.      (TRVGraphicItemInfo(item).Image is TGifImage) and
  233.      (GetGifFrameCount(TGifImage(TRVGraphicItemInfo(item).Image))>1) then begin
  234.     if (anim<>nil) and not (anim is TRVGifImageAnimator) then begin
  235.       anim.Free;
  236.       anim := nil;
  237.     end;
  238.     if anim=nil then begin
  239.       anim := TRVGifImageAnimator.Create(RVData, Item);
  240.       RVData.InsertAnimator(TObject(anim));
  241.       end
  242.     else if anim<>nil then begin
  243.       anim.Update(RVData, Item);
  244.       anim.Reset;
  245.     end;
  246.     exit;
  247.   end;
  248.   DefMakeAnimator(item, RVData, anim)
  249. end;
  250. initialization
  251.   DefMakeAnimator := RV_MakeAnimator;
  252.   RV_MakeAnimator := RV_MakeAnimatorGif;
  253. {$ENDIF}
  254. end.