全國最多中醫師線上諮詢網站-台灣中醫網
發文 回覆 瀏覽次數:4973
推到 Plurk!
推到 Facebook!

請問如何轉換 RichEdit 成 Bitmap ?

缺席
pcboy
版主


發表:177
回覆:1838
積分:1463
註冊:2004-01-13

發送簡訊給我
#1 引用回覆 回覆 發表時間:2006-11-24 12:26:27 IP:219.87.xxx.xxx 訂閱
請問如何轉換 RichEdit 成 Bitmap ?
參考
http://www.swissdelphicenter.ch/en/showcode.php?id=2171
但是 CreateEmptyBmp 這行發生錯誤, 請問該怎樣修改成為正確可用的程式 ?
------
能力不足,求助於人;有能力時,幫幫別人;如果您滿意答覆,請適時結案!

子曰:問有三種,不懂則問,雖懂有疑則問,雖懂而想知更多則問!
william
版主


發表:66
回覆:2535
積分:3048
註冊:2002-07-11

發送簡訊給我
#2 引用回覆 回覆 發表時間:2006-11-25 09:31:37 IP:218.190.xxx.xxx 未訂閱
http://72.14.235.104/search?q=cache:ApmXAOAuz_kJ:www.swissdelphicenter.com/torry/showcomment.php?id=2171&detail=2397 CreateEmptyBmp&hl=zh-TW&gl=hk&ct=clnk&cd=3&client=firefox-a

Added function from Sonic Delphi

Hi,
I've forget to put one function ("CreateEmptyBmp"), here's the source code of "CreateEmptyBmp" function :

Function CreateEmptyBmp(myColor : TColor; Width,Height : Integer) : TBitmap;
Begin
Result := TBitmap.Create;
Result.Width := Width;
Result.Height := Height;
Result.Canvas.brush.Color := myColor;
Result.Canvas.brush.Style := bsSolid;
Result.Canvas.FillRect(Rect(0,0,Result.Width,Result.Height));
End;
pcboy
版主


發表:177
回覆:1838
積分:1463
註冊:2004-01-13

發送簡訊給我
#3 引用回覆 回覆 發表時間:2006-11-27 08:18:09 IP:219.87.xxx.xxx 訂閱
Image1 上面只會出現和 RichEdit1 相同大小的藍色框線
Image1 沒有出現 "This is a test!" 字樣
procedure TForm1.FormCreate(Sender: TObject);
var bmp : TBitmap;
begin
RichEdit1.Text:='This is a test !';
bmp := RTFtoBitmap(RichEdit1,2);
MakeBorder(bmp,2,clBlue);
Image1.Canvas.Draw(5,5,bmp);
bmp.free;
end;
------
能力不足,求助於人;有能力時,幫幫別人;如果您滿意答覆,請適時結案!

子曰:問有三種,不懂則問,雖懂有疑則問,雖懂而想知更多則問!
pcboy
版主


發表:177
回覆:1838
積分:1463
註冊:2004-01-13

發送簡訊給我
#4 引用回覆 回覆 發表時間:2007-04-18 15:26:24 IP:210.241.xxx.xxx 訂閱
有人能解嗎 ?
------
能力不足,求助於人;有能力時,幫幫別人;如果您滿意答覆,請適時結案!

子曰:問有三種,不懂則問,雖懂有疑則問,雖懂而想知更多則問!
h@visli
資深會員


發表:103
回覆:429
積分:431
註冊:2004-02-13

發送簡訊給我
#5 引用回覆 回覆 發表時間:2007-04-18 16:29:51 IP:219.133.xxx.xxx 訂閱
------
------------------------
博采眾家之長,奉獻綿薄之力
------------------------
h@visli
資深會員


發表:103
回覆:429
積分:431
註冊:2004-02-13

發送簡訊給我
#6 引用回覆 回覆 發表時間:2007-04-18 16:40:17 IP:219.133.xxx.xxx 訂閱
還是把文章貼出來吧
Print preview of TRichEdit
Painting a Rich Edit control onto a bitmap for preview

The Rich Edit control (we a talking about standard Windows control, not a Delphi component) contains built-in printing features that can be used to send formatted text to the printer or to paint it's content onto any canvas with minimal effort from the programmer.
Of course, the standard Delphi TRichEdit component incapsulates this feature.
We can use this posibility to make a fast print preview with a scaling or drawing Rich Text on any Delphi control.

