Recent

Author Topic: [Solved] Component à la TPicShow (delphi)  (Read 10684 times)

Handoko

  • Hero Member
  • *****
  • Posts: 3239
  • My goal: build my own game engine using Lazarus
Re: [Solved] Component à la TPicShow (delphi)
« Reply #30 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.

Handoko

  • Hero Member
  • *****
  • Posts: 3239
  • My goal: build my own game engine using Lazarus
Re: [Solved] Component à la TPicShow (delphi)
« Reply #31 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!

WimVan

  • Jr. Member
  • **
  • Posts: 76
Re: [Solved] Component à la TPicShow (delphi)
« Reply #32 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

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.



Handoko

  • Hero Member
  • *****
  • Posts: 3239
  • My goal: build my own game engine using Lazarus
Re: [Solved] Component à la TPicShow (delphi)
« Reply #33 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. :)

WimVan

  • Jr. Member
  • **
  • Posts: 76
Re: [Solved] Component à la TPicShow (delphi)
« Reply #34 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.

« Last Edit: January 14, 2019, 05:44:32 pm by WimVan »

Handoko

  • Hero Member
  • *****
  • Posts: 3239
  • My goal: build my own game engine using Lazarus
Re: [Solved] Component à la TPicShow (delphi)
« Reply #35 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.

WimVan

  • Jr. Member
  • **
  • Posts: 76
Re: [Solved] Component à la TPicShow (delphi)
« Reply #36 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.

Handoko

  • Hero Member
  • *****
  • Posts: 3239
  • My goal: build my own game engine using Lazarus
Re: [Solved] Component à la TPicShow (delphi)
« Reply #37 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.

WimVan

  • Jr. Member
  • **
  • Posts: 76
Re: [Solved] Component à la TPicShow (delphi)
« Reply #38 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;

Handoko

  • Hero Member
  • *****
  • Posts: 3239
  • My goal: build my own game engine using Lazarus
Re: [Solved] Component à la TPicShow (delphi)
« Reply #39 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;