kbmmemtabledesform.pas

内存表控件 kbmMemTable

unit kbmMemTableDesForm;

interface

{$include kbmMemTable.inc}

{$IFNDEF LINUX}

uses
{$IFDEF CLX}
    QForms,
    QImgList, QDialogs, QGrids, QDBGrids, QStdCtrls, QCheckLst,
    QButtons, QControls, QComCtrls, QExtCtrls,
    TypInfo, ImgList, Controls, Dialogs, DB, DBTables, Grids, DBGrids,
  StdCtrls, CheckLst, Buttons, ComCtrls, ExtCtrls, Classes
{$ELSE}
    Windows, Messages, Graphics, Controls, Forms, Dialogs,
    ComCtrls, ExtCtrls, StdCtrls,BDE,DBTables,typinfo,
    Grids, DBGrids, CheckLst, ImgList, Buttons, DB, Classes
 {$IFDEF LEVEL6}
    ,DesignEditors
    ,DesignIntf
 {$ELSE}
    ,DsgnIntf
 {$ENDIF}
{$ENDIF}
    ,SysUtils
    ,kbmMemTable
    ,kbmMemCSVStreamFormat
    ,kbmMemBinaryStreamFormat
    ;

type
    TfrmKbmMemTableDesigner = class(TForm)

