Lazarus

Programming => Graphics and Multimedia => Graphics => Topic started by: WimVan on January 06, 2019, 08:19:52 am

Title: [Solved] Component à la TPicShow (delphi)
Post by: WimVan on January 06, 2019, 08:19:52 am
What a difficult component to fidn for Lazarus.  On the whole internet we can only find a few references that TPicshow (last update in 2014) should be available for Lazarus.
I tried to import , convert but after some days I stop.  Too much items to be rewritten, faulting functions, procedures, properties ...
If someone knows where to find a running Tpicshow-component for Lazarus, be welcome
Meanwhile I tried to note down -how a component for a slideshow could work.
1) a TImage based component
2) the background should be an image too, with the same posibilities (stretch, autosize, ...) as the showed images.  The region that is not filled with the image should be a color we can choose.  So we have to images.  Backgroundimage and a full-component overlaying foregroundimage.
Action
1) load background and foreground.
2) fade in .  At the beginning the background can be a black, ...
3) Once faded in.  We see the foreground.
4) load foreground to background
5) close foreground so we see the background.
6) load foreground as unvisible by other words, to see it, we must fade in again ..

Needed properties above that of timage
1) time for fade in
2) eventually the time a picture is shown

procedure: copy foreground  to background when fade in is 100% and immediately make foreground unvisible fade in is now 0% so a new foreground can be laded.

Some interested of can help me ?

Thanks

SOLUTION. Take a look to all documentation available and learn your own.  If you can't, be a member of my group. To dummy...
Title: Re: Component à la TPicShow (delphi)
Post by: Handoko on January 06, 2019, 08:32:08 am
I never knew TPicshow, but maybe you will interested to try glSlideshow:
http://forum.lazarus.freepascal.org/index.php/topic,35313.msg256719.html#msg256719
Title: Re: Component à la TPicShow (delphi)
Post by: WimVan on January 06, 2019, 10:24:47 am
Thanks for the info and suggestion.
But, where can I find the latest version of your component ?
I will give it a try.  Curious to see if it does what I want.

Meanwhile I tested version 0.95
Nice example, except.
I fades in from a black background.
I prefer a Fading in, out from the previous images, so we do not have a black intermedium.  When you look to very much images, it becomes disturbing and renders headache.


Title: Re: Component à la TPicShow (delphi)
Post by: Handoko on January 06, 2019, 11:26:20 am
I prefer a Fading in, out from the previous images, so we do not have a black intermedium.  When you look to very much images, it becomes disturbing and renders headache.

I understand what you meant.

I'm not very proficient in using OpenGL. Actually, I wanted to create the transition as what you meant but I failed. So instead of direct fading, I created fade to black, white and background.

The code is open source and I know there are many OpenGL experts here. Hope they will improve the code someday.
Title: Re: Component à la TPicShow (delphi)
Post by: WimVan on January 06, 2019, 06:57:46 pm
I was thinking in this direction ....
1) transparent yes.  Does thhis mean if I have a picture to fade in  is not visible, background is not visible to, so I look just through w kind of window.
If this is the way it acts
1) a panel with a background fe black and then 2 timages with panel als parent, asigned as client .
in that case I can construct an slideshow in the way i wanted.
2) finding out how to fade in timage.
Title: Re: Component à la TPicShow (delphi)
Post by: Handoko on January 06, 2019, 07:23:09 pm
Standard visual components do not support transparency, including TPanel. It's still possible to make it support transparency but you have to write the code, and put it on the OnPaint event.

Maybe TPanel can be used but I think it is more suitable if you use TPaintBox or TOpenGLControl. I prefer TOpenGLControl because it is hardware accelerated.

I think direct fading transition isn't too hard to write. Do you need it to support other effects? Maybe zooming, moving, etc. If it's just a simple image fading program, I can write it for you. But I'm busy currently, not available to do programming until March.

You should do some research about BGRABitmap first. It supports transparency and it's relatively easy to learn:
http://wiki.freepascal.org/BGRABitmap_tutorial
Title: Re: Component à la TPicShow (delphi)
Post by: circular on January 07, 2019, 02:32:00 pm
If you're writing your fading with BGRABitmap, you could use TBGRABitmap.CrossFade function to fade between two images. Otherwise to fade one image in, you can use PutImage with a value for the opacity parameter. Note that this works on a TBGRABitmap which is not a regular Canvas. The component TBGRAVirtualScreen and TBCGraphicControl from BGRAControls package can be used for this.

TBGRAVirtualScreen and TPanel are opaque controls, they cannot have a transparent background.
TBCGraphicControl can have a transparent background.

I am wondering if it would be worth making a TBCTransparentImage control that could contain an image with transparent background and have an opacity property.
Title: Re: Component à la TPicShow (delphi)
Post by: WimVan on January 09, 2019, 08:54:35 am
@circular
Thanks for the suggestion.
I tried to install BGRABITMap and the controls but ...
When all installation is done, I can't find anywhere a component like 'BGRABitmap'

'TBGRAVirtualScreen' and 'TBCGraphicControl' are available ...

What's wrong ?
Lazarus 1.8.4
Online-installation used.

Title: Re: Component à la TPicShow (delphi)
Post by: GetMem on January 09, 2019, 09:07:38 am
@WimVan
Quote
When all installation is done, I can't find anywhere a component like 'BGRABitmap
You can find it on the component palette. It can be tedious though if you have a lots of components installed. As an alternative solution just press(Ctrl + Alt +P) or go to menu-->view-->components. After the components window appears go to the pallette tab and type bgra.
Title: Re: Component à la TPicShow (delphi)
Post by: WimVan on January 09, 2019, 09:26:37 am
As I marked, these I have.  The only which I'l looking for is  BGRABitmap.
Title: Re: Component à la TPicShow (delphi)
Post by: Handoko on January 09, 2019, 09:32:04 am
Lazarus main menu > View > Components > type: bgra
Title: Re: Component à la TPicShow (delphi)
Post by: GetMem on January 09, 2019, 09:56:15 am
@WimVan
Quote
As I marked, these I have.  The only which I'l looking for is  BGRABitmap.
OK. Maybe it's just me, but your message was a little bit confusing. Anyways BGRABitmap it's not a visual component, you cannot find it in the component pallette, just add BGRABitmap to the uses clauses, then similarly to a TBitmap declare it like this:
Code: Pascal  [Select][+][-]
  1. var
  2.   BGRABitmap: TBGRABitmap;
  3.  
Please note that BGRABitmapPack must be in the required packages(see project inspector). If not you should add it first.
Title: Re: Component à la TPicShow (delphi)
Post by: WimVan on January 09, 2019, 12:40:28 pm
Ok, now I follow ... 
I thought it was a visual component ...
Thanks
Title: Re: Component à la TPicShow (delphi)
Post by: WimVan on January 12, 2019, 09:11:06 am
A small question.  When I have created 2 image using bgradbitmap ... how now usig crossfade so I see the fadeing on the screen.

I put it here in a button-click-event that calls a form refresh.  bgradbitmap .... seems very very powerful and it is, but the learning-curve is huge. And I find no all needed info to try it on my own.  There is a huge amount of doc too, which helps me, but I find no clear example.
I understand I have to create a new image with the crossfade-function, but how show this action onto the screen ?
Here my ugly code.
Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  9.   BGRABitmap, BGRABitmapTypes;
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Button1: TButton;
  16.     procedure Button1Click(Sender: TObject);
  17.     procedure FormCreate(Sender: TObject);
  18.     procedure FormPaint(Sender: TObject);
  19.   private
  20.     image: TBGRABitmap;
  21.     image_1: TBGRABitmap;
  22.     image_2: TBGRABitmap;
  23.   public
  24.  
  25.   end;
  26.  
  27. var
  28.   Form1: TForm1;
  29.  
  30. implementation
  31.  
  32. {$R *.lfm}
  33.  
  34. { TForm1 }
  35.  
  36. procedure TForm1.Button1Click(Sender: TObject);
  37. begin
  38.   image := TBGRABitmap.Create(image_1.Width,image_2.Height); //note that size may be different between bmp1 and bmp2
  39.   form1.Tag := 1;
  40.   form1.Repaint;
  41. end;
  42.  
  43. procedure TForm1.FormCreate(Sender: TObject);
  44. begin
  45.   image_1 := TBGRABitmap.Create('F:\pict_test\img_044016d.jpg');
  46.   image_2 := TBGRABitmap.Create('F:\pict_test\img_044216d.jpg');
  47. end;
  48.  
  49. procedure TForm1.FormPaint(Sender: TObject);
  50. begin
  51.   if form1.Tag = 1 then
  52.   begin
  53.     image.CrossFade(Rect(0,0,image.Width,image.Height), image, image, round(0.3*255), dmSet);
  54.     Form1.Tag := 2; // ready to next
  55.   end;
  56. end;
  57.  
  58. end.
  59.  
