300分求购"背景水印"的算法!(200分)

我昨天看到方正奥思(用VC开发的)的多媒体工具里面的图像
处理的特别好,我想看看Delphi行不行.
有VC的源程序也可以.
另外的100分等我接收答案以后在给.(以防每人答的出来)

如果只要加背景图,你知道怎么做,是不是,唐晓锋?
现在你只要知道怎么样做水印是不是?
我的感觉(我没做过)是:水印好像一幅图以浅一点方式画上去,或者是半透明的?
大家讨论讨论

1stClass里面有一个Imager，支持很多图像处理的功能，可以参考它的源代码。
主要还是算法问题，看看图像处理的书吧。

>> 水印好像一幅图以浅一点方式画上去,或者是半透明的?
如果这样，找个图像处理软件，对背景图作这些处理后再用不就得了。

我想要的效果就想用FrontPage做出来的有水印背景的主页一样
滚动的时候,背景不动.
to tqz:
你有这方面的电子版的吗?

水印图就是一个背景图，对唐小弟当然不难。其实你所要做的是如何将一幅图象处理
成水印图。水印图一般是将一个图象淡化（FADE）以后再向右下几个象素叠加出一个
浮雕效果。

to huizhang :不一定要浮雕效果吧？
to tang:图书馆里应该有。看看1stclass的source吧，很简单的

to tqz:
1stclass里面没有
在没人回答只好分了
tqz:120
huizhang:80
大家快来抢分!

1stClass里怎么没有? TfcImage中的Emboss效果不就是吗?

? 我在试试

一个图象处理unit，包括淡入，淡出，旋转等等，修改一下大概可以满足你
的要求
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
maley@advdelphisys.com
maley@compuserve.com
maley@cpcug.org}
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 :do
uble;
VStepDistance :do
uble;
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.

多人接受答案了。