1
私はRichEditをページの一部を表すフォームに配置しました。 「ページ」のサイズは、ユーザーが入力の効果を測定するためにページ全体を見ることができるように縮小されています。 'ページ'が印刷されると、RichEdit領域が展開され、プリンタページ上で必要な位置に移動されます。以下のコードは、これを1つのわずかな（大量の読み込み）問題で非常にうまく処理します。フォントは拡大縮小されません。richedit XE5を印刷するときにスケールフォント
私はこのことを指摘しているように、ウィンドウとビューポートの起点と範囲を設定して遊んでみました。残念ながら、私は成功しませんでした。誰かが正しい方向に私を指差してくれますか？
procedure TForm10.PrintNewClick(Sender: TObject);
const
PgHeight=1170;
PgWidth=1170*210 div 294;
var
EdTop,EdLeft,EdWidth,EdHeight :integer;
wPage, hPage, xPPI, yPPI, wTwips, hTwips: integer;
pageRect, rendRect, outline: TRect;
po: TPageOffset;
fr: TFormatRange;
lastOffset, currPage, pageCount: integer;
xOffset, yOffset: integer;
FPageOffsets: array of TPageOffset;
TextLenEx: TGetTextLengthEx;
firstPage: boolean;
PrinterRatioH,PrinterRatioV, ratio:Real;
begin
Printer.Orientation:=poPortrait;
//get printer to 'page' ratios
PrinterRatioH :=Printer.PageWidth/PgWidth;
PrinterRatioV :=Printer.PageHeight/PgHeight;
//get positions and size of richedit on screen 'page'
//top of richedit on screen page
EdTop:=StrToInt(EditTop.Text);
//left of richedit on screen page
if EditCentre.Checked then
EdLeft:=(PgWidth-StrToInt(EditWidth.Text)) div 2
else
EdLeft:=StrToInt(EditLeft.Text);
//Width of richedit on screen page
EdWidth:=StrToInt(EditWidth.Text);
// Height of richedit on screen page
EdHeight:=StrToInt(EditHeight.Text);
//get bounding richedit rectangle on printer
with outline do
begin
left:=Round(EdLeft*PrinterRatioH);
top:=Round(EdTop*PrinterRatioV);
Right:=Left+Round(EdWidth*PrinterRatioH);
Bottom:=Top+Round(EdHeight*PrinterRatioV);
end;
//Get the size of a printed page in printer device units
wPage := GetDeviceCaps(Printer.Handle, PHYSICALWIDTH);
hPage := GetDeviceCaps(Printer.Handle, PHYSICALHEIGHT);
//Next, get the device units per inch for the printer
xPPI := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
if TwipFactor=567 then
xPPI :=round(xPPI/2.54); //change to metric base
yPPI := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
if TwipFactor=567 then
yPPI :=round(yPPI/2.54);
//Convert the page size from device units to twips
wTwips := MulDiv(wPage, TwipFactor, xPPI);
hTwips := MulDiv(hPage, TwipFactor, yPPI);
//Save the page size in twips
with pageRect do
begin
Left := 0;
Top := 0;
Right := wTwips;
Bottom := hTwips
end;
//calculate the size and position of the rendering rectangle in twips
with rendRect do
begin
Left :=MulDiv(Outline.Left, TwipFactor, xPPI);
Top := MulDiv(Outline.Top, TwipFactor, yPPI);
Right := MulDiv(Outline.Right, TwipFactor, xPPI);
Bottom := MulDiv(Outline.Bottom, TwipFactor, yPPI);
end;
//set starting offset to zero
po.mStart := 0;
//Define and initialize a TFormatRange structure.
with fr do
begin
hdc := Printer.Handle;
hdcTarget := Printer.Handle;
chrg.cpMin := po.mStart;
chrg.cpMax := -1;
end;
// how much text is in the control.
with TextLenEx do
begin
flags := GTL_DEFAULT;
codepage := CP_ACP;
end;
lastOffset := SendMessage(TestEdit.Handle, EM_GETTEXTLENGTHEX, wParam(@TextLenEx), 0);
//clear the formatting buffer
SendMessage(TestEdit.Handle, EM_FORMATRANGE, 0, 0);
SaveDC(fr.hdc);
SetMapMode(fr.hdc, MM_ANISOTROPIC{MM_TEXT});
SetViewportOrgEx(fr.hdc, 0, 0, nil);
SetViewportExtEx(fr.hdc, TestEdit.Width ,testedit.Height , nil);
//build a table of page entries,
while ((fr.chrg.cpMin <> -1) and (fr.chrg.cpMin < lastOffset)) do
begin
fr.rc := rendRect;
fr.rcPage := pageRect;
po.mStart := fr.chrg.cpMin;
fr.chrg.cpMin := SendMessage(TestEdit.Handle, EM_FORMATRANGE, 0, Longint(@fr));
po.mEnd := fr.chrg.cpMin - 1;
po.rendRect := fr.rc;
if High(FPageOffsets) = -1 then SetLength(FPageOffsets, 1)
else
SetLength(FPageOffsets, Length(FPageOffsets) + 1);
FPageOffsets[High(FPageOffsets)] := po
end;
pageCount := Length(FPageOffsets);
SendMessage(TestEdit.Handle, EM_FORMATRANGE, 0, 0);
RestoreDC(fr.hdc, - 1);
// print.
Printer.BeginDoc;
fr.hdc := Printer.Handle;
fr.hdcTarget := Printer.Handle;
SaveDC(fr.hdc);
SetViewportOrgEx(fr.hdc, 0, 0, nil);
SetViewportExtEx(fr.hdc, TestEdit.Width ,testedit.Height , nil);
firstPage := True;
//select from page and to page
currPage := 0; //Print from the first page
pageCount := 1; //Only One page for testing REMOVE LATER!!!
while (currPage < pageCount) do
begin
if firstPage then
firstPage := False
else
Printer.NewPage;
SetViewportExtEx(fr.hdc, TestEdit.Width ,testedit.Height
, nil);
fr.rc := FPageOffsets[currPage].rendRect;
fr.rcPage := pageRect;
fr.chrg.cpMin := FPageOffsets[currPage].mStart;
fr.chrg.cpMax := FPageOffsets[currPage].mEnd;
fr.chrg.cpMin := SendMessage(TestEdit.Handle, EM_FORMATRANGE, 1, Longint(@fr));
Inc(currPage);
end;
SetViewportOrgEx(fr.hdc, 0, 0, nil);
//draw bounding rect
Printer.Canvas.MoveTo(outline.Left-2,outline.Top-2);
Printer.Canvas.LineTo(outline.Right+4,outline.Top-2);
Printer.Canvas.LineTo(outline.Right+4,outline.Bottom+4);
Printer.Canvas.LineTo(outline.Left-2,outline.Bottom+4);
Printer.Canvas.LineTo(outline.Left-2,outline.Top-2);
//restore the printer's HDC settings
RestoreDC(fr.hdc, - 1);
Printer.EndDoc;
// clear RichEdit control's formatting buffer
fr.chrg.cpMin := SendMessage(TestEdit.Handle, EM_FORMATRANGE, 0, 0);
//delete saved page table info
Finalize(FPageOffsets);
end;
XE5を使用する場合、なぜXEタグを使用しますか？ –
私はXE5 :-( – Badger
）を見たことがありません。この質問にタグを付ける方法を教えてください。私の編集を参照してください。バージョンが関連している場合、常に平凡な 'delphi'タグとバージョンに一致する特定のタグ –