Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 244
  • Last Modified:

component for printing header

Hello expert,

I am trying to create a procedure for printing headers above RichEdit text. Found out I could use the code of TCustomRichEdit.Print (overload) in a component based on TRichEdit and add a call to a function that prints the header above the PageRect that RichEdit1 in my unit uses on the Canvas.

When I use this call: ...

    RichEdit1.Print('test');

... then the original TCustomRichEdit.Print method is called from unit ComCtrls and not the adapted copy in the newly installed and used component in my unit.

I cannot understand why the component based on TRichEdit is bypassed toward its ancestor TCustomRichEdit when the code from the latter is copied and changed in (to) the component.

Hopefully the question is stated clear enough.
Help much appreciated!!

Thank you,
Ron dW
0
Ron_de_Weijze
Asked:
Ron_de_Weijze
  • 17
  • 11
1 Solution
 
arnismitCommented:
Hi ron,

can you put your code of your customized TRichEdit in here ? so i can fix your problem ?

Greetings,
arni
0
 
Ron_de_WeijzeAuthor Commented:
I used code from Zarko Gajic, who deserves lots of credit.

{
Article:

TRichEditURL - hyperlink aware RichEdit

http://delphi.about.com/library/weekly/aa051804a.htm

Full source code of the TRichEditURL Delphi component,
an extension to the standard RichEdit component. The
TRichEditURL automatically recognizes URLs. Whenever the
text in a RichEditURL matches the format of a URL, the
control will display it as a hyperlink - when the link is
clicked an event is raised enabling you to, for example,
open a browser or send an email. The TRichEditURL works
correctly event when placed on a Panel or any other container control.
}

unit RichEditURL;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Controls,
  ComCtrls, ExtCtrls, RichEdit, PropertyForm;

type
  TURLClickEvent = procedure(Sender :TObject; const URL: string) of object;

  TRichEditURL = class(TRichEdit)
  private
    FOnURLClick: TURLClickEvent;
    procedure CNNotify(var Msg: TWMNotify); message CN_NOTIFY;
  protected
    procedure DoURLClick (const URL : string);
    procedure CreateWnd; override;
  public
    procedure Print(const Caption: string);
  published
    property OnURLClick : TURLClickEvent read FOnURLClick write FOnURLClick;
  end;

procedure Register;
 
 
implementation

procedure Register;
begin
  RegisterComponents('delphi.about.com', [TRichEditURL]);
end;


{ TRichEditURL }
procedure TRichEditURL.DoURLClick(const URL : string);
begin
  if Assigned(FOnURLClick) then OnURLClick(Self, URL);
end; (*DoURLClick*)

procedure TRichEditURL.CNNotify(var Msg: TWMNotify);
var
  p: TENLink;
  sURL: string;
begin
  if (Msg.NMHdr^.code = EN_LINK) then
  begin
   p := TENLink(Pointer(Msg.NMHdr)^);
   if (p.Msg = WM_LBUTTONDOWN) then
   begin
    try
     SendMessage(Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));
     sURL := SelText;
     DoURLClick(sURL);
    except
    end;
   end;
  end;

 inherited;
end; (*CNNotify*)

procedure TRichEditURL.CreateWnd;
var
  mask: Word;
