如何將Timage做fadein |
|
答題得分者是：hagar
|
|
pceyes
尊榮會員   發表：70 回覆：657 積分：1140 註冊：2003-03-13 發送簡訊給我 |
在網路找到Timage fadeout(淡出)的程式碼
卻不知如何將其改成fadein(淡入)
若有其他方式,也請指示方向,謝謝!
procedure FadeOut(const Bmp: TImage; Pause: Integer);
var
BytesPorScan, counter, w, h: Integer;
p: pByteArray;
begin
if not (Bmp.Picture.Bitmap.PixelFormat in [pf24Bit, pf32Bit]) then
raise Exception.Create('Error, bitmap format is not supporting.');
try
BytesPorScan := Abs(Integer(Bmp.Picture.Bitmap.ScanLine[1]) -
Integer(Bmp.Picture.Bitmap.ScanLine[0]));
except
raise Exception.Create('Error!!');
end; for counter := 1 to 256 do
begin
for h := 0 to Bmp.Picture.Bitmap.Height - 1 do
begin
P := Bmp.Picture.Bitmap.ScanLine[h];
for w := 0 to BytesPorScan - 1 do
if P^[w] > 0 then P^[w] := P^[w] - 1;
end;
Sleep(Pause);
Bmp.Refresh;
end;
end; 努力會更接近成功
------
努力會更接近成功 |
|
hagar
版主  發表：143 回覆：4056 積分：4445 註冊：2002-04-14 發送簡訊給我 |
參考 to fade in/out a TImage:
http://www.swissdelphicenter.ch/torry/showcode.php?id=1165
// Speichert die Farbwerte / Stores the colors //
type
PRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array[0..32767] of TRGBTriple; /////////////////////////////////////////////////
// Fade In //
///////////////////////////////////////////////// procedure FadeIn(ImageFileName: TFileName);
var
Bitmap, BaseBitmap: TBitmap;
Row, BaseRow: PRGBTripleArray;
x, y, step: integer;
begin
// Bitmaps vorbereiten / Preparing the Bitmap //
Bitmap := TBitmap.Create;
try
Bitmap.PixelFormat := pf32bit; // oder pf24bit / or pf24bit //
Bitmap.LoadFromFile(ImageFileName);
BaseBitmap := TBitmap.Create;
try
BaseBitmap.PixelFormat := pf32bit;
BaseBitmap.Assign(Bitmap);
// Fading //
for step := 0 to 32 do
begin
for y := 0 to (Bitmap.Height - 1) do
begin
BaseRow := BaseBitmap.Scanline[y];
// Farben vom Endbild holen / Getting colors from final image //
Row := Bitmap.Scanline[y];
// Farben vom aktuellen Bild / Colors from the image as it is now //
for x := 0 to (Bitmap.Width - 1) do
begin
Row[x].rgbtRed := (step * BaseRow[x].rgbtRed) shr 5;
Row[x].rgbtGreen := (step * BaseRow[x].rgbtGreen) shr 5; // Fading //
Row[x].rgbtBlue := (step * BaseRow[x].rgbtBlue) shr 5;
end;
end;
Form1.Canvas.Draw(0, 0, Bitmap); // neues Bild ausgeben / Output new image //
InvalidateRect(Form1.Handle, nil, False);
// Fenster neu zeichnen / Redraw window //
RedrawWindow(Form1.Handle, nil, 0, RDW_UPDATENOW);
end;
finally
BaseBitmap.Free;
end;
finally
Bitmap.Free;
end;
end; /////////////////////////////////////////////////
// Fade Out //
///////////////////////////////////////////////// procedure FadeOut(ImageFileName: TFileName);
var
Bitmap, BaseBitmap: TBitmap;
Row, BaseRow: PRGBTripleArray;
x, y, step: integer;
begin
// Bitmaps vorbereiten / Preparing the Bitmap //
Bitmap := TBitmap.Create;
try
Bitmap.PixelFormat := pf32bit; // oder pf24bit / or pf24bit //
Bitmap.LoadFromFile(ImageFileName);
BaseBitmap := TBitmap.Create;
try
BaseBitmap.PixelFormat := pf32bit;
BaseBitmap.Assign(Bitmap);
// Fading //
for step := 32 downto 0 do
begin
for y := 0 to (Bitmap.Height - 1) do
begin
BaseRow := BaseBitmap.Scanline[y];
// Farben vom Endbild holen / Getting colors from final image //
Row := Bitmap.Scanline[y];
// Farben vom aktuellen Bild / Colors from the image as it is now //
for x := 0 to (Bitmap.Width - 1) do
begin
Row[x].rgbtRed := (step * BaseRow[x].rgbtRed) shr 5;
Row[x].rgbtGreen := (step * BaseRow[x].rgbtGreen) shr 5; // Fading //
Row[x].rgbtBlue := (step * BaseRow[x].rgbtBlue) shr 5;
end;
end;
Form1.Canvas.Draw(0, 0, Bitmap); // neues Bild ausgeben / Output new image //
InvalidateRect(Form1.Handle, nil, False);
// Fenster neu zeichnen / Redraw window //
RedrawWindow(Form1.Handle, nil, 0, RDW_UPDATENOW);
end;
finally
BaseBitmap.Free;
end;
finally
Bitmap.Free;
end;
end; procedure TForm1.Button1Click(Sender: TObject);
begin
FadeIn('C:\TestImage.bmp')
end; {*****************************}
{by Yucel Karapinar, ykarapinar@hotmail.com } { Only for 24 ve 32 bits bitmaps } procedure FadeOut(const Bmp: TImage; Pause: Integer);
var
BytesPorScan, counter, w, h: Integer;
p: pByteArray;
begin
if not (Bmp.Picture.Bitmap.PixelFormat in [pf24Bit, pf32Bit]) then
raise Exception.Create('Error, bitmap format is not supporting.');
try
BytesPorScan := Abs(Integer(Bmp.Picture.Bitmap.ScanLine[1]) -
Integer(Bmp.Picture.Bitmap.ScanLine[0]));
except
raise Exception.Create('Error!!');
end; for counter := 1 to 256 do
begin
for h := 0 to Bmp.Picture.Bitmap.Height - 1 do
begin
P := Bmp.Picture.Bitmap.ScanLine[h];
for w := 0 to BytesPorScan - 1 do
if P^[w] > 0 then P^[w] := P^[w] - 1;
end;
Sleep(Pause);
Bmp.Refresh;
end;
end; procedure TForm1.Button2Click(Sender: TObject);
begin
FadeOut(Image1, 1);
end;
--
hagar.
|
|
pceyes
尊榮會員 發表：70 回覆：657 積分：1140 註冊：2003-03-13 發送簡訊給我 |
|
|
hagar
版主 發表：143 回覆：4056 積分：4445 註冊：2002-04-14 發送簡訊給我 |
改 FadeIn 部份, mark 掉紅色部份, 改用藍色部份:
procedure FadeIn(ImageFileName: TFileName);
var
Bitmap, BaseBitmap: TBitmap;
Row, BaseRow: PRGBTripleArray;
x, y, step: integer;
begin
// Bitmaps vorbereiten / Preparing the Bitmap //
Bitmap := TBitmap.Create;
try
Bitmap.PixelFormat := pf32bit; // oder pf24bit / or pf24bit //
Bitmap.LoadFromFile(ImageFileName);
BaseBitmap := TBitmap.Create;
try
BaseBitmap.PixelFormat := pf32bit;
BaseBitmap.Assign(Bitmap);
// Fading //
for step := 0 to 32 do
begin
for y := 0 to (Bitmap.Height - 1) do
begin
BaseRow := BaseBitmap.Scanline[y];
// Farben vom Endbild holen / Getting colors from final image //
Row := Bitmap.Scanline[y];
// Farben vom aktuellen Bild / Colors from the image as it is now //
for x := 0 to (Bitmap.Width - 1) do
begin
Row[x].rgbtRed := (step * BaseRow[x].rgbtRed) shr 5;
Row[x].rgbtGreen := (step * BaseRow[x].rgbtGreen) shr 5; // Fading //
Row[x].rgbtBlue := (step * BaseRow[x].rgbtBlue) shr 5;
end;
end;
// 以下三行 mark 掉
//Form1.Canvas.Draw(0, 0, Bitmap);
//InvalidateRect(Form1.Handle, nil, False);
//RedrawWindow(Form1.Handle, nil, 0, RDW_UPDATENOW);
//改用以下兩行
Image1.Picture.Graphic := Bitmap;
Image1.Repaint;
end;
finally
BaseBitmap.Free;
end;
finally
Bitmap.Free;
end;
end;
--
hagar. 發表人 - hagar 於 2005/07/15 22:14:05
|
發表時間：2005-07-15 07:14:45
IP:220.132.xxx.xxx 未訂閱
系統時間：2024-04-20 6:09:55
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |