Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  112

•  TDictionary Custom Sort  3 302

•  Fast Watermark Sources  3 051

•  3D Designer  4 805

•  Sik Screen Capture  3 303

•  Patch Maker  3 521

•  Айболит (remote control)  3 620

•  ListBox Drag & Drop  2 980

•  Доска для игры Реверси  81 480

•  Графические эффекты  3 905

•  Рисование по маске  3 216

•  Перетаскивание изображений  2 601

•  Canvas Drawing  2 722

•  Рисование Луны  2 547

•  Поворот изображения  2 154

•  Рисование стержней  2 155

•  Paint on Shape  1 559

•  Генератор кроссвордов  2 217

•  Головоломка Paletto  1 759

•  Теорема Монжа об окружностях  2 203

•  Пазл Numbrix  1 678

•  Заборы и коммивояжеры  2 049

•  Игра HIP  1 273

•  Игра Go (Го)  1 220

•  Симулятор лифта  1 465

•  Программа укладки плитки  1 211

•  Генератор лабиринта  1 537

•  Проверка числового ввода  1 344

•  HEX View  1 484

•  Физический маятник  1 351

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Создавать таблицы такой же структуры



Автор: 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;








Copyright © 2004-2024 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте