Programming: Delphi


Советы программистов (Часть 2)





  1. Часть 1
  2. Часть 3
  3. Часть 4
  1. Создание и использование 256 цветной палитры
  2. Bitmap без формы
  3. Рисование без мерцания
  4. Тень в заданной области
  5. Рисование на панели управления
  6. Надпись под углом
  7. «Прозрачный» текст
  8. Хранение данных в EXE-файле
  9. Проблемы с кириллицей в Database Desktop
  10. Информация о псевдониме BDE
  11. Получение физического пути к таблице
  12. Получение информации о таблице
  13. Создание DBF-файла во время работы приложения
  14. Динамическое создание таблицы и полей во время выполнения программы
  15. Создание индексного файла из приложения
  16. Восстановление записи dBASE
  17. Создание уникального ID для новой записи
  18. Проблема медленного доступа к таблице
  19. Хитрости многопользовательского доступа к базам данных
  20. Создание таблицы Paradox
  21. Замена пароля для таблицы Paradox из приложения
  22. Чтение OLE из BLOB-поля Paradox
  23. Проблемы работы с Paradox в сети
  24. Пакование таблиц Paradox
  25. Поля DBGrid и Memo




Создание и использование 256 цветной палитры

 Пример создания и применения палитры для 256-цветных изображений. Вам нужны API-функции SelectPalette или RealizePalette, в зависимости от того, как вы предполагаете использовать изображение.

procedure TForm1.MakePalette(forBitMap: TBitMap); var pNewPal: PLogPalette; lSize: LongInt; nCntr: Byte; begin lSize := SizeOf(TLogPalette) + SizeOf(TPaletteEntry) * 256; try GetMem(pNewPal, lSize); pNewPal^.palNumEntries := 256; pNewPal^.palVersion := $300; {$R-}{ выключаем контроль допустимого диапазона } { создаем данные палитры... } for nCntr := 0 to 254 do begin pNewPal^.palPalEntry[nCntr].peRed := nCntr + 20; pNewPal^.palPalEntry[nCntr].peGreen := nCntr + 20; pNewPal^.palPalEntry[nCntr].peBlue := nCntr + 20; pNewPal^.palPalEntry[nCntr].peFlags := pc_nocollapse; end; {$R+}{ включаем контроль допустимого диапазона } { удаляем старый hPal; предохраняемся от утечки памяти } DeleteObject(hPal); { создаем новую палитру на основе новых значений } hPal := CreatePalette(pNewPal^); { назначаем новую палитру } forBitMap.Palette := hPal; finally FreeMem(pNewPal, lSize); end; end; [News Group]



Bitmap без формы

 Каким образом загрузить изображение (BMP) и отобразить его на рабочем столе без использования формы? (Отображать необходимо из DLL).

Существует один способ решения поставленной задачи: создать холст TCanvas, получить контекст устройства для рабочего стола и назначить его дескриптору холста. После рисования на холсте ваше творение будет отображено на рабочем столе. Например:

... var DesktopCanvas: TCanvas; begin DesktopCanvas := TCanvas.Create; try DesktopCanvas.Handle := GetDC(0); try DesktopCanvas.MoveTo(0, 0); DesktopCanvas.LineTo(Screen.Width, Screen.Height); finally ReleaseDC(0, DesktopCanvas.Handle); DesktopCanvas.Handle := 0; end; finally DesktopCanvas.Free; end; end; Можно создать TBitmap и загрузить в него файл BMP. Единственная неприятность может произойти, если используется изображение с 256-цветной палитрой при работе в режиме с 256 цветами. Обойти это препятствие можно так: создать форму без границ и заголовка, установить ее высоту и ширину в ноль, поместить на нее компонент TImage и загрузить в него необходимое изображение. VCL создаст для вас нужную палитру.

[News Group]



Рисование без мерцания

 Почему изображение мерцает, если я вызываю метод Repaint или Refresh, а не OnPaint напрямую? Или это просто «вариация на тему»?

Имеются две фазы обновления окна. В первой фазе, при выводе окна, Windows посылает ему сообщение WM_ERASEBKGND, оповещающее о необходимости стирания фона перед процедурой рисования. Затем посылается сообщение WM_PAINT, служащее сигналом для закрашивания «переднего плана».

Тем не менее, вы можете пропустить первую фазу, которая вызывает мерцание, одним из двух способов.

