Issue #1482: add copy table dialog

This commit is contained in:
Ansgar Becker
2025-03-09 20:09:37 +01:00
parent b03583561c
commit 91be516f0f
7 changed files with 722 additions and 8 deletions

View File

@ -173,6 +173,13 @@
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit>
<Unit>
<Filename Value="source\copytable.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="CopyTableForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>

View File

@ -17,7 +17,7 @@ uses
dbstructures, dbstructures.mysql, About, generic_types,
dbstructures.interbase, dbstructures.mssql, dbstructures.postgresql,
dbstructures.sqlite, change_password, loginform, data_sorting, extra_controls,
column_selection, loaddata, csv_detector, createdatabase, editvar {, printlist (EnablePrint not defined) }
column_selection, loaddata, csv_detector, createdatabase, editvar, copytable {, printlist (EnablePrint not defined) }
;
{$R *.res}

View File

@ -17,6 +17,7 @@ UF = both
* UF replace TVirtualStringTree|Columns => TLazVirtualStringTree|Header.Columns
* UF replace TButtonedEdit => TEditButton (+ use EditBtn unit)
* UF if TButton has Images + ImageIndex: replace TButton => TSpeedButton (note: ModalResult not supported!)
* UF if TButton has Style + DropDownMenu: replace TButton => TSpeedButton with ImageIndex 108 and let OnClick activate the TPopupMenu
* U open unit, accept removal of unknown properties
* U press Shift+F11 to add unit+form to project

View File

@ -4282,6 +4282,7 @@ end;
function TAppSettings.ReadIntDpiAware(Index: TAppSettingIndex; AControl: TControl; FormatName: String=''; Default: Integer=0): Integer;
begin
// Todo: take a forms DesignTimePPI into account
Result := ReadInt(Index, FormatName, Default);
//Result := Round(Result * AControl.ScaleFactor);
end;

197
source/copytable.lfm Normal file
View File

