kbmmemtabledesform.pas

内存表控件 kbmMemTable

     end;

     //Selected first ITem if Possible to fire the Onchange Event
     if LTV_Tables.Items.Count > 0 then
     begin
          LTV_Tables.Items[0].Selected:=true;
          LTV_Tables.Items[0].Focused:=true;

          LTV_FromTable.Items[0].Selected:=true;
          LTV_FromTable.Items[0].Focused:=true;
     end;

     RBT_FromTable.Enabled:=LTV_FromTable.Items.Count>0;
end;
{$ENDIF}

procedure TfrmKbmMemTableDesigner.GetActualStructure;
var
   i:integer;
   Item:TListItem;
begin
     //Mark As Filling
     IsFilling:=true;
     try
        //Clear the Listviews
        LTV_Structure.Items.Clear;
        LTV_Existing.Items.Clear;
        LTV_Sort.Items.Clear;

        //Fill the FieldDefs
        for i:=0 to MemTable.Fields.Count-1 do
        begin
             with LTV_Structure.Items.Add do
             begin
                  Caption:=MemTable.Fields.Fields[i].FieldName;
                  SubItems.Add(GetEnumName(Typeinfo(TFieldType),Ord(MemTable.Fields.Fields[i].DataType)));
                  SubItems.Add(IntToStr(MemTable.Fields.Fields[i].Size));
             end;

             // Possible sort fields not yet used.
             Item:=LTV_Existing.Items.Add;
             Item.Caption:=MemTable.Fields.Fields[i].FieldName;
             if IsInFieldNames(MemTable.SortFields,Item.Caption) then
             begin
                   with LTV_Sort.Items.Add do
                        Caption:=Item.Caption;
                   DeleteItem(Item);
             end;
        end;

     finally
        //Un-Mark As Filling
        IsFilling:=False;
     end;

     //Selected first Item if Possible to fire the Onchange Event
     if LTV_Structure.Items.Count>0 then
     begin
          LTV_Structure.Items[0].Selected:=true;
          LTV_Structure.Items[0].Focused:=true;

          LTV_Existing.Items[0].Selected:=true;
          LTV_Existing.Items[0].Focused:=true;
     end;

     //ActualStructure Panel
     PAN_ActualStructure.Enabled:=LTV_Structure.Items.Count>0;

     //Sort Panel
     PAN_Sort.Enabled:=LTV_Existing.Items.Count>0;
     BTN_Sort.Enabled:=false;

     //Force the Buttons Syncronization
     LTV_ExistingChange(Self,nil,ctState);
     LTV_SortChange(Self,nil,ctState);
end;

procedure TfrmKbmMemTableDesigner.CheckAvailData;
begin
     if MemTable.Fields.Count>0 then
        MemTable.Active:=true;

     //Sort Panel
     PAN_Sort.Enabled:=LTV_Existing.Items.Count>0;
     BTN_Sort.Enabled:=(LTV_Sort.Items.Count>0) and (MemTable.Active) and (MemTable.RecordCount>0);
     LTB_SortOptions.Enabled:=LTV_Sort.Items.Count>0;

     //Force the Buttons Synchronization
     LTV_ExistingChange(Self,nil,ctState);
     LTV_SortChange(Self,nil,ctState);

     if (MemTable.Active) and (MemTable.RecordCount>0) then
     begin
          PAN_DataDesign.Enabled:=true;
          DTS_DataDesign.DataSet:=MemTable;
          DTS_DataDesign.Enabled:=true;
          DTS_DataDesign.AutoEdit:=true;
          BTN_Save.Enabled:=true;
     end
     else
     begin
          PAN_DataDesign.Enabled:=false;
          DTS_DataDesign.DataSet:=nil;
          DTS_DataDesign.Enabled:=false;
          DTS_DataDesign.AutoEdit:=false;
          BTN_Save.Enabled:=false;
     end;
end;

{$IFDEF LINUX}
function CreateUniqueName(Dataset:TkbmCustomMemTable; FieldClass:TFIeldClass; FieldName:string; Field:TField):string;
var
   i1,i2:integer;
   s:string;
   unique:boolean;
begin
     for i1:=1 to MaxInt do
     begin
          s:=Format('%s%s%d',[FieldClass.ClassName,FieldName,i1]);

          // Check if unique.
          with Dataset.Owner do
          begin
               unique:=true;
               for i2:=0 to ComponentCount-1 do
               begin
                    if (Components[i2]<>Field) and (CompareText(Components[i2].Name,s)=0) then
                    begin
                         unique:=false;
                         break;
                    end;
               end;

               if unique then
               begin
                    Result:=s;
                    exit;
               end;
          end;
     end;
end;
{$ENDIF}