begin
  inherited CreateWnd;

  SendMessage(Handle, EM_AUTOURLDETECT,1, 0);
  mask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0);
  SendMessage(Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
end; (*CreateWnd*)

procedure TCustomRichEdit.Print(const Caption: string); overload;
var
  Range: TFormatRange;
  LastChar, MaxLen, LogX, LogY, OldMap: Integer;
  SaveRect, TheRect: TRect;
begin
  FillChar(Range, SizeOf(TFormatRange), 0);
  with Printer, Range do
  begin
    Title := Caption;
    BeginDoc;
    hdc := Handle;
    hdcTarget := hdc;
    LogX := GetDeviceCaps(Handle, LOGPIXELSX);
    LogY := GetDeviceCaps(Handle, LOGPIXELSY);
    if IsRectEmpty(PageRect) then
    begin
      rc.right := PageWidth * 1440 div LogX;
      rc.bottom := PageHeight * 1440 div LogY;
    end
    else begin
      rc.left := PageRect.Left * 1440 div LogX;
      rc.top := PageRect.Top * 1440 div LogY;
      rc.right := PageRect.Right * 1440 div LogX;
      rc.bottom := PageRect.Bottom * 1440 div LogY;
    end;
    rcPage := rc;
    SaveRect := rc;
    LastChar := 0;
    MaxLen := GetTextLen;
    chrg.cpMax := -1;
    // ensure printer DC is in text map mode
    OldMap := SetMapMode(hdc, MM_TEXT);
    SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0);    // flush buffer
    try
      Canvas.Textout(10, 10, ED_Caption.text);
      repeat
        rc := SaveRect;
        chrg.cpMin := LastChar;
        LastChar := SendMessage(Self.Handle, EM_FORMATRANGE, 1, Longint(@Range));
        if (LastChar < MaxLen) and (LastChar <> -1) then
        begin
        NewPage;
        end;
      until (LastChar >= MaxLen) or (LastChar = -1);
      EndDoc;
    finally
      SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0);  // flush buffer
      SetMapMode(hdc, OldMap);       // restore previous map mode
    end;
  end;
end;

end. (* RichEditURL.pas *)


{
********************************************
Zarko Gajic
About.com Guide to Delphi Programming
http://delphi.about.com
email: delphi.guide@about.com
free newsletter: http://delphi.about.com/library/blnewsletter.htm
forum: http://forums.about.com/ab-delphi/start/
********************************************
}
0
 
arnismitCommented:
do you use this component only for the printing ???
or also for the URL options ?

greetings,
arni
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
Ron_de_WeijzeAuthor Commented:
Hello Arni,

I use it for handling URL references, but I thought why not also use it for the problem at hand. Is that where the error lies?

Thanks,
Ron dW
0
 
Ron_de_WeijzeAuthor Commented:
Update: found out that although the component-unit compiled, the declaration of the added procedure: ...

  public
    procedure Print(const Caption: string); overload;

... missed the 'overload' statement. Don't see why it would compile anyway, using 'install component'. However, now that 'overload' is added, the problem remains.

I have little experience with components and I wonder whether it could be right to have the procedure named ...

procedure TCustomRichEdit.Print(const Caption: string); overload;

... even though it is in the RichEditURL unit. Should "TCustomRichEdit" not be "TRichEditURL"? Anyway, the original in RichEdit, from which the component-code is a copy, is the same and does not specify its printcommand with "TRichEdit" either.

Questions questions..
0
 
Ron_de_WeijzeAuthor Commented:
Points increased.
0
 
Ron_de_WeijzeAuthor Commented:
Points increased to 400.
0
 
Ron_de_WeijzeAuthor Commented:
Update: leaving out the "TCustomRichEdit" out of the procedure name: ...

procedure TCustomRichEdit.Print(const Caption: string); overload;

... does not make a difference. Still, the compiler jumps to procedure TCustomRichEdit.Print(const Caption: string); in unit ComCtrls and not to procedure Print(const Caption: string); overload; in unit RichEditURL.

Still unresolved.


0
 
Ron_de_WeijzeAuthor Commented:
Points increased to 500
0
 
arnismitCommented:
Ron, i will check it when i come home! I promise!
you'll have an answer tonight. sorry for the delay, but i was very busy lately.

greetings,
arni
0
 
arnismitCommented:
can you try this ?

unit RichEditURL;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Controls,
  ComCtrls, ExtCtrls, RichEdit, printers;

type
  TURLClickEvent = procedure(Sender :TObject; const URL: string) of object;

  TRichEditURL = class(TRichEdit)
  private
    FOnURLClick: TURLClickEvent;
    procedure CNNotify(var Msg: TWMNotify); message CN_NOTIFY;
  protected
    procedure DoURLClick (const URL : string);
    procedure CreateWnd; override;
  public
    procedure Print(const Caption: string); Override;
  published
    property OnURLClick : TURLClickEvent read FOnURLClick write FOnURLClick;
  end;

