Recent

Author Topic: PrintViewer  (Read 15205 times)

rick2691

  • Sr. Member
  • ****
  • Posts: 375
PrintViewer
« on: August 31, 2016, 08:03:44 pm »
The following is almost a Print Viewer. Just add a Timage component to a form and size it. Then you only need to a button to activate it. It is doing well with standard RTF conditions. But it can't do unicode, images, or tabs. Maybe someone can push it a little farther?

Code: Pascal  [Select]
  1. procedure TCmdForm.ViewPageClick(Sender: TObject);
  2. var                  // successive calls to ViewPage are appending the image
  3.   i: integer;        // needs print page sizing, and page advance when full
  4.   mt: widestring;    // needs to handle unicode, images, and tabs
  5. begin                // top-right corner of italics get clipped
  6.   mt:= Utf8ToAnsi(PageMemo.Text);  // does not help -- wanted Unicode -- unicode prints as ? character
  7.   Image1.Canvas.Brush.Color:= clWindow;
  8.   Image1.Canvas.Clear;   // does not clear the canvas
  9.   Image1.Canvas.FillRect(Image1.BoundsRect);   // does not fill the top 2 lines
  10.   for i:= 1 to length(mt) do
  11.       begin
  12.         if mt[i]=#13 then    // emulates a carriage-return
  13.            with Image1.Canvas do
  14.                 MoveTo(0, PenPos.Y + TextHeight(PageMemo.Lines.Strings[0]));
  15.         PageMemo.SelStart:= i;
  16.         PageMemo.SelLength:= 1;
  17.         with Image1.Canvas do                                                 // Type
  18.              begin                                                            // PageMemo: TRichMemo;
  19.              PageMemo.GetTextAttributes(PageMemo.SelStart-1, SelFontFormat);  // SelFontFormat: TFontParams;
  20.              Font.Color:= SelFontFormat.Color;
  21.              Font.Size:= SelFontFormat.Size;
  22.              Font.Style:= SelFontFormat.Style;
  23.              Font.Name:= SelFontFormat.Name;
  24.              if (mt[i]<>#13)
  25.                  and (char(mt[i])<>#10)
  26.                  and (char(mt[i])<>#9)  // can't do tabs!
  27.                  then TextOut(PenPos.X, PenPos.Y, mt[i]);
  28.              if (mt[i]=#9) then TextOut(PenPos.X, PenPos.Y, '   ');  // temporary fix: can't do tabs!
  29.              end;
  30.       end;
  31. end;
  32.  

Rick
Windows 10, LAZ 1.6.4, FPC 3.0.2, SVN 54278, i386-win32-win32/win64, forms use windows unit

GetMem

  • Hero Member
  • *****
  • Posts: 3506
Re: PrintViewer
« Reply #1 on: August 31, 2016, 08:14:39 pm »
I see you have FPC 2.6.4, so instead of:
 
Code: Pascal  [Select]
  1.  mt:= Utf8ToAnsi(PageMemo.Text);
you need:
Code: Pascal  [Select]
  1. mt:= UTF8ToUTF16(PageMemo.Text);

Add LazUTF8 to uses clauses.


PS: And replace TextOut with DrawTextW from windows unit, if you prefer to work with widestrings.
« Last Edit: August 31, 2016, 08:24:10 pm by GetMem »

rick2691

  • Sr. Member
  • ****
  • Posts: 375
Re: PrintViewer
« Reply #2 on: September 01, 2016, 03:26:54 pm »
I tried UTF8ToUTF16. It did not change anything.

There also an issue with this method being too slow for practicality. It is sending everything one character at a time... unless the slowness is on account of the unicode.
Windows 10, LAZ 1.6.4, FPC 3.0.2, SVN 54278, i386-win32-win32/win64, forms use windows unit

rick2691

  • Sr. Member
  • ****
  • Posts: 375
Re: PrintViewer
« Reply #3 on: September 01, 2016, 03:57:43 pm »
I don't think that it is printing unicode because I am doing an i:=1 to length(mt) routine, and it is porting mt tot he canvas. Consequently pieces of the unicode are sent instead of its character representation.
Windows 10, LAZ 1.6.4, FPC 3.0.2, SVN 54278, i386-win32-win32/win64, forms use windows unit

rick2691

  • Sr. Member
  • ****
  • Posts: 375
Re: PrintViewer
« Reply #4 on: September 01, 2016, 05:26:14 pm »
I did some research. TextOut cannot handle unicode. You have to use TextOutW. I also learned that TextOut is the reason for slowness.

Quote
If you use textout it will be very slow, because it take time to render the text every frame. What I do is I render the text to a bitmap in gpu memory (I think the class is called TAdImage). I do this in a thread so to not lose frames when I render it.

Does Lazarus have a DrawText function?
Windows 10, LAZ 1.6.4, FPC 3.0.2, SVN 54278, i386-win32-win32/win64, forms use windows unit

GetMem

  • Hero Member
  • *****
  • Posts: 3506
Re: PrintViewer
« Reply #5 on: September 01, 2016, 09:03:26 pm »
@rick2691
Did you read the PS from my first post?

rick2691

  • Sr. Member
  • ****
  • Posts: 375
Re: PrintViewer
« Reply #6 on: September 01, 2016, 09:11:21 pm »
@GetMem... Yes, I had overlooked the PS comment. Thanks.

I have not implemented anything beyond TextOut, but I have cleaned up the image box a little. It will erase its content for another printing, and subsequent printing do not append the old.

Code: Pascal  [Select]
  1. procedure TCmdForm.ViewPageClick(Sender: TObject);
  2. var
  3.   i: integer;        // needs print page sizing, and page advance when full
  4.   mt: widestring;    // needs to handle unicode, images, and tabs
  5.                      // top-right corner of italics get clipped
  6.   uc: widechar;
  7. begin
  8.   //mt:= UTF8ToUTF16(PageMemo.Text);
  9.   mt:= PageMemo.Text;
  10.   Image1.Canvas.Brush.Color:= clWindow;
  11.   Image1.Canvas.FillRect(0, 0, Image1.Canvas.ClipRect.Right, Image1.Canvas.ClipRect.Bottom);
  12.   Image1.Canvas.MoveTo(0, 0);
  13.   for i:= 1 to UTF8length(mt) do
  14.       begin
  15.         //uc:=
  16.         if mt[i]=#13 then    // emulates a carriage-return
  17.            with Image1.Canvas do
  18.                 MoveTo(0, PenPos.Y + TextHeight(PageMemo.Lines.Strings[0]));
  19.         PageMemo.SelStart:= i;
  20.         PageMemo.SelLength:= 1;
  21.         with Image1.Canvas do                                                 // Type
  22.              begin                                                            // PageMemo: TRichMemo;
  23.              PageMemo.GetTextAttributes(PageMemo.SelStart-1, SelFontFormat);  // SelFontFormat: TFontParams;
  24.              Font.Color:= SelFontFormat.Color;
  25.              Font.Size:= SelFontFormat.Size;
  26.              Font.Style:= SelFontFormat.Style;
  27.              Font.Name:= SelFontFormat.Name;
  28.              if (mt[i]<>#13)
  29.                 and (char(mt[i])<>#10)
  30.                 and (char(mt[i])<>#9)  // can't do tabs!
  31.                 then TextOut(PenPos.X, PenPos.Y, mt[i]);
  32.              if (mt[i]=#9) then TextOut(PenPos.X, PenPos.Y, '   ');  // temporary fix: can't do tabs!
  33.              end;
  34.       end;
  35. end;
  36.  

Rick
Windows 10, LAZ 1.6.4, FPC 3.0.2, SVN 54278, i386-win32-win32/win64, forms use windows unit

rick2691

  • Sr. Member
  • ****
  • Posts: 375
Re: PrintViewer
« Reply #7 on: September 01, 2016, 10:18:26 pm »
So I have a document. It's modified by UTF8toUTF16.  How do you pluck out its unicode one character at a time?
Windows 10, LAZ 1.6.4, FPC 3.0.2, SVN 54278, i386-win32-win32/win64, forms use windows unit

engkin

  • Hero Member
  • *****
  • Posts: 2513
Re: PrintViewer
« Reply #8 on: September 02, 2016, 05:21:25 am »
Rick, while the idea of drawing one character at a time seems ambitious, unfortunately, it is not correct easy.

You can ask the Rich Edit control to do that work for you using EM_FORMATRANGE message. Notice that this message expects twips instead of pixels in FormatRange.

I tried to convert pixels to twips using these two functions:
Code: Pascal  [Select]
  1. function XPixToTwips(px: integer): integer;
  2. var
  3.   dc: THandle;
  4. begin
  5.   dc := GetDC(HWND_DESKTOP);
  6.   Result := Round(1440*px/GetDeviceCaps(dc, LOGPIXELSX));
  7.   ReleaseDC(HWND_DESKTOP, dc);
  8. end;
  9.  
  10. function YPixToTwips(px: integer): integer;
  11. var
  12.   dc: THandle;
  13. begin
  14.   dc := GetDC(HWND_DESKTOP);
  15.   Result := Round(1440*px/GetDeviceCaps(dc, LOGPIXELSY));
  16.   ReleaseDC(HWND_DESKTOP, dc);
  17. end;

To display the Rich Edit on a TImage I used the following code:
Code: Pascal  [Select]
  1. procedure TCmdForm.Button1Click(Sender: TObject);
  2. var
  3.   fs:TFileStream;
  4.   fr:TFormatRange;
  5.   dc:THandle;
  6.   ox, oy, w, h: LongInt;
  7.   cpMin: LRESULT;
  8.   c: Integer;
  9. begin
  10.   { Load some test RTF file }
  11.   fs := TFileStream.Create('TestFile.rtf', fmOpenRead or fmShareDenyNone);
  12.   try
  13.     PageMemo.LoadRichText(fs);
  14.   finally
  15.     fs.Free;
  16.   end;
  17.  
  18.   Image1.Picture.Bitmap.SetSize(PageMemo.Width, PageMemo.Height);
  19.  
  20.   dc := Image1.Canvas.Handle;
  21.  
  22.   ox := 0;//GetDeviceCaps(dc, PHYSICALOFFSETX);
  23.   oy := 0;//GetDeviceCaps(dc, PHYSICALOFFSETY);
  24.   w := XPixToTwips(PageMemo.Width);//GetDeviceCaps(dc, PHYSICALWIDTH);
  25.   h := YPixToTwips(PageMemo.Height);//GetDeviceCaps(dc, PHYSICALHEIGHT);
  26.  
  27.   fr._hdc := dc;
  28.   fr.hdcTarget := dc;
  29.  
  30.   fr.rc.Left:=ox;
  31.   fr.rc.Right:=ox+w;
  32.  
  33.   fr.rc.Top:=oy;
  34.   fr.rc.Bottom:=oy+h;
  35.  
  36.   SendMessage(PageMemo.Handle, EM_SETSEL, 0, -1);
  37.   SendMessage(PageMemo.Handle, EM_EXGETSEL, 0, LParam(@fr.chrg));
  38.   SendMessage(PageMemo.Handle, EM_SETSEL, 0, 0);
  39.  
  40.   c := 1;
  41.   repeat
  42.     cpMin := SendMessage(PageMemo.Handle, EM_FORMATRANGE, 1, LParam(@fr));
  43.     if cpMin < fr.chrg.cpMin then
  44.        break;
  45.     fr.chrg.cpMin := cpMin;
  46.     inc(c);
  47.   until c>=1000; { Not forever! }
  48.  
  49.   SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0);
  50.   Image1.Picture.Bitmap.Canvas.Changed;
  51. end;

I don't know if it works for you, but on my side I have the following image.

Source: VB code on MS KB #94927.

rick2691

  • Sr. Member
  • ****
  • Posts: 375
Re: PrintViewer
« Reply #9 on: September 02, 2016, 02:08:42 pm »
engkin,

I had to change a variable code...  fr._hdc  is  r.hdc  on my system.

I also added the following to clear the page and reset its cursor point.

Image1.Canvas.Brush.Color:= clWindow;
Image1.Canvas.FillRect(0, 0, Image1.Canvas.ClipRect.Right,  Image1.Canvas.ClipRect.Bottom);
Image1.Canvas.MoveTo(0, 0);

After using TextOut, I was astonished at the speed of your code. I had low expectations, but it is nearly instantaneous. Moreover, it does the unicode. I am also impressed that you have provided so much in its construction. Thank you.

One question... do you think that streaming will handle inline images as well?

I should have a fully operational PrintView soon... or maybe a little longer.
« Last Edit: September 02, 2016, 03:46:25 pm by rick2691 »
Windows 10, LAZ 1.6.4, FPC 3.0.2, SVN 54278, i386-win32-win32/win64, forms use windows unit

engkin

  • Hero Member
  • *****
  • Posts: 2513
Re: PrintViewer
« Reply #10 on: September 02, 2016, 02:19:35 pm »
One question... do you think that streaming will handle inline images as well?

If you can see inline images in the Rich Edit control then it should be able handle them as well.

rick2691

  • Sr. Member
  • ****
  • Posts: 375
Re: PrintViewer
« Reply #11 on: September 02, 2016, 07:31:12 pm »
engkin,

I have tried to research this, but I haven't found anything... is there a way to scale everything that is sent by EM_FORMATRANGE. I need fonts and images to be at half or one-third size.

Rick
Windows 10, LAZ 1.6.4, FPC 3.0.2, SVN 54278, i386-win32-win32/win64, forms use windows unit

rick2691

  • Sr. Member
  • ****
  • Posts: 375
Re: PrintViewer
« Reply #12 on: September 02, 2016, 08:56:46 pm »
I finally tracked it down. I have a panel that is at half size to 8.5" x 11" (US letter size), and it is called PaperArea. Then I have an image that sets inside it with 1 inch offset surrounding it, and it is called TextArea. The provision in the code is by three commands... 

TextArea.Picture.Bitmap.SetSize(round(PixWide * 2), round(PixHigh * 2));

and

w:= XPixToTwips(PixWide * 2);  //GetDeviceCaps(dc, PHYSICALWIDTH);
h:= YPixToTwips(PixHigh * 2);  //GetDeviceCaps(dc, PHYSICALHEIGHT);

which reduce everything to half scaling.

Code: Pascal  [Select]
  1. procedure TCmdForm.ViewPageClick(Sender: TObject);
  2. var
  3.   fr: TFormatRange;
  4.   dc: THandle;
  5.   ox, oy, w, h: LongInt;
  6.   cpMin: LRESULT;
  7.   c: Integer;
  8.   PgWide, PgHigh, PgSide, PgHead, InchW, InchH: double;
  9.   PixHigh, PixWide: integer;
  10. begin
  11.   PgWide:= 8.5; PgHigh:= 11.0; PgSide:= 1.0; PgHead:= 1.0;
  12.  
  13.   // setup the TextArea dimensions
  14.   PaperArea.top:= 40;
  15.   PaperArea.height:= round(PgHigh * Screen.PixelsPerInch) div 2;
  16.   PaperArea.width:= round(PgWide * Screen.PixelsPerInch) div 2;
  17.   PaperArea.left:= (PageMemo.width - PaperArea.width) div 2;
  18.  
  19.   InchH:= PgHigh/2 - PgHead; // Phead is half of head and tail
  20.   InchW:= PgWide/2 - PgSide;  // Pside is half of left and right
  21.   PixHigh:= round(InchH * Screen.PixelsPerInch); // standard = 96 per inch
  22.   PixWide:= round(InchW * Screen.PixelsPerInch); // twips are 1440 per inch
  23.  
  24.   // setup the printable region
  25.   TextArea.Top:= Screen.PixelsPerInch div 2; // 48;  // half of screen pixels per inch
  26.   TextArea.height:= PixHigh;
  27.   TextArea.width:= PixWide;
  28.   TextArea.left:= Screen.PixelsPerInch div 2; // 48; // half of screen pixels per inch
  29.   TextArea.Picture.Bitmap.SetSize(round(PixWide * 2), round(PixHigh * 2));
  30.   PaperArea.visible:= true;
  31.  
  32.   // restart the canvas
  33.   TextArea.Canvas.Brush.Color:= clWindow;
  34.   TextArea.Canvas.FillRect(0, 0, TextArea.Canvas.ClipRect.Right, TextArea.Canvas.ClipRect.Bottom);
  35.   TextArea.Canvas.MoveTo(0, 0);
  36.  
  37.   dc:= TextArea.Canvas.Handle;
  38.  
  39.   ox:= 0;  //GetDeviceCaps(dc, PHYSICALOFFSETX);
  40.   oy:= 0;  //GetDeviceCaps(dc, PHYSICALOFFSETY);
  41.   w:= XPixToTwips(PixWide * 2);  //GetDeviceCaps(dc, PHYSICALWIDTH);
  42.   h:= YPixToTwips(PixHigh * 2);  //GetDeviceCaps(dc, PHYSICALHEIGHT);
  43.  
  44.   fr.hdc:= dc;       // fr._hdc := dc; **on another system**
  45.   fr.hdcTarget:= dc;
  46.  
  47.   fr.rc.Left:= ox;
  48.   fr.rc.Right:= ox+w;
  49.  
  50.   fr.rc.Top:= oy;
  51.   fr.rc.Bottom:= oy+h;
  52.  
  53.   SendMessage(PageMemo.Handle, EM_SETSEL, 0, -1);
  54.   SendMessage(PageMemo.Handle, EM_EXGETSEL, 0, LParam(@fr.chrg));
  55.   SendMessage(PageMemo.Handle, EM_SETSEL, 0, 0);
  56.  
  57.   c:= 1;
  58.   repeat
  59.     cpMin:= SendMessage(PageMemo.Handle, EM_FORMATRANGE, 1, LParam(@fr));
  60.     if cpMin<fr.chrg.cpMin then
  61.        break;
  62.     fr.chrg.cpMin:= cpMin;
  63.     inc(c);
  64.   until c>=1000; { Not forever! }
  65.  
  66.   SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0);
  67.   TextArea.Picture.Bitmap.Canvas.Changed;
  68. end;
  69.  

The next problem is curtailing any overage in text, and providing for the next page.

Rick
« Last Edit: September 02, 2016, 08:59:23 pm by rick2691 »
Windows 10, LAZ 1.6.4, FPC 3.0.2, SVN 54278, i386-win32-win32/win64, forms use windows unit

derek.john.evans

  • Guest
Re: PrintViewer
« Reply #13 on: September 03, 2016, 07:12:29 am »
I have some print preview code here, if people want it.

rick2691

  • Sr. Member
  • ****
  • Posts: 375
Re: PrintViewer
« Reply #14 on: September 03, 2016, 01:40:17 pm »
Geepster,

Thanks. I will look into it, and I appreciate your hard work and openness.

Rick
Windows 10, LAZ 1.6.4, FPC 3.0.2, SVN 54278, i386-win32-win32/win64, forms use windows unit