home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kompon / d3456 / PICSHOW.ZIP / PicShow.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-12-29  |  67.2 KB  |  2,295 lines
  1. {------------------------------------------------------------------------------}
  2. {                                                                              }
  3. {  TCustomPicShow v2.62                                                        }
  4. {  by Kambiz R. Khojasteh                                                      }
  5. {                                                                              }
  6. {  kambiz@delphiarea.com                                                       }
  7. {  http://www.delphiarea.com                                                   }
  8. {                                                                              }
  9. {  Special thanks to:                                                          }
  10. {  :: <k3nx@hotmail.com> for help on D5 support.                               }
  11. {  :: Douglass Titjan <support@delphipages.com> for help on D5 support.        }
  12. {  :: Jerry McLain <jkmclain@srcaccess.net> for manual control idea.           }
  13. {  :: M. R. Zamani <M_R_Zamani@yahoo.com> for adding 8 effects (110..117).     }
  14. {  :: Elliott Shevin <ShevinE@aol.com> for adding 4 effects (123..126).        }
  15. {  :: Ken Otto <ken.otto@enviros.com> for adding native JPG support to         }
  16. {     TDBPicShow and fixing a memory leak bug.                                 }
  17. {  :: Gary Bond <gary.bond@tesco.net> for name of the transitions.             }
  18. {                                                                              }
  19. {------------------------------------------------------------------------------}
  20.  
  21. {$I DELPHIAREA.INC}
  22.  
  23. // If you want to use TCustomPicShow as a non-windowed control, remove the
  24. // following compiler directive:
  25. {$DEFINE WINCONTROL_PICSHOW}
  26.  
  27. unit PicShow;
  28.  
  29. interface
  30.  
  31. uses
  32.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  33.   Dialogs, Menus, DB, DBCtrls;
  34.  
  35. const
  36.   RegionStyles = [0, 58..117, 123..127];
  37.  
  38. type
  39.  
  40.   {$IFNDEF DELPHI4_UP}
  41.   HRgn = THandle;
  42.   {$ENDIF}
  43.  
  44.   TShowStyle = 0..127;
  45.   TPercent = 0..100;
  46.   TBackgroundMode = (bmNone, bmTiled, bmStretched, bmCentered);
  47.  
  48.   TCustomDrawEvent = procedure(Sender: TObject; Picture, Screen: TBitmap) of object;
  49.  
  50.   TAbout = class(TObject);
  51.  
  52. { TCustomPicShow }
  53.  
  54.   {$IFDEF WINCONTROL_PICSHOW}
  55.   TCustomPicShow = class(TCustomControl)
  56.   {$ELSE}
  57.   TCustomPicShow = class(TGraphicControl)
  58.   {$ENDIF}
  59.   private
  60.     fAbout: TAbout;
  61.     fPicture: TPicture;
  62.     fBgPicture: TPicture;
  63.     fBgMode: TBackgroundMode;
  64.     fAutoSize: Boolean;
  65.     fCenter: Boolean;
  66.     fStretch: Boolean;
  67.     fStretchFine: Boolean;
  68.     fThreaded: Boolean;
  69.     fThreadPriority: TThreadPriority;
  70.     fManual: Boolean;
  71.     fStyle: TShowStyle;
  72.     fStep: Word;
  73.     fDelay: Word;
  74.     fProgress: TPercent;
  75.     fReverse: Boolean;
  76.     fBusy: Boolean;
  77.     fOnChange: TNotifyEvent;
  78.     fOnProgress: TNotifyEvent;
  79.     fOnComplete: TNotifyEvent;
  80.     fOnCustomDraw: TCustomDrawEvent;
  81.     fOnMouseEnter: TNotifyEvent;
  82.     fOnMouseLeave: TNotifyEvent;
  83.     fOnBeforeNewFrame: TCustomDrawEvent;
  84.     fOnAfterNewFrame: TCustomDrawEvent;
  85.     Media: TBitmap;
  86.     PicRect: TRect;
  87.     Thread: TThread;
  88.     Drawing: Boolean;
  89.     OffScreen: TBitmap;
  90.     Stopping: Boolean;
  91.     OldPic: TBitmap;
  92.     Pic: TBitmap;
  93.     procedure SetAutoSize_(Value: Boolean);
  94.     procedure SetPicture(Value: TPicture);
  95.     procedure SetBgPicture(Value: TPicture);
  96.     procedure SetBgMode(Value: TBackgroundMode);
  97.     procedure SetCenter(Value: Boolean);
  98.     procedure SetStretch(Value: Boolean);
  99.     procedure SetStretchFine(Value: Boolean);
  100.     procedure SetStep(Value: Word);
  101.     procedure SetProgress(Value: TPercent);
  102.     procedure SetManual(Value: Boolean);
  103.     procedure SetStyleName(const Value: String);
  104.     function GetStyleName: String;
  105.     function GetEmpty: Boolean;
  106.     procedure AnimationComplete(Sender: TObject);
  107.     procedure BgPictureChange(Sender: TObject);
  108.     procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
  109.     procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
  110.     procedure WMSize(var Msg: TWMSize); message WM_SIZE;
  111.     procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
  112.     procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
  113.     procedure AdjustClientSize;
  114.     procedure CalculatePicRect;
  115.     procedure InvalidateArea(Area: TRect);
  116.     procedure Prepare;
  117.     procedure Animate;
  118.     procedure UpdateDisplay;
  119.   public
  120.     constructor Create(AOwner: TComponent); override;
  121.     destructor Destroy; override;
  122.     procedure Execute;
  123.     procedure Stop;
  124.     procedure Clear;
  125.     property Busy: Boolean read fBusy;
  126.     property Empty: Boolean read GetEmpty;
  127.     property Progress: TPercent read fProgress write SetProgress;
  128.   protected
  129.     procedure Paint; override;
  130.     procedure PictureChange(Sender: TObject); dynamic;
  131.     property AutoSize: Boolean read fAutoSize write SetAutoSize_ default True;
  132.     property BgMode: TBackgroundMode read fBgMode write SetBgMode default bmTiled;
  133.     property BgPicture: TPicture read fBgPicture write SetBgPicture;
  134.     property Center: Boolean read fCenter write SetCenter default False;
  135.     property Delay: Word read fDelay write fDelay default 40;
  136.     property Manual: Boolean read fManual write SetManual default False;
  137.     property Picture: TPicture read fPicture write SetPicture;
  138.     property Reverse: Boolean read fReverse write fReverse default False;
  139.     property Stretch: Boolean read fStretch write SetStretch default False;
  140.     property StretchFine: Boolean read fStretchFine write SetStretchFine default False;
  141.     property Step: Word read fStep write SetStep default 4;
  142.     property Style: TShowStyle read fStyle write fStyle default 51;
  143.     property StyleName: String read GetStyleName write SetStyleName stored False;
  144.     property Threaded: Boolean read fThreaded write fThreaded default True;
  145.     property ThreadPriority: TThreadPriority read fThreadPriority write fThreadPriority default tpNormal;
  146.     property OnAfterNewFrame: TCustomDrawEvent read fOnAfterNewFrame write fOnAfterNewFrame;
  147.     property OnBeforeNewFrame: TCustomDrawEvent read fOnBeforeNewFrame write fOnBeforeNewFrame;
  148.     property OnCustomDraw: TCustomDrawEvent read fOnCustomDraw write fOnCustomDraw;
  149.     property OnChange: TNotifyEvent read fOnChange write fOnChange;
  150.     property OnComplete: TNotifyEvent read fOnComplete write fOnComplete;
  151.     property OnMouseEnter: TNotifyEvent read fOnMouseEnter write fOnMouseEnter;
  152.     property OnMouseLeave: TNotifyEvent read fOnMouseLeave write fOnMouseLeave;
  153.     property OnProgress: TNotifyEvent read fOnProgress write fOnProgress;
  154.   published
  155.     property About: TAbout read fAbout write fAbout stored False;
  156.   end;
  157.  
  158. { TPicShow }
  159.  
  160.   TPicShow = class(TCustomPicShow)
  161.   published
  162.     property Align;
  163.     {$IFDEF DELPHI4_UP}
  164.     property Anchors;
  165.     {$ENDIF}
  166.     property AutoSize;
  167.     property BgMode;
  168.     property BgPicture;
  169.     property Center;
  170.     property Color;
  171.     property Delay;
  172.     property DragCursor;
  173.     property DragMode;
  174.     property Enabled;
  175.     property Height;
  176.     property Manual;
  177.     property ParentColor;
  178.     property ParentShowHint;
  179.     property Picture;
  180.     property PopupMenu;
  181.     property ShowHint;
  182.     property Reverse;
  183.     property Stretch;
  184.     property StretchFine;
  185.     property Step;
  186.     property Style;
  187.     property StyleName;
  188.     {$IFDEF WINCONTROL_PICSHOW}
  189.     property TabOrder;
  190.     property TabStop;
  191.     {$ENDIF}
  192.     property Threaded;
  193.     property ThreadPriority;
  194.     property Visible;
  195.     property Width;
  196.     property OnAfterNewFrame;
  197.     property OnBeforeNewFrame;
  198.     property OnClick;
  199.     property OnChange;
  200.     property OnComplete;
  201.     property OnCustomDraw;
  202.     property OnDblClick;
  203.     property OnDragDrop;
  204.     property OnDragOver;
  205.     property OnEndDrag;
  206.     {$IFDEF WINCONTROL_PICSHOW}
  207.     property OnEnter;
  208.     property OnExit;
  209.     {$ENDIF}
  210.     property OnMouseDown;
  211.     property OnMouseEnter;
  212.     property OnMouseLeave;
  213.     property OnMouseMove;
  214.     property OnMouseUp;
  215.     {$IFDEF WINCONTROL_PICSHOW}
  216.     property OnKeyDown;
  217.     property OnKeyPress;
  218.     property OnKeyUp;
  219.     {$ENDIF}
  220.     property OnProgress;
  221.     property OnStartDrag;
  222.   end;
  223.  
  224. { TDBPicShow }
  225.  
  226.   TDBPicShow = class(TCustomPicShow)
  227.   private
  228.     fOnAfterLoadPicture: TNotifyEvent;
  229.     fOnBeforeLoadPicture: TNotifyEvent;
  230.     fDataLink: TFieldDataLink;
  231.     fAutoDisplay: Boolean;
  232.     fPictureLoaded: Boolean;
  233.     procedure DataChange(Sender: TObject);
  234.     function GetDataField: string;
  235.     function GetDataSource: TDataSource;
  236.     function GetField: TField;
  237.     function GetReadOnly: Boolean;
  238.     procedure SetAutoDisplay(Value: Boolean);
  239.     procedure SetDataField(const Value: string);
  240.     procedure SetDataSource(Value: TDataSource);
  241.     procedure SetReadOnly(Value: Boolean);
  242.     procedure UpdateData(Sender: TObject);
  243.     procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  244.   protected
  245.     procedure Notification(AComponent: TComponent;
  246.       Operation: TOperation); override;
  247.     procedure PictureChange(Sender: TObject); override;
  248.   public
  249.     constructor Create(AOwner: TComponent); override;
  250.     destructor Destroy; override;
  251.     procedure LoadPicture;
  252.     property Field: TField read GetField;
  253.     property Picture;
  254.   published
  255.     property OnAfterLoadPicture: TNotifyEvent read fOnAfterLoadPicture write fOnAfterLoadPicture;
  256.     property OnBeforeLoadPicture: TNotifyEvent read fOnBeforeLoadPicture write fOnBeforeLoadPicture;
  257.     property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
  258.     property DataField: string read GetDataField write SetDataField;
  259.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  260.     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  261.     property Align;
  262.     {$IFDEF DELPHI4_UP}
  263.     property Anchors;
  264.     {$ENDIF}
  265.     property AutoSize;
  266.     property BgMode;
  267.     property BgPicture;
  268.     property Center;
  269.     property Color;
  270.     property Delay;
  271.     property DragCursor;
  272.     property DragMode;
  273.     property Enabled;
  274.     property Height;
  275.     property Manual;
  276.     property ParentColor;
  277.     property ParentShowHint;
  278.     property PopupMenu;
  279.     property ShowHint;
  280.     property Reverse;
  281.     property Stretch;
  282.     property StretchFine;
  283.     property Step;
  284.     property Style;
  285.     property StyleName;
  286.     {$IFDEF WINCONTROL_PICSHOW}
  287.     property TabOrder;
  288.     property TabStop;
  289.     {$ENDIF}
  290.     property Threaded;
  291.     property ThreadPriority;
  292.     property Visible;
  293.     property Width;
  294.     property OnAfterNewFrame;
  295.     property OnBeforeNewFrame;
  296.     property OnClick;
  297.     property OnCustomDraw;
  298.     property OnDblClick;
  299.     property OnDragDrop;
  300.     property OnDragOver;
  301.     property OnEndDrag;
  302.     {$IFDEF WINCONTROL_PICSHOW}
  303.     property OnEnter;
  304.     property OnExit;
  305.     {$ENDIF}
  306.     property OnComplete;
  307.     property OnMouseDown;
  308.     property OnMouseEnter;
  309.     property OnMouseLeave;
  310.     property OnMouseMove;
  311.     property OnMouseUp;
  312.     {$IFDEF WINCONTROL_PICSHOW}
  313.     property OnKeyDown;
  314.     property OnKeyPress;
  315.     property OnKeyUp;
  316.     {$ENDIF}
  317.     property OnProgress;
  318.     property OnStartDrag;
  319.   end;
  320.  
  321. const
  322.   PSTransitionNames: array[TShowStyle] of String = (
  323.     'Swap',
  324.     'Expand from right',
  325.     'Expand from left',
  326.     'Slide in from right',
  327.     'Slide in from left',
  328.     'Reveal from left',
  329.     'Reveal from right',
  330.     'Expand in from right',
  331.     'Expand in from left',
  332.     'Expand in to middle',
  333.     'Expand out from middle',
  334.     'Reveal out from middle',
  335.     'Reveal in from sides',
  336.     'Expand in from sides',
  337.     'Unroll from left',
  338.     'Unroll from right',
  339.     'Build up from right',
  340.     'Build up from left',
  341.     'Expand from bottom',
  342.     'Expand from top',
  343.     'Slide in from bottom',
  344.     'Slide in from top',
  345.     'Reveal from top',
  346.     'Reveal from bottom',
  347.     'Expand in from bottom',
  348.     'Expand in from top',
  349.     'Expand in to middle (horiz)',
  350.     'Expand out from middle (horiz)',
  351.     'Reveal from middle (horiz)',
  352.     'Slide in from top / bottom',
  353.     'Expand in from top / bottom',
  354.     'Unroll from top',
  355.     'Unroll from bottom',
  356.     'Expand from bottom',
  357.     'Expand in from top',
  358.     'Expand from bottom right',
  359.     'Expand from top right',
  360.     'Expand from top left',
  361.     'Expand from bottom left',
  362.     'Slide in from bottom right',
  363.     'Slide in from top right',
  364.     'Slide in from top left',
  365.     'Slide in from bottom left',
  366.     'Reveal from top left',
  367.     'Reveal from bottom left',
  368.     'Reveal from bottom right',
  369.     'Reveal from top right',
  370.     'Appear and Contract to top left',
  371.     'Appear and Contract to bottom left',
  372.     'Appear and Contract to bottom right',
  373.     'Appear and Contract to top right',
  374.     'Appear and Contract to middle',
  375.     'Expand out from centre',
  376.     'Reveal out from centre',
  377.     'Reveal in to centre',
  378.     'Quarters Reveal in to middle',
  379.     'Quarters Expand to middle',
  380.     'Quarters Slide in to middle',
  381.     'Curved Reveal from left',
  382.     'Curved Reveal from right',
  383.     'Bars in from right',
  384.     'Bars in from left',
  385.     'Bars left then right',
  386.     'Bars right then left',
  387.     'Bars from both sides',
  388.     'Uneven shred from right',
  389.     'Uneven shred from left',
  390.     'Uneven shred out from middle (horiz)',
  391.     'Uneven shred in to middle (horiz)',
  392.     'Curved Reveal from top',
  393.     'Curved Reveal from bottom',
  394.     'Bars from bottom',
  395.     'Bars from top',
  396.     'Bars top then bottom',
  397.     'Bars bottom then top',
  398.     'Bars from top and bottom',
  399.     'Unven shred from bottom',
  400.     'Uneven shred from top',
  401.     'Uneven shred from horizon',
  402.     'Uneven shred in to horizon',
  403.     'Curved reveal from top left',
  404.     'Curved reveal from top right',
  405.     'Curved reveal from bottom left',
  406.     'Curved reveal from bottom right',
  407.     'Circular reveal from centre',
  408.     'Circular reveal to centre',
  409.     'Criss Cross reveal from bottom right',
  410.     'Criss Cross reveal from top right',
  411.     'Criss Cross reveal from bottom left',
  412.     'Criss Cross reveal from top left',
  413.     'Criss Cross reveal bounce from top left',
  414.     'Criss Cross reveal bounce from bottom left',
  415.     'Criss Cross reveal bounce from top right',
  416.     'Criss Cross reveal bounce from bottom right',
  417.     'Criss Cross reveal from right top and bottom',
  418.     'Criss Cross reveal from left top and bottom',
  419.     'Criss Cross reveal from left right and bottom',
  420.     'Criss Cross reveal from left right and top',
  421.     'Criss Cross reveal from top left right and bottom',
  422.     'Criss Cross reveal from bottom left top right',
  423.     'Uneven shred from bottom and right',
  424.     'Uneven shred from top and right',
  425.     'Uneven shred from bottom and left',
  426.     'Uneven shred from top and left',
  427.     'Uneven shred from horiz and right',
  428.     'Uneven shred from horiz and left',
  429.     'Uneven shred from bottom and vert middle',
  430.     'Uneven shred from top and vert middle',
  431.     'Uneven shred from centre',
  432.     'Uneven shred to centre',
  433.     'Reveal diagonal from top left',
  434.     'Reveal diagonal from top right',
  435.     'Reveal diagonal from bottom left',
  436.     'Reveal diagonal from bottom right',
  437.     'Diagonal sweep from top left bottom right anticlockwise',
  438.     'Diagonal sweep from top left bottom right clockwise',
  439.     'Starburst clockwise from center',
  440.     'Triangular shred to right',
  441.     'Fade',
  442.     'Pivot from top left',
  443.     'Pivot from bottom left',
  444.     'Pivot from top right',
  445.     'Pivot from bottom right',
  446.     'Speckle appear from right',
  447.     'Speckle appear from left',
  448.     'Speckle appear from bottom',
  449.     'Speckle appear from top',
  450.     'Random squares appear');
  451.  
  452. implementation
  453.  
  454. uses
  455.   Math, JPEG;
  456.  
  457. const
  458.   MaxPixelCount = 32768;
  459.  
  460. type
  461.  
  462.   PRGBTripleArray = ^TRGBTripleArray;
  463.   TRGBTripleArray = array[0..MaxPixelCount] of TRGBTriple;
  464.  
  465.   TAnimateThread = class(TThread)
  466.   private
  467.     PicShow: TCustomPicShow;
  468.     procedure Update;
  469.   public
  470.     constructor Create(APicShow: TCustomPicShow);
  471.     procedure Execute; override;
  472.   end;
  473.  
  474. { Miscellaneous routines }
  475.  
  476. function CreateBarRgn(X, Y, W, H, S: Integer; XMode, YMode: Byte): HRgn;
  477. var
  478.   X1, Y1: Integer;
  479.   Rgn, tRgn: HRgn;
  480. begin
  481.   Result := NULLREGION;
  482.   Rgn := NULLREGION;
  483.   if X <= W then Y1 := 0 else Y1 := 5;
  484.   while Y1 < H + 5 do
  485.   begin
  486.     if X > W then
  487.     begin
  488.       tRgn := CreateRectRgn(0, Y1 - 5, W, Y1);
  489.       if XMode in [1, 4] then
  490.         Rgn := CreateRectRgn(2 * W - X, Y1, W, Y1 + 5)
  491.       else if XMode in [2, 5] then
  492.         Rgn := CreateRectRgn(0, Y1, X - W, Y1 + 5);
  493.       CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
  494.       DeleteObject(tRgn);
  495.     end
  496.     else
  497.     begin
  498.       if (X + S) > W then X := W;
  499.       if XMode in [1, 5] then
  500.         Rgn := CreateRectRgn(W - X, Y1, W, Y1 + 5)
  501.       else if XMode in [2, 4] then
  502.         Rgn := CreateRectRgn(0, Y1, X, Y1 + 5)
  503.       else if XMode = 3 then
  504.       begin
  505.         tRgn := CreateRectRgn(W - X, Y1, W, Y1 + 5);
  506.         Rgn := CreateRectRgn(0, Y1 + 5, X, Y1 + 10);
  507.         CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
  508.         DeleteObject(tRgn);
  509.       end;
  510.     end;
  511.     if Result <> NULLREGION then
  512.     begin
  513.       CombineRgn(Result, Result, Rgn, RGN_OR);
  514.       DeleteObject(Rgn);
  515.     end
  516.     else
  517.       Result := Rgn;
  518.     Inc(Y1, 10)
  519.   end;
  520.   if Y <= H then X1 := 0 else X1 := 5;
  521.   while X1 < W + 5 do
  522.   begin
  523.     if Y > H then
  524.     begin
  525.       tRgn := CreateRectRgn(X1 - 5, 0, X1, H);
  526.       if YMode in [1, 4] then
  527.         Rgn := CreateRectRgn(X1, 2 * H - Y, X1 + 5, H)
  528.       else if YMode in [2, 5] then
  529.         Rgn := CreateRectRgn(X1, 0, X1 + 5, Y - H);
  530.       CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
  531.       DeleteObject(tRgn);
  532.     end
  533.     else
  534.     begin
  535.       if (Y + S) > H then Y := H;
  536.       if YMode in [1, 5] then
  537.         Rgn := CreateRectRgn(X1, H - Y, X1 + 5, H)
  538.       else if YMode in [2, 4] then
  539.         Rgn := CreateRectRgn(X1, 0, X1 + 5, Y)
  540.       else if YMode = 3 then
  541.       begin
  542.         tRgn := CreateRectRgn(X1, H - Y, X1 + 5, H);
  543.         Rgn := CreateRectRgn(X1 + 5, 0, X1 + 10, Y);
  544.         CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
  545.         DeleteObject(tRgn);
  546.       end;
  547.     end;
  548.     if Result <> NULLREGION then
  549.     begin
  550.       CombineRgn(Result, Result, Rgn, RGN_OR);
  551.       DeleteObject(Rgn);
  552.     end
  553.     else
  554.       Result := Rgn;
  555.     Inc(X1, 10)
  556.   end;
  557. end;
  558.  
  559. function CreateSplashRgn(X, Y, W, H, XMode, YMode: Integer): HRgn;
  560. var
  561.   X1, Y1, N: Integer;
  562.   Rgn, tRgn: HRgn;
  563. begin
  564.   Result := NULLREGION;
  565.   if XMode <> 0 then
  566.   begin
  567.     if X < W then
  568.       N := W div 7
  569.     else
  570.       N := 0;
  571.     Y1 := 0;
  572.     while Y1 < H do
  573.     begin
  574.       if XMode = 1 then
  575.         Rgn := CreateRectRgn(W - X + Random(N) - Random(N), Y1, W, Y1 + 5 + H mod 5)
  576.       else if XMode = 2 then
  577.         Rgn := CreateRectRgn(0, Y1, X + Random(N) - Random(N), Y1 + 5 + H mod 5)
  578.       else if XMode = 3 then
  579.       begin
  580.         Rgn := CreateRectRgn((W - X + Random(N) - Random(N)) div 2, Y1, W div 2, Y1 + 5 + H mod 5);
  581.         tRgn := CreateRectRgn(W div 2, Y1, (W + X + Random(N) - Random(N)) div 2, Y1 + 5 + H mod 5);
  582.         CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
  583.         DeleteObject(tRgn);
  584.       end
  585.       else
  586.       begin
  587.         Rgn := CreateRectRgn(W - (X + Random(N) - Random(N)) div 2, Y1, W, Y1 + 5 + H mod 5);
  588.         tRgn := CreateRectRgn(0, Y1, (X + Random(N) - Random(N)) div 2, Y1 + 5 + H mod 5);
  589.         CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
  590.         DeleteObject(tRgn);
  591.       end;
  592.       if Result <> NULLREGION then
  593.       begin
  594.         CombineRgn(Result, Result, Rgn, RGN_OR);
  595.         DeleteObject(Rgn);
  596.       end
  597.       else
  598.         Result := Rgn;
  599.       Inc(Y1, 5);
  600.     end;
  601.   end;
  602.   if YMode <> 0 then
  603.   begin
  604.     if Y < H then
  605.       N := H div 7
  606.     else
  607.       N := 0;
  608.     X1 := 0;
  609.     while X1 < W do
  610.     begin
  611.       if YMode = 1 then
  612.         Rgn := CreateRectRgn(X1, H - Y + Random(N) - Random(N), X1 + 5 + W mod 5, H)
  613.       else if YMode = 2 then
  614.         Rgn := CreateRectRgn(X1, 0, X1 + 5 + W mod 5, Y + Random(N) - Random(N))
  615.       else if YMode = 3 then
  616.       begin
  617.         Rgn := CreateRectRgn(X1, (H - Y + Random(N) - Random(N)) div 2, X1 + 5 + W mod 5, H div 2);
  618.         tRgn := CreateRectRgn(X1, H div 2, X1 + 5 + W mod 5, (H + Y + Random(N) - Random(N)) div 2);
  619.         CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
  620.         DeleteObject(tRgn);
  621.       end
  622.       else
  623.       begin
  624.         Rgn := CreateRectRgn(X1, H - (Y + Random(N) - Random(N)) div 2, X1 + 5 + W mod 5, H);
  625.         tRgn := CreateRectRgn(X1, 0, X1 + 5 + W mod 5, (Y + Random(N) - Random(N)) div 2);
  626.         CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
  627.         DeleteObject(tRgn);
  628.       end;
  629.       if Result <> NULLREGION then
  630.       begin
  631.         CombineRgn(Result, Result, Rgn, RGN_OR);
  632.         DeleteObject(Rgn);
  633.       end
  634.       else
  635.         Result := Rgn;
  636.       Inc(X1, 5);
  637.     end;
  638.   end;
  639. end;
  640.  
  641. function CreateSwarmRgn(X, Y, W, H, XMode, YMode: Integer): HRgn;
  642. var
  643.   X1, Y1, N, M, I, J: Integer;
  644.   Rgn, tRgn: HRgn;
  645. begin
  646.   Result := NULLREGION;
  647.   if XMode <> 0 then
  648.   begin
  649.     if X < W then
  650.       N := W div 10
  651.     else
  652.       N := 0;
  653.     M := N div 20;
  654.     if M < 2 then M := 2;
  655.     Y1 := 0;
  656.     while Y1 < H do
  657.     begin
  658.       if XMode = 1 then
  659.       begin
  660.         Rgn := CreateRectRgn(W - X, Y1, W, Y1 + M);
  661.         for I := N div M downto 1 do
  662.         begin
  663.           if I > 3 * N div M div 4 then J := 0 else J := 1;
  664.           if Random(I) <= J then
  665.           begin
  666.             X1 := (W - X) - (I * M);
  667.             tRgn := CreateRectRgn(X1, Y1, X1 + M, Y1 + M);
  668.             CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
  669.             DeleteObject(tRgn);
  670.           end;
  671.         end;
  672.       end
  673.       else
  674.       begin
  675.         Rgn := CreateRectRgn(0, Y1, X, Y1 + M);
  676.         for I := N div M downto 1 do
  677.         begin
  678.           if I > 3 * N div M div 4 then J := 0 else J := 1;
  679.           if Random(I) <= J then
  680.           begin
  681.             X1 := X + (I * M);
  682.             tRgn := CreateRectRgn(X1 - M, Y1, X1, Y1 + M);
  683.             CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
  684.             DeleteObject(tRgn);
  685.           end;
  686.         end;
  687.       end;
  688.       if Result <> NULLREGION then
  689.       begin
  690.         CombineRgn(Result, Result, Rgn, RGN_OR);
  691.         DeleteObject(Rgn);
  692.       end
  693.       else
  694.         Result := Rgn;
  695.       Inc(Y1, M div 2);
  696.     end;
  697.   end;
  698.   if YMode <> 0 then
  699.   begin
  700.     if Y < H then
  701.       N := H div 10
  702.     else
  703.       N := 0;
  704.     M := N div 20;
  705.     if M < 2 then M := 2;
  706.     X1 := 0;
  707.     while X1 < W do
  708.     begin
  709.       if YMode = 1 then
  710.       begin
  711.         Rgn := CreateRectRgn(X1, H - Y, X1 + M, H);
  712.         for I := N div M downto 1 do
  713.         begin
  714.           if I > 3 * N div M div 4 then J := 0 else J := 1;
  715.           if Random(I) <= J then
  716.           begin
  717.             Y1 := (H - Y) - (I * M);
  718.             tRgn := CreateRectRgn(X1, Y1, X1 + M, Y1 + M);
  719.             CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
  720.             DeleteObject(tRgn);
  721.           end;
  722.         end;
  723.       end
  724.       else
  725.       begin
  726.         Rgn := CreateRectRgn(X1, 0, X1 + M, Y);
  727.         for I := N div M downto 1 do
  728.         begin
  729.           if I > 3 * N div M div 4 then J := 0 else J := 1;
  730.           if Random(I) <= J then
  731.           begin
  732.             Y1 := Y + (I * M);
  733.             tRgn := CreateRectRgn(X1, Y1 - M, X1 + M, Y1);
  734.             CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
  735.             DeleteObject(tRgn);
  736.           end;
  737.         end;
  738.       end;
  739.       if Result <> NULLREGION then
  740.       begin
  741.         CombineRgn(Result, Result, Rgn, RGN_OR);
  742.         DeleteObject(Rgn);
  743.       end
  744.       else
  745.         Result := Rgn;
  746.       Inc(X1, M div 2);
  747.     end;
  748.   end;
  749. end;
  750.  
  751. function CreateBoxesRgn(W, H: Integer; Percent: TPercent): HRgn;
  752. var
  753.   X, Y: Integer;
  754.   S: Integer;
  755.   Rgn: HRgn;
  756. begin
  757.   Result := NULLREGION;
  758.   if W < H then
  759.     S := W div 50 + Percent div 10
  760.   else
  761.     S := H div 50 + Percent div 10;
  762.   if S < 1 then S := 1;
  763.   X := 0;
  764.   while X < W do
  765.   begin
  766.     Y := 0;
  767.     while Y < H do
  768.     begin
  769.       if Random(100) < Percent then
  770.       begin
  771.         Rgn := CreateRectRgn(X - S, Y - S, X + S, Y + S);
  772.         if Result <> NULLREGION then
  773.         begin
  774.           CombineRgn(Result, Result, Rgn, RGN_OR);
  775.           DeleteObject(Rgn);
  776.         end
  777.         else
  778.           Result := Rgn;
  779.       end;
  780.       Inc(Y, S);
  781.     end;
  782.     Inc(X, S);
  783.   end;
  784. end;
  785.  
  786. function CreateTriangleRgn(x1, y1, x2, y2, x3, y3: Integer): HRgn;
  787. var
  788.   ptArray : array[1..4] of TPoint;
  789. begin
  790.   ptArray[1].x := x1;
  791.   ptArray[1].y := y1;
  792.   ptArray[2].x := x2;
  793.   ptArray[2].y := y2;
  794.   ptArray[3].x := x3;
  795.   ptArray[3].y := y3;
  796.   ptArray[4].x := x1;
  797.   ptArray[4].y := y1;
  798.   Result := CreatePolygonRgn(ptArray, 4, WINDING);
  799. end;
  800.  
  801. function ScaleImageToRect(IR, R: TRect): TRect;
  802. var
  803.   iW, iH: Integer;
  804.   rW, rH: Integer;
  805. begin
  806.   iW := IR.Right - IR.Left;
  807.   iH := IR.Bottom - IR.Top;
  808.   rW := R.Right - R.Left;
  809.   rH := R.Bottom - R.Top;
  810.   if (rW / iW) < (rH / iH) then
  811.   begin
  812.     iH := MulDiv(iH, rW, iW);
  813.     iW := MulDiv(iW, rW, iW);
  814.   end
  815.   else
  816.   begin
  817.     iW := MulDiv(iW, rH, iH);
  818.     iH := MulDiv(iH, rH, iH);
  819.   end;
  820.   SetRect(Result, 0, 0, iW, iH);
  821.   OffsetRect(Result, R.Left + (rW - iW) div 2, R.Top + (rH - iH) div 2);
  822. end;
  823.  
  824. procedure DrawTiledImage(Canvas: TCanvas; Rect: TRect; G: TGraphic);
  825. var
  826.   R, Rows, C, Cols: Integer;
  827. begin
  828.   if (G <> nil) and (not G.Empty) then
  829.   begin
  830.     Rows := ((Rect.Bottom - Rect.Top) div G.Height) + 1;
  831.     Cols := ((Rect.Right - Rect.Left) div G.Width) + 1;
  832.     for R := 1 to Rows do
  833.       for C := 1 to Cols do
  834.         Canvas.Draw(Rect.Left + (C-1) * G.Width, Rect.Top + (R-1) * G.Height, G)
  835.   end;
  836. end;
  837.  
  838. procedure MirrorCopyRect(Canvas: TCanvas; dstRect: TRect;
  839.   Bitmap: TBitmap; srcRect: TRect; Horz, Vert: Boolean);
  840. var
  841.   T: Integer;
  842. begin
  843.   IntersectRect(srcRect, srcRect, Rect(0, 0, Bitmap.Width, Bitmap.Height));
  844.   if Horz then
  845.   begin
  846.     T := dstRect.Left;
  847.     dstRect.Left := dstRect.Right+1;
  848.     dstRect.Right := T-1;
  849.   end;
  850.   if Vert then
  851.   begin
  852.     T := dstRect.Top;
  853.     dstRect.Top := dstRect.Bottom+1;
  854.     dstRect.Bottom := T-1;
  855.   end;
  856.   StretchBlt(Canvas.Handle, dstRect.Left, dstRect.Top,
  857.      dstRect.Right - dstRect.Left, dstRect.Bottom - dstRect.Top,
  858.      Bitmap.Canvas.Handle, srcRect.Left, srcRect.Top,
  859.      srcRect.Right - srcRect.Left, srcRect.Bottom - srcRect.Top, SRCCOPY);
  860. end;
  861.  
  862. // Both bitmaps must be equal size and 24 bit format.
  863. procedure MergeTransparent(dstBitmap, srcBitmap: TBitmap; Transparency: TPercent);
  864. var
  865.   dstRow, srcRow: PRGBTripleArray;
  866.   x, y: Integer;
  867. begin
  868.   for y := 0 to srcBitmap.Height-1 do
  869.   begin
  870.     srcRow := srcBitmap.ScanLine[y];
  871.     dstRow := dstBitmap.ScanLine[y];
  872.     for x := 0 to srcBitmap.Width-1 do
  873.     begin
  874.       dstRow[x].rgbtRed := ((100-Transparency) * dstRow[X].rgbtRed) div 100 +
  875.                             (Transparency * srcRow[X].rgbtRed) div 100;
  876.       dstRow[x].rgbtGreen := ((100-Transparency) * dstRow[X].rgbtGreen) div 100 +
  877.                             (Transparency * srcRow[X].rgbtGreen) div 100;
  878.       dstRow[x].rgbtBlue := ((100-Transparency) * dstRow[X].rgbtBlue) div 100 +
  879.                             (Transparency * srcRow[X].rgbtBlue) div 100;
  880.     end;
  881.   end;
  882. end;
  883.  
  884. // Both bitmaps must be equal size and 24 bit format.
  885. procedure MergeRotate(dstBitmap, srcBitmap: TBitmap; xOrg, yOrg: Integer;
  886.   Angle: Double);
  887. var
  888.   cosTheta: Extended;
  889.   sinTheta: Extended;
  890.   xSrc, ySrc: Integer;
  891.   xDst, yDst: Integer;
  892.   xPrime, yPrime: Integer;
  893.   srcRow, dstRow: PRGBTripleArray;
  894. begin
  895.   SinCos(Angle, sinTheta, cosTheta);
  896.   for ySrc := 0 to srcBitmap.Height-1 do
  897.   begin
  898.     dstRow := dstBitmap.ScanLine[ySrc];
  899.     yPrime := ySrc - yOrg;
  900.     for xSrc := 0 to srcBitmap.Width-1 do
  901.     begin
  902.       xPrime := xSrc - xOrg;
  903.       xDst := xOrg + Round(xPrime * CosTheta - yPrime * sinTheta);
  904.       yDst := yOrg + Round(xPrime * sinTheta + yPrime * cosTheta);
  905.       if (xDst >= 0) and (xDst < dstBitmap.Width) and
  906.          (yDst >= 0) and (yDst < dstBitmap.Height)
  907.       then
  908.       begin
  909.         srcRow := srcBitmap.Scanline[yDst];
  910.         dstRow[xSrc] := srcRow[xDst]
  911.       end;
  912.     end;
  913.   end;
  914. end;
  915.  
  916. { TAnimateThread }
  917.  
  918. constructor TAnimateThread.Create(APicShow: TCustomPicShow);
  919. begin
  920.   PicShow := APicShow;
  921.   OnTerminate := PicShow.AnimationComplete;
  922.   FreeOnTerminate := True;
  923.   inherited Create(False);
  924.   Priority := PicShow.ThreadPriority;
  925. end;
  926.  
  927. procedure TAnimateThread.Execute;
  928. var
  929.   Elapsed: DWord;
  930. begin
  931.   while not (Terminated or PicShow.Manual or PicShow.Stopping) do
  932.   begin
  933.     Elapsed := GetTickCount;
  934.     Synchronize(Update);
  935.     Elapsed := GetTickCount - Elapsed;
  936.     if (PicShow.Reverse and (PicShow.Progress = Low(TPercent))) or
  937.        (not PicShow.Reverse and (PicShow.Progress = High(TPercent))) then
  938.       Terminate
  939.     else if PicShow.Delay > Elapsed then
  940.       Sleep(PicShow.Delay - Elapsed);
  941.   end;
  942. end;
  943.  
  944. procedure TAnimateThread.Update;
  945. begin
  946.   if PicShow.Reverse then
  947.     if PicShow.Progress - PicShow.Step >= Low(TPercent) then
  948.       PicShow.Progress := PicShow.Progress - PicShow.Step
  949.     else
  950.       PicShow.Progress := Low(TPercent)
  951.   else
  952.     if PicShow.Progress + PicShow.Step <= High(TPercent) then
  953.       PicShow.Progress := PicShow.Progress + PicShow.Step
  954.     else
  955.       PicShow.Progress := High(TPercent);
  956. end;
  957.  
  958. { TCustomPicShow }
  959.  
  960. constructor TCustomPicShow.Create(AOwner: TComponent);
  961. begin
  962.   inherited Create(AOwner);
  963.   ControlStyle := ControlStyle + [csOpaque];
  964.   Media := TBitmap.Create;
  965.   Media.PixelFormat := pf24bit;
  966.   fStep := 4;
  967.   fDelay := 40;
  968.   fStyle := 51;
  969.   fReverse := False;
  970.   fCenter := False;
  971.   fStretch := False;
  972.   fStretchFine := False;
  973.   fAutoSize := True;
  974.   fThreaded := True;
  975.   fThreadPriority := tpNormal;
  976.   fManual := False;
  977.   fProgress := Low(TPercent);
  978.   fBusy := False;
  979.   fPicture := TPicture.Create;
  980.   fPicture.OnChange := PictureChange;
  981.   fBgPicture := TPicture.Create;
  982.   fBgPicture.OnChange := BgPictureChange;
  983.   fBgMode := bmTiled;
  984.   OffScreen := TBitmap.Create;
  985.   Width := 100;
  986.   Height := 100;
  987.   Thread := nil;
  988.   Stopping := False;
  989.   Drawing := False;
  990. end;
  991.  
  992. destructor TCustomPicShow.Destroy;
  993. begin
  994.   if Assigned(Thread) then
  995.   begin
  996.     Thread.Terminate;
  997.     repeat
  998.       Application.ProcessMessages;
  999.     until Assigned(Thread);
  1000.   end;
  1001.   Media.Free;
  1002.   fPicture.Free;
  1003.   fBgPicture.Free;
  1004.   OffScreen.Free;
  1005.   inherited Destroy;
  1006. end;
  1007.  
  1008. procedure TCustomPicShow.SetPicture(Value: TPicture);
  1009. begin
  1010.   if Assigned(Value) then
  1011.     fPicture.Assign(Value)
  1012.   else
  1013.     fPicture.Graphic := nil;
  1014. end;
  1015.  
  1016. procedure TCustomPicShow.SetBgPicture(Value: TPicture);
  1017. begin
  1018.   if Assigned(Value) then
  1019.     fBgPicture.Assign(Value)
  1020.   else
  1021.     fBgPicture.Graphic := nil;
  1022. end;
  1023.  
  1024. procedure TCustomPicShow.SetBgMode(Value: TBackgroundMode);
  1025. begin
  1026.   if fBgMode <> Value then
  1027.   begin
  1028.     fBgMode := Value;
  1029.     if Assigned(fBgPicture.Graphic) and not Drawing then Invalidate;
  1030.   end;
  1031. end;
  1032.  
  1033. procedure TCustomPicShow.SetCenter(Value: Boolean);
  1034. begin
  1035.   if fCenter <> Value then
  1036.   begin
  1037.     fCenter := Value;
  1038.     if Assigned(fPicture.Graphic) then
  1039.     begin
  1040.       CalculatePicRect;
  1041.       if not (Media.Empty or Drawing) then Invalidate;
  1042.     end;
  1043.   end;
  1044. end;
  1045.  
  1046. procedure TCustomPicShow.SetStretch(Value: Boolean);
  1047. begin
  1048.   if fStretch <> Value then
  1049.   begin
  1050.     fStretch := Value;
  1051.     if not (Media.Empty or Drawing) then Invalidate;
  1052.   end;
  1053. end;
  1054.  
  1055. procedure TCustomPicShow.SetStretchFine(Value: Boolean);
  1056. begin
  1057.   if fStretchFine <> Value then
  1058.   begin
  1059.     fStretchFine := Value;
  1060.     if not (Media.Empty or Drawing) then Invalidate;
  1061.   end;
  1062. end;
  1063.  
  1064. procedure TCustomPicShow.SetStep(Value: Word);
  1065. begin
  1066.   if Value = 0 then Value := 1;
  1067.   if Value > High(TPercent) then Value := High(TPercent);
  1068.   fStep := Value;
  1069. end;
  1070.  
  1071. procedure TCustomPicShow.SetStyleName(const Value: String);
  1072. var
  1073.   TheStyle: TShowStyle;
  1074. begin
  1075.   for TheStyle := Low(TShowStyle) to High(TShowStyle) do
  1076.     if AnsiCompareText(PSTransitionNames[TheStyle], Value) = 0 then
  1077.     begin
  1078.       Style := TheStyle;
  1079.       Break;
  1080.     end;
  1081. end;
  1082.  
  1083. function TCustomPicShow.GetStyleName: String;
  1084. begin
  1085.   Result := PSTransitionNames[Style];
  1086. end;
  1087.  
  1088. function TCustomPicShow.GetEmpty: Boolean;
  1089. begin
  1090.   Result := not Assigned(fPicture.Graphic) or fPicture.Graphic.Empty;
  1091. end;
  1092.  
  1093. procedure TCustomPicShow.PictureChange(Sender: TObject);
  1094. begin
  1095.   if not (csDestroying in ComponentState) then
  1096.   begin
  1097.     if Assigned(fPicture.Graphic) and fAutoSize then
  1098.       AdjustClientSize;
  1099.     if Assigned(fOnChange) then
  1100.       fOnChange(Self);
  1101.   end;
  1102. end;
  1103.  
  1104. procedure TCustomPicShow.BgPictureChange(Sender: TObject);
  1105. begin
  1106.   if (fBgMode <> bmNone) and not Drawing then Invalidate;
  1107. end;
  1108.  
  1109. procedure TCustomPicShow.SetProgress(Value: TPercent);
  1110. begin
  1111.   if Value < Low(TPercent) then Value := Low(TPercent);
  1112.   if Value > High(TPercent) then Value := High(TPercent);
  1113.   if fBusy and (fProgress <> Value) then
  1114.   begin
  1115.     if (fProgress > Value) and not Drawing then
  1116.       InvalidateArea(Rect(0, 0, Media.Width, Media.Height));
  1117.     fProgress := Value;
  1118.     UpdateDisplay;
  1119.     if Assigned(fOnProgress) and not (csDestroying in ComponentState) then
  1120.       fOnProgress(Self);
  1121.   end;
  1122. end;
  1123.  
  1124. procedure TCustomPicShow.SetManual(Value: Boolean);
  1125. begin
  1126.   if fManual <> Value then
  1127.   begin
  1128.     fManual := Value;
  1129.     if not fBusy then
  1130.       if fReverse then
  1131.         fProgress := High(TPercent)
  1132.       else
  1133.         fProgress := Low(TPercent)
  1134.     else if not fManual then
  1135.       Animate;
  1136.   end;
  1137. end;
  1138.  
  1139. procedure TCustomPicShow.AnimationComplete(Sender: TObject);
  1140. begin
  1141.   Thread := nil;
  1142.   if Stopping or not fManual then
  1143.   begin
  1144.     fBusy := False;
  1145.     if Assigned(Pic) then Pic.Free;
  1146.     if Assigned(OldPic) then OldPic.Free;
  1147.     Pic := nil;
  1148.     OldPic := nil;
  1149.     if Assigned(FOnComplete) and not (csDestroying in ComponentState) and
  1150.       not Stopping then fOnComplete(Self);
  1151.   end;
  1152. end;
  1153.  
  1154. procedure TCustomPicShow.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
  1155. begin
  1156.   Msg.Result := 1;
  1157. end;
  1158.  
  1159. procedure TCustomPicShow.WMPaint(var Msg: TWMPaint);
  1160. begin
  1161.   if not Drawing and (GetCurrentThreadID = MainThreadID) then
  1162.   begin
  1163.     Drawing := True;
  1164.     try
  1165.       inherited;
  1166.     finally
  1167.       Drawing := False;
  1168.     end;
  1169.   end;
  1170. end;
  1171.  
  1172. procedure TCustomPicShow.CMMouseEnter(var Msg: TMessage);
  1173. begin
  1174.   inherited;
  1175.   if Assigned(fOnMouseEnter) then fOnMouseEnter(Self);
  1176. end;
  1177.  
  1178. procedure TCustomPicShow.CMMouseLeave(var Msg: TMessage);
  1179. begin
  1180.   inherited;
  1181.   if Assigned (fOnMouseLeave) then fOnMouseLeave(Self);
  1182. end;
  1183.  
  1184. procedure TCustomPicShow.SetAutoSize_(Value: Boolean);
  1185. begin
  1186.   if fAutoSize <> Value then
  1187.   begin
  1188.     fAutoSize := Value;
  1189.     if fAutoSize then AdjustClientSize;
  1190.   end;
  1191. end;
  1192.  
  1193. procedure TCustomPicShow.AdjustClientSize;
  1194. begin
  1195.   if Assigned(fPicture.Graphic) and (Align = alNone) then
  1196.   begin
  1197.     ClientWidth := fPicture.Width;
  1198.     ClientHeight := fPicture.Height;
  1199.   end;
  1200. end;
  1201.  
  1202. procedure TCustomPicShow.WMSize(var Msg: TWMSize);
  1203. begin
  1204.   inherited;
  1205.   if Assigned(fPicture.Graphic) then
  1206.   begin
  1207.     CalculatePicRect;
  1208.     if not (Media.Empty or Drawing) then Invalidate;
  1209.   end;
  1210. end;
  1211.  
  1212. procedure TCustomPicShow.Paint;
  1213. var
  1214.   R: TRect;
  1215.   C: TCanvas;
  1216. begin
  1217.   OffScreen.Width := ClientWidth;
  1218.   OffScreen.Height := ClientHeight;
  1219.   C := OffScreen.Canvas;
  1220.   C.Lock;
  1221.   try
  1222.     R := ClientRect;
  1223.     C.Brush.Color := Color;
  1224.     C.FillRect(R);
  1225.     if Assigned(fBgPicture.Graphic) then
  1226.       case fBgMode of
  1227.         bmTiled: DrawTiledImage(C, R, fBgPicture.Graphic);
  1228.         bmStretched: C.StretchDraw(R, fBgPicture.Graphic);
  1229.         bmCentered: C.Draw((R.Right - R.Left - fBgPicture.Width) div 2,
  1230.                            (R.Bottom - R.Top - fBgPicture.Height) div 2,
  1231.                             fBgPicture.Graphic);
  1232.       end;
  1233.     if not Media.Empty then
  1234.     begin
  1235.       if fStretch then
  1236.         if fStretchFine then
  1237.           C.StretchDraw(ScaleImageToRect(PicRect, R), Media)
  1238.         else
  1239.           C.StretchDraw(R, Media)
  1240.       else
  1241.         C.Draw(PicRect.Left, PicRect.Top, Media);
  1242.     end;
  1243.     if csDesigning in ComponentState then
  1244.     begin
  1245.       C.Pen.Style := psDash;
  1246.       C.Brush.Style := bsClear;
  1247.       C.Rectangle(0, 0, Width, Height);
  1248.     end;
  1249.   finally
  1250.     C.Unlock;
  1251.   end;
  1252.   Canvas.Lock;
  1253.   try
  1254.     Canvas.Draw(0, 0, OffScreen);
  1255.   finally
  1256.     Canvas.Unlock;
  1257.   end;
  1258. end;
  1259.  
  1260. procedure TCustomPicShow.CalculatePicRect;
  1261. begin
  1262.   if not Media.Empty then
  1263.   begin
  1264.     SetRect(PicRect, 0, 0, Media.Width, Media.Height);
  1265.     if fCenter then
  1266.       OffsetRect(PicRect, (ClientWidth - Media.Width) div 2,
  1267.                           (ClientHeight - Media.Height) div 2);
  1268.   end;
  1269. end;
  1270.  
  1271. procedure TCustomPicShow.InvalidateArea(Area: TRect);
  1272. var
  1273.   R: TRect;
  1274. begin
  1275.   if fStretch then
  1276.   begin
  1277.     if fStretchFine then
  1278.       R := ScaleImageToRect(PicRect, ClientRect)
  1279.     else
  1280.       R := ClientRect;
  1281.     Area.Left := R.Left + MulDiv(Area.Left, R.Right - R.Left, PicRect.Right - PicRect.Left);
  1282.     Area.Right := R.Left + MulDiv(Area.Right, R.Right - R.Left, PicRect.Right - PicRect.Left);
  1283.     Area.Top := R.Top + MulDiv(Area.Top, R.Bottom - R.Top, PicRect.Bottom - PicRect.Top);
  1284.     Area.Bottom := R.Top + MulDiv(Area.Bottom, R.Bottom - R.Top, PicRect.Bottom - PicRect.Top);
  1285.   end
  1286.   else
  1287.   begin
  1288.     if fCenter then OffsetRect(Area, PicRect.Left, PicRect.Top);
  1289.     if Area.Left < PicRect.Left then Area.Left := PicRect.Left;
  1290.     if Area.Right > PicRect.Right then Area.Right := PicRect.Right;
  1291.     if Area.Top < PicRect.Top then Area.Top := PicRect.Top;
  1292.     if Area.Bottom > PicRect.Bottom then Area.Bottom := PicRect.Bottom;
  1293.   end;
  1294.   if not (csDestroying in ComponentState) then
  1295.   begin
  1296.     {$IFDEF WINCONTROL_PICSHOW}
  1297.     InvalidateRect(Handle, @Area, False);
  1298.     {$ELSE}
  1299.     OffsetRect(Area, Left, Top);
  1300.     InvalidateRect(Parent.Handle, @Area, False);
  1301.     {$ENDIF}
  1302.   end;
  1303. end;
  1304.  
  1305. Procedure TCustomPicShow.Clear;
  1306. begin
  1307.   if not (fBusy or Media.Empty) then
  1308.   begin
  1309.     if Media.Canvas.TryLock then
  1310.     begin
  1311.       Media.Canvas.Unlock;
  1312.       Media.Free;
  1313.       Media := TBitmap.Create;
  1314.       Media.PixelFormat := pf24bit;
  1315.       Invalidate;
  1316.     end;
  1317.   end;
  1318. end;
  1319.  
  1320. procedure TCustomPicShow.Stop;
  1321. begin
  1322.   if fBusy and not Stopping then
  1323.   begin
  1324.     Stopping := True;
  1325.     try
  1326.       if Assigned(Thread) then
  1327.       begin
  1328.         Thread.Terminate;
  1329.         repeat
  1330.           Application.ProcessMessages;
  1331.         until Assigned(Thread);
  1332.       end
  1333.       else
  1334.         AnimationComplete(nil);
  1335.     finally
  1336.       Stopping := False;
  1337.     end;
  1338.   end;
  1339. end;
  1340.  
  1341. procedure TCustomPicShow.Execute;
  1342. begin
  1343.   if not fBusy and Assigned(Picture.Graphic) then
  1344.   begin
  1345.     fBusy := True;
  1346.     try
  1347.       Prepare;
  1348.       if not fManual then Animate;
  1349.     except
  1350.       if Assigned(Pic) then Pic.Free;
  1351.       if Assigned(OldPic) then OldPic.Free;
  1352.       fBusy := False;
  1353.       raise;
  1354.     end;
  1355.   end;
  1356. end;
  1357.  
  1358. procedure TCustomPicShow.Animate;
  1359. var
  1360.   StartTime: DWord;
  1361.   Done: Boolean;
  1362. begin
  1363.   if fThreaded then
  1364.     Thread := TAnimateThread.Create(Self)
  1365.   else
  1366.   begin
  1367.     repeat
  1368.       StartTime := GetTickCount;
  1369.       if Reverse then
  1370.         if Progress - Step >= Low(TPercent) then
  1371.           Progress := Progress - Step
  1372.         else
  1373.           Progress := Low(TPercent)
  1374.       else
  1375.         if Progress + Step <= High(TPercent) then
  1376.           Progress := Progress + Step
  1377.         else
  1378.           Progress := High(TPercent);
  1379.       Done := (Reverse and (Progress = Low(TPercent))) or
  1380.               (not Reverse and (Progress = High(TPercent)));
  1381.       if not Done then
  1382.         repeat
  1383.           Application.ProcessMessages;
  1384.         until ((GetTickCount - StartTime) > Delay) or not fBusy or fManual or Stopping;
  1385.     until Done or not fBusy or fManual or Stopping;
  1386.     if Done then AnimationComplete(nil);
  1387.   end;
  1388. end;
  1389.  
  1390. procedure TCustomPicShow.Prepare;
  1391. var
  1392.   R: TRect;
  1393. begin
  1394.   Media.Canvas.Brush.Color := Color;
  1395.   Media.Width := fPicture.Width;
  1396.   Media.Height := fPicture.Height;
  1397.   CalculatePicRect;
  1398.   OldPic := TBitmap.Create;
  1399.   OldPic.Width := Media.Width;
  1400.   OldPic.Height := Media.Height;
  1401.   OldPic.PixelFormat := pf24bit;
  1402.   if fStretch then
  1403.     if fStretchFine then
  1404.       R := ScaleImageToRect(PicRect, ClientRect)
  1405.     else
  1406.       R := ClientRect
  1407.   else
  1408.     R := PicRect;
  1409.   OldPic.Canvas.CopyRect(Rect(0, 0, OldPic.Width, OldPic.Height), OffScreen.Canvas, R);
  1410.   Pic := TBitmap.Create;
  1411.   Pic.Width := Media.Width;
  1412.   Pic.Height := Media.Height;
  1413.   Pic.PixelFormat := pf24bit;
  1414.   Pic.Canvas.Draw(0, 0, fPicture.Graphic);
  1415.   if Reverse then
  1416.     Progress := High(TPercent)
  1417.   else
  1418.     Progress := Low(TPercent);
  1419. end;
  1420.  
  1421. procedure TCustomPicShow.UpdateDisplay;
  1422. var
  1423.   X, Y, W, H: Integer;
  1424.   R, Rgn: HRgn;
  1425.   R1, R2: TRect;
  1426.   I, J, S: Integer;
  1427. begin
  1428.   Media.Canvas.Draw(0, 0, OldPic);
  1429.   if Assigned(fOnBeforeNewFrame) then
  1430.     fOnBeforeNewFrame(Self, Pic, Media);
  1431.   W := Pic.Width;
  1432.   H := Pic.Height;
  1433.   SetRect(R1, 0, 0, W, H);
  1434.   SetRect(R2, 0, 0, W, H);
  1435.   Rgn := NULLREGION;
  1436.   if W >= H then
  1437.   begin
  1438.     X := MulDiv(W, fProgress, 100);
  1439.     Y := MulDiv(X, H, W);
  1440.     S := MulDiv(W, fStep, 90);
  1441.   end
  1442.   else
  1443.   begin
  1444.     Y := MulDiv(H, fProgress, 100);
  1445.     X := MulDiv(Y, W, H);
  1446.     S := MulDiv(H, fStep, 90);
  1447.   end;
  1448.   case fStyle of
  1449.       0: begin
  1450.            if Assigned(fOnCustomDraw) then
  1451.              fOnCustomDraw(Self, Pic, Media)
  1452.            else
  1453.            begin
  1454.              Media.Canvas.Draw(0, 0, Pic);
  1455.              Rgn := CreateRectRgn(0, 0, W, H);
  1456.              fProgress := High(TPercent);
  1457.            end;
  1458.          end;
  1459.       1: begin
  1460.            R1.Left := W - X;
  1461.          end;
  1462.       2: begin
  1463.            R1.Right := X;
  1464.          end;
  1465.       3: begin
  1466.            R1.Left := W - X;
  1467.            R1.Right := (2 * W) - X;
  1468.          end;
  1469.       4: begin
  1470.            R1.Left := X - W;
  1471.            R1.Right := X;
  1472.          end;
  1473.       5: begin
  1474.            R1.Right := X;
  1475.            R2.Right := X;
  1476.          end;
  1477.       6: begin
  1478.            R1.Left := W - X;
  1479.            R2.Left := W - X;
  1480.          end;
  1481.       7: begin
  1482.            R1.Right := (2 * W) - X;
  1483.            R2.Right := X;
  1484.          end;
  1485.       8: begin
  1486.            R1.Left := X - W;
  1487.            R2.Left := W - X;
  1488.          end;
  1489.       9: begin
  1490.            R1.Left := X - W;
  1491.            R1.Right := (2 * W) - X;
  1492.            R2.Left := (W - X) div 2;
  1493.            R2.Right := (W + X) div 2;
  1494.          end;
  1495.      10: begin
  1496.            R1.Left := (W - X) div 2;
  1497.            R1.Right := (W + X) div 2;
  1498.          end;
  1499.      11: begin
  1500.            R1.Left := (W - X) div 2;
  1501.            R1.Right := (W + X) div 2;
  1502.            R2.Left := (W - X) div 2;
  1503.            R2.Right := (W + X) div 2;
  1504.          end;
  1505.      12: begin
  1506.            R1.Left := 0;
  1507.            R1.Right := (X div 2) + 1;
  1508.            R2.Left := 0;
  1509.            R2.Right := (X div 2) + 1;
  1510.            Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
  1511.            InvalidateArea(R1);
  1512.            R1.Left := W - (X div 2) - 1;
  1513.            R1.Right := W;
  1514.            R2.Left := W - (X div 2) - 1;
  1515.            R2.Right := W;
  1516.          end;
  1517.      13: begin
  1518.            R1.Left := 0;
  1519.            R1.Right := (X div 2) + 1;
  1520.            R2.Left := 0;
  1521.            R2.Right := (W div 2) + 1;
  1522.            Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
  1523.            InvalidateArea(R1);
  1524.            R1.Left := W - (X div 2) - 1;
  1525.            R1.Right := W;
  1526.            R2.Left := W div 2;
  1527.            R2.Right := W;
  1528.          end;
  1529.      14: begin
  1530.            R1.Left := X;
  1531.            if R1.Left < W div 5 then
  1532.              R1.Right := R1.Left + X div 2
  1533.            else if (R1.Left + W div 5) > W then
  1534.              R1.Right := R1.Left + (W - X) div 2
  1535.            else
  1536.              R1.Right := R1.Left + W div 10;
  1537.            R2.Left := R1.Right;
  1538.            R2.Right := R2.Left + R1.Right - R1.Left;
  1539.            MirrorCopyRect(Media.Canvas, R1, Pic, R2, True, False);
  1540.            InvalidateArea(R1);
  1541.            R1.Left := 0;
  1542.            R1.Right := X;
  1543.            R2.Left := 0;
  1544.            R2.Right := X;
  1545.          end;
  1546.      15: begin
  1547.            R1.Right := W - X;
  1548.            if (R1.Right + W div 5) > W then
  1549.              R1.Left := R1.Right - X div 2
  1550.            else if R1.Right < W div 5 then
  1551.              R1.Left := R1.Right - (W - X) div 2
  1552.            else
  1553.              R1.Left := R1.Right - W div 10;
  1554.            R2.Right := R1.Left;
  1555.            R2.Left := R2.Right - R1.Right + R1.Left;
  1556.            MirrorCopyRect(Media.Canvas, R1, Pic, R2, True, False);
  1557.            InvalidateArea(R1);
  1558.            R1.Left := W - X;
  1559.            R1.Right := W;
  1560.            R2.Left := W - X;
  1561.            R2.Right := W;
  1562.          end;
  1563.      16: begin
  1564.            R1.Left := 0;
  1565.            R1.Right := X;
  1566.            R2.Left := 0;
  1567.            R2.Right := X;
  1568.            Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
  1569.            InvalidateArea(R1);
  1570.            R1.Left := X;
  1571.            R1.Right := W;
  1572.            R2.Left := X;
  1573.            R2.Right := X + W div 20;
  1574.          end;
  1575.      17: begin
  1576.            R1.Left := W - X;
  1577.            R1.Right := W;
  1578.            R2.Left := W - X;
  1579.            R2.Right := W;
  1580.            Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
  1581.            InvalidateArea(R1);
  1582.            R1.Left := 0;
  1583.            R1.Right := W - X;
  1584.            R2.Left := (W - X) - W div 20;
  1585.            R2.Right := W - X;
  1586.          end;
  1587.      18: begin
  1588.            R1.Top := H - Y;
  1589.          end;
  1590.      19: begin
  1591.            R1.Bottom := Y;
  1592.          end;
  1593.      20: begin
  1594.            R1.Top := H - Y;
  1595.            R1.Bottom := (2 * H) - Y;
  1596.          end;
  1597.      21: begin
  1598.            R1.Top := Y - H;
  1599.            R1.Bottom := Y;
  1600.          end;
  1601.      22: begin
  1602.            R1.Bottom := Y;
  1603.            R2.Bottom := Y;
  1604.          end;
  1605.      23: begin
  1606.            R1.Top := H - Y;
  1607.            R2.Top := H - Y;
  1608.          end;
  1609.      24: begin
  1610.            R1.Bottom := (2 * H) - Y;
  1611.            R2.Bottom := Y;
  1612.          end;
  1613.      25: begin
  1614.            R1.Top := Y - H;
  1615.            R2.Top := H - Y;
  1616.          end;
  1617.      26: begin
  1618.            R1.Top := Y - H;
  1619.            R1.Bottom := (2 * H) - Y;
  1620.            R2.Top := (H - Y) div 2;
  1621.            R2.Bottom := (H + Y) div 2;
  1622.          end;
  1623.      27: begin
  1624.            R1.Top := (H - Y) div 2;
  1625.            R1.Bottom := (H + Y) div 2;
  1626.          end;
  1627.      28: begin
  1628.            R1.Top := (H - Y) div 2;
  1629.            R1.Bottom := (H + Y) div 2;
  1630.            R2.Top := (H - Y) div 2;
  1631.            R2.Bottom := (H + Y) div 2;
  1632.          end;
  1633.      29: begin
  1634.            R1.Top := 0;
  1635.            R1.Bottom := (Y div 2) + 1;
  1636.            R2.Top := 0;
  1637.            R2.Bottom := (Y div 2) + 1;
  1638.            Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
  1639.            InvalidateArea(R1);
  1640.            R1.Top := H - (Y div 2) - 1;
  1641.            R1.Bottom := H;
  1642.            R2.Top := H - (Y div 2) - 1;
  1643.            R2.Bottom := H;
  1644.          end;
  1645.      30: begin
  1646.            R1.Top := 0;
  1647.            R1.Bottom := (Y div 2) + 1;
  1648.            R2.Top := 0;
  1649.            R2.Bottom := (H div 2) + 1;
  1650.            Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
  1651.            InvalidateArea(R1);
  1652.            R1.Top := H - (Y div 2) - 1;
  1653.            R1.Bottom := H;
  1654.            R2.Top := H div 2;
  1655.            R2.Bottom := H;
  1656.          end;
  1657.      31: begin
  1658.            R1.Top := Y;
  1659.            if R1.Top < H div 5 then
  1660.              R1.Bottom := R1.Top + Y div 2
  1661.            else if (R1.Top + H div 5) > H then
  1662.              R1.Bottom := R1.Top + (H - Y) div 2
  1663.            else
  1664.              R1.Bottom := R1.Top + H div 10;
  1665.            R2.Top := R1.Bottom;
  1666.            R2.Bottom := R2.Top + R1.Bottom - R1.Top;
  1667.            MirrorCopyRect(Media.Canvas, R1, Pic, R2, False, True);
  1668.            InvalidateArea(R1);
  1669.            R1.Top := 0;
  1670.            R1.Bottom := Y;
  1671.            R2.Top := 0;
  1672.            R2.Bottom := Y;
  1673.          end;
  1674.      32: begin
  1675.            R1.Bottom := H - Y;
  1676.            if (R1.Bottom + H div 5) > H then
  1677.              R1.Top := R1.Bottom - Y div 2
  1678.            else if R1.Bottom < H div 5 then
  1679.              R1.Top := R1.Bottom - (H - Y) div 2
  1680.            else
  1681.              R1.Top := R1.Bottom - H div 10;
  1682.            R2.Bottom := R1.Top;
  1683.            R2.Top := R2.Bottom - R1.Bottom + R1.Top;
  1684.            MirrorCopyRect(Media.Canvas, R1, Pic, R2, False, True);
  1685.            InvalidateArea(R1);
  1686.            R1.Top := H - Y;
  1687.            R1.Bottom := H;
  1688.            R2.Top := H - Y;
  1689.            R2.Bottom := H;
  1690.          end;
  1691.      33: begin
  1692.            R1.Top := 0;
  1693.            R1.Bottom := Y;
  1694.            R2.Top := 0;
  1695.            R2.Bottom := Y;
  1696.            Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
  1697.            InvalidateArea(R1);
  1698.            R1.Top := Y;
  1699.            R1.Bottom := H;
  1700.            R2.Top := Y;
  1701.            R2.Bottom := Y + H div 20;
  1702.          end;
  1703.      34: begin
  1704.            R1.Top := H - Y;
  1705.            R1.Bottom := H;
  1706.            R2.Top := H - Y;
  1707.            R2.Bottom := H;
  1708.            Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
  1709.            InvalidateArea(R1);
  1710.            R1.Top := 0;
  1711.            R1.Bottom := H - Y;
  1712.            R2.Top := (H - Y) - H div 20;
  1713.            R2.Bottom := H - Y;
  1714.          end;
  1715.      35: begin
  1716.            R1.Left := W - X;
  1717.            R1.Top := H - Y;
  1718.          end;
  1719.      36: begin
  1720.            R1.Left := W - X;
  1721.            R1.Bottom := Y;
  1722.          end;
  1723.      37: begin
  1724.            R1.Right := X;
  1725.            R1.Bottom := Y;
  1726.          end;
  1727.      38: begin
  1728.            R1.Right := X;
  1729.            R1.Top := H - Y;
  1730.          end;
  1731.      39: begin
  1732.            R1.Left := W - X;
  1733.            R1.Top := H - Y;
  1734.            R1.Right := (2 * W) - X;
  1735.            R1.Bottom := (2 * H) - Y;
  1736.          end;
  1737.      40: begin
  1738.            R1.Left := W - X;
  1739.            R1.Top := Y - H;
  1740.            R1.Right := (2 * W) - X;
  1741.            R1.Bottom := Y;
  1742.          end;
  1743.      41: begin
  1744.            R1.Left := X - W;
  1745.            R1.Top := Y - H;
  1746.            R1.Right := X;
  1747.            R1.Bottom := Y;
  1748.          end;
  1749.      42: begin
  1750.            R1.Left := X - W;
  1751.            R1.Top := H - Y;
  1752.            R1.Right := X;
  1753.            R1.Bottom := (2 * H) - Y;
  1754.          end;
  1755.      43: begin
  1756.            R1.Right := X;
  1757.            R1.Bottom := Y;
  1758.            R2.Right := X;
  1759.            R2.Bottom := Y;
  1760.          end;
  1761.      44: begin
  1762.            R1.Right := X;
  1763.            R1.Top := H - Y;
  1764.            R2.Right := X;
  1765.            R2.Top := H - Y;
  1766.          end;
  1767.      45: begin
  1768.            R1.Left := W - X;
  1769.            R1.Top := H - Y;
  1770.            R2.Left := W - X;
  1771.            R2.Top := H - Y;
  1772.          end;
  1773.      46: begin
  1774.            R1.Left := W - X;
  1775.            R1.Bottom := Y;
  1776.            R2.Left := W - X;
  1777.            R2.Bottom := Y;
  1778.          end;
  1779.      47: begin
  1780.            R1.Right := (2 * W) - X;
  1781.            R1.Bottom := (2 * H) - Y;
  1782.            R2.Right := X;
  1783.            R2.Bottom := Y;
  1784.          end;
  1785.      48: begin
  1786.            R1.Right := (2 * W) - X;
  1787.            R1.Top := Y - H;
  1788.            R2.Right := X;
  1789.            R2.Top := H - Y;
  1790.          end;
  1791.      49: begin
  1792.            R1.Left := X - W;
  1793.            R1.Top := Y - H;
  1794.            R2.Left := W - X;
  1795.            R2.Top := H - Y;
  1796.          end;
  1797.      50: begin
  1798.            R1.Left := X - W;
  1799.            R1.Bottom := (2 * H) - Y;
  1800.            R2.Left := W - X;
  1801.            R2.Bottom := Y;
  1802.          end;
  1803.      51: begin
  1804.            R1.Left := X - W;
  1805.            R1.Top := Y - H;
  1806.            R1.Right := (2 * W) - X;
  1807.            R1.Bottom := (2 * H) - Y;
  1808.            R2.Left := (W - X) div 2;
  1809.            R2.Top := (H - Y) div 2;
  1810.            R2.Right := (W + X) div 2;
  1811.            R2.Bottom := (H + Y) div 2;
  1812.          end;
  1813.      52: begin
  1814.            R1.Left := (W - X) div 2;
  1815.            R1.Top := (H - Y) div 2;
  1816.            R1.Right := (W + X) div 2;
  1817.            R1.Bottom := (H + Y) div 2;
  1818.          end;
  1819.      53: begin
  1820.            R1.Left := (W - X) div 2;
  1821.            R1.Top := (H - Y) div 2;
  1822.            R1.Right := (W + X) div 2;
  1823.            R1.Bottom := (H + Y) div 2;
  1824.            R2.Left := (W - X) div 2;
  1825.            R2.Top := (H - Y) div 2;
  1826.            R2.Right := (W + X) div 2;
  1827.            R2.Bottom := (H + Y) div 2;
  1828.          end;
  1829.      54: begin
  1830.            R1.Left := 0;
  1831.            R1.Right := W;
  1832.            R1.Top := 0;
  1833.            R1.Bottom := Y div 2;
  1834.            R2.Left := 0;
  1835.            R2.Right := W;
  1836.            R2.Top := 0;
  1837.            R2.Bottom := Y div 2;
  1838.            Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
  1839.            InvalidateArea(R1);
  1840.            R1.Left := 0;
  1841.            R1.Right := W;
  1842.            R1.Top := H - (Y div 2);
  1843.            R1.Bottom := H;
  1844.            R2.Left := 0;
  1845.            R2.Right := W;
  1846.            R2.Top := H - (Y div 2);
  1847.            R2.Bottom := H;
  1848.            Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
  1849.            InvalidateArea(R1);
  1850.            R1.Left := 0;
  1851.            R1.Right := X div 2;
  1852.            R1.Top := 0;
  1853.            R1.Bottom := H;
  1854.            R2.Left := 0;
  1855.            R2.Right := X div 2;
  1856.            R2.Top := 0;
  1857.            R2.Bottom := H;
  1858.            Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
  1859.            InvalidateArea(R1);
  1860.            R1.Left := W - (X div 2);
  1861.            R1.Right := W;
  1862.            R1.Top := 0;
  1863.            R1.Bottom := H;
  1864.            R2.Left := W - (X div 2);
  1865.            R2.Right := W;
  1866.            R2.Top := 0;
  1867.            R2.Bottom := H;
  1868.          end;
  1869.      55: begin
  1870.            R1.Left := 0;
  1871.            R1.Top := 0;
  1872.            R1.Right := (X div 2) + 1;
  1873.            R1.Bottom := (Y div 2) + 1;
  1874.            R2.Left := 0;
  1875.            R2.Top := 0;
  1876.            R2.Right := (X div 2) + 1;
  1877.            R2.Bottom := (Y div 2) + 1;
  1878.            Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
  1879.            InvalidateArea(R1);
  1880.            R1.Left := 0;
  1881.            R1.Top := H - (Y div 2) - 1;
  1882.            R1.Right := (X div 2) + 1;
  1883.            R1.Bottom := H;
  1884.            R2.Left := 0;
  1885.            R2.Top := H - (Y div 2) - 1;
  1886.            R2.Right := (X div 2) + 1;
  1887.            R2.Bottom := H;
  1888.            Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
  1889.            InvalidateArea(R1);
  1890.            R1.Left := W - (X div 2) - 1;
  1891.            R1.Top := H - (Y div 2) - 1;
  1892.            R1.Right := W;
  1893.            R1.Bottom := H;
  1894.            R2.Left := W - (X div 2) - 1;
  1895.            R2.Top := H - (Y div 2) - 1;
  1896.            R2.Right := W;
  1897.            R2.Bottom := H;
  1898.            Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
  1899.            InvalidateArea(R1);
  1900.            R1.Left := W - (X div 2) - 1;
  1901.            R1.Top := 0;
  1902.            R1.Right := W;
  1903.            R1.Bottom := (Y div 2) + 1;
  1904.            R2.Left := W - (X div 2) - 1;
  1905.            R2.Top := 0;
  1906.            R2.Right := W;
  1907.            R2.Bottom := (Y div 2) + 1;
  1908.          end;
  1909.      56: begin
  1910.            R1.Left := 0;
  1911.            R1.Top := 0;
  1912.            R1.Right := (X div 2) + 1;
  1913.            R1.Bottom := (Y div 2) + 1;
  1914.            R2.Left := 0;
  1915.            R2.Top := 0;
  1916.            R2.Right := (W div 2) + 1;
  1917.            R2.Bottom := (H div 2) + 1;
  1918.            Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
  1919.            InvalidateArea(R1);
  1920.            R1.Left := 0;
  1921.            R1.Top := H - (Y div 2);
  1922.            R1.Right := (X div 2) + 1;
  1923.            R1.Bottom := H;
  1924.            R2.Left := 0;
  1925.            R2.Top := (H div 2) + 1;
  1926.            R2.Right := (W div 2) + 1;
  1927.            R2.Bottom := H;
  1928.            Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
  1929.            InvalidateArea(R1);
  1930.            R1.Left := W - (X div 2);
  1931.            R1.Top := H - (Y div 2);
  1932.            R1.Right := W;
  1933.            R1.Bottom := H;
  1934.            R2.Left := (W div 2) + 1;
  1935.            R2.Top := (H div 2) + 1;
  1936.            R2.Right := W;
  1937.            R2.Bottom := H;
  1938.            Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
  1939.            InvalidateArea(R1);
  1940.            R1.Left := W - (X div 2);
  1941.            R1.Top := 0;
  1942.            R1.Right := W;
  1943.            R1.Bottom := (Y div 2) + 1;
  1944.            R2.Left := (W div 2) + 1;
  1945.            R2.Top := 0;
  1946.            R2.Right := W;
  1947.            R2.Bottom := (H div 2) + 1;
  1948.          end;
  1949.      57: begin
  1950.            R1.Left := (X - W) div 2;
  1951.            R1.Right := (X div 2) + 1;
  1952.            R1.Top := 0;
  1953.            R1.Bottom := (H div 2) + 1;
  1954.            R2.Left := 0;
  1955.            R2.Right := (W div 2) + 1;
  1956.            R2.Top := 0;
  1957.            R2.Bottom := (H div 2) + 1;
  1958.            Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
  1959.            InvalidateArea(R1);
  1960.            R1.Left := (W div 2) - 1;
  1961.            R1.Right := W;
  1962.            R1.Top := (Y - H) div 2;
  1963.            R1.Bottom := (Y div 2) + 1;
  1964.            R2.Left := (W div 2) - 1;
  1965.            R2.Right := W;
  1966.            R2.Top := 0;
  1967.            R2.Bottom := (H div 2) + 1;
  1968.            Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
  1969.            InvalidateArea(R1);
  1970.            R1.Left := W - X div 2;
  1971.            R1.Right := W + (W - X) div 2;
  1972.            R1.Top := (H div 2) - 1;
  1973.            R1.Bottom := H;
  1974.            R2.Left := (W div 2) + 1;
  1975.            R2.Right := W;
  1976.            R2.Top := (H div 2) - 1;
  1977.            R2.Bottom := H;
  1978.            Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
  1979.            InvalidateArea(R1);
  1980.            R1.Left := 0;
  1981.            R1.Right := (W div 2) + 1;
  1982.            R1.Top := H - Y div 2;
  1983.            R1.Bottom := H + (H - Y) div 2;
  1984.            R2.Left := 0;
  1985.            R2.Right := (W div 2) + 1;
  1986.            R2.Top := (H div 2) + 1;
  1987.            R2.Bottom := H;
  1988.          end;
  1989.      58: Rgn := CreateRoundRectRgn(-(2 * W), -5, 2 * X, H + 5, 2 * W, 2 * W);
  1990.      59: Rgn := CreateRoundRectRgn(W - 2 * X, -5, W + (2 * W), H + 5, 2 * W, 2 * W);
  1991.      60: Rgn := CreateBarRgn(2 * X, 0, W, H, S, 1, 0);
  1992.      61: Rgn := CreateBarRgn(2 * X, 0, W, H, S, 2, 0);
  1993.      62: Rgn := CreateBarRgn(2 * X, 0, W, H, S, 4, 0);
  1994.      63: Rgn := CreateBarRgn(2 * X, 0, W, H, S, 5, 0);
  1995.      64: Rgn := CreateBarRgn(X, 0, W, H, 0, 3, 0);
  1996.      65: Rgn := CreateSplashRgn(X, 0, W, H, 1, 0);
  1997.      66: Rgn := CreateSplashRgn(X, 0, W, H, 2, 0);
  1998.      67: Rgn := CreateSplashRgn(X, 0, W, H, 3, 0);
  1999.      68: Rgn := CreateSplashRgn(X, 0, W, H, 4, 0);
  2000.      69: Rgn := CreateRoundRectRgn(-5, -(2 * H), W + 5, 2 * Y, 2 * H, 2 * H);
  2001.      70: Rgn := CreateRoundRectRgn(-5, H - 2 * Y, W + 5, H + (2 * H), 2 * H, 2 * H);
  2002.      71: Rgn := CreateBarRgn(0, 2 * Y, W, H, S, 0, 1);
  2003.      72: Rgn := CreateBarRgn(0, 2 * Y, W, H, S, 0, 2);
  2004.      73: Rgn := CreateBarRgn(0, 2 * Y, W, H, S, 0, 4);
  2005.      74: Rgn := CreateBarRgn(0, 2 * Y, W, H, S, 0, 5);
  2006.      75: Rgn := CreateBarRgn(0, Y, W, H, 0, 0, 3);
  2007.      76: Rgn := CreateSplashRgn(0, Y, W, H, 0, 1);
  2008.      77: Rgn := CreateSplashRgn(0, Y, W, H, 0, 2);
  2009.      78: Rgn := CreateSplashRgn(0, Y, W, H, 0, 3);
  2010.      79: Rgn := CreateSplashRgn(0, Y, W, H, 0, 4);
  2011.      80: Rgn := CreateRoundRectRgn(-(2 * W), -(2 * H), 2 * X, 2 * Y, 2 * W, 2 * H);
  2012.      81: Rgn := CreateRoundRectRgn(W - 2 * X, -(2 * H), W + (2 * W), 2 * Y, 2 * W, 2 * H);
  2013.      82: Rgn := CreateRoundRectRgn(-(2 * W), H - 2 * Y, 2 * X, H + (2 * H), 2 * W, 2 * H);
  2014.      83: Rgn := CreateRoundRectRgn(W - 2 * X, H - 2 * Y, W + (2 * W), H + (2 * H), 2 * H, 2 * H);
  2015.      84: Rgn := CreateRoundRectRgn(W div 2 - X, H div 2 - Y, W div 2 + X, H div 2 + Y, 9 * X div 5, 9 * Y div 5);
  2016.      85: begin
  2017.            R := CreateRectRgn(0, 0, W, H);
  2018.            Rgn := CreateRoundRectRgn(X - W div 2, Y - H div 2, 3 * W div 2 - X,
  2019.              3 * H div 2 - Y, 9 * (W - X) div 5, 9 * (H - Y) div 5);
  2020.            CombineRgn(Rgn, Rgn, R, RGN_XOR);
  2021.            DeleteObject(R);
  2022.          end;
  2023.      86: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 1, 1);
  2024.      87: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 1, 2);
  2025.      88: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 2, 1);
  2026.      89: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 2, 2);
  2027.      90: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 4, 4);
  2028.      91: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 4, 5);
  2029.      92: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 5, 4);
  2030.      93: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 5, 5);
  2031.      94: Rgn := CreateBarRgn(X, Y, W, H, S, 1, 3);
  2032.      95: Rgn := CreateBarRgn(X, Y, W, H, S, 2, 3);
  2033.      96: Rgn := CreateBarRgn(X, Y, W, H, S, 3, 1);
  2034.      97: Rgn := CreateBarRgn(X, Y, W, H, S, 3, 2);
  2035.      98: Rgn := CreateBarRgn(X, Y, W, H, 0, 3, 3);
  2036.      99: begin
  2037.            R := CreateBarRgn(2 * X, 2 * Y, W, H, S, 1, 1);
  2038.            Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 2, 2);
  2039.            CombineRgn(Rgn, Rgn, R, RGN_AND);
  2040.            DeleteObject(R);
  2041.          end;
  2042.     100: Rgn := CreateSplashRgn(X, Y, W, H, 1, 1);
  2043.     101: Rgn := CreateSplashRgn(X, Y, W, H, 1, 2);
  2044.     102: Rgn := CreateSplashRgn(X, Y, W, H, 2, 1);
  2045.     103: Rgn := CreateSplashRgn(X, Y, W, H, 2, 2);
  2046.     104: Rgn := CreateSplashRgn(X, Y, W, H, 1, 3);
  2047.     105: Rgn := CreateSplashRgn(X, Y, W, H, 2, 3);
  2048.     106: Rgn := CreateSplashRgn(X, Y, W, H, 3, 1);
  2049.     107: Rgn := CreateSplashRgn(X, Y, W, H, 3, 2);
  2050.     108: Rgn := CreateSplashRgn(X, Y, W, H, 3, 3);
  2051.     109: Rgn := CreateSplashRgn(X, Y, W, H, 4, 4);
  2052.     // Thanks to M. R. Zamani for followinf 8 effects (110..117)
  2053.     110: Rgn := CreateTriangleRgn(0, 0, 2 * X, 0, 0, 2 * Y);
  2054.     111: Rgn := CreateTriangleRgn(W, 0, W - 2 * X, 0, W, 2 * Y);
  2055.     112: Rgn := CreateTriangleRgn(0, H, 2 * X, H, 0, H - 2 * Y);
  2056.     113: Rgn := CreateTriangleRgn(W, H, W - 2 * X, H, W, H - 2 * Y);
  2057.     114: begin
  2058.            R := CreateTriangleRgn(0, H, 0, 0, X, H);
  2059.            Rgn := CreateTriangleRgn(W, H, W, 0, W - X, 0);
  2060.            CombineRgn(Rgn, Rgn, R, RGN_OR);
  2061.            DeleteObject(R);
  2062.          end;
  2063.     115: begin
  2064.            R := CreateTriangleRgn(W, 0, 0, 0, W, Y);
  2065.            Rgn := CreateTriangleRgn(W, H, 0, H, 0, H - Y);
  2066.            CombineRgn(Rgn, Rgn, R, RGN_OR);
  2067.            DeleteObject(R);
  2068.          end;
  2069.     116: begin
  2070.            Rgn := CreateTriangleRgn(W div 2, H div 2, 0, H, 0, H - Y);
  2071.            R := CreateTriangleRgn(0, 0, X, 0, W div 2, H div 2);
  2072.            CombineRgn(Rgn, Rgn, R, RGN_OR);
  2073.            DeleteObject(R);
  2074.            R := CreateTriangleRgn(W - X, H, W div 2, H div 2, W, H);
  2075.            CombineRgn(Rgn, Rgn, R, RGN_OR);
  2076.            DeleteObject(R);
  2077.            R := CreateTriangleRgn(W div 2, H div 2, W, 0, W, Y);
  2078.            CombineRgn(Rgn, Rgn, R, RGN_OR);
  2079.            DeleteObject(R);
  2080.          end;
  2081.     117: begin
  2082.            X := X div 5;
  2083.            Y := MulDiv(X, H, W);
  2084.            for J := 0 to 9 do
  2085.            begin
  2086.              for I := 0 to 9 do
  2087.              begin
  2088.                R := CreateTriangleRgn(I * W div 10, J * H div 10,
  2089.                  I * W div 10 + X, J * H div 10, I * W div 10, J * H div 10 + Y);
  2090.                if Rgn <> NULLREGION then
  2091.                begin
  2092.                  CombineRgn(Rgn, Rgn, R, RGN_OR);
  2093.                  DeleteObject(R);
  2094.                end
  2095.                else
  2096.                  Rgn := R;
  2097.              end;
  2098.            end;
  2099.          end;
  2100.     118: MergeTransparent(Media, Pic, Progress);
  2101.     119: MergeRotate(Media, Pic, -1, -1, (100-Progress) * PI / 200);
  2102.     120: MergeRotate(Media, Pic, -1, H, (100-Progress) * PI / 200);
  2103.     121: MergeRotate(Media, Pic, W, -1, (100-Progress) * PI / 200);
  2104.     122: MergeRotate(Media, Pic, W, H, (100-Progress) * PI / 200);
  2105.     // Thanks to Elliott Shevin for following 4 effects (123..126)
  2106.     123: Rgn := CreateSwarmRgn(X, Y, W, H, 1, 0);
  2107.     124: Rgn := CreateSwarmRgn(X, Y, W, H, 2, 0);
  2108.     125: Rgn := CreateSwarmRgn(X, Y, W, H, 0, 1);
  2109.     126: Rgn := CreateSwarmRgn(X, Y, W, H, 0, 2);
  2110.     127: Rgn := CreateBoxesRgn(W, H, Progress);
  2111.   else
  2112.     Exit;
  2113.   end; // end of case
  2114.   if fProgress = High(TPercent) then begin
  2115.     Media.Canvas.Draw(0, 0, Pic);
  2116.     if Rgn <> NULLREGION then DeleteObject(Rgn);
  2117.   end
  2118.   else if fProgress <> Low(TPercent) then
  2119.     if fStyle in RegionStyles then
  2120.     begin
  2121.       ExtSelectClipRgn(Media.Canvas.Handle, Rgn, RGN_AND);
  2122.       Media.Canvas.Draw(0, 0, Pic);
  2123.       SelectClipRgn(Media.Canvas.Handle, 0);
  2124.     end
  2125.     else if fStyle in [1..57] then
  2126.       Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
  2127.   if Rgn <> NULLREGION then DeleteObject(Rgn);
  2128.   InvalidateArea(R1);
  2129.   if Assigned(fOnAfterNewFrame) then
  2130.     fOnAfterNewFrame(Self, Pic, Media);
  2131.   if not Drawing then Update;
  2132. end;
  2133.  
  2134. { TDBPicShow }
  2135.  
  2136. constructor TDBPicShow.Create(AOwner: TComponent);
  2137. begin
  2138.   inherited Create(AOwner);
  2139.   fAutoDisplay := True;
  2140.   fDataLink := TFieldDataLink.Create;
  2141.   fDataLink.Control := Self;
  2142.   fDataLink.OnDataChange := DataChange;
  2143.   fDataLink.OnUpdateData := UpdateData;
  2144. end;
  2145.  
  2146. destructor TDBPicShow.Destroy;
  2147. begin
  2148.   fDataLink.Free;
  2149.   fDataLink := nil;
  2150.   inherited Destroy;
  2151. end;
  2152.  
  2153. function TDBPicShow.GetDataSource: TDataSource;
  2154. begin
  2155.   Result := fDataLink.DataSource;
  2156. end;
  2157.  
  2158. procedure TDBPicShow.SetDataSource(Value: TDataSource);
  2159. begin
  2160.   if not (fDataLink.DataSourceFixed and (csLoading in ComponentState)) then
  2161.     fDataLink.DataSource := Value;
  2162.   if Value <> nil then Value.FreeNotification(Self);
  2163. end;
  2164.  
  2165. function TDBPicShow.GetDataField: string;
  2166. begin
  2167.   Result := fDataLink.FieldName;
  2168. end;
  2169.  
  2170. procedure TDBPicShow.SetDataField(const Value: string);
  2171. begin
  2172.   fDataLink.FieldName := Value;
  2173. end;
  2174.  
  2175. function TDBPicShow.GetReadOnly: Boolean;
  2176. begin
  2177.   Result := fDataLink.ReadOnly;
  2178. end;
  2179.  
  2180. procedure TDBPicShow.SetReadOnly(Value: Boolean);
  2181. begin
  2182.   fDataLink.ReadOnly := Value;
  2183. end;
  2184.  
  2185. function TDBPicShow.GetField: TField;
  2186. begin
  2187.   Result := fDataLink.Field;
  2188. end;
  2189.  
  2190. procedure TDBPicShow.SetAutoDisplay(Value: Boolean);
  2191. begin
  2192.   if fAutoDisplay <> Value then
  2193.   begin
  2194.     fAutoDisplay := Value;
  2195.     if fAutoDisplay then LoadPicture;
  2196.   end;
  2197. end;
  2198.  
  2199. procedure TDBPicShow.PictureChange(Sender: TObject);
  2200. begin
  2201.   if fPictureLoaded then FDataLink.Modified;
  2202.   fPictureLoaded := True;
  2203.   inherited PictureChange(Self);
  2204. end;
  2205.  
  2206. procedure TDBPicShow.Notification(AComponent: TComponent;
  2207.   Operation: TOperation);
  2208. begin
  2209.   inherited Notification(AComponent, Operation);
  2210.   if (Operation = opRemove) and (fDataLink <> nil) and
  2211.     (AComponent = DataSource) then DataSource := nil;
  2212. end;
  2213.  
  2214. procedure TDBPicShow.LoadPicture;
  2215. var
  2216.   Stream: TMemoryStream;
  2217.   IsJPEGImage: Boolean;
  2218.   JPEG: TJPEGImage;
  2219. begin
  2220.   if not fPictureLoaded and (not Assigned(fDataLink.Field) or
  2221.     fDataLink.Field.IsBlob) then
  2222.   begin
  2223.     if Assigned(fOnBeforeLoadPicture) then
  2224.       fOnBeforeLoadPicture(Self);
  2225.     IsJPEGImage := False;
  2226.     if TBlobField(fDataLink.Field).BlobSize >= 10 then
  2227.     begin
  2228.       Stream := TMemoryStream.Create;
  2229.       try
  2230.         TBlobField(fDataLink.Field).SaveToStream(Stream);
  2231.         if StrLIComp(@(PChar(Stream.Memory)[6]), 'JFIF', 4) = 0 then
  2232.         begin
  2233.           Stream.Position := 0;
  2234.           JPEG := TJPEGImage.Create;
  2235.           try
  2236.             JPEG.LoadFromStream(Stream);
  2237.             Picture.Assign(JPEG);
  2238.             IsJPEGImage := True;
  2239.           finally
  2240.             JPEG.Free;
  2241.           end;
  2242.         end;
  2243.       finally
  2244.         Stream.Free;
  2245.       end;
  2246.     end;
  2247.     if not IsJPEGImage then
  2248.       Picture.Assign(fDataLink.Field);
  2249.     if Assigned(fOnAfterLoadPicture) then
  2250.       fOnAfterLoadPicture(Self);
  2251.     // Calling abort in OnAfterLoadPicture event causes the following part
  2252.     // of code to be bypassed.
  2253.     if Busy then Stop;
  2254.     if (Picture.Graphic = nil) or Picture.Graphic.Empty then
  2255.       Clear
  2256.     else
  2257.       Execute;
  2258.   end;
  2259. end;
  2260.  
  2261. procedure TDBPicShow.DataChange(Sender: TObject);
  2262. begin
  2263.   Picture.Graphic := nil;
  2264.   fPictureLoaded := False;
  2265.   if fAutoDisplay then LoadPicture;
  2266. end;
  2267.  
  2268. procedure TDBPicShow.UpdateData(Sender: TObject);
  2269. var
  2270.   Stream: TMemoryStream;
  2271. begin
  2272.   if Picture.Graphic is TBitmap then
  2273.     fDataLink.Field.Assign(Picture.Graphic)
  2274.   else if Picture.Graphic is TJPEGImage then
  2275.   begin
  2276.     Stream := TMemoryStream.Create;
  2277.     try
  2278.       Picture.Graphic.SaveToStream(Stream);
  2279.       TBlobField(fDataLink.Field).LoadFromStream(Stream);
  2280.     finally
  2281.       Stream.Free;
  2282.     end;
  2283.   end
  2284.   else
  2285.     fDataLink.Field.Clear;
  2286. end;
  2287.  
  2288. procedure TDBPicShow.CMGetDataLink(var Message: TMessage);
  2289. begin
  2290.   Message.Result := Integer(fDataLink);
  2291. end;
  2292.  
  2293. end.
  2294.  
  2295.