* Ported the Sprites demo from Lazarus to fpGUI. fpGUI shows no flicker at all. Excellent <smile>

5 files changed, 221 insertions, 0 deletions

diff --git a/examples/gui/sprites/extrafpc.cfg b/examples/gui/sprites/extrafpc.cfg
new file mode 100644
index 00000000..073dc4b6
--- /dev/null
+++ b/examples/gui/sprites/extrafpc.cfg
@@ -0,0 +1,5 @@
+-FUunits
+-Fu../../../lib
+-Xs
+-XX
+-CX
diff --git a/examples/gui/sprites/ide_icon48x48.bmp b/examples/gui/sprites/ide_icon48x48.bmp
new file mode 100644
index 00000000..3e710b1d
--- /dev/null
+++ b/examples/gui/sprites/ide_icon48x48.bmp
diff --git a/examples/gui/sprites/splash_logo.bmp b/examples/gui/sprites/splash_logo.bmp
new file mode 100644
index 00000000..0096893a
--- /dev/null
+++ b/examples/gui/sprites/splash_logo.bmp
diff --git a/examples/gui/sprites/spritedemo.lpi b/examples/gui/sprites/spritedemo.lpi
new file mode 100644
index 00000000..6cd2d611
--- /dev/null
+++ b/examples/gui/sprites/spritedemo.lpi
@@ -0,0 +1,52 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="6"/>
+    <General>
+      <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <TargetFileExt Value=""/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="fpgui_package"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="spritedemo.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="spritedemo"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Other>
+      <CustomOptions Value="-FUunits"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>
diff --git a/examples/gui/sprites/spritedemo.lpr b/examples/gui/sprites/spritedemo.lpr
new file mode 100644
index 00000000..12adc82c
--- /dev/null
+++ b/examples/gui/sprites/spritedemo.lpr
@@ -0,0 +1,164 @@
+program spritedemo;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Classes, SysUtils,
+  gfxbase, fpgfx, gui_form, gfx_imgfmt_bmp;
+
+type
+
+  TMainForm = class(TfpgForm)
+  private
+    Timer: TfpgTimer;
+    Background: TfpgImage;
+    SpriteImg: TfpgImage;
+    FShowInterval: Boolean;
+    procedure   TimerFired(Sender: TObject);
+    procedure   FormDestroy(Sender: TObject);
+    procedure   FormClose(Sender: TObject; var CloseAction: TCloseAction);
+    procedure   FormPaint(Sender: TObject);
+  protected
+    procedure   HandleKeyPress(var keycode: word; var shiftstate: TShiftState;
+       var consumed: boolean); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure   AfterCreate; override;
+  end;
+
+
+procedure TMainForm.FormDestroy(Sender: TObject);
+begin
+  Timer.Free;
+  SpriteImg.Free;
+  Background.Free;
+end;
+
+procedure TMainForm.TimerFired(Sender: TObject);
+begin
+  if csDestroying in ComponentState then
+    Exit;
+  Repaint;
+end;
+
+procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
+begin
+  Timer.Enabled := False;
+end;
+
+procedure TMainForm.FormPaint(Sender: TObject);
+var
+  t: Double;
+  x: Int64;
+  y: Integer;
+  CenterX: Integer;
+  CenterY: Integer;
+begin
+  // paint background
+  Canvas.DrawImage(0, 0, Background);
+
+  // calculate sprite position
+  CenterX:=Background.Width div 2;
+  CenterY:=Background.Height div 2;
+  t := Now*86400;
+  x := CenterX+round(cos(t)*CenterX*2/3)-(SpriteImg.Width div 2);
+  y := CenterY+round(sin(t*0.7)*CenterY*2/3)-(SpriteImg.Height div 2);
+  
+  // paint sprite
+  Canvas.DrawImage(x, y, SpriteImg);
+  
+  // paint debug info
+  if FShowInterval then
+  begin
+    Canvas.DrawText(4, 4, 'Timer Interval: ' + IntToStr(Timer.Interval));
+  end;
+end;
+
+procedure TMainForm.HandleKeyPress(var keycode: word;
+  var shiftstate: TShiftState; var consumed: boolean);
+var
+  interval: integer;
+begin
+  case keycode of
+    keyPageUp:  // increase timer interval
+        begin
+          interval := Timer.Interval;
+          inc(interval, 10);
+          Timer.Interval := interval;
+          consumed := True;
+        end;
+    keyPageDown:  // decrease timer interval
+        begin
+          interval := Timer.Interval;
+          dec(interval, 10);
+          if interval < 10 then
+            interval := 10;
+          Timer.Interval := interval;
+          consumed := True;
+        end;
+    keyEscape:  // exit application
+        begin
+          Close;
+        end;
+  end;
+
+  if KeycodeToText(keycode, shiftstate) = 'D' then  // show debug info
+  begin
+    FShowInterval := True;
+    consumed := True;
+  end;
+
+  if not consumed then
+    inherited HandleKeyPress(keycode, shiftstate, consumed);
+end;
+
+constructor TMainForm.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FShowInterval := False;
+  
+  OnPaint   := @FormPaint;
+  OnClose   := @FormClose;
+  OnDestroy := @FormDestroy;
+  
+  Background := LoadImage_BMP('splash_logo.bmp');
+  SpriteImg := LoadImage_BMP('ide_icon48x48.bmp');
+  SpriteImg.CreateMaskFromSample(0, 0);
+  SpriteImg.UpdateImage;
+
+  Timer := TfpgTimer.Create(50);
+  Timer.OnTimer := @TimerFired;
+  Timer.Enabled := True;
+end;
+
+procedure TMainForm.AfterCreate;
+begin
+  Name := 'MainForm';
+  SetPosition(316, 186, 429, 341);
+  WindowTitle := 'Sprite Demo';
+  WindowPosition := wpScreenCenter;
+end;
+
+
+procedure MainProc;
+var
+  frm: TMainForm;
+begin
+  fpgApplication.Initialize;
+  frm := TMainForm.Create(nil);
+  try
+    frm.Show;
+    fpgApplication.Run;
+  finally
+    frm.Free;
+  end;
+end;
+
+begin
+  MainProc;
+end.
+
+