亲爱的朋友,谁有花样显示的各种算法,将一副图像可以以各种形势展现出来!(100分)

我做的是大屏幕显示(led),需要将图像以各种方式显示.比如百叶,上拉,瀑布等等,
现在继续找到有关算法,情各位同仁多多帮助,介绍有关网站也可以 !
谢谢!

搜索本站帖子

我找过了,
昨天在网上待了好长时间,也发了贴子了

[][!][8D][!][!][^][?][][][^][?][!]

给你一控件源码,有一百多种特效：
分分给我吧 嘻嘻
unit PicShow;

{

TPicShow v2.3
by Kambiz R. Khojasteh

email: khojasteh@www.dci.co.ir
web: http://www.crosswinds.net/~khojasteh/

This component is freeware and may be used in any software
product (free or commercial) under the condition that I'm
given proper credit (title, name and e-mail address in the
documentation or the About box of the product this component
is used in).

Thanks to M. R. Zamani for adding 8 effects.
email: M_R_Zamani@yahoo.com

Special thanks to:
k3nx@hotmail.com
Douglass Titjan (support@delhipages.com)
Jerry McLain (jkmclain@cyberstation.net)

}

{$IFNDEF VER80} { Delphi 1.0 }
{$IFNDEF VER90} { Delphi 2.0 }
{$IFNDEF VER100} { Delphi 3.0 }
{$DEFINE PS_D4orHigher}
{$ENDIF}
{$ENDIF}
{$ENDIF}

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, Menus;

const
RegionStyles = [0, 58..117];

type

{$IFNDEF PS_D4orHigher}
HRgn = THandle;
{$ENDIF}

TShowStyle = 0..122;
TPercent = 0..100;
TBackgroundMode = (bmNone, bmTiled, bmStretched, bmCentered);

TCustomDrawEvent = procedure(Sender: TObject; Picture, Screen: TBitmap) of object;

TAbout = class(TObject);

{ TPicShow }

TPicShow = class(TCustomControl)
private
{ Private declarations }
fAbout: TAbout;
fPicture: TPicture;
fBgPicture: TPicture;
fBgMode: TBackgroundMode;
fAutoSize: Boolean;
fCenter: Boolean;
fStretch: Boolean;
fStretchFine: Boolean;
fThreaded: Boolean;
fThreadPriority: TThreadPriority;
fManual: Boolean;
fStyle: TShowStyle;
fStep: Word;
fDelay: Word;
fProgress: TPercent;
fReverse: Boolean;
fBusy: Boolean;
fOnChange: TNotifyEvent;
fOnProgress: TNotifyEvent;
fOnComplete: TNotifyEvent;
fOnCustomDraw: TCustomDrawEvent;
fOnMouseEnter: TNotifyEvent;
fOnMouseLeave: TNotifyEvent;
Media: TBitmap;
PicRect: TRect;
Thread: TThread;
Drawing: Boolean;
OffScreen: TBitmap;
Stopping: Boolean;
OldPic: TBitmap;
Pic: TBitmap;
procedure SetAutoSize(Value: Boolean);
procedure SetPicture(Value: TPicture);
procedure SetBgPicture(Value: TPicture);
procedure SetBgMode(Value: TBackgroundMode);
procedure SetCenter(Value: Boolean);
procedure SetStretch(Value: Boolean);
procedure SetStretchFine(Value: Boolean);
procedure SetStep(Value: Word);
procedure SetProgress(Value: TPercent);
procedure SetManual(Value: Boolean);
function GetEmpty: Boolean;
procedure AnimationComplete(Sender: TObject);
procedure PictureChange(Sender: TObject);
procedure BgPictureChange(Sender: TObject);
procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
procedure WMSize(var Msg: TWMSize); message WM_SIZE;
procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
procedure AdjustClientSize;
procedure CalculatePicRect;
procedure InvalidateArea(Area: TRect);
procedure Prepare;
procedure Animate;
procedure UpdateDisplay;
protected
{ Protected declarations }
procedure Paint; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Execute;
procedure Stop;
procedure Clear;
property Busy: Boolean read fBusy;
property Empty: Boolean read GetEmpty;
property Progress: TPercent read fProgress write SetProgress;
published
{ Published declarations }
property About: TAbout read fAbout write fAbout stored False;
property Align;
{$IFDEF PS_D4orHigher}
property Anchors;
{$ENDIF}
property AutoSize: Boolean read fAutoSize write SetAutoSize default True;
property BgMode: TBackgroundMode read fBgMode write SetBgMode default bmTiled;
property BgPicture: TPicture read fBgPicture write SetBgPicture;
property Center: Boolean read fCenter write SetCenter default False;
property Color;
property Delay: Word read fDelay write fDelay default 40;
property DragCursor;
property DragMode;
property Enabled;
property Height default 100;
property Manual: Boolean read fManual write SetManual default False;
property ParentColor;
property ParentShowHint;
property Picture: TPicture read fPicture write SetPicture;
property PopupMenu;
property ShowHint;
property Reverse: Boolean read fReverse write fReverse default False;
property Stretch: Boolean read fStretch write SetStretch default False;
property StretchFine: Boolean read fStretchFine write SetStretchFine default False;
property Step: Word read fStep write SetStep default 4;
property Style: TShowStyle read fStyle write fStyle default 51;
property Threaded: Boolean read fThreaded write fThreaded default True;
property ThreadPriority: TThreadPriority read fThreadPriority write fThreadPriority default tpNormal;
property Visible;
property Width default 100;
property OnClick;
property OnCustomDraw: TCustomDrawEvent read fOnCustomDraw write fOnCustomDraw;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnChange: TNotifyEvent read fOnChange write fOnChange;
property OnComplete: TNotifyEvent read fOnComplete write fOnComplete;
property OnMouseDown;
property OnMouseEnter: TNotifyEvent read fOnMouseEnter write fOnMouseEnter;
property OnMouseLeave: TNotifyEvent read fOnMouseLeave write fOnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnProgress: TNotifyEvent read fOnProgress write fOnProgress;
property OnStartDrag;
end;

function CreateTriangleRgn(x1, y1, x2, y2, x3, y3: Integer): HRgn;
function ScaleImageToRect(IR, R: TRect): TRect;
procedure DrawTiledImage(Canvas: TCanvas; Rect: TRect; G: TGraphic);
procedure MirrorCopyRect(Canvas: TCanvas; dstRect: TRect;
Bitmap: TBitmap; srcRect: TRect; Horz, Vert: Boolean);
procedure MergeTransparent(dstBitmap, srcBitmap: TBitmap; Transparency: TPercent);
procedure MergeRotate(dstBitmap, srcBitmap: TBitmap; xOrg, yOrg: Integer; Angle: Double);

implementation

uses
Math;

const
MaxPixelCount = 32768;

