Lazarus

Programming => Packages and Libraries => RichMemo => Topic started by: rick2691 on August 31, 2016, 08:03:44 pm

Title: PrintViewer
Post by: rick2691 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

Title: Re: PrintViewer
Post by: balazsszekely 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.

Title: Re: PrintViewer
Post by: rick2691 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.

Title: Re: PrintViewer
Post by: rick2691 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.

Title: Re: PrintViewer
Post by: rick2691 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?

Title: Re: PrintViewer
Post by: balazsszekely on September 01, 2016, 09:03:26 pm

@rick2691
Did you read the PS from my first post?

Title: Re: PrintViewer
Post by: rick2691 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

Title: Re: PrintViewer
Post by: rick2691 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?

Title: Re: PrintViewer
Post by: engkin 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.

Title: Re: PrintViewer
Post by: rick2691 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.

Title: Re: PrintViewer
Post by: engkin on September 02, 2016, 02:19:35 pm

Quote from: rick2691 on September 02, 2016, 02:08:42 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.

Title: Re: PrintViewer
Post by: rick2691 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

Title: Re: PrintViewer
Post by: rick2691 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

Title: Re: PrintViewer
Post by: derek.john.evans on September 03, 2016, 07:12:29 am

I have some print preview code here, if people want it.

Title: Re: PrintViewer
Post by: rick2691 on September 03, 2016, 01:40:17 pm

Geepster,

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

Rick

Title: Re: PrintViewer
Post by: rick2691 on September 03, 2016, 04:43:56 pm

This activates by a button, and deactivates by the same button... as a toggle.

PageMemo is a TRichMemo.
PaperArea is a panel... the code will size it.
TextArea is a TImage. It should be placed on the PaperArea panel.
It will also be sized by the code.
The PaperArea.visible should be set to false.
The code will turn it on and off.

It will walk through the pages... with NEXT popup for advancing.
When all pages have been shown, a DONE popup will show.
To exit toggle your View button again.

As is, this is just a "look at" routine to see if you want to edit your document.

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.   PageAvialable: boolean;
11. begin
12.   if PaperArea.visible=false then
13.      begin
14.         PgWide:= 8.5; PgHigh:= 11.0; PgSide:= 1.0; PgHead:= 1.0;
15.  
16.         // setup the TextArea dimensions
17.         PaperArea.top:= 40;
18.         PaperArea.height:= round(PgHigh * Screen.PixelsPerInch) div 2;
19.         PaperArea.width:= round(PgWide * Screen.PixelsPerInch) div 2;
20.         PaperArea.left:= (PageMemo.width - PaperArea.width) div 2;
21.  
22.         InchH:= PgHigh/2 - PgHead; // Phead is half of head and tail
23.         InchW:= PgWide/2 - PgSide;  // Pside is half of left and right
24.         PixHigh:= round(InchH * Screen.PixelsPerInch); // standard = 96 per inch
25.         PixWide:= round(InchW * Screen.PixelsPerInch); // twips are 1440 per inch
26.  
27.         // setup the printable region
28.         TextArea.Top:= Screen.PixelsPerInch div 2;   // half of screen pixels per inch
29.         TextArea.height:= PixHigh;
30.         TextArea.width:= PixWide;
31.         TextArea.left:= Screen.PixelsPerInch div 2;  // half of screen pixels per inch
32.         TextArea.Picture.Bitmap.SetSize(round(PixWide * 2), round(PixHigh * 2));  // *2 for half size
33.         PaperArea.visible:= true;
34.  
35.         // restart and clear the canvas
36.         TextArea.Canvas.Brush.Color:= clWindow;
37.         TextArea.Canvas.FillRect(0, 0, TextArea.Canvas.ClipRect.Right, TextArea.Canvas.ClipRect.Bottom);
38.         TextArea.Canvas.MoveTo(0, 0);
39.  
40.         dc:= TextArea.Canvas.Handle;
41.  
42.         ox:= 0;  //GetDeviceCaps(dc, PHYSICALOFFSETX);
43.         oy:= 0;  //GetDeviceCaps(dc, PHYSICALOFFSETY);
44.         w:= XPixToTwips(PixWide * 2);  //GetDeviceCaps(dc, PHYSICALWIDTH);   // *2 for half size
45.         h:= YPixToTwips(PixHigh * 2);  //GetDeviceCaps(dc, PHYSICALHEIGHT);  // *2 for half size
46.  
47.         fr.hdc:= dc;       // fr._hdc := dc; **on another system**
48.         fr.hdcTarget:= dc;
49.  
50.         fr.rc.Left:= ox;
51.         fr.rc.Right:= ox+w;
52.  
53.         fr.rc.Top:= oy;
54.         fr.rc.Bottom:= oy+h;
55.  
56.         SendMessage(PageMemo.Handle, EM_SETSEL, 0, -1);
57.         SendMessage(PageMemo.Handle, EM_EXGETSEL, 0, LParam(@fr.chrg));
58.         SendMessage(PageMemo.Handle, EM_SETSEL, 0, 0);
59.  
60.         PageAvialable:= true;
61.         while (fr.chrg.cpMin<fr.chrg.cpMax) and (PageAvialable) do
62.               begin
63.               cpMin:= SendMessage(PageMemo.Handle, EM_FORMATRANGE, 1, LPARAM(@fr));
64.               if (cpMin<=fr.chrg.cpMin) then
65.                  begin
66.                    PageAvialable:= false; //  document has no content
67.                    break;
68.                  end;
69.               fr.chrg.cpMin:= cpMin;
70.               PageAvialable:= EndPage(fr.hdc) > 0;
71.               if (fr.chrg.cpMin<fr.chrg.cpMax) then
72.                  begin
73.                  showmessage('Next');
74.                  TextArea.Canvas.Brush.Color:= clWindow;
75.                  TextArea.Canvas.FillRect(0, 0, TextArea.Canvas.ClipRect.Right, TextArea.Canvas.ClipRect.Bottom);
76.                  TextArea.Canvas.MoveTo(0, 0);
77.                  PageAvialable:= true;
78.                  end;
79.               end;
80.         SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0);
81.         showmessage('Done');
82.  
83.         if PageAvialable
84.            then EndDoc(fr.hdc)
85.            else AbortDoc(fr.hdc);
86.  
87.         TextArea.Picture.Bitmap.Canvas.Changed;
88.      end else PaperArea.visible:= false;
89. end;  
90.  

Rick

Title: Re: PrintViewer
Post by: rick2691 on September 05, 2016, 02:34:26 pm

This is an upgrade to ViewPage. It has 7 variables that could be made global to control page dimensions and its preview scale. They are noted.

This version can count the sum of pages, display the current page number, and navigate back and forward among the pages.

I have compared the page formatting to WordPad, and it has identical paging.

It uses a modal interrupter to manage the page navigation. I don't like it but I couldn't see any other way for arresting the page view. It does, however, permit you drag it around to get it out of the way.

If any of you have been downloading the code, please note that I have changed some of the variables in this version. I have also made extensive revisions on the entire code.