Первый заключается в том, что вы форсируете обновление сами, с помощью вызова функции Windows API InvalidateRect. На входе он получает дескриптор окна, указатель на закрашиваемую область – (передаем nil, если надо отрисовать всю область окна) и третий параметр, сообщающий о необходимости очистки фона. Вот как раз последний параметр и должен содержать значение False, если вы сами будете в методе Paint полностью отрисовывать всю область:

InvalidateRect(Handle, Nil, False); Handle должен быть дескриптором формы или элемента управления.

Второй способ избежать мерцания заключается в использовании функций VCL. Можно указать VCL не стирать фон, добавляя [csOpaque] к значению свойства ControlStyle, как показано ниже:

ControlStyle := ControlStyle + [csOpaque]; Это ограничивает заполнение фона, но процесс «наполнения» области изображением, т. е. процесс рисования, все еще можно наблюдать. В этом случае от эффекта «мигания» можно избавиться, рисуя на TBitmap и выводя его затем на экран командой CopyRect.

[News Group]



Тень в заданной области

 Как быстро наложить тень на заданную область?

Решение
procedure TForm1.DrawShadows(WDepth, HDepth: Integer); var Dst, RgnBox: TRect; hOldDC: HDC; OffScreen, Pattern: TBitmap; Bits: array[0..7] of Word; begin Bits[0] := $0055; Bits[1] := $00aa; Bits[2] := $0055; Bits[3] := $00aa; Bits[4] := $0055; Bits[5] := $00aa; Bits[6] := $0055; Bits[7] := $00aa; hOldDC := Canvas.Handle; Canvas.Handle := GetWindowDC(Form1.Handle); OffsetRgn(ShadeRgn, WDepth, HDepth); GetRgnBox(ShadeRgn, RgnBox); Pattern := TBitmap.Create; Pattern.ReleaseHandle; Pattern.Handle := CreateBitmap(8, 8, 1, 1, @(Bits[0])); Canvas.Brush.Bitmap := Pattern; OffScreen := TBitmap.Create; OffScreen.Width := RgnBox.Right-RgnBox.Left; OffScreen.Height := RgnBox.Bottom-RgnBox.Top; Dst := Rect(0, 0, OffScreen.Width, OffScreen.Height); OffsetRgn(ShadeRgn, 0, -RgnBox.Top); FillRgn(OffScreen.Canvas.Handle, ShadeRgn, Canvas.Brush.Handle); OffsetRgn(ShadeRgn, 0, RgnBox.Top); // BitBlt работает быстрее CopyRect BitBlt(OffScreen.Canvas.Handle, 0, 0, OffScreen.Width, OffScreen.Height, Canvas.Handle, RgnBox.Left, RgnBox.Top, SRCAND); Canvas.Brush.Color := clBlack; FillRgn(Canvas.Handle, ShadeRgn, Canvas.Brush.Handle); BitBlt(Canvas.Handle, RgnBox.Left, RgnBox.Top, OffScreen.Width, OffScreen.Height, OffScreen.Canvas.Handle, 0, 0, SRCPAINT); OffScreen.Free; Pattern.Free; OffsetRgn(ShadeRgn, -WDepth, -HDepth); ReleaseDC(Form1.Handle, Canvas.Handle); Canvas.Handle := hOldDC; end; Функция рисует сложную тень на форме Form1. Для определения формы тени используется регион ShadeRgn, который был создан где-то раньше.



Рисование на панели управления

 Как рисовать на панели управления, например на TPanel?

У всех компонентов, порожденных от TCustomControl, имеется свойство Canvas типа TCanvas.

Если свойство Canvas недоступно, то им можно воспользоваться, создав потомка и осуществив перенос этого свойства в раздел Public.

type TcPanel = class(TPanel) public property Canvas; end;



Надпись под углом

 Как вывести на Canvas надпись, расположенную под углом?

procedure MyRotateText(CV: TCanvas; sText: String; X, Y, Angle: Integer); var LogFont: TLogFont; begin GetObject(CV.Font.Handle, SizeOf(TLogFont), @LogFont); LogFont.lfEscapement := Angle * 10; CV.Font.Handle := CreateFontIndirect(LogFont); CV.TextOut(X, Y, sText); end;



«Прозрачный» текст

 Предлагаемый модуль реализует алгоритм «затухания» текста на холсте и обратного эффекта.

