diff options
Diffstat (limited to 'src/gui')
-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 |
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. + |