* Removed a memory leak from fpg_hint unit.

* Added an example 'customstyles' to show how a quick and easy style could be applied. Please not theming is not fully implemented in fpGUI, so this might change later.

5 files changed, 401 insertions, 0 deletions

diff --git a/examples/gui/customstyles/customstyles.lpi b/examples/gui/customstyles/customstyles.lpi
new file mode 100644
index 00000000..da520924
--- /dev/null
+++ b/examples/gui/customstyles/customstyles.lpi
@@ -0,0 +1,71 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="6"/>
+    <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"/>
+      <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_toolkit"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="3">
+      <Unit0>
+        <Filename Value="customstyles.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="customstyles"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="frm_test.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="frm_test"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="mystyle.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="mystyle"/>
+      </Unit2>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="8"/>
+    <Parsing>
+      <SyntaxOptions>
+        <CStyleOperator Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <CodeGeneration>
+      <Optimizations>
+        <OptimizationLevel Value="0"/>
+      </Optimizations>
+    </CodeGeneration>
+    <Other>
+      <CustomOptions Value="-FUunits
+"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>
diff --git a/examples/gui/customstyles/customstyles.lpr b/examples/gui/customstyles/customstyles.lpr
new file mode 100644
index 00000000..c1b24424
--- /dev/null
+++ b/examples/gui/customstyles/customstyles.lpr
@@ -0,0 +1,34 @@
+program customstyles;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Classes, fpg_main, frm_test, mystyle;
+
+
+procedure MainProc;
+var
+  frm: TTestForm;
+begin
+  fpgApplication.Initialize;
+  frm := TTestForm.Create(nil);
+  try
+    // Free old and set new style
+    if Assigned(fpgStyle) then
+      fpgStyle.Free;
+    fpgStyle := TMyStyle.Create;
+    // now continue with the application
+    frm.Show;
+    fpgApplication.Run;
+  finally
+    frm.Free;
+  end;
+end;
+
+begin
+  MainProc;
+end.
+
diff --git a/examples/gui/customstyles/extrafpc.cfg b/examples/gui/customstyles/extrafpc.cfg
new file mode 100644
index 00000000..073dc4b6
--- /dev/null
+++ b/examples/gui/customstyles/extrafpc.cfg
@@ -0,0 +1,5 @@
+-FUunits
+-Fu../../../lib
+-Xs
+-XX
+-CX
diff --git a/examples/gui/customstyles/frm_test.pas b/examples/gui/customstyles/frm_test.pas
new file mode 100644
index 00000000..bb429a33
--- /dev/null
+++ b/examples/gui/customstyles/frm_test.pas
@@ -0,0 +1,174 @@
+unit frm_test;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  SysUtils, Classes, fpg_base, fpg_main, fpg_widget,
+  fpg_edit, fpg_form, fpg_label, fpg_button,
+  fpg_listbox, fpg_memo, fpg_combobox, fpg_basegrid, fpg_grid, 
+  fpg_dialogs, fpg_checkbox, fpg_tree, fpg_trackbar, 
+  fpg_progressbar, fpg_radiobutton, fpg_tab, fpg_menu,
+  fpg_panel, fpg_popupcalendar, fpg_gauge;
+
+type
+
+  TTestForm = class(TfpgForm)
+  private
+    {@VFD_HEAD_BEGIN: TestForm}
+    btnName1: TfpgButton;
+    lblName1: TfpgLabel;
+    lblName2: TfpgLabel;
+    btnName2: TfpgButton;
+    lblName3: TfpgLabel;
+    btnName3: TfpgButton;
+    lblName4: TfpgLabel;
+    btnName4: TfpgButton;
+    edtName1: TfpgEdit;
+    btnClose: TfpgButton;
+    {@VFD_HEAD_END: TestForm}
+    procedure CloseClicked(Sender: TObject);
+  public
+    procedure AfterCreate; override;
+  end;
+
+{@VFD_NEWFORM_DECL}
+
+implementation
+
+{@VFD_NEWFORM_IMPL}
+
+procedure TTestForm.CloseClicked(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TTestForm.AfterCreate;
+begin
+  {@VFD_BODY_BEGIN: TestForm}
+  Name := 'TestForm';
+  SetPosition(335, 206, 300, 250);
+  WindowTitle := 'Testing Custom Styles';
+  WindowPosition := wpScreenCenter;
+
+  btnName1 := TfpgButton.Create(self);
+  with btnName1 do
+  begin
+    Name := 'btnName1';
+    SetPosition(24, 48, 80, 24);
+    Text := 'Button1';
+    FontDesc := '#Label1';
+    Hint := '';
+    ImageName := '';
+    TabOrder := 1;
+  end;
+
+  lblName1 := TfpgLabel.Create(self);
+  with lblName1 do
+  begin
+    Name := 'lblName1';
+    SetPosition(20, 24, 116, 16);
+    FontDesc := '#Label2';
+    Hint := '';
+    Text := 'Standard Button';
+  end;
+
+  lblName2 := TfpgLabel.Create(self);
+  with lblName2 do
+  begin
+    Name := 'lblName2';
+    SetPosition(164, 24, 124, 16);
+    FontDesc := '#Label2';
+    Hint := '';
+    Text := 'Embedded Button';
+  end;
+
+  btnName2 := TfpgButton.Create(self);
+  with btnName2 do
+  begin
+    Name := 'btnName2';
+    SetPosition(176, 48, 80, 24);
+    Text := 'Button2';
+    Embedded := True;
+    FontDesc := '#Label1';
+    Hint := '';
+    ImageName := '';
+    TabOrder := 2;
+  end;
+
+  lblName3 := TfpgLabel.Create(self);
+  with lblName3 do
+  begin
+    Name := 'lblName3';
+    SetPosition(20, 92, 100, 16);
+    FontDesc := '#Label2';
+    Hint := '';
+    Text := 'Default Button';
+  end;
+
+  btnName3 := TfpgButton.Create(self);
+  with btnName3 do
+  begin
+    Name := 'btnName3';
+    SetPosition(24, 116, 80, 24);
+    Text := 'Button3';
+    FontDesc := '#Label1';
+    Hint := '';
+    ImageName := '';
+    TabOrder := 3;
+    Default := True;
+  end;
+
+  lblName4 := TfpgLabel.Create(self);
+  with lblName4 do
+  begin
+    Name := 'lblName4';
+    SetPosition(164, 92, 116, 16);
+    FontDesc := '#Label2';
+    Hint := '';
+    Text := 'Flat Button';
+  end;
+
+  btnName4 := TfpgButton.Create(self);
+  with btnName4 do
+  begin
+    Name := 'btnName4';
+    SetPosition(176, 116, 80, 24);
+    Text := 'Button4';
+    Flat := True;
+    FontDesc := '#Label1';
+    Hint := '';
+    ImageName := '';
+    TabOrder := 4;
+  end;
+
+  edtName1 := TfpgEdit.Create(self);
+  with edtName1 do
+  begin
+    Name := 'edtName1';
+    SetPosition(24, 168, 120, 22);
+    TabOrder := 5;
+    Text := '';
+    FontDesc := '#Edit1';
+  end;
+
+  btnClose := TfpgButton.Create(self);
+  with btnClose do
+  begin
+    Name := 'btnClose';
+    SetPosition(212, 216, 80, 24);
+    Text := 'Close';
+    FontDesc := '#Label1';
+    Hint := '';
+    ImageName := 'stdimg.close';
+    TabOrder := 6;
+    OnClick := @CloseClicked;
+  end;
+
+  {@VFD_BODY_END: TestForm}
+end;
+
+
+
+end.
diff --git a/examples/gui/customstyles/mystyle.pas b/examples/gui/customstyles/mystyle.pas
new file mode 100644
index 00000000..70448d14
--- /dev/null
+++ b/examples/gui/customstyles/mystyle.pas
@@ -0,0 +1,117 @@
+{
+  A very quick and basic style implementation. It took all of 10 minutes.
+  To apply this style, follow these instructions:
+
+    * free the old fpgStyle
+    * instantiate the new style class
+    * and assign this new instance to fpgStyle variable
+
+
+  Example:
+
+    procedure MainProc;
+    var
+      frm: TMainForm;
+    begin
+      fpgApplication.Initialize;
+      frm := TMainForm.Create(nil);
+      try
+        // Free the old and set the new style
+        if Assigned(fpgStyle) then
+          fpgStyle.Free;
+        fpgStyle := TMyStyle.Create;
+
+        // now continue with the application
+        frm.Show;
+        fpgApplication.Run;
+      finally
+        frm.Free;
+      end;
+    end;
+
+}
+unit mystyle;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpg_main, fpg_base;
+
+type
+  TMyStyle = class(TfpgStyle)
+  public
+    constructor Create; override;
+    procedure DrawControlFrame(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord); override;
+    procedure DrawButtonFace(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; AFlags: TFButtonFlags); override;
+  end;
+
+
+implementation
+
+{ TMyStyle }
+
+constructor TMyStyle.Create;
+begin
+  inherited Create;
+  fpgSetNamedColor(clWindowBackground, TfpgColor($eeeeec));
+end;
+
+procedure TMyStyle.DrawControlFrame(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord);
+var
+  r: TfpgRect;
+begin
+  r.SetRect(x, y, w, h);
+  ACanvas.SetColor(clShadow1);
+  ACanvas.Clear(clYellow);
+  ACanvas.DrawRectangle(r);
+end;
+
+procedure TMyStyle.DrawButtonFace(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; AFlags: TFButtonFlags);
+var
+  r: TfpgRect;
+begin
+  r.SetRect(x, y, w, h);
+
+  if btfIsDefault in AFlags then
+  begin
+    ACanvas.SetColor(TfpgColor($7b7b7b));
+    ACanvas.SetLineStyle(1, lsSolid);
+    ACanvas.DrawRectangle(r);
+    InflateRect(r, -1, -1);
+    Exclude(AFlags, btfIsDefault);
+    fpgStyle.DrawButtonFace(ACanvas, r.Left, r.Top, r.Width, r.Height, AFlags);
+    Exit; //==>
+  end;
+
+  // Clear the canvas
+  ACanvas.SetColor(clWindowBackground);
+  ACanvas.FillRectangle(r);
+
+  if (btfFlat in AFlags) and not (btfIsPressed in AFlags) then
+    Exit; // no need to go further
+
+  // outer rectangle
+  ACanvas.SetLineStyle(1, lsSolid);
+  ACanvas.SetColor(TfpgColor($a6a6a6));
+  ACanvas.DrawRectangle(r);
+
+  // so we don't paint over the border
+  InflateRect(r, -1, -1);
+  // now paint the face of the button
+  if (btfIsPressed in AFlags) then
+  begin
+    ACanvas.GradientFill(r, TfpgColor($cccccc), TfpgColor($e4e4e4), gdVertical);
+  end
+  else
+  begin
+    ACanvas.GradientFill(r, TfpgColor($fafafa), TfpgColor($e2e2e2), gdVertical);
+    ACanvas.SetColor(TfpgColor($cccccc));
+    ACanvas.DrawLine(r.Right, r.Top, r.Right, r.Bottom);   // right
+    ACanvas.DrawLine(r.Right, r.Bottom, r.Left, r.Bottom);   // bottom
+  end;
+end;
+
+end.
+