Perhaps some of you can improve on the project. If so, please post it.

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.   x: Integer;
8.   PgWide, PgHigh, PgLft, PgRht, PgTop, PgBtm, InchW, InchH, ViewScale: double;
9.   PixHigh, PixWide, ViewChg, BegChar, PgCnt, PgSum: integer;
10.   MorePages: boolean;
11.   BackPages, xstr, PgStr: string;
12.  
13. begin
14.   if PaperArea.visible=false then
15.      begin
16.         // define paper size
17.         // these 7 can be global for changeable paper size and display
18.         PgWide:= 8.5; PgHigh:= 11.0;
19.         PgLft:= 1.0; PgRht:= 1.0;
20.         PgTop:= 1.0; PgBtm:= 1.0;
21.         ViewScale:= 2; // display size: 10.5=double, 1.0=full, 2.0=half
22.  
23.         // setup the PaperArea metrics
24.         PaperArea.top:= 40;  // 40 fits my layout
25.         PaperArea.height:= Round(PgHigh * Screen.PixelsPerInch / ViewScale);
26.         PaperArea.width:= Round(PgWide * Screen.PixelsPerInch / ViewScale);
27.         PaperArea.left:= Round((PageMemo.width - PaperArea.width) / 2);  // centering view page
28.  
29.         // setup the TextArea metrics
30.         InchH:= PgHigh - PgTop - PgBtm;
31.         InchW:= PgWide - PgLft - PgRht;
32.         PixHigh:= Round(InchH * Screen.PixelsPerInch / ViewScale);
33.         PixWide:= Round(InchW * Screen.PixelsPerInch / ViewScale);
34.  
35.         // setup the TextArea position
36.         TextArea.Top:= Round((Screen.PixelsPerInch * PgTop) / ViewScale);
37.         TextArea.height:= PixHigh;
38.         TextArea.width:= PixWide;
39.         TextArea.left:= Round((Screen.PixelsPerInch * PgLft) / ViewScale);
40.         TextArea.Picture.Bitmap.SetSize(Round(PixWide * ViewScale), Round(PixHigh * ViewScale));
41.  
42.         // get the page count
43.         cpMin:= 0; PgSum:= 0; MorePages:= true;
44.         while (fr.chrg.cpMin<=fr.chrg.cpMax) and (MorePages) do // track through document
45.               begin
46.               // clear the image canvas
47.               TextArea.Canvas.Brush.Color:= clWindow;
48.               TextArea.Canvas.FillRect(0, 0, TextArea.Canvas.ClipRect.Right, TextArea.Canvas.ClipRect.Bottom);
49.               TextArea.Canvas.MoveTo(0, 0);
50.  
51.               // set the printing metrics
52.               dc:= TextArea.Canvas.Handle;
53.               ox:= 0;  //GetDeviceCaps(dc, PHYSICALOFFSETX);
54.               oy:= 0;  //GetDeviceCaps(dc, PHYSICALOFFSETY);
55.               w:= XPixToTwips(Round(PixWide * ViewScale));  //GetDeviceCaps(dc, PHYSICALWIDTH);
56.               h:= YPixToTwips(Round(PixHigh * ViewScale));  //GetDeviceCaps(dc, PHYSICALHEIGHT);
57.               FillChar(fr, SizeOf(TFormatRange), 0);
58.               fr.hdc:= dc;       // fr._hdc := dc; **on another system**
59.               fr.hdcTarget:= dc;
60.               fr.rc.Left:= ox;
61.               fr.rc.Right:= ox+w;
62.               fr.rc.Top:= oy;
63.               fr.rc.Bottom:= oy+h; //
64.               fr.chrg.cpMin:= cpMin;
65.               SendMessage(PageMemo.Handle, EM_HIDESELECTION, 1, 0);  // hide selection
66.               SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
67.               SendMessage(PageMemo.Handle, EM_SETSEL, cpMin, -1);  // select to end of document
68.               SendMessage(PageMemo.Handle, EM_EXGETSEL, 0, LParam(@fr.chrg));  // copy selection
69.               SendMessage(PageMemo.Handle, EM_SETSEL, 0, 0);  // reset to no selection
70.               SendMessage(PageMemo.Handle, EM_HIDESELECTION, 0, 0); // show selection
71.  
72.               cpMin:= SendMessage(PageMemo.Handle, EM_FORMATRANGE, 1, LPARAM(@fr));
73.               SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
74.  
75.               if (fr.chrg.cpMin=fr.chrg.cpMax)
76.                  then MorePages:= false
77.                  else PgSum:= PgSum + 1;
78.               end;
79.  
80.         // print each page
81.         MorePages:= true; ViewChg:= 0;
82.         cpMin:= 0; BackPages:=''; BegChar:= 0;
83.         PaperArea.visible:= true; PgCnt:= 0;
84.         while (fr.chrg.cpMin<=fr.chrg.cpMax) and (MorePages) do // track through document
85.               begin
86.               if (ViewChg<0) then
87.                  begin
88.                  x:= pos(',',BackPages);
89.                  if x>0 then delete(BackPages,1,x);
90.                  x:= pos(',',BackPages);
91.                  if x>0 then
92.                     begin
93.                     xstr:= copy(BackPages,1,x-1);
94.                     delete(BackPages,1,x);
95.                     cpMin:= StrToInt(xstr);
96.                     PgCnt:= PgCnt - 2;
97.                     if cpMin<0 then
98.                        begin
99.                        cpMin:= 0; BackPages:='';
100.                        PgCnt:= 0;
101.                        end;
102.                     end else begin
103.                              cpMin:= 0; BackPages:='';
104.                              PgCnt:= 0;
105.                              end;
106.                  end;
107.               BackPages:= IntToStr(cpMin)+','+BackPages; //showmessage(BackPages);
108.               ViewChg:= 0;
109.               BegChar:= cpMin; //showmessage(IntToStr(BegChar));
110.  
111.               // clear the image canvas
112.               TextArea.Canvas.Brush.Color:= clWindow;
113.               TextArea.Canvas.FillRect(0, 0, TextArea.Canvas.ClipRect.Right, TextArea.Canvas.ClipRect.Bottom);
114.               TextArea.Canvas.MoveTo(0, 0);
115.  
116.               // set the printing metrics
117.               dc:= TextArea.Canvas.Handle;
118.               ox:= 0;  //GetDeviceCaps(dc, PHYSICALOFFSETX);
119.               oy:= 0;  //GetDeviceCaps(dc, PHYSICALOFFSETY);
120.               w:= XPixToTwips(Round(PixWide * ViewScale));  //GetDeviceCaps(dc, PHYSICALWIDTH);
121.               h:= YPixToTwips(Round(PixHigh * ViewScale));  //GetDeviceCaps(dc, PHYSICALHEIGHT);
122.               FillChar(fr, SizeOf(TFormatRange), 0);
123.               fr.hdc:= dc;       // fr._hdc := dc; **on another system**
124.               fr.hdcTarget:= dc;
125.               fr.rc.Left:= ox;
126.               fr.rc.Right:= ox+w;
127.               fr.rc.Top:= oy;
128.               fr.rc.Bottom:= oy+h; //
129.               fr.chrg.cpMin:= cpMin;
130.               SendMessage(PageMemo.Handle, EM_HIDESELECTION, 1, 0); // hide selection
131.               SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
132.               SendMessage(PageMemo.Handle, EM_SETSEL, cpMin, -1);  // select to end of document
133.               SendMessage(PageMemo.Handle, EM_EXGETSEL, 0, LParam(@fr.chrg));  // copy selection
134.               SendMessage(PageMemo.Handle, EM_SETSEL, 0, 0);  // reset to no selection
135.               SendMessage(PageMemo.Handle, EM_HIDESELECTION, 0, 0); // show selection
136.  
137.               cpMin:= SendMessage(PageMemo.Handle, EM_FORMATRANGE, 1, LPARAM(@fr));
138.               SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
139.  
140.               if (cpMin<=fr.chrg.cpMin) then
141.                   begin
142.                    MorePages:= false; //  document has no content
143.                    break;
144.                   end;
145.  
146.               fr.chrg.cpMin:= cpMin;  // set to start of next page
147.               PgCnt:= PgCnt + 1;
148.               PgStr:= 'Page '+IntToStr(PgCnt)+' of ';
149.               PgStr:= PgStr+IntToStr(PgSum)+' Pages';
150.  
151.               if (BegChar=0) then // pause at first-page
152.                  begin
153.                  case QuestionDlg (PgStr,'Navigation at Home',mtCustom,
154.                                    [mrCancel, 'Quit', mrYes, 'Next'],'') of
155.                       mrYes: ViewChg:= 1;
156.                       mrCancel: MorePages:= false;
157.                       end;
158.                  end  else if (fr.chrg.cpMin<fr.chrg.cpMax) then // pause at each-page
159.                            begin
160.                            case QuestionDlg (PgStr,'Page Navigation',mtCustom,
161.                                              [mrNo,'Back', mrCancel, 'Quit', mrYes, 'Next'],'') of
162.                                 mrNo: ViewChg:= -1;
163.                                 mrYes: ViewChg:= 1;
164.                                 mrCancel: MorePages:= false;
165.                                 end;
166.                            end;
167.               if (fr.chrg.cpMin=fr.chrg.cpMax) then // pause at last-page
168.                  begin
169.                  case QuestionDlg (PgStr,'Navigation at End',mtCustom,
170.                                    [mrNo,'Back', mrCancel, 'Quit'],'') of
171.                       mrNo: ViewChg:= -1;
172.                       mrCancel: MorePages:= false;
173.                       end;
174.                  end;
175.               TextArea.Canvas.Brush.Color:= clWindow;
176.               TextArea.Canvas.FillRect(0, 0, TextArea.Canvas.ClipRect.Right, TextArea.Canvas.ClipRect.Bottom);
177.               TextArea.Canvas.MoveTo(0, 0);
178.               end;
179.  
180.         // clean up
181.         SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
182.         if MorePages
183.            then EndDoc(fr.hdc) // close EM_FORMATRANGE
184.            else AbortDoc(fr.hdc);
185.         TextArea.Picture.Bitmap.Canvas.Changed;  // reset image event
186.         PaperArea.visible:= false;
187.      end else begin
188.               SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
189.               if MorePages
190.                  then EndDoc(fr.hdc) // close EM_FORMATRANGE
191.                  else AbortDoc(fr.hdc);
192.               TextArea.Picture.Bitmap.Canvas.Changed;  // reset image event
193.               PaperArea.visible:= false;
194.               end;
195. end;
196.  

Rick

Title: Re: PrintViewer
Post by: rick2691 on September 06, 2016, 01:41:33 pm

I have found an odd behavior... only a TButton can allow the ViewPage procedure to display the PaperArea panel.

TToolbar button, TMainMenu item, and TBitBtn will not allow it to show. It blinks on, and then it is gone. What would cause that to happen?

Rick

Title: Re: PrintViewer
Post by: engkin on September 06, 2016, 02:28:20 pm

Most likely because fr is not initialized before hitting this while loop:

Code: Pascal  [Select][+][-]

