diff options
-rw-r--r-- | AUTHORS.txt | 2 | ||||
-rw-r--r-- | examples/gui/gauges/extrafpc.cfg | 5 | ||||
-rw-r--r-- | examples/gui/gauges/gaugetest.lpi | 58 | ||||
-rw-r--r-- | examples/gui/gauges/gaugetest.lpr | 296 | ||||
-rw-r--r-- | extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpi | 4 | ||||
-rw-r--r-- | extras/tiopf/demos/Demo_06_CreateTable/frm_main.pas | 2 | ||||
-rw-r--r-- | src/gui/fpgui_package.lpk | 14 | ||||
-rw-r--r-- | src/gui/fpgui_package.pas | 2 | ||||
-rw-r--r-- | src/gui/gui_gauge.pas | 543 |
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. + |