Advanced Delphi Systems- Grafik 2

Yazdığınız makaleleri ve üyelerimizin işine yarayacağını düşündüğünüz kodlarınızı gönderebilirsiniz. Bu foruma soru sormayın!
Cevapla
Kullanıcı avatarı
Asri
Kıdemli Üye
Mesajlar: 767
Kayıt: 16 Eyl 2003 09:54
Konum: istanbul

Advanced Delphi Systems- Grafik 2

Mesaj gönderen Asri »

Aşağıdaki unit'i unit1'de uses olarak ekleyip bu unit içindeki procedure ve function'ları kullanbilirsiniz.

Bu unit program graifk 2 işleminde kullanılır.

Kod: Tümünü seç

Unit ads_graf;

{Copyright(c)2000 Advanced Delphi Systems

 Richard Maley
 Advanced Delphi Systems
 12613 Maidens Bower Drive
 Potomac, MD 20854 USA
 phone 301-840-1554
 maley@advdelphisys.com

 The code herein can be used or modified by anyone.  Please retain references
 to Richard Maley at Advanced Delphi Systems.  If you make improvements to the
 code please send your improvements to maley@advdelphisys.com so that the
 entire Delphi community can benefit.  All comments are welcome.
}

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;

End.
Öğrenmek ve öğretmek, akıntıya karşı yüzmek gibidir ilerleyemediğiniz taktirde gerilersiniz.
Cevapla