type

PRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array[0..MaxPixelCount] of TRGBTriple;

TAnimateThread = class(TThread)
private
PicShow: TPicShow;
procedure Update;
public
constructor Create(APicShow: TPicShow);
procedure Execute; override;
end;

{ Miscellaneous routines }

function CreateBarRgn(X, Y, W, H, S: Integer; XMode, YMode: Byte): HRgn;
var
X1, Y1: Integer;
Rgn, tRgn: HRgn;
begin
Result := NULLREGION;
Rgn := NULLREGION;
if X <= W then Y1 := 0 else Y1 := 5;
while Y1 < H + 5 do
begin
if X > W then
begin
tRgn := CreateRectRgn(0, Y1 - 5, W, Y1);
if XMode in [1, 4] then
Rgn := CreateRectRgn(2 * W - X, Y1, W, Y1 + 5)
else if XMode in [2, 5] then
Rgn := CreateRectRgn(0, Y1, X - W, Y1 + 5);
CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
DeleteObject(tRgn);
end
else
begin
if (X + S) > W then X := W;
if XMode in [1, 5] then
Rgn := CreateRectRgn(W - X, Y1, W, Y1 + 5)
else if XMode in [2, 4] then
Rgn := CreateRectRgn(0, Y1, X, Y1 + 5)
else if XMode = 3 then
begin
tRgn := CreateRectRgn(W - X, Y1, W, Y1 + 5);
Rgn := CreateRectRgn(0, Y1 + 5, X, Y1 + 10);
CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
DeleteObject(tRgn);
end;
end;
if Result <> NULLREGION then
begin
CombineRgn(Result, Result, Rgn, RGN_OR);
DeleteObject(Rgn);
end
else
Result := Rgn;
Inc(Y1, 10)
end;
if Y <= H then X1 := 0 else X1 := 5;
while X1 < W + 5 do
begin
if Y > H then
begin
tRgn := CreateRectRgn(X1 - 5, 0, X1, H);
if YMode in [1, 4] then
Rgn := CreateRectRgn(X1, 2 * H - Y, X1 + 5, H)
else if YMode in [2, 5] then
Rgn := CreateRectRgn(X1, 0, X1 + 5, Y - H);
CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
DeleteObject(tRgn);
end
else
begin
if (Y + S) > H then Y := H;
if YMode in [1, 5] then
Rgn := CreateRectRgn(X1, H - Y, X1 + 5, H)
else if YMode in [2, 4] then
Rgn := CreateRectRgn(X1, 0, X1 + 5, Y)
else if YMode = 3 then
begin
tRgn := CreateRectRgn(X1, H - Y, X1 + 5, H);
Rgn := CreateRectRgn(X1 + 5, 0, X1 + 10, Y);
CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
DeleteObject(tRgn);
end;
end;
if Result <> NULLREGION then
begin
CombineRgn(Result, Result, Rgn, RGN_OR);
DeleteObject(Rgn);
end
else
Result := Rgn;
Inc(X1, 10)
end;
end;

function CreateSplashRgn(X, Y, W, H, XMode, YMode: Integer): HRgn;
var
X1, Y1, N: Integer;
Rgn, tRgn: HRgn;
begin
Result := NULLREGION;
if XMode <> 0 then
begin
if X < W then
N := W div 7
else
N := 0;
Y1 := 0;
while Y1 < H do
begin
if XMode = 1 then
Rgn := CreateRectRgn(W - X + Random(N) - Random(N), Y1, W, Y1 + 5 + H mod 5)
else if XMode = 2 then
Rgn := CreateRectRgn(0, Y1, X + Random(N) - Random(N), Y1 + 5 + H mod 5)
else if XMode = 3 then
begin
Rgn := CreateRectRgn((W - X + Random(N) - Random(N)) div 2, Y1, W div 2, Y1 + 5 + H mod 5);
tRgn := CreateRectRgn(W div 2, Y1, (W + X + Random(N) - Random(N)) div 2, Y1 + 5 + H mod 5);
CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
DeleteObject(tRgn);
end
else
begin
Rgn := CreateRectRgn(W - (X + Random(N) - Random(N)) div 2, Y1, W, Y1 + 5 + H mod 5);
tRgn := CreateRectRgn(0, Y1, (X + Random(N) - Random(N)) div 2, Y1 + 5 + H mod 5);
CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
DeleteObject(tRgn);
end;
if Result <> NULLREGION then
begin
CombineRgn(Result, Result, Rgn, RGN_OR);
DeleteObject(Rgn);
end
else
Result := Rgn;
Inc(Y1, 5);
end;
end;
if YMode <> 0 then
begin
if Y < H then
N := H div 7
else
N := 0;
X1 := 0;
while X1 < W do
begin
if YMode = 1 then
Rgn := CreateRectRgn(X1, H - Y + Random(N) - Random(N), X1 + 5 + W mod 5, H)
else if YMode = 2 then
Rgn := CreateRectRgn(X1, 0, X1 + 5 + W mod 5, Y + Random(N) - Random(N))
else if YMode = 3 then
begin
Rgn := CreateRectRgn(X1, (H - Y + Random(N) - Random(N)) div 2, X1 + 5 + W mod 5, H div 2);
tRgn := CreateRectRgn(X1, H div 2, X1 + 5 + W mod 5, (H + Y + Random(N) - Random(N)) div 2);
CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
DeleteObject(tRgn);
end
else
begin
Rgn := CreateRectRgn(X1, H - (Y + Random(N) - Random(N)) div 2, X1 + 5 + W mod 5, H);
tRgn := CreateRectRgn(X1, 0, X1 + 5 + W mod 5, (Y + Random(N) - Random(N)) div 2);
CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
DeleteObject(tRgn);
end;
if Result <> NULLREGION then
begin
CombineRgn(Result, Result, Rgn, RGN_OR);
DeleteObject(Rgn);
end
else
Result := Rgn;
Inc(X1, 5);
end;
end;
end;

function CreateTriangleRgn(x1, y1, x2, y2, x3, y3: Integer): HRgn;
var
ptArray : array[1..4] of TPoint;
begin
ptArray[1].x := x1;
ptArray[1].y := y1;
ptArray[2].x := x2;
ptArray[2].y := y2;
ptArray[3].x := x3;
ptArray[3].y := y3;
ptArray[4].x := x1;
ptArray[4].y := y1;
Result := CreatePolygonRgn(ptArray, 4, WINDING);
end;

function ScaleImageToRect(IR, R: TRect): TRect;
var
iW, iH: Integer;
rW, rH: Integer;
begin
iW := IR.Right - IR.Left;
iH := IR.Bottom - IR.Top;
rW := R.Right - R.Left;
rH := R.Bottom - R.Top;
if (rW / iW) < (rH / iH) then
begin
iH := MulDiv(iH, rW, iW);
iW := MulDiv(iW, rW, iW);
end
else
begin
iW := MulDiv(iW, rH, iH);
iH := MulDiv(iH, rH, iH);
end;
SetRect(Result, 0, 0, iW, iH);
OffsetRect(Result, R.Left + (rW - iW) div 2, R.Top + (rH - iH) div 2);
end;