1.   if PaperArea.visible=false then
2.      begin
3. ...
4.         // get the page count
5.         cpMin:= 0; PgSum:= 0; MorePages:= true;
6.         while (fr.chrg.cpMin<=fr.chrg.cpMax) and (MorePages) do // track through document
7. ...

Title: Re: PrintViewer
Post by: rick2691 on September 06, 2016, 04:06:19 pm

engkin,

Yes, that was the problem. I thought it could be an issue when I reconstructed the code, but it didn't show any defect while using the Tbutton, so I thought it was OK.

Rick

Title: Re: PrintViewer
Post by: rick2691 on September 06, 2016, 07:20:41 pm

engkin,

The following is a change to initialization code. But it still has an odd behavior. The SendMessage(PageMemo.Handle, EM_HIDESELECTION, 1, 0) command doesn't work with the TtoolButton, but it does with the Tbutton. Yet if I page through a few pages by the Tbutton, then the TtoolButton can do the EM_HIDESELECTION just fine.

As a temporary fix I am masking over the RichMemo screen with a panel that is set to "align client." I can't stand the flicker and flash.

Since Tbutton makes TtoolButton work, it must be an uninitialized variable, but I can't figure it out. How can any variable effect EM_HIDESELECTION ?

Code: Pascal  [Select][+][-]

1. procedure TCmdForm.DisplayPages(Sender: TObject);
2. var
3.   fr: TFormatRange;
4.   dc: THandle;
5.   ox, oy, w, h: LongInt;
6.   cpMin: LRESULT;
7.   x: Integer;
8.   PgWide, PgHigh, PgLft, PgRht, PgTop, PgBtm, InchW, InchH, ViewScale: double;
9.   PixHigh, PixWide, ViewChg, BegChar, PgCnt, PgSum: integer;
10.   MorePages: boolean;
11.   BackPages, xstr, PgStr: string;
12.  
13. begin
14.   // define paper size... these 7 can be global for paper size and display
15.   PgWide:= 8.5; PgHigh:= 11.0;
16.   PgLft:= 1.0; PgRht:= 1.0;
17.   PgTop:= 1.0; PgBtm:= 1.0;
18.   ViewScale:= 2; // display size: 10.5=double, 1.0=full, 2.0=half
19.  
20.   // setup the PaperArea metrics
21.   PaperArea.top:= 0;  // 40 fits my layout
22.   PaperArea.height:= Round(PgHigh * Screen.PixelsPerInch / ViewScale);
23.   PaperArea.width:= Round(PgWide * Screen.PixelsPerInch / ViewScale);
24.   PaperArea.left:= Round((PageMemo.width - PaperArea.width) / 2);  // centering view page
25.  
26.   // setup the TextArea metrics
27.   InchH:= PgHigh - PgTop - PgBtm;
28.   InchW:= PgWide - PgLft - PgRht;
29.   PixHigh:= Round(InchH * Screen.PixelsPerInch / ViewScale);
30.   PixWide:= Round(InchW * Screen.PixelsPerInch / ViewScale);
31.  
32.   // setup the TextArea position
33.   TextArea.Top:= Round((Screen.PixelsPerInch * PgTop) / ViewScale);
34.   TextArea.height:= PixHigh;
35.   TextArea.width:= PixWide;
36.   TextArea.left:= Round((Screen.PixelsPerInch * PgLft) / ViewScale);
37.   TextArea.Picture.Bitmap.SetSize(Round(PixWide * ViewScale), Round(PixHigh * ViewScale));
38.  
39.   // clear the image canvas
40.   TextArea.Canvas.Brush.Color:= clWindow;
41.   TextArea.Canvas.FillRect(0, 0, TextArea.Canvas.ClipRect.Right, TextArea.Canvas.ClipRect.Bottom);
42.   TextArea.Canvas.MoveTo(0, 0);
43.   cpMin:= 0;
44.  
45.   PaperArea.visible:= true;
46.   ScrollView.visible:= true;
47.  
48.   // set the printing metrics
49.   dc:= TextArea.Canvas.Handle;
50.   ox:= 0;  //GetDeviceCaps(dc, PHYSICALOFFSETX);
51.   oy:= 0;  //GetDeviceCaps(dc, PHYSICALOFFSETY);
52.   w:= XPixToTwips(Round(PixWide * ViewScale));  //GetDeviceCaps(dc, PHYSICALWIDTH);
53.   h:= YPixToTwips(Round(PixHigh * ViewScale));  //GetDeviceCaps(dc, PHYSICALHEIGHT);
54.   FillChar(fr, SizeOf(TFormatRange), 0);
55.   fr.hdc:= dc;       // fr._hdc := dc; **on another system**
56.   fr.hdcTarget:= dc;
57.   fr.rc.Left:= ox;
58.   fr.rc.Right:= ox+w;
59.   fr.rc.Top:= oy;
60.   fr.rc.Bottom:= oy+h; //
61.   fr.chrg.cpMin:= cpMin;
62.   SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
63.   SendMessage(PageMemo.Handle, EM_HIDESELECTION, 1, 0);  // hide selection
64.   SendMessage(PageMemo.Handle, EM_SETSEL, cpMin, -1);  // select to end of document
65.   SendMessage(PageMemo.Handle, EM_EXGETSEL, 0, LParam(@fr.chrg));  // copy selection
66.   SendMessage(PageMemo.Handle, EM_SETSEL, 0, 0);  // reset to no selection
67.   SendMessage(PageMemo.Handle, EM_HIDESELECTION, 0, 0); // show selection
68.  
69.   // get the page count
70.   cpMin:= 0; PgSum:= 0; MorePages:= true;
71.   while (fr.chrg.cpMin<=fr.chrg.cpMax) and (MorePages) do // track through document
72.         begin
73.         // clear the image canvas
74.         TextArea.Canvas.Brush.Color:= clWindow;
75.         TextArea.Canvas.FillRect(0, 0, TextArea.Canvas.ClipRect.Right, TextArea.Canvas.ClipRect.Bottom);
76.         TextArea.Canvas.MoveTo(0, 0);
77.  
78.         // set the printing metrics
79.         dc:= TextArea.Canvas.Handle;
80.         ox:= 0;  //GetDeviceCaps(dc, PHYSICALOFFSETX);
81.         oy:= 0;  //GetDeviceCaps(dc, PHYSICALOFFSETY);
82.         w:= XPixToTwips(Round(PixWide * ViewScale));  //GetDeviceCaps(dc, PHYSICALWIDTH);
83.         h:= YPixToTwips(Round(PixHigh * ViewScale));  //GetDeviceCaps(dc, PHYSICALHEIGHT);
84.         FillChar(fr, SizeOf(TFormatRange), 0);
85.         fr.hdc:= dc;       // fr._hdc := dc; **on another system**
86.         fr.hdcTarget:= dc;
87.         fr.rc.Left:= ox;
88.         fr.rc.Right:= ox+w;
89.         fr.rc.Top:= oy;
90.         fr.rc.Bottom:= oy+h; //
91.         fr.chrg.cpMin:= cpMin;
92.         SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
93.         SendMessage(PageMemo.Handle, EM_HIDESELECTION, 1, 0);  // hide selection
94.         SendMessage(PageMemo.Handle, EM_SETSEL, cpMin, -1);  // select to end of document
95.         SendMessage(PageMemo.Handle, EM_EXGETSEL, 0, LParam(@fr.chrg));  // copy selection
96.         SendMessage(PageMemo.Handle, EM_SETSEL, 0, 0);  // reset to no selection
97.         SendMessage(PageMemo.Handle, EM_HIDESELECTION, 0, 0); // show selection
98.  
99.         cpMin:= SendMessage(PageMemo.Handle, EM_FORMATRANGE, 1, LPARAM(@fr));
100.         SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
101.  
102.         if (fr.chrg.cpMin=fr.chrg.cpMax)
103.            then MorePages:= false
104.            else PgSum:= PgSum + 1;
105.         end;
106.  
107.   // print each page
108.   MorePages:= true; ViewChg:= 0; PgCnt:= 0;
109.   cpMin:= 0; BackPages:=''; BegChar:= 0;
110.  
111.   // clear the image canvas
112.   TextArea.Canvas.Brush.Color:= clWindow;
113.   TextArea.Canvas.FillRect(0, 0, TextArea.Canvas.ClipRect.Right, TextArea.Canvas.ClipRect.Bottom);
114.   TextArea.Canvas.MoveTo(0, 0);
115.  
116.   // set the printing metrics
117.   dc:= TextArea.Canvas.Handle;
118.   ox:= 0;  //GetDeviceCaps(dc, PHYSICALOFFSETX);
119.   oy:= 0;  //GetDeviceCaps(dc, PHYSICALOFFSETY);
120.   w:= XPixToTwips(Round(PixWide * ViewScale));  //GetDeviceCaps(dc, PHYSICALWIDTH);
121.   h:= YPixToTwips(Round(PixHigh * ViewScale));  //GetDeviceCaps(dc, PHYSICALHEIGHT);
122.   FillChar(fr, SizeOf(TFormatRange), 0);
123.   fr.hdc:= dc;       // fr._hdc := dc; **on another system**
124.   fr.hdcTarget:= dc;
125.   fr.rc.Left:= ox;
126.   fr.rc.Right:= ox+w;
127.   fr.rc.Top:= oy;
128.   fr.rc.Bottom:= oy+h; //
129.   fr.chrg.cpMin:= cpMin;
130.   SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
131.   SendMessage(PageMemo.Handle, EM_HIDESELECTION, 1, 0);  // hide selection
132.   SendMessage(PageMemo.Handle, EM_SETSEL, cpMin, -1);  // select to end of document
133.   SendMessage(PageMemo.Handle, EM_EXGETSEL, 0, LParam(@fr.chrg));  // copy selection
134.   SendMessage(PageMemo.Handle, EM_SETSEL, 0, 0);  // reset to no selection
135.   SendMessage(PageMemo.Handle, EM_HIDESELECTION, 0, 0); // show selection
136.  
137.   while (fr.chrg.cpMin<=fr.chrg.cpMax) and (MorePages) do // track through document
138.         begin
139.         if (ViewChg<0) then
140.            begin
141.            x:= pos(',',BackPages);
142.            if x>0 then delete(BackPages,1,x);
143.            x:= pos(',',BackPages);
144.            if x>0 then
145.               begin
146.               xstr:= copy(BackPages,1,x-1);
147.               delete(BackPages,1,x);
148.               cpMin:= StrToInt(xstr);
149.               PgCnt:= PgCnt - 2;
150.               if cpMin<0 then
151.                  begin
152.                  cpMin:= 0; BackPages:='';
153.                  PgCnt:= 0;
154.                  end;
155.               end else begin
156.                        cpMin:= 0; BackPages:='';
157.                        PgCnt:= 0;
158.                        end;
159.            end;
160.         BackPages:= IntToStr(cpMin)+','+BackPages; //showmessage(BackPages);
161.         ViewChg:= 0;
162.         BegChar:= cpMin; //showmessage(IntToStr(BegChar));
163.  
164.         // clear the image canvas
165.         TextArea.Canvas.Brush.Color:= clWindow;
166.         TextArea.Canvas.FillRect(0, 0, TextArea.Canvas.ClipRect.Right, TextArea.Canvas.ClipRect.Bottom);
167.         TextArea.Canvas.MoveTo(0, 0);
168.  
169.         // set the printing metrics
170.         dc:= TextArea.Canvas.Handle;
171.         ox:= 0;  //GetDeviceCaps(dc, PHYSICALOFFSETX);
172.         oy:= 0;  //GetDeviceCaps(dc, PHYSICALOFFSETY);
173.         w:= XPixToTwips(Round(PixWide * ViewScale));  //GetDeviceCaps(dc, PHYSICALWIDTH);
174.         h:= YPixToTwips(Round(PixHigh * ViewScale));  //GetDeviceCaps(dc, PHYSICALHEIGHT);
175.         FillChar(fr, SizeOf(TFormatRange), 0);
176.         fr.hdc:= dc;       // fr._hdc := dc; **on another system**
177.         fr.hdcTarget:= dc;
178.         fr.rc.Left:= ox;
179.         fr.rc.Right:= ox+w;
180.         fr.rc.Top:= oy;
181.         fr.rc.Bottom:= oy+h; //
182.         fr.chrg.cpMin:= cpMin;
183.         SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
184.         SendMessage(PageMemo.Handle, EM_HIDESELECTION, 1, 0); // hide selection
185.         SendMessage(PageMemo.Handle, EM_SETSEL, cpMin, -1);  // select to end of document
186.         SendMessage(PageMemo.Handle, EM_EXGETSEL, 0, LParam(@fr.chrg));  // copy selection
187.         SendMessage(PageMemo.Handle, EM_SETSEL, 0, 0);  // reset to no selection
188.         SendMessage(PageMemo.Handle, EM_HIDESELECTION, 0, 0); // show selection
189.  
190.         cpMin:= SendMessage(PageMemo.Handle, EM_FORMATRANGE, 1, LPARAM(@fr));
191.         SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
192.  
193.         if (cpMin<=fr.chrg.cpMin) then
194.             begin
195.              MorePages:= false; //  document has no content
196.              break;
197.             end;
198.  
199.         fr.chrg.cpMin:= cpMin;  // set to start of next page
200.         PgCnt:= PgCnt + 1;
201.  
202.         // begin modal dialogs
203.         if (PgSum>1) then
204.            begin
205.            PgStr:= 'Page '+IntToStr(PgCnt)+' of ';
206.            PgStr:= PgStr+IntToStr(PgSum)+' Pages';
207.            end else PgStr:= 'Single Page';
208.         if (PgSum=1) then // pause at only-page
209.            begin
210.            case QuestionDlg (PgStr,'No Navigation',mtCustom,
211.                             [mrCancel, 'Quit'],'') of
212.                 mrCancel: MorePages:= false;
213.                 end;
214.            end;
215.         if (BegChar=0) and (PgSum>1) then // pause at first-page
216.            begin
217.            case QuestionDlg (PgStr,'Navigation at Home',mtCustom,
218.                             [mrCancel, 'Quit', mrYes, 'Next'],'') of
219.                 mrCancel: MorePages:= false;
220.                 mrYes: ViewChg:= 1;
221.                 end;
222.            end  else if (fr.chrg.cpMin<fr.chrg.cpMax) then // pause at each-page
223.                      begin
224.                      case QuestionDlg (PgStr,'Page Navigation',mtCustom,
225.                                       [mrNo,'Back', mrCancel, 'Quit', mrYes, 'Next'],'') of
226.                           mrNo: ViewChg:= -1;
227.                           mrCancel: MorePages:= false;
228.                           mrYes: ViewChg:= 1;
229.                           end;
230.                      end;
231.         if (fr.chrg.cpMin=fr.chrg.cpMax) and (PgSum>1) then // pause at last-page
232.            begin
233.            case QuestionDlg (PgStr,'Navigation at End',mtCustom,
234.                              [mrNo,'Back', mrCancel, 'Quit'],'') of
235.                 mrNo: ViewChg:= -1;
236.                 mrCancel: MorePages:= false;
237.                 end;
238.            end;
239.         // end of modal dialogs
240.         end;
241.  
242.   // clean up
243.   SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
244.   if MorePages
245.      then EndDoc(fr.hdc) // close EM_FORMATRANGE
246.      else AbortDoc(fr.hdc);
247.   TextArea.Picture.Bitmap.Canvas.Changed;  // reset image event
248.   PaperArea.visible:= false;
249.   ScrollView.visible:= false;
250. end;  
251.  

