diff options
-rw-r--r-- | docs/fpGUIHelpIntegration.lpk | 2 | ||||
-rw-r--r-- | docs/manifest.xml | 4 | ||||
-rw-r--r-- | docview/src/docview.rc | 8 | ||||
-rw-r--r-- | examples/gui/togglebox/ToggleBoxTest.lpi | 77 | ||||
-rw-r--r-- | examples/gui/togglebox/ToggleBoxTest.lpr | 30 | ||||
-rw-r--r-- | examples/gui/togglebox/mainfrm.pas | 44 | ||||
-rw-r--r-- | src/VERSION_FILE.inc | 2 | ||||
-rw-r--r-- | src/corelib/fpg_csvparser.pas | 320 | ||||
-rw-r--r-- | src/corelib/fpg_main.pas | 6 | ||||
-rw-r--r-- | src/corelib/fpg_widget.pas | 2 | ||||
-rw-r--r-- | src/corelib/gdi/fpgui_toolkit.lpk | 16 | ||||
-rw-r--r-- | src/corelib/gdi/fpgui_toolkit.pas | 3 | ||||
-rw-r--r-- | src/corelib/x11/fpg_x11.pas | 2 | ||||
-rw-r--r-- | src/corelib/x11/fpgui_toolkit.lpk | 16 | ||||
-rw-r--r-- | src/corelib/x11/fpgui_toolkit.pas | 5 | ||||
-rw-r--r-- | src/gui/fpg_checkbox.pas | 7 | ||||
-rw-r--r-- | src/gui/fpg_customgrid.pas | 2 | ||||
-rw-r--r-- | src/gui/fpg_stringgridbuilder.pas | 178 | ||||
-rw-r--r-- | src/gui/fpg_toggle.pas | 282 | ||||
-rw-r--r-- | uidesigner/icons.inc | 113 | ||||
-rw-r--r-- | uidesigner/images/toggle.bmp | bin | 0 -> 1850 bytes | |||
-rw-r--r-- | uidesigner/vfdwidgets.pas | 31 |
22 files changed, 1132 insertions, 18 deletions
diff --git a/docs/fpGUIHelpIntegration.lpk b/docs/fpGUIHelpIntegration.lpk index 81c16ce8..7c06a92a 100644 --- a/docs/fpGUIHelpIntegration.lpk +++ b/docs/fpGUIHelpIntegration.lpk @@ -24,7 +24,7 @@ "/> <License Value="LGPL "/> - <Version Major="1" Minor="2"/> + <Version Major="1" Minor="3"/> <Files Count="1"> <Item1> <Filename Value="pkghelpfpGUI.pas"/> diff --git a/docs/manifest.xml b/docs/manifest.xml index addb40c3..fc0d48a0 100644 --- a/docs/manifest.xml +++ b/docs/manifest.xml @@ -1,8 +1,8 @@ <?xml version="1.0"?> <packages> <package name="fpgui"> - <version major="1" minor="2" micro="0" build="0"/> - <filename>fpgui-1.2.0-0.zip</filename> + <version major="1" minor="3" micro="0" build="0"/> + <filename>fpgui-1.3.0-0.zip</filename> <author>Graeme Geldenhuys</author> <license>Modified LGPL</license> <email>graemeg@gmail.com</email> diff --git a/docview/src/docview.rc b/docview/src/docview.rc index 749a08de..24dc3cfe 100644 --- a/docview/src/docview.rc +++ b/docview/src/docview.rc @@ -1,8 +1,8 @@ MAINICON ICON "../images/docview-48x48.ico" 1 VERSIONINFO -FILEVERSION 1, 2, 0, 0 -PRODUCTVERSION 1, 2, 0, 0 +FILEVERSION 1, 3, 0, 0 +PRODUCTVERSION 1, 3, 0, 0 FILEFLAGSMASK 0 FILEOS 0x40000 FILETYPE 1 @@ -13,12 +13,12 @@ FILETYPE 1 { VALUE "CompanyName", "fpGUI Toolkit" VALUE "FileDescription", "fpGUI's INF Documentation Viewer" - VALUE "FileVersion", "1.2.0" + VALUE "FileVersion", "1.3.0" VALUE "InternalName", "docview" VALUE "LegalCopyright", "GNU Public License" VALUE "OriginalFilename", "docview" VALUE "ProductName", "fpGUI Toolkit" - VALUE "ProductVersion", "1.2.0" + VALUE "ProductVersion", "1.3.0" } } BLOCK "VarFileInfo" diff --git a/examples/gui/togglebox/ToggleBoxTest.lpi b/examples/gui/togglebox/ToggleBoxTest.lpi new file mode 100644 index 00000000..327b4258 --- /dev/null +++ b/examples/gui/togglebox/ToggleBoxTest.lpi @@ -0,0 +1,77 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="9"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="ToggleBoxTest"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication Use="True" PathPlusParams="/usr/bin/gnome-terminal -t 'Lazarus Run Output' -e '$(LazarusDir)/tools/runwait.sh $(TargetCmdLine)'"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="fpgui_toolkit"/> + </Item1> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="ToggleBoxTest.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="mainfrm.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="mainfrm"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="ToggleBoxTest"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Other> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/examples/gui/togglebox/ToggleBoxTest.lpr b/examples/gui/togglebox/ToggleBoxTest.lpr new file mode 100644 index 00000000..8866f9c5 --- /dev/null +++ b/examples/gui/togglebox/ToggleBoxTest.lpr @@ -0,0 +1,30 @@ +program ToggleBoxTest; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX} + cthreads, + {$ENDIF} + Classes, + fpg_main, + mainfrm; + +procedure MainProc; +var + frmMain: TfrmMain; +begin + fpgApplication.Initialize; + frmMain:= TfrmMain.Create(nil); + try + frmMain.Show; + fpgApplication.Run; + finally + frmMain.Free; + end; +end; + +begin + MainProc; +end. + diff --git a/examples/gui/togglebox/mainfrm.pas b/examples/gui/togglebox/mainfrm.pas new file mode 100644 index 00000000..ff9a43da --- /dev/null +++ b/examples/gui/togglebox/mainfrm.pas @@ -0,0 +1,44 @@ +unit mainfrm; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fpg_base, fpg_form, fpg_toggle; + +type + + { TfrmMain } + + TfrmMain = class(TfpgForm) + private + FToggle: TfpgToggle; + public + constructor Create(AOwner: TComponent); override; + end; + + +implementation + +{ TfrmMain } + +constructor TfrmMain.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + WindowTitle:='Yay a toggle!'; + SetWidth(300); + SetHeight(200); + + FToggle := TfpgToggle.Create(Self); + FToggle.SetPosition(10, 10, 200, 20); +// FToggle.Width:=200; + + //FToggle.ToggleSide:=tsLeft; + //FToggle.ToggleWidth:=100; + //FToggle.UseAnimation:=False; + +end; + +end. + diff --git a/src/VERSION_FILE.inc b/src/VERSION_FILE.inc index b0593919..518bafb7 100644 --- a/src/VERSION_FILE.inc +++ b/src/VERSION_FILE.inc @@ -1 +1 @@ -FPGUI_VERSION = '1.2'; +FPGUI_VERSION = '1.3'; diff --git a/src/corelib/fpg_csvparser.pas b/src/corelib/fpg_csvparser.pas new file mode 100644 index 00000000..f5c0d0ed --- /dev/null +++ b/src/corelib/fpg_csvparser.pas @@ -0,0 +1,320 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2014 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: + Uses a Finite State Machine to parse CSV files. + Graeme Geldenhuys <graemeg@gmail.com> + + This unit shows how one could use the State Design Pattern to implement a + FSM (Finite State Machine) to create a CSV Parser. It handles invalid + CSV as well and will raise an appropriate exception. In the State pattern, + each of the states becomes a subclass of the base class. Each subclass must + implement the abstract method which will handle the input character and + decide on the next state. +} + +unit fpg_CSVParser; + +{$mode objfpc}{$H+} + +interface + +uses + Classes; + +type + { forward declarations } + TCSVParser = class; + TParserStateClass = class of TCSVParserState; + + + { Abstract State object } + TCSVParserState = class(TObject) + private + FParser: TCSVParser; + procedure ChangeState(NewState: TParserStateClass); + procedure AddCharToCurrField(Ch: char); + procedure AddCurrFieldToList; + public + constructor Create(AParser: TCSVParser); + { Must be implemented in the concrete classes to handle the input character + and decide on the next state. } + procedure ProcessChar(Ch: AnsiChar; Pos: integer); virtual; abstract; + end; + + + { A concrete state object - used when starting a new field } + TCSVParserFieldStartState = class(TCSVParserState) + public + procedure ProcessChar(Ch: AnsiChar; Pos: integer); override; + end; + + + { A concrete state object - used while scanning a field } + TCSVParserScanFieldState = class(TCSVParserState) + public + procedure ProcessChar(Ch: AnsiChar; Pos: integer); override; + end; + + + { A concrete state object - used while scanning double quoted fields } + TCSVParserScanQuotedState = class(TCSVParserState) + public + procedure ProcessChar(Ch: AnsiChar; Pos: integer); override; + end; + + + { A concrete state object - used when found the ending double quote } + TCSVParserEndQuotedState = class(TCSVParserState) + public + procedure ProcessChar(Ch: AnsiChar; Pos: integer); override; + end; + + + { A concrete state object - some error occured / invalid CSV structure } + TCSVParserGotErrorState = class(TCSVParserState) + public + procedure ProcessChar(Ch: AnsiChar; Pos: integer); override; + end; + + + { The actual state machine - CSV parser } + TCSVParser = class(TObject) + private + FCurrentLine: string; + FState: TCSVParserState; + { Cache state objects for greater performance. This comes in handy when + parsing a large CSV file. For smaller files you might want to create them + on the fly. } + FFieldStartState: TCSVParserFieldStartState; + FScanFieldState: TCSVParserScanFieldState; + FScanQuotedState: TCSVParserScanQuotedState; + FEndQuotedState: TCSVParserEndQuotedState; + FGotErrorState: TCSVParserGotErrorState; + { Fields used during parsing } + FCurrField: string; + FFieldList: TStrings; + function GetState: TParserStateClass; + procedure SetState(const Value: TParserStateClass); + protected + procedure AddCharToCurrField(Ch: char); + procedure AddCurrFieldToList; + { An example of Self Encapsulating Field refactoring } + property State: TParserStateClass read GetState write SetState; + public + constructor Create; + destructor Destroy; override; + { prodecure to call, to start the parsing process } + procedure ExtractFields(const S: string; const pFieldList: TStrings); + property CurrentLine: string read FCurrentLine; + end; + + +// global singleton function +function gCSVParser: TCSVParser; + + +implementation + +uses + SysUtils; + +var + uCSVParser: TCSVParser; + + +// Lazy mans singleton +function gCSVParser: TCSVParser; +begin + if uCSVParser = nil then + uCSVParser := TCSVParser.Create; + Result := uCSVParser; +end; + +{ TCSVParser } + +constructor TCSVParser.Create; +begin + inherited Create; + FCurrentLine := ''; + FFieldStartState := TCSVParserFieldStartState.Create(Self); + FScanFieldState := TCSVParserScanFieldState.Create(Self); + FScanQuotedState := TCSVParserScanQuotedState.Create(Self); + FEndQuotedState := TCSVParserEndQuotedState.Create(Self); + FGotErrorState := TCSVParserGotErrorState.Create(Self); +end; + +destructor TCSVParser.Destroy; +begin + FFieldStartState.Free; + FScanFieldState.Free; + FScanQuotedState.Free; + FEndQuotedState.Free; + FGotErrorState.Free; + inherited; +end; + +function TCSVParser.GetState: TParserStateClass; +begin + Result := TParserStateClass(FState.ClassType); +end; + +procedure TCSVParser.SetState(const Value: TParserStateClass); +begin + if Value = TCSVParserFieldStartState then + FState := FFieldStartState + else if Value = TCSVParserScanFieldState then + FState := FScanFieldState + else if Value = TCSVParserScanQuotedState then + FState := FScanQuotedState + else if Value = TCSVParserEndQuotedState then + FState := FEndQuotedState + else if Value = TCSVParserGotErrorState then + FState := FGotErrorState; +end; + +procedure TCSVParser.ExtractFields(const S: string; const pFieldList: TStrings); +var + i: integer; + Ch: AnsiChar; +begin + FCurrentLine := S; + FFieldList := pFieldList; + Assert(Assigned(FFieldList), 'FieldList not assigned'); + { Initialize by clearing the string list, and starting in FieldStart state } + FFieldList.Clear; + State := TCSVParserFieldStartState; + FCurrField := ''; + + { Read through all the characters in the string } + for i := 1 to Length(s) do + begin + { Get the next character } + Ch := s[i]; + FState.ProcessChar(Ch, i); + end; + + { If we are in the ScanQuoted or GotError state at the end of the string, + there was a problem with a closing quote. You can add the second if test + for an extra failsafe! } + if (State = TCSVParserScanQuotedState) then + // or (State = TCSVParserGotErrorState) then + raise Exception.Create('Missing closing quote'); + + { If the current field is not empty, add it to the list } + if (FCurrField <> '') then + AddCurrFieldToList; +end; + +procedure TCSVParser.AddCharToCurrField(Ch: char); +begin + FCurrField := FCurrField + Ch; +end; + +procedure TCSVParser.AddCurrFieldToList; +begin + FFieldList.Add(FCurrField); + // Clear the field in preparation for collecting the next one + FCurrField := ''; +end; + +{ TCSVParserState } + +constructor TCSVParserState.Create(AParser: TCSVParser); +begin + inherited Create; + FParser := AParser; +end; + +procedure TCSVParserState.ChangeState(NewState: TParserStateClass); +begin + FParser.State := NewState; +end; + +procedure TCSVParserState.AddCharToCurrField(Ch: char); +begin + FParser.AddCharToCurrField(Ch); +end; + +procedure TCSVParserState.AddCurrFieldToList; +begin + FParser.AddCurrFieldToList; +end; + +{ TCSVParserFieldStartState } + +procedure TCSVParserFieldStartState.ProcessChar(Ch: AnsiChar; Pos: integer); +begin + case Ch of + '"': ChangeState(TCSVParserScanQuotedState); + ',': AddCurrFieldToList; + else + AddCharToCurrField(Ch); + ChangeState(TCSVParserScanFieldState); + end; +end; + +{ TCSVParserScanFieldState } + +procedure TCSVParserScanFieldState.ProcessChar(Ch: AnsiChar; Pos: integer); +begin + if (Ch = ',') then + begin + AddCurrFieldToList; + ChangeState(TCSVParserFieldStartState); + end + else + AddCharToCurrField(Ch); +end; + +{ TCSVParserScanQuotedState } + +procedure TCSVParserScanQuotedState.ProcessChar(Ch: AnsiChar; Pos: integer); +begin + if (Ch = '"') then + ChangeState(TCSVParserEndQuotedState) + else + AddCharToCurrField(Ch); +end; + +{ TCSVParserEndQuotedState } + +procedure TCSVParserEndQuotedState.ProcessChar(Ch: AnsiChar; Pos: integer); +begin + if (Ch = ',') then + begin + AddCurrFieldToList; + ChangeState(TCSVParserFieldStartState); + end + else + ChangeState(TCSVParserGotErrorState); +end; + +{ TCSVParserGotErrorState } + +procedure TCSVParserGotErrorState.ProcessChar(Ch: AnsiChar; Pos: integer); +begin + raise Exception.Create(Format('Error in line at position %d: ' + #10 + + '<%s>', [Pos, FParser.CurrentLine])); +end; + + +initialization + uCSVParser := nil; + +finalization + if uCSVParser <> nil then + uCSVParser.Free; + +end. + diff --git a/src/corelib/fpg_main.pas b/src/corelib/fpg_main.pas index c7275b14..7ba8a96a 100644 --- a/src/corelib/fpg_main.pas +++ b/src/corelib/fpg_main.pas @@ -203,6 +203,7 @@ type procedure DrawControlFrame(ACanvas: TfpgCanvas; r: TfpgRect); overload; function GetControlFrameBorders: TRect; virtual; procedure DrawBevel(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; ARaised: Boolean = True); virtual; + function GetBevelWidth: TfpgCoord; virtual; procedure DrawDirectionArrow(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; direction: TArrowDirection); virtual; procedure DrawString(ACanvas: TfpgCanvas; x, y: TfpgCoord; AText: string; AEnabled: boolean = True); virtual; procedure DrawFocusRect(ACanvas: TfpgCanvas; r: TfpgRect); virtual; @@ -2275,6 +2276,11 @@ begin ACanvas.DrawLine(r.Right, r.Bottom, r.Left-1, r.Bottom); end; +function TfpgStyle.GetBevelWidth: TfpgCoord; +begin + Result := 1; +end; + procedure TfpgStyle.DrawDirectionArrow(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; direction: TArrowDirection); var { diff --git a/src/corelib/fpg_widget.pas b/src/corelib/fpg_widget.pas index 527e2987..872ac2c8 100644 --- a/src/corelib/fpg_widget.pas +++ b/src/corelib/fpg_widget.pas @@ -176,7 +176,7 @@ type procedure KillFocus; procedure MoveAndResizeBy(const dx, dy, dw, dh: TfpgCoord); procedure SetPosition(aleft, atop, awidth, aheight: TfpgCoord); virtual; - procedure Invalidate; // double check this works as developers expect???? + procedure Invalidate; property FormDesigner: TObject read FFormDesigner write SetFormDesigner; property Parent: TfpgWidget read GetParent write SetParent; property AcceptDrops: boolean read FAcceptDrops write SetAcceptDrops default False; diff --git a/src/corelib/gdi/fpgui_toolkit.lpk b/src/corelib/gdi/fpgui_toolkit.lpk index dfe56c14..487a5e06 100644 --- a/src/corelib/gdi/fpgui_toolkit.lpk +++ b/src/corelib/gdi/fpgui_toolkit.lpk @@ -30,8 +30,8 @@ </CompilerOptions> <Description Value="fpGUI Toolkit"/> <License Value="LGPL 2 with static linking exception."/> - <Version Major="1" Minor="2"/> - <Files Count="104"> + <Version Major="1" Minor="3"/> + <Files Count="107"> <Item1> <Filename Value="..\stdimages.inc"/> <Type Value="Include"/> @@ -448,6 +448,18 @@ <Filename Value="..\..\gui\inputquerydialog.inc"/> <Type Value="Include"/> </Item104> + <Item105> + <Filename Value="..\..\gui\fpg_toggle.pas"/> + <UnitName Value="fpg_toggle"/> + </Item105> + <Item106> + <Filename Value="..\..\gui\fpg_stringgridbuilder.pas"/> + <UnitName Value="fpg_StringGridBuilder"/> + </Item106> + <Item107> + <Filename Value="..\fpg_csvparser.pas"/> + <UnitName Value="fpg_CSVParser"/> + </Item107> </Files> <LazDoc Paths="..\..\..\docs\xml\corelib;..\..\..\docs\xml\corelib\x11;..\..\..\docs\xml\corelib\gdi;..\..\..\docs\xml\gui"/> <RequiredPkgs Count="1"> diff --git a/src/corelib/gdi/fpgui_toolkit.pas b/src/corelib/gdi/fpgui_toolkit.pas index 12ac41b9..4704d56a 100644 --- a/src/corelib/gdi/fpgui_toolkit.pas +++ b/src/corelib/gdi/fpgui_toolkit.pas @@ -22,7 +22,8 @@ uses fpg_style_win2k, fpg_style_motif, fpg_style_clearlooks, fpg_style_bluecurve, fpg_style_bitmap, fpg_readonly, fpg_imgfmt_png, U_Command, U_Pdf, U_Report, U_ReportImages, U_Visu, fpg_trayicon, Agg2D, fpg_dbugintf, fpg_dbugmsg, - fpg_style_carbon, fpg_style_plastic, fpg_style_win8; + fpg_style_carbon, fpg_style_plastic, fpg_style_win8, fpg_toggle, + fpg_StringGridBuilder, fpg_CSVParser; implementation diff --git a/src/corelib/x11/fpg_x11.pas b/src/corelib/x11/fpg_x11.pas index 569772ae..c94cf1fb 100644 --- a/src/corelib/x11/fpg_x11.pas +++ b/src/corelib/x11/fpg_x11.pas @@ -1685,7 +1685,7 @@ begin OnIdle(self); fpFD_ZERO(rfds); fpFD_SET(xfd, rfds); - r := fpSelect(xfd + 1, @rfds, nil, nil, {atimeoutms} 50); + r := fpSelect(xfd + 1, @rfds, nil, nil, Min(atimeoutms, 50)); if r <> 0 then // We got a X event or the timeout happened XNextEvent(display, @ev) else diff --git a/src/corelib/x11/fpgui_toolkit.lpk b/src/corelib/x11/fpgui_toolkit.lpk index ec8c841f..e59e4617 100644 --- a/src/corelib/x11/fpgui_toolkit.lpk +++ b/src/corelib/x11/fpgui_toolkit.lpk @@ -28,8 +28,8 @@ </CompilerOptions> <Description Value="fpGUI Toolkit"/> <License Value="LGPL 2 with static linking exception."/> - <Version Major="1" Minor="2"/> - <Files Count="107"> + <Version Major="1" Minor="3"/> + <Files Count="110"> <Item1> <Filename Value="../stdimages.inc"/> <Type Value="Include"/> @@ -458,6 +458,18 @@ <Filename Value="../../gui/inputintegerdialog.inc"/> <Type Value="Include"/> </Item107> + <Item108> + <Filename Value="../../gui/fpg_toggle.pas"/> + <UnitName Value="fpg_toggle"/> + </Item108> + <Item109> + <Filename Value="../../gui/fpg_stringgridbuilder.pas"/> + <UnitName Value="fpg_StringGridBuilder"/> + </Item109> + <Item110> + <Filename Value="../fpg_csvparser.pas"/> + <UnitName Value="fpg_CSVParser"/> + </Item110> </Files> <LazDoc Paths="../../../docs/xml/corelib;../../../docs/xml/corelib/x11;../../../docs/xml/corelib/gdi;../../../docs/xml/gui"/> <RequiredPkgs Count="1"> diff --git a/src/corelib/x11/fpgui_toolkit.pas b/src/corelib/x11/fpgui_toolkit.pas index 86e456f4..be9f3b5a 100644 --- a/src/corelib/x11/fpgui_toolkit.pas +++ b/src/corelib/x11/fpgui_toolkit.pas @@ -22,8 +22,9 @@ uses fpg_stylemanager, fpg_style_win2k, fpg_style_motif, fpg_style_clearlooks, fpg_style_bluecurve, fpg_style_bitmap, fpg_readonly, fpg_imgfmt_png, U_Command, U_Pdf, U_Report, U_ReportImages, U_Visu, fpg_trayicon, Agg2D, - fpg_dbugintf, fpg_dbugmsg, fpg_fontcache, fpg_style_carbon, - fpg_style_plastic, fpg_style_win8, fpg_scrollframe; + fpg_dbugintf, fpg_dbugmsg, fpg_fontcache, fpg_style_carbon, + fpg_style_plastic, fpg_style_win8, fpg_scrollframe, fpg_toggle, + fpg_StringGridBuilder, fpg_CSVParser; implementation diff --git a/src/gui/fpg_checkbox.pas b/src/gui/fpg_checkbox.pas index 2b4b11d8..cd0e9920 100644 --- a/src/gui/fpg_checkbox.pas +++ b/src/gui/fpg_checkbox.pas @@ -50,6 +50,7 @@ type procedure SetText(const AValue: string); procedure DoOnChange; protected + procedure HandleCheckChanged; virtual; procedure HandlePaint; override; procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override; @@ -121,6 +122,7 @@ begin if FChecked = AValue then Exit; //==> FChecked := AValue; + HandleCheckChanged; RePaint; if not (csDesigning in ComponentState) then DoOnChange; @@ -173,6 +175,11 @@ begin FOnChange(self); end; +procedure TfpgBaseCheckBox.HandleCheckChanged; +begin + // nothing here for us +end; + procedure TfpgBaseCheckBox.HandlePaint; var r: TfpgRect; diff --git a/src/gui/fpg_customgrid.pas b/src/gui/fpg_customgrid.pas index 98040374..923bed91 100644 --- a/src/gui/fpg_customgrid.pas +++ b/src/gui/fpg_customgrid.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, diff --git a/src/gui/fpg_stringgridbuilder.pas b/src/gui/fpg_stringgridbuilder.pas new file mode 100644 index 00000000..fd3fe3b8 --- /dev/null +++ b/src/gui/fpg_stringgridbuilder.pas @@ -0,0 +1,178 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2014 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: + This unit defines a helper class that can populate a StringGrid + from a CSV file. In future this could be expaned to other file + types or even data structures. +} +unit fpg_StringGridBuilder; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, + SysUtils, + fpg_base, + fpg_grid; + +type + TStringGridBuilder = class(TObject) + private + FData: TStringList; + FGrid: TfpgStringGrid; + FCSVFile: TfpgString; + FHasHeader: boolean; + protected + procedure InternalSetupColumns; virtual; + procedure InternalSetupData; virtual; + procedure InternalRepaintRow(const AData: TfpgString; const ARow: integer); virtual; + public + constructor Create; + constructor CreateCustom(const AGrid: TfpgStringGrid; const ACSVFile: TfpgString; const AWithHeader: boolean = True); virtual; + destructor Destroy; override; + procedure Run; + property Grid: TfpgStringGrid read FGrid; + end; + +implementation + +uses + fpg_main, + fpg_utils, + fpg_CSVParser; + +{ TStringGridBuilder } + +procedure TStringGridBuilder.InternalSetupColumns; +var + x: integer; + fields: TStringList; +begin + fields := TStringList.Create; + try + gCsvParser.ExtractFields(FData[0], fields); + // setup correct column count + FGrid.ColumnCount := fields.Count; + // initialize columns + if FHasHeader then + begin + for x := 0 to fields.Count-1 do + begin + FGrid.ColumnTitle[x] := fields[x]; +// FGrid.ColumnWidth[x] := StrToInt(FColumns.ValueFromIndex[x]); + end; + end; + finally + fields.Free; + end; +end; + +procedure TStringGridBuilder.InternalSetupData; +var + y: integer; +begin + FGrid.BeginUpdate; + FGrid.MouseCursor := mcHourGlass; + try + try + // set correct row count. Columns have already been handled. + if FHasHeader then + begin + FGrid.RowCount := FData.Count-1; + for y := 1 to FData.Count-1 do // rows + begin + // writeln(' Row: ', y, ' Data: ', FData.Strings[y-1]); + InternalRepaintRow(FData.Strings[y], y-1); + end; + end + else + begin + FGrid.RowCount := FData.Count; + for y := 0 to FData.Count-1 do // rows + begin + // writeln(' Row: ', y, ' Data: ', FData.Strings[y-1]); + InternalRepaintRow(FData.Strings[y], y); + end; + end; + except + fpgApplication.HandleException(self); + end; + finally + if FGrid.RowCount > 0 then + FGrid.FocusRow := 0; + FGrid.EndUpdate; + FGrid.MouseCursor := mcDefault; + end; +end; + +procedure TStringGridBuilder.InternalRepaintRow(const AData: TfpgString; const ARow: integer); +var + x: integer; + fields: TStrings; + value: string; +begin + fields := TStringList.Create; + try + gCsvParser.ExtractFields(AData, fields); + for x := 0 to FGrid.ColumnCount-1 do + begin + if x < fields.Count then + value := fields.Strings[x] + else + value := ''; + FGrid.Cells[x, ARow] := value + end; + finally + fields.Free; + end; +end; + +constructor TStringGridBuilder.Create; +begin + FData := TStringList.Create; +end; + +constructor TStringGridBuilder.CreateCustom(const AGrid: TfpgStringGrid; const ACSVFile: TfpgString; const AWithHeader: boolean); +begin + Create; + FGrid := AGrid; + FCSVFile := ACSVFile; + FGrid.Clear; + FHasHeader := AWithHeader; + FGrid.ShowHeader := AWithHeader; +end; + +destructor TStringGridBuilder.Destroy; +begin + FGrid := nil; + FData.Free; + inherited Destroy; +end; + +procedure TStringGridBuilder.Run; +begin + if FCSVFile = '' then + raise Exception.Create('TStringGridBuilder: CSV filename is empty!'); + if not fpgFileExists(FCSVFile) then + raise Exception.CreateFmt('TStringGridBuilder: The CSV file <%s> does not exist.', [FCSVFile]); + FData.LoadFromFile(fpgToOSEncoding(FCSVFile)); + InternalSetupColumns; + InternalSetupData; +end; + + +end. + diff --git a/src/gui/fpg_toggle.pas b/src/gui/fpg_toggle.pas new file mode 100644 index 00000000..b35ca661 --- /dev/null +++ b/src/gui/fpg_toggle.pas @@ -0,0 +1,282 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2014 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. + + Original author: Andrew Haines + + Description: + Defines a ToggleBox control. A Checkbox like control that has an + animated bar that slides side to side when toggled. +} +unit fpg_toggle; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, + SysUtils, + fpg_base, + fpg_main, + fpg_stylemanager, + fpg_checkbox; + +type + + TfpgToggle = class(TfpgCheckBox) + private + FCheckedTextColor: TfpgColor; + FToggleWidth: TfpgCoord; + FToggleButtonWidth: TfpgCoord; + FAnimateTimer: TfpgTimer; + FCheckedCaption: TfpgString; + FCheckedColor: TfpgColor; + FSliderPosition: TfpgCoord; + FPaintedSliderPosition: TfpgCoord; + FUnCheckedCaption: TfpgString; + FUnCheckedColor: TfpgColor; + FUnCheckedTextColor: TfpgColor; + FUseAnimation: Boolean; + procedure SetCheckedCaption(AValue: TfpgString); + procedure SetCheckedColor(AValue: TfpgColor); + procedure SetCheckedTextColor(AValue: TfpgColor); + procedure SetToggleWidth(AValue: TfpgCoord); + procedure SetUnCheckedCaption(AValue: TfpgString); + procedure SetUnCheckedColor(AValue: TfpgColor); + procedure AnimateTimer(Sender: TObject); + procedure SetUnCheckedTextColor(AValue: TfpgColor); + function ToggleLeft: TfpgCoord; inline; + protected + procedure HandlePaint; override; + procedure HandleCheckChanged; override; + procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property UseAnimation: Boolean read FUseAnimation write FUseAnimation; + property ToggleWidth: TfpgCoord read FToggleWidth write SetToggleWidth default 45; + property CheckedCaption : TfpgString read FCheckedCaption write SetCheckedCaption; + property CheckedColor: TfpgColor read FCheckedColor write SetCheckedColor default clLime; + property CheckedTextColor: TfpgColor read FCheckedTextColor write SetCheckedTextColor default clHilite2; + property UnCheckedCaption: TfpgString read FUnCheckedCaption write SetUnCheckedCaption; + property UnCheckedColor: TfpgColor read FUnCheckedColor write SetUnCheckedColor default clWindowBackground; + property UnCheckedTextColor: TfpgColor read FUnCheckedTextColor write SetUnCheckedTextColor default clText1; + end; + +implementation + +{ TfpgToggle } + +procedure TfpgToggle.SetCheckedColor(AValue: TfpgColor); +begin + if FCheckedColor=AValue then Exit; + FCheckedColor:=AValue; + Invalidate; +end; + +procedure TfpgToggle.SetCheckedTextColor(AValue: TfpgColor); +begin + if FCheckedTextColor=AValue then Exit; + FCheckedTextColor:=AValue; + Invalidate; +end; + +procedure TfpgToggle.SetToggleWidth(AValue: TfpgCoord); +begin + if FToggleWidth=AValue then Exit; + FToggleWidth:=AValue; + FToggleButtonWidth:=AValue - 10; + Invalidate; +end; + +procedure TfpgToggle.SetCheckedCaption(AValue: TfpgString); +begin + if FCheckedCaption=AValue then Exit; + FCheckedCaption:=AValue; + Invalidate; +end; + +procedure TfpgToggle.SetUnCheckedCaption(AValue: TfpgString); +begin + if FUnCheckedCaption=AValue then Exit; + FUnCheckedCaption:=AValue; + Invalidate; +end; + +procedure TfpgToggle.SetUnCheckedColor(AValue: TfpgColor); +begin + if FUnCheckedColor=AValue then Exit; + FUnCheckedColor:=AValue; + Invalidate; +end; + +procedure TfpgToggle.AnimateTimer(Sender: TObject); +begin + if csDestroying in ComponentState then + Exit; + if not Checked then + begin // not checked + Dec(FSliderPosition, 1); + if FSliderPosition < 1 then + FSliderPosition:=0; + end + else // checked + begin + Inc(FSliderPosition); + if FSliderPosition >= FToggleWidth - FToggleButtonWidth -2then + FSliderPosition := FToggleWidth - FToggleButtonWidth -2; + end; + Invalidate; +end; + +procedure TfpgToggle.SetUnCheckedTextColor(AValue: TfpgColor); +begin + if FUnCheckedTextColor=AValue then Exit; + FUnCheckedTextColor:=AValue; + Invalidate; +end; + +function TfpgToggle.ToggleLeft: TfpgCoord; +begin + if BoxLayout = tbLeftBox then + Result := 1 + else + Result := Width - FToggleWidth; +end; + +procedure TfpgToggle.HandlePaint; +var + ToggleText: TfpgString; + PaintColor: TFPColor; + TextEnabled: TfpgTextFlags; + BvlWdth: TfpgCoord; + ButtonRect: TfpgRect; +begin + Canvas.Clear(BackgroundColor); + + // Text + Canvas.SetFont(Font); + if Enabled then + TextEnabled := [] + else + TextEnabled := [txtDisabled]; + + BvlWdth := fpgStyleManager.Style.GetBevelWidth; + + if BoxLayout = tbRightBox then + Canvas.DrawText(fpgRect(0,0,FWidth-FToggleWidth, FHeight), Text, [txtLeft, txtVCenter] + TextEnabled) { internally this still calls fpgStyle.DrawString(), so theming will be applied } + else + Canvas.DrawText(fpgRect(ToggleWidth,0,FWidth-ToggleWidth, FHeight), Text, [txtRight, txtVCenter] + TextEnabled); { internally this still calls fpgStyle.DrawString(), so theming will be applied } + + // Toggle Stuff + + // Toggle area bevel + fpgStyleManager.Style.DrawBevel(Canvas,ToggleLeft,0,FToggleWidth, Height, False); + + // Toggle Button + ButtonRect := fpgRect(ToggleLeft+FSliderPosition+BvlWdth,BvlWdth,FToggleButtonWidth, Height -(BvlWdth*2)); + fpgStyleManager.Style.DrawBevel(Canvas,ButtonRect.Left, ButtonRect.Top, ButtonRect.Width, ButtonRect.Height, True); + + + // unchecked text + if FSliderPosition < (FToggleWidth - FToggleButtonWidth) div 2 then + begin + ToggleText := FUnCheckedCaption; + Canvas.SetTextColor(FUnCheckedTextColor); + end + // checked text + else + begin + ToggleText := FCheckedCaption; + Canvas.SetTextColor(FCheckedTextColor); + end; + + // Toggle Text (inside 2 bevels) + Canvas.DrawText(fpgRect(ToggleLeft+FSliderPosition+BvlWdth*2,BvlWdth*2,FToggleButtonWidth-BvlWdth*4, Height-BvlWdth*4),ToggleText, [txtVCenter, txtHCenter] + TextEnabled); + + // Paint on either side of the button part of the toggle + if FSliderPosition > 0 then + begin + Canvas.SetColor(CheckedColor); + Canvas.FillRectangle(fpgRect(ToggleLeft+1,1, FSliderPosition, FHeight - BvlWdth*2)); + end; + + if FSliderPosition < FToggleWidth - FToggleButtonWidth -2 then + begin + Canvas.SetColor(UnCheckedColor); + Canvas.FillRectangle(fpgRect(ToggleLeft + FSliderPosition + FToggleButtonWidth+BvlWdth, BvlWdth, FToggleWidth - FToggleButtonWidth - FSliderPosition -(BvlWdth*2), FHeight - BvlWdth*2)); + end; + + // lastly draw focus + if FFocusable and FFocused then + begin + InflateRect(ButtonRect, -1,-1); + fpgStyleManager.Style.DrawFocusRect(Canvas, ButtonRect); + end; + + + if FPaintedSliderPosition = FSliderPosition then + FAnimateTimer.Enabled:=False; + + FPaintedSliderPosition := FSliderPosition; +end; + +procedure TfpgToggle.HandleCheckChanged; +begin + if FUseAnimation then + FAnimateTimer.Enabled := True + else + begin + if Checked then + FSliderPosition := FToggleWidth - FToggleButtonWidth -2 + else + FSliderPosition := 0; + end; + FPaintedSliderPosition := -1; +end; + +procedure TfpgToggle.HandleLMouseUp(x, y: integer; shiftstate: TShiftState); +begin + if ((BoxLayout = tbRightBox) and (x > Width - FToggleWidth)) + or ((BoxLayout = tbLeftBox) and (x <= FToggleWidth)) + then + inherited HandleLMouseUp(x, y, shiftstate); +end; + +constructor TfpgToggle.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + Text := 'ToggleBox'; + ToggleWidth := 45; + BoxLayout := tbRightBox; + FUseAnimation := True; + FUnCheckedCaption := 'OFF'; + FCheckedCaption := 'ON'; + FUnCheckedColor := FBackgroundColor; + FCheckedColor := clLime; + FUnCheckedTextColor := clText1; + FCheckedTextColor := clHilite2; + FAnimateTimer := TfpgTimer.Create(12); + FAnimateTimer.Enabled := False; + FAnimateTimer.OnTimer := @AnimateTimer; +end; + +destructor TfpgToggle.Destroy; +begin + FAnimateTimer.Free; + inherited Destroy; +end; + +end. + diff --git a/uidesigner/icons.inc b/uidesigner/icons.inc index 0e75a91f..f58ab0a0 100644 --- a/uidesigner/icons.inc +++ b/uidesigner/icons.inc @@ -3720,3 +3720,116 @@ const 146,119,119,146,119,119,146,119,119,146,119,119,146,119,119,255,255, 255, 0, 0); + +const + stdimg_vfd_toggle: array[0..1849] of byte = ( + 66, 77, 58, 7, 0, 0, 0, 0, 0, 0,122, 0, 0, 0,108, 0, 0, + 0, 24, 0, 0, 0, 24, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 192, 6, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 66, 71, 82,115, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 146,119,119,146,119,119,146,119,119,146,119,119,146,119,119,146,119, + 119,146,119,119,146,119,119,146,119,119,146,119,119,146,119,119,146, + 119,119,146,119,119,146,119,119,146,119,119,146,119,119,146,119,119, + 146,119,119,146,119,119,146,119,119,146,119,119,146,119,119,255, 0, + 255,255, 0,255,146,119,119,200,208,212,200,208,212,200,208,212,200, + 208,212,200,208,212,200,208,212,200,208,212,200,208,212,200,208,212, + 200,208,212,200,208,212,200,208,212,200,208,212,200,208,212,200,208, + 212,200,208,212,200,208,212,200,208,212,200,208,212,200,208,212,146, + 119,119,255, 0,255,255, 0,255,146,119,119,200,208,212, 0,230, 0, + 0,230, 0, 0,230, 0, 0,230, 0,255,255,255,132,132,132,132,132, + 132,132,132,132,132,132,132,132,132,132,132,132,132,132,132,132,132, + 132,132,132,132,132,132,132,132,132,132,132,132,132,132,132,132,132, + 200,208,212,146,119,119,255, 0,255,255, 0,255,146,119,119,200,208, + 212, 0,230, 0, 0,230, 0, 0,230, 0, 0,230, 0,255,255,255,200, + 208,212,159,159,159, 0, 0, 0, 0, 0, 0,159,159,159,200,208,212, + 0, 0, 0,200,208,212,145,145,145, 0, 0, 0,200,208,212,200,208, + 212,132,132,132,200,208,212,146,119,119,255, 0,255,255, 0,255,146, + 119,119,200,208,212, 0,230, 0, 0,230, 0, 0,230, 0, 0,230, 0, + 255,255,255,200,208,212, 0, 0, 0,200,208,212,200,208,212, 0, 0, + 0,200,208,212, 0, 0, 0,132,132,132, 0, 0, 0, 0, 0, 0,200, + 208,212,200,208,212,132,132,132,200,208,212,146,119,119,255, 0,255, + 255, 0,255,146,119,119,200,208,212, 0,230, 0, 0,230, 0, 0,230, + 0, 0,230, 0,255,255,255,200,208,212, 0, 0, 0,200,208,212,200, + 208,212, 0, 0, 0,200,208,212, 0, 0, 0, 0, 0, 0,132,132,132, + 0, 0, 0,200,208,212,200,208,212,132,132,132,200,208,212,146,119, + 119,255, 0,255,255, 0,255,146,119,119,200,208,212, 0,230, 0, 0, + 230, 0, 0,230, 0, 0,230, 0,255,255,255,200,208,212,159,159,159, + 0, 0, 0, 0, 0, 0,159,159,159,200,208,212, 0, 0, 0,145,145, + 145,200,208,212, 0, 0, 0,200,208,212,200,208,212,132,132,132,200, + 208,212,146,119,119,255, 0,255,255, 0,255,146,119,119,200,208,212, + 0,230, 0, 0,230, 0, 0,230, 0, 0,230, 0,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,200,208,212,146,119,119,255, 0,255,255, 0,255,146,119, + 119,200,208,212,200,208,212,200,208,212,200,208,212,200,208,212,200, + 208,212,200,208,212,200,208,212,200,208,212,200,208,212,200,208,212, + 200,208,212,200,208,212,200,208,212,200,208,212,200,208,212,200,208, + 212,200,208,212,200,208,212,200,208,212,146,119,119,255, 0,255,255, + 0,255,146,119,119,146,119,119,146,119,119,146,119,119,146,119,119, + 146,119,119,146,119,119,146,119,119,146,119,119,146,119,119,146,119, + 119,146,119,119,146,119,119,146,119,119,146,119,119,146,119,119,146, + 119,119,146,119,119,146,119,119,146,119,119,146,119,119,146,119,119, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255); + diff --git a/uidesigner/images/toggle.bmp b/uidesigner/images/toggle.bmp Binary files differnew file mode 100644 index 00000000..304d0973 --- /dev/null +++ b/uidesigner/images/toggle.bmp diff --git a/uidesigner/vfdwidgets.pas b/uidesigner/vfdwidgets.pas index 2238e4e5..575ae40a 100644 --- a/uidesigner/vfdwidgets.pas +++ b/uidesigner/vfdwidgets.pas @@ -67,6 +67,7 @@ uses fpg_ColorWheel, fpg_splitter, fpg_hyperlink, + fpg_toggle, vfdpropeditgrid, vfdmain; @@ -325,6 +326,12 @@ begin fpgImages.AddBMP( 'vfd.scrollframe', @stdimg_vfd_scrollframe, sizeof(stdimg_vfd_scrollframe)); + + fpgImages.AddMaskedBMP( + 'vfd.toggle', @stdimg_vfd_toggle, + sizeof(stdimg_vfd_toggle), + 0, 0); + end; procedure AddWidgetPosProps(wgc: TVFDWidgetClass); @@ -985,6 +992,30 @@ begin wc.WidgetIconName := 'vfd.hyperlink'; RegisterVFDWidget(wc); + // ToggleBox + wc := TVFDWidgetClass.Create(TfpgToggle); + wc.NameBase := 'Toggle'; + wc.AddProperty('Align', TPropertyEnum, ''); + wc.AddProperty('Checked', TPropertyBoolean, 'Boolean value'); + wc.AddProperty('CheckedCaption', TPropertyString, 'Initial text'); + wc.AddProperty('CheckedColor', TPropertyColor, ''); + wc.AddProperty('CheckedTextColor', TPropertyColor, ''); + wc.AddProperty('Enabled', TPropertyBoolean, ''); + wc.AddProperty('FontDesc', TPropertyFontDesc, 'The font used for displaying the text'); + wc.AddProperty('Hint', TPropertyString, 'Tooltip hint'); + wc.AddProperty('ParentShowHint', TPropertyBoolean, ''); + wc.AddProperty('ShowHint', TPropertyBoolean, ''); + wc.AddProperty('TabOrder', TPropertyInteger, 'The tab order'); + wc.AddProperty('Text', TPropertyString, 'Initial text'); + wc.AddProperty('TextColor', TPropertyColor, ''); + wc.AddProperty('ToggleWidth', TPropertyInteger, 'Width of toggle button'); + wc.AddProperty('UnCheckedCaption', TPropertyString, 'Initial text'); + wc.AddProperty('UnCheckedColor', TPropertyColor, ''); + wc.AddProperty('UnCheckedTextColor', TPropertyColor, ''); + wc.AddProperty('UseAnimation', TPropertyBoolean, ''); + wc.WidgetIconName := 'vfd.toggle'; + RegisterVFDWidget(wc); + // Other - do not delete!!! this should be the last... wc := TVFDWidgetClass.Create(TOtherWidget); wc.NameBase := 'Custom'; |