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

{$R c:\programs\delphi\MyFile.res} { Это ваш RES-файл }

constPutTheCursorHere_Dude = 1; { произвольное положительное число }

procedurestuff;

begin

screen.cursors[PutTheCursorHere_Dude] := LoadCursor(hInstance, PChar('cursor_1'));

screen.cursor := PutTheCursorHere_Dude;

end;

… вы все делаете правильно. BatchMove не может пересобирать индексы. Тем не менее, следующая процедура все же поможет вам сделать это (создать индексы заново). Задайте ей необходимые параметры (.DBF. Name, исходная и целевая таблица, Source и Target) и попробуйте ее в деле!

procedureForm1.FormCreate(Sender: TObject);

varx: integer;

begin

BatchMove1.Execute;

Source.Open;

Target.Exclusive := True;

Target.Open;

Source.IndexDefs.Update;

forx := 0 toSource.IndexDefs.Count – 1 do

Target.AddIndex(Source.IndexDefs[x].Name, Source.IndexDefs[x].Fields, Source.IndexDefs[x].Options);

Source.Close;

Target.Close;

end;

Nomadicотвечает:

Удобней всего, например, так —

withbmovMyBatchMove do begin

Mode := bmCopy;

RecordCount := 1;

Execute;

R Destination.Delete;

end;

Где bmovMyBatchMove – экземпляр класса TBatchMoveиз VCL.

Неправда Ваша! ;)

Этот загадочный BatchMove имеет одну очень неприятную особенность (по крайней мере при работе с DBF-таблицами и в Delphi 1.0x), как-то:

увеличивает в создаваемых таблицах в полях типа NUMBERколичество значащих цифр после запятой (не помню – возможно, что и до), если там указаны небольшие (около 1-3 цифр) значения :(.

Я эту особенность побороть не сумел, а мириться с ней в условиях нашей конторы (когда приходится бороться за место под солнцем с программистами на Clipper и FoxPro совершенно неприемлемо.

Кроме того, в предложенном выше варианте еще и запись удалять приходится…:)

Решалась же эта проблема следующим способом:

procedureCopyStruct(SrcTable, DestTable: TTable; cpyFields: array of string);

var

i: Integer;

bActive: Boolean;

SrcDatabase, DestDatabase: TDatabase;

iSrcMemSize, iDestMemSize: Integer;

pSrcFldDes: PFldDesc; CrtTableDesc: CRTblDesc;

bNeedAllFields: Boolean;

begin

SrcDatabase := Session.OpenDatabase(SrcTable.DatabaseName);

try

DestDatabase := Session.OpenDatabase(DestTable.DatabaseName);

try

bActive := SrcTable.Active;

SrcTable.FieldDefs.Update;

iSrcMemSize := SrcTable.FieldDefs.Count * SizeOf(FLDDesc);

pSrcFldDes := AllocMem(iSrcMemSize);

ifpSrcFldDes = nil then begin

raiseEOutOfMemory.Create('Не хватает памяти!');

end;

try

SrcTable.Open;

Check(DbiGetFieldDescs(SrcTable.Handle, pSrcFldDes));

SrcTable.Active := bActive;

FillChar(CrtTableDesc, SizeOf(CrtTableDesc), 0);

withCrtTableDesc do begin

StrPcopy(szTblName, DestTable.TableName);

StrPcopy(szTblType, 'DBASE');

if(Length(cpyFields[0] ) = 0) or(cpyFields[0] = '*') then begin

bNeedAllFields := True;

SrcTable.FieldDefs.Update;

iFldCount := SrcTable.FieldDefs.Count;

end else begin

bNeedAllFields := False;

iFldCount := High(cpyFields) + 1;

end;

iDestMemSize := iFldCount * Sizeof(FLDDesc);

CrtTableDesc.pFLDDesc := AllocMem(iDestMemSize);

ifCrtTableDesc.pFLDDesc = nil then begin

raise EOutOfMemory.Create('Не хватает памяти!');

end;

end;

try

ifbNeedAllFields then begin

fori := 0 toCrtTableDesc.iFldCount - 1 do begin

Move(PFieldDescList(pSrcFldDes)^[i], PFieldDescList(CrtTableDesc.pFLDDesc)^[i], SizeOf(FldDesc));

end;

end else begin

fori:=0 toCrtTableDesc.iFldCount-1 do begin

Move(PFieldDescList(pSrcFldDes)^[SrcTable.FieldDefs.Find(cpyFields[i]).FieldNo – 1], PFieldDescList(CrtTableDesc.pFLDDesc)^[i], SizeOf(FldDesc));

end;

end;

Check(DbiCreateTable(DestDatabase.Handle, True, CrtTableDesc));

finally

FreeMem(CrtTableDesc.pFLDDesc, iDestMemSize);

end;

finally

FreeMem(pSrcFldDes, iSrcMemSize);

end;

finally

Session.CloseDatabase(DestDatabase);

end;

finally

Session.CloseDatabase(SrcDatabase);

end;

end;

VSпишет: