Problem with Multithread application with QuickReport

dougaug
dougaug used Ask the Experts™
on
I'm developing an application in Delphi 5 that prints reports (QuickReport 3.0.5) and must let the users make others tasks while wait for the end of printing. Then I created a procedure called PrintThreadBackGround that do the following:
- if a Thread variable is not nil, try to send a message WM_EXEC to this Thread queue to ask it to run a Method (passed to the same procedure). If the Thread is nil, create a new Thread object and points the Thread variable to this object.

The Thread's Execute Method is a Message Loop that always wait for any WM_EXEC messages. If the Thread not receives any message in 5 minutes it terminates.

When the user clicks a button (Print Report in Form2), then the application creates a new thread and send the message asking it to print the report. But when I print the button again (or in another instance of the Form2), the application only prints 1 report and the second click seems to be lost ??? In the form2, I put a Beep to check if the code executes OK.

P.S: I'm not using Synchronize because it freezes the Screen after the printing start, and the user should wait until the printing terminates.

If someone could help me, I'll increase the question points. Any doubts, please contact me in this board.

Thanks in advance.

Below there is the project code (including .DFM source).

Douglas


program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1},
  Unit2 in 'Unit2.pas' {Form2},
  Unit3 in 'Unit3.pas' {Form3},
  uThreads in 'uThreads.pas';

{$R *.RES}

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

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Db, DBTables;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Table1: TTable;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses Unit2;

procedure TForm1.Button1Click(Sender: TObject);
begin
  TForm2.Create(Self);
end;

end.


unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm2 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    hMu: THandle;
    procedure Print;
  end;

var
  Form2: TForm2;

implementation

{$R *.DFM}

uses uThreads, Unit3;

procedure TForm2.FormCreate(Sender: TObject);
begin
  hMu := CreateMutex(nil, True, PChar(Name));
  Caption := Name;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
  PrintReportBackGround(hMu, Print);
end;

