HomePage   Delphi Library  

Unit ads_graf;

{Copyright(c)1998 Advanced Delphi Systems

 Richard Maley
 Advanced Delphi Systems
 12613 Maidens Bower Drive
 Potomac, MD 20854 USA
 phone 301-840-1554
 [email protected]
 [email protected]
 [email protected]}

Interface

Uses  extctrls, Controls, SysUtils, Ads_Misc;

{!~ Causes an image to fade away.
Example code:
procedure TForm1.Button7Click(Sender: TObject);
begin
  Timer1.OnTimer := Button7Click;
  ImageFadeAway(
    Image1,
    Timer1,
    False);
end;}
Procedure ImageFadeAway(
  Image          : TImage;
  Timer          : TTimer;
  Transparent    : Boolean);

{!~ Causes an image to fade in.
Example code:
procedure TForm1.Button6Click(Sender: TObject);
begin
  Timer1.OnTimer := Button6Click;
  ImageFadeIn(
    Image1,
    Timer1,
    False);
end;}
Procedure ImageFadeIn(
  Image          : TImage;
  Timer          : TTimer;
  Transparent    : Boolean);

{!~ Causes an image to fade in and out.
Setting cycles to 0 makes it continuous.
Example code:
procedure TForm1.Button10Click(Sender: TObject);
begin
  Timer1.OnTimer := Button10Click;
  ImageFadeInAndOut(
    Image1,
    Timer1,
    False,
    0);
end;}
Procedure ImageFadeInAndOut(
  Image          : TImage;
  Timer          : TTimer;
  Transparent    : Boolean;
  Cycles         : Integer);

{!~ This is the underlying engine for many image manipulation procedures:
ImageFadeAway, ImageFadeIn, ImageFadeInAndOut, ImageFlipHoriz, ImageFlipVert,
ImageFlutterHoriz, ImageFlutterVert, and ImagePulsate.}
Procedure ImageFadeInAndOutDetail(
  Image          : TImage;
  Timer          : TTimer;
  Transparent    : Boolean;
  Const MinTop   : Integer;
  Const MinLeft  : Integer;
  MaxWidth       : Integer;
  MaxHeight      : Integer;
  MinWidth       : Integer;
  MinHeight      : Integer;
  Cycles         : Integer);

{!~ Causes an image to flip horizontally.
Setting cycles to 0 makes it continuous.
Example code:
procedure TForm1.Button4Click(Sender: TObject);
begin
  Timer1.OnTimer := Button4Click;
  ImageFlipHoriz(
    Image1,
    Timer1,
    False,
    3,
    3);
end;}
Procedure ImageFlipHoriz(
  Image          : TImage;
  Timer          : TTimer;
  Transparent    : Boolean;
  Const MinLeft  : Integer;
  Cycles         : Integer);

{!~ Causes an image to flip vertically.
Setting cycles to 0 makes it continuous.
Example code:
procedure TForm1.Button5Click(Sender: TObject);
begin
  Timer1.OnTimer := Button5Click;
  ImageFlipVert(
    Image1,
    Timer1,
    False,
    3,
    3);
end;}
Procedure ImageFlipVert(
  Image          : TImage;
  Timer          : TTimer;
  Transparent    : Boolean;
  Const MinTop   : Integer;
  Cycles         : Integer);

{!~ Causes an image to flutter horizontally.
Setting cycles to 0 makes it continuous.
Example code:
procedure TForm1.Button9Click(Sender: TObject);
begin
  Timer1.OnTimer := Button9Click;
  ImageFlutterHoriz(
    Image1,
    Timer1,
    False,
    0);
end;}
Procedure ImageFlutterHoriz(
  Image          : TImage;
  Timer          : TTimer;
  Transparent    : Boolean;
  Cycles         : Integer);

{!~ This is the underlying engine for many image manipulation procedures:
ImageFadeAway, ImageFadeIn, ImageFadeInAndOut, ImageFlipHoriz, ImageFlipVert,
ImageFlutterHoriz, ImageFlutterVert, and ImagePulsate.}
Procedure ImageFlutterHorizDetail(
  Image          : TImage;
  Timer          : TTimer;
  Transparent    : Boolean;
  Const MinTop   : Integer;
  Const MinLeft  : Integer;
  MaxWidth       : Integer;
  MaxHeight      : Integer;
  MinWidth       : Integer;
  MinHeight      : Integer;
  Cycles         : Integer);