Rick

Title: Re: PrintViewer
Post by: engkin on September 06, 2016, 08:58:08 pm

If you want to get rid of flickering, give LockWindowUpdate a try.

Title: Re: PrintViewer
Post by: engkin on September 07, 2016, 01:33:39 am

Rick, I don't see any flickering on my side. I replaced the dialogs with a simple:

Code: Pascal  [Select][+][-]

1.         Application.ProcessMessages;
2.         Sleep(200);

It could be your version of Lazarus that gives flickering.

As for TToolBtn, most likely the procedure is blocking the GUI thread. As you know, the arrangement you have now is just for testing. The GUI thread should not be trapped in DisplayPages procedure. Even for testing, it would be easier to have First, Previous, Next and Last buttons instead of dialogs.

Title: Re: PrintViewer
Post by: skalogryz on September 07, 2016, 03:24:53 am

Quote from: engkin on September 07, 2016, 01:33:39 am

Rick, I don't see any flickering on my side.

This is probably because you're not using Windows XP machine.
The WinAPI drawing process has been modified to use double-buffering, starting with Vista.

Title: Re: PrintViewer
Post by: engkin on September 07, 2016, 06:16:01 am

Quote from: skalogryz on September 07, 2016, 03:24:53 am

Quote from: engkin on September 07, 2016, 01:33:39 am

Rick, I don't see any flickering on my side.

This is probably because you're not using Windows XP machine.
The WinAPI drawing process has been modified to use double-buffering, starting with Vista.

You are right, it flickers because of WM_ERASEBKGND message handling in the panel (PaperArea). Erasing around the image and leaving the image rectangle area intact solved it on my side.

To test it quickly I hacked the TPanel class:

Code: Pascal  [Select][+][-]

1.   TPanel=class(ExtCtrls.TPanel)
2.   public
3.     DoNotEraseRect: TRect;
4.     procedure EraseBackground(DC: HDC); override;
5.   end;
6.  
7. ...
8.  
9. procedure TPanel.EraseBackground(DC: HDC);
10. var
11.   ARect: TRect;
12.   ABrush: HBrush;
13. begin
14.   if DC = 0 then Exit;
15.   if DoNotEraseRect.Right = 0 then
16.     Inherited
17.   else
18.   begin
19.     ABrush := HBRUSH(Brush.Reference.Handle);
20.  
21.     ARect := Types.Rect(0, 0, Width, DoNotEraseRect.Top);
22.     FillRect(DC, ARect, ABrush);
23.  
24.     ARect := Types.Rect(0, 0, DoNotEraseRect.Left,Height);
25.     FillRect(DC, ARect, ABrush);
26.  
27.     ARect := Types.Rect(DoNotEraseRect.Right, 0, Width, Height);
28.     FillRect(DC, ARect, ABrush);
29.  
30.     ARect := Types.Rect(0, DoNotEraseRect.Bottom, Width, Height);
31.     FillRect(DC, ARect, ABrush);
32.   end;
33. end;

