Issue #75: create editable list for check constraints in table editor

This commit is contained in:
Ansgar Becker
2021-01-12 21:41:20 +01:00
parent 8f294e8990
commit 958d62c9b1
3 changed files with 344 additions and 12 deletions

View File

@ -82,6 +82,7 @@ type
procedure Modification(Sender: TObject);
function SQLCode: String;
property ImageIndex: Integer read GetImageIndex;
property Connection: TDBConnection read FConnection;
end;
TTableKeyList = class(TObjectList<TTableKey>)
public
@ -102,6 +103,7 @@ type
procedure Assign(Source: TPersistent); override;
function SQLCode(IncludeSymbolName: Boolean): String;
function ReferenceTableObj: TDBObject;
property Connection: TDBConnection read FConnection;
end;
TForeignKeyList = class(TObjectList<TForeignKey>)
public
@ -109,6 +111,27 @@ type
end;
TForeignKeyCache = TDictionary<String,TForeignKeyList>;
TCheckConstraint = class(TPersistent)
private
FConnection: TDBConnection;
FName, FCheckClause: String;
FModified, FAdded: Boolean;
public
constructor Create(AOwner: TDBConnection);
procedure Assign(Source: TPersistent); override;
function SQLCode: String;
property Connection: TDBConnection read FConnection;
property Name: String read FName write FName;
property CheckClause: String read FCheckClause write FCheckClause;
property Modified: Boolean read FModified write FModified;
property Added: Boolean read FAdded write FAdded;
end;
TCheckConstraintList = class(TObjectList<TCheckConstraint>)
public
procedure Assign(Source: TCheckConstraintList);
end;
TCheckConstraintCache = TDictionary<String,TCheckConstraintList>;
TRoutineParam = class(TObject)
public
Name, Context, Datatype: String;
@ -128,6 +151,7 @@ type
function GetTableColumns: TTableColumnList;
function GetTableKeys: TTableKeyList;
function GetTableForeignKeys: TForeignKeyList;
function GetTableCheckConstraints: TCheckConstraintList;
public
// Table options:
Name, Schema, Database, Column, Engine, Comment, RowFormat, CreateOptions, Collation: String;
@ -161,6 +185,7 @@ type
property TableColumns: TTableColumnList read GetTableColumns;
property TableKeys: TTableKeyList read GetTableKeys;
property TableForeignKeys: TForeignKeyList read GetTableForeignKeys;
property TableCheckConstraints: TCheckConstraintList read GetTableCheckConstraints;
end;
PDBObject = ^TDBObject;
TDBObjectList = class(TObjectList<TDBObject>)
@ -398,6 +423,7 @@ type
FColumnCache: TColumnCache;
FKeyCache: TKeyCache;
FForeignKeyCache: TForeignKeyCache;
FCheckConstraintCache: TCheckConstraintCache;
FCurrentUserHostCombination: String;
FAllUserHostCombinations: TStringList;
FLockedByThread: TThread;
@ -499,6 +525,10 @@ type
property LastErrorMsg: String read GetLastErrorMsg;
property ServerOS: String read FServerOS;
property ServerVersionUntouched: String read FServerVersionUntouched;
property ColumnCache: TColumnCache read FColumnCache;
property KeyCache: TKeyCache read FKeyCache;
property ForeignKeyCache: TForeignKeyCache read FForeignKeyCache;
property CheckConstraintCache: TCheckConstraintCache read FCheckConstraintCache;
property QuoteChar: Char read FQuoteChar;
property QuoteChars: String read FQuoteChars;
function ServerVersionStr: String;
@ -531,6 +561,7 @@ type
function GetTableColumns(Table: TDBObject): TTableColumnList; virtual;
function GetTableKeys(Table: TDBObject): TTableKeyList; virtual;
function GetTableForeignKeys(Table: TDBObject): TForeignKeyList; virtual;
function GetTableCheckConstraints(Table: TDBObject): TCheckConstraintList; virtual;
property MaxRowsPerInsert: Int64 read FMaxRowsPerInsert;
published
property Active: Boolean read FActive write SetActive default False;
@ -1764,6 +1795,7 @@ begin
FColumnCache := TColumnCache.Create;
FKeyCache := TKeyCache.Create;
FForeignKeyCache := TForeignKeyCache.Create;
FCheckConstraintCache := TCheckConstraintCache.Create;
FLoginPromptDone := False;
FCurrentUserHostCombination := '';
FKeepAliveTimer := TTimer.Create(Self);
@ -2857,6 +2889,9 @@ begin
'USER_PRIVILEGES,'+
'VIEWS';
end;
if Parameters.IsMariaDB and (ServerVersionInt >= 100201) then begin
FInformationSchemaObjects.Add('CHECK_CONSTRAINTS');
end;
if (ServerVersionInt >= 50124) and (not Parameters.IsProxySQLAdmin) then
FSQLSpecifities[spLockedTables] := 'SHOW OPEN TABLES FROM %s WHERE '+QuoteIdent('in_use')+'!=0';
@ -3490,6 +3525,8 @@ var
TableKey: TTableKey;
TableForeignKeys: TForeignKeyList;
TableForeignKey: TForeignKey;
TableCheckConstraints: TCheckConstraintList;
TableCheckConstraint: TCheckConstraint;
begin
case Obj.NodeType of
lntTable: begin
@ -3512,6 +3549,12 @@ begin
end;
TableForeignKeys.Free;
TableCheckConstraints := Obj.GetTableCheckConstraints;
for TableCheckConstraint in TableCheckConstraints do begin
Result := Result + CRLF + #9 + TableCheckConstraint.SQLCode + ',';
end;
TableCheckConstraints.Free;
Delete(Result, Length(Result), 1);
Result := Result + CRLF + ')';
@ -5556,6 +5599,27 @@ begin
end;
function TDBConnection.GetTableCheckConstraints(Table: TDBObject): TCheckConstraintList;
var
CheckQuery: TDBQuery;
CheckConstraint: TCheckConstraint;
begin
Result := TCheckConstraintList.Create(True);
if FInformationSchemaObjects.IndexOf('CHECK_CONSTRAINTS') = -1 then
Exit;
CheckQuery := GetResults('SELECT * FROM '+QuoteIdent(InfSch)+'.'+QuoteIdent('CHECK_CONSTRAINTS')+
' WHERE '+Table.SchemaClauseIS('CONSTRAINT')+' AND TABLE_NAME='+EscapeString(Table.Name));
while not CheckQuery.Eof do begin
CheckConstraint := TCheckConstraint.Create(Self);
Result.Add(CheckConstraint);
CheckConstraint.Name := CheckQuery.Col('CONSTRAINT_NAME');
CheckConstraint.CheckClause := CheckQuery.Col('CHECK_CLAUSE');
CheckQuery.Next;
end;
CheckQuery.Free;
end;
function TMySQLConnection.GetRowCount(Obj: TDBObject): Int64;
var
Rows: String;
@ -5812,6 +5876,7 @@ begin
FColumnCache.Clear;
FKeyCache.Clear;
FForeignKeyCache.Clear;
FCheckConstraintCache.Clear;
end;
FTableEngineDefault := '';
FCurrentUserHostCombination := '';
@ -5953,6 +6018,7 @@ begin
FColumnCache.Clear;
FKeyCache.Clear;
FForeignKeyCache.Clear;
FCheckConstraintCache.Clear;
if Assigned(FOnObjectnamesChanged) then
FOnObjectnamesChanged(Self, db);
end;
@ -8694,6 +8760,8 @@ begin
FConnection.FKeyCache.Remove(QuotedDbAndTableName);
if FConnection.FForeignKeyCache.ContainsKey(QuotedDbAndTableName) then
FConnection.FForeignKeyCache.Remove(QuotedDbAndTableName);
if FConnection.FCheckConstraintCache.ContainsKey(QuotedDbAndTableName) then
FConnection.FCheckConstraintCache.Remove(QuotedDbAndTableName);
FCreateCode := '';
FCreateCodeLoaded := False;
end;
@ -8958,6 +9026,19 @@ begin
Result.Assign(ForeignKeysInCache);
end;
function TDBObject.GetTableCheckConstraints: TCheckConstraintList;
var
CheckConstraintsInCache: TCheckConstraintList;
begin
// Return check constraint from table object
if not FConnection.CheckConstraintCache.ContainsKey(QuotedDbAndTableName) then begin
FConnection.CheckConstraintCache.Add(QuotedDbAndTableName, Connection.GetTableCheckConstraints(Self));
end;
FConnection.CheckConstraintCache.TryGetValue(QuotedDbAndTableName, CheckConstraintsInCache);
Result := TCheckConstraintList.Create;
Result.Assign(CheckConstraintsInCache);
end;
{ *** TTableColumn }
@ -9244,7 +9325,7 @@ var
Item, ItemCopy: TTableColumn;
begin
for Item in Source do begin
ItemCopy := TTableColumn.Create(Item.FConnection);
ItemCopy := TTableColumn.Create(Item.Connection);
ItemCopy.Assign(Item);
Add(ItemCopy);
end;
@ -9344,7 +9425,7 @@ var
Item, ItemCopy: TTableKey;
begin
for Item in Source do begin
ItemCopy := TTableKey.Create(Item.FConnection);
ItemCopy := TTableKey.Create(Item.Connection);
ItemCopy.Assign(Item);
Add(ItemCopy);
end;
@ -9437,13 +9518,51 @@ var
Item, ItemCopy: TForeignKey;
begin
for Item in Source do begin
ItemCopy := TForeignKey.Create(Item.FConnection);
ItemCopy := TForeignKey.Create(Item.Connection);
ItemCopy.Assign(Item);
Add(ItemCopy);
end;
end;
{ *** TCheckConstraint }
constructor TCheckConstraint.Create(AOwner: TDBConnection);
begin
inherited Create;
FConnection := AOwner;
end;
procedure TCheckConstraint.Assign(Source: TPersistent);
var
s: TCheckConstraint;
begin
if Source is TCheckConstraint then begin
s := Source as TCheckConstraint;
FName := s.Name;
FCheckClause := s.CheckClause;
FModified := s.Modified;
FAdded := s.Added;
end else
inherited;
end;
function TCheckConstraint.SQLCode: String;
begin
Result := 'CONSTRAINT '+FConnection.QuoteIdent(FName)+' CHECK ('+FCheckClause+')';
end;
procedure TCheckConstraintList.Assign(Source: TCheckConstraintList);
var
Item, ItemCopy: TCheckConstraint;
begin
for Item in Source do begin
ItemCopy := TCheckConstraint.Create(Item.Connection);
ItemCopy.Assign(Item);
Add(ItemCopy);
end;
end;
procedure SQLite_CollationNeededCallback(userData: Pointer; ppDb:Psqlite3; eTextRep:integer; zName:PAnsiChar); cdecl;