{!~ Causes an image to flutter vertically.
Example code:
procedure TForm1.Button8Click(Sender: TObject);
begin
  Timer1.OnTimer := Button8Click;
  ImageFlutterVert(
    Image1,
    Timer1,
    False,
    0);
end;}
Procedure ImageFlutterVert(
  Image          : TImage;
  Timer          : TTimer;
  Transparent    : Boolean;
  Cycles         : Integer);

{!~ This is the underlying engine for many image manipulation procedures:
ImageFadeAway, ImageFadeIn, ImageFadeInAndOut, ImageFlipHoriz, ImageFlipVert,
ImageFlutterHoriz, ImageFlutterVert, and ImagePulsate.}
Procedure ImageFlutterVertDetail(
  Image          : TImage;
  Timer          : TTimer;
  Transparent    : Boolean;
  Const MinTop   : Integer;
  Const MinLeft  : Integer;
  MaxWidth       : Integer;
  MaxHeight      : Integer;
  MinWidth       : Integer;
  MinHeight      : Integer;
  Cycles         : Integer);

{!~ Causes an image to pulsate in and out.
Example code:
procedure TForm1.Button11Click(Sender: TObject);
begin
  Timer1.OnTimer := Button11Click;
  ImagePulsate(
    Image1,
    Timer1,
    False,
    0);
end;}
Procedure ImagePulsate(
  Image          : TImage;
  Timer          : TTimer;
  Transparent    : Boolean;
  Cycles         : Integer);

{!~ This is the underlying engine for many image manipulation procedures:
ImageFadeAway, ImageFadeIn, ImageFadeInAndOut, ImageFlipHoriz, ImageFlipVert,
ImageFlutterHoriz, ImageFlutterVert, and ImagePulsate.}
Procedure ImageRotateDetail(
  Image          : TImage;
  Timer          : TTimer;
  Frames         : Integer;
  Interval       : Integer;
  Transparent    : Boolean;
  RotateHoriz    : Boolean;
  RotateVert     : Boolean;
  QuarterCycles  : Integer;
  Const MinTop   : Integer;
  Const MinLeft  : Integer;
  MaxWidth       : Integer;
  MaxHeight      : Integer;
  MinWidth       : Integer;
  MinHeight      : Integer;
  StartMaxHoriz  : Boolean;
  StartMaxVert   : Boolean);

{!~ Loads A Random Image}
Procedure RandImage(ImageControl: TImage;
                    DirPath,
                    FileStub,
                    FileExt: String;
                    ImageMin,
                    ImageMax: Integer);

Implementation

{Pads or truncates a String and Justifies Left if StrJustify=True}
Function StringPad(
  InputStr,
  FillChar: String;
  StrLen: Integer;
  StrJustify: Boolean): String;
Var
  TempFill: String;
  Counter : Integer;
Begin
  If Not (Length(InputStr) = StrLen) Then
  Begin
    If Length(InputStr) > StrLen Then
    Begin
      InputStr := Copy(InputStr,1,StrLen);
    End
    Else
    Begin
      TempFill := '';
      For Counter := 1 To StrLen-Length(InputStr) Do
      Begin
        TempFill := TempFill + FillChar;
      End;
      If StrJustify Then
      Begin
        {Left Justified}
        InputStr := InputStr + TempFill;
      End
      Else
      Begin
        {Right Justified}
        InputStr := TempFill + InputStr ;
      End;
    End;
  End;
  Result := InputStr;
End;

{Returns A Random Number}
Function RandomInteger(RandMin, RandMax: Integer): Integer;
Var
  RandRange: Integer;
  RandValue: Integer;
Begin
  If RandMax <= RandMin Then
  Begin
    Result := RandMin;
    Exit;
  End;

  Randomize;
  RandRange := RandMax-RandMin;
  RandValue := Random(RandRange);
  Result    := RandValue + RandMin;