Specifing the area in the DisplayPages procedure after setting TextArea position and dimensions:

Code: Pascal  [Select][+][-]

1.     PaperArea.DoNotEraseRect := TextArea.BoundsRect;

@Rick, test it and if it solves your problem then use the proper way.

I don't think calling TextArea.Canvas.FillRect is needed.

Title: Re: PrintViewer
Post by: rick2691 on September 07, 2016, 01:41:59 pm

I have noticed the edges flicker, but what I meant by flicker and flash was the EM_FORMATRANGE loop, as it selected each RichMemo text. It is highlighting the selection, and also scrolling RichMemo to the end of the document. Which (PageMemo.Handle, EM_HIDESELECTION, 1, 0) is supposed to suppress.

But as you noted... getting out of the modal loop may solve everything.

Rick

Title: Re: PrintViewer
Post by: rick2691 on September 07, 2016, 07:37:16 pm

OK. No more modal loop. This version works with all buttons and menus, but the EM_HIDESELECTION is still disfunctional. It doesn't hide the highlighting of selections.

So I have kept the Memo shield. It is called ScrollView (a TScrollBox). It is set to alClient, masking the entire memo. Eventually it will be used for zooming, so maybe I don't care about EM_HIDESELECTION... except that it might be slowing the process down.

The PaperArea panel has three Tbuttons (Back, Quit, and Next) for navigation. Then it also has a TStaticText called PageMonitor for posting page number and total pages.

Code: Pascal  [Select][+][-]

1. // globals
2. var cpMin, PixH, PixW: longint;
3.     ViewScale: double;
4.     dc: THandle;
5.     fr: TFormatRange;
6.     ox, oy, w, h: LongInt;
7.     MorePages: boolean;
8.     BackPages: string;
9.     PgCnt, PgSum: integer;
10.  
11. function XPixToTwips(px: integer): integer;
12. var
13.   dc: THandle;
14. begin
15.   dc:= GetDC(HWND_DESKTOP);
16.   Result:= Round(1440*px/GetDeviceCaps(dc, LOGPIXELSX));
17.   ReleaseDC(HWND_DESKTOP, dc);
18. end;
19.  
20. function YPixToTwips(px: integer): integer;
21. var
22.   dc: THandle;
23. begin
24.   dc:= GetDC(HWND_DESKTOP);
25.   Result:= Round(1440*px/GetDeviceCaps(dc, LOGPIXELSY));
26.   ReleaseDC(HWND_DESKTOP, dc);
27. end;
28.  
29. procedure TCmdForm.SetupViewPage(BegPos, EndPos: longint);
30. begin
31.   // clear the image canvas
32.   TextArea.Canvas.Brush.Color:= clWindow;
33.   TextArea.Canvas.FillRect(0, 0, TextArea.Canvas.ClipRect.Right, TextArea.Canvas.ClipRect.Bottom);
34.   TextArea.Canvas.MoveTo(0, 0);
35.  
36.   // set the printing metrics
37.   dc:= TextArea.Canvas.Handle;
38.   ox:= 0;  //GetDeviceCaps(dc, PHYSICALOFFSETX);
39.   oy:= 0;  //GetDeviceCaps(dc, PHYSICALOFFSETY);
40.   w:= XPixToTwips(Round(PixW * ViewScale));  //GetDeviceCaps(dc, PHYSICALWIDTH);
41.   h:= YPixToTwips(Round(PixH * ViewScale));  //GetDeviceCaps(dc, PHYSICALHEIGHT);
42.   FillChar(fr, SizeOf(TFormatRange), 0);
43.   fr.hdc:= dc;       // fr._hdc:= dc; **on some systems**
44.   fr.hdcTarget:= dc;
45.   fr.rc.Left:= ox;
46.   fr.rc.Right:= ox+w;
47.   fr.rc.Top:= oy;
48.   fr.rc.Bottom:= oy+h;
49.   fr.chrg.cpMin:= BegPos; // set to 0 for start of document
50.   fr.chrg.cpMax:= EndPos; // set to -1 for end of document
51.  
52.   // get document content
53.   SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
54.   SendMessage(PageMemo.Handle, EM_HIDESELECTION, 1, 0); // hide selection
55.   SendMessage(PageMemo.Handle, EM_SETSEL, BegPos, EndPos);  // select to end of document
56.   SendMessage(PageMemo.Handle, EM_EXGETSEL, 0, LParam(@fr.chrg));  // copy selection
57.   SendMessage(PageMemo.Handle, EM_SETSEL, 0, 0);  // reset to no selection
58.   SendMessage(PageMemo.Handle, EM_HIDESELECTION, 0, 0); // show selection
59. end;
60.  
61. procedure TCmdForm.btnViewClick(Sender: TObject);
62. begin
63.   PaperArea.visible:= true;
64.   ScrollView.visible:= true;
65.   SetupViewPage(0, -1);
66.   PostFirstPage(self);
67. end;
68.  
69. procedure TCmdForm.btnViewBackClick(Sender: TObject);
70. var xstr: string;
71.     x: integer;
72. begin
73.    x:= pos(',',BackPages);
74.    if x>0 then delete(BackPages,1,x);  // delete next page reference
75.  
76.    x:= pos(',',BackPages);
77.    if x>0 then
78.       begin
79.       xstr:= copy(BackPages,1,x-1);
80.       delete(BackPages,1,x);          // delete current page reference
81.       cpMin:= StrToInt(xstr);
82.       PgCnt:= PgCnt - 2;
83.       if cpMin<0 then
84.          begin
85.          cpMin:= 0; BackPages:='0,';
86.          PgCnt:= 0;
87.          end;
88.       end else begin
89.                cpMin:= 0; BackPages:='0,';
90.                PgCnt:= 0;
91.                end;
92.  
93.   if PgCnt<0 then PgCnt:= 0;
94.   PostNewPage;
95. end;
96.  
97. procedure TCmdForm.btnViewNextClick(Sender: TObject);
98. begin
99.   PostNewPage;
100. end;
101.  
102. procedure TCmdForm.btnViewQuitClick(Sender: TObject);
103. begin
104.   // clean up
105.   SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
106.   if MorePages
107.      then EndDoc(fr.hdc) // close EM_FORMATRANGE
108.      else AbortDoc(fr.hdc);
109.   TextArea.Picture.Bitmap.Canvas.Changed;  // reset image event
110.   PaperArea.visible:= false;
111.   ScrollView.visible:= false;
112. end;
113.  
114. procedure TCmdForm.PostNewPage;
115. var PgStr: string;
116. begin
117.   if PgCnt<PgSum then
118.      begin
119.       SetupViewPage(cpMin, -1);
120.       BackPages:= IntToStr(cpMin)+','+BackPages;
121.       cpMin:= SendMessage(PageMemo.Handle, EM_FORMATRANGE, 1, LPARAM(@fr));
122.       SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
123.       fr.chrg.cpMin:= cpMin;
124.       PgCnt:= PgCnt + 1;
125.  
126.      end;
127.   PgStr:= 'Page '+IntToStr(PgCnt)+' of ';
128.   PgStr:= PgStr+IntToStr(PgSum);
129.   PageMonitor.caption:= PgStr;
130. end;
131.  
132. procedure TCmdForm.PostFirstPage(Sender: TObject);
133. var
134.   PgWide, PgHigh, PgLft, PgRht, PgTop, PgBtm, InchW, InchH: double;
135.   PgStr: string;
136.  
137. begin
138.   // define paper size... these 7 can be global for paper size and display
139.   PgWide:= 8.5; PgHigh:= 11.0;
140.   PgLft:= 1.0; PgRht:= 1.0;
141.   PgTop:= 1.0; PgBtm:= 1.0;
142.   ViewScale:= 2; // display size: 10.5=double, 1.0=full, 2.0=half
143.  
144.   // setup the PaperArea metrics
145.   PaperArea.top:= 0;  // 0 or 40 fits my layout
146.   PaperArea.height:= Round(PgHigh * Screen.PixelsPerInch / ViewScale);
147.   PaperArea.width:= Round(PgWide * Screen.PixelsPerInch / ViewScale);
148.   PaperArea.left:= Round((PageMemo.width - PaperArea.width) / 2);  // centering view page
149.  
150.   // setup the TextArea metrics
151.   InchH:= PgHigh - PgTop - PgBtm;
152.   InchW:= PgWide - PgLft - PgRht;
153.   PixH:= Round(InchH * Screen.PixelsPerInch / ViewScale);
154.   PixW:= Round(InchW * Screen.PixelsPerInch / ViewScale);
155.  
156.   // setup the TextArea position
157.   TextArea.Top:= Round((Screen.PixelsPerInch * PgTop) / ViewScale);
158.   TextArea.height:= PixH;
159.   TextArea.width:= PixW;
160.   TextArea.left:= Round((Screen.PixelsPerInch * PgLft) / ViewScale);
161.   TextArea.Picture.Bitmap.SetSize(Round(PixW * ViewScale), Round(PixH * ViewScale));
162.  
163.   // get total page count
164.   SetupViewPage(0, -1);
165.   cpMin:= 0; PgSum:= 0; MorePages:= true;
166.   while (fr.chrg.cpMin<=fr.chrg.cpMax) and (MorePages) do // track through document
167.         begin
168.         SetupViewPage(cpMin, -1);
169.         cpMin:= SendMessage(PageMemo.Handle, EM_FORMATRANGE, 1, LPARAM(@fr));
170.         SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
171.         fr.chrg.cpMin:= cpMin;
172.         PgSum:= PgSum + 1;
173.         if (fr.chrg.cpMin=fr.chrg.cpMax)
174.            then MorePages:= false;
175.         end;
176.  
177.   // print first page
178.   MorePages:= true; PgCnt:= 0;
179.   cpMin:= 0; BackPages:='';
180.  
181.   BackPages:= IntToStr(cpMin)+','+BackPages; //showmessage(BackPages);
182.   SetupViewPage(cpMin, -1);
183.  
184.   cpMin:= SendMessage(PageMemo.Handle, EM_FORMATRANGE, 1, LPARAM(@fr));
185.   SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
186.  
187.   fr.chrg.cpMin:= cpMin;  // set to start of next page
188.   PgCnt:= PgCnt + 1;
189.  
190.   PgStr:= 'Page '+IntToStr(PgCnt)+' of ';
191.   PgStr:= PgStr+IntToStr(PgSum);
192.   PageMonitor.caption:= PgStr;
193. end;  
194.  

