Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

ВИДЕОКУРС ВЗЛОМ
выпущен 8 мая!


УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Демонстрация обратного вызова BDE

Автор: Mark Edington

Если вы хотите узнать, как работает программа, а деморолика и описания нет. Просто посадите за клавиатуру кошку - вы узнаете все документированные и недокументированные возможности.

Существует обратный вызов (callback) BDE, который вы можете использовать для получения уведомлений об изменении таблиц Paradox. Тем не менее от вас все же потребуется использование таймера. Функция обратного вызова инициируется при вызове функций, осуществляющих доступ к таблице. Ниже приведен код, демонстрирующий технику работы с описанным выше обратным вызовом:

TCMAIN.PAS:


 unit tcmain;
 
 { Демонстрация cbTableChange }
 
 interface
 
 uses
 
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   DB, DBTables, ExtCtrls, DBCtrls, Grids, DBGrids, BDE, StdCtrls;
 
 const
 
   WM_UPDATETABLE = WM_USER + 1;
 
 type
 
   TForm1 = class(TForm)
     Table1: TTable;
     DataSource1: TDataSource;
     DBGrid1: TDBGrid;
     DBNavigator1: TDBNavigator;
     Timer1: TTimer;
     Button1: TButton;
     procedure Table1AfterOpen(DataSet: TDataSet);
     procedure FormCreate(Sender: TObject);
     procedure Timer1Timer(Sender: TObject);
   private
     FChgCnt: Integer;
     FCB: TBDECallback;
     function TableChangeCallBack(CBInfo: Pointer): CBRType;
     procedure UpdateTableData(var Msg: TMessage); message WM_UPDATETABLE;
   end;
 
 var
 
   Form1: TForm1;
 
 implementation
 
 {$R *.DFM}
 
 // Это функция, вызываемая функцией обратного вызова.
 
 function TForm1.TableChangeCallBack(CBInfo: Pointer): CBRType;
 begin
 
   Inc(FChgCnt);
   Caption := IntToStr(FChgCnt);
   MessageBeep(0);
   // Здесь мы не можем вызвать Table1.Refresh, делаем это позже.
   PostMessage(Handle, WM_UPDATETABLE, 0, 0);
 end;
 
 // Данная функция вызывается в ответ на PostMessage (см. выше).
 
 procedure TForm1.UpdateTableData(var Msg: TMessage);
 begin
 
   // Не пытайтесь вызвать обновление, если мы в "середине" редактирования.
   if (Table1.State = dsBrowse) then
     Table1.Refresh;
 end;
 
 procedure TForm1.Table1AfterOpen(DataSet: TDataSet);
 begin
 
   // Установка обратного вызова.
   FCB := TBDECallback.Create(Self, Table1.Handle, cbTableChanged,
     nil, 0, TableChangeCallBack);
 end;
 
 procedure TForm1.FormCreate(Sender: TObject);
 begin
 
   Table1.DatabaseName := ExtractFilePath(ParamStr(0));
   Table1.Open;
 end;
 
 procedure TForm1.Timer1Timer(Sender: TObject);
 var
 
   SeqNo: Longint;
 begin
 
   // События таймера просто осуществляют вызов DbiGetSeqNo для получения доступа к таблице.
   // В противном случае мы не хотим делать обратный вызов, пока что-то делаем
   // (типа прокрутки) для получения доступа к данным. DbiGetSeqNo вызывается в случае,
   // если таблица не активна.
   if Table1.State <> dsInActive then
     DbiGetSeqNo(Table1.Handle, SeqNo);
 end;
 
 end.
 

TCMAIN.TXT:


 object Form1: TForm1
 
 Left = 270
 Top = 230
 Width = 361
 Height = 251
 Caption = 'Form1'
 PixelsPerInch = 96
 OnCreate = FormCreate
 TextHeight = 13
 object DBGrid1: TDBGrid
 Left = 0
 Top = 83
 Width = 353
 Height = 141
 Align = alBottom
 DataSource = DataSource1
 TabOrder = 0
 end
 object DBNavigator1: TDBNavigator
 Left = 96
 Top = 4
 Width = 240
 Height = 25
 DataSource = DataSource1
 TabOrder = 1
 end
 object Button1: TButton
 Left = 132
 Top = 36
 Width = 75
 Height = 25
 Caption = 'Button1'
 TabOrder = 2
 OnClick = Timer1Timer
 end
 object Table1: TTable
 AfterOpen = Table1AfterOpen
 DatabaseName = 'DBDEMOS'
 TableName = 'VENDORS.DB'
 Left = 16
 Top = 8
 end
 object DataSource1: TDataSource
 DataSet = Table1
 Left = 52
 Top = 8
 end
 object Timer1: TTimer
 OnTimer = Timer1Timer
 Left = 80
 Top = 28
 end
 end
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS