Draw rich text transparently onto the canvas of a TBitmap (Views: 800)
Problem/Question/Abstract: I have e.g. a RichEdit that I want to underlay with a grid for character placement. TCanvas does not seem to be available for TRichedit So I draw the grid on the TForm behind the richedit. How can I make the RichEdit transparent or how can I assign a TCanvas to a TRichedit? Answer: Solve 1: procedure OutputRTFtoBmp(RichHolder: TRichEdit; ImageHolder: TBitmap); var Range: TFormatRange; TextBoundary: TRect; begin {Setup the Height and Width of our output} ImageHolder.width := RichHolder.Width; ImageHolder.height := RichHolder.Height; if (bkGnd.Width <> 0) and (bkGnd.HEight <> 0) then imageholder.canvas.Draw(0, 0, bkGnd) else with imageholder.canvas do begin brush.Color := richholder.color; fillrect(cliprect); end; imageholder.canvas.Brush.Style := bsClear; {Set the Size of the Rich Edit} textboundary := rect(0, 0, RichHolder.Width * screen.Pixelsperinch, RichHolder.Height * screen.Pixelsperinch); {Set the Range record} range.hdc := ImageHolder.Canvas.handle; range.hdctarget := ImageHolder.Canvas.handle; range.rc := textboundary; range.rcpage := textboundary; {Start at character zero} range.chrg.cpMin := 0; {Display all Characters} range.chrg.cpMax := -1; {Ask RTF to Draw} Sendmessage(RichHolder.handle, EM_FORMATRANGE, 1, longint(@range)); {Cleanup RTF Cache} sendmessage(RichHolder.handle, EM_FORMATRANGE, 0, 0); end; Solve 2: This simply copies an RTF document to a canvas: { ... } var Bitmap: TBitmap; RichEdit: TRichEdit; function PrintToCanvas(FromChar, ToChar: integer): Longint; var range: TFormatRange; begin FillChar(Range, SizeOf(TFormatRange), 0); Range.hdc := Bitmap.Canvas.handle; Range.hdcTarget := Bitmap.Canvas.Handle; Range.rc.left := 0; Range.rc.top := 0; Range.rc.right := Bitmap.Width * 1440 div Screen.PixelsPerInch; Range.rc.Bottom := Bitmap.Height * 1440 div Screen.PixelsPerInch; Range.chrg.cpMax := ToChar; Range.chrg.cpMin := FromChar; Result := SendMessage(Richedit.Handle, EM_FORMATRANGE, 1, Longint(@Range)); SendMessage(RichEdit.handle, EM_FORMATRANGE, 0, 0); end; Solve 3: Try following source code: procedure DrawRTF(Bitmap: TBitmap; X1, Y1, X2, Y2: Integer; RichEdit: TRichEdit); const BitmapPixelsPerInch = 96; BitmapTwipsPerPixel = 1440 div BitmapPixelsPerInch; var Range: TFormatRange; begin with Range do begin {convert the coordinates to twips (1/1440") } hDC := Bitmap.Canvas.Handle; {DC handle} hdcTarget := Bitmap.Canvas.Handle; {ditto} rc := Rect(X1 * BitmapTwipsPerPixel, Y1 * BitmapTwipsPerPixel, X2 * BitmapTwipsPerPixel, Y2 * BitmapTwipsPerPixel); rcPage := rc; chrg.cpMin := 0; chrg.cpMax := -1; {RichEdit.GetTextLen;} {Free cached information} RichEdit.Perform(EM_FORMATRANGE, 0, 0); {First measure the text, to find out how high the format rectangle will be. The call sets fmtrange.rc.bottom to the actual height required, if all characters in the selected range will fit into a smaller rectangle.} RichEdit.Perform(EM_FORMATRANGE, 0, DWord(@Range)); {Now render the text} RichEdit.Perform(EM_FORMATRANGE, 1, DWord(@Range)); {Free cached information} RichEdit.Perform(EM_FORMATRANGE, 0, 0); end; end; Solve 4: PaintTo draws the visible client area of a RichEdit control to the TCanvas. Use the following method to render the complete content to your TCanvas. DestDCHandle is TCanvas.Handle, R is the Rect in relation to your canvas, RichEdit is a TRichEdit instance (can be invisible), PixelsPerInch is the Resolution (for screen e.g. 96). procedure DrawRTF(DestDCHandle: HDC; const R: TRect; RichEdit: TRichEdit; PixelsPerInch: Integer); var TwipsPerPixel: Integer; Range: TFormatRange; begin TwipsPerPixel := 1440 div PixelsPerInch; with Range do begin hDC := DestDCHandle; {DC handle} hdcTarget := DestDCHandle; {ditto} {Convert the coordinates to twips (1/1440")} rc.Left := R.Left * TwipsPerPixel; rc.Top := R.Top * TwipsPerPixel; rc.Right := R.Right * TwipsPerPixel; rc.Bottom := R.Bottom * TwipsPerPixel; rcPage := rc; chrg.cpMin := 0; chrg.cpMax := -1; {RichEdit.GetTextLen;} {Free cached information} RichEdit.Perform(EM_FORMATRANGE, 0, 0); {First measure the text, to find out how high the format rectangle will be. The call sets fmtrange.rc.bottom to the actual height required, if all characters in the selected range will fit into a smaller rectangle} RichEdit.Perform(EM_FORMATRANGE, 0, DWord(@Range)); {Now render the text} RichEdit.Perform(EM_FORMATRANGE, 1, DWord(@Range)); {Free cached information} RichEdit.Perform(EM_FORMATRANGE, 0, 0); end; end; Sample 1: procedure TForm1.Button1Click(Sender: TObject); var RichEdit: TRichEdit; bmp: TBitmap; DestDCHandle: HDC; begin RichEdit := TRichEdit.Create(Self); try RichEdit.Visible := False; RichEdit.Parent := Self; {Win2k, WinXP} RichEdit.Lines.LoadFromFile('filename.rtf'); bmp := TBitmap.Create; try bmp.width := 500; bmp.height := 500; DestDCHandle := bmp.Canvas.Handle; DrawRTF(DestDCHandle, Rect(0, 0, bmp.Width, bmp.Height), RichEdit, 96); Image1.Picture.Assign(bmp); finally bmp.Free; end; finally RichEdit.Free; end; end; Sample 2 (draw transparent): procedure TForm1.Button1Click(Sender: TObject); var RichEdit: TRichEdit; ExStyle: DWord; bmp: TBitmap; DestDCHandle: HDC; begin RichEdit := TRichEdit.Create(Self); try RichEdit.Visible := False; RichEdit.Parent := Self; {Win2k, WinXP} ExStyle := GetWindowLong(RichEdit.Handle, GWL_EXSTYLE); ExStyle := ExStyle or WS_EX_TRANSPARENT; SetWindowLong(RichEdit.Handle, GWL_EXSTYLE, ExStyle); RichEdit.Lines.LoadFromFile('filename.rtf'); bmp := TBitmap.Create; try bmp.LoadFromFile('filename.bmp'); DestDCHandle := bmp.Canvas.Handle; {Win9x} SetBkMode(DestDCHandle, TRANSPARENT); DrawRTF(DestDCHandle, Rect(0, 0, bmp.Width, bmp.Height), RichEdit, 96); Image1.Picture.Assign(bmp); finally bmp.Free; end; finally RichEdit.Free; end; end; |