{$IFNDEF LINUX} 
      SES_Dummy: TSession;
      tsBDEAlias: TTabSheet;
      Label1: TLabel;
      Label2: TLabel;
      LTV_Alias: TListView;
      LTV_Tables: TListView;
{$ENDIF}
      StatusBar1: TStatusBar;
      DLG_SelectFile: TOpenDialog;
      DTS_DataDesign: TDataSource;
      DLG_SaveFile: TSaveDialog;
      IMG_LTV_Tables: TImageList;
      IMG_LTV_Alias: TImageList;
      IMG_LTV_Fields: TImageList;
      PGC_Options: TPageControl;
      TBS_ActualStructure: TTabSheet;
      PAN_ActualStructure: TPanel;
      LTV_Structure: TListView;
      TBS_BorrowStructure: TTabSheet;
      PAN_BorrowStructure: TPanel;
      BTN_Refresh: TButton;
      BTN_GetStructure: TButton;
      pcBorrowFrom: TPageControl;
      tsTDataset: TTabSheet;
      LTV_Datasets: TListView;
      TBS_Data: TTabSheet;
      PAN_Data: TPanel;
      LAB_Progress: TLabel;
      RBT_FromFile: TRadioButton;
      RBT_FromTable: TRadioButton;
      PAN_FromFile: TPanel;
      Label3: TLabel;
      EDT_File: TEdit;
      PAN_FromTable: TPanel;
      LTV_FromTable: TListView;
      BTN_Load: TButton;
      BTN_SelectFileName: TButton;
      BTN_Save: TButton;
      PRO_Records: TProgressBar;
      CHK_Binary: TCheckBox;
      CHK_OnlyData: TCheckBox;
      TBS_Sorting: TTabSheet;
      PAN_Sort: TPanel;
      Label4: TLabel;
      Label5: TLabel;
      BTN_SEL_All: TSpeedButton;
      BTN_SEL_Selected: TSpeedButton;
      BTN_UNS_Selected: TSpeedButton;
      BTN_UNS_All: TSpeedButton;
      BTN_ORD_First: TSpeedButton;
      BTN_ORD_Plus: TSpeedButton;
      BTN_ORD_Minus: TSpeedButton;
      BTN_ORD_Last: TSpeedButton;
      Label6: TLabel;
      LTV_Existing: TListView;
      LTV_Sort: TListView;
      BTN_Sort: TButton;
      LTB_SortOptions: TCheckListBox;
      TBS_DataDesign: TTabSheet;
      PAN_DataDesign: TPanel;
      DBG_DataDesign: TDBGrid;
      RBT_FromDataset: TRadioButton;
      PAN_FromDataset: TPanel;
      LTV_FromDataset: TListView;
      procedure FormCreate(Sender: TObject);
      procedure FormShow(Sender: TObject);
      procedure FormClose(Sender: TObject; var Action: TCloseAction);
{$IFNDEF LINUX}
      procedure LTV_AliasChange(Sender: TObject; Item: TListItem;Change: TItemChange);
      procedure LTV_TablesChange(Sender: TObject; Item: TListItem;Change: TItemChange);
{$ENDIF}
      procedure BTN_GetStructureClick(Sender: TObject);
      procedure RBT_FromFileClick(Sender: TObject);
      procedure RBT_FromTableClick(Sender: TObject);
      procedure LTV_FromTableChange(Sender: TObject; Item: TListItem;Change: TItemChange);
      procedure BTN_SelectFileNameClick(Sender: TObject);
      procedure BTN_LoadClick(Sender: TObject);
      procedure BTN_SaveClick(Sender: TObject);
      procedure BTN_RefreshClick(Sender: TObject);
      procedure LTV_ExistingChange(Sender: TObject; Item: TListItem;Change: TItemChange);
      procedure LTV_SortChange(Sender: TObject; Item: TListItem;Change: TItemChange);
      procedure BTN_SEL_AllClick(Sender: TObject);
      procedure BTN_UNS_AllClick(Sender: TObject);
      procedure BTN_SEL_SelectedClick(Sender: TObject);
      procedure BTN_UNS_SelectedClick(Sender: TObject);
      procedure BTN_ORD_LastClick(Sender: TObject);
      procedure BTN_ORD_FirstClick(Sender: TObject);
      procedure BTN_ORD_MinusClick(Sender: TObject);
      procedure BTN_ORD_PlusClick(Sender: TObject);
      procedure BTN_SortClick(Sender: TObject);
    procedure LTV_DatasetsChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure RBT_FromDatasetClick(Sender: TObject);
    procedure LTV_FromDatasetChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    private
      { Private declarations }
      IsFilling: boolean;
{$IFNDEF LINUX}
      procedure GetAliases;
      procedure GetTables(DatabaseName: string);
      procedure LoadStructure(TableName: string);
{$ENDIF}
      procedure GetDatasets;
      procedure GetActualStructure;
      procedure CheckAvailData;
      procedure TransAll(Source: TListView; Dest: TListView);
      procedure CopyItem(SourceItem: TListITem; Dest: TListView);
      procedure StoreSortSetup;

      {ListItems Handling functions and procedures }
      function SwapItems(ItemFrom:TListItem; ItemTo:TListItem):boolean;
      function MoveItem(Item:TListItem; DestinationIndex:integer):TListItem;
      procedure SelectFull(Item:TListItem);
      function DeleteItem(Item:TListItem): TListItem;
      function IsInFieldNames(FieldNames,FieldName:string):boolean;
      procedure CreateFields;
    public
      { Public declarations }
{$IFDEF LEVEL3}
      Designer:TFormDesigner;
{$ELSE}
 {$IFDEF LEVEL6}
      Designer:IDesigner;
 {$ELSE}
      Designer:IFormDesigner;
 {$ENDIF}
{$ENDIF}
      MemTable: TkbmMemTable;
      procedure CopyDataSet(Source: TDataSet; Dest: TDataSet;Visual: boolean);
    end;

var
   frmKbmMemTableDesigner:TfrmKbmMemTableDesigner;

const
     KbmMemTableDesignerVersion='Designer - TkbmMemTable v.'+COMPONENT_VERSION;

implementation

{$IFNDEF LINUX}
 {$R *.dfm}
{$ELSE}
 {$R *.xfm}
{$ENDIF}

// To use code completion, please remark the line further down (uses DSDesign)
// during designtime. Remember to remove the remark before compiletime.
// Kim Bo Madsen/Optical Services - Scandinavia
{$IFNDEF LINUX}
uses DSDesign;
{$ENDIF}

function TfrmKbmMemTableDesigner.SwapItems(ItemFrom:TListItem; ItemTo:TListItem):boolean;
var
   ListView:TListView;
   i:integer;
   ItemDummy:TStringList;

   tmpCaption:string;
   tmpState:integer;
   tmpImageIndex:integer;
   ControlCheck:boolean;
