{ fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 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: Defines a Text Edit control. Also known a Text Entry control. } unit fpg_edit; {$mode objfpc}{$H+} interface uses Classes, SysUtils, fpg_base, fpg_main, fpg_widget, fpg_menu; type TfpgEditBorderStyle = (ebsNone, ebsDefault, ebsSingle); TfpgBaseEdit = class(TfpgWidget) private FAutoSelect: Boolean; FHideSelection: Boolean; FPopupMenu: TfpgPopupMenu; FDefaultPopupMenu: TfpgPopupMenu; FText: string; FPasswordMode: Boolean; FBorderStyle: TfpgEditBorderStyle; FOnChange: TNotifyEvent; FMaxLength: integer; FSelecting: Boolean; procedure Adjust(UsePxCursorPos: boolean = false); virtual; procedure AdjustTextOffset(UsePxCursorPos: boolean); virtual; procedure AdjustDrawingInfo; virtual; // function PointToCharPos(x, y: integer): integer; procedure DeleteSelection; procedure DoCopy; procedure DoPaste; procedure SetAutoSelect(const AValue: Boolean); procedure SetBorderStyle(const AValue: TfpgEditBorderStyle); procedure SetHideSelection(const AValue: Boolean); procedure SetPasswordMode(const AValue: boolean); function GetFontDesc: string; procedure SetFontDesc(const AValue: string); procedure SetText(const AValue: string); procedure DefaultPopupCut(Sender: TObject); procedure DefaultPopupCopy(Sender: TObject); procedure DefaultPopupPaste(Sender: TObject); procedure DefaultPopupClearAll(Sender: TObject); procedure SetDefaultPopupMenuItemsState; protected FFont: TfpgFont; FSideMargin: integer; FMouseDragPos: integer; FSelStart: integer; FSelOffset: integer; FCursorPos: integer; // Caret position (characters) FCursorPx: integer; // Caret position (pixels) FTextOffset: integer; FDrawOffset: integer; FVisibleText: TfpgString; FVisSelStartPx: integer; FVisSelEndPx: integer; procedure DoOnChange; virtual; procedure ShowDefaultPopupMenu(const x, y: integer; const shiftstate: TShiftState); virtual; procedure HandlePaint; override; procedure HandleResize(awidth, aheight: TfpgCoord); override; procedure HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: Boolean); override; procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: Boolean); override; procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; procedure HandleRMouseUp(x, y: integer; shiftstate: TShiftState); override; procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override; procedure HandleDoubleClick(x, y: integer; button: word; shiftstate: TShiftState); override; procedure HandleMouseEnter; override; procedure HandleMouseExit; override; procedure HandleSetFocus; override; procedure HandleKillFocus; override; function GetDrawText: String; property AutoSelect: Boolean read FAutoSelect write SetAutoSelect default True; property BorderStyle: TfpgEditBorderStyle read FBorderStyle write SetBorderStyle default ebsDefault; property FontDesc: String read GetFontDesc write SetFontDesc; property HideSelection: Boolean read FHideSelection write SetHideSelection default True; property MaxLength: Integer read FMaxLength write FMaxLength; property PasswordMode: Boolean read FPasswordMode write SetPasswordMode default False; property PopupMenu: TfpgPopupMenu read FPopupMenu write FPopupMenu; property Text: String read FText write SetText; property OnChange: TNotifyEvent read FOnChange write FOnChange; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function SelectionText: string; procedure SelectAll; procedure Clear; procedure ClearSelection; procedure CopyToClipboard; procedure CutToClipboard; function GetClientRect: TfpgRect; override; procedure PasteFromClipboard; property Font: TfpgFont read FFont; end; TfpgEdit = class(TfpgBaseEdit) public property PopupMenu; // UI Designer doesn't fully support it yet published property AutoSelect; property BackgroundColor default clBoxColor; property BorderStyle; property FontDesc; property HideSelection; property MaxLength; property PasswordMode; property ParentShowHint; property ShowHint; property TabOrder; property Text; property TextColor; property OnChange; property OnEnter; property OnExit; property OnKeyPress; property OnMouseEnter; property OnMouseExit; property OnPaint; end; TfpgBaseNumericEdit = class(TfpgBaseEdit) private FDecimals: integer; FOldColor: TfpgColor; FAlignment: TAlignment; FDecimalseparator: TfpgChar; FNegativeColor: TfpgColor; FThousandSeparator: TfpgChar; FShowThousand: boolean; procedure AdjustTextOffset(UsePxCursorPos: boolean); override; procedure AdjustDrawingInfo; override; procedure SetOldColor(const AValue: TfpgColor); procedure SetAlignment(const AValue: TAlignment); procedure SetDecimalSeparator(const AValue: TfpgChar); procedure SetNegativeColor(const AValue: TfpgColor); procedure SetThousandSeparator(const AValue: TfpgChar); procedure SetShowThousand; protected procedure HandlePaint; override; procedure FormatEdit; 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; {Someone likes to use English operating system but localized decimal and thousand separators Still to implement !!} property CustomDecimalSeparator: TfpgChar read FDecimalseparator write SetDecimalSeparator; property CustomThousandSeparator: TfpgChar read FThousandSeparator write SetThousandSeparator; property NegativeColor: TfpgColor read FNegativeColor write SetNegativeColor; property HideSelection; // property MaxLength; { probably MaxValue and MinValue } property TabOrder; property TextColor; property ShowThousand: boolean read FShowThousand write FShowThousand default False; property OnChange; property OnEnter; property OnExit; property OnKeyPress; property OnMouseEnter; property OnMouseExit; property OnPaint; public constructor Create(AOwner: TComponent); override; published property FontDesc; end; TfpgEditInteger = class(TfpgBaseNumericEdit) protected function GetValue: integer; virtual; procedure SetValue(const AValue: integer); virtual; procedure HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: Boolean); override; procedure HandleSetFocus; override; procedure HandleKillFocus; override; procedure HandlePaint; override; public constructor Create(AOwner: TComponent); override; property OldColor; property Text; published property NegativeColor; property Value: integer read GetValue write SetValue; property ParentShowHint; property ShowHint; property ShowThousand default True; property TabOrder; property TextColor; property CustomThousandSeparator; property OnChange; property OnEnter; property OnExit; property OnKeyPress; property OnMouseEnter; property OnMouseExit; property OnMouseMove; end; TfpgEditFloat = class(TfpgBaseNumericEdit) private FFixedDecimals: boolean; protected function GetValue: extended; virtual; procedure SetValue(const AValue: extended); virtual; procedure SetDecimals(const AValue: integer); procedure SetFixedDecimals(const AValue: boolean); procedure HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: Boolean); override; procedure HandleSetFocus; override; procedure HandleKillFocus; override; procedure HandlePaint; override; public constructor Create(AOwner: TComponent); override; property OldColor; property Text; published property Decimals: integer read FDecimals write SetDecimals default -1; property CustomDecimalSeparator; property FixedDecimals: boolean read FFixedDecimals write SetFixedDecimals default False; property NegativeColor; property ShowThousand default True; property TabOrder; property TextColor; property CustomThousandSeparator; property Value: extended read GetValue write SetValue; property ParentShowHint; property ShowHint; property OnChange; property OnEnter; property OnExit; property OnKeyPress; property OnMouseEnter; property OnMouseExit; property OnMouseMove; end; TfpgEditCurrency = class(TfpgBaseNumericEdit) protected function GetValue: Currency; virtual; procedure SetValue(const AValue: Currency); virtual; procedure SetDecimals(AValue: integer); procedure HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: Boolean); override; procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: Boolean); override; procedure HandleSetFocus; override; procedure HandleKillFocus; override; procedure HandlePaint; override; public constructor Create(AOwner: TComponent); override; property OldColor; property Text; published property Decimals: integer read FDecimals write SetDecimals default 2; property NegativeColor; property CustomDecimalSeparator; property CustomThousandSeparator; property ShowThousand default True; property Value: Currency read GetValue write SetValue; property ParentShowHint; property ShowHint; property TabOrder; property OnChange; property OnEnter; property OnExit; property OnKeyPress; property OnMouseEnter; property OnMouseExit; end; function CreateEdit(AOwner: TComponent; x, y, w, h: TfpgCoord): TfpgEdit; function CreateEditInteger(AOwner: TComponent; x, y, w, h: TfpgCoord; AShowThousand: boolean= True): TfpgEditInteger; function CreateEditFloat(AOwner: TComponent; x, y, w, h: TfpgCoord; AShowThousand: boolean= True; ADecimals: Integer= -1; AFixedDecimals: boolean= False): TfpgEditFloat; function CreateEditCurrency(AOwner: TComponent; x, y, w, h: TfpgCoord; AShowThousand: boolean= True; ADecimals: Integer= 2): TfpgEditCurrency; implementation uses fpg_stringutils, fpg_constants, fpg_hint; const // internal popupmenu item names ipmCut = 'miDefaultCut'; ipmCopy = 'miDefaultCopy'; ipmPaste = 'miDefaultPaste'; ipmClearAll = 'miDefaultClearAll'; function CreateEdit(AOwner: TComponent; x, y, w, h: TfpgCoord): TfpgEdit; begin Result := TfpgEdit.Create(AOwner); Result.Left := x; Result.Top := y; if w > 0 then Result.Width := w; if h < TfpgEdit(Result).FFont.Height + 6 then Result.Height:= TfpgEdit(Result).FFont.Height + 6 else Result.Height:= h; end; function CreateEditInteger(AOwner: TComponent; x, y, w, h: TfpgCoord; AShowThousand: boolean= True): TfpgEditInteger; begin Result := TfpgEditInteger.Create(AOwner); Result.Left := x; Result.Top := y; Result.Width := w; Result.ShowThousand:= AShowThousand; if h < TfpgEditInteger(Result).FFont.Height + 6 then Result.Height:= TfpgEditInteger(Result).FFont.Height + 6 else Result.Height:= h; end; function CreateEditFloat(AOwner: TComponent; x, y, w, h: TfpgCoord; AShowThousand: boolean= True; ADecimals: Integer= -1; AFixedDecimals: boolean= False): TfpgEditFloat; begin Result := TfpgEditFloat.Create(AOwner); Result.Left := x; Result.Top := y; Result.Width := w; Result.ShowThousand:= AShowThousand; Result.Decimals := ADecimals; Result.FFixedDecimals:= AFixedDecimals; if h < TfpgEditFloat(Result).FFont.Height + 6 then Result.Height:= TfpgEditFloat(Result).FFont.Height + 6 else Result.Height:= h; end; function CreateEditCurrency(AOwner: TComponent; x, y, w, h: TfpgCoord; AShowThousand: boolean= True; ADecimals: Integer= 2): TfpgEditCurrency; begin Result := TfpgEditCurrency.Create(AOwner); Result.Left := x; Result.Top := y; Result.Width := w; Result.ShowThousand:= AShowThousand; Result.Decimals := ADecimals; if h < TfpgEditCurrency(Result).FFont.Height + 6 then Result.Height:= TfpgEditCurrency(Result).FFont.Height + 6 else Result.Height:= h; end; { TfpgBaseEdit } procedure TfpgBaseEdit.Adjust(UsePxCursorPos: boolean = false); begin AdjustTextOffset(False); AdjustDrawingInfo; end; procedure TfpgBaseEdit.AdjustTextOffset(UsePxCursorPos: boolean); {If UsePxCursorPos then determines FCursorPos from FCursorPx (that holds mouse pointer coordinates) Calculates exact FCursorPx (relative to the widget bounding box) from FCursorPos Calculates FTextOffset based on FCursorPx} var dtext: string; ch: string; // current character chnum: integer; // its ordinal number chx: integer; // its X position relative to widget bestchx: integer; // chx, nearest to the mouse position (indicated by FCursorPx if UsePxCursorPos = True) tw: integer; // total characters width, that becomes FCursorPx relative to the beginning of the text ptw: integer; dpos: integer; // helps to pass through an utf-8 string quickly VisibleWidth: integer; // width of the edit field minus side margins begin if UsePxCursorPos then begin if FCursorPx > 0 then // bestchx < chx minimum bestchx := Low(chx) + 1 + FCursorPx else // bestchx > chx maximum bestchx := High(chx) - 1 + FCursorPx; end else FCursorPx := 0; dtext := GetDrawText; ch := ''; chnum := 0; tw := 0; dpos := 0; while dpos <= Length(dtext) do begin dpos := UTF8CharAtByte(dtext, dpos, ch); ptw := tw; tw := tw + FFont.TextWidth(ch); chx := tw - FTextOffset + FSideMargin; if UsePxCursorPos then begin if abs(chx - FCursorPx) < abs(bestchx - FCursorPx) then begin bestchx := chx; FCursorPos := chnum; end else begin tw := ptw; break; end; end else begin if chnum >= FCursorPos then break; end; Inc(chnum); end; VisibleWidth := (FWidth - 2 * FSideMargin); if tw - FTextOffset > VisibleWidth - 2 then FTextOffset := tw - VisibleWidth + 2 else if tw - FTextOffset < 0 then begin FTextOffset := tw; if tw <> 0 then Dec(FTextOffset, 2); end; FCursorPx := tw - FTextOffset + FSideMargin; end; procedure TfpgBaseEdit.AdjustDrawingInfo; // Calculates FVisSelStartPx, FVisSelEndPx, FVisibleText, FDrawOffset var vtstartbyte, vtendbyte: integer; // visible characters' start/end in utf-8 string, bytes bestfx, bestlx: integer; dtext: string; ch: string; // current character chnum: integer; // its ordinal number chx: integer; // its X position relative to widget tw: integer; // total characters width, that becomes FCursorPx relative to the beginning of the text ptw: integer; // total width on the previous step dpos: integer; // helps to pass through an utf-8 string quickly pdp: integer; // dpos on the previous step vstart, vend: integer; // visible area start and end, pixels slstart, slend: integer; // selection start and end, pixels begin vstart := FSideMargin; vend := FWidth - FSideMargin; if FSelOffset > 0 then begin slstart := FSelStart; slend := FSelStart + FSelOffset; end else begin slstart := FSelStart + FSelOffset; slend := FSelStart; end; FVisSelStartPx := vend; // because we stop the search FVisSelEndPx := vend; // after last visible character is found bestfx := Low(chx) + 1 + vstart; bestlx := Low(chx) + 1 + vend; dtext := GetDrawText; ch := ''; chnum := 0; tw := 0; dpos := 0; FDrawOffset := 0; while dpos <= Length(dtext) do begin pdp := dpos; dpos := UTF8CharAtByte(dtext, dpos, ch); ptw := tw; tw := tw + FFont.TextWidth(ch); chx := tw - FTextOffset + FSideMargin; // calculate selection-related fields if chnum = slstart then FVisSelStartPx := chx; if chnum = slend then FVisSelEndPx := chx; // search for the first/last visible characters if abs(chx - vstart) < abs(bestfx - vstart) then begin bestfx := chx; vtstartbyte := pdp; FDrawOffset := ptw; end; // in small edit field the same character can be both the first and the last, so no 'else' allowed if abs(chx - vend) < abs(bestlx - vend) then begin bestlx := chx; vtendbyte := UTF8CharAtByte(dtext, dpos, ch); // plus one more character end else break; // we can safely break after last visible character is found Inc(chnum); end; if FVisSelStartPx < vstart then FVisSelStartPx := vstart; if FVisSelEndPx > vend then FVisSelEndPx := vend; // FVisibleText := UTF8Copy(dtext, fvc, lvc - fvc + 2); FVisibleText := Copy(dtext, vtstartbyte, vtendbyte - vtstartbyte); FDrawOffset := FTextOffset - FDrawOffset; end; {function TfpgBaseEdit.PointToCharPos(x, y: integer): integer; var n: integer; cx: integer; // character X position bestcx: integer; dtext: string; tw, dpos: integer; ch: string; begin ch := ''; dtext := GetDrawText; if x > 0 then // bestcx < cx minimum bestcx := Low(cx) + 1 + x else // bestcx > cx maximum bestcx := High(cx) - 1 + x; tw := 0; dpos := 0; n := 0; Result := n; // searching the appropriate character position while dpos <= Length(dtext) do begin dpos := UTF8CharAtByte(dtext, dpos, ch); tw := tw + FFont.TextWidth(ch); cx := tw - FTextOffset + FSideMargin; if abs(cx - x) < abs(bestcx - x) then begin bestcx := cx; Result := n; end else Exit; //==> Inc(n); end; end;} procedure TfpgBaseEdit.SetBorderStyle(const AValue: TfpgEditBorderStyle); begin if FBorderStyle = AValue then Exit; //==> FBorderStyle := AValue; RePaint; end; procedure TfpgBaseEdit.SetHideSelection(const AValue: Boolean); begin if FHideSelection = AValue then Exit; FHideSelection := AValue; end; procedure TfpgBaseEdit.HandlePaint; var r: TfpgRect; // paint selection rectangle procedure DrawSelection; var lcolor: TfpgColor; r: TfpgRect; begin if Focused then begin lcolor := clSelection; Canvas.SetTextColor(clSelectionText); end else begin lcolor := clInactiveSel; Canvas.SetTextColor(clText1); end; r.SetRect(FVisSelStartPx, 3, FVisSelEndPx - FVisSelStartPx, FFont.Height); Canvas.SetColor(lcolor); Canvas.FillRectangle(r); Canvas.SetTextColor(clWhite); Canvas.AddClipRect(r); fpgStyle.DrawString(Canvas, -FDrawOffset + FSideMargin, 3, FVisibleText, Enabled); Canvas.ClearClipRect; end; begin Canvas.ClearClipRect; r.SetRect(0, 0, Width, Height); case BorderStyle of ebsNone: begin // do nothing end; ebsDefault: begin Canvas.DrawControlFrame(r); InflateRect(r, -2, -2); end; ebsSingle: begin Canvas.SetColor(clShadow2); Canvas.DrawRectangle(r); InflateRect(r, -1, -1); end; end; Canvas.SetClipRect(r); if Enabled then Canvas.SetColor(FBackgroundColor) else Canvas.SetColor(clWindowBackground); Canvas.FillRectangle(r); Canvas.SetFont(FFont); Canvas.SetTextColor(FTextColor); fpgStyle.DrawString(Canvas, -FDrawOffset + FSideMargin, 3, FVisibleText, Enabled); if Focused then begin // drawing selection if FSelOffset <> 0 then DrawSelection; // drawing cursor fpgCaret.SetCaret(Canvas, FCursorPx, 3, fpgCaret.Width, FFont.Height); end else begin // drawing selection if (AutoSelect = False) and (FSelOffset <> 0) and (HideSelection = False) then DrawSelection; fpgCaret.UnSetCaret(Canvas); end; end; procedure TfpgBaseEdit.HandleResize(awidth, aheight: TfpgCoord); begin inherited HandleResize(awidth, aheight); AdjustDrawingInfo; end; procedure TfpgBaseEdit.HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: Boolean); var s: TfpgChar; prevval: string; begin prevval := Text; s := AText; if not consumed then begin // Handle only printable characters // UTF-8 characters beyond ANSI range are supposed to be printable if ((Ord(AText[1]) > 31) and (Ord(AText[1]) < 127)) or (Length(AText) > 1) then begin if (FMaxLength <= 0) or (UTF8Length(FText) < FMaxLength) then begin DeleteSelection; UTF8Insert(s, FText, FCursorPos + 1); Inc(FCursorPos); FSelStart := FCursorPos; Adjust; end; consumed := True; end; if prevval <> Text then DoOnChange; end; if consumed then RePaint; inherited HandleKeyChar(AText, shiftstate, consumed); end; procedure TfpgBaseEdit.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); var hasChanged: boolean; procedure StopSelection; begin FSelStart := FCursorPos; FSelOffset := 0; end; begin hasChanged := False; fpgApplication.HideHint; Consumed := True; case CheckClipBoardKey(keycode, shiftstate) of ckCopy: begin DoCopy; end; ckPaste: begin DoPaste; hasChanged := True; end; ckCut: begin DoCopy; DeleteSelection; Adjust; hasChanged := True; end; else Consumed := False; end; if not Consumed then begin // checking for movement keys: case keycode of keyLeft: if FCursorPos > 0 then begin consumed := True; Dec(FCursorPos); if (ssCtrl in shiftstate) then // word search... // while (FCursorPos > 0) and not ptkIsAlphaNum(copy(FText,FCursorPos,1)) // do Dec(FCursorPos); // while (FCursorPos > 0) and ptkIsAlphaNum(copy(FText,FCursorPos,1)) // do Dec(FCursorPos); ; end; keyRight: if FCursorPos < UTF8Length(FText) then begin consumed := True; Inc(FCursorPos); if (ssCtrl in shiftstate) then // word search... // while (FCursorPos < Length(FText)) and ptkIsAlphaNum(copy(FText,FCursorPos+1,1)) // do Inc(FCursorPos); // while (FCursorPos < Length(FText)) and not ptkIsAlphaNum(copy(FText,FCursorPos+1,1)) // do Inc(FCursorPos); ; end; keyHome: begin consumed := True; FCursorPos := 0; end; keyEnd: begin consumed := True; FCursorPos := UTF8Length(FText); end; end; if Consumed then begin FSelecting := (ssShift in shiftstate); if FSelecting then FSelOffset := FCursorPos - FSelStart else StopSelection; Adjust; end; end; // movement key checking if not Consumed then begin consumed := True; case keycode of keyBackSpace: begin if FCursorPos > 0 then begin UTF8Delete(FText, FCursorPos, 1); Dec(FCursorPos); hasChanged := True; end;// backspace end; keyDelete: begin if FSelOffset <> 0 then DeleteSelection else if FCursorPos < UTF8Length(FText) then UTF8Delete(FText, FCursorPos + 1, 1); hasChanged := True; end; else Consumed := False; end; if Consumed then begin StopSelection; Adjust; end; end; { if } if consumed then RePaint else inherited; if hasChanged then if Assigned(FOnChange) then FOnChange(self); end; procedure TfpgBaseEdit.HandleLMouseDown(x, y: integer; shiftstate: TShiftState); begin fpgApplication.HideHint; inherited HandleLMouseDown(x, y, shiftstate); FCursorPx := x; AdjustTextOffset(True); FMouseDragPos := FCursorPos; if (ssShift in shiftstate) then FSelOffset := FCursorPos - FSelStart else begin FSelStart := FCursorPos; FSelOffset := 0; end; AdjustDrawingInfo; RePaint; end; procedure TfpgBaseEdit.HandleRMouseUp(x, y: integer; shiftstate: TShiftState); begin inherited HandleRMouseUp(x, y, shiftstate); if Assigned(PopupMenu) then PopupMenu.ShowAt(self, x, y) else ShowDefaultPopupMenu(x, y, ShiftState); end; procedure TfpgBaseEdit.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); var cp: integer; begin if (btnstate and MOUSE_LEFT) = 0 then // Left button not down begin inherited HandleMouseMove(x, y, btnstate, shiftstate); Exit; //==> end; cp := FCursorPos; FCursorPx := x; AdjustTextOffset(True); if FCursorPos <> cp then begin FSelOffset := FCursorPos - FSelStart; AdjustDrawingInfo; Repaint; end; end; procedure TfpgBaseEdit.HandleDoubleClick(x, y: integer; button: word; shiftstate: TShiftState); begin // button is always Mouse_Left, but lets leave this test here for good measure if button = MOUSE_LEFT then SelectAll else inherited; end; procedure TfpgBaseEdit.HandleMouseEnter; begin inherited HandleMouseEnter; if (csDesigning in ComponentState) then Exit; if Enabled then MouseCursor := mcIBeam; end; procedure TfpgBaseEdit.HandleMouseExit; begin inherited HandleMouseExit; if (csDesigning in ComponentState) then Exit; MouseCursor := mcDefault; end; procedure TfpgBaseEdit.HandleSetFocus; begin inherited HandleSetFocus; if AutoSelect then SelectAll; end; procedure TfpgBaseEdit.HandleKillFocus; begin inherited HandleKillFocus; if AutoSelect then FSelOffset := 0; end; function TfpgBaseEdit.GetDrawText: string; begin if not PassWordMode then Result := FText else Result := StringOfChar('*', UTF8Length(FText)); end; constructor TfpgBaseEdit.Create(AOwner: TComponent); begin inherited Create(AOwner); FFont := fpgGetFont('#Edit1'); // owned object ! Focusable := True; FHeight := FFont.Height + 6; FWidth := 120; FTextColor := Parent.TextColor; FBackgroundColor := clBoxColor; FAutoSelect := True; FSelecting := False; FHideSelection := True; FSideMargin := 3; FMaxLength := 0; // no limit FText := ''; FCursorPos := UTF8Length(FText); FSelStart := FCursorPos; FSelOffset := 0; FTextOffset := 0; FPasswordMode := False; FBorderStyle := ebsDefault; FPopupMenu := nil; FDefaultPopupMenu := nil; FOnChange := nil; end; destructor TfpgBaseEdit.Destroy; begin if Assigned(FDefaultPopupMenu) then FDefaultPopupMenu.Free; FFont.Free; inherited Destroy; end; function TfpgBaseEdit.SelectionText: string; begin if FSelOffset <> 0 then begin if FSelOffset < 0 then Result := UTF8Copy(FText, 1 + FSelStart + FSelOffset, -FSelOffset) else begin Result := UTF8Copy(FText, 1 + FSelStart, FSelOffset); end; end else Result := ''; end; procedure TfpgBaseEdit.SetPasswordMode (const AValue: boolean ); begin if FPasswordMode = AValue then Exit; //==> FPasswordMode := AValue; Adjust; RePaint; end; function TfpgBaseEdit.GetFontDesc: string; begin Result := FFont.FontDesc; end; procedure TfpgBaseEdit.SetFontDesc(const AValue: string); begin FFont.Free; FFont := fpgGetFont(AValue); if Height < FFont.Height + 6 then Height:= FFont.Height + 6; Adjust; RePaint; end; procedure TfpgBaseEdit.SetText(const AValue: string); var s: string; prevval: TfpgString; begin if FText = AValue then Exit; prevval := FText; if FMaxLength <> 0 then begin if UTF8Length(FText) > FMaxLength then s := UTF8Copy(AValue, 1, FMaxLength) else s := AValue; end else s := AValue; FText := s; FCursorPos := UTF8Length(FText); FSelStart := FCursorPos; FSelOffset := 0; FTextOffset := 0; Adjust; RePaint; if prevval <> Text then DoOnChange; end; procedure TfpgBaseEdit.DefaultPopupCut(Sender: TObject); begin CutToClipboard; end; procedure TfpgBaseEdit.DefaultPopupCopy(Sender: TObject); begin CopyToClipboard; end; procedure TfpgBaseEdit.DefaultPopupPaste(Sender: TObject); begin PasteFromClipboard end; procedure TfpgBaseEdit.DefaultPopupClearAll(Sender: TObject); begin Clear; end; procedure TfpgBaseEdit.SetDefaultPopupMenuItemsState; var i: integer; itm: TfpgMenuItem; begin for i := 0 to FDefaultPopupMenu.ComponentCount-1 do begin if FDefaultPopupMenu.Components[i] is TfpgMenuItem then begin itm := TfpgMenuItem(FDefaultPopupMenu.Components[i]); // enabled/disable menu items if itm.Name = ipmCut then itm.Enabled := FSelOffset <> 0 else if itm.Name = ipmCopy then itm.Enabled := FSelOffset <> 0 else if itm.Name = ipmPaste then itm.Enabled := fpgClipboard.Text <> '' else if itm.Name = ipmClearAll then itm.Enabled := Text <> ''; end; end; end; procedure TfpgBaseEdit.DoOnChange; begin if Assigned(FOnChange) then FOnChange(self); end; procedure TfpgBaseEdit.ShowDefaultPopupMenu(const x, y: integer; const shiftstate: TShiftState); var itm: TfpgMenuItem; begin if not Assigned(FDefaultPopupMenu) then begin { todo: This text needs to be localized } FDefaultPopupMenu := TfpgPopupMenu.Create(nil); itm := FDefaultPopupMenu.AddMenuItem(rsCut, '', @DefaultPopupCut); itm.Name := ipmCut; itm := FDefaultPopupMenu.AddMenuItem(rsCopy, '', @DefaultPopupCopy); itm.Name := ipmCopy; itm := FDefaultPopupMenu.AddMenuItem(rsPaste, '', @DefaultPopupPaste); itm.Name := ipmPaste; itm := FDefaultPopupMenu.AddMenuItem(rsDelete, '', @DefaultPopupClearAll); itm.Name := ipmClearAll; end; SetDefaultPopupMenuItemsState; FDefaultPopupMenu.ShowAt(self, x, y); end; procedure TfpgBaseEdit.DeleteSelection; var prevval: TfpgString; begin prevval := FText; if FSelOffset <> 0 then begin if FSelOffset < 0 then begin UTF8Delete(FText, 1 + FSelStart + FSelOffset, -FSelOffset); FCurSorPos := FSelStart + FSelOffset; end else begin UTF8Delete(FText, 1 + FSelStart, FSelOffset); FCurSorPos := FSelStart; end; FSelOffset := 0; FSelStart := FCursorPos; end; if prevval <> Text then DoOnChange; end; procedure TfpgBaseEdit.DoCopy; begin if FSelOffset = 0 then Exit; //==> fpgClipboard.Text := SelectionText; end; procedure TfpgBaseEdit.DoPaste; var s: string; prevval: TfpgString; begin prevval := FText; DeleteSelection; s := fpgClipboard.Text; if (FMaxLength > 0) then if UTF8Length(FText) + UTF8Length(s) > FMaxLength then s := UTF8Copy(s, 1, FMaxLength - UTF8Length(FText)); // trim the clipboard text if needed if UTF8Length(s) < 1 then Exit; //==> UTF8Insert(s, FText, FCursorPos + 1); FCursorPos := FCursorPos + UTF8Length(s); FSelStart := FCursorPos; Adjust; Repaint; if prevval <> Text then DoOnChange; end; procedure TfpgBaseEdit.SetAutoSelect(const AValue: Boolean); begin if FAutoSelect = AValue then Exit; //==> FAutoSelect := AValue; end; procedure TfpgBaseEdit.SelectAll; begin FSelecting := True; FSelStart := 0; FSelOffset := UTF8Length(FText); FCursorPos := FSelOffset; Adjust; Repaint; end; procedure TfpgBaseEdit.Clear; begin Text := ''; end; procedure TfpgBaseEdit.ClearSelection; begin DeleteSelection; Adjust; RePaint; end; procedure TfpgBaseEdit.CopyToClipboard; begin DoCopy; end; procedure TfpgBaseEdit.CutToClipboard; begin DoCopy; DeleteSelection; Adjust; RePaint; end; function TfpgBaseEdit.GetClientRect: TfpgRect; begin case BorderStyle of ebsNone: inherited GetClientRect; ebsDefault: Result.SetRect(2, 2, Width-4, Height-4); ebsSingle: Result.SetRect(1, 1, Width-2, Height-2); end; end; procedure TfpgBaseEdit.PasteFromClipboard; begin DoPaste; end; { TfpgBaseNumericEdit } procedure TfpgBaseNumericEdit.AdjustTextOffset(UsePxCursorPos: boolean); {If UsePxCursorPos then determines FCursorPos from FCursorPx (that holds mouse pointer coordinates) Calculates exact FCursorPx (relative to the widget bounding box) from FCursorPos Calculates FTextOffset based on FCursorPx} var dtext: string; ch: string; // current character chnum: integer; // its ordinal number chx: integer; // its X position relative to widget bestchx: integer; // chx, nearest to the mouse position (indicated by FCursorPx if UsePxCursorPos = True) tw: integer; // total characters width, that becomes FCursorPx relative to the beginning of the text ptw: integer; dpos: integer; // helps to pass through an utf-8 string quickly VisibleWidth: integer; // width of the edit field minus side margins begin if UsePxCursorPos then begin if FCursorPx > 0 then // bestchx < chx minimum bestchx := Low(chx) + 1 + FCursorPx else // bestchx > chx maximum bestchx := High(chx) - 1 + FCursorPx; end else FCursorPx := 0; dtext := GetDrawText; ch := ''; chnum := 0; tw := 0; dpos := 0; while dpos <= Length(dtext) do begin dpos := UTF8CharAtByte(dtext, dpos, ch); ptw := tw; tw := tw + FFont.TextWidth(ch); case FAlignment of taLeftJustify: chx := tw - FTextOffset + FSideMargin; taRightJustify: chx := tw - FTextOffset - FSideMargin + Width - 2 - FFont.TextWidth(dtext); end; if UsePxCursorPos then begin if abs(chx - FCursorPx) < abs(bestchx - FCursorPx) then begin bestchx := chx; FCursorPos := chnum; end else begin tw := ptw; break; end; end else begin if chnum >= FCursorPos then break; end; Inc(chnum); end; VisibleWidth := (FWidth - 2 * FSideMargin); if tw - FTextOffset > VisibleWidth - 2 then FTextOffset := tw - VisibleWidth + 2 else if tw - FTextOffset < 0 then begin FTextOffset := tw; if tw <> 0 then Dec(FTextOffset, 2); end; case FAlignment of taLeftJustify: FCursorPx := tw - FTextOffset + FSideMargin; taRightJustify: FCursorPx := tw - FTextOffset - FSideMargin + Width - FFont.TextWidth(dtext); end; end; procedure TfpgBaseNumericEdit.AdjustDrawingInfo; // Calculates FVisSelStartPx, FVisSelEndPx, FVisibleText, FDrawOffset var vtstartbyte, vtendbyte: integer; // visible characters' start/end in utf-8 string, bytes bestfx, bestlx: integer; dtext: string; ch: string; // current character chnum: integer; // its ordinal number chx: integer; // its X position relative to widget tw: integer; // total characters width, that becomes FCursorPx relative to the beginning of the text ptw: integer; // total width on the previous step dpos: integer; // helps to pass through an utf-8 string quickly pdp: integer; // dpos on the previous step vstart, vend: integer; // visible area start and end, pixels slstart, slend: integer; // selection start and end, pixels begin vstart := FSideMargin; vend := FWidth - FSideMargin; if FSelOffset > 0 then begin slstart := FSelStart; slend := FSelStart + FSelOffset; end else begin slstart := FSelStart + FSelOffset; slend := FSelStart; end; FVisSelStartPx := vend; // because we stop the search FVisSelEndPx := vend; // after last visible character is found bestfx := Low(chx) + 1 + vstart; bestlx := Low(chx) + 1 + vend; dtext := GetDrawText; ch := ''; chnum := 0; tw := 0; dpos := 0; FDrawOffset := 0; while dpos <= Length(dtext) do begin pdp := dpos; dpos := UTF8CharAtByte(dtext, dpos, ch); ptw := tw; tw := tw + FFont.TextWidth(ch); case FAlignment of taLeftJustify: chx := tw - FTextOffset + FSideMargin; taRightJustify: chx := tw - FTextOffset - FSideMargin + Width - 2 - FFont.TextWidth(dtext); end; // calculate selection-related fields if chnum = slstart then FVisSelStartPx := chx; if chnum = slend then FVisSelEndPx := chx; // search for the first/last visible characters if abs(chx - vstart) < abs(bestfx - vstart) then begin bestfx := chx; vtstartbyte := pdp; case FAlignment of taLeftJustify: FDrawOffset := ptw; taRightJustify: FDrawOffset := ptw + Width - 2 - FFont.TextWidth(dtext); end; end; // in small edit field the same character can be both the first and the last, so no 'else' allowed if abs(chx - vend) < abs(bestlx - vend) then begin bestlx := chx; vtendbyte := UTF8CharAtByte(dtext, dpos, ch); // plus one more character end else break; // we can safely break after last visible character is found Inc(chnum); end; if FVisSelStartPx < vstart then FVisSelStartPx := vstart; if FVisSelEndPx > vend then FVisSelEndPx := vend; // FVisibleText := UTF8Copy(dtext, fvc, lvc - fvc + 2); FVisibleText := Copy(dtext, vtstartbyte, vtendbyte - vtstartbyte); FDrawOffset := FTextOffset - FDrawOffset; end; 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: TfpgChar); 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: TfpgChar); begin if FThousandSeparator=AValue then exit; FThousandSeparator:=AValue; end; procedure TfpgBaseNumericEdit.SetShowThousand; var i,long: integer; txt, texte, decimal: string; begin if FDecimals > 0 then begin if Pos(FDecimalSeparator, fText) > 0 then begin txt := UTF8Copy(fText, 1, Pred(UTF8Pos(FDecimalSeparator, fText))); if UTF8Length(fText)-UTF8Pos(FDecimalSeparator, fText) > FDecimals then decimal := UTF8Copy(fText, Succ(UTF8Pos(FDecimalSeparator, fText)), FDecimals) else decimal := UTF8Copy(fText, Succ(UTF8Pos(FDecimalSeparator, fText)), UTF8Length(fText)-UTF8Pos(FDecimalSeparator, fText)); end else txt := fText; end else begin if FDecimals = 0 then begin if Pos(FDecimalSeparator, fText) > 0 then txt := UTF8Copy(fText, 1, Pred(UTF8Pos(FDecimalSeparator, fText))) else txt := fText; end else if Pos(FDecimalSeparator, fText) > 0 then begin txt := UTF8Copy(fText, 1, Pred(UTF8Pos(FDecimalSeparator, fText))); decimal := UTF8Copy(fText, Succ(UTF8Pos(FDecimalSeparator, fText)), UTF8Length(fText)-UTF8Pos(FDecimalSeparator, fText)); end else txt := fText; end; if ShowThousand then begin if fText > '' then if fText[1] = '-' then txt:= UTF8Copy(txt, 2, UTF8Length(txt)-1); long := UTF8Length(txt); if long = 0 then texte := '' else begin for i := 1 to UTF8Length(txt) do if fpgCharAt(txt, i) = FThousandSeparator then begin txt:= UTF8Copy(txt, 1, i - 1) + UTF8Copy(txt, i + 1, long - i); dec(long); end; i := 0; texte := ''; repeat if i > 0 then if ((i mod 3) = 0) and (fpgCharAt(txt,UTF8Length(txt)-UTF8Length(texte)) <> FThousandSeparator) then begin texte := FThousandSeparator + texte; if fText[1] = '-' then begin if Pred(FCursorPos) <= UTF8Length(texte) then Inc(FCursorPos); end else if FCursorPos <= UTF8Length(texte) then Inc(FCursorPos); end; texte := Copy(txt, long - i, 1) + texte; inc(i); until i = long; end; if fText > '' then if fText[1] = '-' then if UTF8Pos(FDecimalSeparator, fText) > 0 then fText := '-' + texte + FDecimalSeparator + decimal else fText := '-' + texte else if UTF8Pos(FDecimalSeparator, fText) > 0 then fText := texte + FDecimalSeparator + decimal else fText := texte + decimal; end; end; procedure TfpgBaseNumericEdit.Justify; begin //based on Alignment property this method will align the derived edit correctly. end; procedure TfpgBaseNumericEdit.HandlePaint; var x: TfpgCoord; r: TfpgRect; // paint selection rectangle procedure DrawSelection; var lcolor: TfpgColor; r: TfpgRect; begin if Focused then begin lcolor := clSelection; Canvas.SetTextColor(clSelectionText); end else begin lcolor := clInactiveSel; Canvas.SetTextColor(clText1); end; r.SetRect(FVisSelStartPx, 3, FVisSelEndPx - FVisSelStartPx, FFont.Height); Canvas.SetColor(lcolor); Canvas.FillRectangle(r); Canvas.SetTextColor(clWhite); Canvas.AddClipRect(r); fpgStyle.DrawString(Canvas, -FDrawOffset - FSideMargin, 3, FVisibleText, Enabled); Canvas.ClearClipRect; end; begin if Alignment = taRightJustify then begin inherited HandlePaint; r := GetClientRect; Canvas.SetClipRect(r); Canvas.Clear(BackgroundColor); Canvas.SetFont(Font); Canvas.SetTextColor(TextColor); x := r.Right - Font.TextWidth(Text) - 1; // 1 is the spacing from client edge Canvas.DrawString(x,r.Top+1,Text); if Focused then begin // drawing selection if FSelOffset <> 0 then DrawSelection; fpgCaret.SetCaret(Canvas, FCursorPx - FSideMargin, r.Top+1, fpgCaret.Width, Font.Height); end; end else inherited; end; procedure TfpgBaseNumericEdit.FormatEdit; begin SetShowThousand; // 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; FDecimalSeparator := DecimalSeparator; FThousandSeparator := ThousandSeparator; NegativeColor := clRed; OldColor := TextColor; end; { TfpgEditInteger } function TfpgEditInteger.GetValue: integer; var txt: string; begin if ShowThousand then begin if Copy(fText, 1, 1) = '-' then txt := Copy(ftext, 2, Length(fText) - 1) else txt := fText; while UTF8Pos(FThousandSeparator, txt) > 0 do txt := UTF8Copy(txt, 1, Pred(UTF8Pos(FThousandSeparator, txt))) +UTF8Copy(txt, Succ(UTF8Pos(FThousandSeparator, txt)), Length(txt) - UTF8Pos(FThousandSeparator, txt)); if UTF8Copy(fText, 1, 1) = '-' then fText := '-' + txt else fText := txt; end; if fText = '-' then begin Result := 0; Text := fText; end else begin if Text <> '' then begin try Result := StrToInt(fText); except on E: EConvertError do begin Result := 0; Text := ''; Invalidate; end; end; end else Result := 0; end; end; procedure TfpgEditInteger.SetValue(const AValue: integer); begin try Text := IntToStr(AValue); FormatEdit; except on E: EConvertError do Text := ''; end; 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 (AText = '-') and (UTF8Pos(AText, Text) <= 0)) then consumed := False else consumed := True; inherited HandleKeyChar(AText, shiftstate, consumed); end; procedure TfpgEditInteger.HandleSetFocus; begin try if GetValue = 0 then Text := '' else Text := IntToStr(GetValue); except on E: EConvertError do Text := ''; end; inherited HandleSetFocus; end; procedure TfpgEditInteger.HandleKillFocus; begin try Text := IntToStr(GetValue); FormatEdit; except on E: EConvertError do Text := ''; end; inherited HandleKillFocus; end; procedure TfpgEditInteger.HandlePaint; begin inherited HandlePaint; // To make it more visible in the UI Designer if csDesigning in ComponentState then begin Canvas.SetTextColor(clInactiveWgFrame); Canvas.DrawString(2, 3, ''); end; end; constructor TfpgEditInteger.Create(AOwner: TComponent); begin inherited Create(AOwner); FShowThousand := True; FDecimals := 0; end; { TfpgEditFloat } function TfpgEditFloat.GetValue: extended; var txt: string; begin if FDecimals > 0 then begin if UTF8Pos(FDecimalSeparator, fText) > 0 then if UTF8Length(fText)-UTF8Pos(FDecimalSeparator, fText) > FDecimals then fText := UTF8Copy(fText, 1, UTF8Length(fText) - 1); end else if FDecimals = 0 then if UTF8Pos(FDecimalSeparator, fText) > 0 then fText := UTF8Copy(fText, 1, UTF8Length(fText) - 1); if ShowThousand then begin if Copy(fText, 1, 1) = '-' then // No need for utf8 version here txt := Copy(ftext, 2, Length(fText) - 1) else txt := fText; while UTF8Pos(FThousandSeparator, txt) > 0 do txt := UTF8Copy(txt, 1, Pred(UTF8Pos(FThousandSeparator, txt))) +UTF8Copy(txt, Succ(UTF8Pos(FThousandSeparator, txt)), UTF8Length(txt) - UTF8Pos(FThousandSeparator, txt)); if Copy(fText, 1, 1) = '-' then // No need for utf8 version here fText := '-' + txt else fText := txt; end; if fText = '-' then begin Result := 0; Text := fText; end else begin if fText <> '' then begin try Result := StrToFloat(fText); except on E: EConvertError do begin Result := 0; Text := ''; Invalidate; end; end; { try..except } end else Result := 0; end; end; procedure TfpgEditFloat.SetValue(const AValue: extended); begin try if FFixedDecimals then Text := FloatToStrF(AValue, ffFixed, 18, FDecimals) else Text := FloatToStr(AValue); FormatEdit; except on E: EConvertError do Text := ''; end; end; procedure TfpgEditFloat.SetDecimals(const AValue: integer); begin if AValue < -1 then Exit; // => if FDecimals <> AValue then FDecimals := AValue end; procedure TfpgEditFloat.SetFixedDecimals(const AValue: boolean); begin if FFixedDecimals <> AValue then FFixedDecimals := AValue; 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 (AText = '-') and (UTF8Pos(AText, Text) <= 0)) or ((AText = FDecimalSeparator) and (UTF8Pos(AText, Text) <= 0)) then consumed := False else consumed := True; inherited HandleKeyChar(AText, shiftstate, consumed); end; procedure TfpgEditFloat.HandleSetFocus; begin try if GetValue = 0 then Text := '' else begin if FFixedDecimals then Text := FloatToStrF(GetValue, ffFixed, 18, FDecimals) else Text := FloatToStr(GetValue); end; except on E: EConvertError do Text := ''; end; inherited HandleSetFocus; end; procedure TfpgEditFloat.HandleKillFocus; begin try if FFixedDecimals then Text := FloatToStrF(GetValue, ffFixed, 18, FDecimals) else Text := FloatToStr(GetValue); FormatEdit; except on E: EConvertError do Text := ''; end; inherited HandleKillFocus; end; procedure TfpgEditFloat.HandlePaint; begin inherited HandlePaint; // To make it more visible in the UI Designer if csDesigning in ComponentState then begin Canvas.SetTextColor(clInactiveWgFrame); Canvas.DrawString(2, 3, ''); end; end; constructor TfpgEditFloat.Create(AOwner: TComponent); begin inherited Create(AOwner); FDecimals := -1; FFixedDecimals := False; FShowThousand := True; end; { TfpgEditCurrency } function TfpgEditCurrency.GetValue: Currency; var txt: string; begin if FDecimals > 0 then if UTF8Pos(FDecimalSeparator, fText) > 0 then if UTF8Length(fText)-UTF8Pos(FDecimalSeparator, fText) > FDecimals then fText := UTF8Copy(fText, 1, UTF8Length(fText) - 1); if ShowThousand then begin if Copy(fText, 1, 1) = '-' then txt := Copy(ftext, 2, Length(fText) - 1) else txt := fText; while UTF8Pos(FThousandSeparator, txt) > 0 do txt := UTF8Copy(txt, 1, Pred(UTF8Pos(FThousandSeparator, txt))) +UTF8Copy(txt, Succ(UTF8Pos(FThousandSeparator, txt)), UTF8Length(txt) - UTF8Pos(FThousandSeparator, txt)); if Copy(fText, 1, 1) = '-' then fText := '-' + txt else fText := txt; end; if fText = '-' then begin Result := 0; Text:= fText; end else if fText > '' then try Result := StrToCurr(fText); except on E: EConvertError do begin Result := 0; Text := ''; Invalidate; end; end else Result := 0; end; procedure TfpgEditCurrency.SetValue(const AValue: Currency); begin try Text := FloatToStrF(AValue, ffFixed, -1, FDecimals); FormatEdit; except on E: EConvertError do Text := ''; end; end; procedure TfpgEditCurrency.SetDecimals(AValue: integer); begin if (AValue < 0) or (AValue > 4) then Exit; // => if FDecimals <> AValue then FDecimals := AValue end; procedure TfpgEditCurrency.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: Boolean); begin case keycode of keyReturn, keyPEnter, keyTab: if FDecimals > 0 then begin if Pos(FDecimalSeparator, fText) = 0 then begin fText := fText + FDecimalSeparator; Inc(FCursorPos); end; if UTF8Length(fText)-UTF8Pos(FDecimalSeparator, fText) < FDecimals then while UTF8Length(fText)-UTF8Pos(FDecimalSeparator, fText) < FDecimals do begin fText := fText + '0'; Inc(FCursorPos); end; end; end; inherited HandleKeyPress(keycode,shiftstate,consumed); end; procedure TfpgEditCurrency.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 (AText = '-') and (UTF8Pos(AText, Text) <= 0)) or ((AText = FDecimalSeparator) and (UTF8Pos(AText, Text) <= 0)) then consumed := False else consumed := True; inherited HandleKeyChar(AText, shiftstate, consumed); end; procedure TfpgEditCurrency.HandleSetFocus; begin try if GetValue = 0 then Text := '' else Text := FloatToStrF(GetValue, ffFixed, -1, FDecimals); except on E: EConvertError do Text := ''; end; inherited HandleSetFocus; end; procedure TfpgEditCurrency.HandleKillFocus; begin try Text := FloatToStrF(GetValue, ffFixed, -1, FDecimals); FormatEdit; except on E: EConvertError do Text := ''; end; inherited HandleKillFocus; end; procedure TfpgEditCurrency.HandlePaint; begin inherited HandlePaint; // To make it more visible in the UI Designer if csDesigning in ComponentState then begin Canvas.SetTextColor(clInactiveWgFrame); Canvas.DrawString(2, 3, ''); end; end; constructor TfpgEditCurrency.Create(AOwner: TComponent); begin inherited Create(AOwner); FDecimals := 2; FShowThousand := True; end; end.