End;

Procedure ImageFadeAway(
  Image          : TImage;
  Timer          : TTimer;
  Transparent    : Boolean);
Begin
  ImageRotateDetail(
    Image,                   {Image          : TImage;}
    Timer,                   {Timer          : TTimer;}
    15,                      {Frames         : Integer;}
    60,                      {Interval       : Integer;}
    Transparent,             {Transparent    : Boolean;}
    True,                    {RotateHoriz    : Boolean;}
    True,                    {RotateVert     : Boolean;}
    1,                       {QuarterCycles  : Integer;}
    Image.Top,               {Const MinTop   : Integer;}
    Image.Left,              {Const MinLeft  : Integer;}
    Image.Width,             {Const MaxWidth : Integer;}
    Image.Height,            {Const MaxHeight: Integer;}
    0,                       {MinWidth       : Integer;}
    0,                       {MinHeight      : Integer;}
    True,                    {StartMaxHoriz  : Boolean;}
    True);                   {StartMaxVert   : Boolean);}
End;

{!~ Causes an image to fade in.
Example code:
procedure TForm1.Button6Click(Sender: TObject);
begin
  Timer1.OnTimer := Button6Click;
  ImageFadeIn(
    Image1,
    Timer1,
    False);
end;}
Procedure ImageFadeIn(
  Image          : TImage;
  Timer          : TTimer;
  Transparent    : Boolean);
Begin
  ImageRotateDetail(
    Image,                   {Image          : TImage;}
    Timer,                   {Timer          : TTimer;}
    15,                      {Frames         : Integer;}
    60,                      {Interval       : Integer;}
    Transparent,             {Transparent    : Boolean;}
    True,                    {RotateHoriz    : Boolean;}
    True,                    {RotateVert     : Boolean;}
    1,                       {QuarterCycles  : Integer;}
    Image.Parent.ClientRect.Top,    {Const MinTop   : Integer;}
    Image.Parent.ClientRect.Left,   {Const MinLeft  : Integer;}
    Image.Parent.ClientRect.Right-Image.Parent.ClientRect.Left,
    Image.Parent.ClientRect.Bottom-Image.Parent.ClientRect.Top,
    0,                       {MinWidth       : Integer;}
    0,                       {MinHeight      : Integer;}
    False,                   {StartMaxHoriz  : Boolean;}
    False);                  {StartMaxVert   : Boolean);}
End;

{!~ Causes an image to fade in and out.
Setting cycles to 0 makes it continuous.
Example code:
procedure TForm1.Button10Click(Sender: TObject);
begin
  Timer1.OnTimer := Button10Click;
  ImageFadeInAndOut(
    Image1,
    Timer1,
    False,
    0);
end;}
Procedure ImageFadeInAndOut(
  Image          : TImage;
  Timer          : TTimer;
  Transparent    : Boolean;
  Cycles         : Integer);
Begin
  ImageFadeInAndOutDetail(
    Image,
    Timer,
    Transparent,
    Image.Parent.ClientRect.Top+1,
    Image.Parent.ClientRect.Left+1,
    (Image.Parent.ClientRect.Right-Image.Parent.ClientRect.Left)-2,
    (Image.Parent.ClientRect.Bottom-Image.Parent.ClientRect.Top)-2,
    0,
    0,
    Cycles);
End;

{!~ This is the underlying engine for many image manipulation procedures:
ImageFadeAway, ImageFadeIn, ImageFadeInAndOut, ImageFlipHoriz, ImageFlipVert,
ImageFlutterHoriz, ImageFlutterVert, and ImagePulsate.}
Procedure ImageFadeInAndOutDetail(
  Image          : TImage;
  Timer          : TTimer;
  Transparent    : Boolean;
  Const MinTop   : Integer;
  Const MinLeft  : Integer;
  MaxWidth       : Integer;
  MaxHeight      : Integer;
  MinWidth       : Integer;
  MinHeight      : Integer;
  Cycles         : Integer);