Title: Re: Component à la TPicShow (delphi)
Post by: circular on January 12, 2019, 04:28:41 pm
Hi Wim,

First, try to display an image that is stretched how you want. You need to determine the ratio with something like that:
Code: Delphi  [Select][+][-]
  1. uses math, Types;
  2.  
  3. procedure TForm1.FormPaint(Sender: TObject);
  4. var ratio: single;
  5.   destRect: TRect;
  6. begin
  7.   image.SetSize(ClientWidth,ClientHeight);
  8.   image.Fill(BGRABlack);
  9.  
  10.   ratio := min(image.width/image_1.width, image.height/image_1.height);
  11.   //determine destination size
  12.   destRect := rect(0,0, round(image_1.width*ratio), round(image_1.width*ratio));
  13.   //center rectangle
  14.   OffsetRect(destRect, (image.width - destRect.width) div 2, (image.height - destRect.height) div 2);
  15.  
  16.   image.StretchPutImage(destRect, image_1, dmDrawWithTransparency, round(0.3*255) );
  17.  
  18.   image.Draw(Canvas, 0,0);
  19. end;
Title: Re: Component à la TPicShow (delphi)
Post by: Thaddy on January 12, 2019, 05:08:15 pm
<Ignore this>
Sounds like the rather common case of  "TComponentThatWritesMyActualProgramWithoutEffortByMe"
<don't totally ignore it>

Programs are the result of some actual intellectual input. Even generated programs rely on that.
Title: Re: Component à la TPicShow (delphi)
Post by: Handoko on January 12, 2019, 06:14:28 pm
bgradbitmap .... seems very very powerful and it is, but the learning-curve is huge. And I find no all needed info to try it on my own.

I think differently. Although, I haven't really use BGRABitmap but I can sure to tell you compare to other graphics libraries BGRABitmap is really easy to learn, the tutorials are very good.

If the learning curve is huge for you, I'm sorry but lets face the truth. Graphics programming is not for you. Graphics programming is not simply calling a function and it works for you. You have to understand the logic behind it, you have to have the basic mathematics skills preferably advanced skill level. Again, sorry of being harsh. But it is actually good for you. Maybe it can motivates you or maybe makes you realize and give up for better.
Title: Re: Component à la TPicShow (delphi)
Post by: WimVan on January 12, 2019, 06:44:21 pm
Handoko,

You are right. Graphic programming is not my real interest.  I'm a photographer and I'm busy with taking picture ...

Meanwhile, I once wrote a program to repair faulting jpeg's ... and still it does.  And, it was written in pure C without a graphical available gui.
I wrote this all in php for the web.  Here you can see what I mean: https://www.fotospotter.be where I wrote any thing myself ...  And the program admids more than what is visible for a guest, a photo-interested person...
I rewrote anything till now and all is working except, I would like to have fade in fade out so a slideshow is nicer.  No more no less.  SO can someone insult me of not being a real graphical programmer ?  I never pretended this and I will never pretend.
I thought that this site was to help persons... even dummies in certain cases ...

But if this a problem, forget all my requests, .... I'll stop rendering my little app more pleaseable ...
By the way, I once started at DOS 2.0  without a windows-interface, programmed on a COmmodore 24, 64 128, Amiga where I then, did graphical things.
DOS 3 had his entry with Pascal ...
Once I programmed in basic without the existence of linenumbers, ...  SO, I'm not a young person ...

Any way, thanks to every body trying to help others.

Sees

PS. Here you can find what I wrote above

https://groups.google.com/forum/#!topic/alt.comp.freeware/XfnR7aZnzak

 
Title: Re: Component à la TPicShow (delphi)
Post by: Handoko on January 12, 2019, 06:51:21 pm
I never meant to insult you. I wanted to motivate you. But if you think differently, I'm sorry.
Title: Re: Component à la TPicShow (delphi)
Post by: WimVan on January 12, 2019, 07:59:33 pm
you do not mean it, but you wrote it anyway.
That's why I was looking for PicShow.  I used it in the years 2004 and it did it just what I try.  But, no development requiered, It was a component.
@Thaddy, Thanks for the title and the message.
I feel lucky.  Apart the fact that there is all needed info, doc and all is clear, there are still so much people with questions and problems with it.
Sorry, yes this sounds negative.
Case closed.
Title: Re: [Solved] Component à la TPicShow (delphi)
Post by: Handoko on January 12, 2019, 10:39:33 pm
The misunderstanding happened because I forgot about your first post that you're looking for a ready to use slideshow component (TPictShow). I saw your later post that you're trying to do fading using BGRABitmap but you said the learning curve is huge.

No, there is no free slideshow component available for Lazarus. You have to build the slideshow manually using one of the available graphics or game libraries. And BGRABitmap is relatively easy among them:
http://wiki.freepascal.org/Graphics_libraries
http://wiki.freepascal.org/Game_framework

Maybe you don't want it anymore. But hope someone will find it useful:

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  9.   ExtDlgs, ExtCtrls, BGRABitmap, BGRABitmapTypes;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     btnImage2: TButton;
  17.     btnImage1: TButton;
  18.     OpenPictureDialog1: TOpenPictureDialog;
  19.     Timer1: TTimer;
  20.     procedure btnImage1Click(Sender: TObject);
  21.     procedure btnImage2Click(Sender: TObject);
  22.     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
  23.     procedure FormCreate(Sender: TObject);
  24.     procedure FormPaint(Sender: TObject);
  25.     procedure FormResize(Sender: TObject);
  26.     procedure Timer1Timer(Sender: TObject);
  27.   private
  28.     Image1: TBGRABitmap;
  29.     Image2: TBGRABitmap;
  30.     Combined: TBGRABitmap;
  31.     ImageLoaded: Boolean;
  32.   end;
  33.  
  34. const
  35.   TransitionDelayTime = 100;  // should be 5 .. 500
  36.   StillDelayTime      = 200;  // should be 0 .. 1000
  37.  
  38. var
  39.   Form1: TForm1;
  40.  
  41. implementation
  42.  
  43. {$R *.lfm}
  44.  
  45. { TForm1 }
  46.  
  47. procedure TForm1.btnImage1Click(Sender: TObject);
  48. begin
  49.   if not(OpenPictureDialog1.Execute) then Exit;
  50.   Image1            := TBGRABitmap.Create(OpenPictureDialog1.FileName);
  51.   btnImage1.Enabled := False;
  52.   btnImage2.Enabled := True;
  53. end;
  54.  
  55. procedure TForm1.btnImage2Click(Sender: TObject);
  56. begin
  57.   if not(OpenPictureDialog1.Execute) then Exit;
  58.   Image2            := TBGRABitmap.Create(OpenPictureDialog1.FileName);
  59.   Combined          := TBGRABitmap.Create(Width, Height);
  60.   ImageLoaded       := True;
  61.   Timer1.Enabled    := True;
  62.   btnImage1.Visible := False;
  63.   btnImage2.Visible := False;
  64. end;
  65.  
  66. procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
  67. begin
  68.   Timer1.Enabled := False;
  69.   Image1.Free;
  70.   Image2.Free;
  71.   Combined.Free;
  72. end;
  73.  
  74. procedure TForm1.FormCreate(Sender: TObject);
  75. begin
  76.   btnImage2.Enabled := False;
  77.   ImageLoaded       := False;
  78.   Timer1.Enabled    := False;
  79.   Timer1.Interval   := 20;
  80. end;
  81.  
  82. procedure TForm1.FormPaint(Sender: TObject);
  83. const
  84.   Transparency : Integer = 0;
  85.   StillDelay   : Integer = 0;
  86.   Transition   : Integer = 0;
  87.   Direction    : (From1To2, From2To1) = From1To2;
  88. var
  89.   ARect: TRect;
  90. begin
  91.  
  92.   // Don't start before all image are loaded
  93.   if not(ImageLoaded) then Exit;
  94.  
  95.   // Process direction changing
  96.   if Transition >= TransitionDelayTime then
  97.     if StillDelay <= 0 then
  98.     begin
  99.       StillDelay := StillDelayTime;
  100.       Transition := 0;
  101.       Inc(Direction);
  102.       if Direction > High(Direction) then
  103.         Direction := Low(Direction);
  104.     end;
  105.  
  106.   // Process fading and show the result
  107.   ARect        := Rect(0, 0, Width, Height);
  108.   Transparency := Round(Transition / TransitionDelayTime * 255);
  109.   case Direction of
  110.     From1To2:
  111.       begin
  112.         Combined.StretchPutImage(ARect, Image1, dmDrawWithTransparency, 255);
  113.         Combined.StretchPutImage(ARect, Image2, dmDrawWithTransparency, Transparency);
  114.       end;
  115.     From2To1:
  116.       begin
  117.         Combined.StretchPutImage(ARect, Image2, dmDrawWithTransparency, 255);
  118.         Combined.StretchPutImage(ARect, Image1, dmDrawWithTransparency, Transparency);
  119.       end;
  120.   end;
  121.   Combined.Draw(Canvas, 0,0);
  122.  
  123.   // Process delays
  124.   if StillDelay <= 0 then
  125.     Inc(Transition)
  126.   else
  127.     Dec(StillDelay);
  128.  
  129. end;
  130.  
  131. procedure TForm1.FormResize(Sender: TObject);
  132. begin
  133.   if not(ImageLoaded) then Exit;
  134.   Combined.Free;
  135.   Combined := TBGRABitmap.Create(Width, Height);
  136. end;
  137.  
  138. procedure TForm1.Timer1Timer(Sender: TObject);
  139. begin
  140.   FormPaint(Self);
  141. end;
  142.  
  143. end.