It is much healthier now. Thanks for prodding me to revise the procedure.

Rick

Title: Re: PrintViewer
Post by: rick2691 on September 07, 2016, 08:26:48 pm

Just a note. I tested this with an inline image. It showed the image, but there still isn't a way to save the image with the file.

Rick.

Title: Re: PrintViewer
Post by: engkin on September 08, 2016, 04:52:18 am

It looks much better. You really did a great job here.

It is natural to move the global vars and all these procedures to a class in a separate unit. This way you can reuse this code in another place or in a totally different project.

Quote from: rick2691 on September 07, 2016, 01:41:59 pm

what I meant by flicker and flash was the EM_FORMATRANGE loop, as it selected each RichMemo text. It is highlighting the selection, and also scrolling RichMemo to the end of the document. Which (PageMemo.Handle, EM_HIDESELECTION, 1, 0) is supposed to suppress.

On my side EM_FORMATRANGE does not scroll the RichMemo nor does it highlight the selection. I just tested EM_HIDESELECTION with two buttons:

Code: Pascal  [Select][+][-]

1. procedure TCmdForm.HideSelectBtnClick(Sender: TObject);
2. begin
3.   SendMessage(PageMemo.Handle, EM_HIDESELECTION, 1, 0);
4. end;
5.  
6. procedure TCmdForm.ShowSelectionBtnClick(Sender: TObject);
7. begin
8.   SendMessage(PageMemo.Handle, EM_HIDESELECTION, 0, 0);
9. end;

It seems to work on my side. Test it and let us know. Notice that I did not install the package, as I don't use it. For testing I create the RichMemo in code:

Code: Pascal  [Select][+][-]

1.   PageMemo := TRichMemo.Create(Self);
2.   PageMemo.Left := 300;
3.   PageMemo.Height := 600;
4.   PageMemo.Width := 600;
5.   PageMemo.ScrollBars := ssAutoBoth;
6.   PageMemo.Parent := Self;

I doubt this difference has any effect, but just in case thought to mention it.

You can use WM_SETREDRAW to pause/resume drawing of the RichMemo.

Title: Re: PrintViewer
Post by: rick2691 on September 08, 2016, 01:38:31 pm

What is happening on my end must be a Windows XP thing. WM_SETREDRAW sounds like it might help.

I have made a name change to the initial function that starts the Page Review. It is btnViewPagesClick. I thought it made it more recognizable against the other buttons that are available.

This update also employs a Zoom button that toggles between half and full size viewing. In full mode it allows for scrolling, and the application can always be moved from its launch size to full screen to not have to scroll.

I have attached a

Code: Pascal  [Select][+][-]

