DrawCommand Click Events

rbuser

Hi,

The DrawCommandClickCustInfo.pas and dfm code below is modified version of
the DrawCommandCustomInfoProj demo downloaded from the Wiki. The code worked
properly prior to version 14 of RB. In version 14 clicking on the lines of
the first page after loading the report works as expected, but after moving
to the second page and then back to the first page the wrong info will
display when clicked.

Thanks

-Jack

--------------------------------------------------------------------------------
//DrawCommandClickCustInfo.pas
unit DrawCommandClickCustInfo;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ppDB, ppDBPipe, Db, DBTables, ppPrnabl, ppClass, ppCtrls,
ppBands, ppCache, ppComm, ppRelatv, ppProd, ppReport, ppParameter,
ppDesignLayer, ppDrwCmd, ppDevice;

type
TmyDrillDownDraw = class(TppDrawShape)
private
FKeyValue: Variant;
protected
procedure DrawClickEvent(Sender: TObject);
public
procedure Assign(Source: TPersistent); override;
function EqualTo(aDrawCommand: TppDrawCommand): Boolean; override;
constructor Create(AOwner: TComponent); override;
published
property KeyValue: Variant read FKeyValue write FKeyValue;
end;

TForm3 = class(TForm)
ppReport1: TppReport;
ppHeaderBand1: TppHeaderBand;
ppDetailBand1: TppDetailBand;
ppFooterBand1: TppFooterBand;
ppDBText1: TppDBText;
dsCustomer: TDataSource;
tblCustomer: TTable;
plCustomer: TppDBPipeline;
Button1: TButton;
Memo1: TMemo;
ppDesignLayers1: TppDesignLayers;
ppDesignLayer1: TppDesignLayer;
ppDBText2: TppDBText;
procedure Button1Click(Sender: TObject);
procedure ppDetailBand1CreateDrawCommand(Sender, aPage: TObject);
private
procedure CreateDrawCommand;
public
{ Public declarations }
end;

var
Form3: TForm3;

implementation

{$R *.DFM}

procedure TForm3.Button1Click(Sender: TObject);
begin
ppReport1.Print;
end;

procedure TForm3.ppDetailBand1CreateDrawCommand(Sender, aPage: TObject);
begin
CreateDrawCommand;
end;

procedure TForm3.CreateDrawCommand;
var
ADraw: TmyDrillDownDraw;
begin
ADraw := TmyDrillDownDraw.Create(ppReport1);
ADraw.Page := ppReport1.Engine.Page;
ADraw.Band := ppReport1.DetailBand;
ADraw.Top := ppReport1.DetailBand.PrintPosRect.Top + 500;
ADraw.Left := ppReport1.PrinterSetup.PageDef.mmMarginLeft;
ADraw.Width := ppReport1.PrinterSetup.PageDef.mmPrintableWidth;
ADraw.Height := ppReport1.DetailBand.mmHeight - 1000;
ADraw.Pen.Style := psClear;
ADraw.Brush.Style := bsClear;
ADraw.Clickable := True;
ADraw.KeyValue := ppReport1.DataPipeline.FieldValues['CustNo'];
end;

{ TmyDrillDownDraw }

procedure TmyDrillDownDraw.Assign(Source: TPersistent);
var
lDrawCommand: TmyDrillDownDraw;
begin
inherited Assign(Source);

if not(Source is TmyDrillDownDraw) then
Exit;

lDrawCommand := TmyDrillDownDraw(Source);
t FKeyValue := lDrawCommand.KeyValue;
end;

constructor TmyDrillDownDraw.Create(AOwner: TComponent);
begin
inherited Create(AOwner);

OnClick := DrawClickEvent;
end;

procedure TmyDrillDownDraw.DrawClickEvent(Sender: TObject);
begin
ShowMessage('Cumpany: ' + string(KeyValue));
end;

function TmyDrillDownDraw.EqualTo(aDrawCommand: TppDrawCommand): Boolean;
begin
Result := inherited EqualTo(aDrawCommand);