function TFadeEffect.FadeInText(Target: TCanvas; X, Y: integer; FText: String): TRect; var Pic: TBitmap; W, H: integer; PicRect, TarRect: TRect; begin Pic := TBitmap.Create; Pic.Canvas.Font := Target.Font; W := Pic.Canvas.TextWidth(FText); H := Pic.Canvas.TextHeight(FText); Pic.Width := W; Pic.Height := H; PicRect := Rect(0, 0, W, H); TarRect := Rect(X, Y, X + W, Y + H); Pic.Canvas.CopyRect(PicRect, Target, TarRect); SetBkMode(Pic.Canvas.Handle, Transparent); Pic.Canvas.TextOut(0, 0, FText); FadeInto(Target, X, Y, Pic); Pic.Free; FadeInText := TarRect; end; procedure TFadeEffect.FadeOutText(Target: TCanvas; TarRect: TRect; Orig: TBitmap); var Pic: TBitmap; PicRect: TRect; begin Pic := TBitmap.Create; Pic.Width := TarRect.Right - TarRect.Left; Pic.Height := TarRect.Bottom - TarRect.Top; PicRect := Rect(0, 0, Pic.Width, Pic.Height); Pic.Canvas.CopyRect(PicRect, Orig.Canvas, TarRect); FadeInto(Target, TarRect.Left, TarRect.Top, Pic); Pic.Free; end;



Хранение данных в EXE-файле

 Можно включить любой тип данных как RCDATA или пользовательский тип ресурса. Это очень просто. Данный совет поясняет общую технику создания такого ресурса.

