unit1.pas

kbmMemTable v5.50 (Dec. 12 2005)内存表控件

          MasterSource:=nil;

          // Define data fields.
          with kbmMemTable1.FieldDefs do
          begin
               Clear;
               Add('Period', ftInteger, 0, false);
               Add('VALUE', ftInteger, 0, false);
               Add('String', ftString, 30, false);
               Add('BytesField', ftBytes, 20, false);
               Add('Color', ftInteger, 0, false);
               Add('Date', ftDate, 0, false);
               Add('Bool', ftBoolean, 0, false);
               Add('Memo', ftMemo, 0, false);
               Add('AutoInc', ftAutoInc,0,false);
               Add('Currency',ftCurrency,0,false);
{$IFDEF LEVEL4}
               Add('WideString',ftWideString,40,false);
{$ENDIF}
          end;

          // Define index fields.
          with kbmMemTable1.IndexDefs do
          begin
               Clear;
               Add('Period','PERIOD',[]);
               Add('Index1','VALUE',[ixdescending]);
               Add('StringIndex','String',[]);
               Add('combined','PERIOD;VALUE',[]);
               Add('descending','PERIOD',[ixDescending]);
//               Add('Index2','Color;Period',[]);
          end;

          // Create the table according to definitions.
          CreateTable;

          TCurrencyField(FieldByName('Currency')).DisplayFormat:='$###0.00';

          // Setup eventhandlers for dynamically created bytefield.
          with FieldByName('BytesField') do
          begin
               OnSetText:=kbmMemTable1BytesFieldSetText;
               OnGetText:=kbmMemTable1BytesFieldGetText;
          end;

          // Define sorting and index.
          IndexFieldNames := 'VALUE';
     end;

{$IFDEF CALC}
     // Define calculated field.
     CalcField:=TStringField.Create(self);
     CalcField.FieldKind:=fkCalculated;
     CalcField.Size:=20;
     CalcField.FieldName:='CALC';
     CalcField.DataSet:=kbmMemTable1;
{$ENDIF}

     // Setup other dataaware controls.
     DBEdit1.DataSource:=DataSource1;
     DBEdit1.DataField:='BytesField';
     DBMemo1.DataSource:=DataSource1;
     DBMemo1.DataField:='Memo';
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
     kbmMemTable1.Open;
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
     kbmMemTable1.Close;
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
     with kbmMemTable1 do
     begin
          IndexFieldNames:='';
          SortFields:='';
          MasterSource:=nil;
          DBImage1.DataField:='';
          DBMemo1.DataField:='';
          DBEdit1.DataSource:=nil;
          LoadFromDataSet(Table1, [mtcpoStructure,mtcpoProperties]);
          DBImage1.DataField:='graphic';
          DBImage1.DataSource:=DataSource1;
          DBMemo1.DataField:='Notes';
          DBMemo1.DataSource:=DataSource1;
     end;
end;

procedure TForm1.Button11Click(Sender: TObject);
var
   Options:TkbmMemTableCompareOptions;
begin
     Options := [];
     if chbDescending.Checked then Options:=Options + [mtcoDescending];
     if chbCaseInsensitive.Checked then Options:=Options + [mtcoCaseInsensitive];
     kbmMemTable1.SortOn(cbSortField.Text, Options);
end;

procedure TForm1.kbmMemTable1FilterRecord(DataSet: TDataSet; var Accept: Boolean);
begin
     // Example of runtime fast filtering.  Only select records where period>10.
     //     Accept:=DataSet.FieldByName('Period').AsInteger > 10;
end;

procedure TForm1.TableFilteredCheckBoxClick(Sender: TObject);
begin
     DataSource1.DataSet.Filtered:=TCheckBox(Sender).Checked;
end;

procedure TForm1.btnLocatePeriodClick(Sender: TObject);
begin
     if DataSource1.DataSet.Locate('PERIOD', eSearch.Text, []) then
        ShowMessage('Found')
     else
         ShowMessage('Not found');
end;

procedure TForm1.btnLocateCalcClick(Sender: TObject);
var
   Options:TLocateOptions;