procedure Register;
 
 
implementation

procedure Register;
begin
  RegisterComponents('delphi.about.com', [TRichEditURL]);
end;


{ TRichEditURL }
procedure TRichEditURL.DoURLClick(const URL : string);
begin
  if Assigned(FOnURLClick) then OnURLClick(Self, URL);
end; (*DoURLClick*)

procedure TRichEditURL.CNNotify(var Msg: TWMNotify);
var
  p: TENLink;
  sURL: string;
begin
  if (Msg.NMHdr^.code = EN_LINK) then
  begin
   p := TENLink(Pointer(Msg.NMHdr)^);
   if (p.Msg = WM_LBUTTONDOWN) then
   begin
    try
     SendMessage(Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));
     sURL := SelText;
     DoURLClick(sURL);
    except
    end;
   end;
  end;

 inherited;
end; (*CNNotify*)

procedure TRichEditURL.CreateWnd;
var
  mask: Word;
begin
  inherited CreateWnd;

  SendMessage(Handle, EM_AUTOURLDETECT,1, 0);
  mask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0);
  SendMessage(Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
end; (*CreateWnd*)

procedure TRichEditURL.Print(const Caption: string);
var
  Range: TFormatRange;
  LastChar, MaxLen, LogX, LogY, OldMap: Integer;
  SaveRect: TRect;
begin
  FillChar(Range, SizeOf(TFormatRange), 0);
  with Printer, Range do
  begin
    Title := Caption;
    BeginDoc;
    hdc := Handle;
    hdcTarget := hdc;
    LogX := GetDeviceCaps(Handle, LOGPIXELSX);
    LogY := GetDeviceCaps(Handle, LOGPIXELSY);
    if IsRectEmpty(PageRect) then
    begin
      rc.right := PageWidth * 1440 div LogX;
      rc.bottom := PageHeight * 1440 div LogY;
    end
    else begin
      rc.left := PageRect.Left * 1440 div LogX;
      rc.top := PageRect.Top * 1440 div LogY;
      rc.right := PageRect.Right * 1440 div LogX;
      rc.bottom := PageRect.Bottom * 1440 div LogY;
    end;
    rcPage := rc;
    SaveRect := rc;
    LastChar := 0;
    MaxLen := GetTextLen;
    chrg.cpMax := -1;
    // ensure printer DC is in text map mode
    OldMap := SetMapMode(hdc, MM_TEXT);
    SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0);    // flush buffer
    try
      Canvas.Textout(10, 10, Caption);
      repeat
        rc := SaveRect;
        chrg.cpMin := LastChar;
        LastChar := SendMessage(Self.Handle, EM_FORMATRANGE, 1, Longint(@Range));
        if (LastChar < MaxLen) and (LastChar <> -1) then
        begin
        NewPage;
        end;
      until (LastChar >= MaxLen) or (LastChar = -1);
      EndDoc;
    finally
      SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0);  // flush buffer
      SetMapMode(hdc, OldMap);       // restore previous map mode
    end;
  end;
end;

end.

good luck
0
 
Ron_de_WeijzeAuthor Commented:
Hi Arni,

I noticed that you added Printers to the Uses. Unfortunately, no luck.

Perhaps my logic is rambling?:

From the running program, by clicking the printbutton, I call the RichEditURL1 control that is on the unit's form and that is the compiled component I just changed using your code.

This is the procedure that the buttonclick calls ...

procedure TUnitForm.FilePrint(Sender: TObject);
var
  presX, presY: Integer;