type TStrItem = String[39]; { 39 символов + байт длины -> 40 байт } TDataArray = array [0..7, 0..24] of TStrItem; const Data: TDataArray = ( (' ', ' ', ... ' '), { 25 строк } { всего 8 таких строк } (' ', ' ', ... ' '); { 25 строк } Данные размещаются в вашем сегменте данных и занимают в нем 8 Kбайт. Если этого слишком много для вашего приложения – поместите реальные данные в ресурс RCDATA. Следующие шаги демонстрируют данный подход. Создайте небольшую безоконную программку, объявляющую типизированную константу, как показано выше, и запишите результат в файл на локальный диск:

program MakeData; type TStrItem = String[39]; { 39 символов + байт длины -> 40 байтов } TDataArray = array [0..7, 0..24] of TStrItem; const Data: TDataArray = ( (' ', ' ', ... ' '), { 25 строк } { всего 8 таких строк } (' ', ' ', ... ' ')); { 25 строк } var F: File of TDataArray; begin Assign(F, 'data.dat'); Rewrite(F); Write(F, Data); Close(F); end. Теперь подготовьте файл ресурса и назовите его DATA.RC. Он должен содержать только следующую строчку:

DATAARRAY RCDATA "data.dat" Сохраните файл, откройте сессию DOS, перейдите в каталог, где вы сохранили data.rc (там же, где и data.dat) и выполните следующую команду:

brcc data.rc (brcc32 для Delphi 2.0 и выше) Теперь можно подключить файл DATA.RES к своему Delphi-проекту. Во время выполнения приложения можно сгенерировать указатель на данные этого ресурса и получить к ним доступ, что и требовалось.

type TStrItem = String[39]; { 39 символов + байт длины -> 40 байт } TDataArray = array [0..7, 0..24] of TStrItem; PDataArray = ^TDataArray; const pData: PDataArray = Nil; { в Delphi 2.0 используем Var } implementation {$R DATA.RES} Procedure LoadDataResource; var dHandle: THandle; begin { pData := Nil; если pData - Var } dHandle := FindResource(hInstance, 'DATAARRAY', RT_RCDATA); if dHandle <> 0 then begin dHandle := LoadResource(hInstance, dHandle); if dHandle <> 0 then pData := LockResource(dHandle); end; if pData = Nil then { неудача, получаем сообщение об ошибке с помощью WinProcs.MessageBox, без помощи VCL, поскольку здесь код выполняется как часть инициализации программы, и VCL, возможно, еще не инициализирована! } end; initialization LoadDataResource; end. [News Group]



Проблемы с кириллицей в Database Desktop

 Database Desktop отображает содержимое таблиц шрифтом без русских букв. В чем проблема?

Для DBD 5.0 в файле C:\Windows\PDOXWIN.INI вставить в секцию:

[Properties] SystemFont=Arial Cyr Для DBD 7.0 нужно исправить значение ключа реестра

HKEY_CURRENT_USER\Software\Borland\DBD\7.0\Preferences\Properties\ SystemFont = "Fixedsys" Если такой ключ не существует, его следует создать.

В Windows NT нужно изменить:

[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Nls\CodePage] "1252"="c_1251.nls" Примечание
Помогает также такой метод. В файле win.ini в конце раздела [FontSubstitutes] пишем: Arial=Arial Cyr. Перегружаем компьютер, т. к. изменения вступят в силу только после обработки этого файла на этапе загрузки.



Информация о псевдониме BDE

 Как получить информацию о псевдониме BDE?

Решение 1
procedure TForm1.Button1Click(Sender: TObject); { Получаем из BDE путь MyAlias } const AliasName = 'MyAlias'; var MyAliasPath: string; ParamsList: TStringList; begin ParamsList := TStringList.Create; try with Session do begin Session.GetAliasNames(ParamsList); Session.GetAliasParams(AliasName,ParamsList); MyAliasPath := Copy(ParamsList[0], 6, 50) + '\'; end; finally ParamsList.Free; end; Label1.Caption := MyAliasPath; end; Примечание
Для работы данного примера бросьте на форму компоненты Label, Button. В обработчике события OnClick кнопки наберите код. Вместо MyAlias напишите любой реальный псевдоним (alias).

Решение 2
uses DbiProcs, DBiTypes; { Возвращает каталог базы данных для псевдонима (без обратного слеша) } function GetDataBaseDir(const Alias: string): String; var sp: PChar; Res: pDBDesc; begin try New(Res); sp := StrAlloc(length(Alias) + 1); StrPCopy(sp, Alias); if DbiGetDatabaseDesc(sp, Res) = 0 then Result := StrPas(Res^.szPhyName) else Result := ''; finally StrDispose(sp); Dispose(Res); end; end; Примечание
Для работоспособности этого кода надо иметь активную таблицу в приложении с тем же псевдонимом, что и Alias. Этот код несколько избыточен, поэтому предлагается вариант из Help:

uses DBiTypes; function GetDataBaseDir(const Alias: string): String; var R: DBDesc; begin Check(DbiGetDatabaseDesc(PChar(Alias), @R)); Result := R.szPhyName; end; procedure TForm1.Button1Click(Sender: TObject); begin Label1.Caption := GetDataBaseDir('Alias'); end;



Получение физического пути к таблице

 Как получить физический путь к таблице?

Если ссылка на таблицу получена через псевдоним, то физический путь к ней выяснить не так просто. Для этого необходимо применить функцию BDE DbiGetDatabaseDesc. Данной функции в качестве параметров передаются имя псевдонима и указатель на структуру DBDesc. Структура DBDesc будет заполнена информацией, относящейся к этому псевдониму. Определение структуры:

pDBDesc = ^DBDesc; DBDesc = packed record { Описание данной базы данных } szName: DBINAME; { Логическое имя (или псевдоним) } szText: DBINAME; { Описательный текст } szPhyName: DBIPATH; { Физическое имя/путь } szDbType: DBINAME; { Тип базы данных } end; Физическое имя/путь будет содержаться в поле szPhyName структуры DBDesc.

Возможные значения, возвращаемые функцией DBIGetDatbaseDesc:

DBIERR_NONE – описание базы данных для pszName было успешно извлечено. DBIERR_OBJNOTFOUND – база данных, указанная в pszName, не была обнаружена. Приведенный ниже пример кода демонстрирует получение физического пути для компонента TTable, использующего псевдоним DBDemos:

var vDBDesc: DBDesc; DirTable: String; begin Check(DbiGetDatabaseDesc(PChar(Table1.DatabaseName), @vDBDesc)); DirTable := Format('%s\%s', [vDBDesc.szPhyName, Table1.TableName]); ShowMessage(DirTable); end;



Получение информации о таблице

 Как получить информацию о таблице?

Нужно воспользоваться свойством FieldDefs. В следующем примере список полей и их размеры передаются компоненту TMemo (расположенному на форме) с именем Memo1:

procedure TForm1.ShowFields; var i: Word; begin Memo1.Lines.Clear; Table1.FieldDefs.Update; { должно быть вызвано, если Table1 не активна } for i := 0 to Table1.FieldDefs.Count - 1 do with Table1.FieldDefs.Items[i] do Memo1.Lines.Add(Name + ' - ' + IntToStr(Size)); end; Если просто нужны имена полей (FieldNames), то обратитесь к методам TTable – GetFieldNames, GetIndexNames для получения имен индексов:

var FldNames, IdxNames: TStringList begin FldNames := TStringList.Create; IdxNames := TStringList.Create; if Table1.State = dsInactive then Table1.Open; Table1.GetFieldNames(FldNames); Table1.GetIndexNames(IdxNames); FldNames.Free; {освобождаем stringlist} IdxNames.Free; end; Для получения информации об определенном поле следует обратиться к FieldDef.



Создание DBF-файла во время работы приложения

 Как создать таблицу из работающего приложения?

Простейший способ – использовать запрос SQL. Таблицы можно создавать с индексом и без индекса.

Небольшой пример:

... const CreateTab = 'CREATE TABLE '; IDXTab = 'PRIMARY KEY '; MyTabStruct = 'IDX_TAB DECIMAL(6,0), ' + 'DATE_ DATE, ' + 'FLD_1 CHARACTER(20), ' + 'FLD_2 DECIMAL(7, 2), ' + 'FLD_3 BOOLEAN, ' + 'FLD_4 BLOB(1, 1), ' + 'FLD_5 BLOB(1, 2), ' + 'FLD_6 BLOB(1, 3), ' + 'FLD_7 BLOB(1, 4), ' + 'FLD_8 BLOB(1, 5) '; ... function TForm1.CreateTable(TabName, TabStruct, TabIDX: string): boolean; var qyTable: TQuery; begin result := true; qyTable := TQuery.Create(Self); with qyTable do try try SQL.Clear; SQL.Add(CreateTab + TabName + '(' + TabStruct + TabIDX + ')'); Prepare; ExecSQL; // ExecSQL, а не Open. Иначе ... except // Обработка ошибок открытия таблицы Exception.Create('Ошибка открытия таблицы'); result := false; end; finally Close; end; end; // создание таблицы без индекса procedure TForm1.Button1Click(Sender: TObject); begin if CreateTable('"MYTAB1.DBF"', MyTabStruct, '') then ... // выполняем дальнейшие операции else ... end; // создание таблицы с индексом procedure TForm1.Button2Click(Sender: TObject); begin if CreateTable('"MYTAB2.DBF"', MyTabStruct, IDXTab + ' (IDX_TAB)') then ... // выполняем дальнейшие операции else ... end; [VS]



Динамическое создание таблицы и полей во время выполнения программы

 Delphi в режиме разработки позволяет быстро добавлять и настраивать в проекте компоненты для работы с базами данных, но бывают ситуации, когда нужно создавать и конфигурировать объекты во время выполнения программы. Например, во время выполнения программы может понадобиться добавить колонку с вычисляемым полем (с помощью алгоритмов пользователя). Поэтому вопрос: как, не прибегая к возможностям среды разработки, Инспектора Объектов и редактора TFields, создавать и конфигурировать TField и другие компоненты для связки данных?

В следующем примере показано динамическое создание TTable, таблицы базы данных в связке с TTable, TFieldDefs, TFields, вычисляемых полей и подключение обработчика для события OnCalc.

Для начала выберите пункт New Application меню File. Будет создан новый проект с пустой формой, на которой мы и будет создавать на лету наши компоненты.

В секцию interface модуля формы добавьте, как показано ниже, объявление обработчика события OnCalcFields и поля TaxAmount. Позже создадим TTable и назначим этот обработчик событию TTable OnCalcFields, который позволит при чтении каждой записи вызывать событие OnCalcFields, которое, в свою очередь, выполнит нашу процедуру TaxAmountCalc.

type TForm1 = class(TForm) procedure TaxAmountCalc(DataSet: TDataset); private TaxAmount: TFloatField; end; В секции implementation создайте обработчик события OnCalc, как показано ниже:

procedure TForm1.TaxAmountCalc(DataSet: TDataset); begin Dataset['TaxAmount'] := Dataset['ItemsTotal'] * (Dataset['TaxRate'] / 100); end; Создайте обработчик формы OnCreate, как показано ниже (для получения дополнительной информации о создании обработчиков событий обратитесь к руководству «Delphi Users Guide», Chapter 4 «Working With Code»).

procedure TForm1.FormCreate(Sender: TObject); var MyTable: TTable; MyDataSource: TDataSource; MyGrid: TDBGrid; begin { Создаем компонент TTable – связанная таблица базы данных будет создана ниже. } MyTable := TTable.Create(Self); with MyTable do begin { Определяем основную базу данных и таблицу. Примечание: Test.DB пока не существует. } DatabaseName := 'DBDemos'; TableName := 'Test.DB'; { Назначаем TaxAmountCalc обработчиком события, чтобы использовать его при наступлении события OnCalcFields в MyTable. } OnCalcFields := TaxAmountCalc; { Создаем и добавляем определения полей к массиву TTable FieldDefs, затем создаем TField на основе информации из определения поля. } with FieldDefs 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%'; { Создаем вычисляемое TField, назначаем свойства, и добавляем поле к массиву определений MyTable. } TaxAmount := TFloatField.Create(MyTable); with TaxAmount do begin FieldName := 'TaxAmount'; Calculated := True; Currency := True; DataSet := MyTable; Name := MyTable.Name + FieldName; MyTable.FieldDefs.Add(Name, ftFloat, 0, false); end; end; { Создаем в базе данных новую таблицу, используя в качестве основы MyTable. } MyTable.CreateTable; end; { Создаем компонент TDataSource и назначаем его MyTable. } MyDataSource := TDataSource.Create(Self); MyDataSource.DataSet := MyTable; { Создаем табличную сетку, отображаем на форме и назначаем MyDataSource для получения доступа к данным из MyTable. } MyGrid := TDBGrid.Create(Self); with MyGrid do begin Parent := Self; Align := alClient; DataSource := MyDataSource; end; { Запускаем нашу конструкцию! } MyTable.Active := True; Caption := 'Новая таблица ' + MyTable.TableName; end; Ниже приведен полный исходный код проекта:

unit gridcalc; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids, ExtCtrls, DBCtrls, DB, DBTables, StdCtrls; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure TaxAmountCalc(DataSet: TDataset); private TaxAmount: TFloatField; end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.TaxAmountCalc(DataSet: TDataset); begin Dataset['TaxAmount'] := Dataset['ItemsTotal'] * (Dataset['TaxRate'] / 100); end; procedure TForm1.FormCreate(Sender: TObject); var MyTable: TTable; MyDataSource: TDataSource; MyGrid: TDBGrid; begin MyTable := TTable.Create(Self); with MyTable do begin DatabaseName := 'DBDemos'; TableName := 'Test.DB'; OnCalcFields := TaxAmountCalc; with FieldDefs 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); with TaxAmount 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); with MyGrid do begin Parent := Self; Align := alClient; DataSource := MyDataSource; end; MyTable.Active := True; Caption := 'Новая таблица ' + MyTable.TableName; end; end.