View File

@ -263,7 +263,7 @@ object frmTableEditor: TfrmTableEditor
TreeOptions.PaintOptions = [toHotTrack, toShowButtons, toShowDropmark, toShowRoot, toShowTreeLines, toShowVertGridLines, toThemeAware, toUseBlendedImages, toFullVertGridLines, toUseExplorerTheme, toHideTreeLinesIfThemed]
TreeOptions.SelectionOptions = [toExtendedFocus, toRightClickSelect]
OnBeforePaint = treeIndexesBeforePaint
OnClick = treeIndexesClick
OnClick = AnyTreeClick
OnCreateEditor = treeIndexesCreateEditor
OnDragOver = treeIndexesDragOver
OnDragDrop = treeIndexesDragDrop
@ -422,7 +422,7 @@ object frmTableEditor: TfrmTableEditor
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toShowHorzGridLines, toShowTreeLines, toShowVertGridLines, toThemeAware, toUseBlendedImages, toUseExplorerTheme, toHideTreeLinesIfThemed]
TreeOptions.SelectionOptions = [toExtendedFocus]
OnBeforePaint = listForeignKeysBeforePaint
OnClick = treeIndexesClick
OnClick = AnyTreeClick
OnCreateEditor = listForeignKeysCreateEditor
OnEditing = listForeignKeysEditing
OnFocusChanged = listForeignKeysFocusChanged
@ -469,6 +469,84 @@ object frmTableEditor: TfrmTableEditor
end>
end
end
object tabCheckConstraints: TTabSheet
Caption = 'Check constraints'
ImageIndex = 55
object tlbCheckConstraints: TToolBar
Left = 0
Top = 0
Width = 66
Height = 121
Align = alLeft
AutoSize = True
ButtonWidth = 66
Caption = 'tlbCheckConstraints'
Images = MainForm.VirtualImageListMain
List = True
ShowCaptions = True
TabOrder = 0
object btnAddCheckConstraint: TToolButton
Left = 0
Top = 0
Caption = 'Add'
ImageIndex = 45
Wrap = True
OnClick = btnAddCheckConstraintClick
end
object btnRemoveCheckConstraint: TToolButton
Left = 0
Top = 22
Caption = 'Remove'
Enabled = False
ImageIndex = 46
Wrap = True
end
object btnClearCheckConstraints: TToolButton
Left = 0
Top = 44
Caption = 'Clear'
Enabled = False
ImageIndex = 26
end
end
object listCheckConstraints: TVirtualStringTree
Left = 66
Top = 0
Width = 620
Height = 121
Align = alClient
EditDelay = 0
Header.AutoSizeIndex = 1
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible, hoDisableAnimatedResize, hoAutoResizeInclCaption]
Header.PopupMenu = MainForm.popupListHeader
Images = MainForm.VirtualImageListMain
TabOrder = 1
TreeOptions.MiscOptions = [toAcceptOLEDrop, toEditable, toFullRepaintOnResize, toGridExtensions, toInitOnSave, toToggleOnDblClick, toWheelPanning, toEditOnClick]
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toShowHorzGridLines, toShowTreeLines, toShowVertGridLines, toThemeAware, toUseBlendedImages, toUseExplorerTheme, toHideTreeLinesIfThemed]
TreeOptions.SelectionOptions = [toExtendedFocus]
OnBeforePaint = listCheckConstraintsBeforePaint
OnClick = AnyTreeClick
OnCreateEditor = listCheckConstraintsCreateEditor
OnFocusChanged = listCheckConstraintsFocusChanged
OnGetText = listCheckConstraintsGetText
OnGetImageIndex = listCheckConstraintsGetImageIndex
OnNewText = listCheckConstraintsNewText
OnStructureChange = AnyTreeStructureChange
Columns = <
item
Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus, coEditable, coStyleColor]
Position = 0
Text = 'Name'
Width = 200
end
item
Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus, coEditable, coStyleColor]
Position = 1
Text = 'Check clause'
Width = 416
end>
end
end
object tabPartitions: TTabSheet
Caption = 'Partitions'
ImageIndex = 186