begin
     Options:=[];
     if chbCaseInsensitive.Checked then Include(Options,loCaseInsensitive);
     if chbPartialKey.Checked then Include(Options,loPartialKey);
     DataSource1.DataSet.Locate('CALC', eSearch.Text, Options);
end;

procedure TForm1.btnLocateValueClick(Sender: TObject);
begin
     DataSource1.DataSet.Locate('VALUE', eSearch.Text, []);
end;

procedure TForm1.btnLookupCalcClick(Sender: TObject);
begin
     eResult.Text:=VarToStr(DataSource1.DataSet.Lookup('PERIOD', eSearch.Text, 'CALC'));
end;

procedure TForm1.Button12Click(Sender: TObject);
begin
     // Prepare a memorytable for detail.
     with kbmMemTable1 do
     begin
          // Remove non used fields currently wired to the memorytable which will not be used for the master/detail demo.
          DBMemo1.DataSource:=nil;
          DBEdit1.DataSource:=nil;
          DBImage1.DataSource:=nil;

          LoadFromDataset(tDetailTemplate, [mtcpoStructure,mtcpoProperties]);

          // Dynamically build index.
//          AddIndex('iCustNo','CustNo',[]);
//          UpdateIndexes;

          // Setup index.
          tMaster.Active:=true;
          DetailFields:='CustNo';
          MasterSource:=dsMaster;
          MasterFields:='CustNo';
     end;

     kbmMemTable1.Active:=true;
end;

procedure TForm1.kbmMemTable1CompressBlobStream(Dataset:TkbmCustomMemTable; UnCompressedStream,
  CompressedStream: TStream);
begin
     if BlobCompression.Checked then
{$ifdef ZIP}
        ZIPCompressBlobStream(UnCompressedStream,CompressedStream)
{$else}
        LZHCompressBlobStream(UnCompressedStream,CompressedStream)
{$endif}
     else
        CompressedStream.CopyFrom(UnCompressedStream, 0);
end;

procedure TForm1.kbmMemTable1DecompressBlobStream(Dataset:TkbmCustomMemTable; CompressedStream,
  DeCompressedStream: TStream);
begin
     if BlobCompression.Checked then
{$ifdef ZIP}
        ZIPDeCompressBlobStream(CompressedStream,DeCompressedStream)
{$else}
        LZHDeCompressBlobStream(CompressedStream,DeCompressedStream)
{$endif}
     else
         DeCompressedStream.CopyFrom(CompressedStream, 0);
end;

procedure TForm1.TabSheet3Enter(Sender: TObject);
var
   i:integer;
begin
     // Build list of fields to sort on.
     cbSortField.Clear;
     for i:=0 to kbmMemTable1.FieldCount-1 do
         cbSortField.Items.Add(kbmMemTable1.Fields[i].FieldName);
     cbSortField.ItemIndex:=0;
end;

procedure TForm1.btnSetRangeClick(Sender: TObject);
begin
     kbmMemTable1.IndexName:='PERIOD';
     kbmMemTable1.SetRange([51],[69]);
end;

procedure TForm1.btnCancelRangeClick(Sender: TObject);
begin
     kbmMemTable1.CancelRange;
end;

procedure TForm1.btnFindNearestClick(Sender: TObject);
begin
     kbmMemTable1.IndexFieldNames:='VALUE';
     kbmMemtable1.FindNearest([eSearch.Text]);
end;

procedure TForm1.kbmMemTable1AfterScroll(DataSet: TDataSet);
begin
     LRecNo.caption:=IntToStr(DataSet.RecNo)+'/'+IntToStr(DataSet.RecordCount);
end;

procedure TForm1.tMasterAfterScroll(DataSet: TDataSet);
begin
     lMasterRecNo.caption:=IntToStr(DataSet.RecNo)+'/'+IntToStr(DataSet.RecordCount);
end;

procedure TForm1.btnGetBookmarkClick(Sender: TObject);
begin
     bm:=kbmMemTable1.GetBookmark;
end;

procedure TForm1.btnGotoBookmarkClick(Sender: TObject);
begin
     kbmMemTable1.GotoBookmark(bm);
end;