procedure DrawTiledImage(Canvas: TCanvas; Rect: TRect; G: TGraphic);
var
R, Rows, C, Cols: Integer;
begin
if (G <> nil) and (not G.Empty) then
begin
Rows := ((Rect.Bottom - Rect.Top) div G.Height) + 1;
Cols := ((Rect.Right - Rect.Left) div G.Width) + 1;
for R := 1 to Rows do
for C := 1 to Cols do
Canvas.Draw(Rect.Left + (C-1) * G.Width, Rect.Top + (R-1) * G.Height, G)
end;
end;

procedure MirrorCopyRect(Canvas: TCanvas; dstRect: TRect;
Bitmap: TBitmap; srcRect: TRect; Horz, Vert: Boolean);
var
T: Integer;
begin
IntersectRect(srcRect, srcRect, Rect(0, 0, Bitmap.Width, Bitmap.Height));
if Horz then
begin
T := dstRect.Left;
dstRect.Left := dstRect.Right+1;
dstRect.Right := T-1;
end;
if Vert then
begin
T := dstRect.Top;
dstRect.Top := dstRect.Bottom+1;
dstRect.Bottom := T-1;
end;
StretchBlt(Canvas.Handle, dstRect.Left, dstRect.Top,
dstRect.Right - dstRect.Left, dstRect.Bottom - dstRect.Top,
Bitmap.Canvas.Handle, srcRect.Left, srcRect.Top,
srcRect.Right - srcRect.Left, srcRect.Bottom - srcRect.Top, SRCCOPY);
end;

// Both bitmaps must be equal size and 24 bit format.
procedure MergeTransparent(dstBitmap, srcBitmap: TBitmap; Transparency: TPercent);
var
dstRow, srcRow: PRGBTripleArray;
x, y: Integer;
begin
for y := 0 to srcBitmap.Height-1 do
begin
srcRow := srcBitmap.ScanLine[y];
dstRow := dstBitmap.ScanLine[y];
for x := 0 to srcBitmap.Width-1 do
begin
dstRow[x].rgbtRed := ((100-Transparency) * dstRow[X].rgbtRed) div 100 +
(Transparency * srcRow[X].rgbtRed) div 100;
dstRow[x].rgbtGreen := ((100-Transparency) * dstRow[X].rgbtGreen) div 100 +
(Transparency * srcRow[X].rgbtGreen) div 100;
dstRow[x].rgbtBlue := ((100-Transparency) * dstRow[X].rgbtBlue) div 100 +
(Transparency * srcRow[X].rgbtBlue) div 100;
end;
end;
end;

// Both bitmaps must be equal size and 24 bit format.
procedure MergeRotate(dstBitmap, srcBitmap: TBitmap; xOrg, yOrg: Integer;
Angle: Double);
var
cosTheta: Extended;
sinTheta: Extended;
xSrc, ySrc: Integer;
xDst, yDst: Integer;
xPrime, yPrime: Integer;
srcRow, dstRow: PRGBTripleArray;
begin
SinCos(Angle, sinTheta, cosTheta);
for ySrc := 0 to srcBitmap.Height-1 do
begin
dstRow := dstBitmap.ScanLine[ySrc];
yPrime := ySrc - yOrg;
for xSrc := 0 to srcBitmap.Width-1 do
begin
xPrime := xSrc - xOrg;
xDst := xOrg + Round(xPrime * CosTheta - yPrime * sinTheta);
yDst := yOrg + Round(xPrime * sinTheta + yPrime * cosTheta);
if (xDst >= 0) and (xDst < dstBitmap.Width) and
(yDst >= 0) and (yDst < dstBitmap.Height)
then
begin
srcRow := srcBitmap.Scanline[yDst];
dstRow[xSrc] := srcRow[xDst]
end;
end;
end;
end;

{ TAnimateThread }

constructor TAnimateThread.Create(APicShow: TPicShow);
begin
PicShow := APicShow;
Priority := PicShow.ThreadPriority;
OnTerminate := PicShow.AnimationComplete;
FreeOnTerminate := True;
inherited Create(False);
end;

procedure TAnimateThread.Execute;
var
Elapsed: DWord;
begin
while not (Terminated or PicShow.Manual or PicShow.Stopping) do
begin
Elapsed := GetTickCount;
Synchronize(Update);
Elapsed := GetTickCount - Elapsed;
if (PicShow.Reverse and (PicShow.Progress = Low(TPercent))) or
(not PicShow.Reverse and (PicShow.Progress = High(TPercent))) then
Terminate
else if PicShow.Delay > Elapsed then
Sleep(PicShow.Delay - Elapsed);
end;
end;

procedure TAnimateThread.Update;
begin
if PicShow.Reverse then
if PicShow.Progress >= PicShow.Step then
PicShow.Progress := PicShow.Progress - PicShow.Step
else
PicShow.Progress := Low(TPercent)
else
PicShow.Progress := PicShow.Progress + PicShow.Step;
end;

{ TPicShow }

constructor TPicShow.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Media := TBitmap.Create;
Media.PixelFormat := pf24bit;
fStep := 4;
fDelay := 40;
fStyle := 51;
fReverse := False;
fCenter := False;
fStretch := False;
fStretchFine := False;
fAutoSize := True;
fThreaded := True;
fThreadPriority := tpNormal;
fManual := False;
fProgress := Low(TPercent);
fBusy := False;
fPicture := TPicture.Create;
fPicture.OnChange := PictureChange;
fBgPicture := TPicture.Create;
fBgPicture.OnChange := BgPictureChange;
fBgMode := bmTiled;
OffScreen := TBitmap.Create;
Width := 100;
Height := 100;
Thread := nil;
Stopping := False;
Drawing := False;
end;

destructor TPicShow.Destroy;
begin
if Assigned(Thread) then
begin
Thread.Terminate;
if Thread.Suspended then
Thread.Resume;
{$IFDEF PS_D4orHigher}
Thread.WaitFor;
{$ENDIF}
end;
Media.Free;
fPicture.Free;
OffScreen.Free;
inherited Destroy;
end;

procedure TPicShow.SetPicture(Value: TPicture);
begin
if Assigned(Value) then
fPicture.Assign(Value)
else
fPicture.Graphic := nil;
end;

procedure TPicShow.SetBgPicture(Value: TPicture);
begin
if Assigned(Value) then
fBgPicture.Assign(Value)
else
fBgPicture.Graphic := nil;
end;