begin
     Result:=false;

     if (ItemFrom = nil) or (ItemTo = nil) then exit;
     if TListView(ItemFrom.Owner.Owner) <> TListView(ItemTo.Owner.Owner) then exit;

     ListView:=TListView(ItemFrom.Owner.Owner);
     if ListView = nil then exit;

     ControlCheck:=ListView.CheckBoxes;

     ItemDummy:=TStringList.Create;
     try
        tmpCaption:=ItemFrom.Caption;
        tmpImageIndex:=ItemFrom.ImageIndex;

        if ControlCheck then
           tmpState:=ord(ItemFrom.Checked)
        else
{$IFNDEF LINUX}
            tmpState:=ItemFrom.StateIndex;
{$ELSE}
            tmpState:=0;
{$ENDIF}

        for i:=0 to ItemFrom.SubItems.Count-1 do
            ItemDummy.Add(ItemFrom.SubItems[i]);

        ItemFrom.Caption:=ItemTo.Caption;

        for i:=0 to ItemTo.SubItems.Count-1 do
            ItemFrom.SubItems[i]:=ItemTo.SubItems[i];

        ItemFrom.ImageIndex:=ItemTo.ImageIndex;
        if ControlCheck then
           ItemFrom.Checked:=ItemTo.Checked
{$IFNDEF LINUX}
        else
            ItemFrom.StateIndex:=ItemTo.StateIndex
{$ENDIF}
        ;


        ItemTo.Caption:=tmpCaption;
        for i:=0 to ItemDummy.Count-1 do
            ItemTo.SubItems[i]:=ItemDummy[i];
        ItemTo.ImageIndex:=tmpImageIndex;

        if ControlCheck then
           ItemTo.Checked:=boolean(tmpState)
{$IFNDEF LINUX}
        else
            ItemTo.StateIndex:=tmpState
{$ENDIF};
     finally
        ItemDummy.Free;
     end;
     Result:=true;
end;

function TfrmKbmMemTableDesigner.MoveItem(Item:TListItem; DestinationIndex:integer):TListItem;
var
   ListView:TListView;
   NewItem:TListItem;
   i:integer;
begin
     Result:=nil;

     if Item=nil then exit;

     ListView:=TListView(Item.Owner.Owner);
     if ListView = nil then exit;

     NewItem:=ListView.Items.Insert(DestinationIndex);
     NewItem.Caption:=Item.Caption;
     NewItem.ImageIndex:=Item.ImageIndex;
{$IFNDEF LINUX}
     NewItem.StateIndex:=Item.StateIndex;
{$ENDIF}
     NewItem.Checked:=Item.Checked;

     for i:=0 to Item.SubItems.Count - 1 do
         NewItem.SubItems.Add(Item.SubItems[i]);

     Item.Delete;
     Result:=NewItem;
end;

procedure TfrmKbmMemTableDesigner.SelectFull(Item:TListItem);
var
   ListView:TListView;
begin
     ListView:=TListView(Item.Owner.Owner);

     if ListView<>nil then
     begin
          if ListView.Selected<>nil then
          begin
               ListView.Selected.Focused:=false;
               ListView.Selected.Selected:=false;
          end;
     end;

     if Item<>nil then
     begin
          Item.Selected:=true;
          Item.Focused:=true;
          Item.MakeVisible{$IFNDEF LINUX}(false){$ENDIF};
     end;
end;

function TfrmKbmMemTableDesigner.DeleteItem(Item:TListItem):TListItem;
var
   Index:integer;
   ListView:TListView;
begin
     ListView:=TListView(Item.Owner.Owner);
     Index:=Item.Index;
     Item.Delete;

     Result:=nil;
     if ListView=nil then exit;
     if ListView.Items.Count=0 then exit;

     if Index>ListView.Items.Count-1 then
        SelectFull(ListView.Items[ListView.Items.Count-1])
     else
         SelectFull(ListView.Items[Index]);

     Result:=ListView.Selected;
end;

function TfrmKbmMemTableDesigner.IsInFieldNames(FieldNames,FieldName:string):boolean;
var
   p:integer;
   s:string;
begin
     Result:=false;
     p:=1;
     while p<=length(FieldNames) do
     begin
          s:=ExtractFieldName(FieldNames,p);
          if s=FieldName then
          begin
               Result:=true;
               break;
          end;
     end;