Создание индексного файла из приложения

 Как создать индексный файл из приложения?

В таблицах dBASE или Paradox для создания нового индекса воспользуйтесь методом AddIndex. Для примера:

Table1.AddIndex('Articles', 'Title', []); создаст индексный файл с именем «Articles», при этом поле TITLE выступает в качестве индексного ключа. При создании можно задавать различные индексные опции (например, указать, что файл уникальный, необслуживаемый и т. д.) – для получения дополнительной информации обратитесь к электронной справке по Delphi.

Примечание
Таблица должна быть открыта исключительно для того, чтобы воспользоваться методом AddIndex.

Поддержка и обновление индексного файла, если только при создании не установлен флаг «необслуживаемый», происходит автоматически.



Восстановление записи dBASE

 Можно ли восстановить запись из таблицы dBASE после ее удаления? Нельзя ли дать пример использования функции?

Предположим, на форме имеется кнопка (с именем «butRecall»), восстанавливающая текущую отображаемую (или позиционируемую курсором) запись. Данный код, будучи расположенным в обработчике события кнопки OnClick, это демонстрирует:

function GetTableCursor(oTable: TTable): hDBICur; var szTable: Array [0..78] of Char; begin StrPCopy(szTable, oTable.TableName); DbiGetCursorForTable(oTable.DBHandle, szTable, nil, Result); end; function dbRecall(oTable: TTable): DBIResult; begin Result := DbiUndeleteRecord(GetTableCursor(oTable)); end; procedure TForm1.butRecallClick(Sender: TObject); begin if dbRecall(Table1) <> DBIERR_NONE then ShowMessage('Не могу восстановить запись!'); end;



