summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--examples/gui/dbtest/test.dbfbin704 -> 704 bytes
-rw-r--r--examples/gui/edits/edittest.lpi52
-rw-r--r--examples/gui/edits/edittest.lpr133
-rw-r--r--examples/gui/edits/extrafpc.cfg5
-rw-r--r--src/gui/gui_edit.pas231
-rw-r--r--src/gui/gui_grid.pas2
6 files changed, 413 insertions, 10 deletions
diff --git a/examples/gui/dbtest/test.dbf b/examples/gui/dbtest/test.dbf
index 0b12908b..0c50b2da 100644
--- a/examples/gui/dbtest/test.dbf
+++ b/examples/gui/dbtest/test.dbf
Binary files differ
diff --git a/examples/gui/edits/edittest.lpi b/examples/gui/edits/edittest.lpi
new file mode 100644
index 00000000..302cd2c1
--- /dev/null
+++ b/examples/gui/edits/edittest.lpi
@@ -0,0 +1,52 @@
+<?xml version="1.0"?>
+<CONFIG>
+ <ProjectOptions>
+ <PathDelim Value="/"/>
+ <Version Value="6"/>
+ <General>
+ <Flags>
+ <SaveOnlyProjectUnits Value="True"/>
+ </Flags>
+ <SessionStorage Value="InProjectDir"/>
+ <MainUnit Value="0"/>
+ <TargetFileExt Value=""/>
+ </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="edittest.lpr"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="edittest"/>
+ </Unit0>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="5"/>
+ <CodeGeneration>
+ <Generate Value="Faster"/>
+ </CodeGeneration>
+ <Other>
+ <CustomOptions Value="-FUunits"/>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+</CONFIG>
diff --git a/examples/gui/edits/edittest.lpr b/examples/gui/edits/edittest.lpr
new file mode 100644
index 00000000..82eb9a48
--- /dev/null
+++ b/examples/gui/edits/edittest.lpr
@@ -0,0 +1,133 @@
+program edittest;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Classes, fpgfx, gui_form, gui_label, gui_edit, gui_button, fpgui_package;
+
+type
+
+ TMainForm = class(TfpgForm)
+ private
+ procedure btnQuitClicked(Sender: TObject);
+ public
+ {@VFD_HEAD_BEGIN: MainForm}
+ lblName1: TfpgLabel;
+ edtText: TfpgEdit;
+ lblName2: TfpgLabel;
+ lblName3: TfpgLabel;
+ edtInteger: TfpgEditInteger;
+ edtFloat: TfpgEditFloat;
+ btnQuit: TfpgButton;
+ {@VFD_HEAD_END: MainForm}
+ procedure AfterCreate; override;
+ end;
+
+{@VFD_NEWFORM_DECL}
+
+
+
+{@VFD_NEWFORM_IMPL}
+
+procedure TMainForm.btnQuitClicked(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure TMainForm.AfterCreate;
+begin
+ {@VFD_BODY_BEGIN: MainForm}
+ Name := 'MainForm';
+ SetPosition(363, 198, 271, 234);
+ WindowTitle := 'Edit components';
+ WindowPosition := wpScreenCenter;
+
+ lblName1 := TfpgLabel.Create(self);
+ with lblName1 do
+ begin
+ Name := 'lblName1';
+ SetPosition(8, 8, 196, 16);
+ FontDesc := '#Label1';
+ Text := 'Text Edit';
+ end;
+
+ edtText := TfpgEdit.Create(self);
+ with edtText do
+ begin
+ Name := 'edtText';
+ SetPosition(24, 28, 120, 22);
+ TabOrder := 1;
+ Text := '';
+ FontDesc := '#Edit1';
+ end;
+
+ lblName2 := TfpgLabel.Create(self);
+ with lblName2 do
+ begin
+ Name := 'lblName2';
+ SetPosition(8, 68, 80, 16);
+ FontDesc := '#Label1';
+ Text := 'Integer Edit';
+ end;
+
+ lblName3 := TfpgLabel.Create(self);
+ with lblName3 do
+ begin
+ Name := 'lblName3';
+ SetPosition(8, 124, 80, 16);
+ FontDesc := '#Label1';
+ Text := 'Float Edit';
+ end;
+
+ edtInteger := TfpgEditInteger.Create(self);
+ with edtInteger do
+ begin
+ Name := 'edtInteger';
+ SetPosition(24, 88, 120, 22);
+ end;
+
+ edtFloat := TfpgEditFloat.Create(self);
+ with edtFloat do
+ begin
+ Name := 'edtFloat';
+ SetPosition(24, 144, 120, 22);
+ end;
+
+ btnQuit := TfpgButton.Create(self);
+ with btnQuit do
+ begin
+ Name := 'btnQuit';
+ SetPosition(188, 200, 75, 24);
+ Text := 'Quit';
+ FontDesc := '#Label1';
+ ImageName := '';
+ TabOrder := 6;
+ OnClick := @btnQuitClicked;
+ end;
+
+ {@VFD_BODY_END: MainForm}
+end;
+
+
+procedure MainProc;
+var
+ frm: TMainForm;
+begin
+ fpgApplication.Initialize;
+ frm := TMainForm.Create(nil);
+ try
+ frm.Show;
+ fpgApplication.Run;
+ finally
+ frm.Free;
+ end;
+end;
+
+begin
+ MainProc;
+end.
+
+
diff --git a/examples/gui/edits/extrafpc.cfg b/examples/gui/edits/extrafpc.cfg
new file mode 100644
index 00000000..073dc4b6
--- /dev/null
+++ b/examples/gui/edits/extrafpc.cfg
@@ -0,0 +1,5 @@
+-FUunits
+-Fu../../../lib
+-Xs
+-XX
+-CX
diff --git a/src/gui/gui_edit.pas b/src/gui/gui_edit.pas
index 0821872c..9db04824 100644
--- a/src/gui/gui_edit.pas
+++ b/src/gui/gui_edit.pas
@@ -130,20 +130,40 @@ type
property OnMouseExit;
property OnPaint;
end;
-
- TfpgNumericEdit = class(TfpgCustomEdit)
+
+ { TfpgBaseNumericEdit }
+
+ TfpgBaseNumericEdit = class(TfpgCustomEdit)
+ private
+ fOldColor: TfpgColor;
+ fAlignment: TAlignment;
+ fDecimalSeparator: char;
+ fNegativeColor: TfpgColor;
+ fThousandSeparator: char;
+ procedure SetOldColor(const AValue: TfpgColor);
+ procedure SetAlignment(const AValue: TAlignment);
+ procedure SetDecimalSeparator(const AValue: char);
+ procedure SetNegativeColor(const AValue: TfpgColor);
+ procedure SetThousandSeparator(const AValue: char);
protected
procedure HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: Boolean); override;
- published
+ procedure HandlePaint; override;
+ procedure Format; virtual;
+ procedure Justify; virtual; // to implement in derived classes
+ property OldColor: TfpgColor read fOldColor write SetOldColor;
+ property Alignment: TAlignment read fAlignment write SetAlignment default taRightJustify;
property AutoSelect;
property BackgroundColor default clBoxColor;
property BorderStyle;
- property FontDesc;
+ {Someone likes to use English operating system but localized decimal and thousand separators
+ Still to implement !!}
+ property DecimalSeparator: char read fDecimalSeparator write SetDecimalSeparator;
+ property ThousandSeparator: char read fThousandSeparator write SetThousandSeparator;
+ property NegativeColor: TfpgColor read fNegativeColor write SetNegativeColor;
property HideSelection;
// property MaxLength; { probably MaxValue and MinValue }
property TabOrder;
-// property Text; { this should become Value }
property TextColor;
property OnChange;
property OnEnter;
@@ -152,8 +172,43 @@ type
property OnMouseEnter;
property OnMouseExit;
property OnPaint;
+ property Text; { this should become Value }
+ public
+ constructor Create(AOwner: TComponent); override;
+ published
+ property FontDesc;
end;
-
+
+
+ { TfpgEditInteger }
+
+ TfpgEditInteger = class(TfpgBaseNumericEdit)
+ protected
+ function GetValue: integer; virtual;
+ procedure SetValue(const AValue: integer); virtual;
+ procedure Format; override;
+ procedure HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: Boolean); override;
+ published
+ property Alignment;
+ property NegativeColor;
+ property Value: integer read GetValue write SetValue;
+ end;
+
+
+ { TfpgEditFloat }
+
+ TfpgEditFloat = class(TfpgBaseNumericEdit)
+ protected
+ function GetValue: extended; virtual;
+ procedure SetValue(const AValue: extended); virtual;
+ procedure HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: Boolean); override;
+ published
+ property Alignment;
+ property NegativeColor;
+ property DecimalSeparator;
+ property Value: extended read GetValue write SetValue;
+ end;
+
function CreateEdit(AOwner: TComponent; x, y, w, h: TfpgCoord): TfpgEdit;
@@ -900,18 +955,176 @@ begin
DoPaste;
end;
-procedure TfpgNumericEdit.HandleKeyChar(var AText: TfpgChar;
+{ TfpgBaseNumericEdit }
+
+procedure TfpgBaseNumericEdit.SetOldColor(const AValue: TfpgColor);
+begin
+ if fOldColor=AValue then exit;
+ fOldColor:=AValue;
+end;
+
+procedure TfpgBaseNumericEdit.SetAlignment(const AValue: TAlignment);
+begin
+ if fAlignment=AValue then exit;
+ fAlignment:=AValue;
+end;
+
+procedure TfpgBaseNumericEdit.SetDecimalSeparator(const AValue: char);
+begin
+ if fDecimalSeparator=AValue then exit;
+ fDecimalSeparator:=AValue;
+end;
+
+procedure TfpgBaseNumericEdit.SetNegativeColor(const AValue: TfpgColor);
+begin
+ if fNegativeColor=AValue then exit;
+ fNegativeColor:=AValue;
+end;
+
+procedure TfpgBaseNumericEdit.SetThousandSeparator(const AValue: char);
+begin
+ if fThousandSeparator=AValue then exit;
+ fThousandSeparator:=AValue;
+end;
+
+procedure TfpgBaseNumericEdit.Justify;
+begin
+ //based on Alignment property this method will align the derived edit correctly.
+end;
+
+procedure TfpgBaseNumericEdit.HandleKeyChar(var AText: TfpgChar;
+ var shiftstate: TShiftState; var consumed: Boolean);
+begin
+ Format; // just call format virtual procedure to have a simple way to manage polymorphism here
+ inherited HandleKeyChar(AText, shiftstate, consumed);
+end;
+
+procedure TfpgBaseNumericEdit.HandlePaint;
+var
+ x: TfpgCoord;
+ s: string;
+ r: TfpgRect;
+ tw: integer;
+begin
+ if Alignment = taRightJustify then
+ begin
+ Canvas.BeginDraw;
+ inherited HandlePaint;
+ // Canvas.ClearClipRect;
+ // r.SetRect(0, 0, Width, Height);
+ Canvas.Clear(BackgroundColor);
+ Canvas.SetFont(Font);
+ Canvas.SetTextColor(TextColor);
+ x := Width - Font.TextWidth(Text) - 1;
+ Canvas.DrawString(x,1,Text);
+ Canvas.EndDraw;
+ if Focused then
+ fpgCaret.SetCaret(Canvas, x + Font.TextWidth(Text) - 1, 3, fpgCaret.Width, Font.Height);
+ end
+ else
+ inherited;
+end;
+
+procedure TfpgBaseNumericEdit.Format;
+begin
+ // Colour negative number
+ if LeftStr(Text,1) = '-' then
+ TextColor := NegativeColor
+ else
+ TextColor := OldColor;
+end;
+
+constructor TfpgBaseNumericEdit.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ fAlignment := taRightJustify;
+ DecimalSeparator := SysUtils.DecimalSeparator;
+ ThousandSeparator := SysUtils.ThousandSeparator;
+ NegativeColor := clRed;
+ OldColor := TextColor;
+end;
+
+{ TfpgEditInteger }
+
+function TfpgEditInteger.GetValue: integer;
+begin
+ try
+ Result := StrToInt(Text);
+ except
+ on E: EConvertError do
+ begin
+ Result := 0;
+ Text := '';
+ Invalidate;
+ end;
+ end;
+end;
+
+procedure TfpgEditInteger.SetValue(const AValue: integer);
+begin
+ try
+ Text := IntToStr(AValue);
+ except
+ on E: EConvertError do
+ Text := '';
+ end;
+end;
+
+procedure TfpgEditInteger.Format;
+begin
+// here there will be, for example, thousand separator integer formatting routine
+ inherited Format;
+end;
+
+procedure TfpgEditInteger.HandleKeyChar(var AText: TfpgChar;
var shiftstate: TShiftState; var consumed: Boolean);
var
n: integer;
begin
n := Ord(AText[1]);
- if ((n >= 48) and (n <= 57)) or ((n = Ord(DecimalSeparator)) or (n = Ord('-')))
- and (Pos(AText[1], Self.Text) <= 0) then
+ if ((n >= 48) and (n <= 57) or (n = Ord('-')) and (Pos(AText[1], Self.Text) <= 0)) then
consumed := False
else
consumed := True;
+ inherited HandleKeyChar(AText, shiftstate, consumed);
+end;
+
+{ TfpgEditFloat }
+
+function TfpgEditFloat.GetValue: extended;
+begin
+ try
+ Result := StrToFloat(Text);
+ except
+ on E: EConvertError do
+ begin
+ Result := 0;
+ Text := FloatToStr(Result);
+ end;
+ end;
+end;
+procedure TfpgEditFloat.SetValue(const AValue: extended);
+begin
+ try
+ Text := FloatToStr(AValue);
+ except
+ on E: EConvertError do
+ Text := '';
+ end;
+end;
+
+procedure TfpgEditFloat.HandleKeyChar(var AText: TfpgChar;
+ var shiftstate: TShiftState; var consumed: Boolean);
+var
+ n: integer;
+begin
+ n := Ord(AText[1]);
+ if ((n >= 48) and (n <= 57) or (n = Ord('-')) and (Pos(AText[1], Self.Text) <= 0))
+ or ((n = Ord(Self.DecimalSeparator)) and (Pos(AText[1], Self.Text) <= 0)) then
+ consumed := False
+ else
+ consumed := True;
inherited HandleKeyChar(AText, shiftstate, consumed);
end;
diff --git a/src/gui/gui_grid.pas b/src/gui/gui_grid.pas
index 5fed12e9..7a869299 100644
--- a/src/gui/gui_grid.pas
+++ b/src/gui/gui_grid.pas
@@ -280,7 +280,7 @@ begin
img := fpgImages.GetImage('stdimg.executable'); // Do NOT localize
{$ENDIF}
{$IFDEF MSWINDOWS}
- if lowercase(e.Extention) = 'exe' then
+ if lowercase(e.Extension) = 'exe' then
img := fpgImages.GetImage('stdimg.executable'); // Do NOT localize
{$ENDIF}
end;
generated by cgit v1.2.3-70-g09d2 (git 2.47.1) at 2024-12-26 18:04:22 +0000