⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 kbmmemtabledesform.pas

📁 内存数据库控件源代码
💻 PAS
📖 第 1 页 / 共 3 页
字号:
          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 + -