procedure TForm2.Print;
begin
  Form3 := TForm3.Create(Self);
  Sleep(2000);

  try
    with Form3 do
    begin
      try
      { In the lines below, I try the following options but they don't work:
       QuickRep1.PrintBackGround; //The code executes OK, but the report is not printed
       QuickRep1.Print; //The code stops in this line, the application freezes and
                        //the report is not printed
       QuickRep1.QRPrinter.Print; //The code pass through this line, but not executes
                                  //the Beep command and nor prints the report}
       QuickRep1.Prepare;
       QuickRep1.QRPrinter.Print;
       Beep;
      finally
        QuickRep1.QRPrinter.Free;
        QuickRep1.QRPrinter := nil;
      end;
    end;
  finally
    Form3.Free;
  end;
end;

end.

unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, QuickRpt, Qrctrls;

type
  TForm3 = class(TForm)
    QuickRep1: TQuickRep;
    QRBand1: TQRBand;
    QRBand2: TQRBand;
    QRDBText1: TQRDBText;
    QRLabel1: TQRLabel;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

{$R *.DFM}

end.

unit uThreads;

interface

uses
  Windows, SysUtils, Classes, Messages;

const
  WM_EXEC = WM_USER + $800;

  procedure PrintReportBackGround(Mutex: THandle; Method: TThreadMethod);

implementation

type
  TTimerThread = class(TThread)
  private
    FMethod: TThreadMethod;
    FTimer: Cardinal;
    FMutexHandle: THandle;
  protected
    procedure Execute; override;
    procedure ThreadTerminate(Sender: TObject); dynamic;
  public
    constructor Create;
  end;

  TPrintThread = class(TTimerThread)
  protected
    procedure ThreadTerminate(Sender: TObject); override;
  end;

var
  PrintThread: TPrintThread = nil;

procedure PrintReportBackGround(Mutex: THandle; Method: TThreadMethod);
var
  bSucess: Boolean;
begin
  if PrintThread = nil then
    PrintThread := TPrintThread.Create;

  with PrintThread do
  begin
    FMethod := Method;

    repeat
      bSucess := PostThreadMessage(ThreadID, WM_EXEC, Mutex, 0);
    until bSucess;
  end;
end;

{ TTimerThread }

constructor TTimerThread.Create;
begin
  inherited Create(True);
  OnTerminate := ThreadTerminate;
  FreeOnTerminate := True;

  { Creates a 5 minutes Timer }
  FTimer := SetTimer(0, 0, 300000, nil);
  Resume;
end;

procedure TTimerThread.Execute;
var
  Msg: TMsg;
begin
  while not Terminated do
  begin
    if GetMessage(Msg, 0, 0, 0) then
    begin
      case Msg.message of
        WM_EXEC: begin
                       FMutexHandle := Msg.wParam;

                       if WaitForSingleObject(FMutexHandle, INFINITE) = WAIT_OBJECT_0 then
                         try
                           FMethod; { Executes the method passed to the Thread }
                         finally
                           { After printing, kills the previous Timer and creates a new  }
                           KillTimer(0, FTimer);
                           FTimer := SetTimer(0, 0, 300000, nil);
                           ReleaseMutex(FMutexHandle);
                         end;
                     end;

        { After 5 minutes without any message in thread's queue, terminates the thread }
        WM_TIMER: Terminate;
      end;

      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end
    else
      Terminate;
  end;
end;

procedure TTimerThread.ThreadTerminate(Sender: TObject);
begin
  KillTimer(0, FTimer);
end;

{ TPrintThread }
procedure TPrintThread.ThreadTerminate(Sender: TObject);
begin
  PrintThread := nil;
end;

end.


object Form1: TForm1
  Left = 192
  Top = 103
  Width = 696
  Height = 480
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  FormStyle = fsMDIForm
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 8
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Create Form2'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Table1: TTable
    Active = True
    DatabaseName = 'DBDEMOS'
    TableName = 'biolife.db'
    Left = 152
    Top = 24
  end
end

object Form2: TForm2
  Left = 192
  Top = 106
  Width = 170
  Height = 173
  Caption = 'Form2'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  FormStyle = fsMDIChild
  OldCreateOrder = False
  Position = poDefault
  Visible = True
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 16
    Top = 16
    Width = 75
    Height = 25
    Caption = 'Print Report'
    TabOrder = 0
    OnClick = Button1Click
  end
end

object Form3: TForm3
  Left = 192
  Top = 106
  Width = 696
  Height = 480
  Caption = 'Form3'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Scaled = False
  PixelsPerInch = 96
  TextHeight = 13
  object QuickRep1: TQuickRep
    Left = 0
    Top = 0
    Width = 816
    Height = 1056
    Frame.Color = clBlack
    Frame.DrawTop = False
    Frame.DrawBottom = False
    Frame.DrawLeft = False
    Frame.DrawRight = False
    DataSet = Form1.Table1
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'Arial'
    Font.Style = []
    Functions.Strings = (
      'PAGENUMBER'
      'COLUMNNUMBER'
      'REPORTTITLE')
    Functions.DATA = (
      '0'
      '0'
      #39#39)
    Options = [FirstPageHeader, LastPageFooter]
    Page.Columns = 1
    Page.Orientation = poPortrait
    Page.PaperSize = Letter
    Page.Values = (
      100
      2794
      100
      2159
      100
      100
      0)
    PrinterSettings.Copies = 1
    PrinterSettings.Duplex = False
    PrinterSettings.FirstPage = 0
    PrinterSettings.LastPage = 0
    PrinterSettings.OutputBin = Auto
    PrintIfEmpty = True
    SnapToGrid = True
    Units = MM
    Zoom = 100
    object QRBand1: TQRBand
      Left = 38
      Top = 38
      Width = 740
      Height = 27
      Frame.Color = clBlack
      Frame.DrawTop = False
      Frame.DrawBottom = False
      Frame.DrawLeft = False
      Frame.DrawRight = False
      AlignToBottom = False
      Color = clWhite
      ForceNewColumn = False
      ForceNewPage = False
      Size.Values = (
        71.4375
        1957.91666666667)
      BandType = rbTitle
      object QRLabel1: TQRLabel
        Left = 328
        Top = 8
        Width = 58
        Height = 17
        Frame.Color = clBlack
        Frame.DrawTop = False
        Frame.DrawBottom = False
        Frame.DrawLeft = False
        Frame.DrawRight = False
        Size.Values = (
          44.9791666666667
          867.833333333333
          21.1666666666667
          153.458333333333)
        Alignment = taLeftJustify
        AlignToBand = False
        AutoSize = True
        AutoStretch = False
        Caption = 'QRLabel1'
        Color = clWhite
        Transparent = False
        WordWrap = True
        FontSize = 10
      end
    end
    object QRBand2: TQRBand
      Left = 38
      Top = 65
      Width = 740
      Height = 27
      Frame.Color = clBlack
      Frame.DrawTop = False
      Frame.DrawBottom = False
      Frame.DrawLeft = False
      Frame.DrawRight = False
      AlignToBottom = False
      Color = clWhite
      ForceNewColumn = False
      ForceNewPage = False
      Size.Values = (
        71.4375
        1957.91666666667)
      BandType = rbDetail
      object QRDBText1: TQRDBText
        Left = 48
        Top = 8
        Width = 53
        Height = 17
        Frame.Color = clBlack
        Frame.DrawTop = False
        Frame.DrawBottom = False
        Frame.DrawLeft = False
        Frame.DrawRight = False
        Size.Values = (
          44.9791666666667
          127
          21.1666666666667
          140.229166666667)
        Alignment = taLeftJustify
        AlignToBand = False
        AutoSize = True
        AutoStretch = False
        Color = clWhite
        DataSet = Form1.Table1
        DataField = 'Category'
        Transparent = False
        WordWrap = True
        FontSize = 10
      end
    end
  end
end
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®

Commented:
i do not see the direct error in your code, the only thing
that looks suspicious to me is:
if you don't synchronize,
i wouldn't make form3 a global/member variable with
influence to your other forms.
i would:

procedure TForm2.Print;
var xform3: TForm3;
begin
 xForm3 := TForm3.Create(nil);
...

Hi drnick,

I've tested my program with your suggestion but it still hangs. I've made a test deleting the printing lines and add Form3.Show, and the program runs OK. Maybe the problem is in the QuickReport component.

Douglas.

Commented:
Create the Form3 under the control of the printing thread.  You have a message pump so it should be okay.
Build an E-Commerce Site with Angular 5

Learn how to build an E-Commerce site with Angular 5, a JavaScript framework used by developers to build web, desktop, and mobile applications.

Commented:
That is ... move the entire body of the "print" method into the thread.  Use the print method only to set up and kick off the thread.

Commented:
swift is right,
and another thing: the messagepump already does synchronization work for you, maybe you can also leave the mutex away since new message are only processed when printing is done.
Hi swift99,

I change my thread Execute method to the code below (and the application only print the report 1 time even I created two instances of Form2 and click the print button in both):

procedure TTimerThread.Execute;
var
  Msg: TMsg;
begin
  while not Terminated do
  begin
    if GetMessage(Msg, 0, 0, 0) then
    begin
      case Msg.message of
        WM_EXEC: begin
                       FMutexHandle := Msg.wParam;

                       if WaitForSingleObject(FMutexHandle, INFINITE) = WAIT_OBJECT_0 then
                         try
                            Form3 := TForm3.Create(nil);
                            Sleep(2000);

                            try
                              with Form3 do
                              begin
                                try
                                { In the lines below, I try the following options but they don't work:
                                 QuickRep1.PrintBackGround; //The code executes OK, but the report is not printed
                                 QuickRep1.Print; //The code stops in this line, the application freezes and
                                                  //the report is not printed
                                 QuickRep1.QRPrinter.Print; //The code pass through this line, but not executes
                                                            //the Beep command and nor prints the report}
                                 QuickRep1.Prepare;
                                 QuickRep1.QRPrinter.Print;
                                 Beep;
                                finally
                                  QuickRep1.QRPrinter.Free;
                                  QuickRep1.QRPrinter := nil;
                                end;
                              end;
                            finally
                              Form3.Free;
                            end;

                         finally
                           { After printing, kills the previous Timer and creates a new  }
                           KillTimer(0, FTimer);
                           FTimer := SetTimer(0, 0, 300000, nil);
                           ReleaseMutex(FMutexHandle);
                         end;
                     end;

        { After 5 minutes without any message in thread's queue, terminates the thread }
        WM_TIMER: Terminate;
      end;

      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end
    else
      Terminate;
  end;
end;

If the code above isn't what you suggest, please send me the correct code. I think the problem is in QuickReport, because if I comment the lines that prepare and print the report, the beep sound will be heard two times. And it doesn't make difference if the method is in the thread context or in the form2 because the method will be executed in the thread anyway.

About drnick comment, the mutex is to synchronize to another thread in my complete application, but in this code, as you said, doesn't synchronize anything.

Regards,

Douglas.

Commented:
make form3 a local variable to the Execute method.

Commented:
Also, are you creating two instances of the thread (one for each?  

You don't have a job queueing mechanism so each "print" will require its own thread instance.  As it is, the second print request would be lost.

The Windows printer drivers handle queueing for you, so you can eliminate the mutex unless there are other protected resources you need to deal with.

You still need the message pump ... but the timer can go ... or you can add a message queueing scheme ... it looks like a bit of design restructuring may be needed.

I've spent all the time here that I can this morning, but I'll think about it and get back.

Commented:
no, he hasn't more than one threads,

procedure PrintReportBackGround(Mutex: THandle; Method: TThreadMethod);
var
 bSucess: Boolean;
begin
 if PrintThread = nil then
   PrintThread := TPrintThread.Create;

so he has additional queuing by the message pump

Commented:
This has the same sort of feel to the situation that blindsides people with asynchronous TCP/IP communications and threads.

This will take some thought, but it's definitely solvable.

Any I/O will result in messages being processed from the message pump.  

Since both instances of TForm3 are assigned to the same variable, only one will get processed with the code as it stands.

Why do you need "sleep 2000"?

Try this ... this way you should be safe from overwriting your variable.  I still think I'm missing at least one more piece.

with TForm3.Create(NIL) do begin
  try
     ...
  finally
     free
  end;
end;
I'm creating only 1 thread for all instances of form2 that require a print job. If there isn't any messages it stays idle.

Again: the mutex is to synchronize another resource, don't mather with it...

I understand you said "I don't have a job queueing mechanism", ok. And how about the message loop... Try the code above with commenting the lines QuickRep1.Prepare and QuickRep1.QrPrinter.Print with this code:
  Printer.BeginDoc;
  Printer.Canvas.TextOut(20, 20, 'Printing test');
  Printer.EndDoc;

If you test the code, the second printing job will not lost !!???

What do you mean about message pump? Could you explain to me?

My doubt is: how can I use QuickReport and don't get any error?

Regards,

Douglas

Commented:
message pump = message loop = your code that contains Getmessage/Translatemsg/Dispatchmsg.

Okay ... so this is a service thread.  That's sensible.

You will have to queue up your source data, unless every instance of Form2 prints the identical data.

I believe that Print and PrintBackground requires the message pump to do its work.  If this is so then you must end your work there, until the printing process is complete.  The report should generate a Done printing message, or may have an Afterprint event, that you can hook into for freeing the report.

    case Msg.message of
       WM_EXEC: begin
             ...
             print
           end;
       WM_QR_PRINT_DONE: begin
             free
           end;

Commented:
you will have to research the specifics.

I didn't understand your code in the last message. Could you send a more detailed one?

Douglas

Commented:
It will have to wait ... the guy that writes my paycheck gets first dibs on my time!  :o)
I didn't understand your code in the last message. Could you send a more detailed one?

Douglas

Commented:
This may not even compile, but it should be close enough to get you on the right track.

unit Unit2;

interface

uses Windows, SysUtils, Messages, Classes, Graphics, Controls,
  StdCtrls, ExtCtrls, Forms, Quickrpt, QRCtrls;

const
  APP_MSG_PRINT = 2048;
  APP_MSG_PRINT_DONE = 2049;
type
  TContentsRecord = record
    // stuff needed to set up the report for unique printing
    // with care, multiple simultaneous reports may not need to block each other
  end;

  TReportServerThread = class (TThread)
  public
    InputQueue: TQueue;
    Procedure Execute;
    procedure QuickRepAfterPrint(Sender: TObject);
  end;

implementation

{ TReportServerThread }

procedure TReportServerThread.Execute;
var
  msg: TMessage;
  aContentsRecord: TContentsRecord;
  aReport: TQuickRep;
begin
  // Kick off the execute at the beginning
  // When you wan a report, create a new TContents record with the report
  // setup, push it into the InputQueue, and SendThreadMesasge (APP_MSG_PRINT)
  // to this thread

  while GetMessage (msg, 0,0,0) > 0 do
  begin
    case Msg.Msg of
    APP_MSG_PRINT: begin
        // *** this "pop" should probably be synchronized
        aContentsRecord := TContentsRecord (InputQueue.Pop);
        with TMyReport.Create (aContentsRecord) do
        begin
          aReport.AfterPrint := QuickRepAfterPrint;
          aReport.Prepare;
          aReport.PrintBackground;
        end;
      end;
    APP_MSG_PRINT_DONE: begin
        aReport := TQuickRep (Pointer (msg.LParam));
        aReport.Free;
      end;
    WM_QUIT: begin
        TranslateMessage (msg);
        DispatchMessage (msg);
        exit;
      end;
    end;

    TranslateMessage (msg);
    DispatchMessage (msg);
  end;
end;

procedure TReportServerThread.QuickRepAfterPrint(Sender: TObject);
begin
  PostThreadMessage (ThreadID, APP_MSG_PRINT_DONE, 0, Integer (Sender));
end;

end.
I didn't understand your code in the last message. Could you send a more detailed one?

Douglas

Commented:
Which part do you need clarification for?
What is TContentsRecord?
Why are you using TQueue? You aren't refering anywhere in the code?
Which kind of object is TMyReport? Is it a Form?

Regards

Douglas

Commented:
TMyReport is your descendent from TQuickRep that contains your report.  The report does not reside on a form since you are not viewing it on the screen, it simply exists as itself.  You create and initialize the report dynamically as it is needed.

A TQueue is a built in Delphi component that performs the task of a FIFO queue.  You need to set up each instance of the report with its initialization data, unless every instance uses the same data.  But then there would be no need to print them both.  When you signal the thread that there is something to report on, this provides a place to put the information so the thread can set up the report.  You must define this within your application.

TContentsRecord contains the information from your GUI form (or other source) that is required to initialize the report.

I have generalized the routine further since this fits right in with one of my projects' upcoming needs.  See next posting.

Commented:
unit Unit2;

interface

uses Windows, SysUtils, Messages, Classes, Graphics, Controls,
  StdCtrls, ExtCtrls, Forms, Quickrpt, QRCtrls;

const
  APP_MSG_PRINT = 2048;
  APP_MSG_PRINT_DONE = 2049;
type
  PContentsRecord = ^TContentsRecord;
  TContentsRecord = record
    ReportClass: TClass;
    // add stuff needed to set up the report for printing
    // with care, multiple simultaneous reports will never need to block each
    //   other.
    // The report is responsible for any blocking that is required
    //   (Mutexes, etc)
    // ReportClass should be set to the class of the report to be generated like
    //   aContentsRecord^.reportClass := TMyReportClass;
  end;

  TReportServerThread = class (TThread)
  public
    Procedure Execute; override;
    procedure PopContentsRecord;
    procedure QuickRepAfterPrint(Sender: TObject);
  end;

implementation

{ TReportServerThread }

{-------------------------------------------------------------------------------
  Generic thread to generate and print arbitrary QuickReport descendents on
  demand using a non-blocking model for high throughput.

  Model will handle any number of more-or-less simultaneous requests, depending
  on available system resources.
-------------------------------------------------------------------------------}
procedure TReportServerThread.Execute;
var
  msg: TMessage;
  aContentsRecord: PContentsRecord;
begin
  // Kick off the execute at the beginning
  // When the GUI wants to print a report:
  //   create a new PContentsRecord
  //   initialize its fields with the report setup parameters, then
  //   PostThreadMessage (ThreadID, APP_MSG_PRINT, 0, Integer (aPContentsRecord));
  // The thread will release the memory when the record is processed

  while (GetMessage (msg, 0,0,0) > 0) do
  begin
    case Msg.Msg of
    APP_MSG_PRINT: begin
        // dereference the LParam into a pointer to the ContentsRecord for
        // building the report.  A Factory class is a better choice, but this
        // gets the idea across.  The actual code difference would not show up
        // in this relatively trivial example.
        aContentsRecord := PContentsRecord (msg.LParam);

        // we don't need to actually do anything with the report, so we just
        // build it and don't assign it to any specific variable.  It knows
        // who it is, and will tell the message pump when it needs attention.
        //
        // Note that the assumption is that we are creating the TReport
        // directly, not in conjunction with any (extraneous) form.
        with aContentsRecord.ReportClass.Create (aContentsRecord) do
        begin
          // set up the report so that it will notify the thread on completion
          AfterPrint := QuickRepAfterPrint;

          // start working
          Prepare;

          // The print job will execute in its own good time in response to
          // events posted by the QuickReport components and the Windows
          // print manager.  We are just kicking it off.  The events are
          // handled through the TranslateMessage and DispatchMessage
          // statements that follow this case statement (see below).
          Print;
        end;

        // after using the contents record we can get rid of it so we don't
        // have a memory leak.
        Dispose (aContentsRecord);
        aContentsRecord := NIL;
      end;

    APP_MSG_PRINT_DONE: begin
        // This could have been done in the AfterPrint event, but it is more clear
        // when we do it here (for maintenance purposes)
        with TQuickRep (Pointer (msg.LParam)) do
          Free;
        Synchronize (Beep); // *** audible notification for testing purposes
      end;
    end;

    // Do work that is not encapsulated in the thread's main line such as
    // responding to print manager events - the stuff that makes OO so powerful
    // since we don't have to worry about it as long as we follow the rules
    TranslateMessage (msg);
    DispatchMessage (msg);

    // we need to allow other components to process the WM_QUIT message before
    // the thread exits, so we handle WM_QUIT after everything else is taken
    // care of
    if msg.Msg = WM_QUIT then exit;
  end;
end;

procedure TReportServerThread.QuickRepAfterPrint(Sender: TObject);
begin
  // Post a message back to the thread to indicate that the print operation
  // is completed
  PostThreadMessage (ThreadID, APP_MSG_PRINT_DONE, 0, Integer (Sender));
end;

end.
Your last code doesn't printing anything.

Regards,

Douglas

Commented:
Hmmm ...

I'll have to try it myself and see.

Commented:
Try PrintBackground instead of Print.  PrintBackground should not block the message pump.

Commented:
Here it is tested - I more-or-less simultaneously kicked off 15 reports to be processed through this code.

I saw some wierdness from this, Windows was not posting all of the requested events to the thread if they were too close together, so I'd go back to explicit queueing for maximum reliability (see first example).

---------------------------------------------------------


unit ReportThreadServer;
interface

uses Windows, SysUtils, Messages, Classes, Graphics, Controls,
 StdCtrls, ExtCtrls, Forms, Quickrpt, QRCtrls, QRPrntr;

const
 APP_MSG_PRINT = 2048;
 APP_MSG_PRINT_DONE = 2049;
type
  TQuickRepClass = class of TQuickRep;
  PContentsRecord = ^TContentsRecord;
  TContentsRecord = record
    ReportClass: TQuickRepClass;
    // add stuff needed to set up the report for printing
    // with care, multiple simultaneous reports will never need to block each
    //   other.
    // The report is responsible for any blocking that is required
    //   (Mutexes, etc)
    // ReportClass should be set to the class of the report to be generated like
    //   aContentsRecord^.reportClass := TMyReportClass;
 end;

 TReportServerThread = class (TThread)
 public
   Procedure Execute; override;
   procedure QuickRepAfterPrint(Sender: TObject);
 end;

implementation

{ TReportServerThread }

{-------------------------------------------------------------------------------
 Generic thread to generate and print arbitrary QuickReport descendents on
 demand using a non-blocking model for high throughput.

 Model will handle any number of more-or-less simultaneous requests, depending
 on available system resources.
-------------------------------------------------------------------------------}
procedure TReportServerThread.Execute;
var
  msg: tagMSG;
  aContentsRecord: PContentsRecord;
  aReport: TQuickRep;
begin
  // Kick off the execute at the beginning
  // When the GUI wants to print a report:
  //   create a new PContentsRecord
  //   initialize its fields with the report setup parameters, then
  //   PostThreadMessage (ThreadID, APP_MSG_PRINT, 0, Integer (aPContentsRecord));
  // The thread will release the memory when the record is processed

  while GetMessage (msg, 0,0,0)  do
  begin
    case Msg.message of
    APP_MSG_PRINT: begin
        // dereference the LParam into a pointer to the ContentsRecord for
        // building the report.  A Factory class is a better choice, but this
        // gets the idea across.  The actual code difference would not show up
        // in this relatively trivial example.
        aContentsRecord := PContentsRecord (msg.LParam);

        // we don't need to actually do anything with the report, so we just
        // build it and don't assign it to any specific variable.  It knows
        // who it is, and will tell the message pump when it needs attention.
        //
        // Note that the assumption is that we are creating the TReport
        // directly, not in conjunction with any (extraneous) form.
        aReport := aContentsRecord.ReportClass.Create (NIL);
        with aReport do
        begin
          // *** Insert your code here to initialize the report parameters

          // set up the report so that it will notify the thread on completion
          AfterPrint := QuickRepAfterPrint;

          // start working
          Prepare;

          // The print job will execute in its own good time in response to
          // events posted by the QuickReport components and the Windows
          // print manager.  We are just kicking it off.  The events are
          // handled through the TranslateMessage and DispatchMessage
          // statements that follow this case statement (see below).
          PrintBackground;
        end;

        // after using the contents record we can get rid of it so we don't
        // have a memory leak.
        Dispose (aContentsRecord);
        aContentsRecord := NIL;
      end;

    APP_MSG_PRINT_DONE: begin
        // This could have been done in the AfterPrint event, but it is more clear
        // when we do it here (for maintenance purposes)
        with TQuickRep (Pointer (msg.LParam)) do
        begin
          Free;
        end;
      end
    else
      // Do work that is not encapsulated in the thread's main line such as
      // responding to print manager events - the stuff that makes OO so powerful
      // since we don't have to worry about it as long as we follow the rules
      TranslateMessage (msg);
      DispatchMessage (msg);
    end;

    // we need to allow other components to process the WM_QUIT message before
    // the thread exits, so we handle WM_QUIT after everything else is taken
    // care of
    if msg.Message = WM_QUIT then exit;
  end;
end;

procedure TReportServerThread.QuickRepAfterPrint(Sender: TObject);
begin
  // Post a message back to the thread to indicate that the print operation
  // is completed
  PostThreadMessage (ThreadID, APP_MSG_PRINT_DONE, 0, Integer (Sender));
end;

end.

Commented:
For the interested - the problem was with the initialization.  I was calling the wrong constructor, hence the new TQuickRepClass definition.

Commented:
Here it is refactored and tested with explicit queueing.  This is much more reliable - it can handle reports queued at machine speeds rather than GUI/human speeds.  I don't know why you might want to queue up 500,000 report requests in a second, but this will pretty much handle that scenario.

Due to design limitations (possibly deliberate) in QuickReports, only one report at a time is processed from the queue.

------------------------------------------------

unit ReportThreadServer;
interface

uses Windows, SysUtils, Messages, Classes, Graphics, Controls,
 StdCtrls, ExtCtrls, Forms, Quickrpt, QRCtrls, QRPrntr, contnrs;

const
  APP_MSG_PRINT = 2048;
  APP_MSG_PRINT_DONE = 2049;
type
  TQuickRepClass = class of TQuickRep;
  PContentsRecord = ^TContentsRecord;
  TContentsRecord = record
    ReportClass: TQuickRepClass;
    // add stuff needed to set up the report for printing
    // with care, multiple simultaneous reports will never need to block each
    //   other.
    // The report is responsible for any blocking that is required
    //   (Mutexes, etc)
    // ReportClass should be set to the class of the report to be generated like
    //   aContentsRecord^.reportClass := TMyReportClass;
 end;

  TReportServerThread = class (TThread)
  protected
    FRequestQueue: TQueue;
    FContentsRecord: PContentsRecord;
    FBusy: Boolean;
  public
    constructor Create;
    Destructor Destroy; override;

    procedure PopRequest;
    procedure PushRequest (aPContentsRecord: PContentsRecord);
    Procedure Execute; override;
    procedure QuickRepAfterPrint(Sender: TObject);
  end;

implementation

{ TReportServerThread }

{-------------------------------------------------------------------------------
 Generic thread to generate and print arbitrary QuickReport descendents on
 demand using a non-blocking model for high throughput.

 Model will handle any number of more-or-less simultaneous requests, depending
 on available system resources.
-------------------------------------------------------------------------------}
constructor TReportServerThread.Create;
begin
  inherited Create (false);

  FRequestQueue := TQueue.Create;
end;

destructor TReportServerThread.Destroy;
begin
  FRequestQueue.Free;
  inherited;
end;

procedure TReportServerThread.Execute;
var
  msg: tagMSG;
  aContentsRecord: PContentsRecord;
  aReport: TQuickRep;
begin
  // Kick off the execute at the beginning
  // When the GUI wants to print a report:
  //   create a new PContentsRecord
  //   initialize its fields with the report setup parameters, then
  //   PostThreadMessage (ThreadID, APP_MSG_PRINT, 0, Integer (aPContentsRecord));
  // The thread will release the memory when the record is processed

  while GetMessage (msg, 0,0,0)  do
  begin
    case Msg.message of
    APP_MSG_PRINT:
      if FRequestQueue.AtLeast (1) then
      begin
        FBusy := true;
        // dereference the LParam into a pointer to the ContentsRecord for
        // building the report.  A Factory class is a better choice, but this
        // gets the idea across.  The actual code difference would not show up
        // in this relatively trivial example.
        Synchronize (PopRequest);

        // we don't need to actually do anything with the report, so we just
        // build it and don't assign it to any specific variable.  It knows
        // who it is, and will tell the message pump when it needs attention.
        //
        // Note that the assumption is that we are creating the TReport
        // directly, not in conjunction with any (extraneous) form.
        aReport := FContentsRecord.ReportClass.Create (NIL);
        with aReport do
        begin
          // *** Insert your code here to initialize the report parameters

          // set up the report so that it will notify the thread on completion
          AfterPrint := QuickRepAfterPrint;

          // start working
          Prepare;

          // The print job will execute in its own good time in response to
          // events posted by the QuickReport components and the Windows
          // print manager.  We are just kicking it off.  The events are
          // handled through the TranslateMessage and DispatchMessage
          // statements that follow this case statement (see below).
          PrintBackground;
        end;

        // after using the contents record we can get rid of it so we don't
        // have a memory leak.
        Dispose (FContentsRecord);
        FContentsRecord := NIL;
      end;

    APP_MSG_PRINT_DONE: begin
        // This could have been done in the AfterPrint event, but it is more clear
        // when we do it here (for maintenance purposes)
        FBusy := false;
        with TQuickRep (Pointer (msg.LParam)) do
        begin
          Free;
        end;
      end
    else
      // Do work that is not encapsulated in the thread's main line such as
      // responding to print manager events - the stuff that makes OO so powerful
      // since we don't have to worry about it as long as we follow the rules
      TranslateMessage (msg);
      DispatchMessage (msg);
    end;

    // we need to allow other components to process the WM_QUIT message before
    // the thread exits, so we handle WM_QUIT after everything else is taken
    // care of
    if msg.Message = WM_QUIT then exit;
  end;
end;

procedure TReportServerThread.PopRequest;
begin
  FContentsRecord := PContentsRecord(FRequestQueue.Pop);
end;

procedure TReportServerThread.PushRequest(
  aPContentsRecord: PContentsRecord);
begin
  FRequestQueue.Push (aPContentsRecord);
  if not Fbusy then
    PostThreadMessage (ThreadID, APP_MSG_PRINT, 0, 0);
end;

procedure TReportServerThread.QuickRepAfterPrint(Sender: TObject);
begin
  // Post a message back to the thread to indicate that the print operation
  // is completed
  PostThreadMessage (ThreadID, APP_MSG_PRINT_DONE, 0, Integer (Sender));
  // post a message just in case we have more to print
  PostThreadMessage (ThreadID, APP_MSG_PRINT, 0, 0);
end;

end.
Hi swift,

sorry I haven't answered your comments ... I was testing your last code. I think it's so nice, and I changed my old code to use your queue solution. But now, my code raises an exception when I call the thread two times (like before), and it terminates. Could check it to see what is wrong?

Thanks for you efforts,

Douglas

unit uThreads;

interface

uses
  Windows, SysUtils, Classes, Messages, dialogs;

const
  WM_EXEC = WM_USER + $800;

  procedure PrintReportBackGround(Mutex: THandle; Method: TThreadMethod);

implementation

uses contnrs;

type
  TTimerThread = class(TThread)
  private
    FMethod: TThreadMethod;
    FTimer: Cardinal;
    FMutexHandle: THandle;
  protected
    procedure Execute; override;
    procedure ThreadTerminate(Sender: TObject); dynamic;
    procedure CallMethod; virtual; abstract;
    procedure ReExecute; virtual;
  public
    constructor Create; dynamic;
  end;

  TPrintThread = class(TTimerThread)
  protected
    procedure ThreadTerminate(Sender: TObject); override;
    procedure CallMethod; override;
    procedure ReExecute; override;
  public
    FJobsPending: TQueue;
    constructor Create; override;
    destructor Destroy; override;
  end;

var
  PrintThread: TPrintThread = nil;

procedure PrintReportBackGround(Mutex: THandle; Method: TThreadMethod);
var
  bSucess: Boolean;
begin
  if PrintThread = nil then
    PrintThread := TPrintThread.Create;

  with PrintThread do
  begin
    { Here the main thread adds a new print job to the printthread queue object before call the print method }
    FJobsPending.Push(@@Method);

    repeat
      bSucess := PostThreadMessage(ThreadID, WM_EXEC, Mutex, 0);
    until bSucess;
  end;
end;

{ TTimerThread }

constructor TTimerThread.Create;
begin
  inherited Create(True);
  OnTerminate := ThreadTerminate;
  FreeOnTerminate := True;

  { Creates a 5 minutes Timer }
  FTimer := SetTimer(0, 0, 300000, nil);
  Resume;
end;

procedure TTimerThread.Execute;
var
  Msg: TMsg;
begin
  while not Terminated do
  begin
    try
      if GetMessage(Msg, 0, 0, 0) then
      begin
        case Msg.message of
          WM_EXEC: begin
                     FMutexHandle := Msg.wParam;

                     if WaitForSingleObject(FMutexHandle, INFINITE) = WAIT_OBJECT_0 then
                       try
                         CallMethod; { Executes the method passed to the Thread }
                       finally
                         { After printing, kills the previous Timer and creates a new  }
                         KillTimer(0, FTimer);
                         FTimer := SetTimer(0, 0, 300000, nil);
                         ReleaseMutex(FMutexHandle);
                       end;
                   end;

          { After 5 minutes without any message in thread's queue, terminates the thread }
          WM_TIMER: Terminate;
        end;

        TranslateMessage(Msg);
        DispatchMessage(Msg);
        ReExecute;
      end
      else
        Terminate;
    except
      ShowMessage(IntToStr(Integer(ExceptAddr)));
    end;
  end;
end;

procedure TTimerThread.ReExecute;
begin

end;

procedure TTimerThread.ThreadTerminate(Sender: TObject);
begin
  KillTimer(0, FTimer);
end;

{ TPrintThread }
constructor TPrintThread.Create;
begin
  inherited;
  FJobsPending := TQueue.Create;
end;

destructor TPrintThread.Destroy;
begin
  FJobsPending.Free;
  inherited;
end;

procedure TPrintThread.CallMethod;
begin
  //Pops the method from the queue and executes it
  //When I called the thread first time, it runs OK
  //But if I call it during the execution, it adds
  //the print job OK, but when it pops the method,
  //an AccessViolation is raised
  TThreadMethod(FJobsPending.Pop^);
end;

procedure TPrintThread.ReExecute;
begin
  //Reenter the thread loop if there is any pending requests
  if FJobsPending.AtLeast(1) then
    PostThreadMessage(ThreadID, WM_EXEC, 0, 0);
end;

procedure TPrintThread.ThreadTerminate(Sender: TObject);
begin
  PrintThread := nil;
end;

end.
Commented:
I will have to study this a bit.  I think it needs refactoring - you're passing method pointers around (generally bad in OO designs) and calling the EXECUTE method of a thread multiple times (always bad).

Commented:
I bet the thread's "FreeOnTerminate" property is true.

If this is the case, then you will need to re-create your thread before you call execute.

This seems like a really awkward way to do things.  Why don't you just kick off the thread and let it sit idle for the duration of the app (like the code I sent you)?  It won't use any CPU and the memory usage is very little.
Hi,

I change my code as you suggest. Now I'm not using method pointers, but I create an interface called Printable that has a method Print and it is running OK. I'll make more tests, and if there will not any errors, I'll give the points for you.

If still you have any suggests than using interfaces, post them here.

Thanks, Douglas.

Commented:
I just pass the class of my report in and make sure that the report is self contained.  The rest of the TContentsRecord is to provide initialization data for the constructors of my reports, and since I don't have any real report it was undefined.

The "interface" solution is acceptable, but it seems the complicated way to me.  Also it slows performance from 500,000 TPS to 5,000 TPS in my measurements last summer.  Delphi interfaces are (unfortunately) tied in to COM.  5,000 is more reports than I would want to queue for printing in a second so I guess it's okay provided it's not bogging down the rest of your application.  

Most desktops apps would find this acceptable, although enterprise server apps would probably find it too CPU consuming.

The important thing is that you now have your own code that embodies the principle of queueing.  Pick up a good book on multi-threaded programming (any environment, Enterprise level Java books tend to be good resources) and you're in good shape.  Another good reference is "Collaborative Computing in Delphi 3" by Callan.
Thanks for you effort and patience...

Douglas

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial