Home General

Stretch behavior on tppLabel / tppDBLabel

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.

Comments

  • 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;
    Best Regards,

    Nico Cizik
    Digital Metaphors
    http://www.digital-metaphors.com
  • 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
  • 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;
    Best Regards,

    Nico Cizik
    Digital Metaphors
    http://www.digital-metaphors.com
  • Hi Nico,

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

    Thank you!

    Cheers

    Adam.
  • 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
  • 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
    Best Regards,

    Nico Cizik
    Digital Metaphors
    http://www.digital-metaphors.com
  • 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
  • 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.
    Best Regards,

    Nico Cizik
    Digital Metaphors
    http://www.digital-metaphors.com
  • Hi Nico,

    Email sent. Thanks for looking into this for me.

    Best Regards

    Adam.
  • 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.
  • 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.
    Best Regards,

    Nico Cizik
    Digital Metaphors
    http://www.digital-metaphors.com
  • 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
Sign In or Register to comment.