begin
  inherited;
  with RichEditURL1 do
  begin
  plaintext := true;
  presX := GetDeviceCaps( printer.handle, LOGPIXELSX );
  presY := GetDeviceCaps( printer.handle, LOGPIXELSY );
  end;
  with RichEditURL1.PageRect do
  begin
    left := presX;  // 1 inch left margin
    top  := 3 * presY div 2;  //  1.5 inch top margin
    right := Printer.PageWidth - 3 * presX div 4; // 0.75 inch right margin
    bottom := Printer.PageHeight - presY; // 1 inch bottom margin
  end;
  if PrintDialog.Execute then
    RichEditURL1.Print('test');
end;

... to position the RichEdit text below a location for the header. The header...

Canvas.Textout(10, 10, ED_Caption.text);

... is called from the RichEditURL component itself. Now, the clause in the code above...

RichEditURL1.Print('test')

... is pointing at ...

proc TCustomRichEdit.Print: Procedure(const Caption:string) - ComCtrl.pas (11654)

... while I expect ...

procedure TRichEditURL.Print: Procedure(const Caption: string) - RichEditURL.pas (75)

0
 
arnismitCommented:
well thats because i changed more then only the uses clause.

please try the code above.. there was also an override statement missing.

i tried it at home and it worked!!!!

good luck,
arni
0
 
Ron_de_WeijzeAuthor Commented:
Forgot to mention that, sorry.
I have replaced the component completely with your code (just changing the code for the header to its former state) and the outcome is as above.
Like before, the RichEdit text is printed, leaving room for a header, however the header is not printed.

0
 
arnismitCommented:
i tried to print,

runs the right code, but didnt print the caption

now i fixed the code again, use the following code and you have your caption:

( the tricks was this line:   Printer.Canvas.Textout(10, 10, Caption);

you can chnges the values for the X and Y position to center the text....

good luck
arni


unit RichEditUrl;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Controls,
  ComCtrls, ExtCtrls, RichEdit;

type
  TURLClickEvent = procedure(Sender :TObject; const URL: string) of object;

  TRichEditURL = class(TRichEdit)
  private
    FOnURLClick: TURLClickEvent;
    procedure CNNotify(var Msg: TWMNotify); message CN_NOTIFY;
  protected
    procedure DoURLClick (const URL : string);
    procedure CreateWnd; override;
  public
    procedure Print(const Caption: string); Override;
  published
    property OnURLClick : TURLClickEvent read FOnURLClick write FOnURLClick;
  end;

procedure Register;


implementation

Uses printers;

procedure Register;
begin
  RegisterComponents('delphi.about.com', [TRichEditURL]);
end;


{ TRichEditURL }
procedure TRichEditURL.DoURLClick(const URL : string);
begin
  if Assigned(FOnURLClick) then OnURLClick(Self, URL);
end; (*DoURLClick*)

procedure TRichEditURL.CNNotify(var Msg: TWMNotify);
var
  p: TENLink;
  sURL: string;
begin
  if (Msg.NMHdr^.code = EN_LINK) then
  begin
   p := TENLink(Pointer(Msg.NMHdr)^);
   if (p.Msg = WM_LBUTTONDOWN) then
   begin
    try
     SendMessage(Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));
     sURL := SelText;
     DoURLClick(sURL);
    except
    end;
   end;
  end;

 inherited;
end; (*CNNotify*)

procedure TRichEditURL.CreateWnd;
var
  mask: Word;
