paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 23:59:10 +02:00
Code Issues Packages Projects Releases Wiki Activity

ValEdit: Start implementing validating: don't accept duplicate Key names.

Browse Source 
git-svn-id: trunk@39491 -
This commit is contained in:
bart 2012-12-09 16:51:01 +00:00
parent 5b1bd9549c
commit 18bd334bfa
1 changed files with 30 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
lcl/valedit.pas
View File

@ -5,7 +5,7 @@ unit ValEdit;
interface interface
uses uses
Classes, SysUtils, Grids, LResources; Classes, SysUtils, Grids, LResources, Dialogs, LazUtf8;
type type
@ -78,6 +78,7 @@ type
procedure SetCells(ACol, ARow: Integer; const AValue: string); override; procedure SetCells(ACol, ARow: Integer; const AValue: string); override;
procedure SetEditText(ACol, ARow: Longint; const Value: string); override; procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
procedure TitlesChanged(Sender: TObject); procedure TitlesChanged(Sender: TObject);
function ValidateEntry(const ACol,ARow:Integer; const OldValue:string; var NewValue:string): boolean; override;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
@ -202,6 +203,10 @@ type
end; end;
const
//ToDo: Make this a resourcestring in lclstrconsts unit, once we are satisfied with the implementation of validating
rsVLEDuplicateKey = 'Duplicate Key:'+LineEnding+'A key with name "%s" already exists at column %d';
procedure Register; procedure Register;
implementation implementation
@ -501,9 +506,6 @@ procedure TValueListEditor.SetEditText(ACol, ARow: Longint; const Value: string)
begin begin
inherited SetEditText(ACol, ARow, Value); inherited SetEditText(ACol, ARow, Value);
Cells[ACol, ARow] := Value; Cells[ACol, ARow] := Value;
// ToDo: There must be a check for duplicate keys but it must
// not be triggered while the user is typing.
// The error must be postponed until user moves to other cell.
end; end;
procedure TValueListEditor.TitlesChanged(Sender: TObject); procedure TValueListEditor.TitlesChanged(Sender: TObject);
@ -514,6 +516,30 @@ begin
Invalidate; Invalidate;
end; end;
function TValueListEditor.ValidateEntry(const ACol, ARow: Integer;
const OldValue: string; var NewValue: string): boolean;
var
Index, i: Integer;
begin
Result := inherited ValidateEntry(ACol, ARow, OldValue, NewValue);
if ((ACol - FixedCols) = 0) then
begin//Check for duplicate key names (only in "Key" column)
Index := ARow - FixedRows;
for i := 0 to FStrings.Count - 1 do
begin
if (Index <> i) then
begin
if (Utf8CompareText(FStrings.Names[i], NewValue) = 0) then
begin
Result := False;
ShowMessage(Format(rsVLEDuplicateKey,[NewValue, i + FixedRows]));
if Editor is TStringCellEditor then TStringCelleditor(Editor).SelectAll;
end;
end;
end;
end;
end;
class procedure TValueListEditor.WSRegisterClass; class procedure TValueListEditor.WSRegisterClass;
begin begin
// RegisterPropertyToSkip(Self, 'SomeProperty', 'VCL compatibility property', ''); // RegisterPropertyToSkip(Self, 'SomeProperty', 'VCL compatibility property', '');