procedure TPicShow.SetBgMode(Value: TBackgroundMode);
begin
if fBgMode <> Value then
begin
fBgMode := Value;
if Assigned(fBgPicture.Graphic) and not Drawing then Invalidate;
end;
end;

procedure TPicShow.SetCenter(Value: Boolean);
begin
if fCenter <> Value then
begin
fCenter := Value;
if Assigned(fPicture.Graphic) then
begin
CalculatePicRect;
if not (Media.Empty or Drawing) then Invalidate;
end;
end;
end;

procedure TPicShow.SetStretch(Value: Boolean);
begin
if fStretch <> Value then
begin
fStretch := Value;
if not (Media.Empty or Drawing) then Invalidate;
end;
end;

procedure TPicShow.SetStretchFine(Value: Boolean);
begin
if fStretchFine <> Value then
begin
fStretchFine := Value;
if not (Media.Empty or Drawing) then Invalidate;
end;
end;

procedure TPicShow.SetStep(Value: Word);
begin
if Value = 0 then Value := 1;
if Value > High(TPercent) then Value := High(TPercent);
fStep := Value;
end;

function TPicShow.GetEmpty: Boolean;
begin
Result := not Assigned(fPicture.Graphic) or fPicture.Graphic.Empty;
end;

procedure TPicShow.PictureChange(Sender: TObject);
begin
if not (csDestroying in ComponentState) then
begin
if Assigned(fPicture.Graphic) and fAutoSize then
AdjustClientSize;
if Assigned(fOnChange) then
fOnChange(Self);
end;
end;

procedure TPicShow.BgPictureChange(Sender: TObject);
begin
if (fBgMode <> bmNone) and not Drawing then Invalidate;
end;

procedure TPicShow.SetProgress(Value: TPercent);
begin
if Value < Low(TPercent) then Value := Low(TPercent);
if Value > High(TPercent) then Value := High(TPercent);
if fBusy and (fProgress <> Value) then
begin
if (fProgress > Value) and not Drawing then
InvalidateArea(Rect(0, 0, Media.Width, Media.Height));
fProgress := Value;
UpdateDisplay;
if Assigned(fOnProgress) and not (csDestroying in ComponentState) then
fOnProgress(Self);
end;
end;

procedure TPicShow.SetManual(Value: Boolean);
begin
if fManual <> Value then
begin
fManual := Value;
if not fBusy then
if fReverse then
fProgress := High(TPercent)
else
fProgress := Low(TPercent)
else if not fManual then
Animate;
end;
end;

procedure TPicShow.AnimationComplete(Sender: TObject);
begin
Thread := nil;
if Stopping or not fManual then
begin
fBusy := False;
if Assigned(Pic) then Pic.Free;
if Assigned(OldPic) then OldPic.Free;
Pic := nil;
OldPic := nil;
if Assigned(FOnComplete) and not (csDestroying in ComponentState) and
not Stopping then FOnComplete(Self);
end;
end;

procedure TPicShow.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
Msg.Result := 1;
end;

procedure TPicShow.WMPaint(var Msg: TWMPaint);
begin
if not Drawing and (GetCurrentThreadID = MainThreadID) then
begin
Drawing := True;
try
inherited;
finally
Drawing := False;
end;
end;
end;

procedure TPicShow.CMMouseEnter(var Msg: TMessage);
begin
inherited;
if Assigned(fOnMouseEnter) then fOnMouseEnter(Self);
end;

procedure TPicShow.CMMouseLeave(var Msg: TMessage);
begin
inherited;
if Assigned (fOnMouseLeave) then fOnMouseLeave(Self);
end;

procedure TPicShow.SetAutoSize(Value: Boolean);
begin
if fAutoSize <> Value then
begin
fAutoSize := Value;
if fAutoSize then AdjustClientSize;
end;
end;

procedure TPicShow.AdjustClientSize;
begin
if Assigned(fPicture.Graphic) and (Align = alNone) then
begin
ClientWidth := fPicture.Width;
ClientHeight := fPicture.Height;
end;
end;

procedure TPicShow.WMSize(var Msg: TWMSize);
begin
inherited;
if Assigned(fPicture.Graphic) then
begin
CalculatePicRect;
if not (Media.Empty or Drawing) then Invalidate;
end;
end;

procedure TPicShow.Paint;
var
R: TRect;
C: TCanvas;
begin
OffScreen.Width := ClientWidth;
OffScreen.Height := ClientHeight;
C := OffScreen.Canvas;
C.Lock;
try
R := ClientRect;
C.Brush.Color := Color;
C.FillRect(R);
if Assigned(fBgPicture.Graphic) then
case fBgMode of
bmTiled: DrawTiledImage(C, R, fBgPicture.Graphic);
bmStretched: C.StretchDraw(R, fBgPicture.Graphic);
bmCentered: C.Draw((R.Right - R.Left - fBgPicture.Width) div 2,
(R.Bottom - R.Top - fBgPicture.Height) div 2,
fBgPicture.Graphic);
end;
if not Media.Empty then
begin
if fStretch then
if fStretchFine then
C.StretchDraw(ScaleImageToRect(PicRect, R), Media)
else
C.StretchDraw(R, Media)
else
C.Draw(PicRect.Left, PicRect.Top, Media);
end;
finally
C.Unlock;
end;
Canvas.Lock;
try
Canvas.Draw(0, 0, OffScreen);
finally
Canvas.Unlock;
end;
end;

procedure TPicShow.CalculatePicRect;
begin
if not Media.Empty then
begin
SetRect(PicRect, 0, 0, Media.Width, Media.Height);
if fCenter then
OffsetRect(PicRect, (ClientWidth - Media.Width) div 2,
(ClientHeight - Media.Height) div 2);
end;
end;

procedure TPicShow.InvalidateArea(Area: TRect);
var
R: TRect;
begin
if fStretch then
begin
if fStretchFine then
R := ScaleImageToRect(PicRect, ClientRect)
else
R := ClientRect;
Area.Left := R.Left + MulDiv(Area.Left, R.Right - R.Left, PicRect.Right - PicRect.Left);
Area.Right := R.Left + MulDiv(Area.Right, R.Right - R.Left, PicRect.Right - PicRect.Left);
Area.Top := R.Top + MulDiv(Area.Top, R.Bottom - R.Top, PicRect.Bottom - PicRect.Top);
Area.Bottom := R.Top + MulDiv(Area.Bottom, R.Bottom - R.Top, PicRect.Bottom - PicRect.Top);
end
else
begin
if fCenter then OffsetRect(Area, PicRect.Left, PicRect.Top);
if Area.Left < PicRect.Left then Area.Left := PicRect.Left;
if Area.Right > PicRect.Right then Area.Right := PicRect.Right;
if Area.Top < PicRect.Top then Area.Top := PicRect.Top;
if Area.Bottom > PicRect.Bottom then Area.Bottom := PicRect.Bottom;
end;
if not (csDestroying in ComponentState) then
InvalidateRect(Handle, @Area, False);
end;