edit:
The declaration of the constant "Transparency" on line 84 should be put on the line 89 as a variable.
Title: Re: [Solved] Component à la TPicShow (delphi)
Post by: circular on January 13, 2019, 03:05:38 am
In fact there is a slideshow under development
https://gilles-vasseur.developpez.com/tutoriels/transitions/bgra1/
though I think there is no download link

I don’t believe it helps to be harsh with people. If we don’t want to spend time on it we can simply say it. If we force ourselves to help it is bad for us and the other person. And we end up being passive aggressive or judgemental.

It is sometimes difficult to ask for help because we show our vulnerability. So I would enjoy it to be a safe space here.
Title: Re: [Solved] Component à la TPicShow (delphi)
Post by: WimVan on January 13, 2019, 10:09:46 am
It is sometimes difficult to ask for help because we show our vulnerability. So I would enjoy it to be a safe space here.
I mis a thumb-up-icon ....
Title: Re: [Solved] Component à la TPicShow (delphi)
Post by: Bart on January 13, 2019, 10:59:32 am
It is sometimes difficult to ask for help because we show our vulnerability. So I would enjoy it to be a safe space here.

Yes, a safe place this shall remain.

Not asking for help is obviously worse.
We try to help as good as we can.
For me, this assumes that whoever asks for help also must put in the effort (note: this is not a reflection upon TS).
You might however be subjected to various degrees of humor  (especially when askig for help with homework assignments) O:-)

Bart
Title: Re: [Solved] Component à la TPicShow (delphi)
Post by: Handoko on January 13, 2019, 05:31:51 pm
How To Do Proportional Scaling

Now I improved the source code to do proportional scaling. Doing proportional scaling is not hard but it is very difficult to explain it, especially with my limitation of English.

First, look the code below. There are many optimizations can be done (for better performance), but I tried to wrote it in the more readable way:

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  9.   ExtDlgs, ExtCtrls, BGRABitmap, BGRABitmapTypes;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     btnImage2: TButton;
  17.     btnImage1: TButton;
  18.     OpenPictureDialog1: TOpenPictureDialog;
  19.     Timer1: TTimer;
  20.     procedure btnImage1Click(Sender: TObject);
  21.     procedure btnImage2Click(Sender: TObject);
  22.     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
  23.     procedure FormCreate(Sender: TObject);
  24.     procedure FormPaint(Sender: TObject);
  25.     procedure FormResize(Sender: TObject);
  26.     procedure Timer1Timer(Sender: TObject);
  27.   private
  28.     Image1: TBGRABitmap;
  29.     Image2: TBGRABitmap;
  30.     Combined: TBGRABitmap;
  31.     ImageLoaded: Boolean;
  32.   end;
  33.  
  34. const
  35.   TransitionDelayTime = 100;  // should be 5 .. 500
  36.   StillDelayTime      = 200;  // should be 0 .. 1000
  37.  
  38. var
  39.   Form1: TForm1;
  40.  
  41. implementation
  42.  
  43. {$R *.lfm}
  44.  
  45. { TForm1 }
  46.  
  47. procedure TForm1.btnImage1Click(Sender: TObject);
  48. begin
  49.   if not(OpenPictureDialog1.Execute) then Exit;
  50.   Image1            := TBGRABitmap.Create(OpenPictureDialog1.FileName);
  51.   btnImage1.Enabled := False;
  52.   btnImage2.Enabled := True;
  53. end;
  54.  
  55. procedure TForm1.btnImage2Click(Sender: TObject);
  56. begin
  57.   if not(OpenPictureDialog1.Execute) then Exit;
  58.   Image2            := TBGRABitmap.Create(OpenPictureDialog1.FileName);
  59.   Combined          := TBGRABitmap.Create(Width, Height);
  60.   ImageLoaded       := True;
  61.   Timer1.Enabled    := True;
  62.   btnImage1.Visible := False;
  63.   btnImage2.Visible := False;
  64. end;
  65.  
  66. procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
  67. begin
  68.   Timer1.Enabled := False;
  69.   Image1.Free;
  70.   Image2.Free;
  71.   Combined.Free;
  72. end;
  73.  
  74. procedure TForm1.FormCreate(Sender: TObject);
  75. begin
  76.   btnImage2.Enabled := False;
  77.   ImageLoaded       := False;
  78.   Timer1.Enabled    := False;
  79.   Timer1.Interval   := 20;
  80. end;
  81.  
  82. procedure TForm1.FormPaint(Sender: TObject);
  83. const
  84.   StillDelay   : Integer = 0;
  85.   Transition   : Integer = 0;
  86.   Direction    : (From1To2, From2To1) = From1To2;
  87. var
  88.   Transparency    : Integer;
  89.   AspectForm      : Single;
  90.   AspectImage1    : Single;
  91.   AspectImage2    : Single;
  92.   Image1NewWidth  : Integer;
  93.   Image1NewHeight : Integer;
  94.   Image2NewWidth  : Integer;
  95.   Image2NewHeight : Integer;
  96.   RectImage1      : TRect;
  97.   RectImage2      : TRect;
  98. begin
  99.  
  100.   // Don't start before all image are loaded
  101.   if not(ImageLoaded) then Exit;
  102.  
  103.   // Process direction changing
  104.   if Transition >= TransitionDelayTime then
  105.     if StillDelay <= 0 then
  106.     begin
  107.       StillDelay := StillDelayTime;
  108.       Transition := 0;
  109.       Inc(Direction);
  110.       if Direction > High(Direction) then
  111.         Direction := Low(Direction);
  112.     end;
  113.  
  114.   // Calculations for proportional scaling
  115.   AspectForm   := Width / Height;
  116.   AspectImage1 := Image1.Width / Image1.Height;
  117.   AspectImage2 := Image2.Width / Image2.Height;
  118.   if AspectForm > AspectImage1 then // use same height
  119.   begin
  120.     Image1NewHeight := Height;
  121.     Image1NewWidth  := Round(Image1NewHeight * AspectImage1);
  122.   end
  123.   else begin                        // use same width
  124.     Image1NewWidth  := Width;
  125.     Image1NewHeight := Round(Image1NewWidth / AspectImage1);
  126.   end;
  127.   if AspectForm > AspectImage2 then // use same height
  128.   begin
  129.     Image2NewHeight := Height;
  130.     Image2NewWidth  := Round(Image2NewHeight * AspectImage2);
  131.   end
  132.   else begin                        // use same width
  133.     Image2NewWidth  := Width;
  134.     Image2NewHeight := Round(Image2NewWidth / AspectImage2);
  135.   end;
  136.   RectImage1.Left   := (Width-Image1NewWidth) div 2;   // Make the image center
  137.   RectImage1.Top    := (Height-Image1NewHeight) div 2; // Make the image center
  138.   RectImage1.Width  := Image1NewWidth;
  139.   RectImage1.Height := Image1NewHeight;
  140.   RectImage2.Left   := (Width-Image2NewWidth) div 2;   // Make the image center
  141.   RectImage2.Top    := (Height-Image2NewHeight) div 2; // Make the image center
  142.   RectImage2.Width  := Image2NewWidth;
  143.   RectImage2.Height := Image2NewHeight;
  144.  
  145.   // Process fading and show the result
  146.   Transparency := Round(Transition / TransitionDelayTime * 255);
  147.   case Direction of
  148.     From1To2:
  149.       begin
  150.         Combined.StretchPutImage(RectImage1, Image1, dmDrawWithTransparency, 255);
  151.         Combined.StretchPutImage(RectImage2, Image2, dmDrawWithTransparency, Transparency);
  152.       end;
  153.     From2To1:
  154.       begin
  155.         Combined.StretchPutImage(RectImage2, Image2, dmDrawWithTransparency, 255);
  156.         Combined.StretchPutImage(RectImage1, Image1, dmDrawWithTransparency, Transparency);
  157.       end;
  158.   end;
  159.   Combined.Draw(Canvas, 0,0);
  160.  
  161.   // Process delays
  162.   if StillDelay <= 0 then
  163.     Inc(Transition)
  164.   else
  165.     Dec(StillDelay);
  166.  
  167. end;
  168.  
  169. procedure TForm1.FormResize(Sender: TObject);
  170. begin
  171.   if not(ImageLoaded) then Exit;
  172.   Combined.Free;
  173.   Combined := TBGRABitmap.Create(Width, Height);
  174. end;
  175.  
  176. procedure TForm1.Timer1Timer(Sender: TObject);
  177. begin
  178.   FormPaint(Self);
  179. end;
  180.  
  181. end.

