Progressive fade for TPicshow

Please post bug reports, feature requests, or any question regarding the DELPHI AREA products here.

Progressive fade for TPicshow

Postby Tisseyre » September 7th, 2011, 3:18 pm

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
Active Member
Active Member
 
Posts: 10
Joined: November 23rd, 2010, 10:36 am

Re: Progressive fade for TPicshow

Postby Tisseyre » September 7th, 2011, 6:46 pm

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;
Tisseyre
Active Member
Active Member
 
Posts: 10
Joined: November 23rd, 2010, 10:36 am

Re: Progressive fade for TPicshow

Postby Kambiz » September 8th, 2011, 12:58 pm

Thank you, I'll check them out.
Kambiz
User avatar
Kambiz
Administrator
Administrator
 
Posts: 2408
Joined: March 7th, 2003, 7:10 pm

Re: Progressive fade for TPicshow

Postby Tisseyre » September 9th, 2011, 1:05 am

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;
Tisseyre
Active Member
Active Member
 
Posts: 10
Joined: November 23rd, 2010, 10:36 am


Return to DELPHI AREA Products

Who is online

Users browsing this forum: Bing [Bot] and 1 guest