Procedure TPicShow.Clear;
begin
if not (fBusy or Media.Empty) then
begin
if Media.Canvas.TryLock then
begin
Media.Canvas.Unlock;
Media.Free;
Media := TBitmap.Create;
Media.PixelFormat := pf24bit;
Invalidate;
end;
end;
end;

procedure TPicShow.Stop;
begin
if fBusy and not Stopping then
begin
Stopping := True;
try
if Assigned(Thread) then
begin
Thread.Terminate;
{$IFDEF PS_D4orHigher}
Thread.WaitFor;
{$ENDIF}
end
else
AnimationComplete(Self);
finally
Stopping := False;
end;
end;
end;

procedure TPicShow.Execute;
begin
if not fBusy and Assigned(Picture.Graphic) then
begin
fBusy := True;
try
Prepare;
if not fManual then Animate;
except
if Assigned(Pic) then Pic.Free;
if Assigned(OldPic) then OldPic.Free;
fBusy := False;
raise;
end;
end;
end;

procedure TPicShow.Animate;
var
StartTime: DWord;
Done: Boolean;
begin
if fThreaded then
Thread := TAnimateThread.Create(Self)
else
begin
repeat
StartTime := GetTickCount;
if Reverse then
if Progress >= Step then
Progress := Progress - Step
else
Progress := Low(TPercent)
else
Progress := Progress + Step;
Done := (Reverse and (Progress = Low(TPercent))) or
(not Reverse and (Progress = High(TPercent)));
if not Done then
repeat
Application.ProcessMessages;
until ((GetTickCount - StartTime) > Delay) or not fBusy or fManual or Stopping;
until Done or not fBusy or fManual or Stopping;
if Done then AnimationComplete(Self);
end;
end;

procedure TPicShow.Prepare;
var
R: TRect;
begin
Media.Canvas.Brush.Color := Color;
Media.Width := fPicture.Width;
Media.Height := fPicture.Height;
CalculatePicRect;
OldPic := TBitmap.Create;
OldPic.Width := Media.Width;
OldPic.Height := Media.Height;
OldPic.PixelFormat := pf24bit;
if fStretch then
if fStretchFine then
R := ScaleImageToRect(PicRect, ClientRect)
else
R := ClientRect
else
R := PicRect;
OldPic.Canvas.CopyRect(Rect(0, 0, OldPic.Width, OldPic.Height), OffScreen.Canvas, R);
Pic := TBitmap.Create;
Pic.Width := Media.Width;
Pic.Height := Media.Height;
Pic.PixelFormat := pf24bit;
Pic.Canvas.Draw(0, 0, fPicture.Graphic);
if Reverse then
Progress := High(TPercent)
else
Progress := Low(TPercent);
end;

