Added a new fpGUI based on multiple handles. One handle per Widget. Also added a few cool features.

6 files changed, 482 insertions, 0 deletions

diff --git a/prototypes/fpgui2/examples/core/eventtest/eventtest.lpi b/prototypes/fpgui2/examples/core/eventtest/eventtest.lpi
new file mode 100644
index 00000000..f09daf7e
--- /dev/null
+++ b/prototypes/fpgui2/examples/core/eventtest/eventtest.lpi
@@ -0,0 +1,55 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="\"/>
+    <Version Value="5"/>
+    <General>
+      <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <IconPath Value=".\"/>
+      <TargetFileExt Value=""/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <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="fpGFX2"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="eventtest.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="eventtest"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <PathDelim Value="\"/>
+    <CodeGeneration>
+      <Optimizations>
+        <OptimizationLevel Value="0"/>
+      </Optimizations>
+    </CodeGeneration>
+    <Other>
+      <CustomOptions Value="-FUunits"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>
diff --git a/prototypes/fpgui2/examples/core/eventtest/eventtest.lpr b/prototypes/fpgui2/examples/core/eventtest/eventtest.lpr
new file mode 100644
index 00000000..786ec3a0
--- /dev/null
+++ b/prototypes/fpgui2/examples/core/eventtest/eventtest.lpr
@@ -0,0 +1,152 @@
+program eventtest;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Classes, SysUtils, GFXBase, fpGFX, gui_form, gfx_widget;
+  
+type
+  TMainForm = class(TfpgForm)
+  private
+    function    ShiftStateToStr(AShift: word): string;
+    function    MouseState(AShift: word; const AMousePos: TPoint): string;
+  protected
+    procedure   HandleClose; override;
+    procedure   HandlePaint; override;
+    procedure   HandleDoubleClick(x, y: integer; button: word; shiftstate: word); override;
+    procedure   HandleKeyChar(var keycode: word; var shiftstate: word; var consumed: boolean); override;
+    procedure   HandleMouseEnter; override;
+    procedure   HandleMouseExit; override;
+    procedure   HandleMouseMove(x, y: integer; btnstate: word; shiftstate: word); override;
+    procedure   HandleLMouseDown(x, y: integer; shiftstate: word); override;
+    procedure   HandleLMouseUp(x, y: integer; shiftstate: word); override;
+    procedure   HandleRMouseDown(x, y: integer; shiftstate: word); override;
+    procedure   HandleRMouseUp(x, y: integer; shiftstate: word); override;
+  public
+    constructor Create(aowner: TComponent); override;
+  end;
+
+{ TMainForm }
+
+function TMainForm.ShiftStateToStr(AShift: word): string;
+begin
+  Result := '';
+  {$Note This must move into gfx_XXX units and return TShiftState enum}
+  if (AShift and ss_Shift) <> 0 then
+    Result := 'Shift ';
+  if (AShift and ss_Alt) <> 0 then
+    Result := Result + 'Alt ';
+  if (AShift and ss_Control) <> 0 then
+    Result := Result + 'Ctrl ';
+end;
+
+function TMainForm.MouseState(AShift: word; const AMousePos: TPoint): string;
+var
+  ShiftStateStr: String;
+begin
+  ShiftStateStr := ShiftStateToStr(AShift);
+  Result := '[X=' + IntToStr(AMousePos.x) + ' Y=' + IntToStr(AMousePos.y);
+  if Length(ShiftStateStr) > 0 then
+    Result := Result + ' ' + ShiftStateStr;
+  Result := Result + '] ';
+end;
+
+procedure TMainForm.HandleClose;
+begin
+  WriteLn('HandleClose');
+  inherited HandleClose;
+end;
+
+procedure TMainForm.HandlePaint;
+begin
+  WriteLn('HandlePaint');
+  inherited HandlePaint;
+end;
+
+procedure TMainForm.HandleDoubleClick(x, y: integer; button: word;
+  shiftstate: word);
+begin
+  WriteLn('HandleDoubleClick');
+  inherited HandleDoubleClick(x, y, button, shiftstate);
+end;
+
+procedure TMainForm.HandleKeyChar(var keycode: word; var shiftstate: word;
+  var consumed: boolean);
+begin
+  Write('Character generated: ');
+  if Char(keycode) >= ' ' then
+    WriteLn('''', Char(keycode), '''')
+  else
+    WriteLn('#', Ord(keycode));
+
+  inherited HandleKeyChar(keycode, shiftstate, consumed);
+end;
+
+procedure TMainForm.HandleMouseEnter;
+begin
+  WriteLn('Mouse entered window');
+  inherited HandleMouseEnter;
+end;
+
+procedure TMainForm.HandleMouseExit;
+begin
+  WriteLn('Mouse left window');
+  inherited HandleMouseExit;
+end;
+
+procedure TMainForm.HandleMouseMove(x, y: integer; btnstate: word;
+  shiftstate: word);
+begin
+  WriteLn(MouseState(shiftstate, Point(x, y)), 'Mouse moved');
+  inherited HandleMouseMove(x, y, btnstate, shiftstate);
+end;
+
+procedure TMainForm.HandleLMouseDown(x, y: integer; shiftstate: word);
+begin
+  WriteLn('Left mouse button down');
+  inherited HandleLMouseDown(x, y, shiftstate);
+end;
+
+procedure TMainForm.HandleLMouseUp(x, y: integer; shiftstate: word);
+begin
+  Writeln('Left mouse button up');
+  inherited HandleLMouseUp(x, y, shiftstate);
+end;
+
+procedure TMainForm.HandleRMouseDown(x, y: integer; shiftstate: word);
+begin
+  Writeln('Right mouse button down');
+  inherited HandleRMouseDown(x, y, shiftstate);
+end;
+
+procedure TMainForm.HandleRMouseUp(x, y: integer; shiftstate: word);
+begin
+  WriteLn('Right mouse button up');
+  inherited HandleRMouseUp(x, y, shiftstate);
+end;
+
+constructor TMainForm.Create(aowner: TComponent);
+begin
+  inherited Create(aowner);
+  SetPosition(100, 100, 500, 100);
+  WindowTitle := 'fpGFX event test';
+end;
+  
+  
+procedure MainProc;
+var
+  frm: TMainForm;
+begin
+  fpgApplication.Initialize;
+  frm := TMainForm.Create(nil);
+  frm.Show;
+  fpgApplication.Run;
+end;
+
+begin
+  MainProc;
+end.
+
diff --git a/prototypes/fpgui2/examples/core/imgtest/bitmaptest.dpr b/prototypes/fpgui2/examples/core/imgtest/bitmaptest.dpr
new file mode 100644
index 00000000..969cb09f
--- /dev/null
+++ b/prototypes/fpgui2/examples/core/imgtest/bitmaptest.dpr
@@ -0,0 +1,68 @@
+program bitmaptest;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes,
+  SysUtils,
+  gfxbase,
+  fpgfx,
+  gfx_imgfmt_bmp,
+  gui_form;
+
+type
+
+  { TMainForm }
+
+  TMainForm = class(TfpgForm)
+  protected
+    procedure HandlePaint; override;
+  public
+    procedure AfterCreate; override;
+  end;
+
+
+  { TMainForm }
+
+  procedure TMainForm.AfterCreate;
+  begin
+    SetPosition(100, 100, 256, 256);
+    WindowTitle := 'fpGUI2 Bitmap Test';
+  end;
+
+  procedure TMainForm.HandlePaint;
+  var
+    img: TfpgImage;
+    i, j: integer;
+  begin
+    Canvas.BeginDraw; // activate double buffering in time.
+    inherited HandlePaint;
+    
+    img := TfpgImage.Create;
+    img.AllocateImage(32, 256, 256);
+    img.UpdateImage;
+    // populate the bitmap with pretty colors :-)
+    for j := 0 to 255 do
+      for i := 0 to 255 do
+        PLongWord(img.ImageData)[j * 256 + i] := (i shl 16) or (j shl 8);
+
+    Canvas.DrawImage(0, 0, img);
+    img.Free;
+    Canvas.EndDraw;
+  end;
+
+  procedure MainProc;
+  var
+    frm: TMainForm;
+  begin
+    fpgApplication.Initialize;
+    frm := TMainForm.Create(nil);
+    frm.Show;
+    fpgApplication.Run;
+  end;
+
+
+begin
+  MainProc;
+end.
+
diff --git a/prototypes/fpgui2/examples/core/imgtest/bitmaptest.lpi b/prototypes/fpgui2/examples/core/imgtest/bitmaptest.lpi
new file mode 100644
index 00000000..844bcc82
--- /dev/null
+++ b/prototypes/fpgui2/examples/core/imgtest/bitmaptest.lpi
@@ -0,0 +1,63 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="5"/>
+    <General>
+      <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=""/>
+      <Title Value="bitmaptest"/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <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="fpGFX2"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="bitmaptest.dpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="bitmaptest"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="uhelpers.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="uhelpers"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <SearchPaths>
+      <IncludeFiles Value="../source/"/>
+      <OtherUnitFiles Value="../source/;../source/x11/;../gui/"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Other>
+      <CustomOptions Value="-FUunits
+"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>
diff --git a/prototypes/fpgui2/examples/gui/stdimages/stdimglist.lpi b/prototypes/fpgui2/examples/gui/stdimages/stdimglist.lpi
new file mode 100644
index 00000000..8ec0e1a4
--- /dev/null
+++ b/prototypes/fpgui2/examples/gui/stdimages/stdimglist.lpi
@@ -0,0 +1,51 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="5"/>
+    <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="fpGFX2"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="stdimglist.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </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/prototypes/fpgui2/examples/gui/stdimages/stdimglist.lpr b/prototypes/fpgui2/examples/gui/stdimages/stdimglist.lpr
new file mode 100644
index 00000000..06212cfc
--- /dev/null
+++ b/prototypes/fpgui2/examples/gui/stdimages/stdimglist.lpr
@@ -0,0 +1,93 @@
+program stdimglist;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils,
+  fpgfx, gfxbase, gui_form, gfx_imgfmt_bmp, gui_button;
+
+type
+
+  TMainForm = class(TfpgForm)
+  private
+    btnClose: TfpgButton;
+    procedure   btnCloseClick(Sender: TObject);
+  protected
+    procedure   HandlePaint; override;
+  public
+    constructor Create(aowner: TComponent); override;
+    procedure   AfterCreate; override;
+  end;
+
+{ TMainForm }
+
+procedure TMainForm.AfterCreate;
+begin
+  SetPosition(100,100,700,500);
+  WindowTitle := 'fpGUI Standard Image Listing';
+end;
+
+procedure TMainForm.btnCloseClick(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TMainForm.HandlePaint;
+var
+  n: integer;
+  x: TfpgCoord;
+  y: TfpgCoord;
+  sl: TStringList;
+  img: TfpgImage;
+begin
+  Canvas.BeginDraw; // begin double buffering
+  inherited HandlePaint;
+
+  sl  := TStringList.Create;
+  x   := 8;
+  y   := 8;
+  fpgImages.ListImages(sl);
+  
+  for n := 0 to sl.Count-1 do
+  begin
+    Canvas.DrawString(x, y, sl[n]+':');
+    
+    img := TfpgImage(sl.Objects[n]);
+    if img <> nil then
+      Canvas.DrawImage(x+150, y, img);
+
+    inc(y, img.Height+8);
+    if y > Height-32 then // largest images are 32 in height
+    begin
+      inc(x, 200);
+      y := 8;
+    end;
+  end;
+
+  Canvas.EndDraw;
+  sl.Free;
+end;
+
+constructor TMainForm.Create(aowner: TComponent);
+begin
+  inherited Create(aowner);
+  // Place button in bottom right corner.
+  btnClose := CreateButton(self, Width-90, Height-35, 75, 'Quit', @btnCloseClick);
+  btnClose.ImageName := 'stdimg.quit';
+//  btnClose.Focusable := False;
+  btnClose.Anchors := [anRight, anBottom];
+end;
+
+procedure MainProc;
+var
+  frm : TMainForm;
+begin
+  fpgApplication.Initialize;
+  frm := TMainForm.Create(nil);
+  frm.Show;
+  fpgApplication.Run;
+end;
+
+begin
+  MainProc;
+end.