Stretch behavior on tppLabel / tppDBLabel

adam · November 2022

Hi,

I was just wondering if it's possible to achieve the effects of 'stretch' that we have with Memo components for Label components too.

The reason I can't use a memo component is that I wish to add a hyperlink to the value that's printing (it's a connote tracking number) - and I wish for the hyperlink to take the user directly to the shipping companies tracking number URL. Hyperlink doesn't appear to be available on Memo's.

Unfortunately on the odd occasion, the connote number needs to worldwrap due to being significantly larger than other tracking numbers if a certain company is used.

So I'm hoping there's a quick/simple solution that will allow me to dynamically stretch labels in the same way that Memo's stretch please?

Thanks & Regards

Adam.

nicocizik · November 2022

Hi Adam,

TppLabel components are not stretchable.

One option would be to implement the OnDrawCommandClick event of the memo and manually open the website when the memo is selected. Something like the following:

uses
  Windows, ppDrwCmd, ppUtils;

procedure TForm2.ppMemo1DrawCommandClick(Sender, aDrawCommand: TObject);
var
  lDrawText: TppDrawText;
  lsWebAddress: String;
begin

  lDrawText := TppDrawText(aDrawCommand);
  lsWebAddress := lDrawText.WrappedText.Text;

  ppShellExec(lsWebAddress, '', '', SW_SHOWNORMAL);

end;

adam · November 2022

Thanks Nico,

Unfortunately I'm wanting this to work when it's saved to a PDF file, so the DrawCommandClick isn't going to work.

If I can't make pplabel components stretchable, is it possible to attack this from the opposite direction and add hyperlink properties to a memo component?

Thanks & Regards

Adam

nicocizik · November 2022

Hi Adam,

Thanks for the clarification.

While hyperlinks are not supported for memos in ReportBuilder, it is possible to trick the PDF device into making the entire memo control hyperlink-clickable by assigning the HyperLink property when the draw command is created.

procedure TForm2.ppMemo1DrawCommandCreate(Sender, aDrawCommand: TObject);
var
  lDrawText: TppDrawText;
begin

  lDrawText := TppDrawText(aDrawCommand);
  lDrawText.Hyperlink := StringReplace(lDrawText.WrappedText.Text, #13#10, '', [rfReplaceAll]);

end;

adam · November 2022

Hi Nico,

Fantastic - I think that might do the job. I'll give that a try.

Thank you!

Cheers

Adam.

adam · November 2022

Hi Nico,

I've given that a try but unfortunately it doesn't seem to be working.

The code is executing - it's just that no hyperlink shows up in the previewer for the component, nor if I print it to a PDF printer.

(I've got a demo project to use as an example, but unfortunately I can't figure out how to post attachments to this forum).

Thanks & Regards

Adam

nicocizik · November 2022

Below is a link to the example I created which appears to be working as intended. It was created with RB 21.05. Let me know if it you still get the issue on your machine with my example and I'll try to track down what is happening.

http://www.digital-metaphors.com/tips/ClickableMemo.zip

adam · November 2022

Thanks Nico,

I've ran your demo and it runs fine. Furthermore - I can even run it with the OnDrawClick event removed and it still works as I would expect with the PDF file.

However for some crazy reason - when I use the exact same code in my test app - it fails.

I'm using 21.04 instead (I haven't updated to 21.05 yet) but your demo app works so I don't believe it's that.

I know I'm omitting the OnDrawClick event in my demo (as I don't care about the previewer, just the end PDF result) - but even if I remove the OnDrawClick event from your project - yours still works where mine doesn't.

Here is my PAS and DFM Files that I'm using:

I'm not sure if you can see why it would not work for me, when it works in your app?

Thanks & Regards

Adam

--------------------------------------------------
unit Unit1;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, ppDB, ppDBJIT, ppComm, ppRelatv, ppProd,
ppClass, ppReport, ppPrnabl, ppStrtch, ppMemo, ppBands, ppCache,
ppDesignLayer, ppParameter;

