Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Создавать таблицы такой же структуры

Автор: Nomadic

В 1995 годy на компьютеpной выставке CeBIT в Ганновеpе во вpемя доклада Билла Гейтса в зале поднимали плакат "Alt+F4".

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


with bmovMyBatchMove do
begin
  Mode := bmCopy;
  RecordCount := 1;
  Execute;R Destination.Delete;
end;

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

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

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

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

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

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

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


procedure CopyStruct(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);
      if pSrcFldDes = nil then
      begin
        raise EOutOfMemory.Create('Не хватает памяти!');
      end;
      try
        SrcTable.Open;
        Check(DbiGetFieldDescs(SrcTable.Handle, pSrcFldDes));
        SrcTable.Active := bActive;
        FillChar(CrtTableDesc, SizeOf(CrtTableDesc), 0);
        with CrtTableDesc 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);
          if CrtTableDesc.pFLDDesc = nil then
          begin
            raise EOutOfMemory.Create('Не хватает памяти!');
          end;
        end;
        try
          if bNeedAllFields then
          begin
            for i := 0 to CrtTableDesc.iFldCount - 1 do
            begin
              Move(PFieldDescList(pSrcFldDes)^[i],
                PFieldDescList(CrtTableDesc.pFLDDesc)^[i], SizeOf(FldDesc));
            end;
          end
          else
          begin
            for i := 0 to CrtTableDesc.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;

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.