1. // globals
2. var cpMin, PixH, PixW: longint;
3.     ViewScale: double;
4.     dc: THandle;
5.     fr: TFormatRange;
6.     ox, oy, w, h: LongInt;
7.     MorePages: boolean;
8.     BackPages,TotalPages: widestring;
9.     PgCnt, PgSum: integer;
10.  
11. function XPixToTwips(px: integer): integer;
12. var
13.   dc: THandle;
14. begin
15.   dc:= GetDC(HWND_DESKTOP);
16.   Result:= Round(1440*px/GetDeviceCaps(dc, LOGPIXELSX));
17.   ReleaseDC(HWND_DESKTOP, dc);
18. end;
19.  
20. function YPixToTwips(px: integer): integer;
21. var
22.   dc: THandle;
23. begin
24.   dc:= GetDC(HWND_DESKTOP);
25.   Result:= Round(1440*px/GetDeviceCaps(dc, LOGPIXELSY));
26.   ReleaseDC(HWND_DESKTOP, dc);
27. end;
28.  
29. procedure TCmdForm.SetupViewPage(BegPos, EndPos: longint);
30. begin
31.   // clear the image canvas
32.   TextArea.Canvas.Brush.Color:= clWindow;
33.   TextArea.Canvas.FillRect(0, 0, TextArea.Canvas.ClipRect.Right, TextArea.Canvas.ClipRect.Bottom);
34.   TextArea.Canvas.MoveTo(0, 0);
35.  
36.   // set the printing metrics
37.   dc:= TextArea.Canvas.Handle;
38.   ox:= 0;  //GetDeviceCaps(dc, PHYSICALOFFSETX);
39.   oy:= 0;  //GetDeviceCaps(dc, PHYSICALOFFSETY);
40.   w:= XPixToTwips(Round(PixW * ViewScale));  //GetDeviceCaps(dc, PHYSICALWIDTH);
41.   h:= YPixToTwips(Round(PixH * ViewScale));  //GetDeviceCaps(dc, PHYSICALHEIGHT);
42.   FillChar(fr, SizeOf(TFormatRange), 0);
43.   fr.hdc:= dc;       // fr._hdc:= dc; **on some systems**
44.   fr.hdcTarget:= dc;
45.   fr.rc.Left:= ox;
46.   fr.rc.Right:= ox+w;
47.   fr.rc.Top:= oy;
48.   fr.rc.Bottom:= oy+h;
49.   fr.chrg.cpMin:= BegPos; // set to 0 for start of document
50.   fr.chrg.cpMax:= EndPos; // set to -1 for end of document
51.  
52.   // get document content
53.   SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
54.   SendMessage(PageMemo.Handle, EM_HIDESELECTION, 1, 0); // hide selection
55.   SendMessage(PageMemo.Handle, EM_SETSEL, BegPos, EndPos);  // select to end of document
56.   SendMessage(PageMemo.Handle, EM_EXGETSEL, 0, LParam(@fr.chrg));  // copy selection
57.   SendMessage(PageMemo.Handle, EM_SETSEL, 0, 0);  // reset to no selection
58.   SendMessage(PageMemo.Handle, EM_HIDESELECTION, 0, 0); // show selection
59. end;
60.  
61. procedure TCmdForm.CountPages;
62. begin
63. // get total page count
64.   SetupViewPage(0, -1);
65.   cpMin:= 0; PgSum:= 0; PgCnt:= 0; MorePages:= true; TotalPages:= '';
66.   while (fr.chrg.cpMin<=fr.chrg.cpMax) and (MorePages) do // track through document
67.         begin
68.         SetupViewPage(cpMin, -1);
69.         PgCnt:= PgCnt + 1;
70.         if PgCnt=1  // start=@ medial=# close=*
71.            then TotalPages:= '@'+IntToStr(PgCnt)+':'+IntToStr(cpMin)+','+TotalPages // beg - 1
72.            else TotalPages:= '#'+IntToStr(PgCnt)+':'+IntToStr(cpMin)+','+TotalPages;
73.         cpMin:= SendMessage(PageMemo.Handle, EM_FORMATRANGE, 1, LPARAM(@fr));
74.         SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
75.         fr.chrg.cpMin:= cpMin;
76.         PgSum:= PgSum + 1;
77.         if (fr.chrg.cpMin=fr.chrg.cpMax)
78.            then MorePages:= false;
79.         end;
80.   TotalPages:= '*'+IntToStr(PgCnt)+':'+IntToStr(cpMin)+','+TotalPages; // end + 1
81.   //showmessage(TotalPages);
82. end;
83.  
84. procedure TCmdForm.ConfigureView;
85. var
86.   PgWide, PgHigh, PgLft, PgRht, PgTop, PgBtm, InchW, InchH: double;
87.   PgCnt: longint;
88. begin
89.   // define paper size... these 7 can be global for paper size and display
90.   PgWide:= 8.5; PgHigh:= 11.0;  // US Letter Size
91.   PgLft:= 1.0; PgRht:= 1.0;
92.   PgTop:= 1.0; PgBtm:= 1.0;
93.  
94.   // setup the PaperArea metrics
95.   PaperArea.top:= 0;  // 0 or 40 fits my layout
96.   PaperArea.height:= Round(PgHigh * Screen.PixelsPerInch / ViewScale);
97.   PaperArea.width:= Round(PgWide * Screen.PixelsPerInch / ViewScale);
98.   PaperArea.left:= Round((PageMemo.width - PaperArea.width) / 2);  // centering view page
99.   if PaperArea.left<0 then PaperArea.left:= 0;
100.  
101.   // setup the TextArea metrics
102.   InchH:= PgHigh - PgTop - PgBtm;
103.   InchW:= PgWide - PgLft - PgRht;
104.   PixH:= Round(InchH * Screen.PixelsPerInch / ViewScale);
105.   PixW:= Round(InchW * Screen.PixelsPerInch / ViewScale);
106.  
107.   // setup the TextArea position
108.   TextArea.Top:= Round((Screen.PixelsPerInch * PgTop) / ViewScale);
109.   TextArea.height:= PixH;
110.   TextArea.width:= PixW;
111.   TextArea.left:= Round((Screen.PixelsPerInch * PgLft) / ViewScale);
112.   TextArea.Picture.Bitmap.SetSize(Round(PixW * ViewScale), Round(PixH * ViewScale));
113. end;
114.  
115. procedure TCmdForm.btnViewPagesClick(Sender: TObject);
116. begin
117.   PaperArea.visible:= true;
118.   ScrollView.visible:= true;
119.   SetupViewPage(0, -1);
120.   PostFirstPage;
121. end;
122.  
123. procedure TCmdForm.btnViewZoomClick(Sender: TObject);
124. begin
125.   if ViewScale>1.5           // zoom toggle between full and half
126.      then ViewScale:= 1.0
127.      else ViewScale:= 2.0;
128.   ConfigureView;
129. end;
130.  
131. procedure TCmdForm.btnViewBackClick(Sender: TObject);
132. var xstr: string;
133.     x: integer;
134. begin
135.    x:= pos(',',BackPages);
136.    if x>0 then delete(BackPages,1,x);  // delete next page reference
137.  
138.    x:= pos(',',BackPages);
139.    if x>0 then
140.       begin
141.       xstr:= copy(BackPages,1,x-1);
142.       delete(BackPages,1,x);          // delete current page reference
143.       cpMin:= StrToInt(xstr);
144.       PgCnt:= PgCnt - 2;
145.       if cpMin<0 then
146.          begin
147.          cpMin:= 0; BackPages:='0,';
148.          PgCnt:= 0;
149.          end;
150.       end else begin
151.                cpMin:= 0; BackPages:='0,';
152.                PgCnt:= 0;
153.                end;
154.  
155.   if PgCnt<0 then PgCnt:= 0;
156.   PostNewPage;
157. end;
158.  
159. procedure TCmdForm.btnViewNextClick(Sender: TObject);
160. begin
161.   PostNewPage;
162. end;
163.  
164. procedure TCmdForm.btnViewQuitClick(Sender: TObject);
165. begin
166.   // clean up
167.   SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
168.   if MorePages
169.      then EndDoc(fr.hdc) // close EM_FORMATRANGE
170.      else AbortDoc(fr.hdc);
171.   TextArea.Picture.Bitmap.Canvas.Changed;  // reset image event
172.   PaperArea.visible:= false;
173.   ScrollView.visible:= false;
174. end;
175.  
176. procedure TCmdForm.PostNewPage;
177. var PgStr: string;
178. begin
179.   if PgCnt<PgSum then
180.      begin
181.       SetupViewPage(cpMin, -1);
182.       BackPages:= IntToStr(cpMin)+','+BackPages;
183.       cpMin:= SendMessage(PageMemo.Handle, EM_FORMATRANGE, 1, LPARAM(@fr));
184.       SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
185.       fr.chrg.cpMin:= cpMin;
186.       PgCnt:= PgCnt + 1;
187.  
188.      end;
189.   PgStr:= 'Page '+IntToStr(PgCnt)+' of ';
190.   PgStr:= PgStr+IntToStr(PgSum);
191.   PageMonitor.caption:= PgStr;
192. end;
193.  
194. procedure TCmdForm.PostFirstPage;
195. var
196.   PgStr: string;
197. begin
198.   ViewScale:= 2.0; // display size: 10.5=double, 1.0=full, 2.0=half
199.   ConfigureView;
200.   CountPages;
201.  
202.   MorePages:= true; PgCnt:= 0;
203.   cpMin:= 0; BackPages:='';
204.   BackPages:= IntToStr(cpMin)+','+BackPages; //showmessage(BackPages);
205.   SetupViewPage(cpMin, -1);
206.   cpMin:= SendMessage(PageMemo.Handle, EM_FORMATRANGE, 1, LPARAM(@fr));
207.   SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
208.   fr.chrg.cpMin:= cpMin;  // set to start of next page
209.   PgCnt:= PgCnt + 1;
210.  
211.   PgStr:= 'Page '+IntToStr(PgCnt)+' of ';
212.   PgStr:= PgStr+IntToStr(PgSum);
213.   PageMonitor.caption:= PgStr;
214. end;
215.  

Rick

Title: Re: PrintViewer
Post by: engkin on September 09, 2016, 04:42:21 am

Rick, it is delightful to see that image. Thanks for sharing.

Quote from: rick2691 on September 07, 2016, 08:26:48 pm

I tested this with an inline image. It showed the image, but there still isn't a way to save the image with the file.

I suggest that you create another thread if you are still looking for a solution to save/load the images with files.

It basically needs an interface. Specifically IRichEditOleCallback interface. You pass an instance to the rich edit using EM_SETOLECALLBACK message.

For reading images it needs two functions implemented GetNewStorage and QueryInsertObject. One is to allocate space for the parsed images, while the other is to ask if you want to show the image. The rest of the interface functions can return E_NOTIMPL.

As for writing, I just tested EM_STREAMOUT. It embedded the image in the file successfully.

Title: Re: PrintViewer
Post by: rick2691 on September 09, 2016, 03:41:50 pm

engkin,

Thanks for the information. It should get me started. I will start a new post after I have worked with it a little.

Currently, I have have employed a more flexible method for accessing pages. I build a PageMap at the start. It is a string that has encoded markers. I am an old LISP programmer.

I have also switched to TBitBtn's and a panel that can be shifted to center page when zooming. As is, everything is pretty much worked out, except for printing by page selection.

Code: Pascal  [Select][+][-]

