unit1.pas

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

unit Unit1;

interface

{$I kbmMemTable.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, Grids, DBGrids, ExtCtrls, DBCtrls,
  StdCtrls, kbmMemTable,
  DBTables, ComCtrls, Mask, kbmMemCSVStreamFormat,
  kbmMemBinaryStreamFormat, System.ComponentModel,variants, Borland.Vcl.DBClient;

type
  // An example on how to create a deltahandler.
  TDemoDeltaHandler = class(TkbmCustomDeltaHandler)
  protected
     procedure InsertRecord(var Retry:boolean; var State:TUpdateStatus); override;
     procedure DeleteRecord(var Retry:boolean; var State:TUpdateStatus); override;
     procedure ModifyRecord(var Retry:boolean; var State:TUpdateStatus); override;
  end;

  // The standard form definition.
  TForm1 = class(TForm)
    Panel1: TPanel;
    DBGrid1: TDBGrid;
    DBNavigator1: TDBNavigator;
    DataSource1: TDataSource;
    kbmMemTable1: TkbmMemTable;
    Table1: TTable;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button1: TButton;
    Panel2: TPanel;
    DBImage1: TDBImage;
    DBMemo1: TDBMemo;
    TabSheet2: TTabSheet;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    TabSheet3: TTabSheet;
    Button11: TButton;
    Label10: TLabel;
    btnLocatePeriod: TButton;
    eSearch: TEdit;
    btnLocateValue: TButton;
    chbCaseInsensitive: TCheckBox;
    chbPartialKey: TCheckBox;
    btnLookupCalc: TButton;
    btnLocateCalc: TButton;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    eResult: TEdit;
    TabSheet4: TTabSheet;
    tMaster: TTable;
    DBGrid2: TDBGrid;
    dsMaster: TDataSource;
    Panel3: TPanel;
    Button12: TButton;
    tDetailTemplate: TTable;
    Label18: TLabel;
    chbDescending: TCheckBox;
    Label19: TLabel;
    lblLZH: TLabel;
    PageControl2: TPageControl;
    TabSheet5: TTabSheet;
    TabSheet6: TTabSheet;
    Label1: TLabel;
    Button9: TButton;
    Button2: TButton;
    Label2: TLabel;
    Label3: TLabel;
    Button3: TButton;
    Label4: TLabel;
    Button4: TButton;
    Button5: TButton;
    Label5: TLabel;
    Memo1: TMemo;
    Panel4: TPanel;
    LZHCompressed: TCheckBox;
    BlobCompression: TCheckBox;
    Label20: TLabel;
    Label21: TLabel;
    BinarySave: TCheckBox;
    cbSortField: TComboBox;
    Label24: TLabel;
    btnFindNearest: TButton;
    eRecordCount: TEdit;
    Label25: TLabel;
    Label26: TLabel;
    lRecNo: TLabel;
    Panel5: TPanel;
    Label27: TLabel;
    lMasterRecNo: TLabel;
    TabSheet7: TTabSheet;
    btnGetBookmark: TButton;
    Label11: TLabel;
    btnGotoBookmark: TButton;
    Label29: TLabel;
    TabSheet8: TTabSheet;
    btnRebuildIdx: TButton;
    Label30: TLabel;
    Label31: TLabel;
    cbIndexes: TComboBox;
    chbEnableIndexes: TCheckBox;
    btnAddIndex: TButton;
    Label32: TLabel;
    btnDeleteIndex: TButton;
    Label33: TLabel;
    chbSaveIndexDef: TCheckBox;
    Panel6: TPanel;
    DBEdit1: TDBEdit;
    Label34: TLabel;
    chbRandomColor: TCheckBox;
    DBNavigator2: TDBNavigator;
    chbColorUnique: TCheckBox;
    chbColorDescending: TCheckBox;
    Label35: TLabel;
    lOldValue: TLabel;
    TabSheet10: TTabSheet;
    Button14: TButton;
    Label36: TLabel;
    Label37: TLabel;
    chbVersionAll: TCheckBox;
    Label38: TLabel;
    Button15: TButton;
    chbSaveDeltas: TCheckBox;
    Button16: TButton;
    Label39: TLabel;
    TabSheet11: TTabSheet;
    Button17: TButton;
    Button18: TButton;
    Label40: TLabel;
    Label41: TLabel;
    TabSheet12: TTabSheet;
    Button19: TButton;
    Button20: TButton;
    Button21: TButton;
    Label42: TLabel;
    lTransactionLevel: TLabel;
    Label43: TLabel;
    Label44: TLabel;
    Label45: TLabel;
    chbGenerateMemos: TCheckBox;
    TabSheet13: TTabSheet;
    Label28: TLabel;
    eFilter: TEdit;
    TableFilteredCheckBox: TCheckBox;
    btnSetFilter: TButton;
    Label22: TLabel;
    btnSetRange: TButton;
    btnCancelRange: TButton;
    Label23: TLabel;
    Panel7: TPanel;
    Label46: TLabel;
    lProgress: TLabel;
    Button22: TButton;
    Button13: TButton;
    Button10: TButton;
    Label47: TLabel;
    Button23: TButton;
    chbNoQuotes: TCheckBox;
    Button24: TButton;
    Label48: TLabel;
    sfBinary: TkbmBinaryStreamFormat;
    sfCSV: TkbmCSVStreamFormat;
    sfBinaryWithDeltas: TkbmBinaryStreamFormat;
    ClientDataSet1: TClientDataSet;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure MemTable1CalcFields(DataSet: TDataSet);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure kbmMemTable1FilterRecord(DataSet: TDataSet;
      var Accept: Boolean);
    procedure TableFilteredCheckBoxClick(Sender: TObject);
    procedure btnLocatePeriodClick(Sender: TObject);
    procedure btnLocateCalcClick(Sender: TObject);
    procedure btnLocateValueClick(Sender: TObject);
    procedure btnLookupCalcClick(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure kbmMemTable1CompressBlobStream(Dataset:TkbmCustomMemTable; UnCompressedStream,
      CompressedStream: TStream);
    procedure kbmMemTable1DecompressBlobStream(Dataset:TkbmCustomMemTable; CompressedStream,
      DeCompressedStream: TStream);
    procedure TabSheet3Enter(Sender: TObject);
    procedure btnSetRangeClick(Sender: TObject);
    procedure btnCancelRangeClick(Sender: TObject);
    procedure btnFindNearestClick(Sender: TObject);
    procedure kbmMemTable1AfterScroll(DataSet: TDataSet);
    procedure tMasterAfterScroll(DataSet: TDataSet);
    procedure btnGetBookmarkClick(Sender: TObject);
    procedure btnGotoBookmarkClick(Sender: TObject);
    procedure btnRebuildIdxClick(Sender: TObject);
    procedure TabSheet8Enter(Sender: TObject);
    procedure cbIndexesChange(Sender: TObject);
    procedure chbEnableIndexesClick(Sender: TObject);
    procedure btnAddIndexClick(Sender: TObject);
    procedure btnDeleteIndexClick(Sender: TObject);
    procedure kbmMemTable1BytesFieldGetText(Sender: TField;
      var Text: String; DisplayText: Boolean);
    procedure kbmMemTable1BytesFieldSetText(Sender: TField;
      const Text: String);
    procedure btnSetFilterClick(Sender: TObject);
    procedure kbmMemTable1AfterEdit(DataSet: TDataSet);
    procedure Button14Click(Sender: TObject);
    procedure Button15Click(Sender: TObject);
    procedure chbVersionAllClick(Sender: TObject);
    procedure BinarySaveClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button16Click(Sender: TObject);
    procedure Button17Click(Sender: TObject);
    procedure Button18Click(Sender: TObject);
    procedure Button19Click(Sender: TObject);
    procedure Button20Click(Sender: TObject);
    procedure Button21Click(Sender: TObject);
    procedure kbmMemTable1Progress(DataSet: TDataSet; Percentage: Integer;
      Code: TkbmProgressCode);
    procedure Button22Click(Sender: TObject);
    procedure Button13Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button23Click(Sender: TObject);
    procedure Button24Click(Sender: TObject);
    procedure sfBinaryCompress(Dataset: TkbmCustomMemTable;
      UnCompressedStream, CompressedStream: TStream);
    procedure sfBinaryDeCompress(Dataset: TkbmCustomMemTable;
      CompressedStream, DeCompressedStream: TStream);
  private
    { Private declarations }
  public
    { Public declarations }
    CalcField:TStringField;
    bm:TBookmark;
    DeltaHandler:TDemoDeltaHandler;
    SnapShot:variant;
  end;

var
  Form1: TForm1;

implementation

{$R *.NFM}

// An example on how to create a deltahandler.
procedure TDemoDeltaHandler.ModifyRecord(var Retry:boolean; var State:TUpdateStatus);
var
   i:integer;
   s1,s2,sv:string;
   v:variant;
begin
     s1:='';
     s2:='';
     for i:=0 to FieldCount-1 do
     begin
          if (not (Fields[i].DataType in kbmBinaryTypes)) or (Fields[i].DataType=ftMemo) then
          begin
               v:=Values[i];
               if (VarIsNull(v)) then sv:='<NULL>'
               else sv:=v;
               s1:=s1+sv+' ';

               v:=OrigValues[i];
               if (VarIsNull(v)) then sv:='<NULL>'
               else sv:=v;
               s2:=s2+sv+' ';
          end;
     end;
     ShowMessage(Format('Modified record (%s) to (%s)',[s2,s1]));
end;

procedure TDemoDeltaHandler.InsertRecord(var Retry:boolean; var State:TUpdateStatus);
var
   i:integer;
   s,sv:string;
   v:variant;
begin
     s:='';
     for i:=0 to FieldCount-1 do
     begin
          v:=Values[i];
          if not (Fields[i].DataType in kbmBinaryTypes) then
          begin
               if (VarIsNull(v)) then sv:='<NULL>'
               else sv:=v;
               s:=s+sv+' ';
          end;
     end;
     ShowMessage(Format('Inserted record (%s)',[s]));
end;

procedure TDemoDeltaHandler.DeleteRecord(var Retry:boolean; var State:TUpdateStatus);
var
   i:integer;
   s,sv:string;
   v:variant;
begin
     s:='';
     for i:=0 to FieldCount-1 do
     begin
          v:=Values[i];
          if not (Fields[i].DataType in kbmBinaryTypes) then
          begin
               if (VarIsNull(v)) then sv:='<NULL>'
               else sv:=v;
               s:=s+sv+' ';
          end;
     end;
     ShowMessage(Format('Deleted record (%s)',[s]));
end;

// ****************************************************************************
// The following code illustrates an example on creating a TkbmMemTable
// on the fly in runtime code.
//
//
//  // Create the memorytable object, and set a few optionel stuff.
//  kbmMemTable1 := TkbmMemTable.Create(Self); //Owner is Self. It will be auto-destroyed.
//  kbmMemTable1.SortOptions := [];                                           // Optional.
//  kbmMemTable1.PersistentFile := 'testfil.txt';                             // Optional.
//  kbmMemTable1.OnCompress := kbmMemTable1Compress;                          // Optional.
//  kbmMemTable1.OnDecompress := kbmMemTable1Decompress;                      // Optional.
//  kbmMemTable1.OnCompressBlobStream := kbmMemTable1CompressBlobStream;      // Optional.
//  kbmMemTable1.OnDecompressBlobStream := kbmMemTable1DecompressBlobStream;  // Optional.
//  kbmMemTable1.OnCalcFields := MemTable1CalcFields;                         // Optional.
//  kbmMemTable1.OnFilterRecord := kbmMemTable1FilterRecord;                  // Optional.
//  kbmMemTable1.MasterSource := Nil;                                         // Optional.
//