new effect for TPicshow

[Tisseyre]

// Tanks For TPicshow : very good !
// I add some effects...
// (it's just a small contribution)

// percent [0..100] is not suffisant for me / fluidity and i prefere TMaxi [0..2048]
// why? because (2048 => shr 11) > (full HD => 1920);

Code: Select all

Const maxi = 2048;  //
         dbmaxi = maxi*2 ;    //4096;
         hfmaxi = maxi div 2; //1024;

function Muldiv255(progression : integer) : integer;
begin
  result := Muldiv(255, progression, maxi)
end;

function Muldiv256(progression : integer) : integer;
begin
  result := progression shr 3 ; // ~ Muldiv(256, progression, maxi)
end;

// reveal out from middle h with Fade
procedure Effect170(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var mWy: Integer;
    Rgn: HRGN;
    Blend : TBLENDFUNCTION;
begin
  mWy := (H - y) div 2;
  Rgn := CreateRectRgn(0, mWY, W, (H + y) div 2);
  ZeroMemory(@Blend, SizeOf(Blend));
  with Display.Canvas do Try
      SelectClipRgn(Handle, Rgn);
      Blend.SourceConstantAlpha := MulDiv255(Progress) ;
      AlphaBlend(Handle, 0, 0, w,h, Image.Canvas.Handle, 0, 0,w,h,  Blend);
      //AlphaBlend(Handle, 0, (h-y) div 2, w, (h + y) div 2, Image.Canvas.Handle, 0, 0,w,h, Blend);
      BitBlt(Handle, 0, 0, W, mwy, Image.Canvas.Handle, 0, 0, srccopy);  //
      SelectClipRgn(Handle, 0);
  finally DeleteObject(Rgn); end;
end;

// Fade Sinus
procedure Effect171(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var
  dstPixel, srcPixel: PRGBQuad;
  Weight: Integer;
  I: Integer;
begin
  srcPixel := Image.ScanLine[H - 1];
  dstPixel := Display.ScanLine[H - 1];
  Weight := round(hfmaxi * ( 1 + sin(-pi/2 + progress/maxi*pi)));
  for I := (W * H) - 1 downto 0 do begin
    with dstPixel^ do begin
      Inc(rgbRed, (Weight * (srcPixel^.rgbRed - rgbRed)) shr 11);
      Inc(rgbGreen, (Weight * (srcPixel^.rgbGreen - rgbGreen)) shr 11);
      Inc(rgbBlue, (Weight * (srcPixel^.rgbBlue - rgbBlue)) shr 11); end;
    Inc(srcPixel);
    Inc(dstPixel);
  end;
end;

// Fade Staccato1
procedure Effect173(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var
  dstPixel, srcPixel: PRGBQuad;
  Weight: Integer;
  I : Integer;
begin
  srcPixel := Image.ScanLine[H - 1];
  dstPixel := Display.ScanLine[H - 1];
  if progress < maxi / 3
     then Weight := MulDiv256(progress * 3 div 2)
     else if progress < dbmaxi / 3
          then Weight := 128 //MulDiv(256, hfmaxi, Maxi)
          else Weight := MulDiv256(progress-(maxi-progress) div 3);
  for I := (W * H) - 1 downto 0 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;

// Fade Staccato2
procedure Effect174(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var
  dstPixel, srcPixel: PRGBQuad;
  Weight: Integer;
  I: Integer;
begin
  srcPixel := Image.ScanLine[H - 1];
  dstPixel := Display.ScanLine[H - 1];
  case progress of
         0 ..  400 : Weight := MulDiv256(progress * 5 div 3);
       401 ..  800 : Weight := MulDiv256( maxi div 3);
       801 .. 1200 : Weight := MulDiv256( progress - (1200-progress)*3 div 5);
       1201.. 1600 : Weight := MulDiv256( dbmaxi div 3)
       else          Weight := MulDiv256( progress - (maxi-progress)*3 div 5);
       end;
  for I := (W * H) - 1 downto 0 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;

// Reveal from left with Fade
procedure Effect176(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var Rgn: HRGN;
    Blend : TBLENDFUNCTION;
begin
  Rgn := CreateRectRgn(0, 0, X, H);
  ZeroMemory(@Blend, SizeOf(Blend));
  with Display.Canvas do try
      SelectClipRgn(Handle, Rgn);
      Blend.SourceConstantAlpha := MulDiv255(Progress) ;
      AlphaBlend(Handle, 0, 0, w, h, Image.Canvas.Handle, 0, 0,w,h, Blend);
      BitBlt(Handle, 0, 0, -2 * W, 0, Image.Canvas.Handle, 0, 0, SRCCOPY);
      SelectClipRgn(Handle, 0);
  finally DeleteObject(Rgn); end;
end;

// Elliptic reveal out from centre with Fade
procedure Effect177(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
  var mW, mH : Integer;
      Rgn: HRGN;
      Blend : TBLENDFUNCTION;
begin
  mW := W div 2;
  mH := H div 2;
  Rgn := CreateRoundRectRgn(mW - X, mH - Y, mW + X, mH + Y,8* X div 5, 8 * Y div 5);
  ZeroMemory(@Blend, SizeOf(Blend));
  with Display.Canvas do Try
      SelectClipRgn(Handle, Rgn);
      Blend.SourceConstantAlpha := MulDiv255(Progress) ;
      AlphaBlend(Handle, 0, 0, w,h, Image.Canvas.Handle, 0, 0,w,h,  Blend);
      BitBlt(Handle, 0, 0, mW-x, mH-y, Image.Canvas.Handle, 0, 0, SRCCOPY);
      SelectClipRgn(Handle, 0);
  finally DeleteObject(Rgn); end;
end;

// Cadre reveal out from centre with Fade
procedure Effect178(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
  var Rgn: HRGN;
      Blend : TBLENDFUNCTION;
begin
  Rgn := CreateRectRgn((W - X) div 2, (H - Y) div 2, (W + X) div 2, (H + Y) div 2);
  ZeroMemory(@Blend, SizeOf(Blend));
  with Display.Canvas do Try
      SelectClipRgn(Handle, Rgn);
      Blend.SourceConstantAlpha := MulDiv255(Progress) ;
      AlphaBlend(Handle, 0, 0, w,h, Image.Canvas.Handle, 0, 0,w,h,  Blend);
      BitBlt(Handle, 0, 0, (W-x) div 2, (H-y) div 2, Image.Canvas.Handle, 0, 0, SRCCOPY);
      SelectClipRgn(Handle, 0);
  finally DeleteObject(Rgn); end;
end;

// Reveal out from middle v with Fade
procedure Effect179(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var mWX: Integer;
    Rgn: HRGN;
    Blend : TBLENDFUNCTION;
begin
  mWX := (W - X) div 2;
  Rgn := CreateRectRgn(mWX, 0, (W + X) div 2, H);
  ZeroMemory(@Blend, SizeOf(Blend));
  with Display.Canvas do Try
      SelectClipRgn(Handle, Rgn);
      Blend.SourceConstantAlpha := MulDiv255(Progress) ;
      AlphaBlend(Handle, 0, 0, w,h, Image.Canvas.Handle, 0, 0,w,h,  Blend);
      BitBlt(Handle, 0, 0, mwX, H, Image.Canvas.Handle, 0, 0, SRCCOPY);
      SelectClipRgn(Handle, 0);
  finally DeleteObject(Rgn); end;
end;

// Fade Tangentiel
procedure Effect180(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var
  dstPixel, srcPixel: PRGBQuad;
  Weight, I : Integer;
begin
  srcPixel := Image.ScanLine[h - 1];
  dstPixel := Display.ScanLine[h - 1];
  Weight := round(hfmaxi * ( 1 + tan(-pi/4 + progress/maxi*pi/2)));
  for I := (W * H) - 1 downto 0 do begin
    with dstPixel^ do begin
      Inc(rgbRed, (Weight * (srcPixel^.rgbRed - rgbRed)) shr 11);
      Inc(rgbGreen, (Weight * (srcPixel^.rgbGreen - rgbGreen)) shr 11);
      Inc(rgbBlue, (Weight * (srcPixel^.rgbBlue - rgbBlue)) shr 11);
    end;
    Inc(srcPixel);
    Inc(dstPixel);
  end;
end;

// Fade saccade
procedure Effect181(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var
  dstPixel, srcPixel: PRGBQuad;
  I, posit, ampli : Integer;
begin
  srcPixel := Image.ScanLine[H - 1];
  dstPixel := Display.ScanLine[H - 1];
  posit := progress;
  if progress < hfmaxi
     then ampli := progress div 3
     else ampli := (maxi - progress) div 3;
  if (posit mod 3 = 0) then begin
     posit := progress + random(ampli) * (2*(posit mod 2) -1); end;
  for I := (W * H) - 1 downto 0 do begin
    with dstPixel^ do begin
      Inc(rgbRed, (posit * (srcPixel^.rgbRed - rgbRed)) shr 11);
      Inc(rgbGreen, (posit * (srcPixel^.rgbGreen - rgbGreen)) shr 11);
      Inc(rgbBlue, (posit * (srcPixel^.rgbBlue - rgbBlue)) shr 11);
    end;
    Inc(srcPixel);
    Inc(dstPixel);
  end;
end;

// Reveal from top with Fade
procedure Effect182(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var Rgn: HRGN;
    Blend : TBLENDFUNCTION;
begin
  Rgn := CreateRectRgn(0, 0, w, y);
  ZeroMemory(@Blend, SizeOf(Blend));
  with Display.Canvas do try
      SelectClipRgn(Handle, Rgn);
      Blend.SourceConstantAlpha := MulDiv255(Progress) ;
      AlphaBlend(Handle, 0, 0, w, h, Image.Canvas.Handle, 0, 0,w,h, Blend);
      BitBlt(Handle, 0, 0, 0, -2 * H, Image.Canvas.Handle, 0, 0, SRCCOPY);
      SelectClipRgn(Handle, 0);
  finally DeleteObject(Rgn); end;
end;

// Reveal from bottom with Fade
procedure Effect183(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var dstPixel, srcPixel: PRGBQuad;
    Weight, I: Integer;
begin
  srcPixel := Image.ScanLine[H-1];
  dstPixel := Display.ScanLine[H-1];
  Weight := MulDiv256(Progress*y div H) ;
  for I := y*(w - 1) downTo 0 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;

// Reveal from right with Fade
procedure Effect184(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var Rgn: HRGN;
    Blend : TBLENDFUNCTION;
begin
  Rgn := CreateRectRgn(w-X, 0, w, H);
  ZeroMemory(@Blend, SizeOf(Blend));
  with Display.Canvas do try
      SelectClipRgn(Handle, Rgn);
      Blend.SourceConstantAlpha := MulDiv255(Progress) ;
      AlphaBlend(Handle, 0, 0, w, h, Image.Canvas.Handle, 0, 0,w,h, Blend);
      BitBlt(Handle, 0, 0, -2 * W, 0, Image.Canvas.Handle, 0, 0, SRCCOPY);
      SelectClipRgn(Handle, 0);
  finally DeleteObject(Rgn); end;
end;

@+
Eric

[Kambiz]

That is nice! After a long time, finally we will see some new transitions in PicShow.
Thank you!

[Kambiz]

I just added your effects to PicShow, but the effects hardly can be seen!
Am I doing something wrong?

[Tisseyre]

the ability to insert images in the images (within a small part) could be a solution to integrate Tpicshow interresting.
failing to know to do this using the type TEffectProc, I decided that works, but poorly designed!

Code: Select all

procedure TCustomRicShow.RedrawPicture(x,y : integer);
  var w, h : integer;
      SrcRect : Trect;
      C : TPoint; // center
begin
  w := x div 2 ;
  h := y div 2 ;
  IF Fmaxformat then C.x := Clientwidth div 2 else C.x := Display.width div 2;
  IF Fmaxformat then C.y := ClientHeight div 2 else C.y := Display.Height div 2;

  case style of
       121 : SetRect(SrcRect, C.x - w-1, C.y - H-1, C.x - 1  , C.y - 1   );  //NW
       122 : SetRect(SrcRect, C.x + 1  , C.y - H-1, C.x + w+1, C.y - 1   );  //NE
       123 : SetRect(SrcRect, C.x - W-1, C.y + 1  , C.x - 1  , C.y + h+1 );  //SW
       124 : SetRect(SrcRect, C.x + 1  , C.y + 1  , C.x + w+1, C.y + h+1 );  //SE
       125 : SetRect(SrcRect, C.x- (W div 4*3) ,C.y - (H div 4*3), C.x + (W div 4*3),C.y + (H div 4*3)); //Middle
       end;
  //OffsetRect(Srcrect,0,0);
  with oldpic do begin
       Assign(Display);
       canvas.stretchDraw(SrcRect, Picture.Graphic);
       canvas.brush.color:= clblack;
       canvas.frameRect(SrcRect);
       end;
  Picture.graphic.assign(Oldpic);
end;

To call this procedure inelegant because it changes the source, just add the following in the procedure "prepare" with :

Code: Select all

 
begin
  W := Picture.Width;
  H := Picture.Height;
  if (W > ClientWidth) or (H > ClientHeight)
  then
  Begin
     ratioX := H / W;
     ratioW := W / ClientWidth;
     ratioH := H / ClientHeight;
     if (ratioW >= ratioH) and (ratioW >=1)
        then begin W:= ClientWidth; H:= trunc(ClientWidth * ratioX) end
        else if (ratioW >= ratioH) and (ratioW < 1)
             then H:= trunc(W * ratioX)
        else if (ratioW < ratioH) and (ratioH >=1)
                then begin H:= ClientHeight; W:= trunc(ClientHeight / ratioX) end
        else if (ratioW < ratioH) and (ratioH < 1) then W:= trunc(Height / ratioX);
  end;

  if (style > StylePicshow) then begin
     [b]RedrawPicture(w,h); [/b]
     W:= Oldpic.width;
     H:= Oldpic.height;
     end;
  //...
end;


may be you have a best solution...
tank you

[Kambiz]

Sorry, but I didn't get it.

In my opinion, PicShow code is too old and needs major redesign. In other hand, I have no more interest in Delphi programming to work on it.

[Tisseyre]

But your code has two advantages: simplicity and efficiency.
Also, I continue with the idea of ​​progress with him.
You say, "You Did not get it." : (What i mean)
I Can Give you an example with this slideshow of 14 MB:
Link = http://www.edialbum.fr/domnload/Moulin.zip
(it's about tropical flowers. Executable = Moulin Tan.exe

in this slideshow, i redraw pictures and integrate images into a part of the surface of the display.
(from the image number 10 until 20)
i think it's a good idea, but the method is not optimal :
why? Because the fade is done all over the display and not only the area of the new integrated image.

Thank you very much for your work and contribution.
I hope you enjoy the slide show (nice photos reduced)

[Tisseyre]

Error / Link = http://www.edialbum.fr/download/Moulin.zip

[Kambiz]

I looked at the slideshow. Impressive work, congratulations!
If sometime I decide to update PicShow, for sure I will consider this scenario.