Begin
  ImageRotateDetail(
    Image,                   {Image          : TImage;}
    Timer,                   {Timer          : TTimer;}
    15,                      {Frames         : Integer;}
    60,                      {Interval       : Integer;}
    Transparent,             {Transparent    : Boolean;}
    True,                    {RotateHoriz    : Boolean;}
    True,                    {RotateVert     : Boolean;}
    2*Cycles,                {QuarterCycles  : Integer;}
    MinTop,                  {Const MinTop   : Integer;}
    MinLeft,                 {Const MinLeft  : Integer;}
    MaxWidth,                {Const MaxWidth : Integer;}
    MaxHeight,               {Const MaxHeight: Integer;}
    MinWidth,                {MinWidth       : Integer;}
    MinHeight,               {MinHeight      : Integer;}
    True,                    {StartMaxHoriz  : Boolean;}
    True);                   {StartMaxVert   : Boolean);}
End;

{!~ Causes an image to flip horizontally.
Setting cycles to 0 makes it continuous.
Example code:
procedure TForm1.Button4Click(Sender: TObject);
begin
  Timer1.OnTimer := Button4Click;
  ImageFlipHoriz(
    Image1,
    Timer1,
    False,
    3,
    3);
end;}
Procedure ImageFlipHoriz(
  Image          : TImage;
  Timer          : TTimer;
  Transparent    : Boolean;
  Const MinLeft  : Integer;
  Cycles         : Integer);
Begin
  ImageRotateDetail(
    Image,                   {Image          : TImage;}
    Timer,                   {Timer          : TTimer;}
    15,                      {Frames         : Integer;}
    60,                      {Interval       : Integer;}
    Transparent,             {Transparent    : Boolean;}
    True,                    {RotateHoriz    : Boolean;}
    False,                   {RotateVert     : Boolean;}
    2*Cycles,                {QuarterCycles  : Integer;}
    Image.Top,               {Const MinTop   : Integer;}
    MinLeft,                 {Const MinLeft  : Integer;}
    Image.Width,             {Const MaxWidth : Integer;}
    Image.Height,            {Const MaxHeight: Integer;}
    0,                       {MinWidth       : Integer;}
    0,                       {MinHeight      : Integer;}
    True,                    {StartMaxHoriz  : Boolean;}
    True);                   {StartMaxVert   : Boolean);}
End;
{!~ Causes an image to flip horizontally.
Setting cycles to 0 makes it continuous.
Example code:
procedure TForm1.Button4Click(Sender: TObject);
begin
  Timer1.OnTimer := Button4Click;
  ImageFlipHoriz(
    Image1,
    Timer1,
    False,
    3,
    3);
end;}

{!~ Causes an image to flip vertically.
Setting cycles to 0 makes it continuous.
Example code:
procedure TForm1.Button5Click(Sender: TObject);
begin
  Timer1.OnTimer := Button5Click;
  ImageFlipVert(
    Image1,
    Timer1,
    False,
    3,
    3);
end;}
Procedure ImageFlipVert(
  Image          : TImage;
  Timer          : TTimer;
  Transparent    : Boolean;
  Const MinTop   : Integer;
  Cycles         : Integer);
Begin
  ImageRotateDetail(
    Image,                   {Image          : TImage;}
    Timer,                   {Timer          : TTimer;}
    15,                      {Frames         : Integer;}
    60,                      {Interval       : Integer;}
    Transparent,             {Transparent    : Boolean;}
    False,                   {RotateHoriz    : Boolean;}
    True,                    {RotateVert     : Boolean;}
    2*Cycles,                {QuarterCycles  : Integer;}
    MinTop,                  {Const MinTop   : Integer;}
    Image.Left,              {Const MinLeft  : Integer;}
    Image.Width,             {Const MaxWidth : Integer;}
    Image.Height,            {Const MaxHeight: Integer;}
    0,                       {MinWidth       : Integer;}
    0,                       {MinHeight      : Integer;}
    True,                    {StartMaxHoriz  : Boolean;}
    True);                   {StartMaxVert   : Boolean);}
End;
{!~ Causes an image to flip vertically.
Setting cycles to 0 makes it continuous.
Example code:
procedure TForm1.Button5Click(Sender: TObject);
begin
  Timer1.OnTimer := Button5Click;
  ImageFlipVert(
    Image1,
    Timer1,
    False,
    3,
    3);
end;}