1. // globals
2. var cpMin, PixH, PixW: longint;
3.     ViewScale: double;
4.     dc: THandle;
5.     fr: TFormatRange;
6.     ox, oy, w, h: LongInt;
7.     MorePages: boolean;
8.     PageMap: widestring;
9.     PgCnt, PgSum: integer;
10.  
11. function XPixToTwips(px: integer): integer;
12. var
13.   dc: THandle;
14. begin
15.   dc:= GetDC(HWND_DESKTOP);
16.   Result:= Round(1440*px/GetDeviceCaps(dc, LOGPIXELSX));
17.   ReleaseDC(HWND_DESKTOP, dc);
18. end;
19.  
20. function YPixToTwips(px: integer): integer;
21. var
22.   dc: THandle;
23. begin
24.   dc:= GetDC(HWND_DESKTOP);
25.   Result:= Round(1440*px/GetDeviceCaps(dc, LOGPIXELSY));
26.   ReleaseDC(HWND_DESKTOP, dc);
27. end;
28.  
29. procedure TCmdForm.SetupViewPage(BegPos, EndPos: longint);
30. begin
31.   // clear the image canvas
32.   TextArea.Canvas.Brush.Color:= clWindow;
33.   TextArea.Canvas.FillRect(0, 0, TextArea.Canvas.ClipRect.Right, TextArea.Canvas.ClipRect.Bottom);
34.   TextArea.Canvas.MoveTo(0, 0);
35.  
36.   // set the printing metrics
37.   dc:= TextArea.Canvas.Handle;
38.   ox:= 0;  //GetDeviceCaps(dc, PHYSICALOFFSETX);
39.   oy:= 0;  //GetDeviceCaps(dc, PHYSICALOFFSETY);
40.   w:= XPixToTwips(Round(PixW * ViewScale));  //GetDeviceCaps(dc, PHYSICALWIDTH);
41.   h:= YPixToTwips(Round(PixH * ViewScale));  //GetDeviceCaps(dc, PHYSICALHEIGHT);
42.   FillChar(fr, SizeOf(TFormatRange), 0);
43.   fr.hdc:= dc;       // fr._hdc:= dc; **on some systems**
44.   fr.hdcTarget:= dc;
45.   fr.rc.Left:= ox;
46.   fr.rc.Right:= ox+w;
47.   fr.rc.Top:= oy;
48.   fr.rc.Bottom:= oy+h;
49.   fr.chrg.cpMin:= BegPos; // set to 0 for start of document
50.   fr.chrg.cpMax:= EndPos; // set to -1 for end of document
51.  
52.   // get document content
53.   SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
54.   SendMessage(PageMemo.Handle, EM_HIDESELECTION, 1, 0); // hide selection
55.   SendMessage(PageMemo.Handle, EM_SETSEL, BegPos, EndPos);  // select to end of document
56.   SendMessage(PageMemo.Handle, EM_EXGETSEL, 0, LParam(@fr.chrg));  // copy selection
57.   SendMessage(PageMemo.Handle, EM_SETSEL, 0, 0);  // reset to no selection
58.   SendMessage(PageMemo.Handle, EM_HIDESELECTION, 0, 0); // show selection
59. end;
60.  
61. procedure TCmdForm.CountPages;
62. var x,p: longint;
63. begin
64. // get total page count
65.   SetupViewPage(0, -1);
66.   cpMin:= 0; PgSum:= 0; p:= 0; MorePages:= true; PageMap:= '';
67.   while (fr.chrg.cpMin<=fr.chrg.cpMax) and (MorePages) do // track through document
68.         begin
69.         SetupViewPage(cpMin, -1);
70.         p:= p + 1;
71.         PageMap:= '#'+IntToStr(p)+':'+IntToStr(cpMin)+','+PageMap;
72.         cpMin:= SendMessage(PageMemo.Handle, EM_FORMATRANGE, 1, LPARAM(@fr));
73.         SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
74.         fr.chrg.cpMin:= cpMin;
75.         PgSum:= PgSum + 1;
76.         if (fr.chrg.cpMin=fr.chrg.cpMax)
77.            then MorePages:= false;
78.         end;
79.   PageMap:= '*'+IntToStr(p)+':'+IntToStr(cpMin)+','+PageMap; // end + 1
80.   for x:=1 to PgSum do ViewPageList.Items.Add(IntToStr(x));
81. end;
82.  
83. procedure TCmdForm.ConfigureView;
84. var
85.   PgWide, PgHigh, PgLft, PgRht, PgTop, PgBtm, InchW, InchH: double;
86. begin
87.   // define paper size... these 6 can be global for paper size and display
88.   PgWide:= 8.5; PgHigh:= 11.0;  // US Letter Size
89.   PgLft:= 1.0; PgRht:= 1.0;
90.   PgTop:= 1.0; PgBtm:= 1.0;
91.  
92.   // setup the PaperArea metrics
93.   PaperArea.top:= 0;  // 0 or 40 fits my layout
94.   PaperArea.height:= Round(PgHigh * Screen.PixelsPerInch / ViewScale);
95.   PaperArea.width:= Round(PgWide * Screen.PixelsPerInch / ViewScale);
96.   PaperArea.left:= Round((PageMemo.width - PaperArea.width) / 2);  // centering view page
97.   if PaperArea.left<0 then PaperArea.left:= 0;
98.  
99.   // setup the TextArea metrics
100.   InchH:= PgHigh - PgTop - PgBtm;
101.   InchW:= PgWide - PgLft - PgRht;
102.   PixH:= Round(InchH * Screen.PixelsPerInch / ViewScale);
103.   PixW:= Round(InchW * Screen.PixelsPerInch / ViewScale);
104.  
105.   // setup the TextArea position
106.   TextArea.Top:= Round((Screen.PixelsPerInch * PgTop) / ViewScale);
107.   TextArea.height:= PixH;
108.   TextArea.width:= PixW;
109.   TextArea.left:= Round((Screen.PixelsPerInch * PgLft) / ViewScale);
110.   TextArea.Picture.Bitmap.SetSize(Round(PixW * ViewScale), Round(PixH * ViewScale));
111. end;
112.  
113. procedure TCmdForm.GetPageMap;
114. var PgSel,GetStr: string;
115.     x,s: integer;
116. begin
117.   PgSel:= IntToStr(PgCnt);
118.   GetStr:= '#'+PgSel+':';
119.   x:= pos(GetStr,PageMap);
120.   s:= length(PageMap);
121.   if x>0 then
122.      begin
123.      GetStr:= copy(PageMap,x,s-x+1);
124.      x:= pos(':',GetStr);
125.      delete(GetStr,1,x);
126.      x:= pos(',',GetStr);
127.      GetStr:= copy(GetStr,1,x-1);
128.      cpMin:= StrToInt(GetStr);
129.      end;
130. end;
131.  
132. procedure TCmdForm.btnViewPagesClick(Sender: TObject);
133. begin
134.   PaperArea.visible:= true;
135.   ScrollView.visible:= true;
136.   SetupViewPage(0, -1);
137.   PostFirstPage;
138. end;
139.  
140. procedure TCmdForm.btnViewZoomClick(Sender: TObject);
141. begin
142.   if ViewScale>1.5           // zoom toggle between full and half
143.      then ViewScale:= 1.0
144.      else ViewScale:= 2.0;
145.   ConfigureView;
146.   NavPanel.left:= Round((PaperArea.width - NavPanel.width) / 2);
147. end;
148.  
149. procedure TCmdForm.btnViewBegClick(Sender: TObject);
150. var PgSel,GetStr: string;
151.     x,s: integer;
152. begin
153.   PgCnt:= 1;
154.   GetPageMap;
155.   PostNewPage;
156. end;
157.  
158. procedure TCmdForm.btnViewEndClick(Sender: TObject);
159. var PgSel,GetStr: string;
160.     x,s: integer;
161. begin
162.   PgCnt:= PgSum;
163.   GetPageMap;
164.   PostNewPage;
165. end;
166.  
167. procedure TCmdForm.btnViewPrtClick(Sender: TObject);
168. begin
169.   // no built
170. end;
171.  
172. procedure TCmdForm.btnViewBckClick(Sender: TObject);
173. var PgSel,GetStr: string;
174.     x,s: integer;
175. begin
176.   PgCnt:= PgCnt - 1;
177.   if PgCnt<1 then PgCnt:= 1;
178.   GetPageMap;
179.   PostNewPage;
180. end;
181.  
182. procedure TCmdForm.btnViewNxtClick(Sender: TObject);
183.  
184. begin
185.   PgCnt:= PgCnt + 1;
186.   if PgCnt>PgSum then PgCnt:= PgSum;
187.   GetPageMap;
188.   PostNewPage;
189. end;
190.  
191. procedure TCmdForm.btnViewQuitClick(Sender: TObject);
192. begin
193.   // clean up
194.   SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
195.   if MorePages
196.      then EndDoc(fr.hdc) // close EM_FORMATRANGE
197.      else AbortDoc(fr.hdc);
198.   TextArea.Picture.Bitmap.Canvas.Changed;  // reset image event
199.   PaperArea.visible:= false;
200.   ScrollView.visible:= false;
201. end;
202.  
203. procedure TCmdForm.ViewPageListEditingDone(Sender: TObject);
204. begin
205.   ViewPageListSelect(self)
206. end;
207.  
208. procedure TCmdForm.ViewPageListSelect(Sender: TObject);
209. var PgSel,GetStr: string;
210.     x,s,p: integer;
211. begin
212.   PgSel:= ViewPageList.Text;
213.   PgCnt:= StrToInt(PgSel);
214.   GetPageMap;
215.   PostNewPage;
216. end;
217.  
218. procedure TCmdForm.PostNewPage;
219. var PgStr: string;
220. begin
221.   SetupViewPage(cpMin, -1);
222.   cpMin:= SendMessage(PageMemo.Handle, EM_FORMATRANGE, 1, LPARAM(@fr));
223.   SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
224.   fr.chrg.cpMin:= cpMin;
225.  
226.   PgStr:= 'Page '+IntToStr(PgCnt)+' of ';
227.   PgStr:= PgStr+IntToStr(PgSum);
228.   PageMonitor.caption:= PgStr;
229. end;
230.  
231. procedure TCmdForm.PostFirstPage;
232. var
233.   PgStr: string;
234. begin
235.   ViewScale:= 2.0; // display size: 10.5=double, 1.0=full, 2.0=half
236.   ConfigureView;
237.   CountPages;
238.  
239.   MorePages:= true;
240.   cpMin:= 0;
241.   SetupViewPage(cpMin, -1);
242.   cpMin:= SendMessage(PageMemo.Handle, EM_FORMATRANGE, 1, LPARAM(@fr));
243.   SendMessage(PageMemo.Handle, EM_FORMATRANGE, 0, 0); // clear EM_FORMATRANGE
244.   fr.chrg.cpMin:= cpMin;  // set to start of next page
245.  
246.   PgCnt:= 1;
247.   PgStr:= 'Page '+IntToStr(PgCnt)+' of ';
248.   PgStr:= PgStr+IntToStr(PgSum);
249.   PageMonitor.caption:= PgStr;
250.   ViewPageList.Text:= '1';
251. end;
252.  

Thanks for all your help, and the same to others who have contributed.

Rick