The code for doing proportional scaling starts from line #114 .. # 143.

You need to supply the image's x, y, w, h when showing it. That's why I added RectImage1 and RectImage2. See the example on line #150 and #151.

The x and y values of RectImages are not (0, 0). Because (0, 0) mean top left corner. So we have to calculate the center position. The calculation are performed on the line #136, #137, #140, #141.

To be able to calculate the center position, we have to calculate the image's width and height first. And this is the most tricky part. This is the pseudo code:

  if AspectOfContainer > AspectOfObject then
  begin
      // object use the height of container
      ObjectNewHeight := container's Height;
      // and we calculate the object's width
      ObjectNewWidth  := Round(ObjectNewHeight * AspectOfObject);
  end
  else begin                        
      // object use the width of container
      ObjectNewWidth  := container's Width;
      // and we calculate the object's height
      ObjectNewHeight := Round(ObjectNewWidth / AspectOfObject);
  end;

Note:
The code for calculating object's new width and new height is on the line #118 .. #135.
To be able to calculate the object's new width or height we need the Aspect value of the object.

You can use wikipedia to learn more about aspect.

In graphics programming you can use aspect to calculate the new size of object by using these formulas:

Object_New_Width = Object_New_Height x Aspect_Of_The_Object
and
Object_New_Height = Object_New_Width / Aspect_Of_The_Object

See the pseudocode to learn how to use these formulas.
We have to add Round function because BGRABitmap needs integer values for those inputs.

And the last thing is the how to calculate the aspects. In our case we need 3 aspects:
- Aspect of the container -> the form itself
- Aspect of the object1 -> Image1
- Aspect of the object2 -> Image2
See line #115 .. #117.

The explanation above is in a reverse-way. In short, this is how you do proportional scaling (in the 'correct' non reverse-way):

Graphics programming is fun ... as long as you have the passion to do it.
Have fun!
Title: Re: [Solved] Component à la TPicShow (delphi)
Post by: circular on January 13, 2019, 06:39:21 pm
Looks great Handoko.

Some remarks:
- the size of the drawable part is ClientWidth x ClientHeight, not Width x Height (you can also read the value of Combined.Width and Combined.Height so that the drawing is consistent with the virtual screen size)
- calling FromPaint directly works on Windows and Linux but not on MacOS. Instead you can call Invalidate. This may cause some blinking depending on the system, so you need to prevent the erase background event or set the DoubleBuffered property to True.
Title: Re: [Solved] Component à la TPicShow (delphi)
Post by: Handoko on January 13, 2019, 06:47:39 pm
In the source code I provided above, because the container is the form itself so the client width and client height is the form's width and height. It can be simplified by using width and height only, because the Self is the form. But I agree if someone copy/pasted the code, without the 'client' it has higher chances of failure.