Drawing from a Rich Edit control to any canvas involves the use of the standard Rich Edit control message EM_FORMATRANGE.
The lParam parameter for this message is a pointer to the TFormatRange record.
This record have to be filled before sending the message to the RichEdit.

The TFORMATRANGE record contains information that a rich edit control uses to format its output for a particular device, where
hdc Device to render to.
hdcTarget Target device to format for.
rc Area to render to. Units are measured in twips. Twips are screen-independent units to ensure that the proportion of screen elements are the same on all display systems. A twip is defined as being 1/1440 of an inch.
rcPage Entire area of rendering device. Units are measured in twips.
chrg TCHARRANGE record that specifies the range of text to format.

This record usually is used with the EM_EXGETSEL and EM_EXSETSEL messages and includes two fields: cpMin and cpMax.
cpMin is a character position index immediately preceding the first character in the range.
cpMax is a character position immediately following the last character in the range.

function PrintRTFToBitmap(ARichEdit : TRichEdit; ABitmap : TBitmap) : Longint;
var
range : TFormatRange;
begin
FillChar(Range, SizeOf(TFormatRange), 0);
// Rendering to the same DC we are measuring.
Range.hdc := ABitmap.Canvas.handle;
Range.hdcTarget := ABitmap.Canvas.Handle;

// Set up the page.
Range.rc.left := 0;
Range.rc.top := 0;
Range.rc.right := ABitmap.Width * 1440 div Screen.PixelsPerInch;
Range.rc.Bottom := ABitmap.Height * 1440 div Screen.PixelsPerInch;

// Default the range of text to print as the entire document.
Range.chrg.cpMax := -1;
Range.chrg.cpMin := 0;

// format the text
Result := SendMessage(ARichedit.Handle, EM_FORMATRANGE, 1, Longint(@Range));

// Free cached information
SendMessage(ARichEdit.handle, EM_FORMATRANGE, 0,0);
end;


The next example shows how to draw the Rich Edit not only to any canvas, but also how to draw only selected text range.
function PrintToCanvas(ACanvas : TCanvas; FromChar, ToChar : integer;
ARichEdit : TRichEdit; AWidth, AHeight : integer) : Longint;
var
Range : TFormatRange;
begin
FillChar(Range, SizeOf(TFormatRange), 0);
Range.hdc := ACanvas.handle;
Range.hdcTarget := ACanvas.Handle;
Range.rc.left := 0;
Range.rc.top := 0;
Range.rc.right := AWidth * 1440 div Screen.PixelsPerInch;
Range.rc.Bottom := AHeight * 1440 div Screen.PixelsPerInch;
Range.chrg.cpMax := ToChar;
Range.chrg.cpMin := FromChar;
Result := SendMessage(ARichedit.Handle, EM_FORMATRANGE, 1, Longint(@Range));
SendMessage(ARichEdit.handle, EM_FORMATRANGE, 0,0);
end;
But how to draw a Rich Text with the background image?
That is hopeless with the standard TRichedit control, because it based on the Windows
control and have no provision to handle background bitmaps or transparency.
In this case we can use two different bitmaps for background and drawing the Rich Text and after
combine them togehter.
procedure TForm1.Button2Click(Sender: TObject);
var Bmp : TBitmap;
begin
Bmp := TBitmap.Create;
bmp.Width := 300;
bmp.Height := 300;
PrintToCanvas(bmp.Canvas,2,5,RichEdit1,300,300);
BitBlt(Image1.Picture.Bitmap.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height,
bmp.Canvas.Handle, 0, 0, srcAND);
Image1.Repaint;
bmp.Free;
end;


另一篇就不貼了http://immortals.fake.hu/delphiportal/modules.php?name=News&file=article&sid=2197


------
------------------------
博采眾家之長,奉獻綿薄之力
------------------------
pcboy
版主


發表:177
回覆:1838
積分:1463
註冊:2004-01-13

發送簡訊給我
#7 引用回覆 回覆 發表時間:2007-04-19 08:57:53 IP:61.220.xxx.xxx 訂閱
有點問題耶
Undeclared identifier: TFormatRange
------
能力不足,求助於人;有能力時,幫幫別人;如果您滿意答覆,請適時結案!

子曰:問有三種,不懂則問,雖懂有疑則問,雖懂而想知更多則問!
pcboy
版主


發表:177
回覆:1838
積分:1463
註冊:2004-01-13