procedure TForm1.btnRebuildIdxClick(Sender: TObject);
begin
     kbmMemTable1.Indexes.ReBuildAll;
end;

procedure TForm1.TabSheet8Enter(Sender: TObject);
var
   i:integer;
begin
     // Build list of indexes currently available.
     cbIndexes.Clear;
     cbIndexes.Items.Add('');
     for i:=0 to kbmMemTable1.IndexDefs.Count-1 do
         cbIndexes.Items.Add(kbmMemTable1.IndexDefs.Items[i].Name);
end;

procedure TForm1.cbIndexesChange(Sender: TObject);
begin
     kbmMemTable1.IndexName:=cbIndexes.Text;
end;

procedure TForm1.chbEnableIndexesClick(Sender: TObject);
begin
     kbmMemTable1.EnableIndexes:=chbEnableIndexes.Checked;
end;

procedure TForm1.btnAddIndexClick(Sender: TObject);
var
   io:TIndexOptions;
begin
     io:=[];
     if chbColorUnique.checked then io:=io+[ixUnique];
     if chbColorDescending.checked then io:=io+[ixDescending];
     kbmMemTable1.AddIndex('testindex','COLOR',io);

     // Update combobox list of indexes.
     TabSheet8Enter(nil);
end;

procedure TForm1.btnDeleteIndexClick(Sender: TObject);
begin
     kbmMemTable1.DeleteIndex('testindex');

     // Update combobox list of indexes.
     TabSheet8Enter(nil);
end;

procedure TForm1.kbmMemTable1BytesFieldGetText(Sender: TField;
  var Text: String; DisplayText: Boolean);
var
   len:integer;
   h,l:byte;
   s:string;
begin
     if Sender.IsNull then Text:='(NULL)'
     else
     begin
          s:=Sender.AsString;
          h:=ord(s[1]);
          l:=ord(s[2]);
          len:=h*256 + l;
          Text:=Copy(s,3,len);
     end;
end;

procedure TForm1.kbmMemTable1BytesFieldSetText(Sender: TField;
  const Text: String);
var
   len:integer;
   h,l:byte;
begin
     len:=length(Text);
     if len=0 then Sender.Clear
     else
     begin
          h:=len div 256;
          l:=len mod 256;
          Sender.AsString:=chr(h)+chr(l)+Text;
     end;
end;

procedure TForm1.btnSetFilterClick(Sender: TObject);
begin
     DataSource1.DataSet.Filter:=eFilter.Text;
     TableFilteredCheckBox.Visible:=trim(DataSource1.DataSet.Filter)<>'';
end;

procedure TForm1.kbmMemTable1AfterEdit(DataSet: TDataSet);
var
   fld:TField;
begin
     fld:=DataSet.FindField('VALUE');
     if fld<>nil then lOldValue.Caption:=fld.OldValue;
end;

procedure TForm1.Button14Click(Sender: TObject);
begin
     kbmMemTable1.CheckPoint;
end;

procedure TForm1.Button15Click(Sender: TObject);
begin
     kbmMemTable1.SaveToFileViaFormat('c:\deltas.dat',sfBinaryWithDeltas);
end;

procedure TForm1.chbVersionAllClick(Sender: TObject);
begin
     if chbVersionAll.checked then
        kbmMemTable1.VersioningMode:=mtvmAllSinceCheckPoint
     else
        kbmMemTable1.VersioningMode:=mtvm1SinceCheckPoint;
     if kbmMemTable1.Active then kbmMemTable1.CheckPoint;
end;

procedure TForm1.BinarySaveClick(Sender: TObject);
begin
     chbSaveDeltas.Enabled:=BinarySave.Checked;
     if not chbSaveDeltas.Enabled then chbSaveDeltas.Checked:=false;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     // Create the demo delta handler.
     DeltaHandler:=TDemoDeltaHandler.Create(nil);
     kbmMemTable1.DeltaHandler:=DeltaHandler;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
     DeltaHandler.Free;
end;

procedure TForm1.Button16Click(Sender: TObject);
begin
     if assigned(kbmMemTable1.DeltaHandler) then kbmMemTable1.DeltaHandler.Resolve;
     kbmMemTable1.CheckPoint;
