Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

procedureTaxAmountCalc(DataSet: TDataset);

private

TaxAmount: TFloatField;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedureTForm1.TaxAmountCalc(DataSet: TDataset);

begin

Dataset['TaxAmount'] := Dataset['ItemsTotal'] *(Dataset['TaxRate'] / 100);

end;

procedureTForm1.FormCreate(Sender: TObject);

var

MyTable: TTable;

MyDataSource: TDataSource;

MyGrid: TDBGrid;

begin

MyTable := TTable.Create(Self);

withMyTable do

begin

DatabaseName := 'DBDemos';

TableName := 'Test.DB';

OnCalcFields := TaxAmountCalc;

withFieldDefs do

begin

Add('ItemsTotal', ftCurrency, 0, false);

FieldDefs[0].CreateField(MyTable);

Add('TaxRate', ftFloat, 0, false);

FieldDefs[1].CreateField(MyTable);

TFloatField(Fields[1]).DisplayFormat := '##.0%';

TaxAmount := TFloatField.Create(MyTable);

withTaxAmount do

begin

FieldName := 'TaxAmount';

Calculated := True;

Currency := True;

DataSet := MyTable;

Name := MyTable.Name + FieldName;

MyTable.FieldDefs.Add(Name, ftFloat, 0, false);

end;

end;

MyTable.CreateTable;

end;

MyDataSource := TDataSource.Create(Self);

MyDataSource.DataSet := MyTable;

MyGrid := TDBGrid.Create(Self);

withMyGrid do

begin

Parent := Self;

Align := alClient;

DataSource := MyDataSource;

end;

MyTable.Active := True;

Caption := 'Новая таблица ' + MyTable.TableName;

end;

end.

Я использую таблицу paradox на своей локальной машине.

Я использую следующие команды:

Table.DatabaseName := 'ABC';

Table.TableName := 'TEST';

Table.CreateTable;

Table.AddIndex('Primary','ID',[ixPrimary]); (работает как часы)

Table.AddIndex('Number_IDX','NUMBER',[ixUnique]); (здесь я получаю ошибку времени выполнения)

ID – LongInt поле

NUMBER – поле типа char[15]

Nomadicотвечает:

Вот такая конструкция проходит на DB2 2.1.2/NT и UDB5/NT…

CREATE DATABASE Efes2

USING CODESET 1251 TERRITORY RU

COLLATE USING IDENTITY;

Вот пример InMemoryTable. Свободен для использования, модификации и всего остального. Ну и как в отношении других вещей: я не даю никаких гарантий. Я не несу никакой ответственности за ущерб, который может причинить код. Позвольте, я повторю это:

ВНИМАНИЕ! ДАННЫЙ КОД НЕ ПРЕДУСМАТРИВАЕТ НИКАКИХ ГАРАНТИЙ!

ИСПОЛЬЗУЙТЕ ЕГО НА СВОЙ СТРАХ И РИСК - ВЫ ЕДИНСТВЕННЫЙ ЧЕЛОВЕК, ОТВЕТСТВЕННЫЙ ЗА ЛЮБОЙ УЩЕРБ, КОТОРЫЙ МОЖЕТ ПОВЛЕЧЬ ЗА СОБОЙ ИСПОЛЬЗОВАНИЕ ДАННОГО КОДА — Я ВАС ПРЕДУПРЕДИЛ!

Благодарю Steve Garland <72700.2407@compuserve.com> за предоставленную помощь. Он создал свой собственный "in-memory" табличный компонент, который послужил мне толчком для написания сего кода.

InMemory-таблицы являются характеристикой Borland Database Engine (BDE). InMemory-таблицы создаются в RAM и удаляются при их закрытии. Работают они значительно быстрее и очень полезны в случае, если вам нужны быстрые операции в небольших таблицах. Данный пример использует вызов функции BDE DbiCreateInMemoryTable. Данный объект должен работать наподобии простой регулярной таблицы, за исключением того, что InMemory-таблицы не поддерживают некоторые характеристики (типа проверка целостности, вторичные индексы и BLOB-поля), и в настоящее время данный код не содержит механизма обработки ошибок. Вероятно, вы получите ошибку при попытке создания memo-поля. Если у вас есть любые замечания, шлите их по адресу grisha@mira.com.