發送簡訊給我
#8 引用回覆 回覆 發表時間:2007-04-19 09:14:10 IP:61.220.xxx.xxx 訂閱
uses 部分要補上
<textarea class="delphi" rows="10" cols="60" name="code"> {http://www.swissdelphicenter.ch/torry/showcode.php?id=1466}
StdCtrls, ComCtrls, RichEdit,
//RxRichEd,
ExtCtrls, Printers; </textarea>

type 部分要宣告

<textarea class="delphi" rows="10" cols="60" name="code"> {http://www.wesoho.com/index.asp?page=9} TCharRange = record {Copy From RichEdit.pas} cpMin: Integer; cpMax: Integer; end; {http://www.bibts.com/MSN-QQ-Delphi-RichEdit-(-ImageOle-dll)-t125930.htm} TFormatRange = record hdc: Integer; hdcTarget: Integer; // rectRegion: TRect; rc: TRect; rectPage: TRect; chrg: TCharRange; end; </textarea>
但是 button2 按下去仍沒反應

------
能力不足,求助於人;有能力時,幫幫別人;如果您滿意答覆,請適時結案!

子曰:問有三種,不懂則問,雖懂有疑則問,雖懂而想知更多則問!
h@visli
資深會員


發表:103
回覆:429
積分:431
註冊:2004-02-13

發送簡訊給我
#9 引用回覆 回覆 發表時間:2007-04-19 11:04:34 IP:219.133.xxx.xxx 訂閱
你是不是直接用的PrintToCanvas(bmp.Canvas,2,5,RichEdit1,300,300);這句? 其中2與5分別指起始字符位置,你改變一下。或直接用function PrintRTFToBitmap(ARichEdit : TRichEdit; ABitmap : TBitmap) : Longint; 如果還不行,我再把我的代碼發給你。
------
------------------------
博采眾家之長,奉獻綿薄之力
------------------------
h@visli
資深會員


發表:103
回覆:429
積分:431
註冊:2004-02-13

發送簡訊給我
#10 引用回覆 回覆 發表時間:2007-04-19 11:28:30 IP:219.133.xxx.xxx 訂閱
Uses 部分要引用RichEdit單元,Type部分無需再定義TFormatRange記錄類型,因為RichEdit單元中已定義了。

我的代碼:

<textarea class="delphi" rows="10" cols="60" name="code"> unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls, RichEdit; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; Image1: TImage; RichEdit1: TRichEdit; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} function PrintRTFToBitmap(ARichEdit: TRichEdit; ABitmap: TBitmap): Longint; var range: TFormatRange; begin FillChar(Range, SizeOf(TFormatRange), 0); // Rendering to the same DC we are measuring. Range.hdc := ABitmap.Canvas.handle; Range.hdcTarget := ABitmap.Canvas.Handle; // Set up the page. Range.rc.left := 0; Range.rc.top := 0; Range.rc.right := ABitmap.Width * 1440 div Screen.PixelsPerInch; Range.rc.Bottom := ABitmap.Height * 1440 div Screen.PixelsPerInch; // Default the range of text to print as the entire document. Range.chrg.cpMax := -1; Range.chrg.cpMin := 0; // format the text Result := SendMessage(ARichedit.Handle, EM_FORMATRANGE, 1, Longint(@Range)); // Free cached information SendMessage(ARichEdit.handle, EM_FORMATRANGE, 0, 0); end; function PrintToCanvas(ACanvas: TCanvas; FromChar, ToChar: integer; ARichEdit: TRichEdit; AWidth, AHeight: integer): Longint; var Range: TFormatRange; begin FillChar(Range, SizeOf(TFormatRange), 0); Range.hdc := ACanvas.handle; Range.hdcTarget := ACanvas.Handle; Range.rc.left := 0; Range.rc.top := 0; Range.rc.right := AWidth * 1440 div Screen.PixelsPerInch; Range.rc.Bottom := AHeight * 1440 div Screen.PixelsPerInch; Range.chrg.cpMax := ToChar; Range.chrg.cpMin := FromChar; Result := SendMessage(ARichedit.Handle, EM_FORMATRANGE, 1, Longint(@Range)); SendMessage(ARichEdit.handle, EM_FORMATRANGE, 0, 0); end; {use PrintRTFToBitmap function} procedure TForm1.Button1Click(Sender: TObject); var Bmp: TBitmap; begin Bmp := TBitmap.Create; bmp.Width := RichEdit1.ClientWidth; bmp.Height := RichEdit1.ClientHeight; PrintRTFToBitmap(RichEdit1, Bmp); Image1.Canvas.Draw(0, 0, Bmp); bmp.Free; end; {use PrintToCanvas function} procedure TForm1.Button2Click(Sender: TObject); var Bmp: TBitmap; begin Bmp := TBitmap.Create; bmp.Width := RichEdit1.ClientWidth; bmp.Height := RichEdit1.ClientHeight; PrintToCanvas(bmp.Canvas, 0, Length(RichEdit1.Text), RichEdit1, Bmp.Width, Bmp.Height); Image1.Canvas.Draw(0, 0, Bmp); bmp.Free; end; end. </textarea>
------
------------------------
博采眾家之長,奉獻綿薄之力
------------------------
pcboy
版主


發表:177
回覆:1838
積分:1463
註冊:2004-01-13

發送簡訊給我
#11 引用回覆 回覆 發表時間:2007-04-19 12:05:07 IP:61.220.xxx.xxx 訂閱
感謝 ~ 會動了 ~

我在 Button2 最底下加入一行
Image1.Picture.SaveToFile('C:\RTF2BMP.bmp');

發現產生的圖片畫面, 只有 Image1 在螢幕顯示的大小, 不是 RichEdit 所有內容
我希望 Image1 在螢幕顯示只有部分 RichEdit 內容沒關係(因為 RichEdit 內容可能很長), 但是存 bmp 檔不能只有一部分內容
------
能力不足,求助於人;有能力時,幫幫別人;如果您滿意答覆,請適時結案!

子曰:問有三種,不懂則問,雖懂有疑則問,雖懂而想知更多則問!
h@visli
資深會員


發表:103
回覆:429
積分:431
註冊:2004-02-13

發送簡訊給我
#12 引用回覆 回覆 發表時間:2007-04-19 15:07:05 IP:219.133.xxx.xxx 訂閱
通過設置Bitmap的高度與TFormatRange記錄成員chrg.cpMax的值,是可以實現的,你可以手動試試效果。關鍵是要如何得知RichEdit控件中文字總的高的。我想這也是可以計算出來的。不過我就不花時間在這上面了。

我這裡要說的另一種方法:分頁打印。就與打印普通文檔一樣,把要打印的文檔進行分頁。換成輸出到BitMap中,就相當於輸出到多幅BitMap中,如果你願意,還可以很方便的把這所有多幅BitMap拼(畫)成一幅大的BitMap。

請看ComCtrls中的下面這段分頁打印代碼,只要把打印機Printer換成BitMap再修改一下就不難實現你的問題了:

procedure TCustomRichEdit.Print(const Caption: string);
var
Range: TFormatRange;
LastChar, MaxLen, LogX, LogY, OldMap: Integer;
SaveRect: TRect;
begin
FillChar(Range, SizeOf(TFormatRange), 0);
with Printer, Range do
begin
Title := Caption;
BeginDoc;
hdc := Handle; //換成BitMap的Handle
hdcTarget := hdc;
LogX := GetDeviceCaps(Handle, LOGPIXELSX); //換成Screen.PixelsPerInch
LogY := GetDeviceCaps(Handle, LOGPIXELSY);
if IsRectEmpty(PageRect) then //注意,PageRect是可以由你設置的,不然你就要設置BitMap的寬、高
begin
rc.right := PageWidth * 1440 div LogX;
rc.bottom := PageHeight * 1440 div LogY;
end
else begin
rc.left := PageRect.Left * 1440 div LogX;
rc.top := PageRect.Top * 1440 div LogY;
rc.right := PageRect.Right * 1440 div LogX;
rc.bottom := PageRect.Bottom * 1440 div LogY;
end;
rcPage := rc;
SaveRect := rc;
LastChar := 0;
MaxLen := GetTextLen;
chrg.cpMax := -1;
// ensure printer DC is in text map mode
OldMap := SetMapMode(hdc, MM_TEXT);
SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0); // flush buffer
try
repeat
rc := SaveRect;
chrg.cpMin := LastChar;
LastChar := SendMessage(Self.Handle, EM_FORMATRANGE, 1, Longint(@Range));
if (LastChar < MaxLen) and (LastChar <> -1) then NewPage; //一頁不夠換下一頁,這裡需要改為換一幅新的BitMap
until (LastChar >= MaxLen) or (LastChar = -1);
EndDoc;
finally
SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0); // flush buffer
SetMapMode(hdc, OldMap); // restore previous map mode
end;
end;
end;
------
------------------------
博采眾家之長,奉獻綿薄之力
------------------------
系統時間:2024-11-23 13:38:37
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!