end;

procedure TForm1.Button17Click(Sender: TObject);
begin
     SnapShot:=kbmMemTable1.AllData;
end;

procedure TForm1.Button18Click(Sender: TObject);
begin
     kbmMemTable1.AllData:=SnapShot;
end;

procedure TForm1.Button19Click(Sender: TObject);
begin
     kbmMemTable1.VersioningMode:=mtvmAllSinceCheckPoint;
     kbmMemTable1.StartTransaction;
     lTransactionLevel.caption:=inttostr(kbmMemTable1.TransactionLevel);
end;

procedure TForm1.Button20Click(Sender: TObject);
begin
     DBGrid1.SelectedRows.Clear;
     kbmMemTable1.Commit;
     lTransactionLevel.caption:=inttostr(kbmMemTable1.TransactionLevel);
end;

procedure TForm1.Button21Click(Sender: TObject);
begin
     kbmMemTable1.Rollback;
     lTransactionLevel.caption:=inttostr(kbmMemTable1.TransactionLevel);
end;

procedure TForm1.kbmMemTable1Progress(DataSet: TDataSet;
  Percentage: Integer; Code: TkbmProgressCode);
const
   ProgressStrings:array [0..ord(mtpcSort)] of string = (
     'Load','Save','Empty','Pack','Checkpoint','Search','Copy','Update','Sort');
begin
     lProgress.Caption:=ProgressStrings[ord(Code)]+' '+inttostr(Percentage)+'%';
     lProgress.Refresh;
end;

procedure TForm1.Button22Click(Sender: TObject);
begin
     DBMemo1.DataSource.DataSet.Edit;
     DBMemo1.Field.Clear;
end;

procedure TForm1.Button13Click(Sender: TObject);
var
   i:integer;
begin
     for i:=0 to 100 do
     begin
          kbmMemTable1.AppendRecord([i,100-i,'S_'+inttostr(i*2)]);
     end;
end;

procedure TForm1.Button10Click(Sender: TObject);
begin
     kbmMemTable1.RecNo:=10;
end;

procedure TForm1.Button23Click(Sender: TObject);
begin
     kbmMemTable1.IndexFieldNames:='VALUE';
     if kbmMemtable1.FindKey([eSearch.Text]) then
        ShowMessage('Found')
     else
         ShowMessage('Not Found');
end;

procedure TForm1.Button24Click(Sender: TObject);
var
   io:TIndexOptions;
begin
     io:=[];
     if chbColorUnique.checked then io:=io+[ixUnique];
     if chbColorDescending.checked then io:=io+[ixDescending];
     kbmMemTable1.AddFilteredIndex('filteredindex','PERIOD',io,'Period<70',[]{$IFNDEF LEVEL5},nil{$ENDIF});

     // Update combobox list of indexes.
     TabSheet8Enter(nil);
end;

procedure TForm1.sfBinaryCompress(Dataset: TkbmCustomMemTable;
  UnCompressedStream, CompressedStream: TStream);
begin
     Screen.Cursor := crHourglass;
     Application.ProcessMessages;
     try
        if LZHCompressed.Checked then
{$ifdef ZIP}
            ZIPCompressSave(UnCompressedStream,CompressedStream)
{$else}
            LZHCompressSave(UnCompressedStream,CompressedStream)
{$endif}
        else
            CompressedStream.CopyFrom(UnCompressedStream, 0);
     finally
        Screen.Cursor:=crDefault;
     end;
end;

procedure TForm1.sfBinaryDeCompress(Dataset: TkbmCustomMemTable;
  CompressedStream, DeCompressedStream: TStream);
begin
     Screen.Cursor := crHourglass;
     Application.ProcessMessages;
     try
        if LZHCompressed.Checked then
{$ifdef ZIP}
            ZIPDeCompressLoad(CompressedStream,DeCompressedStream)
{$else}
            LZHDeCompressLoad(CompressedStream,DeCompressedStream)
{$endif}
        else
            DeCompressedStream.CopyFrom(CompressedStream, 0);
     finally
        Screen.Cursor:=crDefault;
     end;
end;

end.