Создание уникального ID для новой записи

 Как создать уникальный индекс для поля?

Существует несколько способов задавать в таблице уникальный ID.

  1. Можно использовать автоинкрементное поле. Этот метод не очень надежен. Если таблица каким-то образом испортится и понадобится ее пересобрать, автоинкрементные поля будут перенумерованы. Хотя это легкий способ для ситуации, когда нет ссылки на ID в других таблицах, но это не очень мудрое решение в других случаях.

  2. Можно использовать ID-таблицу. Если имеется приложение, где нескольким таблицам необходимы уникальные ID, создайте ID-таблицу (IDTable) с двумя полями: Name (первичный ключ) и Last_Id. В методе BeforePost таблицы, которой необходим уникальный ID, сделайте так: procedure TForm1.Table1BeforePost(DataSet: TDataSet); var Id: Integer; begin { проверяем, существует ли ID для этой записи } if Table1.Fields[0].AsInteger = 0 then begin { ищем имя таблицы в ID Таблице } IDTable.FindKey([Name]); { извлекаем последний ID - подразумеваем блокировку записи } Id := IDTable.FieldByName('Last Id').AsInteger; Inc(Id); { записываем новый ID в ID-таблицу - подразумеваем разблокировку таблицы } IDTable.FieldByName('Last Id').AsInteger := Id; IDTable.Post; { записываем извлеченный ID в вашу таблицу } Table1.Fields[0].AsInteger := Id; end; end; Поместив этот код в обработчик события BeforePost, можно убедиться, что все ID будут последовательными. Недостаток: если пользователь во время попытки добавления новой записи вдруг передумает, то получится запись только с заполненным полем ID.

    Для того чтобы воспользоваться данным способом (последовательные ID), поместите приведенный выше код в обработчик события таблицы OnNewRecord.

  3. Можете использовать ID-файл.
