Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 5

Project CALLBACK

Project Structure


CALLBACK.DPR

program CallBack;

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

{$R *.RES}

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

CBACKF.PAS

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.

CBACKF.DFM

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