unitInmem;

interface

usesDBTables, WinTypes, WinProcs, DBITypes, DBIProcs, DB, SysUtils;

typeTInMemoryTable = class(TTable)

private

hCursor: hDBICur;

procedureEncodeFieldDesc( varFieldDesc: FLDDesc; constName: string; DataType: TFieldType; Size: Word);

functionCreateHandle: HDBICur; override;

public

procedureCreateTable;

end;

implementation

{ Эта функция виртуальная, так что я смог перекрыть ее. В оригинальном VCL-коде для TTable эта функция реально открывает таблицу, но, поскольку мы уже имеем дескриптор таблицы, то мы просто возвращаем его }

functionTInMemoryTable.CreateHandle;

begin

Result := hCursor;

end;

{ Эта функция получена ее простым копированием из исходного кода VCL. Я должен был это сделать, поскольку это было объявлено в секции private компонента TTable, поэтому отсюда у меня не было к этому досупа. }

procedureTInMemoryTable.EncodeFieldDesc( varFieldDesc: FLDDesc; constName: string; DataType: TFieldType; Size: Word);

const

TypeMap: array[TFieldType] ofByte = (fldUNKNOWN, fldZSTRING, fldINT16, fldINT32, fldUINT16, fldBOOL,fldFLOAT, fldFLOAT, fldBCD, fldDATE, fldTIME, fldTIMESTAMP, fldBYTES,fldVARBYTES, fldBLOB, fldBLOB, fldBLOB);

begin

with FieldDesc do

begin

AnsiToNative(Locale, Name, szName, SizeOf(szName) - 1);

iFldType := TypeMap[DataType];

caseDataType of

ftString, ftBytes, ftVarBytes, ftBlob, ftMemo, ftGraphic:

iUnits1 := Size;

ftBCD:

begin

iUnits1 := 32;

iUnits2 := Size;

end;

end;

caseDataType of

ftCurrency: iSubType := fldstMONEY;

ftBlob: iSubType := fldstBINARY;

ftMemo: iSubType := fldstMEMO;

ftGraphic: iSubType := fldstGRAPHIC;

end;

end;

end;

{ Вот кухня, где все это происходит. Я скопировал эту функцию из исходников VCL и затем изменил ее для использования DbiCreateInMemoryTable вместо DbiCreateTable. Поскольку InMemory-таблицы не поддерживают индексы, я удалил весь соответствующий код. }

procedureTInMemoryTable.CreateTable;

var

I: Integer;

pFieldDesc: pFLDDesc;

szTblName: DBITBLNAME;

iFields: Word;

Dogs: pfldDesc;

begin

CheckInactive;

ifFieldDefs.Count = 0 then forI := 0 toFieldCount - 1 do withFields[I] do if notCalculated thenFieldDefs.Add(FieldName, DataType, Size, Required);

pFieldDesc := nil;

SetDBFlag(dbfTable, True);

try

AnsiToNative(Locale, TableName, szTblName, SizeOf(szTblName) - 1);

iFields := FieldDefs.Count;

pFieldDesc := AllocMem(iFields * SizeOf(FLDDesc));

forI := 0 toFieldDefs.Count - 1 do withFieldDefs[I] do

begin

EncodeFieldDesc(PFieldDescList(pFieldDesc)^[I], Name,DataType, Size);

end;

{ тип драйвера nil, т.к. поля логические }

Check(DbiTranslateRecordStructure( nil, iFields, pFieldDesc, nil, nil, pFieldDesc));

{ здесь hCursor получает свое значение }

Check(DbiCreateInMemTable(DBHandle, szTblName, iFields, pFieldDesc, hCursor));