{!~ Causes an image to flutter horizontally.
Setting cycles to 0 makes it continuous.
Example code:
procedure TForm1.Button9Click(Sender: TObject);
begin
  Timer1.OnTimer := Button9Click;
  ImageFlutterHoriz(
    Image1,
    Timer1,
    False,
    0);
end;}
Procedure ImageFlutterHoriz(
  Image          : TImage;
  Timer          : TTimer;
  Transparent    : Boolean;
  Cycles         : Integer);
Begin
  ImageFlutterHorizDetail(
    Image,
    Timer,
    Transparent,
    Image.Parent.ClientRect.Top+1,
    Image.Parent.ClientRect.Left+1,
    (Image.Parent.ClientRect.Right-Image.Parent.ClientRect.Left)-2,
    (Image.Parent.ClientRect.Bottom-Image.Parent.ClientRect.Top)-2,
    (((Image.Parent.ClientRect.Right-Image.Parent.ClientRect.Left-2)*5) div 6),
    0,
    Cycles);
End;
{!~ Causes an image to flutter horizontally.
Setting cycles to 0 makes it continuous.
Example code:
procedure TForm1.Button9Click(Sender: TObject);
begin
  Timer1.OnTimer := Button9Click;
  ImageFlutterHoriz(
    Image1,
    Timer1,
    False,
    0);
end;}

{!~ This is the underlying engine for many image manipulation procedures:
ImageFadeAway, ImageFadeIn, ImageFadeInAndOut, ImageFlipHoriz, ImageFlipVert,
ImageFlutterHoriz, ImageFlutterVert, and ImagePulsate.}
Procedure ImageFlutterHorizDetail(
  Image          : TImage;
  Timer          : TTimer;
  Transparent    : Boolean;
  Const MinTop   : Integer;
  Const MinLeft  : Integer;
  MaxWidth       : Integer;
  MaxHeight      : Integer;
  MinWidth       : Integer;
  MinHeight      : Integer;
  Cycles         : Integer);
Begin
  ImageRotateDetail(
    Image,                   {Image          : TImage;}
    Timer,                   {Timer          : TTimer;}
    15,                      {Frames         : Integer;}
    60,                      {Interval       : Integer;}
    Transparent,             {Transparent    : Boolean;}
    True,                    {RotateHoriz    : Boolean;}
    False,                   {RotateVert     : Boolean;}
    2*Cycles,                {QuarterCycles  : Integer;}
    MinTop,                  {Const MinTop   : Integer;}
    MinLeft,                 {Const MinLeft  : Integer;}
    MaxWidth,                {Const MaxWidth : Integer;}
    MaxHeight,               {Const MaxHeight: Integer;}
    MinWidth,                {MinWidth       : Integer;}
    MinHeight,               {MinHeight      : Integer;}
    True,                    {StartMaxHoriz  : Boolean;}
    True);                   {StartMaxVert   : Boolean);}
End;

{!~ Causes an image to flutter vertically.
Example code:
procedure TForm1.Button8Click(Sender: TObject);
begin
  Timer1.OnTimer := Button8Click;
  ImageFlutterVert(
    Image1,
    Timer1,
    False,
    0);
end;}
Procedure ImageFlutterVert(
  Image          : TImage;
  Timer          : TTimer;
  Transparent    : Boolean;
  Cycles         : Integer);
Begin
  ImageFlutterVertDetail(
    Image,
    Timer,
    Transparent,
    Image.Parent.ClientRect.Top+1,
    Image.Parent.ClientRect.Left+1,
    (Image.Parent.ClientRect.Right-Image.Parent.ClientRect.Left)-2,
    (Image.Parent.ClientRect.Bottom-Image.Parent.ClientRect.Top)-2,
    0,
    (((Image.Parent.ClientRect.Bottom-Image.Parent.ClientRect.Top-2)*5) div 6),
    Cycles);
End;
{!~ Causes an image to flutter vertically.
Example code:
procedure TForm1.Button8Click(Sender: TObject);
begin
  Timer1.OnTimer := Button8Click;
  ImageFlutterVert(
    Image1,
    Timer1,
    False,
    0);
end;}

