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

{ MAINDB.DPR }

programmaindb;

usesForms, mainform in'mainform.pas' {dbmainform};

{$R *.RES}

begin

Application.Initialize;

Application.CreateForm(TDBMainForm, DBMainForm);

Application.Run;

end.

{ MAINFORM.PAS }

unitmainform;

interface

uses SysUtils, Windows, Messages, Classes, Graphics, Controls, StdCtrls, Forms, DBCtrls, DB, DBGrids, DBTables, Grids, ExtCtrls, BDE;

typeTDBMainForm = class(TForm)

Table1Name: TStringField;

Table1Capital: TStringField;

Table1Continent: TStringField;

Table1Area: TFloatField;

Table1Population: TFloatField;

DBGrid1: TDBGrid;

DBNavigator: TDBNavigator;

Panel1: TPanel;

DataSource1: TDataSource;

Panel2: TPanel;

Table1: TTable;

EditButton: TButton;

procedureFormCreate(Sender: TObject);

procedureEditButtonClick(Sender: TObject);

procedureDBGrid1DblClick(Sender: TObject);

private

{ private declarations }

public

{ public declarations }

end;

varDBMainForm: TDBMainForm;

implementation

{$R *.DFM}

procedureTDBMainForm.FormCreate(Sender: TObject);

begin

Table1.Open;

end;

// {ПРИМЕЧАНИЕ: DBHandle - дескриптор базы данных & DSHandle - курсор

// рассматриваемой записи. Кроме того, если вы имеете цель в

// динамической загрузке DLL во время выполнения приложения,

// используйте вызовы API LoadLibrary, GetProcAddress и

// FreeLibrary вместо подразумевающихся вызовов загрузки при

// запуске. Пример использования API для динамической загрузки: }

// Type

// {Для GetProcAddress}

// BDEDataSync =

// function(const DBHandle: HDBIDB; const DSHandle: HDBICur): Boolean;

// stdcall;

// {Организация перехвата ошибок загрузки DLL}

// EDLLLoadError = class(Exception);

// var h: hwnd;

// p: BDEDataSync;

// LastError: DWord;

// begin

// UpdateCursorPos;

// Try

// h := loadLibrary('EDITDLL.DLL');

// {Примечание для пользователей Delphi 1.0: Поскольку Win32

// LoadLibrary при неудачной загрузке DLL возвращает NULL,

// поэтому для поиска ошибки необходим вызов GetLastError,

// Win16 LoadLibrary возвращает значение ошибки (меньше чем

// HINSTANCE_ERROR), которая для выяснения причин неудачной

// загрузки может затем провериться с помощью Win16API SDK.}

// if h = 0 then begin

// LastError := GetLastError;

// Raise EDLLLoadError.create(IntToStr(LastError) +

// ': Невозможно загрузить DLL');

// end;

// try

// p := getProcAddress(h, 'EditData');

// if p(DBHandle, Handle) then Resync([]);

// finally

// freeLibrary(h);

// end;

// Except

// On E: EDLLLoadError do

// MessageDLG(E.Message, mtInformation, [mbOk],0);

// end;

// end;

// {или}

functionEditData( constDBHandle: HDBIDB; constDSHandle: HDBICur): Boolean; stdcall external'EDITDLL.DLL' name'EditData';

procedureTDBMainForm.EditButtonClick(Sender: TObject);

begin

withTable1 do begin

UpdateCursorPos;// Вызываем процедуру EditData из EditDll.dll.

ifEditData(DBHandle, Handle) thenResync([]);

end;

end;

procedureTDBMainForm.DBGrid1DblClick(Sender: TObject);

begin

EditButton.Click;

end;

end.

Проект EDIT DLL

{ EDITDLL.DPR }

libraryeditdll;

usesSysUtils, Classes, editform in'editform.pas' {DBEditForm};

exportsEditData;

begin

end.

{ EDITFORM.PAS }

uniteditform;

interface

uses SysUtils, Windows, Messages, Classes, Graphics, Controls, StdCtrls, Forms, DBCtrls, DB, DBTables, Mask, ExtCtrls, BDE;

type

TTableClone = class;

TDBEditForm = class(TForm);

ScrollBox: TScrollBox;

Label1: TLabel;

EditName: TDBEdit;

Label2: TLabel;

EditCapital: TDBEdit;

Label3: TLabel;

EditContinent: TDBEdit;

Label4: TLabel;

EditArea: TDBEdit;

Label5: TLabel;

EditPopulation: TDBEdit;

DBNavigator: TDBNavigator;

Panel1: TPanel;

DataSource1: TDataSource;

Panel2: TPanel;

Database1: TDatabase;

OKButton: TButton;

private

TableClone: TTableClone;

end;

{ TTableClone }

TTableClone = class(TTable)

private

SrcHandle: HDBICur;

protected

functionCreateHandle: HDBICur; override;

public

procedureOpenClone(ASrcHandle: HDBICur);

end;

functionEditData( constDBHandle: HDBIDB; constDSHandle: HDBICur): Boolean; stdcall;

varDBEditForm: TDBEditForm;

implementation

{$R *.DFM}

{ Экспорт }

functionEditData( constDBHandle: HDBIDB; constDSHandle: HDBICur): Boolean; stdcall;

varDBEditForm: TDBEditForm;

begin

DBEditForm := TDBEditForm.Create(Application);

withDBEditForm do try

// Устанавливаем дескриптор Database1 на открытую в текущий момент базу данных

Database1.Handle := DBHandle;

TableClone := TTableClone.Create(DBEditForm);

try

TableClone.DatabaseName := 'DB1';

DataSource1.DataSet := TableClone;

TableClone.OpenClone(DSHandle);

Result := (ShowModal = mrOK);

ifResult then begin

TableClone.UpdateCursorPos;

DbiSetToCursor(DSHandle, TableClone.Handle);

end;

finally

TableClone.Free;

end;

finally

Free;

end;

end;

{ TTableClone }

procedureTTableClone.OpenClone(ASrcHandle: HDBICur);

begin

SrcHandle := ASrcHandle;

Open;

DbiSetToCursor(Handle, SrcHandle);

Resync([]);

end;

functionTTableClone.CreateHandle: HDBICur

begin

Check(DbiCloneCursor(SrcHandle, False, False, Result));

end;

end.

{ EDITFORM.DFM }

objectDBEditForm: TDBEditForm

Left = 201

Top = 118

Width = 354

Height = 289

ActiveControl = Panel1

Caption = 'DBEditForm'

Font.Color = clWindow

TextFont.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = []

Position = poScreenCenter

PixelsPerInch = 96

TextHeight = 13

objectPanel1: TPanel

Left = 0

Top = 0

Width = 346

Height = 41

Align = alTop

TabOrder = 0

objectDBNavigator: TDBNavigator

Left = 8

Top = 8

Width = 240

Height = 25

DataSource = DataSource1

Ctl3D = FalseParent

Ctl3D = False

TabOrder = 0

end

objectOKButton: TButton

Left = 260

Top = 8

Width = 75

Height = 25

Caption = 'OK'

Default = True

ModalResult = 1

TabOrder = 1

end

end

objectPanel2: TPanel

Left = 0