Progressive fade for TPicshow

[Tisseyre]

hello
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

[Tisseyre]

Ok : i find a correction about progressive fade from middle or to Middle
(but not answer / left or right progressive fade...)
corrected code is:

Code: Select all

// Fade from bottom
procedure DoFadeUp(Display, Image: TBitmap; W, H, Progress, deb, fin: Integer; middle : boolean);
var dstPixel, srcPixel: PRGBQuad;
    Weight, pos, Blend, I, k : integer;
begin
  srcPixel := Image.ScanLine[H-1];
  dstPixel := Display.ScanLine[H-1];
  Blend :=  Muldiv(256, progression, percent) ;       // ~ blend in [0..256]
  pos :=   muldiv(w,progress,percent);  // ~ x
  if middle then begin inc(srcPixel, w*deb);  inc(dstPixel,w*deb); end;
  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; middle : boolean);
var dstPixel, srcPixel: PRGBQuad;
    Weight, pos, Blend, I, k : integer;
begin
  srcPixel := Image.ScanLine[H-1];
  dstPixel := Display.ScanLine[H-1];
  Blend :=  Muldiv(256, progression, percent) ;
  pos :=  muldiv(w,progress,percent);
  if middle then begin inc(srcPixel, w*deb);  inc(dstPixel,w*deb) end;
  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, false);
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, false);
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, true);
  DoFadeUp(Display, Image, w, h , Progress, 0, h div 2 -1, true);
end;

// Fade from out to center vertical
procedure Effect210(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  DoFadeDown(Display, Image, w,h , Progress, 0, h div 2 -1, true );
  DoFadeUp(Display, Image, w, h , Progress, h div 2, h-1, true);
end;


[Kambiz]

Thank you, I'll check them out.

[Tisseyre]

sorry, my code is consistent only with vertical images.
The fit is not perfect because transparency is defined as a horizontal dimension when it is the vertical dimension must be defined.
In fact, the new variable posX included in the procedure should be called PosY ...
now rectified this code is better suited and can be a source of study?

Code: Select all

// Fade from bottom
procedure DoFadeUp(Display, Image: TBitmap; W, H, Progress, deb, fin, Posit: Integer);
var dstPixel, srcPixel: PRGBQuad;
    Weight, posX, Blend, I, k, delta : integer;
begin
  srcPixel := Image.ScanLine[H-1];
  dstPixel := Display.ScanLine[H-1];
  inc(srcPixel, posit);
  inc(dstPixel, posit);
  posX :=   muldiv(w, progress, percent);
  Blend := Muldiv(256, progress , percent);

  for k := 0 to w-1 do begin
      if k <= posX
         then Weight :=  Blend
         else begin
              delta := min(k-posX, w-k); // delta >= 0 !
              Weight := Blend - min(delta, 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, Posit: Integer);
var dstPixel, srcPixel: PRGBQuad;
    Weight, posX, Blend, I, k, delta : integer;
begin
  srcPixel := Image.ScanLine[H-1];
  dstPixel := Display.ScanLine[H-1];
  inc(srcPixel, posit);
  inc(dstPixel, posit);
  posX :=  muldiv(w, progress, percent);
  Blend := Muldiv(256, progress , percent);

  for k := w-1 downto 0 do begin
      if k <= posX
         then Weight :=  Blend
         else begin
              delta := min(k-posX, w-k); // delta >= 0 !
              Weight := Blend - min(delta, 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, 0);
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, 0);
end;

// Fade from Out vertical To Center
procedure Effect209(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  DoFadeDown( Display, Image, w, h , Progress, h div 2+1 , h-1       , (h div 2+1)*w);
  DoFadeUp  ( Display, Image, w, h , Progress, 0         , h div 2   , 0);
end;

// Fade from Center vertical to out
procedure Effect210(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  DoFadeDown(Display, Image, w, h , Progress, 0        , h div 2, 0 );
  DoFadeUp  (Display, Image, w, h , Progress, h div 2+1, h-1    , (h div 2+1)*w);
end;