{!~ This is the underlying engine for many image manipulation procedures:
ImageFadeAway, ImageFadeIn, ImageFadeInAndOut, ImageFlipHoriz, ImageFlipVert,
ImageFlutterHoriz, ImageFlutterVert, and ImagePulsate.}
Procedure ImageFlutterVertDetail(
  Image          : TImage;
  Timer          : TTimer;
  Transparent    : Boolean;
  Const MinTop   : Integer;
  Const MinLeft  : Integer;
  MaxWidth       : Integer;
  MaxHeight      : Integer;
  MinWidth       : Integer;
  MinHeight      : Integer;
  Cycles         : Integer);
Begin
  ImageRotateDetail(
    Image,                   {Image          : TImage;}
    Timer,                   {Timer          : TTimer;}
    15,                      {Frames         : Integer;}
    60,                      {Interval       : Integer;}
    Transparent,             {Transparent    : Boolean;}
    False,                   {RotateHoriz    : Boolean;}
    True,                    {RotateVert     : Boolean;}
    2*Cycles,                {QuarterCycles  : Integer;}
    MinTop,                  {Const MinTop   : Integer;}
    MinLeft,                 {Const MinLeft  : Integer;}
    MaxWidth,                {Const MaxWidth : Integer;}
    MaxHeight,               {Const MaxHeight: Integer;}
    MinWidth,                {MinWidth       : Integer;}
    MinHeight,               {MinHeight      : Integer;}
    True,                    {StartMaxHoriz  : Boolean;}
    True);                   {StartMaxVert   : Boolean);}
End;

{!~ Causes an image to pulsate in and out.
Example code:
procedure TForm1.Button11Click(Sender: TObject);
begin
  Timer1.OnTimer := Button11Click;
  ImagePulsate(
    Image1,
    Timer1,
    False,
    0);
end;}
Procedure ImagePulsate(
  Image          : TImage;
  Timer          : TTimer;
  Transparent    : Boolean;
  Cycles         : Integer);
Begin
  ImageFadeInAndOutDetail(
    Image,
    Timer,
    Transparent,
    Image.Parent.ClientRect.Top+1,
    Image.Parent.ClientRect.Left+1,
    (Image.Parent.ClientRect.Right-Image.Parent.ClientRect.Left)-2,
    (Image.Parent.ClientRect.Bottom-Image.Parent.ClientRect.Top)-2,
    (((Image.Parent.ClientRect.Right-Image.Parent.ClientRect.Left-2)*19) div 20),
    (((Image.Parent.ClientRect.Bottom-Image.Parent.ClientRect.Top-2)*19) div 20),
    Cycles);
End;
{!~ Causes an image to pulsate in and out.
Example code:
procedure TForm1.Button11Click(Sender: TObject);
begin
  Timer1.OnTimer := Button11Click;
  ImagePulsate(
    Image1,
    Timer1,
    False,
    0);
end;}

{!~ This is the underlying engine for many image manipulation procedures:
ImageFadeAway, ImageFadeIn, ImageFadeInAndOut, ImageFlipHoriz, ImageFlipVert,
ImageFlutterHoriz, ImageFlutterVert, and ImagePulsate.}
Procedure ImageRotateDetail(
  Image          : TImage;
  Timer          : TTimer;
  Frames         : Integer;
  Interval       : Integer;
  Transparent    : Boolean;
  RotateHoriz    : Boolean;
  RotateVert     : Boolean;
  QuarterCycles  : Integer;
  Const MinTop   : Integer;
  Const MinLeft  : Integer;
  MaxWidth       : Integer;
  MaxHeight      : Integer;
  MinWidth       : Integer;
  MinHeight      : Integer;
  StartMaxHoriz  : Boolean;
  StartMaxVert   : Boolean);
