summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorgraemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf>2007-11-06 20:50:26 +0000
committergraemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf>2007-11-06 20:50:26 +0000
commit6b34d0d7654981ea7c9bfbc732df1fc1c6e12326 (patch)
treef3182ea936bd2b1c84090b89915f65ad099bcce7
parentab910baffbf9585f5376f6a40f70490a5c765257 (diff)
downloadfpGUI-6b34d0d7654981ea7c9bfbc732df1fc1c6e12326.tar.xz
* Added new TfpgGauge component. Thanks to Giuliano Colla.
* Added new Gauges demo program - thanks to Giuliano Colla.
-rw-r--r--AUTHORS.txt2
-rw-r--r--examples/gui/gauges/extrafpc.cfg5
-rw-r--r--examples/gui/gauges/gaugetest.lpi58
-rw-r--r--examples/gui/gauges/gaugetest.lpr296
-rw-r--r--extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpi4
-rw-r--r--extras/tiopf/demos/Demo_06_CreateTable/frm_main.pas2
-rw-r--r--src/gui/fpgui_package.lpk14
-rw-r--r--src/gui/fpgui_package.pas2
-rw-r--r--src/gui/gui_gauge.pas543
9 files changed, 917 insertions, 9 deletions
diff --git a/AUTHORS.txt b/AUTHORS.txt
index e18c6002..00409e43 100644
--- a/AUTHORS.txt
+++ b/AUTHORS.txt
@@ -17,4 +17,6 @@ Contributors
------------
Felipe Monteiro de Carvalho <felipemonteiro.carvalho@gmail.com>
Andrew Haines <andrewd207@aol.com>
+Giuliano Colla <giuliano.colla@fastwebnet.it>
+
diff --git a/examples/gui/gauges/extrafpc.cfg b/examples/gui/gauges/extrafpc.cfg
new file mode 100644
index 00000000..073dc4b6
--- /dev/null
+++ b/examples/gui/gauges/extrafpc.cfg
@@ -0,0 +1,5 @@
+-FUunits
+-Fu../../../lib
+-Xs
+-XX
+-CX
diff --git a/examples/gui/gauges/gaugetest.lpi b/examples/gui/gauges/gaugetest.lpi
new file mode 100644
index 00000000..d1063c28
--- /dev/null
+++ b/examples/gui/gauges/gaugetest.lpi
@@ -0,0 +1,58 @@
+<?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=".exe"/>
+ </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="gaugetest.lpr"/>
+ <IsPartOfProject Value="True"/>
+ </Unit0>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="5"/>
+ <Parsing>
+ <SyntaxOptions>
+ <AllowLabel Value="False"/>
+ <CPPInline Value="False"/>
+ </SyntaxOptions>
+ </Parsing>
+ <CodeGeneration>
+ <Generate Value="Faster"/>
+ </CodeGeneration>
+ <Other>
+ <CustomOptions Value="-FUunits"/>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+</CONFIG>
diff --git a/examples/gui/gauges/gaugetest.lpr b/examples/gui/gauges/gaugetest.lpr
new file mode 100644
index 00000000..1ab55c21
--- /dev/null
+++ b/examples/gui/gauges/gaugetest.lpr
@@ -0,0 +1,296 @@
+program gaugetest;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Classes, Sysutils
+ { you can add units after this },
+ fpgfx,
+ gfxbase,
+ gui_form,
+ gui_button,
+ gui_progressbar,
+ gui_trackbar,
+ gui_label,
+ gfx_imgfmt_bmp,
+ fpgui_package,
+ gui_edit,
+ gui_bevel,
+ gui_gauge;
+
+type
+
+ TGaugeTest = class(TfpgForm)
+ public
+ {@VFD_HEAD_BEGIN: GaugeTest}
+ CloseBtn: TfpgButton;
+ Gauge: TfpgGauge;
+ MinusBtn: TfpgButton;
+ PlusBtn: TfpgButton;
+ ProgressBar: TfpgProgressBar;
+ TrackBar: TfpgTrackBar;
+ VertGauge: TfpgGauge;
+ TextGauge: TfpgGauge;
+ lblName1: TfpgLabel;
+ lblName2: TfpgLabel;
+ lblName3: TfpgLabel;
+ lblName4: TfpgLabel;
+ NeedleGauge: TfpgGauge;
+ PieGauge: TfpgGauge;
+ DialGauge: TfpgGauge;
+ lblName5: TfpgLabel;
+ lblName6: TfpgLabel;
+ lblName7: TfpgLabel;
+ SmallNeedle: TfpgGauge;
+ {@VFD_HEAD_END: GaugeTest}
+ procedure AfterCreate; override;
+ procedure OnCloseClick (Sender:TObject);
+ procedure OnPlusClick (Sender:TObject);
+ procedure OnMinusClick (Sender:TObject);
+ procedure OnTrackBarChange (Sender: TObject; APosition: integer);
+ end;
+
+{@VFD_NEWFORM_DECL}
+
+
+procedure TGaugeTest.AfterCreate;
+begin
+ {@VFD_BODY_BEGIN: GaugeTest}
+ Name := 'GaugeTest';
+ SetPosition(83, 160, 595, 379);
+ WindowTitle := 'Gauge Test';
+ WindowPosition:= wpScreenCenter;
+ Sizeable := False;
+
+ CloseBtn := TfpgButton.Create(self);
+ with CloseBtn do
+ begin
+ Name := 'CloseBtn';
+ SetPosition(463, 329, 75, 24);
+ Anchors := [anRight,anBottom];
+ Text := 'Close';
+ FontDesc := '#Label1';
+ ImageName := 'stdimg.close';
+ ModalResult := 1;
+ OnClick:= @OnCloseClick;
+ end;
+
+ Gauge := TfpgGauge.Create(self);
+ with Gauge do
+ begin
+ Name := 'Gauge';
+ SetPosition(124, 104, 151, 25);
+ Kind := gkHorizontalBar;
+ end;
+
+ MinusBtn := TfpgButton.Create(self);
+ with MinusBtn do
+ begin
+ Name := 'MinusBtn';
+ SetPosition(116, 329, 24, 24);
+ Anchors := [anLeft,anBottom];
+ Text := '-';
+ FontDesc := '#Label1';
+ ImageName := '';
+ OnClick:= @OnMinusClick;
+ end;
+
+ PlusBtn := TfpgButton.Create(self);
+ with PlusBtn do
+ begin
+ Name := 'PlusBtn';
+ SetPosition(384, 329, 24, 24);
+ Anchors := [anLeft,anBottom];
+ Text := '+';
+ FontDesc := '#Label1';
+ ImageName := '';
+ OnClick:= @OnPlusClick;
+ end;
+
+ ProgressBar := TfpgProgressBar.Create(self);
+ with ProgressBar do
+ begin
+ Name := 'ProgressBar';
+ SetPosition(124, 16, 150, 22);
+ ShowCaption := True;
+ end;
+
+ TrackBar := TfpgTrackBar.Create(self);
+ with TrackBar do
+ begin
+ Name := 'TrackBar';
+ SetPosition(164, 325, 200, 30);
+ Anchors := [anLeft,anBottom];
+ OnChange := @OnTrackBarChange;
+ end;
+
+ VertGauge := TfpgGauge.Create(self);
+ with VertGauge do
+ begin
+ Name := 'VertGauge';
+ SetPosition(352, 32, 25, 100);
+ Kind := gkVerticalBar;
+ ShowText := False;
+ end;
+
+ TextGauge := TfpgGauge.Create(self);
+ with TextGauge do
+ begin
+ Name := 'TextGauge';
+ SetPosition(124, 60, 75, 25);
+ Kind := gkText;
+ end;
+
+ lblName1 := TfpgLabel.Create(self);
+ with lblName1 do
+ begin
+ Name := 'lblName1';
+ SetPosition(16, 20, 92, 16);
+ Text := 'Progress Bar';
+ FontDesc := '#Label1';
+ end;
+
+ lblName2 := TfpgLabel.Create(self);
+ with lblName2 do
+ begin
+ Name := 'lblName2';
+ SetPosition(16, 64, 80, 16);
+ Text := 'Text Gauge';
+ FontDesc := '#Label1';
+ end;
+
+ lblName3 := TfpgLabel.Create(self);
+ with lblName3 do
+ begin
+ Name := 'lblName3';
+ SetPosition(16, 108, 108, 16);
+ Text := 'Horizontal Gauge';
+ FontDesc := '#Label1';
+ end;
+
+ lblName4 := TfpgLabel.Create(self);
+ with lblName4 do
+ begin
+ Name := 'lblName4';
+ SetPosition(324, 12, 96, 16);
+ Text := 'Vertical Gauge';
+ FontDesc := '#Label1';
+ end;
+
+ NeedleGauge := TfpgGauge.Create(self);
+ with NeedleGauge do
+ begin
+ Name := 'NeedleGauge';
+ SetPosition(472, 40, 100, 50);
+ Kind := gkNeedle;
+ end;
+
+ PieGauge := TfpgGauge.Create(self);
+ with PieGauge do
+ begin
+ Name := 'PieGauge';
+ SetPosition(124, 156, 120, 120);
+ Kind := gkPie;
+ end;
+
+ DialGauge := TfpgGauge.Create(self);
+ with DialGauge do
+ begin
+ Name := 'DialGauge';
+ SetPosition(356, 156, 120, 120);
+ Kind := gkDial;
+ end;
+
+ lblName5 := TfpgLabel.Create(self);
+ with lblName5 do
+ begin
+ Name := 'lblName5';
+ SetPosition(152, 288, 80, 16);
+ Text := 'Pie Gauge';
+ FontDesc := '#Label1';
+ end;
+
+ lblName6 := TfpgLabel.Create(self);
+ with lblName6 do
+ begin
+ Name := 'lblName6';
+ SetPosition(384, 288, 80, 16);
+ Text := 'Dial Gauge';
+ FontDesc := '#Label1';
+ end;
+
+ lblName7 := TfpgLabel.Create(self);
+ with lblName7 do
+ begin
+ Name := 'lblName7';
+ SetPosition(476, 100, 100, 16);
+ Text := 'Needle Gauge';
+ FontDesc := '#Label1';
+ end;
+
+ SmallNeedle := TfpgGauge.Create(self);
+ with SmallNeedle do
+ begin
+ Name := 'SmallNeedle';
+ SetPosition(504, 160, 64, 32);
+ Kind := gkNeedle;
+ end;
+
+ {@VFD_BODY_END: GaugeTest}
+end;
+
+procedure TGaugeTest.OnCloseClick(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure TGaugeTest.OnPlusClick(Sender: TObject);
+begin
+ TrackBar.Position:= TrackBar.Position + 5;
+ TrackBar.Invalidate;
+ OnTrackBarChange(self,TrackBar.Position);
+end;
+
+procedure TGaugeTest.OnMinusClick(Sender: TObject);
+begin
+ TrackBar.Position:= TrackBar.Position - 5;
+ TrackBar.Invalidate;
+ OnTrackBarChange(self,TrackBar.Position);
+end;
+
+procedure TGaugeTest.OnTrackBarChange(Sender: TObject; APosition: integer);
+begin
+ Gauge.Progress := APosition;
+ ProgressBar.Position := APosition;
+ VertGauge.Progress := APosition;
+ TextGauge.Progress := APosition;
+ NeedleGauge.Progress := APosition;
+ PieGauge.Progress := APosition;
+ DialGauge.Progress := APosition;
+ SmallNeedle.Progress := APosition;
+end;
+
+
+procedure MainProc;
+var
+ frm: TGaugeTest;
+begin
+ fpgApplication.Initialize;
+ frm := TGaugeTest.Create(nil);
+ try
+ frm.Show;
+ fpgApplication.Run;
+ finally
+ frm.Free;
+ end;
+end;
+
+
+begin
+ MainProc
+end.
+
+
diff --git a/extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpi b/extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpi
index 29fe7b8d..a1d58616 100644
--- a/extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpi
+++ b/extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpi
@@ -30,10 +30,10 @@
</RunParams>
<RequiredPackages Count="2">
<Item1>
- <PackageName Value="fpgui_package"/>
+ <PackageName Value="tiOPFfpGUI"/>
</Item1>
<Item2>
- <PackageName Value="tiOPFfpGUI"/>
+ <PackageName Value="fpgui_package"/>
</Item2>
</RequiredPackages>
<Units Count="2">
diff --git a/extras/tiopf/demos/Demo_06_CreateTable/frm_main.pas b/extras/tiopf/demos/Demo_06_CreateTable/frm_main.pas
index 7173bea4..87e2d08e 100644
--- a/extras/tiopf/demos/Demo_06_CreateTable/frm_main.pas
+++ b/extras/tiopf/demos/Demo_06_CreateTable/frm_main.pas
@@ -52,7 +52,7 @@ begin
LTableMetaData.Name:= 'Client';
LTableMetaData.AddField('OID', qfkString, 36); // Using GUID OIDs
LTableMetaData.AddField('Client_Name', qfkString, 200);
- LTableMetaData.AddField('ACN', qfkString, 9);
+ LTableMetaData.AddField('Client_ID', qfkString, 9);
gTIOPFManager.CreateTable(LTableMetaData);
finally
LTableMetaData.Free;
diff --git a/src/gui/fpgui_package.lpk b/src/gui/fpgui_package.lpk
index f65ccde6..80dc2a9a 100644
--- a/src/gui/fpgui_package.lpk
+++ b/src/gui/fpgui_package.lpk
@@ -26,7 +26,7 @@
<License Value="Modified LGPL
"/>
<Version Minor="5" Release="1"/>
- <Files Count="27">
+ <Files Count="28">
<Item1>
<Filename Value="gui_button.pas"/>
<UnitName Value="gui_button"/>
@@ -135,15 +135,19 @@
<Filename Value="gui_popupcalendar.pas"/>
<UnitName Value="gui_popupcalendar"/>
</Item27>
+ <Item28>
+ <Filename Value="gui_gauge.pas"/>
+ <UnitName Value="gui_gauge"/>
+ </Item28>
</Files>
<RequiredPkgs Count="2">
<Item1>
- <PackageName Value="fpgfx_package"/>
- <MinVersion Minor="5" Valid="True"/>
- </Item1>
- <Item2>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
+ </Item1>
+ <Item2>
+ <PackageName Value="fpgfx_package"/>
+ <MinVersion Minor="5" Valid="True"/>
</Item2>
</RequiredPkgs>
<UsageOptions>
diff --git a/src/gui/fpgui_package.pas b/src/gui/fpgui_package.pas
index bc3ab192..ad9e692a 100644
--- a/src/gui/fpgui_package.pas
+++ b/src/gui/fpgui_package.pas
@@ -11,7 +11,7 @@ uses
gui_listbox, gui_memo, gui_scrollbar, gui_bevel, gui_checkbox,
gui_radiobutton, gui_trackbar, gui_tab, gui_basegrid, gui_listview,
gui_customgrid, gui_progressbar, gui_menu, gui_style, gui_grid, gui_tree,
- gui_iniutils, gui_mru, fpgui_db, gui_popupcalendar;
+ gui_iniutils, gui_mru, fpgui_db, gui_popupcalendar, gui_gauge;
implementation
diff --git a/src/gui/gui_gauge.pas b/src/gui/gui_gauge.pas
new file mode 100644
index 00000000..68c4da2e
--- /dev/null
+++ b/src/gui/gui_gauge.pas
@@ -0,0 +1,543 @@
+{
+ fpGUI - Free Pascal GUI Library
+
+ Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this
+ distribution, for details of the copyright.
+
+ See the file COPYING.modifiedLGPL, included in this distribution,
+ for details about redistributing fpGUI.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ Description:
+ A Gauge component that supports different display styles. eg: Needle,
+ Dial, Pie etc.
+}
+
+unit gui_gauge;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, math,
+ fpgfx,
+ gfxbase,
+ gfx_widget;
+
+type
+
+ TGaugeKind = (gkText, gkHorizontalBar, gkVerticalBar, gkPie, gkNeedle, gkDial);
+
+ TBorderStyle = (bsNone, bsSingle, bsDouble, bsRaisedPanel, bsSunkenPanel,
+ bsRaised3D, bsSunken3D, bsEtched, bsEmmbossed);
+
+
+ TfpgGauge = class(TfpgWidget)
+ private
+ FFont: TfpgFont;
+ FClientRect: TfpgRect;
+ FMin: Longint;
+ FMax: Longint;
+ FPosition: Longint;
+ FKind: TGaugeKind;
+ FShowText: Boolean;
+ {TODO _ Implement Border style }
+ FBorderStyle: TBorderStyle;
+ FColor: TfpgColor; // Background color
+ { Currently little used colors, should be derived from style and possibly
+ overriden by user TODO - How to deal with gradients? Starting color and compute ending,
+ or give pair? }
+ FFirstColor: TfpgColor; // Text and Needle color
+ FSecondColor: TfpgColor; // Bar, Pie etc. main color
+ { Currently unused - TODO - Implement Low Watermark and High Watermark }
+ FLWMColor: TfpgColor; // Low Watermark Color
+ FLWMValue: Longint; // Low Watermark Value
+ FHWMColor: TfpgColor; // High Watermark Color
+ FHWMValue: Longint; // High Watermark Color
+ procedure BackgroundDraw;
+ procedure TextDraw;
+ procedure BarDraw;
+ procedure PieDraw;
+ procedure NeedleDraw;
+ procedure DialDraw;
+ procedure SetGaugeKind(AValue: TGaugeKind);
+ procedure SetShowText(AValue: Boolean);
+ procedure SetBorderStyle(AValue: TBorderStyle);
+ procedure SetFirstColor(AValue: TfpgColor);
+ procedure SetSecondColor(AValue: TfpgColor);
+ procedure SetMin(AValue: Longint);
+ procedure SetMax(AValue: Longint);
+ procedure SetProgress(AValue: Longint);
+ function GetPercentage: Longint;
+ protected
+ procedure HandlePaint; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure AddProgress(AValue: Longint);
+ property Percentage: Longint read GetPercentage;
+ published
+ property Align;
+ property Anchors;
+ property SecondColor: TfpgColor read FSecondColor write SetSecondColor default clWhite;
+ property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
+ property Color: TfpgColor read FColor write FColor default clButtonFace;
+ property Enabled;
+ property FirstColor: TfpgColor read FFirstColor write SetFirstColor default clBlack;
+ property Font: TfpgFont read FFont;
+ property Kind: TGaugeKind read FKind write SetGaugeKind default gkHorizontalBar;
+ property MinValue: Longint read FMin write SetMin default 0;
+ property MaxValue: Longint read FMax write SetMax default 100;
+ property Progress: Longint read FPosition write SetProgress;
+ property ShowText: Boolean read FShowText write SetShowText default True;
+ property Visible;
+ end;
+
+
+// A convenience function to quickly create a gauge from code
+function CreateGauge (AOwner: TComponent; ALeft, ATop, AWidth,
+ AHeight: TfpgCoord; AKind: TGaugeKind ): TfpgGauge;
+
+
+implementation
+
+{ This procedure draws a filled arc with a color gradient -
+ to be moved in CanvasBase? }
+procedure FillArcGradient(canvas: TfpgCanvas; X,Y,W,H: TfpgCoord; a1,a2: double; Astart,Astop: TfpgColor);
+var
+ RGBStart: TRGBTriple;
+ RGBStop: TRGBTriple;
+ RDiff, GDiff, BDiff: Integer;
+ count: Integer;
+ i: Integer;
+ newcolor: TRGBTriple;
+begin
+ if Astart = Astop then
+ begin { No gradient, just solid color}
+ canvas.SetColor(Astart);
+ canvas.FillArc(X, Y, W, H, a1, a2);
+ Exit; //==>
+ end;
+
+ RGBStart := fpgColorToRGBTriple(fpgColorToRGB(AStart));
+ RGBStop := fpgColorToRGBTriple(fpgColorToRGB(AStop));
+
+ count := min(H,W);
+ count := count div 2;
+ count := count -2 ;
+
+ RDiff := RGBStop.Red - RGBStart.Red;
+ GDiff := RGBStop.Green - RGBStart.Green;
+ BDiff := RGBStop.Blue - RGBStart.Blue;
+
+
+ { X11 draws arcs at one pixel distance without leaving out pixels, so Line Width
+ of 1 would be appropriate, but GDI doesn't, and therefore Line Width 2 is
+ required to make both work}
+
+ //canvas.SetLineStyle(1,lsSolid);
+ canvas.SetLineStyle(2,lsSolid);
+ for i := 0 to count do
+ begin
+ X := X + 1;
+ Y := Y + 1;
+ W := W - 2;
+ H := H - 2;
+ newcolor.Red := RGBStart.Red + (i * RDiff) div count;
+ newcolor.Green := RGBStart.Green + (i * GDiff) div count;
+ newcolor.Blue := RGBStart.Blue + (i * BDiff) div count;
+ canvas.SetColor(RGBTripleTofpgColor(newcolor));
+ canvas.DrawArc(X, Y, W, H, a1, a2);
+ end;
+end;
+
+function CreateGauge(AOwner: TComponent; ALeft, ATop, AWidth, AHeight: TfpgCoord;
+ AKind: TGaugeKind): TfpgGauge;
+begin
+ Result := TfpgGauge.Create(AOwner);
+ Result.Left := ALeft;
+ Result.Top := ATop;
+ Result.Width := AWidth;
+ Result.Height := AHeight;
+ Result.Kind := AKind;
+end;
+
+{ TfpgGauge }
+
+{ Drawing procedures - they're called from HandlePaint, which takes care of
+ canvas.BeginDraw and Canvas.EndDraw - Shouldn't be used otherwise. }
+procedure TfpgGauge.BackgroundDraw;
+begin
+ {common Background for all kinds }
+
+ {Client area is Widget area, to start with}
+ FClientRect.SetRect(0, 0, Width, Height);
+ Canvas.ClearClipRect;
+ Canvas.Clear(Color);
+ { This must be adjusted according the selected style }
+ Canvas.SetColor(TfpgColor($999999));
+ Canvas.SetLineStyle(1, lsSolid);
+ Canvas.DrawRectangle(FClientRect);
+ { This must be completed and adjusted with border style }
+ InflateRect(FClientRect, -1, -1);
+ with FClientRect do
+ begin
+ { Kind specific Bacground }
+ case FKind of
+ { Currently Text doesn't require additional Bacground }
+ { And so horizontal and vertical bar - Unless style requires it}
+ gkHorizontalBar,
+ gkVerticalBar:
+ begin
+ Canvas.SetLineStyle(1, lsSolid); // just in case background changed that
+ end;
+ gkPie:
+ begin
+ { Round frame for the Pie }
+ Canvas.SetLineStyle(2, lsSolid);
+ Canvas.SetColor(TfpgColor($98b2ed));
+ Canvas.DrawArc(Left, Top, Width, Height , 0, 360);
+ end;
+ gkNeedle:
+ begin
+ { Half a filled circle background for needle }
+ FillArcGradient (Canvas,Left, Top, Width, Height * 2 -1, 0, 180,TfpgColor($425d9b),TfpgColor($98b2ed));
+ Canvas.SetLineStyle(2, lsSolid);
+ //Canvas.SetColor(TfpgColor($3b4c71));
+ Canvas.SetColor(TfpgColor($98b2ed));
+ Canvas.DrawArc(Left, Top, Width, Height * 2 - 1, 0, 180);
+ Canvas.SetLineStyle(1, lsSolid);
+ Canvas.SetColor(TfpgColor($3b4c71));
+ Canvas.DrawLine(Left, Bottom,Left + Width, Bottom);
+ end;
+ gkDial:
+ begin
+ { 270° pie shaped background for Dial }
+ FillArcGradient (Canvas,Left, Top, Width, Height , 225, -270 ,TfpgColor($425d9b),TfpgColor($98b2ed));
+ Canvas.SetLineStyle(2, lsSolid);
+ //Canvas.SetColor(TfpgColor($3b4c71));
+ Canvas.SetColor(TfpgColor($98b2ed));
+ Canvas.DrawArc(Left,Top,Width,Height,225,-270);
+ end;
+ end;
+ end; { with }
+end;
+
+procedure TfpgGauge.TextDraw;
+var
+ S: string;
+ X, Y: Integer;
+begin
+ S := Format('%d%%', [Percentage]);
+ with FClientRect do
+ begin
+ X := (Width - FFont.TextWidth(S)) div 2;
+ Y := (Height - FFont.Height) div 2;
+ if Kind = gkDial then
+ Y := Y + (Y div 2);
+ end;
+{ If contrast is poor we might use a Xor function }
+ Canvas.SetTextColor(FirstColor);
+ Canvas.Font := FFont;
+ Canvas.DrawString(x, y, S);
+end;
+
+procedure TfpgGauge.BarDraw;
+var
+ BarLength: Longint;
+ SavedRect: TfpgRect;
+begin
+ SavedRect := FClientRect; // save client rect for text !!
+ with FClientRect do
+ begin
+ case FKind of
+ gkHorizontalBar:
+ begin
+ BarLength := Longint(Trunc( (Width * Percentage) / 100.0 ) );
+ if BarLength > 0 then
+ begin
+ if BarLength > Width then
+ BarLength := Width;
+ Width := BarLength;
+ // left top
+ Canvas.SetColor(TfpgColor($98b2ed));
+ Canvas.DrawLine(Left, Bottom, Left, Top); // left
+ Canvas.DrawLine(Left, Top, Right, Top); // top
+ // right bottom
+ Canvas.SetColor(TfpgColor($3b4c71));
+ Canvas.DrawLine(Right, Top, Right, Bottom); // right
+ Canvas.DrawLine(Right, Bottom, Left-1, Bottom); // bottom
+ // inside gradient fill
+ InflateRect(FClientRect, -1, -1);
+ Canvas.GradientFill(FClientRect, TfpgColor($425d9b), TfpgColor($97b0e8), gdVertical);
+ end; { if }
+ end;
+ gkVerticalBar:
+ begin
+ BarLength := Longint(Trunc( (Height * Percentage) / 100.0 ) );
+ if BarLength > 0 then
+ begin
+ if BarLength > Height then
+ BarLength := Height;
+ Top := Height - BarLength;
+ Height := BarLength;
+ // left top
+ Canvas.SetColor(TfpgColor($98b2ed));
+ Canvas.DrawLine(Left, Bottom, Left, Top); // left
+ Canvas.DrawLine(Left, Top, Right, Top); // top
+ // right bottom
+ Canvas.SetColor(TfpgColor($3b4c71));
+ Canvas.DrawLine(Right, Top, Right, Bottom); // right
+ Canvas.DrawLine(Right, Bottom, Left-1, Bottom); // bottom
+ // inside gradient fill
+ InflateRect(FClientRect, -1, -1);
+ Canvas.GradientFill(FClientRect, TfpgColor($425d9b), TfpgColor($97b0e8), gdHorizontal);
+ end;
+ end; { if }
+ end; { case }
+ end; { with }
+ FClientRect := SavedRect;
+end;
+
+procedure TfpgGauge.PieDraw;
+var
+ Angle: Double;
+begin
+ with FClientRect do
+ begin
+ Angle := Percentage;
+ Angle := Angle * 3.6; // Percentage to degrees
+ Canvas.SetColor(TfpgColor($425d9b));
+ FillArcGradient (Canvas,Left, Top, Width, Height , 90, -Angle,TfpgColor($425d9b),TfpgColor($98b2ed));
+ end;
+end;
+
+procedure TfpgGauge.NeedleDraw;
+var
+ Center: TPoint;
+ Radius: TPoint;
+ Angle: Double;
+begin
+ with FClientRect do
+ begin
+ if Percentage > 0 then
+ begin
+ { Compute the center }
+ Center := CenterPoint(Rect(Left,Top,Width,Height));
+ { Make needle 4 pixel shorter than gauge radius to accomodate border }
+ Radius.X := Center.X - 4;
+ Radius.Y := (Bottom - 4);
+ Canvas.SetLineStyle(2,lsSolid);
+ Angle := (Pi * ((Percentage / 100.0))); // percentage to radiants
+ Canvas.SetColor(TfpgColor($3b4c71));
+ Canvas.SetLineStyle(2,lsSolid);
+ Canvas.DrawLine(Center.X, FClientRect.Bottom,
+ Integer(round(Center.X - (Radius.X * Cos(Angle)))),
+ Integer(round((FClientRect.Bottom) - (Radius.Y * Sin(Angle)))));
+ end;
+ end;
+end;
+
+procedure TfpgGauge.DialDraw;
+var
+ Center: TPoint;
+ Radius: TPoint;
+ Angle: Double;
+ CenterDot: Integer;
+begin
+ with FClientRect do
+ begin
+ if Percentage >= 0 then
+ begin
+ { Compute the center }
+ Center := CenterPoint(Rect(Left,Top,Width,Height));
+ { Make needle 3 pixel shorter than gauge radius }
+ Radius.X := Center.X -3;
+ Radius.Y := Center.Y -3;
+ {compute centre circle size}
+ CenterDot := (Width + Height) div 40; // approx. scaled to 1/10 of widget size:
+ if CenterDot < 2 then
+ CenterDot := 2;
+ { draw needle centre circle }
+ Canvas.SetColor(TfpgColor($3b4c71));
+ Canvas.FillArc(Center.X - CenterDot, Center.Y - CenterDot,CenterDot * 2, CenterDot * 2,0,360);
+ { draw needle }
+ Angle := (Pi * ((Percentage / (100 * 2 / 3)) + -0.25));
+ Canvas.SetLineStyle(2,lsSolid);
+ Canvas.DrawLine(Center.X, Center.Y,
+ Integer(round(Center.X - ( Radius.X * cos(Angle)))),
+ Integer(round((Center.Y) - (Radius.Y * Sin(Angle)))));
+ end; { if }
+ end; { with }
+end;
+
+procedure TfpgGauge.HandlePaint;
+begin
+ inherited HandlePaint;
+ Canvas.BeginDraw(True);
+ {Paint Background and adjust FClientRect according style and BorderStyle}
+ BackgroundDraw;
+ {Paint foreground according selected Kind}
+ case FKind of
+ gkHorizontalBar,
+ gkVerticalBar:
+ BarDraw;
+ gkPie:
+ PieDraw;
+ gkNeedle:
+ NeedleDraw;
+ gkDial:
+ DialDraw;
+ end;
+ {Add Text if required}
+ if ShowText then
+ TextDraw;
+ Canvas.EndDraw;
+end;
+
+procedure TfpgGauge.SetGaugeKind(AValue: TGaugeKind);
+begin
+ if AValue <> FKind then
+ begin
+ FKind := AValue;
+ RePaint;
+ end;
+end;
+
+procedure TfpgGauge.SetShowText(AValue: Boolean);
+begin
+ if AValue <> FShowText then
+ begin
+ FShowText := AValue;
+ RePaint;
+ end;
+end;
+
+procedure TfpgGauge.SetBorderStyle(AValue: TBorderStyle);
+begin
+ if AValue <> FBorderStyle then
+ begin
+ FBorderStyle := AValue;
+ {TODO - Implement Border style }
+ // Graeme: Wouldn't descending from TfpgBevel give you this functionality already?
+ // It could be a option.
+ //RePaint;
+ end;
+end;
+
+procedure TfpgGauge.SetFirstColor(AValue: TfpgColor);
+begin
+ if AValue <> FFirstColor then
+ begin
+ FFirstColor := AValue;
+ {TODO - allow user colors}
+ //RePaint;
+ end;
+end;
+
+procedure TfpgGauge.SetSecondColor(AValue: TfpgColor);
+begin
+ if AValue <> FSecondColor then
+ begin
+ FSecondColor := AValue;
+ {TODO - allow user colors}
+ //RePaint;
+ end;
+end;
+
+procedure TfpgGauge.SetMin(AValue: Longint);
+begin
+ if AValue <> FMin then
+ begin
+ // correct input errors
+ if AValue > FMax then
+ if not (csLoading in ComponentState) then
+ FMax := AValue + 1;
+ if FPosition < AValue then
+ FPosition := AValue;
+ // then update
+ FMin := AValue;
+ RePaint;
+ end;
+end;
+
+procedure TfpgGauge.SetMax(AValue: Longint);
+begin
+ if AValue <> FMax then
+ begin
+ // correct input errors
+ if AValue < FMin then
+ if not (csLoading in ComponentState) then
+ FMin := AValue - 1;
+ if FPosition > AValue then
+ FPosition := AValue;
+ // then update
+ FMax := AValue;
+ RePaint;
+ end;
+end;
+
+procedure TfpgGauge.SetProgress(AValue: Longint);
+var
+ CurrPercentage: Longint;
+ MustRepaint: Boolean;
+begin
+ CurrPercentage := GetPercentage;
+ MustRepaint := False;
+
+ if AValue < FMin then
+ AValue := FMin
+ else if AValue > FMax then
+ AValue := FMax;
+
+ if FPosition <> AValue then
+ begin // Value has changed
+ FPosition := AValue;
+ if CurrPercentage <> Percentage then // Visible value has changed
+ MustRepaint := True;
+ { TODO Check against low and high watermarks }
+ end;
+ if MustRepaint then
+ RePaint;
+end;
+
+function TfpgGauge.GetPercentage: Longint;
+Var
+ V,T: Longint;
+begin
+ T := FMax - FMin;
+ V := FPosition - FMin;
+ if T = 0 then
+ Result := 0
+ else
+ Result := Longint(Trunc( (V * 100.0) / T ));
+end;
+
+constructor TfpgGauge.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ Focusable := False;
+ FWidth := 100;
+ FHeight := 25;
+ FKind := gkHorizontalBar;
+ FSecondColor := clWhite;
+ FFirstColor := clBlack;
+ FColor := TfpgColor($c4c4c4); //clInactiveWgFrame;
+ FMax := 100;
+ FMin := 0;
+ FPosition := 0;
+ FShowText := True;
+ FBorderStyle := bsNone;
+ FFont := fpgStyle.DefaultFont;
+end;
+
+procedure TfpgGauge.AddProgress(AValue: Longint);
+begin
+ Progress := FPosition + AValue;
+end;
+
+end.
+