lazarus/lcl/valedit.pas

1637 lines
49 KiB
ObjectPascal

unit ValEdit;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, Contnrs, Variants,
Controls, StdCtrls, Grids, LResources, Dialogs, LCLType, LCLStrConsts,
Laz2_XMLCfg;
type
TValueListEditor = class; // Forward declaration
TValueListStrings = class;
TEditStyle = (esSimple, esEllipsis, esPickList);
TVleSortCol = (colKey, colValue);
{ TItemProp }
TItemProp = class(TPersistent)
private
FGrid: TValueListEditor;
FEditMask: string;
FEditStyle: TEditStyle;
FPickList: TStrings;
FMaxLength: Integer;
FReadOnly: Boolean;
FKeyDesc: string;
function GetPickList: TStrings;
procedure PickListChange(Sender: TObject);
procedure SetEditMask(const AValue: string);
procedure SetMaxLength(const AValue: Integer);
procedure SetReadOnly(const AValue: Boolean);
procedure SetEditStyle(const AValue: TEditStyle);
procedure SetPickList(const AValue: TStrings);
procedure SetKeyDesc(const AValue: string);
protected
procedure AssignTo(Dest: TPersistent); override;
public
constructor Create(AOwner: TValueListEditor);
destructor Destroy; override;
// function HasPickList: Boolean;
published
property EditMask: string read FEditMask write SetEditMask;
property EditStyle: TEditStyle read FEditStyle write SetEditStyle;
property KeyDesc: string read FKeyDesc write SetKeyDesc;
property PickList: TStrings read GetPickList write SetPickList;
property MaxLength: Integer read FMaxLength write SetMaxLength;
property ReadOnly: Boolean read FReadOnly write SetReadOnly;
end;
{ TItemPropList }
TItemPropList = class
private
FList: TFPObjectList;
FStrings: TValueListStrings;
function GetCount: Integer;
function GetItem(Index: Integer): TItemProp;
procedure SetItem(Index: Integer; AValue: TItemProp);
protected
public
procedure Add(AValue: TItemProp);
procedure Assign(Source: TItemPropList);
procedure Clear;
procedure Delete(Index: Integer);
procedure Exchange(Index1, Index2: Integer);
procedure Insert(Index: Integer; AValue: TItemProp);
public
constructor Create(AOwner: TValueListStrings);
destructor Destroy; override;
public
property Count: Integer read GetCount;
property Items[Index: Integer]: TItemProp read GetItem write SetItem; default;
end;
{ TValueListStrings }
TValueListStrings = class(TStringList)
private
FGrid: TValueListEditor;
FItemProps: TItemPropList;
function GetItemProp(const AKeyOrIndex: Variant): TItemProp;
procedure QuickSortStringsAndItemProps(L, R: Integer; CompareFn: TStringListSortCompare);
function CanHideShowingEditorAtIndex(Index: Integer): Boolean;
protected
procedure InsertItem(Index: Integer; const S: string; AObject: TObject); override;
procedure InsertItem(Index: Integer; const S: string); override;
procedure Put(Index: Integer; const S: String); override;
public
constructor Create(AOwner: TValueListEditor);
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure Clear; override;
procedure CustomSort(Compare: TStringListSortCompare); override;
procedure Delete(Index: Integer); override;
procedure Exchange(Index1, Index2: Integer); override;
end;
TKeyValuePair = record
Key, Value: String;
end;
TDisplayOption = (doColumnTitles, doAutoColResize, doKeyColFixed);
TDisplayOptions = set of TDisplayOption;
TKeyOption = (keyEdit, keyAdd, keyDelete, keyUnique);
TKeyOptions = set of TKeyOption;
TGetPickListEvent = procedure(Sender: TObject; const KeyName: string;
Values: TStrings) of object;
TOnValidateEvent = procedure(Sender: TObject; ACol, ARow: Longint;
const KeyName, KeyValue: string) of object;
{ TValueListEditor }
TValueListEditor = class(TCustomStringGrid)
private
FTitleCaptions: TStrings;
FCreating: Boolean;
FStrings: TValueListStrings;
FKeyOptions: TKeyOptions;
FDisplayOptions: TDisplayOptions;
FDropDownRows: Integer;
FOnGetPickList: TGetPickListEvent;
FOnStringsChange: TNotifyEvent;
FOnStringsChanging: TNotifyEvent;
FOnValidate: TOnValidateEvent;
FRowTextOnEnter: TKeyValuePair;
FLastEditedRow: Integer;
FUpdatingKeyOptions: Boolean;
function GetItemProp(const AKeyOrIndex: Variant): TItemProp;
procedure SetItemProp(const AKeyOrIndex: Variant; AValue: TItemProp);
procedure StringsChange(Sender: TObject);
procedure StringsChanging(Sender: TObject);
function GetOptions: TGridOptions;
function GetKey(Index: Integer): string;
function GetValue(const Key: string): string;
procedure SetDisplayOptions(const AValue: TDisplayOptions);
procedure SetDropDownRows(const AValue: Integer);
procedure SetKeyOptions(AValue: TKeyOptions);
procedure SetKey(Index: Integer; const Value: string);
procedure SetValue(const Key: string; AValue: string);
procedure SetOptions(AValue: TGridOptions);
procedure SetStrings(const AValue: TValueListStrings);
procedure SetTitleCaptions(const AValue: TStrings);
procedure UpdateTitleCaptions(const KeyCap, ValCap: String);
protected
class procedure WSRegisterClass; override;
procedure SetFixedCols(const AValue: Integer); override;
procedure ShowColumnTitles;
procedure AdjustRowCount; virtual;
procedure ColRowExchanged(IsColumn: Boolean; index, WithIndex: Integer); override;
procedure ColRowDeleted(IsColumn: Boolean; index: Integer); override;
procedure DefineCellsProperty(Filer: TFiler); override;
procedure InvalidateCachedRow;
procedure GetAutoFillColumnInfo(const Index: Integer; var aMin,aMax,aPriority: Integer); override;
function GetEditText(ACol, ARow: Integer): string; override;
function GetCells(ACol, ARow: Integer): string; override;
function GetDefaultEditor(Column: Integer): TWinControl; override;
function GetRowCount: Integer;
procedure KeyDown(var Key : Word; Shift : TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure LoadContent(cfg: TXMLConfig; Version: Integer); override;
procedure ResetDefaultColWidths; override;
procedure SaveContent(cfg: TXMLConfig); override;
procedure SetCells(ACol, ARow: Integer; const AValue: string); override;
procedure SetColCount(AValue: Integer); override;
procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
procedure SetFixedRows(const AValue: Integer); override;
procedure SetRowCount(AValue: Integer);
procedure Sort(ColSorting: Boolean; index,IndxFrom,IndxTo:Integer); override;
procedure TitlesChanged(Sender: TObject);
function ValidateEntry(const ACol,ARow:Integer; const OldValue:string; var NewValue:string): boolean; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Clear;
procedure DeleteColRow(IsColumn: Boolean; index: Integer);
procedure DeleteRow(Index: Integer); override;
procedure DeleteCol(Index: Integer); override;
function FindRow(const KeyName: string; out aRow: Integer): Boolean;
procedure InsertColRow(IsColumn: boolean; index: integer);
function InsertRow(const KeyName, Value: string; Append: Boolean): Integer;
procedure InsertRowWithValues(Index: Integer; Values: array of String);
procedure ExchangeColRow(IsColumn: Boolean; index, WithIndex: Integer); override;
function IsEmptyRow: Boolean; {Delphi compatible function}
function IsEmptyRow(aRow: Integer): Boolean; {This for makes more sense to me}
procedure LoadFromCSVStream(AStream: TStream; ADelimiter: Char=',';
UseTitles: boolean=true; FromLine: Integer=0; SkipEmptyLines: Boolean=true); override;
procedure MoveColRow(IsColumn: Boolean; FromIndex, ToIndex: Integer);
function RestoreCurrentRow: Boolean;
procedure Sort(Index, IndxFrom, IndxTo: Integer);
procedure Sort(ACol: TVleSortCol = colKey);
property Modified;
property Keys[Index: Integer]: string read GetKey write SetKey;
property Values[const Key: string]: string read GetValue write SetValue;
property ItemProps[const AKeyOrIndex: Variant]: TItemProp read GetItemProp write SetItemProp;
published
// Same as in TStringGrid
property Align;
property AlternateColor;
property Anchors;
property AutoAdvance;
property AutoEdit;
property BiDiMode;
property BorderSpacing;
property BorderStyle;
property Color;
property Constraints;
property DefaultColWidth;
property DefaultDrawing;
property DefaultRowHeight;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property ExtendedSelect;
property FixedColor;
property FixedCols;
property Flat;
property Font;
property GridLineWidth;
property HeaderHotZones;
property HeaderPushZones;
property MouseWheelOption;
property ParentBiDiMode;
property ParentColor default false;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property RowCount: Integer read GetRowCount write SetRowCount;
property ScrollBars;
property ShowHint;
property TabOrder;
property TabStop;
property TitleFont;
property TitleImageList;
property TitleStyle;
property UseXORFeatures;
property Visible;
property VisibleColCount;
property VisibleRowCount;
property OnBeforeSelection;
property OnButtonClick;
property OnChangeBounds;
property OnCheckboxToggled;
property OnClick;
property OnColRowDeleted;
property OnColRowExchanged;
property OnColRowInserted;
property OnColRowMoved;
property OnCompareCells;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnDblClick;
property OnDrawCell;
property OnEditButtonClick; deprecated;
property OnEditingDone;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetEditMask;
property OnGetEditText;
property OnHeaderClick;
property OnHeaderSized;
property OnHeaderSizing;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnMouseWheelHorz;
property OnMouseWheelLeft;
property OnMouseWheelRight;
property OnPickListSelect;
property OnPrepareCanvas;
property OnResize;
property OnSelectEditor;
property OnSelection;
property OnSelectCell;
property OnSetEditText;
property OnShowHint;
property OnStartDock;
property OnStartDrag;
property OnTopLeftChanged;
property OnUserCheckboxBitmap;
property OnUTF8KeyPress;
property OnValidateEntry;
// Compatible with Delphi TValueListEditor:
property DisplayOptions: TDisplayOptions read FDisplayOptions
write SetDisplayOptions default [doColumnTitles, doAutoColResize, doKeyColFixed];
property DoubleBuffered;
property DropDownRows: Integer read FDropDownRows write SetDropDownRows default 8;
property KeyOptions: TKeyOptions read FKeyOptions write SetKeyOptions default [];
property Options: TGridOptions read GetOptions write SetOptions default
[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColSizing,
goEditing, goAlwaysShowEditor, goThumbTracking];
property Strings: TValueListStrings read FStrings write SetStrings;
property TitleCaptions: TStrings read FTitleCaptions write SetTitleCaptions;
property OnGetPickList: TGetPickListEvent read FOnGetPickList write FOnGetPickList;
property OnStringsChange: TNotifyEvent read FOnStringsChange write FOnStringsChange;
property OnStringsChanging: TNotifyEvent read FOnStringsChanging write FOnStringsChanging;
property OnValidate: TOnValidateEvent read FOnValidate write FOnValidate;
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';
//ToDo: Make this a resourcestring in lclstrconsts unit, once we are satisfied with ShowColumnTitles
rsVLEKey = 'Key';
rsVLEValue = 'Value';
rsVLEInvalidRowColOperation = 'The operation %s is not allowed on a TValueListEditor%s.';
//LoadContent errors
rsVLENoRowCountFound = 'Error reading file "%s":'^m'No value for RowCount found.';
rsVLERowIndexOutOfBounds = 'Error reading file "%s":'^m'Row index out of bounds (%d).';
rsVLEColIndexOutOfBounds = 'Error reading file "%s":'^m'Column index out of bounds (%d).';
rsVLEIllegalColCount = 'ColCount of a TValueListEditor cannot be %d (it can only ever be 2).';
procedure Register;
implementation
type
TCompositeCellEditorAccess = class(TCompositeCellEditor);
{ TItemProp }
constructor TItemProp.Create(AOwner: TValueListEditor);
begin
inherited Create;
FGrid := AOwner;
end;
destructor TItemProp.Destroy;
begin
FPickList.Free;
inherited Destroy;
end;
function TItemProp.GetPickList: TStrings;
begin
if FPickList = Nil then
begin
FPickList := TStringList.Create;
TStringList(FPickList).OnChange := @PickListChange;
end;
Result := FPickList;
end;
procedure TItemProp.PickListChange(Sender: TObject);
begin
if PickList.Count > 0 then begin
if EditStyle = esSimple then
EditStyle := esPickList;
end
else begin
if EditStyle = esPickList then
EditStyle := esSimple;
end;
end;
procedure TItemProp.SetEditMask(const AValue: string);
begin
FEditMask := AValue;
with FGrid do
if EditorMode and (FStrings.UpdateCount = 0) then
InvalidateCell(Col, Row);
end;
procedure TItemProp.SetMaxLength(const AValue: Integer);
begin
FMaxLength := AValue;
with FGrid do
if EditorMode and (FStrings.UpdateCount = 0) then
InvalidateCell(Col, Row);
end;
procedure TItemProp.SetReadOnly(const AValue: Boolean);
begin
FReadOnly := AValue;
with FGrid do
if EditorMode and (FStrings.UpdateCount = 0) then
InvalidateCell(Col, Row);
end;
procedure TItemProp.SetEditStyle(const AValue: TEditStyle);
begin
FEditStyle := AValue;
with FGrid do
if EditorMode and (FStrings.UpdateCount = 0) then
InvalidateCell(Col, Row);
end;
procedure TItemProp.SetPickList(const AValue: TStrings);
begin
GetPickList.Assign(AValue);
with FGrid do
if EditorMode and (FStrings.UpdateCount = 0) then
InvalidateCell(Col, Row);
end;
procedure TItemProp.SetKeyDesc(const AValue: string);
begin
FKeyDesc := AValue;
end;
procedure TItemProp.AssignTo(Dest: TPersistent);
begin
if not (Dest is TItemProp) then
inherited AssignTo(Dest)
else
begin
TItemProp(Dest).EditMask := Self.EditMask;
TItemProp(Dest).EditStyle := Self.EditStyle;
TItemProp(Dest).KeyDesc := Self.KeyDesc;
TItemProp(Dest).PickList.Assign(Self.PickList);
TItemProp(Dest).MaxLength := Self.MaxLength;
TItemProp(Dest).ReadOnly := Self.ReadOnly;
end;
end;
{ TItemPropList }
function TItemPropList.GetItem(Index: Integer): TItemProp;
begin
Result := TItemProp(FList.Items[Index]);
end;
function TItemPropList.GetCount: Integer;
begin
Result := FList.Count;
end;
procedure TItemPropList.SetItem(Index: Integer; AValue: TItemProp);
begin
FList.Items[Index] := AValue;
end;
procedure TItemPropList.Insert(Index: Integer; AValue: TItemProp);
begin
FList.Insert(Index, AValue);
end;
procedure TItemPropList.Add(AValue: TItemProp);
begin
FList.Add(AValue);
end;
procedure TItemPropList.Assign(Source: TItemPropList);
var
Index: Integer;
Prop: TItemProp;
begin
Clear;
if not Assigned(Source) then Exit;
for Index := 0 to Source.Count - 1 do
begin
Prop := TItemProp.Create(FStrings.FGrid);
Prop.Assign(Source.Items[Index]);
Add(Prop);
end;
end;
procedure TItemPropList.Delete(Index: Integer);
begin
FList.Delete(Index);
end;
procedure TItemPropList.Exchange(Index1, Index2: Integer);
begin
FList.Exchange(Index1, index2);
end;
procedure TItemPropList.Clear;
begin
FList.Clear;
end;
constructor TItemPropList.Create(AOwner: TValueListStrings);
begin
FStrings := AOwner;
FList := TFPObjectList.Create(True);
end;
destructor TItemPropList.Destroy;
begin
FList.Free;
inherited Destroy;
end;
{ TValueListStrings }
procedure TValueListStrings.InsertItem(Index: Integer; const S: string; AObject: TObject);
var
MustHideShowingEditor: Boolean;
begin
// ToDo: Check validity of key
//debugln('TValueListStrings.InsertItem: Index = ',dbgs(index),' S = "',S,'" AObject = ',dbgs(aobject));
FGrid.InvalidateCachedRow;
MustHideShowingEditor := CanHideShowingEditorAtIndex(Index);
if MustHideShowingEditor then FGrid.Options := FGrid.Options - [goAlwaysShowEditor];
inherited InsertItem(Index, S, AObject);
FItemProps.Insert(Index, TItemProp.Create(FGrid));
//only restore this _after_ FItemProps is updated!
if MustHideShowingEditor then FGrid.Options := FGrid.Options + [goAlwaysShowEditor];
end;
procedure TValueListStrings.InsertItem(Index: Integer; const S: string);
begin
InsertItem(Index, S, nil);
end;
procedure TValueListStrings.Put(Index: Integer; const S: String);
var
MustHideShowingEditor: Boolean;
begin
// ToDo: Check validity of key
MustHideShowingEditor := CanHideShowingEditorAtIndex(Index);
//debugln('TValueListStrings.Put: MustHideShowingEditor=',DbgS(MustHideShowingEditor));
if MustHideShowingEditor then FGrid.Options := FGrid.Options - [goAlwaysShowEditor];
inherited Put(Index, S);
if MustHideShowingEditor then FGrid.Options := FGrid.Options + [goAlwaysShowEditor];
end;
constructor TValueListStrings.Create(AOwner: TValueListEditor);
begin
inherited Create;
FGrid := AOwner;
FItemProps := TItemPropList.Create(Self);
end;
destructor TValueListStrings.Destroy;
begin
FItemProps.Free;
inherited Destroy;
end;
procedure TValueListStrings.Assign(Source: TPersistent);
begin
FGrid.InvalidateCachedRow;
Clear; //if this is not done, and a TValueListEditor.Sort() is done and then later a Strings.Assign, an exception will occur.
inherited Assign(Source);
if (Source is TValueListStrings) then
FItemProps.Assign(TValueListStrings(Source).FItemProps);
end;
procedure TValueListStrings.Clear;
var
IsShowingEditor: Boolean;
begin
FGrid.InvalidateCachedRow;
IsShowingEditor := goAlwaysShowEditor in FGrid.Options;
if IsShowingEditor then FGrid.Options := FGrid.Options - [goAlwaysShowEditor];
inherited Clear;
FItemProps.Clear;
if IsShowingEditor then FGrid.Options := FGrid.Options + [goAlwaysShowEditor];
end;
{
Duplicates the functionality of TStringList.QuickSort, but also
sorts the ItemProps.
}
procedure TValueListStrings.QuickSortStringsAndItemProps(L, R: Integer;
CompareFn: TStringListSortCompare);
var
Pivot, vL, vR: Integer;
begin
if R - L <= 1 then
begin // a little bit of time saver
if L < R then
if CompareFn(Self, L, R) > 0 then
//Exchange also exchanges FItemProps
Exchange(L, R);
Exit;
end;
vL := L;
vR := R;
Pivot := L + Random(R - L); // they say random is best
while vL < vR do
begin
while (vL < Pivot) and (CompareFn(Self, vL, Pivot) <= 0) do
Inc(vL);
while (vR > Pivot) and (CompareFn(Self, vR, Pivot) > 0) do
Dec(vR);
//Exchange also exchanges FItemProps
Exchange(vL, vR);
if Pivot = vL then // swap pivot if we just hit it from one side
Pivot := vR
else if Pivot = vR then
Pivot := vL;
end;
if Pivot - 1 >= L then
QuickSortStringsAndItemProps(L, Pivot - 1, CompareFn);
if Pivot + 1 <= R then
QuickSortStringsAndItemProps(Pivot + 1, R, CompareFn);
end;
function TValueListStrings.CanHideShowingEditorAtIndex(Index: Integer): Boolean;
var
IndexToRow: Integer;
WC: TWinControl;
EditorHasFocus: Boolean;
begin
IndexToRow := Index + FGrid.FixedRows;
if (FGrid.Editor is TCompositeCellEditor) then
begin
WC := TCompositeCellEditorAccess(FGrid.Editor).GetActiveControl;
if (WC is TCustomEdit) then
EditorHasFocus := TCustomEdit(WC).Focused
else
EditorHasFocus := False;
end
else
EditorHasFocus := Assigned(FGrid.Editor) and FGrid.Editor.Focused;
//debugln('CanHideShowingEditor:');
//debugln(' Assigned(FGrid.Editor) = ',DbgS(Assigned(FGrid.Editor)));
//debugln(' (goAlwaysShowEditor in FGrid.Options) = ',DbgS(goAlwaysShowEditor in FGrid.Options));
//if Assigned(FGrid.Editor) then
// debugln(' FGrid.Editor.Visible = ',DbgS(FGrid.Editor.Visible));
//debugln(' IndexToRow = ',DbgS(IndextoRow));
//debugln(' Count = ',DbgS(Count));
//debugln(' EditorHasFocus = ',DbgS(EditorHasFocus));
Result := Assigned(FGrid.Editor) and
(goAlwaysShowEditor in FGrid.Options) and
FGrid.Editor.Visible and
((IndexToRow = FGrid.Row) or (Count = 0)) and //if Count = 0 we still have an editable row
//if editor is Focussed, we are editing a cell, so we cannot hide!
(not EditorHasFocus);
//debugln('CanHideShowingEditor: Result = ',DbgS(Result));
end;
procedure TValueListStrings.CustomSort(Compare: TStringListSortCompare);
{
Re-implement it, because we need it to call our own QuickSortStringsAndItemProps
and so we cannot use inherited CustomSort
Use BeginUpdate/EndUpdate to avoid numerous Changing/Changed calls
}
begin
If not Sorted and (Count>1) then
begin
try
BeginUpdate;
FGrid.InvalidateCachedRow;
QuickSortStringsAndItemProps(0,Count-1, Compare);
finally
EndUpdate;
end;
end;
end;
procedure TValueListStrings.Delete(Index: Integer);
var
IsShowingEditor: Boolean;
begin
FGrid.InvalidateCachedRow;
IsShowingEditor := CanHideShowingEditorAtIndex(Index);
if IsShowingEditor then FGrid.Options := FGrid.Options - [goAlwaysShowEditor];
inherited Delete(Index);
// Delete also ItemProps
FItemProps.Delete(Index);
//only restore this _after_ FItemProps is updated!
if IsShowingEditor then FGrid.Options := FGrid.Options + [goAlwaysShowEditor];
end;
procedure TValueListStrings.Exchange(Index1, Index2: Integer);
var
MustHideShowingEditor: Boolean;
begin
FGrid.InvalidateCachedRow;
MustHideShowingEditor := CanHideShowingEditorAtIndex(Index1) or CanHideShowingEditorAtIndex(Index2);
if MustHideShowingEditor then FGrid.Options := FGrid.Options - [goAlwaysShowEditor];
inherited Exchange(Index1, Index2);
FItemProps.Exchange(Index1, Index2);
if MustHideShowingEditor then FGrid.Options := FGrid.Options + [goAlwaysShowEditor];
end;
function TValueListStrings.GetItemProp(const AKeyOrIndex: Variant): TItemProp;
var
i: Integer;
s: string;
begin
Result := Nil;
if (Count > 0) and (UpdateCount = 0) then
begin
if VarIsOrdinal(AKeyOrIndex) then
i := AKeyOrIndex
else begin
s := AKeyOrIndex;
i := IndexOfName(s);
if i = -1 then
raise Exception.Create('TValueListStrings.GetItemProp: Key not found: '+s);
end;
if i < FItemProps.Count then
begin
Result := FItemProps.Items[i];
if not Assigned(Result) then
Raise Exception.Create(Format('TValueListStrings.GetItemProp: Index=%d Result=Nil',[i]));
end;
end;
end;
{ TValueListEditor }
constructor TValueListEditor.Create(AOwner: TComponent);
begin
//need FStrings before inherited Create, because they are needed in overridden SelectEditor
FCreating := True;
FStrings := TValueListStrings.Create(Self);
FStrings.NameValueSeparator := '=';
FTitleCaptions := TStringList.Create;
inherited Create(AOwner);
FStrings.OnChange := @StringsChange;
FStrings.OnChanging := @StringsChanging;
TStringList(FTitleCaptions).OnChange := @TitlesChanged;
//Don't use Columns.Add, it interferes with setting FixedCols := 1 (it will then insert an extra column)
{
with Columns.Add do
Title.Caption := 'Key';
with Columns.Add do begin
Title.Caption := 'Value';
DropDownRows := 8;
end;
}
ColCount:=2;
{inherited} RowCount := 2;
FixedCols := 0;
// DefaultColWidth := 150;
// DefaultRowHeight := 18;
// Width := 306;
// Height := 300;
Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
goColSizing, goEditing, goAlwaysShowEditor, goThumbTracking];
FDisplayOptions := [doColumnTitles, doAutoColResize, doKeyColFixed];
Col := 1;
FLastEditedRow := -1;
FDropDownRows := 8;
ShowColumnTitles;
AutoFillColumns := true;
FCreating := False;
end;
destructor TValueListEditor.Destroy;
begin
FTitleCaptions.Free;
FStrings.Free;
inherited Destroy;
end;
procedure TValueListEditor.Clear;
begin
Strings.Clear;
end;
procedure TValueListEditor.DeleteColRow(IsColumn: Boolean; index: Integer);
begin
if not IsColumn then
DeleteRow(Index)
else
DeleteCol(Index);
end;
procedure TValueListEditor.DeleteRow(Index: Integer);
begin
//If we have only one row, it may be empty and we cannot remove
if not ((Index - FixedRows = 0) and (Strings.Count = 0)) then inherited DeleteRow(Index) ;
end;
procedure TValueListEditor.DeleteCol(Index: Integer);
begin
Raise EGridException.CreateFmt(rsVLEInvalidRowColOperation,['DeleteCol','']);
end;
function TValueListEditor.FindRow(const KeyName: string; out aRow: Integer): Boolean;
var
Index: Integer;
begin
Index := Strings.IndexOfName(KeyName);
Result := (Index > -1);
if Result then aRow := Index + FixedRows;
end;
procedure TValueListEditor.InsertColRow(IsColumn: boolean; index: integer);
begin
if not IsColumn then
Strings.InsertItem(Index - FixedRows,'')
else
Raise EGridException.CreateFmt(rsVLEInvalidRowColOperation,['InsertColRow',' on columns']);
end;
function TValueListEditor.InsertRow(const KeyName, Value: string; Append: Boolean): Integer;
var
NewInd, NewRow: Integer;
Line: String;
begin
if not ((KeyName = '') and (Value = '')) then
Line := KeyName + Strings.NameValueSeparator + Value
else
Line := '';
if (Row > Strings.Count) or ((Row - FixedRows) >= Strings.Count)
or (Cells[0, Row] <> '') or (Cells[1, Row] <> '') then
begin // Add a new Key=Value pair
Strings.BeginUpdate;
try
if Append then
begin
if (Strings.Count = 0) then //empty grid
NewInd := 0
else
NewInd := Row - FixedRows + 1 //append after current row
end
else
NewInd := Row - FixedRows; //insert it at current row
Strings.InsertItem(NewInd, Line, Nil);
finally
Strings.EndUpdate;
end;
end
else begin // Use an existing row, just update the Key and Value.
Cells[0, Row] := KeyName;
Cells[1, Row] := Value;
NewInd := Row - FixedRows;
end;
Result := NewInd;
NewRow := NewInd + FixedRows;
if (NewRow <> Row) then Row := NewRow;
end;
procedure TValueListEditor.InsertRowWithValues(Index: Integer; Values: array of String);
var
AKey, AValue: String;
begin
AKey := '';
AValue := '';
if (Length(Values) > 1) then
begin
AKey := Values[0];
AValue := Values[1];
end
else if (Length(Values) = 1) then
AKey := Values[0];
Strings.InsertItem(Index, AKey + Strings.NameValueSeparator + AValue);
end;
procedure TValueListEditor.ExchangeColRow(IsColumn: Boolean; index, WithIndex: Integer);
begin
if not IsColumn then
inherited ExchangeColRow(IsColumn, index, WithIndex)
else
Raise EGridException.CreateFmt(rsVLEInvalidRowColOperation,['ExchangeColRow',' on columns']);
end;
function TValueListEditor.IsEmptyRow: Boolean;
{As per help text on Embarcadero: the function does not have a parameter for row, so assume current one?}
begin
Result := IsEmptyRow(Row);
end;
function TValueListEditor.IsEmptyRow(aRow: Integer): Boolean;
begin
if (Strings.Count = 0) and (aRow - FixedRows = 0) then
//special case: we have just one row, and it is empty
Result := True
else if (aRow = 0) and (FixedRows = 0) then
Result := ((inherited GetCells(0,0)) = EmptyStr) and ((inherited GetCells(1,0)) = EmptyStr)
else
Result := Strings.Strings[aRow - FixedRows] = EmptyStr;
end;
procedure TValueListEditor.LoadFromCSVStream(AStream: TStream;
ADelimiter: Char; UseTitles: boolean; FromLine: Integer;
SkipEmptyLines: Boolean);
begin
inherited LoadFromCSVStream(AStream, ADelimiter, UseTitles, FromLine,
SkipEmptyLines);
if UseTitles then UpdateTitleCaptions(Cells[0,0],Cells[1,0]);
end;
procedure TValueListEditor.MoveColRow(IsColumn: Boolean; FromIndex,
ToIndex: Integer);
var
Line: String;
begin
if not IsColumn then
begin
try
Strings.BeginUpdate;
Line := Strings.Strings[FromIndex - FixedRows];
Strings.Delete(FromIndex - FixedRows);
Strings.InsertItem(ToIndex - FixedRows, Line);
finally
Strings.EndUpdate;
end;
end
else
Raise EGridException.CreateFmt(rsVLEInvalidRowColOperation,['MoveColRow',' on columns']);
end;
function TValueListEditor.RestoreCurrentRow: Boolean;
begin
//DbgOut('RestoreCurrentRow: Row=',DbgS(Row),' FLastEditedRow=',DbgS(FLastEditedRow),' SavedKey=',FRowTextOnEnter.Key,' SavedValue=',FRowTextOnEnter.Value);
Result := False;
if (Row = FLastEditedRow) and Assigned(Editor) and Editor.Focused then
begin
if (Cells[0,Row] <> FRowTextOnEnter.Key) or (Cells[1,Row] <> FRowTextOnEnter.Value) then
begin
try
EditorHide;
if (Cells[0,Row] <> FRowTextOnEnter.Key) then Cells[0,Row] := FRowTextOnEnter.Key;
if (Cells[1,Row] <> FRowTextOnEnter.Value) then Cells[1,Row] := FRowTextOnEnter.Value;
finally
EditorShow(True);
end;
Result := True;
end;
end;
end;
procedure TValueListEditor.Sort(ACol: TVleSortCol = colKey);
begin
SortColRow(True, Ord(ACol));
end;
procedure TValueListEditor.Sort(Index, IndxFrom, IndxTo: Integer);
begin
Sort(True, Index, IndxFrom, IndxTo);
end;
procedure TValueListEditor.StringsChange(Sender: TObject);
begin
Modified := True;
AdjustRowCount;
Invalidate;
if Assigned(OnStringsChange) then
OnStringsChange(Self);
end;
procedure TValueListEditor.StringsChanging(Sender: TObject);
begin
if Assigned(OnStringsChanging) then
OnStringsChanging(Self);
end;
procedure TValueListEditor.SetFixedCols(const AValue: Integer);
begin
if (AValue in [0,1]) then
inherited SetFixedCols(AValue);
end;
procedure TValueListEditor.SetFixedRows(const AValue: Integer);
begin
if AValue in [0,1] then begin // No other values are allowed
if AValue = 0 then // Typically DisplayOptions are changed directly
DisplayOptions := DisplayOptions - [doColumnTitles]
else
DisplayOptions := DisplayOptions + [doColumnTitles]
end;
end;
function TValueListEditor.GetItemProp(const AKeyOrIndex: Variant): TItemProp;
begin
Result := FStrings.GetItemProp(AKeyOrIndex);
end;
procedure TValueListEditor.SetItemProp(const AKeyOrIndex: Variant; AValue: TItemProp);
begin
FStrings.GetItemProp(AKeyOrIndex).Assign(AValue);
end;
function TValueListEditor.GetOptions: TGridOptions;
begin
Result := inherited Options;
end;
procedure TValueListEditor.SetDisplayOptions(const AValue: TDisplayOptions);
// Set number of fixed rows to 1 if titles are shown (based on DisplayOptions).
// Set the local options value, then Adjust Column Widths and Refresh the display.
begin
BeginUpdate;
if (doColumnTitles in DisplayOptions) <> (doColumnTitles in AValue) then
if doColumnTitles in AValue then begin
if RowCount < 2 then
{inherited} RowCount := 2;
inherited SetFixedRows(1);// don't do FixedRows := 1 here, it wil cause infinite recursion (Issue 0029993)
end else
inherited SetFixedRows(0);
if (doAutoColResize in DisplayOptions) <> (doAutoColResize in AValue) then
AutoFillColumns := (doAutoColResize in AValue);
FDisplayOptions := AValue;
ShowColumnTitles;
AdjustRowCount;
EndUpdate;
end;
procedure TValueListEditor.SetDropDownRows(const AValue: Integer);
begin
FDropDownRows := AValue;
// ToDo: If edit list for inplace editing is implemented, set its handler, too.
end;
procedure TValueListEditor.SetKeyOptions(AValue: TKeyOptions);
begin
FUpdatingKeyOptions := True;
// KeyAdd requires KeyEdit, KeyAdd oddly enough does not according to Delphi specs
if KeyAdd in AValue then
Include(AValue, keyEdit);
FKeyOptions := AValue;
if (KeyAdd in FKeyOptions) then
Options := Options + [goAutoAddRows]
else
Options := Options - [goAutoAddRows];
FUpdatingKeyOptions := False;
end;
procedure TValueListEditor.SetOptions(AValue: TGridOptions);
begin
//cannot allow goColMoving
if goColMoving in AValue then
Exclude(AValue, goColMoving);
//temporarily disable this, it causes crashes
if (goAutoAddRowsSkipContentCheck in AValue) then
Exclude(AValue, goAutoAddRowsSkipContentCheck);
inherited Options := AValue;
// Enable also the required KeyOptions for goAutoAddRows
if not FUpdatingKeyOptions and not (csLoading in ComponentState)
and (goAutoAddRows in AValue) then
KeyOptions := KeyOptions + [keyEdit, keyAdd];
end;
procedure TValueListEditor.SetStrings(const AValue: TValueListStrings);
begin
FStrings.Assign(AValue);
end;
procedure TValueListEditor.SetTitleCaptions(const AValue: TStrings);
begin
FTitleCaptions.Assign(AValue);
end;
procedure TValueListEditor.UpdateTitleCaptions(const KeyCap, ValCap: String);
begin
FTitleCaptions.Clear;
FTitleCaptions.Add(KeyCap);
FTitleCaptions.Add(ValCap);
end;
function TValueListEditor.GetKey(Index: Integer): string;
begin
Result:=Cells[0,Index];
end;
procedure TValueListEditor.SetKey(Index: Integer; const Value: string);
begin
Cells[0,Index]:=Value;
end;
function TValueListEditor.GetValue(const Key: string): string;
var
I: Integer;
begin
Result := '';
I := Strings.IndexOfName(Key);
if I > -1 then begin
Inc(I, FixedRows);
Result:=Cells[1,I];
end;
end;
procedure TValueListEditor.SetValue(const Key: string; AValue: string);
var
I: Integer;
begin
I := Strings.IndexOfName(Key);
if I > -1 then begin
Inc(I, FixedRows);
Cells[1,I]:=AValue;
end
else begin
Insert(Strings.NameValueSeparator, AValue, 1);
Insert(Key, AValue, 1);
Strings.Add(AValue);
end;
end;
procedure TValueListEditor.ShowColumnTitles;
var
KeyCap, ValCap: String;
begin
if (doColumnTitles in DisplayOptions) then
begin
KeyCap := rsVLEKey;
ValCap := rsVLEValue;
if (TitleCaptions.Count > 0) then KeyCap := TitleCaptions[0];
if (TitleCaptions.Count > 1) then ValCap := TitleCaptions[1];
//Columns[0].Title.Caption := KeyCap;
//Columns[1].Title.Caption := ValCap;
//or:
Cells[0,0] := KeyCap;
Cells[1,0] := ValCap;
end;
end;
procedure TValueListEditor.AdjustRowCount;
// Change the number of rows based on the number of items in Strings collection.
// Sets Row and RowCount of parent TCustomDrawGrid class.
var
NewC: Integer;
begin
NewC:=FixedRows+1;
if Strings.Count>0 then
NewC:=Strings.Count+FixedRows;
if NewC<>RowCount then
begin
if NewC<Row then
Row:=NewC-1;
if Row = 0 then
if doColumnTitles in DisplayOptions then
Row:=1;
inherited RowCount:=NewC;
end;
end;
procedure TValueListEditor.ColRowExchanged(IsColumn: Boolean; index,
WithIndex: Integer);
begin
Strings.Exchange(Index - FixedRows, WithIndex - FixedRows);
inherited ColRowExchanged(IsColumn, index, WithIndex);
end;
procedure TValueListEditor.ColRowDeleted(IsColumn: Boolean; index: Integer);
begin
EditorMode := False;
Strings.Delete(Index-FixedRows);
inherited ColRowDeleted(IsColumn, index);
end;
procedure TValueListEditor.DefineCellsProperty(Filer: TFiler);
begin
end;
procedure TValueListEditor.InvalidateCachedRow;
begin
if (Strings.Count = 0) then
begin
FLastEditedRow := FixedRows;
FRowTextOnEnter.Key := '';
FRowTextOnEnter.Value := '';
end
else
FLastEditedRow := -1;
end;
procedure TValueListEditor.GetAutoFillColumnInfo(const Index: Integer;
var aMin, aMax, aPriority: Integer);
begin
if Index=1 then
aPriority := 1
else
begin
if doKeyColFixed in FDisplayOptions then
aPriority := 0
else
aPriority := 1;
end;
end;
function TValueListEditor.GetCells(ACol, ARow: Integer): string;
var
I: Integer;
begin
Result:='';
if (ARow=0) and (doColumnTitles in DisplayOptions) then
begin
Result := Inherited GetCells(ACol, ARow);
end
else
begin
I:=ARow-FixedRows;
if (I >= Strings.Count) then
//Either empty grid, or a row has been added and Strings hasn't been update yet
//the latter happens when rows are auto-added (issue #0025166)
Exit;
if ACol=0 then
Result:=Strings.Names[I]
else if ACol=1 then
Result:=Strings.ValueFromIndex[I];
end;
end;
procedure SetGridEditorReadOnly(Ed: TwinControl; RO: Boolean);
begin
//debugln('SetEditorReadOnly: Ed is ',DbgSName(Ed),' ReadOnly=',DbgS(RO));
if (Ed is TCustomEdit) then
TCustomEdit(Ed).ReadOnly := RO
else if (Ed is TCustomComboBox) then
if RO then
TCustomComboBox(Ed).Style := csDropDownList
else
TCustomComboBox(Ed).Style := csDropDown;
end;
function TValueListEditor.GetDefaultEditor(Column: Integer): TWinControl;
var
ItemProp: TItemProp;
begin
if (Row <> FLastEditedRow) then
//save current contents for RestoreCurrentRow
begin
FLastEditedRow := Row;
FRowTextOnEnter.Key := Cells[0,Row];
FRowTextOnEnter.Value := Cells[1,Row];
end;
Result:=inherited GetDefaultEditor(Column);
//Need this to be able to intercept VK_Delete in the editor
if (KeyDelete in KeyOptions) then
EditorOptions := EditorOptions or EO_HOOKKEYDOWN
else
EditorOptions := EditorOptions and (not EO_HOOKKEYDOWN);
if Column=1 then
begin
ItemProp := nil;
//debugln('**** A Col=',dbgs(col),' Row=',dbgs(row),' (',dbgs(itemprop),')');
ItemProp := Strings.GetItemProp(Row-FixedRows);
if Assigned(ItemProp) then
begin
case ItemProp.EditStyle of
esSimple: begin
result := EditorByStyle(cbsAuto);
SetGridEditorReadOnly(result, ItemProp.ReadOnly);
end;
esEllipsis: begin
result := EditorByStyle(cbsEllipsis);
SetGridEditorReadOnly(TCompositeCellEditorAccess(result).GetActiveControl, ItemProp.ReadOnly);
end;
esPickList: begin
result := EditorByStyle(cbsPickList);
(result as TCustomComboBox).Items.Assign(ItemProp.PickList);
(result as TCustomComboBox).DropDownCount := DropDownRows;
SetGridEditorReadOnly(result, ItemProp.ReadOnly);
if Assigned(FOnGetPickList) then
FOnGetPickList(Self, Strings.Names[Row - FixedRows], (result as TCustomComboBox).Items);
//Style := csDropDown, default = csDropDownList;
end;
end; //case
end
else SetGridEditorReadOnly(result, False);
end
else
begin
//First column is only editable if KeyEdit is in KeyOptions
if not (KeyEdit in KeyOptions) then
Result := nil
else
SetGridEditorReadOnly(result, False);
end;
end;
function TValueListEditor.GetRowCount: Integer;
begin
Result := inherited RowCount;
end;
procedure TValueListEditor.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);
if (KeyAdd in KeyOptions) then
begin
if (Key = VK_INSERT) and (Shift = []) then
begin
//Insert a row in the current position
InsertRow('', '', False);
Key := 0;
end;
end;
if (KeyDelete in KeyOptions) then
begin
//Although Delphi help says this happens if user presses Delete, testers report it only happens with Ctrl+Delete
if (Key = VK_DELETE) and (Shift = [ssModifier]) then
begin
DeleteRow(Row);
Key := 0;
end;
end;
if (Key = VK_ESCAPE) and (Shift = []) then
if RestoreCurrentRow then Key := 0;
end;
procedure TValueListEditor.KeyPress(var Key: Char);
begin
inherited KeyPress(Key);
if (Key = Strings.NameValueSeparator) and (Col = 0) then
begin//move to Value column
Key := #0;
//Modified code from TCustomGrid.KeyDown
GridFlags := GridFlags + [gfEditingDone];
if MoveNextSelectable(True, 1, 0) then
Click;
GridFlags := GridFlags - [gfEditingDone];
end;
end;
procedure TValueListEditor.LoadContent(cfg: TXMLConfig; Version: Integer);
var
ContentSaved, HasColumnTitles, AlwaysShowEditor: Boolean;
i,j,k, RC: Integer;
KeyCap, ValCap, S: String;
oldSaveOptions: TSaveOptions;
begin
// Check that this file is a valid ValueListEditor grid
RC := cfg.GetValue('grid/content/rowcount', -1);
if (RC = -1) then
raise EStreamError.CreateFmt(rsVLENoRowCountFound,[cfg.Filename]);
if (RC < 1) then RC := 1;
HasColumnTitles := cfg.getValue('grid/content/hascolumntitles', False);
//contrary to other grids we restore the entire saved content,
//so we add/delete rows (not columns of course) as needed.
if HasColumnTitles and (RC = 1) then
RC := 2;
// Check that cell content makes sense
k:=cfg.getValue('grid/content/cells/cellcount', 0);
while k>0 do
begin
i := cfg.GetValue('grid/content/cells/cell'+IntToStr(k)+'/column', -1);
j := cfg.GetValue('grid/content/cells/cell'+IntTostr(k)+'/row',-1);
if (j<0) or (j>RC-1) then
raise EStreamError.CreateFmt(rsVLERowIndexOutOfBounds,[cfg.Filename,j]);
if not IsColumnIndexValid(i) then
raise EStreamError.CreateFmt(rsVLEColIndexOutOfBounds,[cfg.Filename,i]);
Dec(k);
end;
KeyCap := '';
ValCap := '';
oldSaveOptions := SaveOptions;
BeginUpdate;
try
AlwaysShowEditor := (goAlwaysShowEditor in Options);
if AlwaysShowEditor then Options := Options - [goAlwaysShowEditor];
SaveOptions := SaveOptions - [soContent];
inherited LoadContent(Cfg, Version);
if soContent in oldSaveOptions then
begin
ContentSaved:=Cfg.GetValue('grid/saveoptions/content', false);
if ContentSaved then
begin
Clean(0,0,ColCount-1,RowCount-1,[]); //needed if the to be loaded grid has no entries
if HasColumnTitles then
DisplayOptions := DisplayOptions + [doColumnTitles]
else
DisplayOptions := DisplayOptions - [doColumnTitles];
RowCount := RC;
k:=cfg.getValue('grid/content/cells/cellcount', 0);
while k>0 do
begin
i := cfg.GetValue('grid/content/cells/cell'+IntToStr(k)+'/column', -1);
j := cfg.GetValue('grid/content/cells/cell'+IntTostr(k)+'/row',-1);
S := cfg.GetValue('grid/content/cells/cell'+IntToStr(k)+'/text','');
Cells[i,j] := S;
if HasColumnTitles and (i = 0) and (j = 0) then
KeyCap := S
else if HasColumnTitles and (i = 1) and (j = 0) then
ValCap := S;
Dec(k);
end;
if HasColumnTitles then UpdateTitleCaptions(KeyCap, ValCap);
end;
end;
finally
if AlwaysShowEditor then Options := Options + [goAlwaysShowEditor];
SaveOptions := oldSaveOptions;
EndUpdate(True);
end;
end;
procedure TValueListEditor.ResetDefaultColWidths;
begin
if not AutoFillColumns then
inherited ResetDefaultColWidths
else if doKeyColFixed in DisplayOptions then
begin
SetRawColWidths(0, -1);
VisualChange;
end;
end;
procedure TValueListEditor.SaveContent(cfg: TXMLConfig);
var
i,j,k: Integer;
Value: String;
HasSaveContent: Boolean;
begin
HasSaveContent := soContent in SaveOptions;
//no need to save content in inherited SaveContent, since we re-implemented that here.
if HasSaveContent then
SaveOptions := SaveOptions - [soContent];
try
inherited SaveContent(cfg);
if HasSaveContent then
SaveOptions := SaveOptions + [soContent];
cfg.SetValue('grid/saveoptions/content', soContent in SaveOptions);
if soContent in SaveOptions then
begin
cfg.SetValue('grid/content/hascolumntitles',(doColumnTitles in FDisplayOptions));
cfg.SetValue('grid/content/rowcount', RowCount);
// Save Cell Contents
k:=0;
For i:=0 to ColCount-1 do
For j:=0 to RowCount-1 do
begin
//fGrid.Celda is unassigned for cells other than the title row, so we neet to query GetCells here
Value := GetCells(i,j);
if (Value <> '') then
begin
Inc(k);
//Cfg.SetValue('grid/content/cells/cellcount',k);
cfg.SetValue('grid/content/cells/cell'+IntToStr(k)+'/column',i);
cfg.SetValue('grid/content/cells/cell'+IntToStr(k)+'/row',j);
cfg.SetValue('grid/content/cells/cell'+IntToStr(k)+'/text', Value);
end;
Cfg.SetValue('grid/content/cells/cellcount',k);
end;
end;
finally
if HasSaveContent then
SaveOptions := SaveOptions + [soContent];
end;
end;
procedure TValueListEditor.SetCells(ACol, ARow: Integer; const AValue: string);
var
I: Integer;
Key, KeyValue, Line: string;
Sep: Char;
begin
if (ARow = 0) and (doColumnTitles in DisplayOptions) then
begin
Inherited SetCells(ACol, ARow, AValue);
end
else
begin
I:=ARow-FixedRows;
if ACol=0 then
begin
Sep := Strings.NameValueSeparator;
Key := AValue;
{
A Key can never contain NameVlaueSeparator (by default an equal sign ('='))
While we disallow typing '=' inside the Key column
we cannot prevent the user from pasting text that contains a '='
This leads to strange effects since when we insert the Key/Value pair into
the Strings property, in effect the equal sign will be treated (by design) as the separator for the value part.
This in turn updates the Value column, but does not remove the equal sign from Key.
E.g. if both Key and Value celss are empty and you type '=' into an empty Key cell,
the Value cell will become '=='
Reported on forum: https://forum.lazarus.freepascal.org/index.php?topic=51977.0;topicseen
}
if (Pos(Sep, Key) > 0) then
begin
Key := StringReplace(Key, Sep, '', [rfReplaceAll]);
//update the content of the Column cell
inherited SetCells(ACol, ARow, Key);
end;
KeyValue := Cells[1,ARow]
end
else
begin
KeyValue := AValue;
Key := Cells[0,ARow];
end;
//If cells are empty don't store '=' in Strings
if (Key = '') and (KeyValue = '') then
Line := ''
else begin
Line := KeyValue;
system.Insert(Strings.NameValueSeparator, Line, 1);
system.Insert(Key, Line, 1);
end;
// Empty grid: don't add a the line '' to Strings!
if (Strings.Count = 0) and (Line = '') then Exit;
if I>=Strings.Count then
Strings.Insert(I,Line)
else
if (Line <> Strings[I]) then Strings[I]:=Line;
end;
end;
procedure TValueListEditor.SetColCount(AValue: Integer);
begin
if (not FCreating) and (not (csLoading in ComponentState)) and (AValue <> 2) then
raise EGridException.CreateFmt(rsVLEIllegalColCount,[AValue]);
inherited SetColCount(AValue);
end;
function TValueListEditor.GetEditText(ACol, ARow: Integer): string;
begin
Result:= Cells[ACol, ARow];
if Assigned(OnGetEditText) then
OnGetEditText(Self, ACol, ARow, Result);
end;
procedure TValueListEditor.SetEditText(ACol, ARow: Longint; const Value: string);
begin
inherited SetEditText(ACol, ARow, Value);
Cells[ACol, ARow] := Value;
end;
procedure TValueListEditor.SetRowCount(AValue: Integer);
var
OldValue, NewCount: Integer;
begin
//debugln('TValueListEditor.SetRowCount: AValue=',DbgS(AValue));
OldValue := inherited RowCount;
if OldValue = AValue then Exit;
if FixedRows > AValue then
Raise EGridException.Create(rsFixedRowsTooBig);
NewCount := AValue - FixedRows;
if (NewCount > Strings.Count) then
begin
Strings.BeginUpdate;
while (Strings.Count < NewCount) do Strings.Add('');
Strings.EndUpdate;
end
else if (NewCount < Strings.Count) then
begin
Strings.BeginUpdate;
while (NewCount < Strings.Count) do Strings.Delete(Strings.Count - 1);
Strings.EndUpdate;
end;
end;
procedure TValueListEditor.Sort(ColSorting: Boolean; index, IndxFrom,
IndxTo: Integer);
var
HideEditor: Boolean;
begin
HideEditor := goAlwaysShowEditor in Options;
if HideEditor then Options := Options - [goAlwaysShowEditor];
Strings.BeginUpdate;
try
inherited Sort(True, index, IndxFrom, IndxTo);
finally
Strings.EndUpdate;
end;
if HideEditor then Options := Options + [goAlwaysShowEditor];
end;
procedure TValueListEditor.TitlesChanged(Sender: TObject);
begin
// Refresh the display.
ShowColumnTitles;
AdjustRowCount;
Invalidate;
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);
//Check for duplicate key names (only in "Key" column), if KeyUnique is set
if ((ACol - FixedCols) = 0) and (KeyUnique in KeyOptions) then
begin
Index := ARow - FixedRows;
for i := 0 to FStrings.Count - 1 do
begin
if (Index <> i) and (FStrings.Names[i] <> '') then
begin
if (AnsiCompareText(FStrings.Names[i], NewValue) = 0) then
begin
Result := False;
ShowMessage(Format(rsVLEDuplicateKey,[NewValue, i + FixedRows]));
if Editor is TStringCellEditor then TStringCelleditor(Editor).SelectAll;
Break;
end;
end;
end;
end;
end;
class procedure TValueListEditor.WSRegisterClass;
begin
// RegisterPropertyToSkip(Self, 'SomeProperty', 'VCL compatibility property', '');
inherited WSRegisterClass;
end;
procedure Register;
begin
RegisterComponents('Additional',[TValueListEditor]);
end;
end.