@ -0,0 +1,197 @@
object CopyTableForm: TCopyTableForm
Left = 393
Height = 380
Top = 115
Width = 455
Caption = 'Copy Table...'
ClientHeight = 380
ClientWidth = 455
Color = clBtnFace
DesignTimePPI = 120
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Tahoma'
OnClose = FormClose
OnCreate = FormCreate
OnResize = FormResize
OnShow = FormShow
Position = poMainFormCenter
object lblNewTablename: TLabel
Left = 10
Height = 18
Top = 10
Width = 183
Caption = 'Copy "%s" to new db.table:'
end
object lblItems: TLabel
Left = 10
Height = 18
Top = 64
Width = 210
Caption = 'Elements to create in new table:'
end
object lblWhere: TLabel
Left = 10
Height = 18
Top = 207
Width = 210
Anchors = [akLeft, akBottom]
Caption = 'WHERE clause for data copying:'
end
object editNewTablename: TEdit
Left = 199
Height = 26
Top = 30
Width = 246
TabOrder = 1
OnChange = editNewTablenameChange
end
object btnCancel: TButton
Left = 341
Height = 31
Top = 339
Width = 104
Anchors = [akRight, akBottom]
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 5
end
object comboDatabase: TComboBox
Left = 10
Height = 26
Top = 30
Width = 181
ItemHeight = 18
Style = csDropDownList
TabOrder = 0
end
object btnOK: TButton
Left = 230
Height = 31
Top = 339
Width = 104
Anchors = [akRight, akBottom]
Caption = 'OK'
Default = True
ModalResult = 1
TabOrder = 4
OnClick = btnOKClick
end
object TreeElements: TLazVirtualStringTree
Left = 10
Height = 110
Top = 88
Width = 435
Anchors = [akTop, akLeft, akRight, akBottom]
Header.AutoSizeIndex = 0
Header.Columns = <>
Header.MainColumn = -1
Images = MainForm.ImageListIcons8
TabOrder = 2
TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes, toAutoChangeScale]
TreeOptions.MiscOptions = [toAcceptOLEDrop, toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toEditOnClick]
TreeOptions.PaintOptions = [toHotTrack, toShowButtons, toShowDropmark, toShowRoot, toShowTreeLines, toThemeAware, toUseBlendedImages, toUseExplorerTheme, toHideTreeLinesIfThemed]
OnChecked = TreeElementsChecked
OnGetText = TreeElementsGetText
OnGetImageIndex = TreeElementsGetImageIndex
OnInitChildren = TreeElementsInitChildren
OnInitNode = TreeElementsInitNode
end
inline MemoFilter: TSynEdit
Left = 10
Height = 91
Top = 240
Width = 435
Anchors = [akLeft, akRight, akBottom]
Font.Color = clGrayText
Font.Height = -16
Font.Name = 'Courier New'
Font.Pitch = fpFixed
Font.Quality = fqNonAntialiased
ParentColor = False
ParentFont = False
TabOrder = 3
Gutter.Width = 72
Gutter.MouseActions = <>
RightGutter.Width = 0
RightGutter.MouseActions = <>
Highlighter = MainForm.SynSQLSynUsed
Keystrokes = <>
MouseActions = <>
MouseTextActions = <>
MouseSelActions = <>
Options = [eoAutoIndent, eoGroupUndo, eoKeepCaretX, eoShowScrollHint, eoSmartTabs, eoTabIndent, eoDragDropEditing]
MouseOptions = [emDragDropEditing]
VisibleSpecialChars = [vscSpace, vscTabAtLast]
SelectedColor.BackPriority = 50
SelectedColor.ForePriority = 50
SelectedColor.FramePriority = 50
SelectedColor.BoldPriority = 50
SelectedColor.ItalicPriority = 50
SelectedColor.UnderlinePriority = 50
SelectedColor.StrikeOutPriority = 50
BracketHighlightStyle = sbhsBoth
BracketMatchColor.Background = clNone
BracketMatchColor.Foreground = clNone
BracketMatchColor.Style = [fsBold]
FoldedCodeColor.Background = clNone
FoldedCodeColor.Foreground = clGray
FoldedCodeColor.FrameColor = clGray
MouseLinkColor.Background = clNone
MouseLinkColor.Foreground = clBlue
LineHighlightColor.Background = clNone
LineHighlightColor.Foreground = clNone
inline SynLeftGutterPartList1: TSynGutterPartList
object SynGutterMarks1: TSynGutterMarks
Width = 30
MouseActions = <>
end
object SynGutterLineNumber1: TSynGutterLineNumber
Width = 21
MouseActions = <>
MarkupInfo.Background = clBtnFace
MarkupInfo.Foreground = clNone
DigitCount = 2
ShowOnlyLineNumbersMultiplesOf = 1
ZeroStart = False
LeadingZeros = False
end
object SynGutterChanges1: TSynGutterChanges
Width = 5
MouseActions = <>
ModifiedColor = 59900
SavedColor = clGreen
end
object SynGutterSeparator1: TSynGutterSeparator
Width = 3
MouseActions = <>
MarkupInfo.Background = clWhite
MarkupInfo.Foreground = clGray
end
object SynGutterCodeFolding1: TSynGutterCodeFolding
Width = 13
MouseActions = <>
MarkupInfo.Background = clNone
MarkupInfo.Foreground = clGray
MouseActionsExpanded = <>
MouseActionsCollapsed = <>
end
end
end
object btnRecentFilters: TSpeedButton
Left = 310
Height = 28
Top = 204
Width = 135
Anchors = [akRight, akBottom]
Caption = 'Recent filters'
Images = MainForm.ImageListIcons8
ImageIndex = 108
OnClick = btnRecentFiltersClick
end
object popupRecentFilters: TPopupMenu
Left = 260
Top = 200
end
end

507
source/copytable.pas Normal file
View File