View File

@ -86,6 +86,12 @@ type
menuPasteColumns: TMenuItem;
tabPartitions: TTabSheet;
SynMemoPartitions: TSynMemo;
tabCheckConstraints: TTabSheet;
tlbCheckConstraints: TToolBar;
btnAddCheckConstraint: TToolButton;
btnRemoveCheckConstraint: TToolButton;
btnClearCheckConstraints: TToolButton;
listCheckConstraints: TVirtualStringTree;
procedure Modification(Sender: TObject);
procedure btnAddColumnClick(Sender: TObject);
procedure btnRemoveColumnClick(Sender: TObject);
@ -139,7 +145,7 @@ type
procedure menuAddIndexColumnClick(Sender: TObject);
procedure PageControlMainChange(Sender: TObject);
procedure chkCharsetConvertClick(Sender: TObject);
procedure treeIndexesClick(Sender: TObject);
procedure AnyTreeClick(Sender: TObject);
procedure btnDiscardClick(Sender: TObject);
procedure popupColumnsPopup(Sender: TObject);
procedure AddIndexByColumn(Sender: TObject);
@ -173,6 +179,21 @@ type
procedure listColumnsChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure AnyTreeStructureChange(Sender: TBaseVirtualTree;
Node: PVirtualNode; Reason: TChangeReason);
procedure listCheckConstraintsBeforePaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas);
procedure btnAddCheckConstraintClick(Sender: TObject);
procedure listCheckConstraintsGetImageIndex(Sender: TBaseVirtualTree;
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var ImageIndex: TImageIndex);
procedure listCheckConstraintsFocusChanged(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex);
procedure listCheckConstraintsGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: string);
procedure listCheckConstraintsCreateEditor(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
procedure listCheckConstraintsNewText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; NewText: string);
private
{ Private declarations }
FLoaded: Boolean;
@ -180,6 +201,7 @@ type
FColumns: TTableColumnList;
FKeys: TTableKeyList;
FForeignKeys: TForeignKeyList;
FCheckConstraints: TCheckConstraintList;
DeletedKeys, DeletedForeignKeys: TStringList;
procedure ValidateColumnControls;
procedure ValidateIndexControls;
@ -214,6 +236,7 @@ begin
FixVT(listColumns);
FixVT(treeIndexes);
FixVT(listForeignKeys);
FixVT(listCheckConstraints);
// Try the best to auto fit various column widths, respecting a custom DPI setting and a pulldown arrow
listColumns.Header.Columns[2].Width := Mainform.Canvas.TextWidth('GEOMETRYCOLLECTION') + 6*listColumns.TextMargin;
listColumns.Header.Columns[7].Width := Mainform.Canvas.TextWidth('AUTO_INCREMENT') + 4*listColumns.TextMargin;
@ -222,6 +245,7 @@ begin
Mainform.RestoreListSetup(listColumns);
Mainform.RestoreListSetup(treeIndexes);
Mainform.RestoreListSetup(listForeignKeys);
MainForm.RestoreListSetup(listCheckConstraints);
comboRowFormat.Items.CommaText := 'DEFAULT,DYNAMIC,FIXED,COMPRESSED,REDUNDANT,COMPACT';
comboInsertMethod.Items.CommaText := 'NO,FIRST,LAST';
FColumns := TTableColumnList.Create;
@ -239,6 +263,7 @@ begin
Mainform.SaveListSetup(listColumns);
Mainform.SaveListSetup(treeIndexes);
Mainform.SaveListSetup(listForeignKeys);
MainForm.SaveListSetup(listCheckConstraints);
inherited;
end;
@ -265,6 +290,7 @@ begin
listColumns.Clear;
treeIndexes.Clear;
listForeignKeys.Clear;
listCheckConstraints.Clear;
tabALTERcode.TabVisible := DBObject.Name <> '';
// Clear value editors
memoComment.Text := '';
@ -291,6 +317,7 @@ begin
FColumns := TTableColumnList.Create;
FKeys := TTableKeyList.Create;
FForeignKeys := TForeignKeyList.Create;
FCheckConstraints := TCheckConstraintList.Create;
end else begin
// Editing existing table
editName.Text := DBObject.Name;
@ -341,6 +368,7 @@ begin
FColumns := DBObject.TableColumns;
FKeys := DBObject.TableKeys;
FForeignKeys := DBObject.TableForeignKeys;
FCheckConstraints := DBObject.TableCheckConstraints;
end;
listColumns.RootNodeCount := FColumns.Count;
DeInitializeVTNodes(listColumns);
@ -351,6 +379,7 @@ begin
// Set root nodes per BeforePaint event:
treeIndexes.Invalidate;
listForeignKeys.Invalidate;
listCheckConstraints.Invalidate;
// Validate controls
comboEngineSelect(comboEngine);
@ -505,6 +534,7 @@ var
i: Integer;
Results: TDBQuery;
Col, PreviousCol: PTableColumn;
Constraint: TCheckConstraint;
Node: PVirtualNode;
Conn: TDBConnection;
@ -598,11 +628,9 @@ begin
end;
// Update columns
MainForm.EnableProgress(FColumns.Count + DeletedKeys.Count + FKeys.Count);
Node := listColumns.GetFirst;
PreviousCol := nil;
while Assigned(Node) do begin
Mainform.ProgressStep;
Col := listColumns.GetNodeData(Node);
if Col.Status <> esUntouched then begin
OverrideCollation := IfThen(chkCharsetConvert.Checked, comboCollation.Text);
@ -704,7 +732,6 @@ begin
// Drop indexes, also changed indexes, which will be readded below
for i:=0 to DeletedKeys.Count-1 do begin
Mainform.ProgressStep;
if DeletedKeys[i] = TTableKey.PRIMARY then
IndexSQL := 'PRIMARY KEY'
else
@ -713,7 +740,6 @@ begin
end;
// Add changed or added indexes
for i:=0 to FKeys.Count-1 do begin
Mainform.ProgressStep;
if FKeys[i].Modified and (not FKeys[i].Added) then begin
if FKeys[i].OldIndexType = TTableKey.PRIMARY then
IndexSQL := 'PRIMARY KEY'
@ -732,6 +758,14 @@ begin
Specs.Add('ADD '+FForeignKeys[i].SQLCode(True));
end;
// Check constraints
// Todo: process constraint marked for deletion
for Constraint in FCheckConstraints do begin
if Constraint.Added or Constraint.Modified or (Specs.Count > 0) then
Specs.Add('ADD ' + Constraint.SQLCode);
end;
FinishSpecs;
Result := TSQLBatch.Create;
@ -739,7 +773,6 @@ begin
FreeAndNil(Specs);
Mainform.ShowStatusMsg;
MainForm.DisableProgress;
Screen.Cursor := crDefault;
end;
@ -748,6 +781,7 @@ function TfrmTableEditor.ComposeCreateStatement: TSQLBatch;
var
i, IndexCount: Integer;
Col: PTableColumn;
Constraint: TCheckConstraint;
Node: PVirtualNode;
tmp, SQL: String;
begin
@ -772,6 +806,11 @@ begin
for i:=0 to FForeignKeys.Count-1 do
SQL := SQL + #9 + FForeignKeys[i].SQLCode(True) + ','+CRLF;
// Check constraints
for Constraint in FCheckConstraints do begin
SQL := SQL + #9 + Constraint.SQLCode + ',' + sLineBreak;
end;
if Integer(listColumns.RootNodeCount) + IndexCount + FForeignKeys.Count > 0 then
Delete(SQL, Length(SQL)-2, 3);
@ -837,6 +876,23 @@ begin
end;
procedure TfrmTableEditor.btnAddCheckConstraintClick(Sender: TObject);
var
CheckConstraint: TCheckConstraint;
idx: Integer;
begin
// Add new check constraint
CheckConstraint := TCheckConstraint.Create(DBObject.Connection);
idx := FCheckConstraints.Add(CheckConstraint);
CheckConstraint.Name := 'CC'+IntToStr(idx+1);
CheckConstraint.CheckClause := '';
CheckConstraint.Added := True;
Modification(Sender);
listCheckConstraints.Repaint;
SelectNode(listCheckConstraints, idx);
listCheckConstraints.EditNode(listCheckConstraints.FocusedNode, listCheckConstraints.Header.MainColumn);
end;
procedure TfrmTableEditor.btnAddColumnClick(Sender: TObject);
var
NewCol: TTableColumn;
@ -1730,7 +1786,7 @@ begin
end;
procedure TfrmTableEditor.treeIndexesClick(Sender: TObject);
procedure TfrmTableEditor.AnyTreeClick(Sender: TObject);
var
VT: TVirtualStringTree;
Click: THitInfo;
@ -1768,6 +1824,83 @@ begin
end;
procedure TfrmTableEditor.listCheckConstraintsBeforePaint(
Sender: TBaseVirtualTree; TargetCanvas: TCanvas);
begin
// Set RootNodeCount
listCheckConstraints.RootNodeCount := FCheckConstraints.Count;
btnClearCheckConstraints.Enabled := listCheckConstraints.RootNodeCount > 0;
end;
procedure TfrmTableEditor.listCheckConstraintsCreateEditor(
Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
out EditLink: IVTEditLink);
var
VT: TVirtualStringTree;
Edit: TInplaceEditorLink;
begin
// Edit check constraint
VT := Sender as TVirtualStringTree;
Edit := TInplaceEditorLink.Create(VT, True);
Edit.TitleText := VT.Header.Columns[Column].Text;
Edit.ButtonVisible := True;
EditLink := Edit;
end;
procedure TfrmTableEditor.listCheckConstraintsFocusChanged(
Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);
begin
// Focus on list changed
btnRemoveCheckConstraint.Enabled := Assigned(Node);
end;
procedure TfrmTableEditor.listCheckConstraintsGetImageIndex(
Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind;
Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex);
begin
// Return image index for node cell in list
if not (Kind in [ikNormal, ikSelected]) then Exit;
case Column of
0: ImageIndex := tabCheckConstraints.ImageIndex;
else ImageIndex := -1;
end;
end;
procedure TfrmTableEditor.listCheckConstraintsGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: string);
var
CheckConstraint: TCheckConstraint;
begin
// Return cell text in list
CheckConstraint := FCheckConstraints[Node.Index];
case Column of
0: CellText := CheckConstraint.Name;
1: CellText := CheckConstraint.CheckClause;
end;
end;
procedure TfrmTableEditor.listCheckConstraintsNewText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; NewText: string);
var
Constraint: TCheckConstraint;
begin
// Check constraint edited
Constraint := FCheckConstraints[Node.Index];
case Column of
0: Constraint.Name := NewText;
1: Constraint.CheckClause := NewText;
end;
Constraint.Modified := True;
Modification(Sender);
end;
procedure TfrmTableEditor.treeIndexesEditing(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
var
@ -2030,6 +2163,7 @@ procedure TfrmTableEditor.PageControlMainChange(Sender: TObject);
begin
treeIndexes.EndEditNode;
listForeignKeys.EndEditNode;
listCheckConstraints.EndEditNode;
// Ensure SynMemo's have focus, otherwise Select-All and Copy actions may fail
if PageControlMain.ActivePage = tabCREATEcode then begin
if SynMemoCreateCode.CanFocus then
@ -2569,6 +2703,7 @@ begin
// Append number of listed keys (or whatever) to the tab caption
tabIndexes.Caption := _('Indexes') + ' (' + FKeys.Count.ToString + ')';
tabForeignKeys.Caption := _('Foreign keys') + ' (' + FForeignKeys.Count.ToString + ')';
tabCheckConstraints.Caption := _('Check constraints') + ' (' + FCheckConstraints.Count.ToString + ')';
end;