📄 kbmmemtabledesform.pas
字号:
LAB_Progress.Visible:=false;
//TBS_DataDesign
PAN_DataDesign.Enabled:=false;
DTS_DataDesign.DataSet:=nil;
DTS_DataDesign.Enabled:=false;
DTS_DataDesign.AutoEdit:=false;
//TBS_Sort
//Panels
PAN_Sort.Enabled:=false;
//Listviews
LTV_Existing.Items.Clear;
LTV_Sort.Items.Clear;
//Listboxes
LTB_SortOptions.Items.Clear;
LTB_SortOptions.Enabled:=false;
//Buttons
BTN_Sort.Enabled:=false;
BTN_SEL_All.Enabled:=false;
BTN_SEL_Selected.Enabled:=false;
BTN_UNS_Selected.Enabled:=false;
BTN_UNS_All.Enabled:=false;
BTN_ORD_First.Enabled:=false;
BTN_ORD_Last.Enabled:=false;
BTN_ORD_Plus.Enabled:=false;
BTN_ORD_Minus.Enabled:=false;
end;
end;
procedure TfrmKbmMemTableDesigner.FormClose(Sender: TObject;var Action: TCloseAction);
begin
try
//Close the Session
StoreSortSetup;
{$IFNDEF LINUX}
SES_Dummy.Active:=false;
{$ENDIF}
finally
Action:=caFree;
end;
end;
{$IFNDEF LINUX}
procedure TfrmKbmMemTableDesigner.LTV_AliasChange(Sender: TObject;Item: TListItem; Change: TItemChange);
begin
if IsFilling then exit;
//If no Item Selected then Clear Tables Listview, Disable Button and Exit
if LTV_Alias.Selected = nil then
begin
//Listview
LTV_Tables.Items.Clear;
//Buttons
BTN_GetStructure.Enabled:=false;
exit;
end;
//Fill the Tables Listview
GetTables(LTV_Alias.Selected.Caption);
//Button only Active if there is a Table Selected
BTN_GetStructure.Enabled := LTV_Tables.Selected <> nil;
end;
procedure TfrmKbmMemTableDesigner.LTV_TablesChange(Sender: TObject;Item: TListItem; Change: TItemChange);
begin
if IsFilling then exit;
//Button only Active if there is a Table Selected
BTN_GetStructure.Enabled := LTV_Tables.Selected <> nil;
end;
{$ENDIF}
procedure TfrmKbmMemTableDesigner.BTN_GetStructureClick(Sender: TObject);
var
ds:TDataset;
begin
{$IFNDEF LINUX}
if pcBorrowFrom.ActivePage=tsBDEAlias then
begin
//General Procedure for Loading a Structure
if LTV_Tables.Selected<>nil then LoadStructure(LTV_Tables.Selected.Caption);
end
else
{$ENDIF}
if pcBorrowFrom.ActivePage=tsTDataset then
begin
if LTV_Datasets.Selected<>nil then
begin
ds:=TDataSet(LTV_Datasets.Selected.Data);
if ds<>nil then
begin
Memtable.Active:=False;
Memtable.CreateTableAs(ds,[mtcpoStructure,mtcpoProperties,mtcpoLookup]);
CreateFields;
GetActualStructure;
end;
end;
end;
//Show the Active Structure
PGC_Options.ActivePage := TBS_ActualStructure;
end;
procedure TfrmKbmMemTableDesigner.RBT_FromFileClick(Sender: TObject);
begin
//Activate the Items
PAN_FromTable.Enabled:=false;
PAN_FromDataset.Enabled:=false;
BTN_SelectFileName.Enabled:=true;
BTN_Load.Enabled := FileExists(EDT_File.Text);
CHK_Binary.Enabled:=true;
CHK_OnlyData.Enabled:=true;
end;
procedure TfrmKbmMemTableDesigner.RBT_FromTableClick(Sender: TObject);
begin
//Activate the Items
PAN_FromTable.Enabled:=true;
PAN_FromDataset.Enabled:=false;
BTN_SelectFileName.Enabled:=false;
BTN_Load.Enabled:=LTV_FromTable.Selected <> nil;
CHK_Binary.Enabled:=false;
CHK_OnlyData.Enabled:=false;
end;
procedure TfrmKbmMemTableDesigner.RBT_FromDatasetClick(Sender: TObject);
begin
//Activate the Items
PAN_FromDataset.Enabled:=true;
BTN_SelectFileName.Enabled:=false;
PAN_FromTable.Enabled:=false;
BTN_Load.Enabled:=LTV_FromDataset.Selected <> nil;
CHK_Binary.Enabled:=false;
CHK_OnlyData.Enabled:=false;
end;
procedure TfrmKbmMemTableDesigner.LTV_FromTableChange(Sender: TObject;Item: TListItem; Change: TItemChange);
begin
if (IsFilling) then exit;
if not RBT_FromTable.Checked then exit;
//Button only Active if there is a Table Selected
BTN_Load.Enabled:=LTV_FromTable.Selected <> nil;
end;
procedure TfrmKbmMemTableDesigner.BTN_SelectFileNameClick(Sender: TObject);
begin
DLG_SelectFile.InitialDir := ExtractFileDir(EDT_File.Text);
DLG_SelectFile.FileName := ExtractFileName(EDT_File.Text);
if DLG_SelectFile.Execute then
begin
EDT_File.Text := DLG_SelectFile.FileName;
TkbmMemTable(MemTable).PersistentFile := DLG_SelectFile.FileName;
end;
BTN_Load.Enabled := FileExists(EDT_File.Text);
end;
procedure TfrmKbmMemTableDesigner.BTN_LoadClick(Sender: TObject);
var
{$IFNDEF LINUX}
Table:TTable;
{$ENDIF}
ds:TDataset;
DummyTable:TKbmMemTable;
Fmt:TkbmCustomStreamFormat;
begin
//Depending on What method..
if RBT_FromFile.Checked then
begin
//Empty the Table
MemTable.Active:=true;
TkbmMemTable(MemTable).EmptyTable;
DummyTable:=TKbmMemTable.Create(Self);
try
if CHK_Binary.Checked then
Fmt:=TkbmBinaryStreamFormat.Create(nil)
else
Fmt:=TkbmCSVStreamFormat.Create(nil);
try
DummyTable.LoadFromFileViaFormat(EDT_File.Text,Fmt);
finally
Fmt.Free;
end;
if not CHK_OnlyData.Checked then
with Memtable do
begin
Active := False;
CreateTableAs(DummyTable,[mtcpoStructure]);
CreateFields;
end;
//Activate the MemTable
MemTable.Active:=true;
//Copy the Table
CopyDataSet(DummyTable,MemTable,True);
finally
//Free Dummy Table
DummyTable.Free;
end;
//Get the Structure
GetActualStructure;
CheckAvailData;
MemTable.First;
//Activate de DataDesgin TabSheet
PGC_Options.ActivePage := TBS_DataDesign;
end
else
begin
//Empty the Table
if MemTable.active then
TkbmMemTable(MemTable).EmptyTable;
{$IFNDEF LINUX}
// Check if from table, then make table access.
if RBT_FromTable.Checked then
begin
//Create a Table that will hold the Table
Table:=TTable.Create(Self);
try
//Assign the Values to the Table
Table.DatabaseName := LTV_Alias.Selected.Caption;
Table.TableName := LTV_FromTable.Selected.Caption;
//Load the Structure
LoadStructure(LTV_FromTable.Selected.Caption);
//Activate the MemTable
MemTable.Active:=true;
try
Table.Active:=true;
Table.First;
except
MessageDlg('An error ocurred while trying to open the source table.',mtError,[mbOk],0);
exit;
end;
//Copy the Table
CopyDataSet(Table,MemTable,True);
finally
//Free the Table
Table.Free;
end;
end
else
begin
{$ENDIF}
ds:=TDataSet(LTV_FromDataset.Selected.Data);
if ds<>nil then
begin
Memtable.Active:=False;
MemTable.LoadFromDataSet(ds,[mtcpoStructure,mtcpoProperties,mtcpoLookup]);
GetActualStructure;
end;
{$IFNDEF LINUX}
end;
{$ENDIF}
CheckAvailData;
MemTable.First;
//Activate the DataDesgin TabSheet
PGC_Options.ActivePage := TBS_DataDesign;
end;
end;
procedure TfrmKbmMemTableDesigner.BTN_SaveClick(Sender: TObject);
var
SaveBinary:boolean;
Fmt:TkbmCustomStreamFormat;
begin
if not DLG_SaveFile.Execute then exit;
//Get binary Option
SaveBinary:=CHK_Binary.Checked;
//Saving the File
if SaveBinary then
Fmt:=TkbmBinaryStreamFormat.Create(nil)
else
Fmt:=TkbmCSVStreamFormat.Create(nil);
try
TkbmMemTable(MemTable).SaveToFileViaFormat(DLG_SaveFile.FileName,Fmt);
finally
Fmt.Free;
end;
//Refresh PersistentFile Values
EDT_File.Text := DLG_SaveFile.FileName;
TkbmMemTable(MemTable).PersistentFile := DLG_SaveFile.FileName;
end;
procedure TfrmKbmMemTableDesigner.BTN_RefreshClick(Sender: TObject);
begin
FormShow(Self);
end;
procedure TfrmKbmMemTableDesigner.LTV_ExistingChange(Sender: TObject;Item: TListItem; Change: TItemChange);
var
ListItem:TListItem;
begin
if (IsFilling) then exit;
BTN_Sort.Enabled := LTV_Sort.Items.Count > 0;
LTB_SortOptions.Enabled := LTV_Sort.Items.Count > 0;
//Get the Item Selected
ListItem := LTV_Existing.Selected;
if ListItem=nil then
begin
BTN_SEL_Selected.Enabled:=false;
BTN_SEL_All.Enabled := LTV_Existing.Items.Count > 0;
exit;
end;
//Adjust Buttons
BTN_SEL_All.Enabled := LTV_Existing.Items.Count > 0;
BTN_SEL_Selected.Enabled:=true;
end;
procedure TfrmKbmMemTableDesigner.LTV_SortChange(Sender: TObject;Item: TListItem; Change: TItemChange);
var
ListItem:TListItem;
begin
if (IsFilling) then exit;
BTN_Sort.Enabled := LTV_Sort.Items.Count > 0;
LTB_SortOptions.Enabled := LTV_Sort.Items.Count > 0;
//Get the Item Selected
ListItem:=LTV_Sort.Selected;
if ListItem = nil then
begin
BTN_UNS_Selected.Enabled:=false;
BTN_UNS_All.Enabled:=LTV_Sort.Items.Count > 0;
BTN_ORD_First.Enabled:=false;
BTN_ORD_Last.Enabled:=false;
BTN_ORD_Plus.Enabled:=false;
BTN_ORD_Minus.Enabled:=false;
exit;
end;
//Adjust Buttons
BTN_UNS_Selected.Enabled:=true;
BTN_UNS_All.Enabled := LTV_Sort.Items.Count > 0;
BTN_ORD_First.Enabled := ListItem.Index <> 0;
BTN_ORD_Last.Enabled := (LTV_Sort.Items.Count > 0) and (ListItem.Index <> (LTV_Sort.Items.Count-1));
BTN_ORD_Minus.Enabled := ListItem.Index < (LTV_Sort.Items.Count - 1);
BTN_ORD_Plus.Enabled := ListItem.Index <> 0;
end;
procedure TfrmKbmMemTableDesigner.BTN_SEL_AllClick(Sender: TObject);
begin
//Procedure To Copy All Items
TransAll(LTV_Existing,LTV_Sort);
StoreSortSetup;
end;
procedure TfrmKbmMemTableDesigner.BTN_UNS_AllClick(Sender: TObject);
begin
//Procedure To Copy All Items
TransAll(LTV_Sort,LTV_Existing);
StoreSortSetup;
end;
procedure TfrmKbmMemTableDesigner.BTN_SEL_SelectedClick(Sender: TObject);
begin
//Procedure To Copy One Item
CopyItem(LTV_Existing.Selected,LTV_Sort);
StoreSortSetup;
end;
procedure TfrmKbmMemTableDesigner.BTN_UNS_SelectedClick(Sender: TObject);
begin
//Procedure To Copy One Item
CopyItem(LTV_Sort.Selected,LTV_Existing);
StoreSortSetup;
end;
procedure TfrmKbmMemTableDesigner.BTN_ORD_LastClick(Sender: TObject);
begin
SelectFull(MoveItem(LTV_Sort.Selected,LTV_Sort.ITems.Count));
StoreSortSetup;
end;
procedure TfrmKbmMemTableDesigner.BTN_ORD_FirstClick(Sender: TObject);
begin
SelectFull(MoveItem(LTV_Sort.Selected,0));
StoreSortSetup;
end;
procedure TfrmKbmMemTableDesigner.BTN_ORD_MinusClick(Sender: TObject);
var
ItemDest:TListItem;
begin
ItemDest := LTV_Sort.Items[LTV_Sort.Selected.Index + 1];
SwapItems(LTV_Sort.Selected,ItemDest);
SelectFull(ItemDest);
StoreSortSetup;
end;
procedure TfrmKbmMemTableDesigner.BTN_ORD_PlusClick(Sender: TObject);
var
ItemDest:TListItem;
begin
ItemDest := LTV_Sort.Items[LTV_Sort.Selected.Index - 1];
SwapItems(LTV_Sort.Selected,ItemDest);
SelectFull(ItemDest);
StoreSortSetup;
end;
procedure TfrmKbmMemTableDesigner.BTN_SortClick(Sender: TObject);
var
i:integer;
CompareOptions:TkbmMemTableCompareOptions;
SortFields:string;
begin
MemTable.Active:=true;
//Init CompareOptions
if LTB_SortOptions.Items.Count<=0 then exit;
CompareOptions := [];
for i:=ord(Low(TkbmMemTableCompareOption)) to ord(High(TkbmMemTableCompareOption)) do
if LTB_SortOptions.Checked[i] then
CompareOptions := CompareOptions + [TkbmMemTableCompareOption(i)];
//Init Sort Fields
SortFields := '';
for i:=0 to LTV_Sort.Items.Count - 1 do
begin
SortFields := SortFields + LTV_Sort.Items[i].Caption;
if i<>LTV_Sort.Items.Count - 1 then SortFields := SortFields + ';';
end;
//Sort the Table
TKbmMemTable(MemTable).SortOn(SortFields,CompareOptions);
MemTable.First;
//Activate de DataDesgin TabSheet
PGC_Options.ActivePage := TBS_DataDesign;
end;
procedure TfrmKbmMemTableDesigner.LTV_DatasetsChange(Sender: TObject;
Item: TListItem; Change: TItemChange);
begin
//Button only Active if there is a Table Selected
BTN_GetStructure.Enabled := LTV_Datasets.Selected <> nil;
end;
procedure TfrmKbmMemTableDesigner.LTV_FromDatasetChange(Sender: TObject;
Item: TListItem; Change: TItemChange);
begin
if (IsFilling) then exit;
if not RBT_FromDataset.Checked then exit;
//Button only Active if there is a dataset Selected
BTN_Load.Enabled:=LTV_FromDataset.Selected <> nil;
end;
{$ELSE}
implementation
{$ENDIF}
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -