I added fades gradual rising and falling in Tpicshow
- Code: Select all
// Fade from bottom
procedure DoFadeUp(Display, Image: TBitmap; W, H, Progress, deb, fin: Integer);
var dstPixel, srcPixel: PRGBQuad;
Weight, pos, Blend, I, k : integer;
begin
srcPixel := Image.ScanLine[H-1];
dstPixel := Display.ScanLine[H-1];
Blend := Muldiv(256, progress, percent) ; // ~ blend in [0..256]
pos := muldiv(w,progress,percent); // ~ x
for k := 0 to w-1 do begin
if k <= pos
then Weight := Blend
else begin
i := min(k-pos, H-k-1);
IF I < 0 THEN Weight := 0 else Weight := Blend - min(i, Blend);
end;
for i := fin downTo deb do begin
with dstPixel^ do begin
Inc(rgbRed, (Weight * (srcPixel^.rgbRed - rgbRed)) shr 8);
Inc(rgbGreen, (Weight * (srcPixel^.rgbGreen - rgbGreen)) shr 8);
Inc(rgbBlue, (Weight * (srcPixel^.rgbBlue - rgbBlue)) shr 8);
end;
Inc(srcPixel);
Inc(dstPixel); end;
end;
end;
// Fade from top
procedure DoFadeDown(Display, Image: TBitmap; W, H, Progress, deb, fin: Integer);
var dstPixel, srcPixel: PRGBQuad;
Weight, pos, Blend, I, k : integer;
begin
srcPixel := Image.ScanLine[H-1];
dstPixel := Display.ScanLine[H-1];
Blend := Muldiv(256, progress, percent) ; // ~ blend in [0..256]
pos := muldiv(w,progress,percent); // ~ x
for k := w-1 downto 0 do begin
if k <= pos
then Weight := Blend
else begin
i := min(k-pos, H-k-1);
IF I < 0 THEN Weight := 0 else Weight := Blend - min(i, Blend);
end;
for i := deb to fin do begin
with dstPixel^ do begin
Inc(rgbRed, (Weight * (srcPixel^.rgbRed - rgbRed)) shr 8);
Inc(rgbGreen, (Weight * (srcPixel^.rgbGreen - rgbGreen)) shr 8);
Inc(rgbBlue, (Weight * (srcPixel^.rgbBlue - rgbBlue)) shr 8);
end;
Inc(srcPixel);
Inc(dstPixel); end;
end;
end;
// Fade from bottom
procedure Effect207(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
DoFadeUp(Display, Image, W, H, Progress, 0, h-1);
end;
// Fade from top
procedure Effect208(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
DoFadeDown(Display, Image, W, H, Progress, 0, h-1);
end;
// Fade from center to out vertical
procedure Effect209(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
DoFadeDown(Display, Image, w, h , Progress, h div 2, h-1);
DoFadeUp(Display, Image, w, h div 2 , Progress, 0, h div 2-1);
end;
// Fade from out to center vertical but a problem here probably because dstPixel := Display.ScanLine[H-1];
procedure Effect210(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
DoFadeUp(Display, Image, w, h , Progress, h div 2+1, h-1);
DoFadeDown(Display, Image, w, h div 2+1, Progress, 0, h div 2 );
end;
I would like to do the same with two new procedures as "DoFadeLeft()" and "DoFadeRight()" but with scanLine it's not possible
thank you
Eric