procedure TfrmKbmMemTableDesigner.CreateFields;
var
   i:integer;
   Field:TField;
begin
     MemTable.DeleteTable;
     with MemTable.FieldDefs do
     begin
          for i:=0 to Count-1 do
          begin
               Field:=Items[i].CreateField(MemTable.Owner,nil,Items[i].Name,false);
               try
                  Field.Origin:='';
{$IFNDEF LINUX}
                  Field.Name := DSDesign.CreateUniqueName(MemTable, Items[i].Name, TFieldClass(Items[i].ClassType), nil);
{$ELSE}
                  Field.Name := CreateUniqueName(MemTable, TFieldClass(Items[i].ClassType), Items[i].Name, nil);
{$ENDIF}
               except
                  Field.Free;
                  raise;
               end;
          end;
     end;
end;

{$IFNDEF LINUX}
procedure TfrmKbmMemTableDesigner.LoadStructure(TableName:string);
var
   Table:TTable;
begin
     //First We 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:=TableName;

        //Call the Procedure that Fills the fieldDefs
        with MemTable do
        begin
             MemTable.Active:=false;
             CreateTableAs(Table,[mtcpoStructure]);
        end;
        CreateFields;

     finally
        //Free the Table
        Table.Free;
     end;
     //Refresh the Actual Structure
     GetActualStructure;
end;
{$ENDIF}

procedure TfrmKbmMemTableDesigner.TransAll(Source,Dest:TListView);
var
   Item:TListItem;
   i:integer;
begin
     //Mark as filling
     IsFilling:=true;
     try
        for i:= 0 to Source.Items.Count-1 do
        begin
             Item:=Dest.Items.Add;
             Item.Caption := Source.Items[i].Caption;
        end;

        //Clear Existing
        Source.Items.Clear;
     finally
        //UnMark filling
        IsFilling:=false;
     end;

     if Dest.Items.Count > 0 then
     begin
          Dest.Items[0].Selected:=true;
          Dest.Items[0].Focused:=true;
     end;

     //Force the Buttons Syncronization
     LTV_ExistingChange(Self,nil,ctState);
     LTV_SortChange(Self,nil,ctState);
end;

procedure TfrmKbmMemTableDesigner.CopyItem(SourceItem:TListITem; Dest:TListView);
var
   Item:TListItem;
begin
     Item:=Dest.Items.Add;
     Item.Caption:=SourceItem.Caption;
     DeleteItem(SourceItem);

     Item.Selected:=true;
     Item.MakeVisible{$IFNDEF LINUX}(false){$ENDIF};

     //Force the Buttons Sincronization.
     LTV_ExistingChange(Self,nil,ctState);
     LTV_SortChange(Self,nil,ctState);
end;

procedure TfrmKbmMemTableDesigner.StoreSortSetup;
var
   i:integer;
   s,a:string;
   CompareOptions:TkbmMemTableCompareOptions;
begin
     // Store sort fields.
     if LTV_Sort.Items.Count>0 then
     begin
          a:='';
          for i:=0 to LTV_Sort.Items.Count-1 do
          begin
               s:=s+a+LTV_Sort.Items[i].Caption;
               a:=';';
          end;
          MemTable.SortFields:=s;
     end;

     // Store sort options.
     CompareOptions := [];
     if LTB_SortOptions.Items.Count>0 then
     begin
          for i:=ord(Low(TkbmMemTableCompareOption)) to ord(High(TkbmMemTableCompareOption)) do
              if LTB_SortOptions.Checked[i] then
                 CompareOptions := CompareOptions + [TkbmMemTableCompareOption(i)];
          MemTable.SortOptions:=CompareOptions;
     end;

     Designer.Modified;
end;

procedure TfrmKbmMemTableDesigner.CopyDataSet(Source: TDataSet; Dest: TDataSet;Visual: boolean);
var
   i:integer;
begin
     if Visual then
     begin
          //Progress
          LAB_Progress.Visible:=true;
          PRO_Records.Position:=0;
          PRO_Records.Max:=Source.RecordCount;
          PRO_Records.Visible:=true;
          Application.ProcessMessages;
     end;

     //First Record of Source
     Source.First;

     //Read all the Records
     TkbmMemTable(Dest).IgnoreReadOnly:=true;
     try
        while not Source.EOF do
        begin
             try
                Dest.Insert;
                for i:=0 to Source.Fields.Count-1 do
                begin
                     try
                        Dest.FieldByName(Source.Fields[i].FieldName).Value:=Source.Fields[i].Value;
                     except
                        on E: Exception do
                        begin
                             MessageDlg('An error ocurred while trying to append a tecord to the memory table: '+E.Message,mtError,[mbOk],0);
                             Dest.Cancel;
                             exit;
                        end;
                     end;
                end;
                Dest.Post;
             except
                on E: Exception do
                begin
                   MessageDlg('An error ocurred while trying to append a tecord to the memory table: '+E.Message,mtError,[mbOk],0);
                   Dest.Cancel;
                   exit;
                end;
             end;

             if Visual then PRO_Records.Position:=PRO_Records.Position + 1;

             //Next Record
             Source.Next;
        end;
     finally
        TkbmMemTable(Dest).IgnoreReadOnly:=false;
     end;

     If Visual then
     begin
          //Progress
          LAB_Progress.Visible:=false;
          PRO_Records.Visible:=false;
     end;
