summaryrefslogtreecommitdiff
path: root/src/gui
diff options
context:
space:
mode:
Diffstat (limited to 'src/gui')
-rw-r--r--src/gui/fpg_checkbox.pas7
-rw-r--r--src/gui/fpg_customgrid.pas2
-rw-r--r--src/gui/fpg_stringgridbuilder.pas178
-rw-r--r--src/gui/fpg_toggle.pas282
4 files changed, 468 insertions, 1 deletions
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.
+
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-10-27 04:38:03 +0000