Var
  HSmaller      : Boolean;
  VSmaller      : Boolean;
  HSmaller_I    : Integer;
  VSmaller_I    : Integer;
  QuarterCycle  : Integer;
  HStepDistance : Double;
  VStepDistance : Double;
  RealFrames    : Integer;
  HDelta        : Integer;
  VDelta        : Integer;
  MinDelta      : Integer;
  HalfMinDelta  : Integer;
  NewLeft       : Integer;
  NewTop        : Integer;
  NewWidth      : Integer;
  NewHeight     : Integer;
  NewStep       : Integer;
  CurrentStep   : Integer;
  QCycles       : Integer;
  MaxHght       : Integer;
  MaxWdth       : Integer;
Begin
  If Image.Tag = 0 Then
  Begin

    {This is the start and the time to initialize the process}
    Image.IncrementalDisplay := False;
    Image.Transparent        := Transparent;
    Image.Stretch            := True;
    Image.Align              := alNone;
    Timer.Interval           := Interval;
    Timer.Enabled            := True;
    Timer.Tag                := 0;
    QuarterCycle             := 0;
    QCycles                  := QuarterCycles;

    {Set Horizontal start size and direction}
    HSmaller       := StartMaxHoriz;
    If HSmaller Then
    Begin
      Image.Left   := MinLeft;
      Image.Width  := MaxWidth;
      HSmaller_I   := 1;
    End
    Else
    Begin
      Image.Left   := MinLeft+((MaxWidth-MinWidth) div 2);
      Image.Width  := MinWidth;
      HSmaller_I   := 2;
    End;

    {Set Vertical start size and direction}
    VSmaller       := StartMaxVert;
    If VSmaller Then
    Begin
      Image.Top    := MinTop;
      Image.Height := MaxHeight;
      VSmaller_I   := 1;
    End
    Else
    Begin
      Image.Top    := MinTop+((MaxHeight-MinHeight) div 2);
      Image.Height := MinHeight;
      VSmaller_I   := 2;
    End;
    Image.Tag :=
      StrToInt(
        '1'+
        StringPad(IntToStr(QCycles),'0',3,False)+
        StringPad(IntToStr(QuarterCycle),'0',3,False)+
        '0'+
        IntToStr(HSmaller_I)+
        IntToStr(VSmaller_I));
    NewStep   := 1;
    If MaxHeight > 999 Then MaxHeight := 999;
    If MaxWidth  > 999 Then MaxWidth  := 999;
    Timer.Tag :=
      StrToInt(
        '1'+
        StringPad(IntToStr(MaxHeight),'0',3,False)+
        StringPad(IntToStr(MaxWidth), '0',3,False)+
        StringPad(IntToStr(NewStep),  '0',3,False));
    Image.Visible := True;
  End;
  MaxHght :=
    StrToInt(Copy(
      StringPad(IntToStr(Timer.Tag),'0',10,False), 2,3));
  MaxWdth :=
    StrToInt(Copy(
      StringPad(IntToStr(Timer.Tag),'0',10,False), 5,3));
  CurrentStep  :=
    StrToInt(Copy(
      StringPad(IntToStr(Timer.Tag),'0',10,False), 8,3));
  HDelta        := MaxWdth   - MinWidth;
  VDelta        := MaxHght   - MinHeight;
  If HDelta < VDelta Then MinDelta := HDelta Else MinDelta := VDelta;
  HalfMinDelta  := MinDelta div 2;
  RealFrames    := Frames;
  {The minimum Frames is set at 3}
  If RealFrames < 3 Then RealFrames := 3;

  {The minimum stepdistance is 2}
  If RealFrames > (HalfMinDelta div 2) Then
    RealFrames := (HalfMinDelta div 2);

  {The horizontal step distance}
  HStepDistance := ((HDelta/2)/RealFrames);

  {The Vertical step distance}
  VStepDistance := ((VDelta/2)/RealFrames);

  QCycles      := StrToInt(Copy(IntToStr(Image.Tag), 2,3));
  QuarterCycle := StrToInt(Copy(IntToStr(Image.Tag), 5,3));
  HSmaller_I   := StrToInt(Copy(IntToStr(Image.Tag), 9,1));
  VSmaller_I   := StrToInt(Copy(IntToStr(Image.Tag),10,1));
  HSmaller     := (HSmaller_I = 1);
  VSmaller     := (VSmaller_I = 1);

  If RotateHoriz Then
  Begin
    If HSmaller Then
    Begin
      NewWidth :=
        HDelta-
        StrToInt(
          FormatFloat(
            '0',
            Round(((CurrentStep * HStepDistance * 2)+MinWidth))));
    End
    Else
    Begin
      NewWidth :=
        StrToInt(
          FormatFloat(
            '0',
            Round(((CurrentStep * HStepDistance * 2)+MinWidth))));
    End;
    NewWidth := Abs(NewWidth);
    NewLeft  := (MaxWdth - NewWidth) div 2;
  End
  Else
  Begin
    NewWidth := Image.Width;
    NewLeft  := Image.Left;
    NewWidth := Abs(NewWidth);
  End;

  If RotateVert Then
  Begin
    If VSmaller Then
    Begin
      NewHeight :=
        VDelta -
        StrToInt(
          FormatFloat(
            '0',
            Round(((CurrentStep * VStepDistance * 2)+MinHeight))));
    End
    Else
    Begin
      NewHeight :=
        StrToInt(
          FormatFloat(
            '0',
            Round(((CurrentStep * VStepDistance * 2)+MinHeight))));
    End;
    NewHeight := Abs(NewHeight);
    NewTop  := (MaxHght - NewHeight) div 2;
  End
  Else
  Begin
    NewHeight := Image.Height;
    NewTop    := Image.Top;
    NewHeight := Abs(NewHeight);
  End;

  Image.Left   := Abs(NewLeft);
  Image.Top    := Abs(NewTop);
  Image.Width  := Abs(NewWidth);
  Image.Height := Abs(NewHeight);
  Image.Refresh;

  If CurrentStep <= 1 Then
  Begin
    NewStep := 2;
  End
  Else
  Begin
    If CurrentStep >= RealFrames Then
    Begin
      NewStep      := 1;
      HSmaller     := Not HSmaller;
      If HSmaller Then
      Begin
        HSmaller_I := 1;
      End
      Else
      Begin
        HSmaller_I := 2;
      End;
      VSmaller     := Not VSmaller;
      If VSmaller Then
      Begin
        VSmaller_I := 1;
      End
      Else
      Begin
        VSmaller_I := 2;
      End;
      QuarterCycle := QuarterCycle + 1;
    End
    Else
    Begin
      NewStep := CurrentStep + 1;
    End;
  End;
  Timer.Tag :=
    StrToInt(
      '1'+
      StringPad(IntToStr(MaxHght),'0',3,False)+
      StringPad(IntToStr(MaxWdth),'0',3,False)+
      StringPad(IntToStr(NewStep),'0',3,False));

  If QCycles = 0 Then QuarterCycle := 1;
  If (QuarterCycle >= QCycles) and
     (Not (QCycles = 0)) Then
  Begin
    Image.Tag := 0;
    Timer.Enabled := False;
  End
  Else
  Begin
    Image.Tag :=
      StrToInt(
        '1'+
        StringPad(IntToStr(QCycles),'0',3,False)+
        StringPad(IntToStr(QuarterCycle),'0',3,False)+
        '0'+
        IntToStr(HSmaller_I)+
        IntToStr(VSmaller_I));
  End;
End;

{!~ Loads A Random Image}
Procedure RandImage(ImageControl: TImage;
                    DirPath,
                    FileStub,
                    FileExt: String;
                    ImageMin,
                    ImageMax: Integer);
Var
  RandomValue: Integer;
  RandValString: String;
Begin
  RandomValue := RandomInteger(ImageMin,ImageMax);
  If RandomValue < 10 Then
  Begin
    RandValString := '0'+ IntToStr(RandomValue);
  End
  Else
  Begin
    RandValString := IntToStr(RandomValue);
  End;

  ImageControl.Picture.LoadFromFile(DirPath+'\'+
                                    FileStub+
                                    RandValString+'.'+FileExt);
End;

Initialization
  DelphiChecker(
    RunOutsideIDE_ads,
    'Advanced Delphi Systems Code',
    RunOutsideIDECompany_ads,
    RunOutsideIDEPhone_ads,
    RunOutsideIDEDate_ads);
End.
Hosted by www.Geocities.ws

1