procedure TPicShow.UpdateDisplay;
var
X, Y, W, H: Integer;
R, Rgn: HRgn;
R1, R2: TRect;
I, J, S: Integer;
begin
Media.Canvas.Draw(0, 0, OldPic);
W := Pic.Width;
H := Pic.Height;
SetRect(R1, 0, 0, W, H);
SetRect(R2, 0, 0, W, H);
Rgn := NULLREGION;
if W >= H then
begin
X := MulDiv(W, fProgress, 100);
Y := MulDiv(X, H, W);
S := MulDiv(W, fStep, 90);
end
else
begin
Y := MulDiv(H, fProgress, 100);
X := MulDiv(Y, W, H);
S := MulDiv(H, fStep, 90);
end;
case fStyle of
0: begin
if Assigned(fOnCustomDraw) then
fOnCustomDraw(Self, Pic, Media)
else
begin
Media.Canvas.Draw(0, 0, Pic);
Rgn := CreateRectRgn(0, 0, W, H);
fProgress := High(TPercent);
end;
end;
1: begin
R1.Left := W - X;
end;
2: begin
R1.Right := X;
end;
3: begin
R1.Left := W - X;
R1.Right := (2 * W) - X;
end;
4: begin
R1.Left := X - W;
R1.Right := X;
end;
5: begin
R1.Right := X;
R2.Right := X;
end;
6: begin
R1.Left := W - X;
R2.Left := W - X;
end;
7: begin
R1.Right := (2 * W) - X;
R2.Right := X;
end;
8: begin
R1.Left := X - W;
R2.Left := W - X;
end;
9: begin
R1.Left := X - W;
R1.Right := (2 * W) - X;
R2.Left := (W - X) div 2;
R2.Right := (W + X) div 2;
end;
10: begin
R1.Left := (W - X) div 2;
R1.Right := (W + X) div 2;
end;
11: begin
R1.Left := (W - X) div 2;
R1.Right := (W + X) div 2;
R2.Left := (W - X) div 2;
R2.Right := (W + X) div 2;
end;
12: begin
R1.Left := 0;
R1.Right := (X div 2) + 1;
R2.Left := 0;
R2.Right := (X div 2) + 1;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := W - (X div 2) - 1;
R1.Right := W;
R2.Left := W - (X div 2) - 1;
R2.Right := W;
end;
13: begin
R1.Left := 0;
R1.Right := (X div 2) + 1;
R2.Left := 0;
R2.Right := (W div 2) + 1;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := W - (X div 2) - 1;
R1.Right := W;
R2.Left := W div 2;
R2.Right := W;
end;
14: begin
R1.Left := X;
if R1.Left < W div 5 then
R1.Right := R1.Left + X div 2
else if (R1.Left + W div 5) > W then
R1.Right := R1.Left + (W - X) div 2
else
R1.Right := R1.Left + W div 10;
R2.Left := R1.Right;
R2.Right := R2.Left + R1.Right - R1.Left;
MirrorCopyRect(Media.Canvas, R1, Pic, R2, True, False);
InvalidateArea(R1);
R1.Left := 0;
R1.Right := X;
R2.Left := 0;
R2.Right := X;
end;
15: begin
R1.Right := W - X;
if (R1.Right + W div 5) > W then
R1.Left := R1.Right - X div 2
else if R1.Right < W div 5 then
R1.Left := R1.Right - (W - X) div 2
else
R1.Left := R1.Right - W div 10;
R2.Right := R1.Left;
R2.Left := R2.Right - R1.Right + R1.Left;
MirrorCopyRect(Media.Canvas, R1, Pic, R2, True, False);
InvalidateArea(R1);
R1.Left := W - X;
R1.Right := W;
R2.Left := W - X;
R2.Right := W;
end;
16: begin
R1.Left := 0;
R1.Right := X;
R2.Left := 0;
R2.Right := X;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := X;
R1.Right := W;
R2.Left := X;
R2.Right := X + W div 20;
end;
17: begin
R1.Left := W - X;
R1.Right := W;
R2.Left := W - X;
R2.Right := W;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := 0;
R1.Right := W - X;
R2.Left := (W - X) - W div 20;
R2.Right := W - X;
end;
18: begin
R1.Top := H - Y;
end;
19: begin
R1.Bottom := Y;
end;
20: begin
R1.Top := H - Y;
R1.Bottom := (2 * H) - Y;
end;
21: begin
R1.Top := Y - H;
R1.Bottom := Y;
end;
22: begin
R1.Bottom := Y;
R2.Bottom := Y;
end;
23: begin
R1.Top := H - Y;
R2.Top := H - Y;
end;
24: begin
R1.Bottom := (2 * H) - Y;
R2.Bottom := Y;
end;
25: begin
R1.Top := Y - H;
R2.Top := H - Y;
end;
26: begin
R1.Top := Y - H;
R1.Bottom := (2 * H) - Y;
R2.Top := (H - Y) div 2;
R2.Bottom := (H + Y) div 2;
end;
27: begin
R1.Top := (H - Y) div 2;
R1.Bottom := (H + Y) div 2;
end;
28: begin
R1.Top := (H - Y) div 2;
R1.Bottom := (H + Y) div 2;
R2.Top := (H - Y) div 2;
R2.Bottom := (H + Y) div 2;
end;
29: begin
R1.Top := 0;
R1.Bottom := (Y div 2) + 1;
R2.Top := 0;
R2.Bottom := (Y div 2) + 1;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Top := H - (Y div 2) - 1;
R1.Bottom := H;
R2.Top := H - (Y div 2) - 1;
R2.Bottom := H;
end;
30: begin
R1.Top := 0;
R1.Bottom := (Y div 2) + 1;
R2.Top := 0;
R2.Bottom := (H div 2) + 1;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Top := H - (Y div 2) - 1;
R1.Bottom := H;
R2.Top := H div 2;
R2.Bottom := H;
end;
31: begin
R1.Top := Y;
if R1.Top < H div 5 then
R1.Bottom := R1.Top + Y div 2
else if (R1.Top + H div 5) > H then
R1.Bottom := R1.Top + (H - Y) div 2
else
R1.Bottom := R1.Top + H div 10;
R2.Top := R1.Bottom;
R2.Bottom := R2.Top + R1.Bottom - R1.Top;
MirrorCopyRect(Media.Canvas, R1, Pic, R2, False, True);
InvalidateArea(R1);
R1.Top := 0;
R1.Bottom := Y;
R2.Top := 0;
R2.Bottom := Y;
end;
32: begin
R1.Bottom := H - Y;
if (R1.Bottom + H div 5) > H then
R1.Top := R1.Bottom - Y div 2
else if R1.Bottom < H div 5 then
R1.Top := R1.Bottom - (H - Y) div 2
else
R1.Top := R1.Bottom - H div 10;
R2.Bottom := R1.Top;
R2.Top := R2.Bottom - R1.Bottom + R1.Top;
MirrorCopyRect(Media.Canvas, R1, Pic, R2, False, True);
InvalidateArea(R1);
R1.Top := H - Y;
R1.Bottom := H;
R2.Top := H - Y;
R2.Bottom := H;
end;
33: begin
R1.Top := 0;
R1.Bottom := Y;
R2.Top := 0;
R2.Bottom := Y;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Top := Y;
R1.Bottom := H;
R2.Top := Y;
R2.Bottom := Y + H div 20;
end;
34: begin
R1.Top := H - Y;
R1.Bottom := H;
R2.Top := H - Y;
R2.Bottom := H;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Top := 0;
R1.Bottom := H - Y;
R2.Top := (H - Y) - H div 20;
R2.Bottom := H - Y;
end;
35: begin
R1.Left := W - X;
R1.Top := H - Y;
end;
36: begin
R1.Left := W - X;
R1.Bottom := Y;
end;
37: begin
R1.Right := X;
R1.Bottom := Y;
end;
38: begin
R1.Right := X;
R1.Top := H - Y;
end;
39: begin
R1.Left := W - X;
R1.Top := H - Y;
R1.Right := (2 * W) - X;
R1.Bottom := (2 * H) - Y;
end;
40: begin
R1.Left := W - X;
R1.Top := Y - H;
R1.Right := (2 * W) - X;
R1.Bottom := Y;
end;
41: begin
R1.Left := X - W;
R1.Top := Y - H;
R1.Right := X;
R1.Bottom := Y;
end;
42: begin
R1.Left := X - W;
R1.Top := H - Y;
R1.Right := X;
R1.Bottom := (2 * H) - Y;
end;
43: begin
R1.Right := X;
R1.Bottom := Y;
R2.Right := X;
R2.Bottom := Y;
end;
44: begin
R1.Right := X;
R1.Top := H - Y;
R2.Right := X;
R2.Top := H - Y;
end;
45: begin
R1.Left := W - X;
R1.Top := H - Y;
R2.Left := W - X;
R2.Top := H - Y;
end;
46: begin
R1.Left := W - X;
R1.Bottom := Y;
R2.Left := W - X;
R2.Bottom := Y;
end;
47: begin
R1.Right := (2 * W) - X;
R1.Bottom := (2 * H) - Y;
R2.Right := X;
R2.Bottom := Y;
end;
48: begin
R1.Right := (2 * W) - X;
R1.Top := Y - H;
R2.Right := X;
R2.Top := H - Y;
end;
49: begin
R1.Left := X - W;
R1.Top := Y - H;
R2.Left := W - X;
R2.Top := H - Y;
end;
50: begin
R1.Left := X - W;
R1.Bottom := (2 * H) - Y;
R2.Left := W - X;
R2.Bottom := Y;
end;
51: begin
R1.Left := X - W;
R1.Top := Y - H;
R1.Right := (2 * W) - X;
R1.Bottom := (2 * H) - Y;
R2.Left := (W - X) div 2;
R2.Top := (H - Y) div 2;
R2.Right := (W + X) div 2;
R2.Bottom := (H + Y) div 2;
end;
52: begin
R1.Left := (W - X) div 2;
R1.Top := (H - Y) div 2;
R1.Right := (W + X) div 2;
R1.Bottom := (H + Y) div 2;
end;
53: begin
R1.Left := (W - X) div 2;
R1.Top := (H - Y) div 2;
R1.Right := (W + X) div 2;
R1.Bottom := (H + Y) div 2;
R2.Left := (W - X) div 2;
R2.Top := (H - Y) div 2;
R2.Right := (W + X) div 2;
R2.Bottom := (H + Y) div 2;
end;
54: begin
R1.Left := 0;
R1.Right := W;
R1.Top := 0;
R1.Bottom := Y div 2;
R2.Left := 0;
R2.Right := W;
R2.Top := 0;
R2.Bottom := Y div 2;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := 0;
R1.Right := W;
R1.Top := H - (Y div 2);
R1.Bottom := H;
R2.Left := 0;
R2.Right := W;
R2.Top := H - (Y div 2);
R2.Bottom := H;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := 0;
R1.Right := X div 2;
R1.Top := 0;
R1.Bottom := H;
R2.Left := 0;
R2.Right := X div 2;
R2.Top := 0;
R2.Bottom := H;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := W - (X div 2);
R1.Right := W;
R1.Top := 0;
R1.Bottom := H;
R2.Left := W - (X div 2);
R2.Right := W;
R2.Top := 0;
R2.Bottom := H;
end;
55: begin
R1.Left := 0;
R1.Top := 0;
R1.Right := (X div 2) + 1;
R1.Bottom := (Y div 2) + 1;
R2.Left := 0;
R2.Top := 0;
R2.Right := (X div 2) + 1;
R2.Bottom := (Y div 2) + 1;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := 0;
R1.Top := H - (Y div 2) - 1;
R1.Right := (X div 2) + 1;
R1.Bottom := H;
R2.Left := 0;
R2.Top := H - (Y div 2) - 1;
R2.Right := (X div 2) + 1;
R2.Bottom := H;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := W - (X div 2) - 1;
R1.Top := H - (Y div 2) - 1;
R1.Right := W;
R1.Bottom := H;
R2.Left := W - (X div 2) - 1;
R2.Top := H - (Y div 2) - 1;
R2.Right := W;
R2.Bottom := H;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := W - (X div 2) - 1;
R1.Top := 0;
R1.Right := W;
R1.Bottom := (Y div 2) + 1;
R2.Left := W - (X div 2) - 1;
R2.Top := 0;
R2.Right := W;
R2.Bottom := (Y div 2) + 1;
end;
56: begin
R1.Left := 0;
R1.Top := 0;
R1.Right := (X div 2) + 1;
R1.Bottom := (Y div 2) + 1;
R2.Left := 0;
R2.Top := 0;
R2.Right := (W div 2) + 1;
R2.Bottom := (H div 2) + 1;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := 0;
R1.Top := H - (Y div 2);
R1.Right := (X div 2) + 1;
R1.Bottom := H;
R2.Left := 0;
R2.Top := (H div 2) + 1;
R2.Right := (W div 2) + 1;
R2.Bottom := H;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := W - (X div 2);
R1.Top := H - (Y div 2);
R1.Right := W;
R1.Bottom := H;
R2.Left := (W div 2) + 1;
R2.Top := (H div 2) + 1;
R2.Right := W;
R2.Bottom := H;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := W - (X div 2);
R1.Top := 0;
R1.Right := W;
R1.Bottom := (Y div 2) + 1;
R2.Left := (W div 2) + 1;
R2.Top := 0;
R2.Right := W;
R2.Bottom := (H div 2) + 1;
end;
57: begin
R1.Left := (X - W) div 2;
R1.Right := (X div 2) + 1;
R1.Top := 0;
R1.Bottom := (H div 2) + 1;
R2.Left := 0;
R2.Right := (W div 2) + 1;
R2.Top := 0;
R2.Bottom := (H div 2) + 1;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := (W div 2) - 1;
R1.Right := W;
R1.Top := (Y - H) div 2;
R1.Bottom := (Y div 2) + 1;
R2.Left := (W div 2) - 1;
R2.Right := W;
R2.Top := 0;
R2.Bottom := (H div 2) + 1;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := W - X div 2;
R1.Right := W + (W - X) div 2;
R1.Top := (H div 2) - 1;
R1.Bottom := H;
R2.Left := (W div 2) + 1;
R2.Right := W;
R2.Top := (H div 2) - 1;
R2.Bottom := H;
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
InvalidateArea(R1);
R1.Left := 0;
R1.Right := (W div 2) + 1;
R1.Top := H - Y div 2;
R1.Bottom := H + (H - Y) div 2;
R2.Left := 0;
R2.Right := (W div 2) + 1;
R2.Top := (H div 2) + 1;
R2.Bottom := H;
end;
58: Rgn := CreateRoundRectRgn(-(2 * W), -5, 2 * X, H + 5, 2 * W, 2 * W);
59: Rgn := CreateRoundRectRgn(W - 2 * X, -5, W + (2 * W), H + 5, 2 * W, 2 * W);
60: Rgn := CreateBarRgn(2 * X, 0, W, H, S, 1, 0);
61: Rgn := CreateBarRgn(2 * X, 0, W, H, S, 2, 0);
62: Rgn := CreateBarRgn(2 * X, 0, W, H, S, 4, 0);
63: Rgn := CreateBarRgn(2 * X, 0, W, H, S, 5, 0);
64: Rgn := CreateBarRgn(X, 0, W, H, 0, 3, 0);
65: Rgn := CreateSplashRgn(X, 0, W, H, 1, 0);
66: Rgn := CreateSplashRgn(X, 0, W, H, 2, 0);
67: Rgn := CreateSplashRgn(X, 0, W, H, 3, 0);
68: Rgn := CreateSplashRgn(X, 0, W, H, 4, 0);
69: Rgn := CreateRoundRectRgn(-5, -(2 * H), W + 5, 2 * Y, 2 * H, 2 * H);
70: Rgn := CreateRoundRectRgn(-5, H - 2 * Y, W + 5, H + (2 * H), 2 * H, 2 * H);
71: Rgn := CreateBarRgn(0, 2 * Y, W, H, S, 0, 1);
72: Rgn := CreateBarRgn(0, 2 * Y, W, H, S, 0, 2);
73: Rgn := CreateBarRgn(0, 2 * Y, W, H, S, 0, 4);
74: Rgn := CreateBarRgn(0, 2 * Y, W, H, S, 0, 5);
75: Rgn := CreateBarRgn(0, Y, W, H, 0, 0, 3);
76: Rgn := CreateSplashRgn(0, Y, W, H, 0, 1);
77: Rgn := CreateSplashRgn(0, Y, W, H, 0, 2);
78: Rgn := CreateSplashRgn(0, Y, W, H, 0, 3);
79: Rgn := CreateSplashRgn(0, Y, W, H, 0, 4);
80: Rgn := CreateRoundRectRgn(-(2 * W), -(2 * H), 2 * X, 2 * Y, 2 * W, 2 * H);
81: Rgn := CreateRoundRectRgn(W - 2 * X, -(2 * H), W + (2 * W), 2 * Y, 2 * W, 2 * H);
82: Rgn := CreateRoundRectRgn(-(2 * W), H - 2 * Y, 2 * X, H + (2 * H), 2 * W, 2 * H);
83: Rgn := CreateRoundRectRgn(W - 2 * X, H - 2 * Y, W + (2 * W), H + (2 * H), 2 * H, 2 * H);
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);
85: begin
R := CreateRectRgn(0, 0, W, H);
Rgn := CreateRoundRectRgn(X - W div 2, Y - H div 2, 3 * W div 2 - X,
3 * H div 2 - Y, 9 * (W - X) div 5, 9 * (H - Y) div 5);
CombineRgn(Rgn, Rgn, R, RGN_XOR);
DeleteObject(R);
end;
86: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 1, 1);
87: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 1, 2);
88: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 2, 1);
89: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 2, 2);
90: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 4, 4);
91: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 4, 5);
92: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 5, 4);
93: Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 5, 5);
94: Rgn := CreateBarRgn(X, Y, W, H, S, 1, 3);
95: Rgn := CreateBarRgn(X, Y, W, H, S, 2, 3);
96: Rgn := CreateBarRgn(X, Y, W, H, S, 3, 1);
97: Rgn := CreateBarRgn(X, Y, W, H, S, 3, 2);
98: Rgn := CreateBarRgn(X, Y, W, H, 0, 3, 3);
99: begin
R := CreateBarRgn(2 * X, 2 * Y, W, H, S, 1, 1);
Rgn := CreateBarRgn(2 * X, 2 * Y, W, H, S, 2, 2);
CombineRgn(Rgn, Rgn, R, RGN_AND);
DeleteObject(R);
end;
100: Rgn := CreateSplashRgn(X, Y, W, H, 1, 1);
101: Rgn := CreateSplashRgn(X, Y, W, H, 1, 2);
102: Rgn := CreateSplashRgn(X, Y, W, H, 2, 1);
103: Rgn := CreateSplashRgn(X, Y, W, H, 2, 2);
104: Rgn := CreateSplashRgn(X, Y, W, H, 1, 3);
105: Rgn := CreateSplashRgn(X, Y, W, H, 2, 3);
106: Rgn := CreateSplashRgn(X, Y, W, H, 3, 1);
107: Rgn := CreateSplashRgn(X, Y, W, H, 3, 2);
108: Rgn := CreateSplashRgn(X, Y, W, H, 3, 3);
109: Rgn := CreateSplashRgn(X, Y, W, H, 4, 4);
// Thanks to M. R. Zamani for these effects
110: Rgn := CreateTriangleRgn(0, 0, 2 * X, 0, 0, 2 * Y);
111: Rgn := CreateTriangleRgn(W, 0, W - 2 * X, 0, W, 2 * Y);
112: Rgn := CreateTriangleRgn(0, H, 2 * X, H, 0, H - 2 * Y);
113: Rgn := CreateTriangleRgn(W, H, W - 2 * X, H, W, H - 2 * Y);
114: begin
R := CreateTriangleRgn(0, H, 0, 0, X, H);
Rgn := CreateTriangleRgn(W, H, W, 0, W - X, 0);
CombineRgn(Rgn, Rgn, R, RGN_OR);
DeleteObject(R);
end;
115: begin
R := CreateTriangleRgn(W, 0, 0, 0, W, Y);
Rgn := CreateTriangleRgn(W, H, 0, H, 0, H - Y);
CombineRgn(Rgn, Rgn, R, RGN_OR);
DeleteObject(R);
end;
116: begin
Rgn := CreateTriangleRgn(W div 2, H div 2, 0, H, 0, H - Y);
R := CreateTriangleRgn(0, 0, X, 0, W div 2, H div 2);
CombineRgn(Rgn, Rgn, R, RGN_OR);
DeleteObject(R);
R := CreateTriangleRgn(W - X, H, W div 2, H div 2, W, H);
CombineRgn(Rgn, Rgn, R, RGN_OR);
DeleteObject(R);
R := CreateTriangleRgn(W div 2, H div 2, W, 0, W, Y);
CombineRgn(Rgn, Rgn, R, RGN_OR);
DeleteObject(R);
end;
117: begin
X := X div 5;
Y := MulDiv(X, H, W);
for J := 0 to 9 do
begin
for I := 0 to 9 do
begin
R := CreateTriangleRgn(I * W div 10, J * H div 10,
I * W div 10 + X, J * H div 10, I * W div 10, J * H div 10 + Y);
if Rgn <> NULLREGION then
begin
CombineRgn(Rgn, Rgn, R, RGN_OR);
DeleteObject(R);
end
else
Rgn := R;
end;
end;
end;
118: MergeTransparent(Media, Pic, Progress);
119: MergeRotate(Media, Pic, -1, -1, (100-Progress) * PI / 200);
120: MergeRotate(Media, Pic, -1, H, (100-Progress) * PI / 200);
121: MergeRotate(Media, Pic, W, -1, (100-Progress) * PI / 200);
122: MergeRotate(Media, Pic, W, H, (100-Progress) * PI / 200);
else
Exit;
end; // end of case
if fProgress = High(TPercent) then
Media.Canvas.Draw(0, 0, Pic)
else if fProgress <> Low(TPercent) then
if fStyle in RegionStyles then
begin
ExtSelectClipRgn(Media.Canvas.Handle, Rgn, RGN_AND);
Media.Canvas.Draw(0, 0, Pic);
SelectClipRgn(Media.Canvas.Handle, 0);
end
else if fStyle in [1..57] then
Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
if Rgn <> NULLREGION then DeleteObject(Rgn);
InvalidateArea(R1);
if not Drawing then Update;
end;