Руководствуйтесь теми же принципами, что и в предыдущем способе, но вместо ID-таблицы создается ID-файл. Это дает преимущество за счет более высокой скорости работы, но в многопользовательской среде нужно заботиться о блокировке записей.



Проблема медленного доступа к таблице

 У меня очень медленный доступ к таблице при первом обращении. Как решить эту проблему?

Данная проблема возникает из-за того, что BDE вначале запрашивает базу данных для получения информации о таблице, прежде чем он начнет с ней работать. Как только появляется информация о таблице, она кэшируется и обращения к таблице во время всего сеанса (пока TDatabase.Connection имеет значение True) происходят практически мгновенно. Для того чтобы использовать кэшируемую информацию и при последующем запуске приложения, в конфигурации BDE найдите необходимый псевдоним и установите SHEMA CACHE = TRUE и SHEMA CACHE DIR = 'C:\TEMP' или любой другой удобный каталог.

Примечание
При любом изменении структуры таблицы придется удалять кэш вручную. Имя файла, в котором хранится кэш, можно узнать, посмотрев в любом текстовом редакторе файл SCache.INI.

Есть еще параметр SHEMA CACHE TIME, значение которого устанавливает периодичность обновления информации о структуре БД.



Хитрости многопользовательского доступа к базам данных

 Некоторые хитрости, знание которых может быть полезным в разработке баз многопользовательского доступа:

В модуле DBIPROCS Delphi 1.0 и в BDE.INT Delphi 2.0 существует функция с именем DBISetLockRetry(n).

Синтаксис – DBISetLockRetry(n), где n – продолжительность ожидания перед повторной попыткой вставки (в секундах), редактирования или другой операцией с таблицей. DBISetLockRetry(-1) будет бесконечно пытаться получить доступ к вашей таблице.

Хорошее место для вызова функции – обработчик события TableAfterOpen. В этом случае все, что нужно сделать, это:

DBISetLockRetry(x); Работая с Delphi 1.0, не забудьте включить в вашу программу DBIProcs. В Delphi 2.0 включите BDE.

Эти требования обязательны при разработке многопользовательских приложений Delphi, работающих с файлами dBASE или Paradox.





Создание таблицы Paradox

 Как создать таблицу Paradox из приложения?

Пример:

procedure TForm1.Button1Click(Sender: TObject); begin with TTable.Create(Self) do begin DatabaseName := 'c:\windows\temp'; TableName := 'FOO'; TableType := ttParadox; with FieldDefs do begin Add('Age', ftInteger, 0, True); Add('Name', ftString, 25, False); Add('Weight', ftFloat, 0, False); end; IndexDefs.Add('MainIndex', 'Age', [ixPrimary, ixUnique]); CreateTable; end; end;



Замена пароля для таблицы Paradox из приложения

 Как сменить пароль (master password) для таблицы Paradox?

Пример:

