unit1.pas

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

  CompressedStream: TStream);
begin
{$IFDEF COMPRESSION}
     if BlobCompression.Checked then
 {$ifdef ZIP}
        ZIPCompressBlobStream(UnCompressedStream,CompressedStream)
 {$else}
        LZHCompressBlobStream(UnCompressedStream,CompressedStream)
 {$endif}
     else
{$ENDIF}
        CompressedStream.CopyFrom(UnCompressedStream, 0);
end;

procedure TForm1.kbmMemTable1DecompressBlobStream(Dataset:TkbmCustomMemTable; CompressedStream,
  DeCompressedStream: TStream);
begin
{$IFDEF COMPRESSION}
     if BlobCompression.Checked then
 {$ifdef ZIP}
        ZIPDeCompressBlobStream(CompressedStream,DeCompressedStream)
 {$else}
        LZHDeCompressBlobStream(CompressedStream,DeCompressedStream)
 {$endif}
     else
{$ENDIF}
         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',[]);

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

procedure TForm1.sfBinaryCompress(Dataset: TkbmCustomMemTable;
  UnCompressedStream, CompressedStream: TStream);
begin
     Screen.Cursor := crHourglass;
     Application.ProcessMessages;
     try
{$IFDEF COMPRESSED}
        if LZHCompressed.Checked then
 {$ifdef ZIP}
            ZIPCompressSave(UnCompressedStream,CompressedStream)
 {$else}
            LZHCompressSave(UnCompressedStream,CompressedStream)
 {$endif}
        else
{$ENDIF}
            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
{$IFDEF COMPRESSED}
        if LZHCompressed.Checked then
 {$ifdef ZIP}
            ZIPDeCompressLoad(CompressedStream,DeCompressedStream)
 {$else}
            LZHDeCompressLoad(CompressedStream,DeCompressedStream)
 {$endif}
        else
{$ENDIF}
            DeCompressedStream.CopyFrom(CompressedStream, 0);
     finally
        Screen.Cursor:=crDefault;
     end;
end;

end.