Home: Code Repository: Mastering Delphi 5

Project CALLBACK

Project Structure

CALLBACK.DPR
CBACKF.PAS
CBACKF.DFM

program CallBack;

uses
  Forms,
  CBackF in 'CBackF.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

unit CBackF;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables, Grids, DBGrids, ComCtrls, StdCtrls, Bde;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ProgressBar1: TProgressBar;
    Query1: TQuery;
    DataSource2: TDataSource;
    DBGrid2: TDBGrid;
    ListBox1: TListBox;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    fAborted: Boolean;
    CallBackObj: TBDECallBack;
    function fnCallBack (CBInfo: Pointer): CBRType;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button2Click(Sender: TObject);
begin
  fAborted := True;
  Button2.Enabled := False;
end;

function TForm1.fnCallBack(CBInfo: Pointer): CBRType;
var
  I: Integer;
begin
  if fAborted then
    Result := cbrAbort
  else
    Result := cbrContinue;

  with PCBPROGRESSDesc(CBInfo)^ do
    // se iPercent e' <0 allora le informazioni si trovano in szMsg
//    if iPercentDone < 0 then
    begin
      //aggiorna la prima label
      // Label1.Caption :=
      ListBox1.Items.Add ('1:' + szMsg);
      // Copy(szMsg, Pos(':', szMsg) + 1, StrLen(szMsg)));
//      ProgressBar1.Position := StrToInt (
//        Copy(szMsg, Pos(':', szMsg) + 1, StrLen(szMsg))) div 10;
//    end
//    else
//    begin
      ProgressBar1.Position := iPercentDone;
      ListBox1.Items.Add ('2: ' + IntToStr (iPercentDone));
    end;

  // slow down a little
  for I := 1 to 1000 do
    Application.ProcessMessages;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Buffer: CBPROGRESSDesc; // ??name
begin
  // activate the DBE first
  Session.Open;
  // create and install the callback object
  CallBackObj := TBDECallBack.Create (Self, nil,
    cbGenProgress {cbCancelQry}, @Buffer, sizeof (Buffer),
    fnCallBack, True);
  try
    Query1.Open;
  finally
    CallBackObj.Free;
  end;
end;

end.

object Form1: TForm1
  Left = 192
  Top = 107
  Width = 529
  Height = 472
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 32
    Top = 336
    Width = 75
    Height = 25
    Caption = 'Open'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 120
    Top = 336
    Width = 75
    Height = 25
    Caption = 'Cancel'
    TabOrder = 1
    OnClick = Button2Click
  end
  object ProgressBar1: TProgressBar
    Left = 24
    Top = 304
    Width = 417
    Height = 17
    Min = 0
    Max = 1000
    TabOrder = 2
  end
  object DBGrid2: TDBGrid
    Left = 24
    Top = 16
    Width = 409
    Height = 265
    DataSource = DataSource2
    TabOrder = 3
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'MS Sans Serif'
    TitleFont.Style = []
  end
  object ListBox1: TListBox
    Left = 216
    Top = 336
    Width = 257
    Height = 97
    ItemHeight = 13
    TabOrder = 4
  end
  object Query1: TQuery
    DatabaseName = 'DBDEMOS'
    SQL.Strings = (

              'SELECT items.ItemNo, items.Qty, items.Discount, Customer.Company' +
        ', Orders.OrderNo, Parts.Description, Vendors.VendorName'
      'FROM items'
      '   INNER JOIN "parts.db" Parts'
      '   ON  (Parts.PartNo = items.PartNo)  '
      '   AND  (Parts.PartNo = items.PartNo)  '
      '   INNER JOIN "orders.DB" Orders'
      '   ON  (items.OrderNo = Orders.OrderNo)  '
      '   AND  (items.OrderNo = Orders.OrderNo)  '
      '   INNER JOIN "vendors.db" Vendors'
      '   ON  (Vendors.VendorNo = Parts.VendorNo)  '
      '   INNER JOIN "customer.db" Customer'
      '   ON  (Orders.CustNo = Customer.CustNo)  '
      '   AND  (Orders.CustNo = Customer.CustNo)  '
      'WHERE   (items.Qty > 0)  '
      '   AND  (items.OrderNo < 1000000)  ')
    Left = 456
    Top = 72
  end
  object DataSource2: TDataSource
    DataSet = Query1
    Left = 472
    Top = 200
  end
end