end;

procedure TfrmKbmMemTableDesigner.GetDatasets;
var
   I: Integer;
 procedure AddDatasetsFromForm(CurForm: TComponent);
 var
    I:integer;
    Item:TListItem;
    CurComp: TComponent;
 begin
{$IFDEF LEVEL6}
{$IFNDEF LINUX}
      if (CurForm is TCustomForm) then
      begin
           if TCustomForm(CurForm).Designer<>nil then
              CurForm:=TCustomForm(CurForm).designer.GetRoot;
      end;
{$ENDIF}
{$ENDIF}
      for i:=CurForm.ComponentCount-1 downto 0 do
      begin
           CurComp:=CurForm.Components[I];
           if (CurComp is TDataSet) and (CurComp<>MemTable) then
           begin
                Item:=LTV_Datasets.Items.Add;
                Item.Caption:= Format('%s.%s', [CurForm.Name, CurComp.Name]);
                Item.Data := CurComp;

                Item:=LTV_FromDataset.Items.Add;
                Item.Caption:= Format('%s.%s', [CurForm.Name, CurComp.Name]);
                Item.Data := CurComp;
           end;
      end;
 end;
begin
     // Mark as we are Filling the ListView
     IsFilling:=true;

     try
        // Build datasets Listview
        LTV_Datasets.Items.Clear;
        LTV_FromDataset.Items.Clear;
        for I := Screen.CustomFormCount - 1 downto 0 do
            AddDatasetsFromForm(Screen.CustomForms[I]);
{$IFNDEF LEVEL6}
        for I := Screen.DataModuleCount - 1 downto 0 do
            AddDatasetsFromForm(Screen.DataModules[I]);
{$ENDIF}
     finally
        //Un-Mark as we are Filling the ListView
        IsFilling:=false;
     end;
end;

{$IFNDEF LINUX}
procedure TfrmKbmMemTableDesigner.GetAliases;
var
   TempCursor:hDbiCur;
   DB_Description:DBDesc;
   Item:TListItem;
begin
     // Mark as we are Filling the ListView
     IsFilling:=true;

     try
        // Clear Alias Listview
        LTV_Alias.Items.Clear;

        Check(DbiOpenDatabaseList(TempCursor));
        while (DbiGetNextRecord(TempCursor, dbiNOLOCK, @DB_Description, nil) = DBIERR_NONE) do
        begin
             Item:=LTV_Alias.Items.Add;
             Item.Caption:=DB_Description.szName;
             Item.SubItems.Add(DB_Description.szPhyName);
        end;

        // Close the Cursor
        Check(DbiCloseCursor(TempCursor));
     finally
        //Un-Mark as we are Filling the ListView
        IsFilling:=false;
     end;

{
     // Selected first Item if Possible to fire the Onchange Event
     if LTV_Alias.Items.Count>0 then
     begin
          LTV_Alias.Items[0].Selected:=true;
          LTV_Alias.Items[0].Focused:=true;
     end;
}
end;
{$ENDIF}

{$IFNDEF LINUX}
procedure TfrmKbmMemTableDesigner.GetTables(DatabaseName: string);
var
   Tables:TStringList;
   Item:TListItem;
   TableNumber:integer;
begin
     //Mark as we are Filling the ListView
     IsFilling:=true;

     try
        //Clear Tables Listviews
        LTV_Tables.Items.Clear;
        LTV_FromTable.Items.Clear;

        //Tables Holder for GetTableNames
        Tables:=TStringList.Create;

        try
           //Get Table Names
           SES_Dummy.GetTableNames(DatabaseName, '*.*',False, False, Tables);

           //Fill de Listview with the Tables Returned
           for TableNumber:=0 to Tables.Count-1 do
           begin
                Item:=LTV_Tables.Items.Add;
                Item.Caption:=Tables[TableNumber];

                Item:=LTV_FromTable.Items.Add;
                Item.Caption:=Tables[TableNumber];
           end;
        finally
           //Free the StringList
           Tables.Free;
        end;

     finally
        //Un-Mark as we are Filling the ListView
        IsFilling:=False;