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, TeeProcs, TeEngine,
  Chart, StdCtrls, Series, DBChart, kbmMemTable,
  DBTables, ComCtrls, kbmCompress, Mask, kbmMemCSVStreamFormat,
  kbmMemBinaryStreamFormat
{$ifdef LEVEL6}
  ,variants
{$endif}
;

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;
    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

type
   TkbmProtCustomStreamFormat = class(TkbmCustomStreamFormat);

{$R *.DFM}

// 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.
//
//  //Now, creating the field defs.                                           // Similar required.
//  kbmMemTable1.FieldDefs.Clear; //We dont need this line, but it does not hurt either.
//  kbmMemTable1.FieldDefs.Add('Period', ftInteger, 0, False);
//  kbmMemTable1.FieldDefs.Add('Value', ftInteger, 0, False);
//  kbmMemTable1.FieldDefs.Add('Color', ftInteger, 0, False);
//  kbmMemTable1.FieldDefs.Add('Calc', FtString, 20, False);
//  kbmMemTable1.FieldDefs.Add('Date', ftDate, 0, False);
//
//  // Define index fields.                                                   // Optional.
//  kbmMemTable1.IndexDefs.Add('Index1','Value',[]);
//
//  // Finally create the table according to definitions.                     // Required.
//  kbmMemTable1.CreateTable;
//
//  //Since this is a run-time created one, we have to assign the following here.
//  DataSource1.DataSet := kbmMemTable1;
//
//  // Optionel. IndexFields and SortFields must be assigned AFTER CreateTable
//  kbmMemTable1.IndexFields := 'Value';
//  kbmMemTable1.SortFields := 'Value';
//


procedure TForm1.Button1Click(Sender: TObject);
var
   i,j:integer;
begin
     j:=strtoint(eRecordCount.text);
     with kbmMemTable1 do
     begin
          Close;
          DisableControls;
          try
             Open;
             for i:=1 to j do
             begin
//OutputDebugString(Pchar('i='+inttostr(i)));
                  Append;
                  FieldByName('PERIOD').asinteger:=i;
                  FieldByName('VALUE').asinteger:=(j-i) * 2;
                  if chbRandomColor.Checked then
                     FieldByName('COLOR').asinteger:=Random(j)
                  else
                     FieldByName('COLOR').asinteger:=i*4;
                  FieldByName('Date').AsDateTime:=Now+i-1;
                  FieldByName('String').AsString:='String:'+inttostr(i);
{$IFDEF LEVEL4}
                  FieldByName('WideString').Value:='WideString:'+inttostr(i);
{$ENDIF}

                  if chbGenerateMemos.Checked then
                     FieldByName('Memo').AsString:='This is a memo'+#10+DateTimeToStr(Now)+' '+inttostr(i);

                  Post;
             end;

             // Check if not updated indexes, rebuild and reenable updates of the indexes.
             if EnableIndexes=false then
             begin
                  // Rebuild indexes.
                  UpdateIndexes;
                  EnableIndexes:=true;
                  chbEnableIndexes.Checked:=true;
             end;
          finally
             EnableControls;
          end;
     end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
   fmt:TkbmCustomStreamFormat;
begin
     if BinarySave.Checked then
        fmt:=sfBinary
     else
         fmt:=sfCSV;

     with TkbmProtCustomStreamFormat(fmt) do
     begin
          if chbSaveIndexDef.Checked then sfIndexDef:=[sfSaveIndexDef];
          if chbSaveDeltas.Checked then
          begin
               sfDeltas:=[sfSaveDeltas];
               sfDontFilterDeltas:=[sfSaveDontFilterDeltas];
          end;
          if chbNoQuotes.Checked then
          begin
               sfCSV.CSVQuote:=#0;
               sfCSV.CSVRecordDelimiter:=#0;
          end
          else
          begin
               sfCSV.CSVQuote:='"';
               sfCSV.CSVRecordDelimiter:=',';
          end;
     end;

     if BinarySave.Checked then
        kbmMemTable1.SaveToFileViaFormat('c:\test.bin',fmt)
     else
        kbmMemTable1.SaveToFileViaFormat('c:\test.csv',fmt);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
     if chbNoQuotes.Checked then
     begin
          sfCSV.CSVQuote:=#0;
          sfCSV.CSVRecordDelimiter:=#0;
     end
     else
     begin
          sfCSV.CSVQuote:='"';
          sfCSV.CSVRecordDelimiter:=',';
     end;

     if BinarySave.Checked then
        kbmMemTable1.LoadFromFileViaFormat('c:\test.bin',sfBinary)
     else
        kbmMemTable1.LoadFromFileViaFormat('c:\test.csv',sfCSV);
end;

procedure TForm1.MemTable1CalcFields(DataSet: TDataSet);
var
   i:integer;
   s:string;
begin
     if kbmMemTable1.Fields[0].IsNull then
        kbmMemTable1.FieldByName('CALC').AsString:='NULL'
     else
     begin
          i:=kbmMemTable1.Fields[0].AsInteger;
          s:=LongMonthNames[(i mod 12) + 1];
          kbmMemTable1.Fieldbyname('CALC').AsString := kbmMemTable1.Fields[0].AsString + '-' + s;
     end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
     Memo1.Lines.Text:=kbmMemTable1.CommaText;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
     kbmMemTable1.CommaText:=Memo1.Lines.Text;
end;

// Dynamically define a set of fields.
{$DEFINE CALC}
procedure TForm1.Button6Click(Sender: TObject);
begin
     with kbmMemTable1 do
     begin
          Close;