type
TForm1 = class(TForm)
ppReport1: TppReport;
ppJITPipeline1: TppJITPipeline;
ppParameterList1: TppParameterList;
ppDesignLayers1: TppDesignLayers;
ppDesignLayer1: TppDesignLayer;
ppHeaderBand1: TppHeaderBand;
ppDetailBand1: TppDetailBand;
ppFooterBand1: TppFooterBand;
ppMemo1: TppMemo;
procedure FormCreate(Sender: TObject);
procedure ppMemo1Print(Sender: TObject);
procedure ppMemo1DrawCommandCreate(Sender, aDrawCommand: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses ppDrwCmd;

procedure TForm1.FormCreate(Sender: TObject);
begin
ppReport1.print;
end;

procedure TForm1.ppMemo1DrawCommandCreate(Sender, aDrawCommand: TObject);
var
lDrawText: TppDrawText;
begin
if ppJITPipeline1.RecordNo * 0.5 = trunc(ppJITPipeline1.RecordNo * 0.5) then
exit;

lDrawText := TppDrawText(aDrawCommand);
lDrawText.Hyperlink := StringReplace(lDrawText.WrappedText.Text, #13#10, '', [rfReplaceAll]);
end;

procedure TForm1.ppMemo1Print(Sender: TObject);
begin
ppMemo1.lines.Text := 'http://google.com/' + inttostr(ppJitPipeline1.RecordNo);
end;

end.

---------------------------------------------------------------------------
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 299
ClientWidth = 635
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object ppReport1: TppReport
AutoStop = False
DataPipeline = ppJITPipeline1
PrinterSetup.BinName = 'Default'
PrinterSetup.DocumentName = 'Report'
PrinterSetup.PaperName = 'A4'
PrinterSetup.PrinterName = 'Default'
PrinterSetup.SaveDeviceSettings = False
PrinterSetup.mmMarginBottom = 6350
PrinterSetup.mmMarginLeft = 6350
PrinterSetup.mmMarginRight = 6350
PrinterSetup.mmMarginTop = 6350
PrinterSetup.mmPaperHeight = 297000
PrinterSetup.mmPaperWidth = 210000
PrinterSetup.PaperSize = 9
ArchiveFileName = '($MyDocuments)\ReportArchive.raf'
DeviceType = 'Screen'
DefaultFileDeviceType = 'PDF'
EmailSettings.ReportFormat = 'PDF'
EmailSettings.ConnectionSettings.MailService = 'SMTP'
EmailSettings.ConnectionSettings.WebMail.GmailSettings.OAuth2.RedirectPort = 0
EmailSettings.ConnectionSettings.WebMail.Outlook365Settings.OAuth2.RedirectPort = 0
EmailSettings.ConnectionSettings.EnableMultiPlugin = False
LanguageID = 'Default'
OpenFile = False
OutlineSettings.CreateNode = True
OutlineSettings.CreatePageNodes = True
OutlineSettings.Enabled = True
OutlineSettings.Visible = True
ThumbnailSettings.Enabled = True
ThumbnailSettings.Visible = True
ThumbnailSettings.DeadSpace = 30
ThumbnailSettings.PageHighlight.Width = 3
ThumbnailSettings.ThumbnailSize = tsSmall
PDFSettings.EmbedFontOptions = [efUseSubset]
PDFSettings.EncryptSettings.AllowCopy = True
PDFSettings.EncryptSettings.AllowInteract = True
PDFSettings.EncryptSettings.AllowModify = True
PDFSettings.EncryptSettings.AllowPrint = True
PDFSettings.EncryptSettings.AllowExtract = True
PDFSettings.EncryptSettings.AllowAssemble = True
PDFSettings.EncryptSettings.AllowQualityPrint = True
PDFSettings.EncryptSettings.Enabled = False
PDFSettings.EncryptSettings.KeyLength = kl40Bit
PDFSettings.EncryptSettings.EncryptionType = etRC4
PDFSettings.DigitalSignatureSettings.SignPDF = False
PDFSettings.FontEncoding = feAnsi
PDFSettings.ImageCompressionLevel = 25
PDFSettings.PDFAFormat = pafNone
PreviewFormSettings.PageBorder.mmPadding = 0
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 = True
XLSSettings.AppName = 'ReportBuilder'
XLSSettings.Author = 'ReportBuilder'
XLSSettings.Subject = 'Report'
XLSSettings.Title = 'Report'
XLSSettings.WorksheetName = 'Report'
CloudDriveSettings.DropBoxSettings.OAuth2.RedirectPort = 0
CloudDriveSettings.DropBoxSettings.DirectorySupport = True
CloudDriveSettings.GoogleDriveSettings.OAuth2.RedirectPort = 0
CloudDriveSettings.GoogleDriveSettings.DirectorySupport = False
CloudDriveSettings.OneDriveSettings.OAuth2.RedirectPort = 0
CloudDriveSettings.OneDriveSettings.DirectorySupport = True
Left = 344
Top = 128
Version = '21.04'
mmColumnWidth = 0
DataPipelineName = 'ppJITPipeline1'
object ppHeaderBand1: TppHeaderBand
Border.mmPadding = 0
mmBottomOffset = 0
mmHeight = 13229
mmPrintPosition = 0
end
object ppDetailBand1: TppDetailBand
Border.mmPadding = 0
mmBottomOffset = 0
mmHeight = 8202
mmPrintPosition = 0
object ppMemo1: TppMemo
OnPrint = ppMemo1Print
DesignLayer = ppDesignLayer1
UserName = 'Memo1'
Border.mmPadding = 0
Caption = 'Memo1'
CharWrap = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Name = 'Arial'
Font.Size = 9
Font.Style = []
Lines.Strings = (
'test1')
OnDrawCommandCreate = ppMemo1DrawCommandCreate
RemoveEmptyLines = False
Transparent = True
mmHeight = 5556
mmLeft = 4233
mmTop = 2646
mmWidth = 48948
BandType = 4
LayerName = Foreground
mmBottomOffset = 0
mmOverFlowOffset = 0
mmStopPosition = 0
mmMinHeight = 0
mmLeading = 0
end
end
object ppFooterBand1: TppFooterBand
Border.mmPadding = 0
mmBottomOffset = 0
mmHeight = 13229
mmPrintPosition = 0
end
object ppDesignLayers1: TppDesignLayers
object ppDesignLayer1: TppDesignLayer
UserName = 'Foreground'
LayerType = ltBanded
Index = 0
end
end
object ppParameterList1: TppParameterList
end
end
object ppJITPipeline1: TppJITPipeline
InitialIndex = 0
RecordCount = 10
UserName = 'JITPipeline1'
Left = 136
Top = 120
end
end

nicocizik · November 2022

Hi Adam,

I only added the OnDrawCommandClick event to show how the memo URL can be done both ways. It is not necessary for PDF.

Using your exact code and similar form definition, I was unable to recreate this. Please send your example to support@digital-metaphors.com in .zip format and I'll see what is happening. I must be missing something.

adam · November 2022

Hi Nico,

Email sent. Thanks for looking into this for me.

Best Regards

Adam.

adam · November 2022

Hi Nico,

I was just wondering if my email from the other week has come through and if you've had a chance to look at this yet please?

Thanks & Regards

Adam.

nicocizik · November 2022

Hi Adam,

Yes, below is a copy of my email response from November, 21.

---

I tested your example with Delphi 10.4.2, and Delphi 11.2 on multiple machines and it functions as expected. I am at a loss at what is happening on your machine. My only thought is that you start with my example (or recreate it from scratch) and move forward with your main application from there.

adam · November 2022

Hi Nico,

Thanks for your reply. I'm not sure why I didn't receive the email (there's nothing in the junk list) but appreciate your response here.

I'll continue to try and figure out what is going on my end.

Have a great day!

Adam

Stretch behavior on tppLabel / tppDBLabel

Comments