end.

gz

谢了！[]

这么大,让我如何下手,如何应用哦！
[]

GZ

install

我也正在作大屏幕演示，你要的窗口特效，有很多中表现方法。
前面，dingbaosheng,说的picshow是一种，里面有122种效果，同样要做出窗口消融、效果的
还有《delphi第三方控件使用大全》中的另一个控件叫tranfx控件。
同样的控件还有ahm套件中的ahmformslide及ahmprensation控件，里面也有54中，窗体的
显示效果，拉到程序里，很容易实现的。
另外，简单的窗体动画还有AnimateWindow api函数。
这样问题解决了吧
btw，dingbaosheng兄，可不可以以后只贴一个下载地址，不要把控件的源码贴在这儿，
不然，不是宽带上网的朋友就倒了大霉。
谁要picshow、ahmformslide、ahmprensation的朋友，可以写信给我liu-yongxue@263.net
或者到51delphi.com上下，很多的。

To 刘永学：
　　tranfx在《delphi第三方控件大全》里是属于哪一个分类？

to悲酥清风 :
《delphi第三方控件使用大全》是一本书，里面附带了一张光盘，里面的序列号，好像是
d3pcub，分类是在图形图像类。（安装目录下/）
如果你是南京的话，我可以将光盘借给你

看来我得抓紧学控件的使用,安装了,!

感觉问题还没有解决,我会继续看看控件和winapi