var db: TDatabase; Desc: CRTblDesc; begin db := Table1.OpenDatabase; FillChar(Desc, SizeOf(Desc), #0); StrCopy(Desc.szTblName, PChar(Table1.TableName)); StrCopy(Desc.szTblType, szParadox); StrCopy(Desc.szPassword, 'password'); Desc.bProtected := TRUE; Check(DbiDoRestructure(db.Handle, 1, @Desc, nil, nil, nil, FALSE)); end;



Чтение OLE из BLOB-поля Paradox

 Говорят, что выполнить чтение OLE из BLOB-поля Paradox невозможно. Как поступать в данном случае?

Предлагаемое решение:

procedure TForm1.Button1Click(Sender: TObject); var b: TBlobStream; begin try b := TBlobStream.Create((Table1.FieldByName('OLE') as TBlobField), bmRead); OLEContainer1.LoadFromStream(b); finally b.free; end; end; procedure TForm1.Button2Click(Sender: TObject); var b: TBlobStream; begin try Table1.Insert; b := TBlobstream.Create((Table1.FieldByName('OLE') as TBlobField), bmReadWrite); OLEContainer1.SaveToStream(b); Table1.Post; finally b.free; end; end; Примечание
Предварительно на форму помещаем OleContainer со страницы SYSTEM палитры компонентов.



Проблемы работы с Paradox в сети

 Я получаю ошибку приложения «... not initialized for accessing network files» (не инициализировано для доступа к сетевым файлам).

Программа Borland BDE Install не включает в себя автоматически драйвер для работы в сети для таблиц Paradox, если целевой компьютер подключен к сети. Пользователь получит сообщение об ошибке, если путь никем не установлен. Программы третьих фирм, устанавливающие BDE, поступают точно так же. Настройка сетевого каталога возможна программным путем из самой программы или с помощью пользователя и утилиты BDEconfig (BDE Administrator).

При запуске приложения разверните предусмотренную Borland библиотеку NETDIR.DLL (58 Kбайт), загруженную из форума PdoxWin, получите доступ к IDAPI.CFG и считайте значение сетевого каталога. Следующий код проверяет, был ли установлен сетевой каталог, и, если не был, то он временно устанавливается для текущего сеанса пользователя.

{ объявляем DLL-функцию } function getCFGNetDir: pChar; far; external 'netdir' index 4; { проверяем и при необходимости восстанавливаем сетевой каталог } procedure TForm1.FormCreate(Sender: TObject); var theNetDir: PChar; theChar: Char; begin theChar := ':'; theNetDir := getCFGNetDir; if (StrScan(theNetDir, theChar) = nil) then Session.NetFileDir := 'C:\'; end;



Пакование таблиц Paradox

 Можно ли перестраивать и паковать таблицы Paradox из программ, написанных на Delphi?

Проверьте работу приведенной ниже функции, она пакует таблицы Paradox и dBase (требуется компонент TDatabase, указывающий на ту же директорию, где хранятся таблицы):

uses BDE; function PackTable(tbl:TTable; db:TDatabase): DBIResult; var crtd: CRTblDesc; begin Result := DBIERR_NA; with tbl do if Active then Active := False; with db do if not Connected then Connected := True; FillChar(crtd,SizeOf(CRTblDesc), 0); StrPCopy(crtd.szTblName, tbl.TableName); crtd.bPack := True; Result := DbiDoRestructure(db.Handle, 1, @crtd, nil, nil, nil, FALSE); end; Пример использования:

procedure TForm1.Button1Click(Sender: TObject); begin if PackTable(Table1, DataBase1) = DBIERR_NONE then ... else MessageBeep(0); end;



Поля DBGrid и Memo

 Как из Memo-поля выбрать данные для DBGrid?

В обработчик события GetText TMemoField поместите следующую строку:

Text := GrabMemoAsString(TMemoField(Sender)); и поместите следующую функцию так, чтобы к ней можно было свободно обратиться:

function GrabMemoAsString(TheField: TMemoField): String; begin if TheField.IsNull then Result := '' else with TBlobStream.Create(TheField, bmRead) do begin if Size >= 255 then begin SetLength(Result, 255); Read(Result, 255); end else begin SetLength(Result, Size); Read(Result, Size); end; Free; while Pos(#10, Result) > 0 do Result[Pos(#10, Result)] := ' '; while Pos(#13, Result) > 0 do Result[Pos(#13, Result)] := ' '; end; end;


Часть 3


При перепечатке любого материала с сайта, видимая ссылка на источник www.warayg.narod.ru и все имена, ссылки авторов обязательны.

© 2005