if aDrawCommand is TmyDrillDownDraw then
Result := Result and (FKeyValue =
TmyDrillDownDraw(aDrawCommand).KeyValue);
end;

initialization

RegisterClasses([TmyDrillDownDraw]);

finalization
UnRegisterClasses([TmyDrillDownDraw]);

end.

//DrawCommandClickCustInfo.dfm
object Form3: TForm3
Left = 209
Top = 107
Caption = 'Draw Command Click Info'
ClientHeight = 220
ClientWidth = 404
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 157
Top = 178
Width = 75
Height = 25
Caption = 'Preview'
TabOrder = 0
OnClick = Button1Click
end
object Memo1: TMemo
Left = 38
Top = 15
Width = 330
Height = 141
Enabled = False
Lines.Strings = (
'This example shows how to attach custom information to a draw '
'command.'
''
'The Report.OnDrawCommandCreate and OnDrawCommandClicked '
'events are used to store and retrieve the custom info.'
''
'Preview the report, then click on the company names to display '
'additional information.')
TabOrder = 1
end
object ppReport1: TppReport
AutoStop = False
DataPipeline = plCustomer
PrinterSetup.BinName = 'Default'
PrinterSetup.DocumentName = 'Report'
PrinterSetup.PaperName = 'Letter'
PrinterSetup.PrinterName = 'Default'
PrinterSetup.SaveDeviceSettings = False
PrinterSetup.mmMarginBottom = 6350
PrinterSetup.mmMarginLeft = 6350
PrinterSetup.mmMarginRight = 6350
PrinterSetup.mmMarginTop = 6350
PrinterSetup.mmPaperHeight = 279401
PrinterSetup.mmPaperWidth = 215900
PrinterSetup.PaperSize = 1
ArchiveFileName = '($MyDocuments)\ReportArchive.raf'
DeviceType = 'Screen'
DefaultFileDeviceType = 'PDF'
EmailSettings.ReportFormat = 'PDF'
LanguageID = 'Default'
OutlineSettings.CreateNode = True
OutlineSettings.CreatePageNodes = True
OutlineSettings.Enabled = False
OutlineSettings.Visible = False
PDFSettings.EmbedFontOptions = []
PDFSettings.EncryptSettings.AllowCopy = True
PDFSettings.EncryptSettings.AllowInteract = True
PDFSettings.EncryptSettings.AllowModify = True
PDFSettings.EncryptSettings.AllowPrint = True
PDFSettings.EncryptSettings.Enabled = False
PDFSettings.FontEncoding = feAnsi
PDFSettings.ImageCompressionLevel = 25
PreviewFormSettings.WindowState = wsMaximized
PreviewFormSettings.ZoomSetting = zsPageWidth
RTFSettings.DefaultFont.Charset = DEFAULT_CHARSET
RTFSettings.DefaultFont.Color = clWindowText
RTFSettings.DefaultFont.Height = -13
RTFSettings.DefaultFont.Name = 'Arial'
RTFSettings.DefaultFont.Style = []
TextFileName = '($MyDocuments)\Report.pdf'
TextSearchSettings.DefaultString = ''
TextSearchSettings.Enabled = False
XLSSettings.AppName = 'ReportBuilder'
XLSSettings.Author = 'ReportBuilder'
XLSSettings.Subject = 'Report'
XLSSettings.Title = 'Report'
Left = 100
Top = 177
Version = '14.04'
mmColumnWidth = 0
DataPipelineName = 'plCustomer'
object ppHeaderBand1: TppHeaderBand
Background.Brush.Style = bsClear
mmBottomOffset = 0
mmHeight = 13229
mmPrintPosition = 0
end
object ppDetailBand1: TppDetailBand
OnCreateDrawCommand = ppDetailBand1CreateDrawCommand
Background1.Brush.Style = bsClear
Background2.Brush.Style = bsClear
mmBottomOffset = 0
mmHeight = 13229
mmPrintPosition = 0
object ppDBText1: TppDBText
UserName = 'DBText1'
DataField = 'Company'
DataPipeline = plCustomer
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Name = 'Arial'
Font.Size = 10
Font.Style = []
Transparent = True
DataPipelineName = 'plCustomer'
mmHeight = 3969
mmLeft = 5821
mmTop = 3440
mmWidth = 58473
BandType = 4
LayerName = Foreground
end
object ppDBText2: TppDBText
UserName = 'DBText2'
DataField = 'CustNo'
DataPipeline = plCustomer
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Name = 'Arial'
Font.Size = 10
Font.Style = []
Transparent = True
DataPipelineName = 'plCustomer'
mmHeight = 3969
mmLeft = 127529
mmTop = 3440
mmWidth = 17198
BandType = 4
LayerName = Foreground
end
end
object ppFooterBand1: TppFooterBand
Background.Brush.Style = bsClear
mmBottomOffset = 0
mmHeight = 13229
mmPrintPosition = 0
end
object ppDesignLayers1: TppDesignLayers
object ppDesignLayer1: TppDesignLayer
UserName = 'Foreground'
LayerType = ltBanded
end
end
object ppParameterList1: TppParameterList
end
end
object dsCustomer: TDataSource
DataSet = tblCustomer
Left = 38
Top = 177
end
object tblCustomer: TTable
Active = True
DatabaseName = 'DBDEMOS'
TableName = 'customer.db'
Left = 7
Top = 177
end
object plCustomer: TppDBPipeline
DataSource = dsCustomer
UserName = 'plCustomer'
Left = 69
Top = 177
object plCustomerppField1: TppField
Alignment = taRightJustify
FieldAlias = 'CustNo'
FieldName = 'CustNo'
FieldLength = 0
DataType = dtDouble
DisplayWidth = 10
Position = 0
end
object plCustomerppField2: TppField
FieldAlias = 'Company'
FieldName = 'Company'
FieldLength = 30
DisplayWidth = 30
Position = 1
end
object plCustomerppField3: TppField
FieldAlias = 'Addr1'
FieldName = 'Addr1'
FieldLength = 30
DisplayWidth = 30
Position = 2
end
object plCustomerppField4: TppField
FieldAlias = 'Addr2'
FieldName = 'Addr2'
FieldLength = 30
DisplayWidth = 30
Position = 3
end
object plCustomerppField5: TppField
FieldAlias = 'City'
FieldName = 'City'
FieldLength = 15
DisplayWidth = 15
Position = 4
end
object plCustomerppField6: TppField
FieldAlias = 'State'
FieldName = 'State'
FieldLength = 20
DisplayWidth = 20
Position = 5
end
object plCustomerppField7: TppField
FieldAlias = 'Zip'
FieldName = 'Zip'
FieldLength = 10
DisplayWidth = 10
Position = 6
end
object plCustomerppField8: TppField
FieldAlias = 'Country'
FieldName = 'Country'
FieldLength = 20
DisplayWidth = 20
Position = 7
end
object plCustomerppField9: TppField
FieldAlias = 'Phone'
FieldName = 'Phone'
FieldLength = 15
DisplayWidth = 15
Position = 8
end
object plCustomerppField10: TppField
FieldAlias = 'FAX'
FieldName = 'FAX'
FieldLength = 15
DisplayWidth = 15
Position = 9
end
object plCustomerppField11: TppField
Alignment = taRightJustify
FieldAlias = 'TaxRate'
FieldName = 'TaxRate'
FieldLength = 0
DataType = dtDouble
DisplayWidth = 10
Position = 10
end
object plCustomerppField12: TppField
FieldAlias = 'Contact'
FieldName = 'Contact'
FieldLength = 20
DisplayWidth = 20
Position = 11
end
object plCustomerppField13: TppField
FieldAlias = 'LastInvoiceDate'
FieldName = 'LastInvoiceDate'
FieldLength = 0
DataType = dtDateTime
DisplayWidth = 18
Position = 12
end
end
end

nicocizik

Hi Jack,

Sorry for the delay. We are currently researching this and will get
back to you as soon as possible.

rbuser

Any updates?

nicocizik

We are still researching a solution for this issue. Please contact
support@digital-metaphors.com directly and I will walk you through a
workaround to keep you up and running until we can provide a permanent fix.