@ -0,0 +1,507 @@
unit copytable;
{$mode delphi}{$H+}
interface
uses
SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, extra_controls,
dbconnection, dbstructures, dbstructures.mysql, laz.VirtualTrees, SynEdit, Menus,
Buttons;
type
TCopyTableForm = class(TExtForm)
editNewTablename: TEdit;
lblNewTablename: TLabel;
btnCancel: TButton;
comboDatabase: TComboBox;
btnOK: TButton;
TreeElements: TLazVirtualStringTree;
MemoFilter: TSynEdit;
lblItems: TLabel;
lblWhere: TLabel;
btnRecentFilters: TSpeedButton;
popupRecentFilters: TPopupMenu;
procedure editNewTablenameChange(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure TreeElementsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
procedure TreeElementsInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
procedure TreeElementsGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer);
procedure TreeElementsInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode;
var ChildCount: Cardinal);
procedure TreeElementsChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnRecentFiltersClick(Sender: TObject);
procedure RecentFilterClick(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ Private declarations }
FDBObj: TDBObject;
FConnection: TDBConnection;
FColumns: TTableColumnList;
FKeys: TTableKeyList;
FForeignKeys: TForeignKeyList;
public
{ Public declarations }
end;
implementation
uses apphelpers, main;
const
nColumns = 0;
nKeys = 1;
nForeignKeys = 2;
nData = 3;
{$R *.lfm}
{$I const.inc}
procedure TCopyTableForm.FormCreate(Sender: TObject);
begin
HasSizeGrip := True;
MainForm.SetupSynEditors(Self);
FixVT(TreeElements);
end;
procedure TCopyTableForm.FormResize(Sender: TObject);
var
HalfWidth: Integer;
const
Space: Integer=8;
begin
// Give both dropdown and edit box the same width. See http://www.heidisql.com/forum.php?t=11039
HalfWidth := (ClientWidth - (3*Space)) div 2;
comboDatabase.Width := HalfWidth;
editNewTablename.Width := HalfWidth;
editNewTablename.Left := comboDatabase.Left + comboDatabase.Width + Space;
end;
procedure TCopyTableForm.FormShow(Sender: TObject);
var
Filter: String;
Obj: PDBObject;
i: Integer;
Item: TMenuItem;
Tree: TVirtualStringTree;
begin
// Todo: check if resizing a form here drags its controls with it
//Width := AppSettings.ReadIntDpiAware(asCopyTableWindowWidth, Self);
//Height := AppSettings.ReadIntDpiAware(asCopyTableWindowHeight, Self);
if Mainform.DBtree.Focused then
Tree := Mainform.DBtree
else
Tree := Mainform.ListTables;
Obj := Tree.GetNodeData(Tree.FocusedNode);
FDBObj := Obj^;
FConnection := FDBObj.Connection;
editNewTablename.Text := FDBObj.Name + '_copy';
editNewTablename.SetFocus;
lblNewTablename.Caption := f_('Copy "%s" to new db.table:', [FDBObj.Name]);
editNewTablename.SetFocus;
// Select TargetDatabase
comboDatabase.Items.Clear;
comboDatabase.Items.Assign(FConnection.AllDatabases);
comboDatabase.ItemIndex := comboDatabase.Items.IndexOf(Mainform.ActiveDatabase);
if comboDatabase.ItemIndex = -1 then
comboDatabase.ItemIndex := 0;
// Fetch columns and key structures from table or view
case FDBObj.NodeType of
lntTable, lntView: begin
FColumns := FDBObj.TableColumns;
FKeys := FDBObj.TableKeys;
FForeignKeys := FDBObj.TableForeignKeys;
end;
else raise Exception.CreateFmt(_('Neither table nor view: %s'), [FDBObj.Name]);
end;
// Reset options tree
TreeElements.Clear;
TreeElements.RootNodeCount := 4;
// Load recent WHERE clauses from registry into dropdown menu
popupRecentFilters.Items.Clear;
for i:=1 to 20 do begin
Filter := AppSettings.ReadString(asCopyTableRecentFilter, IntToStr(i));
if Filter.IsEmpty then
Continue;
Item := TMenuItem.Create(popupRecentFilters);
Item.Caption := IntToStr(i) + ' ' + StrEllipsis(Filter, 100);
Item.Hint := Filter;
Item.OnClick := RecentFilterClick;
popupRecentFilters.Items.Add(Item);
end;
end;
procedure TCopyTableForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
Node: PVirtualNode;
Option: TAppSettingIndex;
Filter: String;
NewValues: TStringList;
i: Integer;
begin
// Save first level node check options
Node := TreeElements.GetFirst;
while Assigned(Node) do begin
case Node.Index of
nColumns: Option := asCopyTableColumns;
nKeys: Option := asCopyTableKeys;
nForeignKeys: Option := asCopyTableForeignKeys;
nData: Option := asCopyTableData;
else raise Exception.Create(_(SUnhandledNodeIndex));
end;
if not (vsDisabled in Node.States) then
AppSettings.WriteBool(Option, Node.CheckState in CheckedStates);
Node := TreeElements.GetNextSibling(Node);
end;
// Store recent filters
if MemoFilter.Enabled and (MemoFilter.GetTextLen > 0) then begin
NewValues := TStringList.Create;
NewValues.Add(MemoFilter.Text);
for i:=1 to 20 do begin
Filter := AppSettings.ReadString(asCopyTableRecentFilter, IntToStr(i));
if Filter.IsEmpty then
Continue;
if NewValues.IndexOf(Filter) = -1 then
NewValues.Add(Filter);
AppSettings.DeleteValue(asCopyTableRecentFilter, IntToStr(i));
end;
for i:=0 to NewValues.Count-1 do begin
AppSettings.WriteString(asCopyTableRecentFilter, NewValues[i], IntToStr(i));
end;
end;
// Store GUI setup
AppSettings.WriteIntDpiAware(asCopyTableWindowWidth, Self, Width);
AppSettings.WriteIntDpiAware(asCopyTableWindowHeight, Self, Height);
end;
procedure TCopyTableForm.TreeElementsChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
begin
// Disable WHERE memo if "Data" was unselected
if (Sender.GetNodeLevel(Node) = 0) and (Node.Index = nData) then begin
MemoFilter.Enabled := Node.CheckState = csCheckedNormal;
btnRecentFilters.Enabled := MemoFilter.Enabled;
if MemoFilter.Enabled then begin
MemoFilter.Highlighter := MainForm.SynSQLSynUsed;
MemoFilter.Color := GetThemeColor(clWindow);
end else begin
MemoFilter.Highlighter := nil;
MemoFilter.Color := GetThemeColor(clBtnFace);
end;
end;
end;
procedure TCopyTableForm.TreeElementsGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex);
begin
// Get node index
if not (Kind in [ikNormal, ikSelected]) then Exit;
case Sender.GetNodeLevel(Node) of
0: case Node.Index of
nColumns: ImageIndex := ICONINDEX_FIELD;
nKeys: ImageIndex := 13;
nForeignKeys: ImageIndex := ICONINDEX_FOREIGNKEY;
nData: ImageIndex := 41;
else raise Exception.Create(_(SUnhandledNodeIndex));
end;
1: case Node.Parent.Index of
nColumns: ImageIndex := ICONINDEX_FIELD;
nKeys: ImageIndex := FKeys[Node.Index].ImageIndex;
nForeignKeys: ImageIndex := ICONINDEX_FOREIGNKEY;
else raise Exception.Create(_(SUnhandledNodeIndex));
end;
end;
end;
procedure TCopyTableForm.TreeElementsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
var
CheckedCount: Integer;
Child: PVirtualNode;
begin
// Get node text
case Sender.GetNodeLevel(Node) of
0: begin
case Node.Index of
nColumns: CellText := _('Columns');
nKeys: CellText := _('Indexes');
nForeignKeys: CellText := _('Foreign keys');
nData: CellText := f_('Data (%s rows)', [FormatNumber(FDBObj.RowCount(False))]);
else raise Exception.Create(_(SUnhandledNodeIndex));
end;
if Node.Index <> nData then begin
CheckedCount := 0;
Child := Sender.GetFirstChild(Node);
while Assigned(Child) do begin
if Child.CheckState in CheckedStates then
Inc(CheckedCount);
Child := Sender.GetNextSibling(Child);
end;
CellText := CellText + ' ('+FormatNumber(CheckedCount)+'/'+FormatNumber(Sender.ChildCount[Node])+')';
end;
end;
1: case Node.Parent.Index of
nColumns: CellText := FColumns[Node.Index].Name;
nKeys: CellText := FKeys[Node.Index].Name;
nForeignKeys: CellText := FForeignKeys[Node.Index].KeyName;
else raise Exception.Create(_(SUnhandledNodeIndex));
end;
end;
end;
procedure TCopyTableForm.TreeElementsInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode;
var ChildCount: Cardinal);
begin
// Set child node count
case Sender.GetNodeLevel(Node) of
0: case Node.Index of
nColumns: ChildCount := FColumns.Count;
nKeys: ChildCount := FKeys.Count;
nForeignKeys: ChildCount := FForeignKeys.Count;
nData: ChildCount := 0;
else raise Exception.Create(_(SUnhandledNodeIndex));
end;
else ChildCount := 0;
end;
end;
procedure TCopyTableForm.TreeElementsInitNode(Sender: TBaseVirtualTree; ParentNode,
Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
var
Option: TAppSettingIndex;
ChildCount: Integer;
begin
// First three upper nodes mostly have child nodes
Node.CheckType := ctTriStateCheckBox;
case Sender.GetNodeLevel(Node) of
0: begin
case Node.Index of
nColumns: begin Option := asCopyTableColumns; ChildCount := FColumns.Count; end;
nKeys: begin Option := asCopyTableKeys; ChildCount := FKeys.Count; end;
nForeignKeys: begin Option := asCopyTableForeignKeys; ChildCount := FForeignKeys.Count; end;
nData: begin Option := asCopyTableData; ChildCount := -1; end;
else raise Exception.Create(_(SUnhandledNodeIndex));
end;
if ChildCount > 0 then
Include(InitialStates, ivsHasChildren);
if (ChildCount = 0) or ((Node.Index = nData) and (FDBObj.RowCount(False) = 0)) then
Node.States := Node.States + [vsDisabled]
else if AppSettings.ReadBool(Option) then
Node.CheckState := csCheckedNormal;
(Sender as TVirtualStringTree).OnChecked(Sender, Node);
end;
1: if Node.Parent.CheckState in CheckedStates then
Node.CheckState := csCheckedNormal;
end;
end;
procedure TCopyTableForm.btnRecentFiltersClick(Sender: TObject);
var
btn: TControl;
begin
// A split button does not drop its menu down when the normal button area is clicked. Do that by hand.
btn := Sender as TControl;
popupRecentFilters.Popup(btn.ClientOrigin.X, btn.ClientOrigin.Y+btn.Height);
end;
procedure TCopyTableForm.RecentFilterClick(Sender: TObject);
var
Item: TMenuItem;
begin
// Load recent filter
Item := Sender as TMenuItem;
MemoFilter.SelectAll;
MemoFilter.SelText := Item.Hint;
end;
procedure TCopyTableForm.editNewTablenameChange(Sender: TObject);
begin
// Disable OK button as long as table name is empty
btnOK.Enabled := editNewTablename.Text <> '';
end;
procedure TCopyTableForm.btnOKClick(Sender: TObject);
var
CreateCode, InsertCode, TargetTable, DataCols, Msg: String;
TableExistence, AutoIncName: String;
ParentNode, Node: PVirtualNode;
DoData, AutoIncGetsKey, AutoIncRemoved, TableHasAutoInc: Boolean;
SelectedColumns: TTableColumnList;
SelectedKeys: TTableKeyList;
SelectedForeignKeys: TForeignKeyList;
Column: TTableColumn;
Key: TTableKey;
ForeignKey: TForeignKey;
ClausePattern: String;
begin
// Compose and run CREATE query
TargetTable := FConnection.QuotedDbAndTableName(comboDatabase.Text, editNewTablename.Text);
ClausePattern := CodeIndent + '%s,' + sLineBreak;
// Watch out if target table exists
try
TableExistence := FConnection.GetVar('SELECT 1 FROM '+
FConnection.QuoteIdent(comboDatabase.Text)+'.'+FConnection.QuoteIdent(editNewTablename.Text));
except
TableExistence := '';
end;
if TableExistence <> '' then begin
if MessageDialog(_('Target table exists. Drop it and overwrite?'), mtConfirmation, [mbYes, mbCancel]) = mrCancel then begin
ModalResult := mrNone;
Exit;
end;
FConnection.Query('DROP TABLE '+TargetTable);
FConnection.ShowWarnings;
end;
Screen.Cursor := crHourglass;
MainForm.ShowStatusMsg(_('Generating SQL code ...'));
DataCols := '';
SelectedColumns := TTableColumnList.Create(False);
SelectedKeys := TTableKeyList.Create(False);
SelectedForeignKeys := TForeignKeyList.Create(False);
DoData := False;
ParentNode := TreeElements.GetFirst;
while Assigned(ParentNode) do begin
Node := TreeElements.GetFirstChild(ParentNode);
while Assigned(Node) do begin
if Node.CheckState in CheckedStates then begin
case ParentNode.Index of
nColumns: SelectedColumns.Add(FColumns[Node.Index]);
nKeys: SelectedKeys.Add(FKeys[Node.Index]);
nForeignkeys: SelectedForeignKeys.Add(FForeignKeys[Node.Index]);
else raise Exception.Create(_(SUnhandledNodeIndex));
end;
end;
Node := TreeElements.GetNextSibling(Node);
end;
if (ParentNode.Index = nData) then
DoData := ParentNode.CheckState in CheckedStates;
ParentNode := TreeElements.GetNextSibling(ParentNode);
end;
CreateCode := '';
TableHasAutoInc := False;
// Columns code. Remove auto_increment attribute if pkey was unchecked, to overcome
// "there can be only one auto column and it must be defined as a key"
AutoIncName := 'unknown';
for Column in SelectedColumns do begin
AutoIncGetsKey := False;
AutoIncRemoved := False;
AutoIncName := Column.AutoIncName;
if Column.DefaultType = cdtAutoInc then begin
for Key in SelectedKeys do begin
// Don't check index type, MySQL allows auto-increment columns on nearly all indexes
if Key.Columns.IndexOf(Column.Name) > -1 then begin
AutoIncGetsKey := True;
Break;
end;
end;
if not AutoIncGetsKey then begin
Column.DefaultType := cdtNothing;
AutoIncRemoved := True;
end;
end;
TableHasAutoInc := TableHasAutoInc or (Column.DefaultType = cdtAutoInc);
CreateCode := CreateCode + Format(ClausePattern, [Column.SQLCode]);
if AutoIncRemoved then
Column.DefaultType := cdtAutoInc;
// Use this column for the INSERT..SELECT query only if it's not a virtual one
if Column.Virtuality.IsEmpty then
DataCols := DataCols + FConnection.QuoteIdent(Column.Name) + ', ';
end;
// Indexes code
for Key in SelectedKeys do
CreateCode := CreateCode + Format(ClausePattern, [Key.SQLCode]);
// Foreign keys code
for ForeignKey in SelectedForeignKeys do
CreateCode := CreateCode + Format(ClausePattern, [ForeignKey.SQLCode(False)]);
// Finish code
Delete(CreateCode, Length(CreateCode)-2, 3);
CreateCode := 'CREATE TABLE '+TargetTable+' ('+CRLF+CreateCode+CRLF+')'+CRLF;
// Add collation and engine clauses
if FDBObj.Collation <> '' then
CreateCode := CreateCode + ' COLLATE ' + FConnection.EscapeString(FDBObj.Collation);
if FDBObj.Engine <> '' then begin
if FConnection.ServerVersionInt < 40018 then
CreateCode := CreateCode + ' TYPE=' + FDBObj.Engine
else
CreateCode := CreateCode + ' ENGINE=' + FDBObj.Engine;
end;
if FDBObj.RowFormat <> '' then
CreateCode := CreateCode + ' ROW_FORMAT=' + FDBObj.RowFormat;
if (FDBObj.AutoInc > -1) and TableHasAutoInc then
CreateCode := CreateCode + ' AUTO_INCREMENT=' + IntToStr(FDBObj.AutoInc);
if FDBObj.Comment <> '' then
CreateCode := CreateCode + ' COMMENT=' + FConnection.EscapeString(FDBObj.Comment);
// Add INSERT .. SELECT .. FROM OrgTable clause
InsertCode := '';
if DoData and (DataCols <> '') then begin
DataCols := Trim(DataCols);
Delete(DataCols, Length(DataCols), 1);
InsertCode := 'INSERT INTO '+TargetTable+' ('+DataCols+') SELECT ' + DataCols + ' FROM ' + FDBObj.QuotedName;
if MemoFilter.GetTextLen > 0 then
InsertCode := InsertCode + ' WHERE ' + MemoFilter.Text;
end;
// Run query and refresh list
try
MainForm.ShowStatusMsg(_('Creating table ...'));
FConnection.Query(CreateCode);
FConnection.ShowWarnings;
if InsertCode <> '' then begin
FConnection.Query(InsertCode);
FConnection.ShowWarnings;
end;
// actRefresh takes care of whether the table editor is open
// See also issue #1597
MainForm.actRefresh.Execute
except
on E:EDbError do begin
Screen.Cursor := crDefault;
Msg := E.Message;
if FConnection.LastErrorCode = ER_WRONG_AUTO_KEY then
Msg := Msg + CRLF + CRLF + f_('Please select the required index for the %s flag.', [AutoIncName]);
ErrorDialog(Msg);
ModalResult := mrNone;
end;
end;
MainForm.ShowStatusMsg;
Screen.Cursor := crDefault;
end;
end.

View File

@ -1411,7 +1411,8 @@ const
implementation
uses
FileInfo, winpeimagereader, elfreader, machoreader, About, data_sorting, column_selection, loaddata, editvar;
FileInfo, winpeimagereader, elfreader, machoreader, About, data_sorting, column_selection, loaddata, editvar,
copytable;
{$R *.lfm}
@ -3058,13 +3059,13 @@ end;
procedure TMainForm.actCopyTableExecute(Sender: TObject);
//var
// Dialog: TCopyTableForm;
var
Dialog: TCopyTableForm;
begin
// copy table
//Dialog := TCopyTableForm.Create(Self);
//Dialog.ShowModal;
//Dialog.Free;
Dialog := TCopyTableForm.Create(Self);
Dialog.ShowModal;
Dialog.Free;
end;