I don't have a Mac. :-[
But, I will remember to use Invalidate (instead of Form's Paint) and use Double Buffer.

Thank you for the suggestions.

edit:
Suggestion for BGRABitmap, please consider to add proportional scaling feature.
Title: Re: [Solved] Component à la TPicShow (delphi)
Post by: WimVan on January 13, 2019, 09:44:14 pm
Handoko,
Runs well, except, if you have a a landscaped image and a portrait-image,  when the fade in image is the portrait, you still see parts of the first image ...
I too tried something.  I used bgrabitmap and crossfade;  It runs well, except, I have no proportial scaling.
For crossfade you need two images with the same width, height.  Portrait and landscape isn't
So I was thinking to create an image (runtime) which covers the whole canvas-area after I draw an image on it respecting proportial scaling and centering it.  Of course, this may not been seen while showing the slideshow.  It should have been done in memory.  If I find this out, I'll can finalise my version.
Still interested if you can fade in the new image while fade out the second one.  This is what crossfade does.

Code: Pascal  [Select][+][-]
  1. unit slide_1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  9.   ExtCtrls, math, types, BGRABitmap, BGRABitmapTypes;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     knop: TButton;
  17.     procedure FormWindowStateChange(Sender: TObject);
  18.     procedure knopClick(Sender: TObject);
  19.     procedure FormCreate(Sender: TObject);
  20.     procedure FormPaint(Sender: TObject);
  21.   private
  22.     image: TBGRABitmap;
  23.     image_from : TBGRABitmap;
  24.     image_to   : TBGRABitmap;
  25.  
  26.   public
  27.  
  28.   end;
  29.  
  30. var
  31.   Form1: TForm1;
  32.   nfoto : integer;
  33.  
  34. implementation
  35.  
  36. {$R *.lfm}
  37.  
  38. { TForm1 }
  39.  
  40. procedure TForm1.knopClick(Sender: TObject);
  41. var
  42.   nknop : integer;
  43.   str_foto_from, str_foto_to : string;
  44. begin
  45.   if nfoto = 0 then
  46.   begin
  47.     str_foto_from := 'img_044000d.jpg';
  48.     str_foto_to   := 'img_045014d.jpg';
  49.   end;
  50.   if nfoto = 1 then
  51.   begin
  52.     str_foto_from := 'img_045014d.jpg';
  53.     str_foto_to   := 'img_044333d.jpg';
  54.   end;
  55.   if nfoto = 2 then
  56.   begin
  57.     str_foto_from := 'img_044333d.jpg';
  58.     str_foto_to   := 'img_042000d.jpg';
  59.   end;
  60.   image_from.LoadFromFile( str_foto_from);
  61. // change image-size to a fullsized form
  62.   BGRAReplace(image_from, image_from.Resample(Form1.Width, Form1.Height, rmSimpleStretch));
  63.  
  64.   image_to.LoadFromFile( str_foto_to );
  65.   // change image-size to a fullsized form
  66.   BGRAReplace(image_to, image_to.Resample(Form1.Width, Form1.Height, rmSimpleStretch));
  67.  
  68.   nfoto := nfoto + 1;
  69.   if nfoto = 3 then nfoto := 0;
  70.  
  71. // fading using crossqfade by incresing transparency-value (from 1 to 255 by step of 5
  72.   for nknop := 1 to 51 do
  73.   begin
  74.     knop.Tag := nknop;
  75.     form1.Tag := 1;
  76. // call form-paint-event
  77.     form1.Repaint;
  78.   end;
  79. end;
  80.  
  81. procedure TForm1.FormWindowStateChange(Sender: TObject);
  82. begin
  83.   image.SetSize(ClientWidth,ClientHeight);
  84.   image.Fill(BGRABlack);
  85. end;
  86.  
  87.  
  88. procedure TForm1.FormCreate(Sender: TObject);
  89. begin
  90.   image_from := TBGRABitmap.Create;
  91.   image_to   := TBGRABitmap.Create;
  92.   image      := TBGRABitmap.Create;
  93.   image.SetSize(ClientWidth,ClientHeight);
  94.   image.Fill(BGRABlack);
  95.   nfoto := 0;
  96. end;
  97.  
  98. procedure TForm1.FormPaint(Sender: TObject);
  99. var r
  100.   destRect: TRect;
  101. begin
  102.   if form1.Tag = 1 then
  103.   begin
  104. // create an image from two images with transparency  FormPaint is put in a loop while increasing the transparancy of image 2(image_to), decreasing image 1 (image_from)
  105.     image.CrossFade(Rect(0,0,image.Width, image.Height), image_from, image_to, round(knop.tag * 5), dmSet);
  106.       sleep( 20 );
  107.       image.   Draw(Canvas, 0,0);
  108.     Form1.Tag := 2; // ready to next
  109.   end;
  110. end;
  111.  
  112. end.
  113.  

used images are added.  Image img_044333d.jpg is portrait and as I told, proportial scaling is still not set
Due to limitation of attachments-size I added bad looking images (size 200 pixel-150 pixel)

Title: Re: [Solved] Component à la TPicShow (delphi)
Post by: gillou58 on January 14, 2019, 09:28:25 am
Hi,
As circular suggested, perhaps you will be interested in a component I wrote a few months ago for teaching purpose. For the moment explanations are only in French. I will try to work on it ASAP if someone is interested in this kind of work.

You have to install the excellent BRABitmap library first.

The TGVTransition Component is in the gvsoft package. You have to install it too.
There is a demo in the sample directory. If you can't read French, compile this program just click on the Test button and try to change the options values.

There are https://www.developpez.net/forums/d1869926/autres-langages/pascal/lazarus/creer-transitions-d-image-image-lazarus-bgrabitmap-7-composant-complet/ (https://www.developpez.net/forums/d1869926/autres-langages/pascal/lazarus/creer-transitions-d-image-image-lazarus-bgrabitmap-7-composant-complet/)seven tutorials (all in French :( ) to explain how I wrote this component.

[EDIT] Demo is here : https://www.dropbox.com/s/jpmsd5gpt4rwzhy/demo.7z?dl=0 (https://www.dropbox.com/s/jpmsd5gpt4rwzhy/demo.7z?dl=0)

Gilles
Title: Re: [Solved] Component à la TPicShow (delphi)
Post by: circular on January 14, 2019, 12:59:30 pm
In the source code I provided above, because the container is the form itself so the client width and client height is the form's width and height. It can be simplified by using width and height only, because the Self is the form. But I agree if someone copy/pasted the code, without the 'client' it has higher chances of failure.
Nope, the Form Width is a few pixels bigger than the Form ClientWidth as it contains the form border.

Quote
Suggestion for BGRABitmap, please consider to add proportional scaling feature.
Sure. I've added StretchPutImageProportionally on dev branch.  :)
Hence the code becomes:
Code: Delphi  [Select][+][-]
  1. procedure TForm1.FormPaint(Sender: TObject);
  2. const
  3.   StillDelay   : Integer = 0;
  4.   Transition   : Integer = 0;
  5.   Direction    : (From1To2, From2To1) = From1To2;
  6. var
  7.   Transparency    : Integer;
  8.   r: TRect;
  9. begin
  10.  
  11.   // Don't start before all image are loaded
  12.   if not(ImageLoaded) then Exit;
  13.  
  14.   // Process direction changing
  15.   if Transition >= TransitionDelayTime then
  16.     if StillDelay <= 0 then
  17.     begin
  18.       StillDelay := StillDelayTime;
  19.       Transition := 0;
  20.       Inc(Direction);
  21.       if Direction > High(Direction) then
  22.         Direction := Low(Direction);
  23.     end;
  24.  
  25.   // Process fading and show the result
  26.   Transparency := Round(Transition / TransitionDelayTime * 255);
  27.   Combined.Fill(BGRABlack);
  28.   r := Rect(0,0,Combined.Width,Combined.Height);
  29.   case Direction of
  30.     From1To2:
  31.       begin
  32.         Combined.StretchPutImageProportionally(r, taCenter,tlCenter, Image1, dmDrawWithTransparency, 255);
  33.         Combined.StretchPutImageProportionally(r, taCenter,tlCenter, Image2, dmDrawWithTransparency, Transparency);
  34.       end;
  35.     From2To1:
  36.       begin
  37.         Combined.StretchPutImageProportionally(r, taCenter,tlCenter, Image2, dmDrawWithTransparency, 255);
  38.         Combined.StretchPutImageProportionally(r, taCenter,tlCenter, Image1, dmDrawWithTransparency, Transparency);
  39.       end;
  40.   end;
  41.   Combined.Draw(Canvas, 0,0);
  42.  
  43.   // Process delays
  44.   if StillDelay <= 0 then
  45.     Inc(Transition)
  46.   else
  47.     Dec(StillDelay);
  48.  
  49. end;

@gillou58:
Thanks for the link. My mistake there was a download link:
https://pascal.developpez.com/telecharger/detail/id/6236/TGVTransition-composant-visuel-pour-l-affichage-de-transitions-d-image-a-image

@WimVan:
I see your point. Indeed when images do not have the same aspect ratio, the previous image does not disappear as the fading occurs. You can generate your stretched images like that:
Code: Delphi  [Select][+][-]
  1.   function CreateStretched(AImage: TBGRABitmap): TBGRABitmap;
  2.   var
  3.     ratio: single;
  4.   begin
  5.     result := TBGRABitmap.Create(Combined.Width,Combined.Height, BGRABlack);
  6.     ratio := min(Combined.Width/AImage.Width,Combined.Height/AImage.Height);
  7.     r := rect(0,0,round(AImage.Width*ratio),round(AImage.Height*ratio));
  8.     r.Offset((Combined.Width-r.Width) div 2, (Combined.Height-r.Height) div 2);
  9.     result.StretchPutImage(r, AImage, dmDrawWithTransparency);
  10.   end;

I noticed CrossFade was slow so I just optimized it a bit on dev branch.
Title: Re: [Solved] Component à la TPicShow (delphi)
Post by: Handoko on January 14, 2019, 01:43:11 pm
@WimVan

I tested your source code. It seems you're not familiar with event-driven programming. But that's okay, it is easy and you'll like it once you understand how it works.

I rewrote your code, added some improvements. But not much, still does not support proportional scaling. Here is the source code:

Code: Pascal  [Select][+][-]
  1. unit slide_1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  9.   ExtCtrls, math, types, BGRABitmap, BGRABitmapTypes, BGRAGraphicControl;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     knop: TButton;
  17.     Timer1: TTimer;
  18.     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
  19.     procedure FormWindowStateChange(Sender: TObject);
  20.     procedure knopClick(Sender: TObject);
  21.     procedure FormCreate(Sender: TObject);
  22.     procedure Timer1Timer(Sender: TObject);
  23.   private
  24.     image: TBGRABitmap;
  25.     image_from : TBGRABitmap;
  26.     image_to   : TBGRABitmap;
  27.     nfoto      : integer;
  28.     TimerIndex : integer;
  29.     TimerStep  : integer;
  30.   end;
  31.  
  32. var
  33.   Form1: TForm1;
  34.  
  35. implementation
  36.  
  37. {$R *.lfm}
  38.  
  39. { TForm1 }
  40.  
  41. procedure TForm1.knopClick(Sender: TObject);
  42. var
  43.   nknop : integer;
  44.   str_foto_from, str_foto_to : string;
  45. begin
  46.   if nfoto = 0 then
  47.   begin
  48.     str_foto_from := 'img_044000d.jpg';
  49.     str_foto_to   := 'img_045014d.jpg';
  50.   end;
  51.   if nfoto = 1 then
  52.   begin
  53.     str_foto_from := 'img_045014d.jpg';
  54.     str_foto_to   := 'img_044333d.jpg';
  55.   end;
  56.   if nfoto = 2 then
  57.   begin
  58.     str_foto_from := 'img_044333d.jpg';
  59.     str_foto_to   := 'img_042000d.jpg';
  60.   end;
  61.   image_from.LoadFromFile( str_foto_from);
  62. // change image-size to a fullsized form
  63.   BGRAReplace(image_from, image_from.Resample(Form1.Width, Form1.Height, rmSimpleStretch));
  64.  
  65.   image_to.LoadFromFile( str_foto_to );
  66.   // change image-size to a fullsized form
  67.   BGRAReplace(image_to, image_to.Resample(Form1.Width, Form1.Height, rmSimpleStretch));
  68.  
  69.   nfoto := nfoto + 1;
  70.   if nfoto = 3 then nfoto := 0;
  71.  
  72. // fading using crossqfade by incresing transparency-value (from 1 to 255 by step of 5
  73.   TimerIndex     := 0;
  74.   TimerStep      := 5;
  75.   Timer1.Enabled := True;
  76. end;
  77.  
  78. procedure TForm1.FormWindowStateChange(Sender: TObject);
  79. begin
  80.   image.SetSize(ClientWidth,ClientHeight);
  81.   image.Fill(BGRABlack);
  82. end;
  83.  
  84. procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
  85. begin
  86.   Timer1.Enabled := False;
  87.   image_from.Free;
  88.   image_to.Free;
  89.   image.Free;
  90. end;
  91.  
  92. procedure TForm1.FormCreate(Sender: TObject);
  93. begin
  94.   image_from := TBGRABitmap.Create;
  95.   image_to   := TBGRABitmap.Create;
  96.   image      := TBGRABitmap.Create;
  97.   image.SetSize(ClientWidth,ClientHeight);
  98.   image.Fill(BGRABlack);
  99.   nfoto := 0;
  100.  
  101.   Timer1.Interval := 20;
  102.   Timer1.Enabled  := False;
  103. end;
  104.  
  105. procedure TForm1.Timer1Timer(Sender: TObject);
  106. begin
  107.   image.CrossFade(Rect(0,0,image.Width, image.Height), image_from, image_to, TimerIndex, dmSet);
  108.   image.Draw(Canvas, 0,0);
  109.   if TimerIndex  < 255-TimerStep then
  110.     TimerIndex := TimerIndex + TimerStep;
  111.   Application.ProcessMessages; // avoid to become unresponsive
  112. end;
  113.  
  114. end.

Note: if you want to compare source codes, I recommend Meld http://meldmerge.org/


1. Use a TTimer for the looping

I saw you did this:
  for nknop := 1 to 51 do
  begin
    knop.Tag := nknop;
    form1.Tag := 1;
// call form-paint-event
    form1.Repaint;
  end;

Calling Form.Repaint (refresh or invalidate) several times for doing the transition is not correct. The easiest solution for it is use a TTimer, see line #105 .. #112.

This is the documentation of TTimer:
https://lazarus-ccr.sourceforge.io/docs/lcl/extctrls/ttimer.html

On my previous codes (fade.zip and fade2.zip) I put the code for drawing in the OnPaint event and use a TTimer to 'force' the canvas the refresh by calling the OnPaint event. But this time I did it differently, to make the code more readable. I now moved all the code inside OnPaint into OnTimer, so there is nothing for OnPaint event.

2. Set the values of the TTimer

We need to provide the values for the TTimer when program starts and when user clicks the button. See line #101 .. #102 and line #73 .. #75.

3. Free the objects

We should free the objects before the program ends, see line #84 .. #90. For your information, not all components need to be freed manually because it will handled by its owner.

4. Prevent unresponsive

In GUI programming, the interface can become unresponsive if a looping runs too long. To prevent it, we use Application.ProcessMessages; see line #111. In this code, you won't notice any serious unresponsive thing to happens if you remove that line but you will experience some delay if you click the close button when the transition is running.

5. Move the global variable to form's private section

For more beautiful code, I move the variable nfoto to the form's private section. Form's private section is the good place to put variables, see line #23 .. #29.

6. Use more descriptive name

I renamed your nknop and knop.tag to something more descriptive. See line #73 .. #74.

7. Don't use component's tag

It is not a sin but it may cause the source code become harder to maintain in the future. So some programmers ... :-X including @Thaddy disagree the use of tags.

So I removed your knop.tag and form1.tag.
Title: Re: [Solved] Component à la TPicShow (delphi)
Post by: Handoko on January 14, 2019, 01:49:48 pm
In the source code I provided above, because the container is the form itself so the client width and client height is the form's width and height. It can be simplified by using width and height only, because the Self is the form. But I agree if someone copy/pasted the code, without the 'client' it has higher chances of failure.
Nope, the Form Width is a few pixels bigger than the Form ClientWidth as it contains the form border.

I never know it, I will make a test for it.

I've added StretchPutImageProportionally on dev branch.  :)

That's great!
Title: Re: [Solved] Component à la TPicShow (delphi)
Post by: WimVan on January 14, 2019, 03:12:59 pm
Thanks Handoko ...
Please note, that, when I write tests, I do it in a badly way, without cleaning, ... without capting errors, freeing objects, memory ...  Why.  It is draft and I prefer investigating trials and errors in a quick way, the cleanup, definite version comes later.
That's the way I always developed.  A prototype with garbage programming, but with a logic I want to use, see. Optimizing, cleanup ... comes later if I'm sure all is working as I like.
But, Thanks for the info.
Meanwhile I  worked again some hours (from this morning 4 o clock) on testing, reading on the internet, insulting my desktop, my bad memory ...  Finally I got all working like I whished.
Source are not optimized as you did, because I worked on the previous trial.  Tonight I'll write a proper one.  But, it is just to see if my logic was write and if it runs.
Goal: a slide-show without black moments.  Proportial ratio must be kept, eventually time of transition  must be adaptable, ...  Backgroundcolor must be adaptive.

I uses crossfade.  But, to get this properly working I created an temp-image where I get a black image.  This is not the same as the background.  The fact that it is an image it is treated as an image so it is not transparent (background is) and ther is the glue to remove parts of the previous image when transition takes place (You see that when you slide between a landscape and a portrait).
This is also usable to start a presentation from a black image (this is changeable so one of my goals is done).
For the moment I used sleep for the transition, but of course and you are right, it is better to use a timer.  But in draft using sleep is quicker (I'm sometime very lazy)
I uses the canvas of a form, but it can be something else.  Be aware, in that case I must change the existent references to Form.  In my optimized version it will be a parameter.
See it as follow, this code I made is the start-up for more.  But I had to know if it was possible and yes, it does.
For those who want the full-size images, source and executable, you can this with the url: http://fotospotter.be/_all_download/slide.zip (http://fotospotter.be/_all_download/slide.zip)

Here is the code: (I did not added your ideas, corrections , they will be inserted later.

Code: Pascal  [Select][+][-]
  1. unit slide_1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  9.   ExtCtrls, types, BGRABitmap, BGRABitmapTypes;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     knop: TButton;
  17.     procedure FormResize(Sender: TObject);
  18.     procedure FormWindowStateChange(Sender: TObject);
  19.     procedure knopClick(Sender: TObject);
  20.     procedure FormCreate(Sender: TObject);
  21.     procedure FormPaint(Sender: TObject);
  22.   private
  23.     image      : TBGRABitmap;
  24.     image_from : TBGRABitmap;
  25.     image_to   : TBGRABitmap;
  26.     procedure resize_to_slide_show( work_image: TBGRABitmap; str_image : string );
  27.  
  28.   public
  29.  
  30.   end;
  31.  
  32. var
  33.   Form1: TForm1;
  34.   nfoto : integer;
  35.  
  36. implementation
  37.  
  38. {$R *.lfm}
  39.  
  40. { TForm1 }
  41.  
  42.  
  43. //-----------------------------------------------------
  44.  
  45. procedure TForm1.resize_to_slide_show( work_image: TBGRABitmap; str_image : string );
  46. var
  47.   FormVerhouding      : Single;
  48.   BeeldVerhouding     : Single;
  49.   SlideBreedte   : Integer;
  50.   SlideHoogte  : Integer;
  51.   RectSlide       : TRect;
  52.   image_tmp       : TBGRABitmap;
  53. begin
  54.  
  55.   try
  56.     RectSlide       := TRect.Create(0,0,Form1.Width,Form1.Height);
  57.  
  58. //  load backgroundimage to fill whole projectioncanvas
  59.     image_tmp := TBGRABitmap.Create( 'black.jpg' );
  60.  
  61.     work_image.StretchPutImage(RectSlide, image_tmp, dmset, 255);
  62.     image_tmp.Free;
  63.  
  64. // get picture to be loaded
  65.     image_tmp := TBGRABitmap.Create( str_image );
  66.  
  67. // scale en ratio
  68.     FormVerhouding  := Form1.Width / Form1.Height;
  69.     BeeldVerhouding := image_tmp.Width / image_tmp.Height;
  70.  
  71.     if FormVerhouding > BeeldVerhouding then // use same height
  72.     begin
  73.       SlideHoogte := Form1.Height;
  74.       SlideBreedte  := Round(SlideHoogte * BeeldVerhouding);
  75.     end
  76.     else begin                        // use same width
  77.       SlideBreedte  := Form1.Width;
  78.       SlideHoogte := Round(SlideBreedte / BeeldVerhouding);
  79.     end;
  80.     if (image_tmp.Width < form1.Width) or
  81.        (image_tmp.Height < form1.Height) then
  82.     begin
  83.       image_tmp.ResampleFilter := rfBestQuality;
  84.       BGRAReplace(image_tmp, image_tmp.Resample(form1.Width, form1.Height));
  85.     end;
  86.  
  87. // center SLide
  88.     RectSlide.Left   := (Form1.Width  - SlideBreedte)  div 2;
  89.     RectSlide.Top    := (Form1.Height - SlideHoogte) div 2;
  90.     RectSlide.Width  := SlideBreedte;
  91.     RectSlide.Height := SlideHoogte;
  92.  
  93.     work_image.StretchPutImage(RectSlide, image_tmp, dmSet, 255);
  94.  
  95.   finally
  96.     image_tmp.Free;
  97.   end;
  98. end;
  99.  
  100. //------------------------------------------------------
  101.  
  102. procedure TForm1.knopClick(Sender: TObject);
  103. var
  104.   nknop : integer;
  105.   str_foto_from, str_foto_to : string;
  106. begin
  107.   Knop.Visible := false;
  108.   if nfoto = 0 then
  109.   begin
  110.     str_foto_from := 'black.jpg';
  111.     str_foto_to   := 'img_044000d.jpg';
  112.   end;
  113.   if nfoto = 1 then
  114.   begin
  115.     str_foto_from := 'img_044000d.jpg';
  116.     str_foto_to   := 'img_045014d.jpg';
  117.   end;
  118.   if nfoto = 2 then
  119.   begin
  120.     str_foto_from := 'img_045014d.jpg';
  121.     str_foto_to   := 'img_044333d.jpg';
  122.   end;
  123.   if nfoto = 3 then
  124.   begin
  125.     str_foto_from := 'img_044333d.jpg';
  126.     str_foto_to   := 'img_042000d.jpg';
  127.   end;
  128.   if nfoto = 4 then
  129.   begin
  130.     str_foto_from := 'img_042000d.jpg';
  131.     str_foto_to   := 'black.jpg';
  132.   end;
  133.  
  134.   nfoto := nfoto + 1;
  135.   if nfoto = 5 then nfoto := 0;
  136.  
  137.   resize_to_slide_show( image_from, str_foto_from );
  138.   resize_to_slide_show( image_to, str_foto_to );
  139.  
  140.   for nknop := 1 to 51 do
  141.   begin
  142.     knop.Tag := nknop;
  143.     form1.Tag := 1;
  144.     form1.Repaint;
  145.   end;
  146.   Knop.Visible := true;
  147. end;
  148.  
  149.  
  150. procedure TForm1.FormWindowStateChange(Sender: TObject);
  151. begin
  152.     image.SetSize(ClientWidth,ClientHeight);
  153.   image.Fill(BGRAWhite);
  154.  
  155. end;
  156.  
  157. procedure TForm1.FormResize(Sender: TObject);
  158. begin
  159.   image_from.SetSize(ClientWidth,ClientHeight);
  160.   image_to.SetSize(ClientWidth,ClientHeight);
  161.   image.SetSize(ClientWidth,ClientHeight);
  162. end;
  163.  
  164. procedure TForm1.FormCreate(Sender: TObject);
  165. begin
  166.   image_from := TBGRABitmap.Create(ClientWidth,ClientHeight);
  167.   image_to   := TBGRABitmap.Create(ClientWidth,ClientHeight);
  168.   image      := TBGRABitmap.Create(ClientWidth,ClientHeight);
  169. //  image.SetSize(ClientWidth,ClientHeight);
  170.   image.Fill(BGRABlack);
  171.   nfoto := 0;
  172. end;
  173.  
  174. procedure TForm1.FormPaint(Sender: TObject);
  175. var
  176.   destRect: TRect;
  177. begin
  178.   if form1.Tag = 1 then
  179.   begin
  180.     OffsetRect(destRect, (image.width - destRect.width) div 2, (image.height - destRect.height) div 2);
  181.     image.CrossFade(Rect(0,0,image.Width, image.Height), image_from, image_to, round(knop.tag * 5), dmSet);
  182.     sleep( 20 );
  183.     image.Draw(Canvas, 0,0);
  184.     Form1.Tag := 2; // ready to next
  185.   end;
  186. end;
  187.  
  188. end.
  189.  

So, any way, thanks for the info, addings, suggestions...
I'll pass the definite version within some days ..   Now I have to find out how I can insert google maps.
By the way, This slideshow is is already written, but without the transition.  And slides can be mixed with video-parts.  This runs already.  Now I can remove the black intervals.


Title: Re: [Solved] Component à la TPicShow (delphi)
Post by: Handoko on January 14, 2019, 04:13:01 pm
I've just tried your new code. It compiled but I got SIGSEGV error if I click the start/next button. While your previous version seems to run okay unless the fading transition not working yet.

Now I have to find out how I can insert google maps.
...  And slides can be mixed with video-parts.

I remember there were several discussions about google maps and video playback here. I think you may get what you need by searching the forum.

... when I write tests, I do it in a badly way, without cleaning, ... without capting errors, freeing objects, memory ...

Yes, I understand. And I was the same as you.

I ever posted my prototype code in the forum and I got critiques from Thaddy.

It feels bad if we receive critique, but I try to take the positive side. Now I always write my code as beautiful, maintainable and readable as I can, even when prototyping. And it becomes my habit. The advantage of it, is no need to do cleaning up to upgrade the prototype to become definite version.

Thaddy's words often sound harsh. But his nitpicking about the security and maintainability of the source code, makes me now write better code. :)
Title: Re: [Solved] Component à la TPicShow (delphi)
Post by: WimVan on January 14, 2019, 05:13:04 pm
handoko
I see that the attachment was not succesfull.  The reason why you got the error is the lack of black.jpg.

Here the attachment with all used sources

I already merged a week ago video's too in the slideshow.  Now I have to merge the transition

Look at your first code please.
Proportial scale is good, but if you transition from a landscaped picture to a portrait, parts of the landscape picture remain.

Title: Re: [Solved] Component à la TPicShow (delphi)
Post by: Handoko on January 14, 2019, 05:55:23 pm
Tested your new upload. But I got an error. Ignoring it, I got the second error. For your information, I use Linux.

It seems you work too much and you need some proper sleep to re-energize your power. :D

handoko
Proportial scale is good, but if you transition from a landscaped picture to a portrait, parts of the landscape picture remain.

I've just checked it. Yes, you're right I saw the issue.
Title: Re: [Solved] Component à la TPicShow (delphi)
Post by: WimVan on January 15, 2019, 10:19:13 am
@Handoko
I took your advice ...  Went to sleep.

Next code should work now.  I added a kind of stop in the timer to, otherwise I see that is is updating whole the time, even it no fading is no more needed and we wait till the start-next is clicked.
It is programmed on a Win10, so I'm not sure that this runs on Linux, but normally it should.
I used your cleaned up version.  Added a procedure to resize, proportial scale and add a black-image to the BGRABitmap-container (I see this as a container), so it can be used for as well the from-image and the to-image. ....
In future I'll try doing proper development in prototyping ...

Code: Pascal  [Select][+][-]
  1. unit slide_1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  9.   ExtCtrls, types, BGRABitmap, BGRABitmapTypes;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     Show_slide_button: TButton;
  17.     Slide_panel: TPanel;
  18.     Timer1: TTimer;
  19.     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
  20.     procedure FormWindowStateChange(Sender: TObject);
  21.     procedure Show_slide_buttonClick(Sender: TObject);
  22.     procedure FormCreate(Sender: TObject);
  23.     procedure Timer1Timer(Sender: TObject);
  24.   private
  25.     image: TBGRABitmap;
  26.     image_from : TBGRABitmap;
  27.     image_to   : TBGRABitmap;
  28.     nfoto      : integer;
  29.     TimerIndex : integer;
  30.     TimerStep  : integer;
  31.     procedure resize_to_slide_show( work_image: TBGRABitmap; str_image : string );
  32.   end;
  33.  
  34. var
  35.   Form1: TForm1;
  36.  
  37. implementation
  38.  
  39. {$R *.lfm}
  40.  
  41. { TForm1 }
  42.  
  43. procedure TForm1.resize_to_slide_show( work_image: TBGRABitmap; str_image : string );
  44. var
  45.   FormVerhouding  : Single;
  46.   BeeldVerhouding : Single;
  47.   SlideBreedte    : Integer;
  48.   SlideHoogte     : Integer;
  49.   RectSlide       : TRect;
  50.   image_tmp       : TBGRABitmap;
  51. begin
  52.  
  53.   try
  54.     RectSlide       := TRect.Create(0,0,Slide_panel.Width,Slide_panel.Height);
  55.  
  56.  
  57. //  load backgroundimage to fill whole projectioncanvas
  58.     image_tmp := TBGRABitmap.Create( 'black.jpg' );
  59.     work_image.StretchPutImage(RectSlide, image_tmp, dmset, 255);
  60.     image_tmp.Free;
  61.  
  62. // get picture to be loaded
  63.     image_tmp := TBGRABitmap.Create( str_image );
  64.  
  65. // scale en ratio
  66.     FormVerhouding  := Slide_panel.Width / Slide_panel.Height;
  67.     BeeldVerhouding := image_tmp.Width / image_tmp.Height;
  68.  
  69.     if FormVerhouding > BeeldVerhouding then // use same height
  70.     begin
  71.       SlideHoogte := Slide_panel.Height;
  72.       SlideBreedte  := Round(SlideHoogte * BeeldVerhouding);
  73.     end
  74.     else begin                        // use same width
  75.       SlideBreedte  := Slide_panel.Width;
  76.       SlideHoogte := Round(SlideBreedte / BeeldVerhouding);
  77.     end;
  78.     if (image_tmp.Width < Slide_panel.Width) or
  79.        (image_tmp.Height < Slide_panel.Height) then
  80.     begin
  81.       image_tmp.ResampleFilter := rfBestQuality;
  82.       BGRAReplace(image_tmp, image_tmp.Resample(Slide_panel.Width, Slide_panel.Height));
  83.     end;
  84.  
  85. // center SLide
  86.     RectSlide.Left   := (Slide_panel.Width  - SlideBreedte)  div 2;
  87.     RectSlide.Top    := (Slide_panel.Height - SlideHoogte) div 2;
  88.     RectSlide.Width  := SlideBreedte;
  89.     RectSlide.Height := SlideHoogte;
  90.  
  91.     work_image.StretchPutImage(RectSlide, image_tmp, dmSet, 255);
  92.  
  93.   finally
  94.     image_tmp.Free;
  95.   end;
  96. end;
  97.  
  98.  
  99. procedure TForm1.Show_slide_buttonClick(Sender: TObject);
  100. var
  101.   str_foto_from, str_foto_to : string;
  102.  
  103. begin
  104.   if nfoto = 0 then
  105.   begin
  106.     str_foto_from := 'black.jpg';
  107.     str_foto_to   := 'img_044000d.jpg';
  108.   end;
  109.   if nfoto = 1 then
  110.   begin
  111.     str_foto_from := 'img_044000d.jpg';
  112.     str_foto_to   := 'img_045014d.jpg';
  113.   end;
  114.   if nfoto = 2 then
  115.   begin
  116.     str_foto_from := 'img_045014d.jpg';
  117.     str_foto_to   := 'img_044333d.jpg';
  118.   end;
  119.   if nfoto = 3 then
  120.   begin
  121.     str_foto_from := 'img_044333d.jpg';
  122.     str_foto_to   := 'img_042000d.jpg';
  123.   end;
  124.   if nfoto = 4 then
  125.   begin
  126.     str_foto_from := 'img_042000d.jpg';
  127.     str_foto_to   := 'black.jpg';
  128.   end;
  129.  
  130.   resize_to_slide_show( image_from, str_foto_from );
  131.  
  132.   resize_to_slide_show( image_to, str_foto_to );
  133.  
  134.   nfoto := nfoto + 1;
  135.   if nfoto = 5 then nfoto := 0;
  136.  
  137. // fading using crossqfade by incresing transparency-value (from 1 to 255 by step of 5
  138.   TimerIndex     := 0;
  139.   TimerStep      := 5;
  140.   Timer1.Enabled := True;
  141. end;
  142.  
  143. procedure TForm1.FormWindowStateChange(Sender: TObject);
  144. begin
  145.   image_from.SetSize(Slide_panel.Width,Slide_panel.Height);
  146.   image_to.SetSize(Slide_panel.Width,Slide_panel.Height);
  147.   image.SetSize(Slide_panel.Width,Slide_panel.Height);
  148.   image.Fill(BGRABlack);
  149. end;
  150.  
  151. procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
  152. begin
  153.   Timer1.Enabled := False;
  154.   image_from.Free;
  155.   image_to.Free;
  156.   image.Free;
  157. end;
  158.  
  159. procedure TForm1.FormCreate(Sender: TObject);
  160. begin
  161.   image_from := TBGRABitmap.Create( Slide_panel.Width,Slide_panel.Height );
  162.   image_to   := TBGRABitmap.Create( Slide_panel.Width,Slide_panel.Height );
  163.   image      := TBGRABitmap.Create( Slide_panel.Width,Slide_panel.Height );
  164.   image.Fill(BGRABlack);
  165.   nfoto := 0;
  166.  
  167.   Timer1.Interval := 20;
  168.   Timer1.Enabled  := False;
  169. end;
  170.  
  171. procedure TForm1.Timer1Timer(Sender: TObject);
  172. begin
  173.   image.CrossFade(Rect(0,0,image.Width, image.Height), image_from, image_to, TimerIndex, dmSet);
  174.   image.Draw(Slide_panel.Canvas, 0,0);
  175.   if TimerIndex  < 255-TimerStep then
  176.     TimerIndex := TimerIndex + TimerStep
  177.     else Timer1.Enabled:=false;;
  178.   Application.ProcessMessages; // avoid to become unresponsive
  179. end;
  180.  
  181. end.
Title: Re: [Solved] Component à la TPicShow (delphi)
Post by: Handoko on January 15, 2019, 02:59:52 pm
Finally, your baseslide3 works!

I got an error but it's easy solved after I copied the images from your previous post.
Title: Re: [Solved] Component à la TPicShow (delphi)
Post by: WimVan on January 17, 2019, 10:29:25 am
@Handoko
We have a logical problem, error in the timer-event

Code: Pascal  [Select][+][-]
  1. procedure TForm1.Timer1Timer(Sender: TObject);
  2. begin
  3.   image.CrossFade(Rect(0,0,image.Width, image.Height), image_from, image_to, TimerIndex, dmSet);
  4.   image.Draw(Slide_panel.Canvas, 0,0);
  5.   if TimerIndex  < 255-TimerStep then
  6.     TimerIndex := TimerIndex + TimerStep
  7.     else Timer1.Enabled:=false;;
  8.   Application.ProcessMessages; // avoid to become unresponsive
  9. end;

This routine runs correct as long 255 is divisible by Timerstep.
BUt, if it is not divisible, Timerindex will never be 255, so the transition is never done completly (read 255).  This means that when the refresh stops, still parts will be visible of the first image.  Nearly completly fade out, but not wiped.

I modified it this way

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if TimerIndex  > 255 then TimerIndex := 255;  // transparenty greater than 255 returns an error

  image.CrossFade(Rect(0,0,image.Width, image.Height), image_from, image_to, TimerIndex, dmSet);
  image.Draw(Slide_panel.Canvas, 0,0);
  if TimerIndex  < 255 + TimerStep then
    TimerIndex := TimerIndex + TimerStep
    else Timer1.Enabled:=false;;
  Application.ProcessMessages; // avoid to become unresponsive
end;
Title: Re: [Solved] Component à la TPicShow (delphi)
Post by: Handoko on January 17, 2019, 10:45:20 am
When I wrote "if TimerIndex < 255-TimerStep then", I was a bit unsure if it was 'correct'. My sixth sense told me it wasn't good.

But you're right, that was wrong. And you fix it simply and cleverly:
if TimerIndex  > 255 then TimerIndex := 255;
TinyPortal © 2005-2018