end;

procedure TfrmKbmMemTableDesigner.FormCreate(Sender: TObject);
begin
     //Set the Active Page
     PGC_Options.ActivePage := TBS_BorrowStructure;
end;

procedure TfrmKbmMemTableDesigner.FormShow(Sender: TObject);
var
   i:integer;
begin
     if MemTable <> nil then
     begin
          //PageControl
          PGC_Options.Enabled:=true;

          //Caption
          Caption:=Format('%s  [%s]',[KbmMemTableDesignerVersion,MemTable.Name]);

          //TBS_BorrowStructure
          //First We get the Aliases
{$IFNDEF LINUX}
          SES_Dummy.Active := True;
          GetAliases;

          {Depending on the Amount of Items}
          if LTV_Alias.Items.Count > 0 then
          begin
               //Panels
               PAN_BorrowStructure.Enabled := True;

               //ListViews
               //Tables ListView Filled on the Onchange Event of the LTV_Alias Listview
               //buttons Arranged by the Onchange Event Also
          end
          else
          begin
               //ListViews
               LTV_Alias.Items.Clear;
               LTV_Tables.Items.Clear;

               //Panels
               PAN_BorrowStructure.Enabled:=false;

               //Buttons
               BTN_GetStructure.Enabled:=false;
               BTN_Refresh.Enabled:=false;
          end;
{$ENDIF}

          GetDatasets;
          
          //TBS_ActualStructure
          GetActualStructure;

          //Panel Controled by the GetActualStructure Procedure

          //TBS_Data
          //Panels
          PAN_FromTable.Enabled:=false;

          //RadioButtons &checkBoxes
          RBT_FromFile.Checked:=true;
          CHK_Binary.Enabled:=true;
          CHK_Binary.Checked:=true;
          CHK_OnlyData.Enabled:=true;
          CHK_OnlyData.Checked:=true;

          //RBT_FromTable Set on the GetTables Procedure

          //Edits
          EDT_File.Text:=TKbmMemTable(MemTable).PersistentFile;

          //Buttons
          BTN_SelectFileName.Enabled:=true;
          BTN_Load.Enabled:=FileExists(EDT_File.Text);

          //ProgressBar
          PRO_Records.Visible:=false;
          LAB_Progress.Visible:=false;

          //TBS_DataDesign
          CheckAvailData;

          //TBS_Sort
          //Controled by the GetActualStructure

          //SortOptions
          LTB_SortOptions.Items.Clear;
          for i:=ord(Low(TkbmMemTableCompareOption)) to ord(High(TkbmMemTableCompareOption)) do
              LTB_SortOptions.Items.Add(GetEnumName(Typeinfo(TkbmMemTableCompareOption),i));
     end
     else
     begin
          //If the Owner is not correctly passed then Disable All
          //Caption
          Caption:=Format('%s  (MemTable not found)',[KbmMemTableDesignerVersion]);

          //PageControl
          PGC_Options.Enabled:=false;

          //TBS_BorrowStructure
          //ListViews}
{$IFNDEF LINUX}
          LTV_Alias.Items.Clear;
          LTV_Tables.Items.Clear;
{$ENDIF}

          //Panels
          PAN_BorrowStructure.Enabled:=false;

          //Buttons
          BTN_GetStructure.Enabled:=false;
          BTN_Refresh.Enabled:=false;

          //TBS_ActualStructure
          PAN_ActualStructure.Enabled:=false;

          //TBS_Data
          //Panels
          PAN_Data.Enabled:=false;

          //Edits
          EDT_File.Text:='';

          //CheckBoxes
          CHK_Binary.Checked:=false;
          CHK_Binary.Enabled:=false;
          CHK_OnlyData.Checked:=false;
          CHK_OnlyData.Enabled:=false;

          //Listviews
          LTV_FromTable.Items.Clear;

          //Buttons
          BTN_Load.Enabled:=false;
          BTN_SelectFileName.Enabled:=false;
          BTN_Save.Enabled:=false;

          //ProgressBar
          PRO_Records.Visible:=false;