begin
  inherited CreateWnd;

  SendMessage(Handle, EM_AUTOURLDETECT,1, 0);
  mask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0);
  SendMessage(Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
end; (*CreateWnd*)

procedure TRichEditURL.Print(const Caption: string);
var
  Range: TFormatRange;
  LastChar, MaxLen, LogX, LogY, OldMap: Integer;
  SaveRect: TRect;
begin
  FillChar(Range, SizeOf(TFormatRange), 0);
  with Printer, Range do
  begin
    Title := Caption;
    BeginDoc;
    hdc := Handle;
    hdcTarget := hdc;
    LogX := GetDeviceCaps(Handle, LOGPIXELSX);
    LogY := GetDeviceCaps(Handle, LOGPIXELSY);
    if IsRectEmpty(PageRect) then
    begin
      rc.right := PageWidth * 1440 div LogX;
      rc.bottom := PageHeight * 1440 div LogY;
    end
    else begin
      rc.left := PageRect.Left * 1440 div LogX;
      rc.top := PageRect.Top * 1440 div LogY;
      rc.right := PageRect.Right * 1440 div LogX;
      rc.bottom := PageRect.Bottom * 1440 div LogY;
    end;
    rcPage := rc;
    SaveRect := rc;
    LastChar := 0;
    MaxLen := GetTextLen;
    chrg.cpMax := -1;
    // ensure printer DC is in text map mode
    OldMap := SetMapMode(hdc, MM_TEXT);
    SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0);    // flush buffer
    try
      Printer.Canvas.Textout(10, 10, Caption);
      repeat
        rc := SaveRect;
        chrg.cpMin := LastChar;
        LastChar := SendMessage(Self.Handle, EM_FORMATRANGE, 1, Longint(@Range));
        if (LastChar < MaxLen) and (LastChar <> -1) then
        begin
        NewPage;
        end;
      until (LastChar >= MaxLen) or (LastChar = -1);
      EndDoc;
    finally
      SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0);  // flush buffer
      SetMapMode(hdc, OldMap);       // restore previous map mode
    end;
  end;
end;

end.
0
 
Ron_de_WeijzeAuthor Commented:
Arni, still no luck. Do you see a reason why the wrong code could be run? I am still a newbee so expect the impossibly stupid.
0
 
Ron_de_WeijzeAuthor Commented:
Why would the code handling the URL references (underline, turn blue, make clickable) work and the print header code not work?
0
 
Ron_de_WeijzeAuthor Commented:
Could it be the relation between the calling procedure and the compiled component (heredity, encapsulation, inclusive compiling)?
0
 
Ron_de_WeijzeAuthor Commented:
Could it be a path that, just in this case and not in case of URL specifics, finds the ComCtrl sooner than the RichEditURL component?
0
 
arnismitCommented:
this part:

 public
    procedure Print(const Caption: string); Override;
  published

and this

procedure TRichEditURL.Print(const Caption: string);
var

should do the trick, please compare the lines with you first code. note the override and the proper classname.
well im wondering too if you have installed this component on the component pallette, let me know, because that is vital for a good use

greetings
arni
0
 
arnismitCommented:
it works all fine here :)
so you must do something wrong.

the code i provided last time is fully working
0
 
arnismitCommented:
what version of delphi are you using anyways ?, not that that should make a difference, but just asking
0
 
Ron_de_WeijzeAuthor Commented:
Hi Arni,

I use Delphi 7.

You made me doubt whether I had installed the component correctly so I deleted it from the palette page and started all over. Then I found out that in the Install Component dialog the Search path had directories containing old versions of my program. (Perhaps I should not put updated versions in new directories?) Clicking ok opened a window "Package - dclusr.dpr" showing RichEditURL, also with a wrong path. So I corrected this. Now, compiling shows no error.

If there is no error in compiling RichEditURL, should it not be registered and show up again on the component palette? I am now trying to figure out why it doesn't and why it did previously.

Will keep you posted.

Thanks,
Ron.
0
 
Ron_de_WeijzeAuthor Commented:
It turns out that deleting probably just hid the component palette label for RichEditURL. Palette properties allowed to make it visible again. And... it works!

So thank you Arni, for helping me out.
0
 
arnismitCommented:
im glad we finally got there,

good luk exploring delphi

if you post any new questions and you want my assistance please be so kind to drop a message in this question
0
 
Ron_de_WeijzeAuthor Commented:
Will do so Arni.
By the way, could I use Dutch?
(You have a Dutch name.)
0
 
arnismitCommented:
yes you can speak dutch but thats not allowed in here

greetings,
arni
0
 
Ron_de_WeijzeAuthor Commented:
Hi Arni,

I just put up another question. You asked me to drop a message if I would like your assistance.
http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_21362610.html

thanks,
Ron
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

  • 17
  • 11
Tackle projects and never again get stuck behind a technical roadblock.
Join Now