581 lines
20 KiB
ObjectPascal
581 lines
20 KiB
ObjectPascal
|
{*************************************************************}
|
|||
|
|
{ Delphi Control to RTF Conversion VCL }
|
|||
|
|
{ Version: 1.0 }
|
|||
|
|
{ Author: K. Nishita }
|
|||
|
|
{ E-Mail: info@nishita.com }
|
|||
|
|
{ Home Page: http://nishita.com }
|
|||
|
|
{ Created: 3/1/2000 }
|
|||
|
|
{ Type: Freeware }
|
|||
|
|
{ Legal: Copyright (c) 1999 by K. Nishita }
|
|||
|
|
{*************************************************************}
|
|||
|
|
{ This component convert Delphi grid, edit, listbox, memo, }
|
|||
|
|
{ and label to Rich Text Format. }
|
|||
|
|
{*************************************************************}
|
|||
|
|
{ Please see example program for more information. }
|
|||
|
|
{*************************************************************}
|
|||
|
|
{ IMPORTANT NOTE: }
|
|||
|
|
{ This software is provided 'as-is', without any express or }
|
|||
|
|
{ implied warranty. In no event will the author be held }
|
|||
|
|
{ liable for any damages arising from the use of this }
|
|||
|
|
{ software. }
|
|||
|
|
{ Permission is granted to anyone to use this software for }
|
|||
|
|
{ any purpose, including commercial applications, and to }
|
|||
|
|
{ alter it and redistribute it freely, subject to the }
|
|||
|
|
{ following restrictions: }
|
|||
|
|
{ 1. The origin of this software must not be misrepresented, }
|
|||
|
|
{ you must not claim that you wrote the original software. }
|
|||
|
|
{ If you use this software in a product, an acknowledgment }
|
|||
|
|
{ in the product documentation would be appreciated but is }
|
|||
|
|
{ not required. }
|
|||
|
|
{ 2. Altered source versions must be plainly marked as such, }
|
|||
|
|
{ and must not be misrepresented as being the original }
|
|||
|
|
{ software. }
|
|||
|
|
{ 3. This notice may not be removed or altered from any }
|
|||
|
|
{ source distribution. }
|
|||
|
|
{ 4. You must register this software by visiting }
|
|||
|
|
{ http://nishita.com. }
|
|||
|
|
{*************************************************************}
|
|||
|
|
|
|||
|
|
unit CtlToRTF;
|
|||
|
|
|
|||
|
|
interface
|
|||
|
|
|
|||
|
|
uses
|
|||
|
|
SysUtils, {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs,{$ENDIF} Messages, Classes, Graphics, Controls,
|
|||
|
|
StdCtrls, ExtCtrls, Grids, Forms, cxGridTableView;
|
|||
|
|
|
|||
|
|
type
|
|||
|
|
TCtrlToRTF = class(TComponent)
|
|||
|
|
private
|
|||
|
|
{ Private declarations }
|
|||
|
|
FFileName:string;
|
|||
|
|
RTF:TMemoryStream;
|
|||
|
|
FontTable:TStringList;
|
|||
|
|
procedure StreamWriteStr(var ms: TMemoryStream; s: string);
|
|||
|
|
function GetRTFFontTableName(FontName:string):string;
|
|||
|
|
function GetRTFFontAttrib(Style:TFontStyles):string;
|
|||
|
|
function GetRTFFontSize(Size:Integer):string;
|
|||
|
|
function GetRTFAlignment(Alignment:TAlignment):string;
|
|||
|
|
function GetRTFFontColorTableName(Color:TColor):string;
|
|||
|
|
function GetRTF: String;
|
|||
|
|
|
|||
|
|
protected
|
|||
|
|
{ Protected declarations }
|
|||
|
|
public
|
|||
|
|
{ Public declarations }
|
|||
|
|
constructor Create(AOwner: TComponent); override;
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
procedure CreateRTFHeader;
|
|||
|
|
procedure AddFontToTable(Font:TFont);
|
|||
|
|
procedure ImageToRTF(Image:TImage;Alignment:TAlignment);
|
|||
|
|
procedure MemoToRTF(Memo:TMemo);
|
|||
|
|
procedure ListBoxToRTF(pList:TListBox);
|
|||
|
|
procedure StringListToRTF(pStringList:TStringList;Font:TFont;Alignment:TAlignment);
|
|||
|
|
procedure StringToRTF(pString:String;Font:TFont;Alignment:TAlignment);
|
|||
|
|
procedure TextBufToRTF(TextBuf:pointer;size:word;Font:TFont;Alignment:TAlignment);
|
|||
|
|
procedure LabelToRTF(pLabel:TLabel);
|
|||
|
|
procedure EditToRTF(pEdit:TEdit);
|
|||
|
|
procedure GridToRTF(Grid:TStringGrid);
|
|||
|
|
procedure cxGridViewToRTF(cxGridView:TcxGridTableView);
|
|||
|
|
procedure SaveToFile(pFileName:String);
|
|||
|
|
published
|
|||
|
|
property RTFText : String read GetRTF;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure Register;
|
|||
|
|
|
|||
|
|
implementation
|
|||
|
|
|
|||
|
|
//{$IFDEF WIN32}
|
|||
|
|
// {$R *.D32}
|
|||
|
|
//{$ELSE}
|
|||
|
|
// {$R *.D16}
|
|||
|
|
//{$ENDIF}
|
|||
|
|
|
|||
|
|
constructor TCtrlToRTF.Create(AOwner: TComponent);
|
|||
|
|
begin
|
|||
|
|
inherited Create(AOwner);
|
|||
|
|
RTF:=TMemoryStream.Create;
|
|||
|
|
FontTable:=TStringList.Create;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
destructor TCtrlToRTF.Destroy;
|
|||
|
|
begin
|
|||
|
|
RTF.Free;
|
|||
|
|
FontTable.Free;
|
|||
|
|
inherited Destroy;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TCtrlToRTF.CreateRTFHeader;
|
|||
|
|
var i:Integer;
|
|||
|
|
begin
|
|||
|
|
StreamWriteStr(RTF,'{\rtf1\ansi\ansicpg1252\deff0\deftab720');
|
|||
|
|
StreamWriteStr(RTF,'{\fonttbl');
|
|||
|
|
for i:=0 to FontTable.count-1 do
|
|||
|
|
StreamWriteStr(RTF,FontTable.Strings[i]);
|
|||
|
|
StreamWriteStr(RTF,'}');
|
|||
|
|
StreamWriteStr(RTF,'{\colortbl');
|
|||
|
|
StreamWriteStr(RTF,'\red0\green0\blue0;'); {Black}
|
|||
|
|
StreamWriteStr(RTF,'\red128\green0\blue0;'); {Maroon}
|
|||
|
|
StreamWriteStr(RTF,'\red0\green128\blue0;'); {Green}
|
|||
|
|
StreamWriteStr(RTF,'\red128\green128\blue0;'); {Olive}
|
|||
|
|
StreamWriteStr(RTF,'\red0\green0\blue128;'); {Navy}
|
|||
|
|
StreamWriteStr(RTF,'\red128\green0\blue128;'); {Purple}
|
|||
|
|
StreamWriteStr(RTF,'\red0\green128\blue128;'); {Teal}
|
|||
|
|
StreamWriteStr(RTF,'\red128\green128\blue128;'); {Gray}
|
|||
|
|
StreamWriteStr(RTF,'\red192\green192\blue192;'); {Silver}
|
|||
|
|
StreamWriteStr(RTF,'\red255\green0\blue0;'); {Red}
|
|||
|
|
StreamWriteStr(RTF,'\red0\green255\blue0;'); {Lime}
|
|||
|
|
StreamWriteStr(RTF,'\red255\green255\blue0;'); {Yellow}
|
|||
|
|
StreamWriteStr(RTF,'\red0\green0\blue255;'); {Blue}
|
|||
|
|
StreamWriteStr(RTF,'\red255\green0\blue255;'); {Fuchsia}
|
|||
|
|
StreamWriteStr(RTF,'\red0\green255\blue255;'); {Aqua}
|
|||
|
|
StreamWriteStr(RTF,'\red255\green255\blue255;'); {White}
|
|||
|
|
StreamWriteStr(RTF,'}');
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TCtrlToRTF.cxGridViewToRTF(cxGridView: TcxGridTableView);
|
|||
|
|
var i,j:Integer;
|
|||
|
|
Temp:double;
|
|||
|
|
FontColor,FontAttrib,FontSize,FontName:String;
|
|||
|
|
begin
|
|||
|
|
{FontColor:=GetRTFFontColorTableName(cxGridView.Font.Color);
|
|||
|
|
FontSize:=GetRTFFontSize(cxGridView.Font.Size);
|
|||
|
|
FontAttrib:=GetRTFFontAttrib(cxGridView.Font.Style);
|
|||
|
|
FontName:=GetRTFFontTableName(cxGridView.Font.Name);}
|
|||
|
|
|
|||
|
|
CreateRTFHeader;
|
|||
|
|
|
|||
|
|
FontColor:=GetRTFFontColorTableName(Windows.GetSysColor(COLOR_BTNTEXT));
|
|||
|
|
FontSize:=GetRTFFontSize(8);
|
|||
|
|
FontAttrib:=GetRTFFontAttrib([]);
|
|||
|
|
FontName:=GetRTFFontTableName('Tahoma');
|
|||
|
|
|
|||
|
|
|
|||
|
|
StreamWriteStr(RTF,'\par \pard\plain\cgrid');
|
|||
|
|
StreamWriteStr(RTF,'{\stylesheet{\nowidctlpar\widctlpar\adjustright \fs20\cgrid \snext0 Normal;}');
|
|||
|
|
StreamWriteStr(RTF,'{\*\cs10 \additive Default Paragraph Font;}}');
|
|||
|
|
StreamWriteStr(RTF,'{\*\pnseclvl1\pnucrm\pnstart1\pnindent720\pnhang{\pntxta');
|
|||
|
|
StreamWriteStr(RTF,'.}}{\*\pnseclvl2\pnucltr\pnstart1\pnindent720\pnhang');
|
|||
|
|
StreamWriteStr(RTF,'{\pntxta .}}{\*\pnseclvl3\pndec\pnstart1'+'\pnindent720\pnhang{\pntxta');
|
|||
|
|
StreamWriteStr(RTF,'.}}{\*\pnseclvl4\pnlcltr\pnstart1\pnindent720\pnhang{\pntxta');
|
|||
|
|
StreamWriteStr(RTF,')}}{\*\pnseclvl5\pndec\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta');
|
|||
|
|
StreamWriteStr(RTF,')}}{\*\pnseclvl6\pnlcltr\pnstart1\pnindent720\pnhang');
|
|||
|
|
StreamWriteStr(RTF,'{\pntxtb (}{\pntxta )}}{\*\pnseclvl7\pnlcrm\pnstart1\pnindent720'+
|
|||
|
|
'\pnhang{\pntxtb (}{\pntxta');
|
|||
|
|
StreamWriteStr(RTF,')}}{\*\pnseclvl8\pnlcltr\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta');
|
|||
|
|
StreamWriteStr(RTF,')}}{\*\pnseclvl9\pnlcrm\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}');
|
|||
|
|
|
|||
|
|
for i:=0 to cxGridView.Controller.SelectedRowCount-1 do
|
|||
|
|
begin
|
|||
|
|
StreamWriteStr(RTF,'\trowd');
|
|||
|
|
StreamWriteStr(RTF,'\trgaph108');
|
|||
|
|
StreamWriteStr(RTF,'\trrh260');
|
|||
|
|
StreamWriteStr(RTF,'\trleft90');
|
|||
|
|
StreamWriteStr(RTF,'\trbrdrt\brdrs\brdrw10');
|
|||
|
|
StreamWriteStr(RTF,'\trbrdrl\brdrs\brdrw10');
|
|||
|
|
StreamWriteStr(RTF,'\trbrdrb\brdrs\brdrw10');
|
|||
|
|
StreamWriteStr(RTF,'\trbrdrr\brdrs\brdrw10');
|
|||
|
|
StreamWriteStr(RTF,'\trbrdrh\brdrs\brdrw10');
|
|||
|
|
StreamWriteStr(RTF,'\trbrdrv\brdrs\brdrw10');
|
|||
|
|
|
|||
|
|
for j:=0 to cxGridView.VisibleColumnCount-1 do
|
|||
|
|
begin
|
|||
|
|
StreamWriteStr(RTF,'\clvertalt');
|
|||
|
|
StreamWriteStr(RTF,'\clbrdrt\brdrs\brdrw10');
|
|||
|
|
StreamWriteStr(RTF,'\clbrdrl\brdrs\brdrw10');
|
|||
|
|
StreamWriteStr(RTF,'\clbrdrb\brdrs\brdrw10');
|
|||
|
|
StreamWriteStr(RTF,'\clbrdrr\brdrs\brdrw10');
|
|||
|
|
// <20><><EFBFBD><EFBFBD><EFBFBD> if (j<cxGridView.FixedCols) or (i<cxGridView.FixedRows) then StreamWriteStr(RTF,'\clcbpat8');
|
|||
|
|
|
|||
|
|
{if (j=0) or (i=0) then StreamWriteStr(RTF,'\clshdng1500');}
|
|||
|
|
|
|||
|
|
StreamWriteStr(RTF,'\cltxlrtb');
|
|||
|
|
Temp:=(j+1)*cxGridView.VisibleColumns[j].Width;
|
|||
|
|
Temp:=(Temp/Screen.pixelsperinch)*1440.0+108.0;
|
|||
|
|
StreamWriteStr(RTF,'\cellx'+IntToStr(round(Temp)));
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
StreamWriteStr(RTF,'\pard\ri-123\nowidctlpar\widctlpar\intbl\adjustright');
|
|||
|
|
StreamWriteStr(RTF,' {'+FontName+FontSize+FontAttrib+FontColor+'\cgrid0');
|
|||
|
|
|
|||
|
|
for j:=0 to cxGridView.VisibleColumnCount-1 do
|
|||
|
|
StreamWriteStr(RTF, cxGridView.DataController.DisplayTexts[cxGridView.Controller.SelectedRows[i].RecordIndex, cxGridView.VisibleColumns[j].Index] +'\cell ');
|
|||
|
|
StreamWriteStr(RTF,'}');
|
|||
|
|
StreamWriteStr(RTF,'\pard \nowidctlpar\widctlpar\intbl\adjustright {\row}');
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
StreamWriteStr(RTF,'\pard\nowidctlpar\widctlpar\adjustright {');
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TCtrlToRTF.GridToRTF(Grid:TStringGrid);
|
|||
|
|
var i,j:Integer;
|
|||
|
|
Temp:double;
|
|||
|
|
FontColor,FontAttrib,FontSize,FontName:String;
|
|||
|
|
begin
|
|||
|
|
FontColor:=GetRTFFontColorTableName(Grid.Font.Color);
|
|||
|
|
FontSize:=GetRTFFontSize(Grid.Font.Size);
|
|||
|
|
FontAttrib:=GetRTFFontAttrib(Grid.Font.Style);
|
|||
|
|
FontName:=GetRTFFontTableName(Grid.Font.Name);
|
|||
|
|
StreamWriteStr(RTF,'\par \pard\plain\cgrid');
|
|||
|
|
StreamWriteStr(RTF,'{\stylesheet{\nowidctlpar\widctlpar\adjustright \fs20\cgrid \snext0 Normal;}');
|
|||
|
|
StreamWriteStr(RTF,'{\*\cs10 \additive Default Paragraph Font;}}');
|
|||
|
|
StreamWriteStr(RTF,'{\*\pnseclvl1\pnucrm\pnstart1\pnindent720\pnhang{\pntxta');
|
|||
|
|
StreamWriteStr(RTF,'.}}{\*\pnseclvl2\pnucltr\pnstart1\pnindent720\pnhang');
|
|||
|
|
StreamWriteStr(RTF,'{\pntxta .}}{\*\pnseclvl3\pndec\pnstart1'+'\pnindent720\pnhang{\pntxta');
|
|||
|
|
StreamWriteStr(RTF,'.}}{\*\pnseclvl4\pnlcltr\pnstart1\pnindent720\pnhang{\pntxta');
|
|||
|
|
StreamWriteStr(RTF,')}}{\*\pnseclvl5\pndec\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta');
|
|||
|
|
StreamWriteStr(RTF,')}}{\*\pnseclvl6\pnlcltr\pnstart1\pnindent720\pnhang');
|
|||
|
|
StreamWriteStr(RTF,'{\pntxtb (}{\pntxta )}}{\*\pnseclvl7\pnlcrm\pnstart1\pnindent720'+
|
|||
|
|
'\pnhang{\pntxtb (}{\pntxta');
|
|||
|
|
StreamWriteStr(RTF,')}}{\*\pnseclvl8\pnlcltr\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta');
|
|||
|
|
StreamWriteStr(RTF,')}}{\*\pnseclvl9\pnlcrm\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}');
|
|||
|
|
|
|||
|
|
for i:=0 to Grid.RowCount-1 do
|
|||
|
|
begin
|
|||
|
|
StreamWriteStr(RTF,'\trowd');
|
|||
|
|
StreamWriteStr(RTF,'\trgaph108');
|
|||
|
|
StreamWriteStr(RTF,'\trrh260');
|
|||
|
|
StreamWriteStr(RTF,'\trleft90');
|
|||
|
|
StreamWriteStr(RTF,'\trbrdrt\brdrs\brdrw10');
|
|||
|
|
StreamWriteStr(RTF,'\trbrdrl\brdrs\brdrw10');
|
|||
|
|
StreamWriteStr(RTF,'\trbrdrb\brdrs\brdrw10');
|
|||
|
|
StreamWriteStr(RTF,'\trbrdrr\brdrs\brdrw10');
|
|||
|
|
StreamWriteStr(RTF,'\trbrdrh\brdrs\brdrw10');
|
|||
|
|
StreamWriteStr(RTF,'\trbrdrv\brdrs\brdrw10');
|
|||
|
|
|
|||
|
|
for j:=0 to Grid.ColCount-1 do
|
|||
|
|
begin
|
|||
|
|
StreamWriteStr(RTF,'\clvertalt');
|
|||
|
|
StreamWriteStr(RTF,'\clbrdrt\brdrs\brdrw10');
|
|||
|
|
StreamWriteStr(RTF,'\clbrdrl\brdrs\brdrw10');
|
|||
|
|
StreamWriteStr(RTF,'\clbrdrb\brdrs\brdrw10');
|
|||
|
|
StreamWriteStr(RTF,'\clbrdrr\brdrs\brdrw10');
|
|||
|
|
if (j<Grid.FixedCols) or (i<Grid.FixedRows) then StreamWriteStr(RTF,'\clcbpat8');
|
|||
|
|
{if (j=0) or (i=0) then StreamWriteStr(RTF,'\clshdng1500');}
|
|||
|
|
StreamWriteStr(RTF,'\cltxlrtb');
|
|||
|
|
Temp:=(j+1)*Grid.DefaultColWidth;
|
|||
|
|
Temp:=(Temp/Screen.pixelsperinch)*1440.0+108.0;
|
|||
|
|
StreamWriteStr(RTF,'\cellx'+IntToStr(round(Temp)));
|
|||
|
|
end;
|
|||
|
|
StreamWriteStr(RTF,'\pard\ri-123\nowidctlpar\widctlpar\intbl\adjustright');
|
|||
|
|
StreamWriteStr(RTF,' {'+FontName+FontSize+FontAttrib+FontColor+'\cgrid0');
|
|||
|
|
for j:=0 to Grid.ColCount-1 do
|
|||
|
|
StreamWriteStr(RTF,Grid.Cells[j,i]+'\cell ');
|
|||
|
|
StreamWriteStr(RTF,'}');
|
|||
|
|
StreamWriteStr(RTF,'\pard \nowidctlpar\widctlpar\intbl\adjustright {\row}');
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
StreamWriteStr(RTF,'\pard\nowidctlpar\widctlpar\adjustright {');
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
|
|||
|
|
procedure TCtrlToRTF.ImageToRTF(Image:TImage;Alignment:TAlignment);
|
|||
|
|
type
|
|||
|
|
PtrRec = record
|
|||
|
|
Lo : Word;
|
|||
|
|
Hi : Word;
|
|||
|
|
end;
|
|||
|
|
PHugeByteArray = ^THugeByteArray;
|
|||
|
|
THugeByteArray = array[0..0] of Byte;
|
|||
|
|
function GetBigPointer(lp : pointer; Offset : LongInt) : Pointer;
|
|||
|
|
begin
|
|||
|
|
{$IFDEF WIN32}
|
|||
|
|
GetBigPointer := @PHugeByteArray(lp)^[Offset];
|
|||
|
|
{$ELSE}
|
|||
|
|
Offset := Offset + PTRREC(lp).Lo;
|
|||
|
|
GetBigPointer := Ptr(PtrRec(lp).Hi + PtrRec(Offset).Hi * SelectorInc, PtrRec(Offset).Lo);
|
|||
|
|
{$ENDIF}
|
|||
|
|
end;
|
|||
|
|
var
|
|||
|
|
hmf,hGlobal:THandle;
|
|||
|
|
i,j: integer;
|
|||
|
|
FCanvas : TCanvas;
|
|||
|
|
lpBits:pointer;
|
|||
|
|
dwSize,count:LongInt;
|
|||
|
|
Ch:char;
|
|||
|
|
h,h1,w,w1:double;
|
|||
|
|
TempBuf:PChar;
|
|||
|
|
Align:string;
|
|||
|
|
pPPoint:PPoint;
|
|||
|
|
pPSize:PSize;
|
|||
|
|
begin
|
|||
|
|
FCanvas := TCanvas.Create;
|
|||
|
|
FCanvas.Handle := CreateMetafile(nil);
|
|||
|
|
SetMapMode(FCanvas.Handle, mm_AnIsoTropic);
|
|||
|
|
{$IFDEF WIN32}
|
|||
|
|
SetWindowOrgEx(FCanvas.Handle, 0, 0, pPPoint);
|
|||
|
|
SetWindowExtEx(FCanvas.Handle, Image.Width, Image.Height, pPSize);
|
|||
|
|
{$ELSE}
|
|||
|
|
SetWindowOrg(FCanvas.Handle, 0, 0);
|
|||
|
|
SetWindowExt(FCanvas.Handle, Image.Width, Image.Height);
|
|||
|
|
{$ENDIF}
|
|||
|
|
FCanvas.StretchDraw(rect(0,0, Image.Width, Image.Height), Image.Picture.Graphic);
|
|||
|
|
hmf:=CloseMetafile(FCanvas.Handle);
|
|||
|
|
{$IFDEF WIN32}
|
|||
|
|
dwSize:=GetMetaFileBitsEx(hmf,dwSize,nil);
|
|||
|
|
GetMem(lpBits,dwSize);
|
|||
|
|
GetMetaFileBitsEx(hmf,dwSize,lpBits);
|
|||
|
|
{$ELSE}
|
|||
|
|
hGlobal := GetMetaFileBits( hmf );
|
|||
|
|
dwSize := GlobalSize(hGlobal);
|
|||
|
|
lpBits := GlobalLock( hGlobal );
|
|||
|
|
{$ENDIF}
|
|||
|
|
h:= Image.Height;
|
|||
|
|
h1:=h;
|
|||
|
|
w:= Image.Width;
|
|||
|
|
w1:=w;
|
|||
|
|
h:= (h/Screen.pixelsperinch)*1440.0;
|
|||
|
|
w:= (w/Screen.pixelsperinch)*1440.0;
|
|||
|
|
h1:=26.46875*h1;
|
|||
|
|
w1:=26.46875*w1;
|
|||
|
|
Align:=GetRTFAlignment(Alignment);
|
|||
|
|
StreamWriteStr(RTF,'\par \pard'+Align+'\plain\cgrid {\pict');
|
|||
|
|
StreamWriteStr(RTF,'\picscalex100');
|
|||
|
|
StreamWriteStr(RTF,'\picscaley100');
|
|||
|
|
StreamWriteStr(RTF,'\piccropl0');
|
|||
|
|
StreamWriteStr(RTF,'\piccropr0');
|
|||
|
|
StreamWriteStr(RTF,'\piccropt0');
|
|||
|
|
StreamWriteStr(RTF,'\piccropb0');
|
|||
|
|
StreamWriteStr(RTF,'\picw'+ inttostr(round(w1)));
|
|||
|
|
StreamWriteStr(RTF,'\pich'+ inttostr(round(h1)));
|
|||
|
|
StreamWriteStr(RTF,'\picwgoal'+inttostr(round(w)));
|
|||
|
|
StreamWriteStr(RTF,'\pichgoal'+inttostr(round(h)));
|
|||
|
|
StreamWriteStr(RTF,'\wmetafile8 \bin'+IntToStr(dwSize));
|
|||
|
|
RTF.Write(lpBits^,dwSize);
|
|||
|
|
{$IFDEF WIN32}
|
|||
|
|
FreeMem(lpBits);
|
|||
|
|
{$ELSE}
|
|||
|
|
GlobalUnLock( hGlobal );
|
|||
|
|
{$ENDIF}
|
|||
|
|
StreamWriteStr(RTF,'}');
|
|||
|
|
DeleteMetaFile(hmf);
|
|||
|
|
FCanvas.Free;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TCtrlToRTF.MemoToRTF(Memo:TMemo);
|
|||
|
|
var i:Integer;
|
|||
|
|
Align, FontColor,FontAttrib,FontSize,FontName:String;
|
|||
|
|
begin
|
|||
|
|
Align:=GetRTFAlignment(Memo.Alignment);
|
|||
|
|
FontColor:=GetRTFFontColorTableName(Memo.Font.Color);
|
|||
|
|
FontSize:=GetRTFFontSize(Memo.Font.Size);
|
|||
|
|
FontAttrib:=GetRTFFontAttrib(Memo.Font.Style);
|
|||
|
|
FontName:=GetRTFFontTableName(Memo.Font.Name);
|
|||
|
|
StreamWriteStr(RTF,'\par \pard'+Align+'\plain'+FontName+FontSize+FontAttrib+FontColor);
|
|||
|
|
for i:=0 to Memo.Lines.Count-1 do
|
|||
|
|
begin
|
|||
|
|
StreamWriteStr(RTF,' \par '+Memo.Lines[i]);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TCtrlToRTF.LabelToRTF(pLabel:TLabel);
|
|||
|
|
var i:Integer;
|
|||
|
|
Align, FontColor,FontAttrib,FontSize,FontName:String;
|
|||
|
|
begin
|
|||
|
|
Align:=GetRTFAlignment(pLabel.Alignment);
|
|||
|
|
FontColor:=GetRTFFontColorTableName(pLabel.Font.Color);
|
|||
|
|
FontSize:=GetRTFFontSize(pLabel.Font.Size);
|
|||
|
|
FontAttrib:=GetRTFFontAttrib(pLabel.Font.Style);
|
|||
|
|
FontName:=GetRTFFontTableName(pLabel.Font.Name);
|
|||
|
|
StreamWriteStr(RTF,'\par \pard'+Align+'\plain'+FontName+FontSize+FontAttrib+FontColor+' '+pLabel.Caption);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TCtrlToRTF.TextBufToRTF(TextBuf:pointer;size:word;Font:TFont;Alignment:TAlignment);
|
|||
|
|
var i:Integer;
|
|||
|
|
Align, FontColor,FontAttrib,FontSize,FontName:String;
|
|||
|
|
begin
|
|||
|
|
Align:=GetRTFAlignment(Alignment);
|
|||
|
|
FontColor:=GetRTFFontColorTableName(Font.Color);
|
|||
|
|
FontSize:=GetRTFFontSize(Font.Size);
|
|||
|
|
FontAttrib:=GetRTFFontAttrib(Font.Style);
|
|||
|
|
FontName:=GetRTFFontTableName(Font.Name);
|
|||
|
|
StreamWriteStr(RTF,'\par \pard'+Align+'\plain'+FontName+FontSize+FontAttrib+FontColor+' \par');
|
|||
|
|
RTF.Write(TextBuf^,size);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TCtrlToRTF.ListBoxToRTF(pList:TListBox);
|
|||
|
|
var i:Integer;
|
|||
|
|
FontColor,FontAttrib,FontSize,FontName:String;
|
|||
|
|
begin
|
|||
|
|
FontColor:=GetRTFFontColorTableName(pList.Font.Color);
|
|||
|
|
FontSize:=GetRTFFontSize(pList.Font.Size);
|
|||
|
|
FontAttrib:=GetRTFFontAttrib(pList.Font.Style);
|
|||
|
|
FontName:=GetRTFFontTableName(pList.Font.Name);
|
|||
|
|
StreamWriteStr(RTF,'\par \pard\plain'+FontName+FontSize+FontAttrib+FontColor);
|
|||
|
|
for i:=0 to pList.Items.Count-1 do
|
|||
|
|
begin
|
|||
|
|
StreamWriteStr(RTF,' \par '+pList.Items[i]);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TCtrlToRTF.StringListToRTF(pStringList:TStringList;Font:TFont;Alignment:TAlignment);
|
|||
|
|
var i:Integer;
|
|||
|
|
Align, FontColor,FontAttrib,FontSize,FontName:String;
|
|||
|
|
begin
|
|||
|
|
Align:=GetRTFAlignment(Alignment);
|
|||
|
|
FontColor:=GetRTFFontColorTableName(Font.Color);
|
|||
|
|
FontSize:=GetRTFFontSize(Font.Size);
|
|||
|
|
FontAttrib:=GetRTFFontAttrib(Font.Style);
|
|||
|
|
FontName:=GetRTFFontTableName(Font.Name);
|
|||
|
|
StreamWriteStr(RTF,'\par \pard'+Align+'\plain'+FontName+FontSize+FontAttrib+FontColor);
|
|||
|
|
for i:=0 to pStringList.Count-1 do
|
|||
|
|
begin
|
|||
|
|
StreamWriteStr(RTF,' \par '+pStringList.strings[i]);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TCtrlToRTF.StringToRTF(pString:String;Font:TFont;Alignment:TAlignment);
|
|||
|
|
var Align, FontColor,FontAttrib,FontSize,FontName:String;
|
|||
|
|
begin
|
|||
|
|
Align:=GetRTFAlignment(Alignment);
|
|||
|
|
FontColor:=GetRTFFontColorTableName(Font.Color);
|
|||
|
|
FontSize:=GetRTFFontSize(Font.Size);
|
|||
|
|
FontAttrib:=GetRTFFontAttrib(Font.Style);
|
|||
|
|
FontName:=GetRTFFontTableName(Font.Name);
|
|||
|
|
StreamWriteStr(RTF,'\par \pard'+Align+'\plain'+FontName+FontSize+FontAttrib+FontColor+' '+pString);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
|
|||
|
|
procedure TCtrlToRTF.EditToRTF(pEdit:TEdit);
|
|||
|
|
begin
|
|||
|
|
StringToRTF(pEdit.Text,pEdit.Font,taLeftJustify);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
|
|||
|
|
function TCtrlToRTF.GetRTFFontTableName(FontName:string):string;
|
|||
|
|
var i:Integer;
|
|||
|
|
begin
|
|||
|
|
Result := '\f0';
|
|||
|
|
for i:=0 to FontTable.Count-1 do
|
|||
|
|
begin
|
|||
|
|
if Pos(FontName,FontTable.Strings[i]) > 0 then
|
|||
|
|
begin
|
|||
|
|
Result := '\f'+IntToStr(i);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TCtrlToRTF.GetRTFFontAttrib(Style:TFontStyles):string;
|
|||
|
|
var retval:string;
|
|||
|
|
begin
|
|||
|
|
retval:='';
|
|||
|
|
if fsBold in Style then
|
|||
|
|
retval := retval+'\b';
|
|||
|
|
if fsItalic in Style then
|
|||
|
|
retval := retval+'\c';
|
|||
|
|
if fsUnderline in Style then
|
|||
|
|
retval := retval+'\ul';
|
|||
|
|
if fsStrikeOut in Style then
|
|||
|
|
retval := retval+'\strike';
|
|||
|
|
Result:=retval;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TCtrlToRTF.GetRTFFontSize(Size:Integer):string;
|
|||
|
|
begin
|
|||
|
|
Result:='\fs'+IntToStr(size*2);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TCtrlToRTF.GetRTF: String;
|
|||
|
|
var
|
|||
|
|
A : TStringList;
|
|||
|
|
begin
|
|||
|
|
StreamWriteStr(RTF,#13#10+'}}');
|
|||
|
|
RTF.Position := 0;
|
|||
|
|
A := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
A.LoadFromStream(RTF);
|
|||
|
|
Result := A.Text;
|
|||
|
|
finally
|
|||
|
|
FreeANDNIL(A);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TCtrlToRTF.GetRTFAlignment(Alignment:TAlignment):string;
|
|||
|
|
var Align:String;
|
|||
|
|
begin
|
|||
|
|
if Alignment = taCenter then Align := '\qc'
|
|||
|
|
else if Alignment = taRightJustify then Align := '\qr'
|
|||
|
|
else Align:='';
|
|||
|
|
Result := Align;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TCtrlToRTF.GetRTFFontColorTableName(Color:TColor):string;
|
|||
|
|
begin
|
|||
|
|
if Color = clBlack then Result:='\cf0'
|
|||
|
|
else if Color =clMaroon then Result:='\cf1'
|
|||
|
|
else if Color =clGreen then Result:='\cf2'
|
|||
|
|
else if Color =clOlive then Result:='\cf3'
|
|||
|
|
else if Color =clNavy then Result:='\cf4'
|
|||
|
|
else if Color =clPurple then Result:='\cf5'
|
|||
|
|
else if Color =clTeal then Result:='\cf6'
|
|||
|
|
else if Color =clGray then Result:='\cf7'
|
|||
|
|
else if Color =clSilver then Result:='\cf8'
|
|||
|
|
else if Color =clRed then Result:='\cf9'
|
|||
|
|
else if Color =clLime then Result:='\cf10'
|
|||
|
|
else if Color =clYellow then Result:='\cf11'
|
|||
|
|
else if Color =clBlue then Result:='\cf12'
|
|||
|
|
else if Color =clFuchsia then Result:='\cf13'
|
|||
|
|
else if Color =clAqua then Result:='\cf14'
|
|||
|
|
else if Color =clWhite then Result:='\cf15';
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TCtrlToRTF.AddFontToTable(Font:TFont);
|
|||
|
|
var DC: HDC;
|
|||
|
|
SaveFont: HFont;
|
|||
|
|
SysMetrics, Metrics: TTextMetric;
|
|||
|
|
Temp:byte;
|
|||
|
|
I: Integer;
|
|||
|
|
charset,family:string;
|
|||
|
|
begin
|
|||
|
|
DC := GetDC(0);
|
|||
|
|
SaveFont := SelectObject(DC, Font.Handle);
|
|||
|
|
GetTextMetrics(DC, Metrics);
|
|||
|
|
SelectObject(DC, SaveFont);
|
|||
|
|
ReleaseDC(0, DC);
|
|||
|
|
for I:=0 to FontTable.Count-1 do
|
|||
|
|
begin
|
|||
|
|
if Pos(Font.Name,FontTable.Strings[i]) > 0 then
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
case Metrics.tmCharSet of
|
|||
|
|
ANSI_CHARSET: charset:='fcharset0';
|
|||
|
|
DEFAULT_CHARSET: charset:='fcharset1';
|
|||
|
|
SYMBOL_CHARSET: charset:='fcharset2';
|
|||
|
|
SHIFTJIS_CHARSET: charset:='fcharset128';
|
|||
|
|
OEM_CHARSET: charset:='fcharset255';
|
|||
|
|
else charset:='';
|
|||
|
|
end;
|
|||
|
|
Temp:=Metrics.tmPitchAndFamily;
|
|||
|
|
Temp:= (Temp shr 4) shl 4;
|
|||
|
|
case Temp of
|
|||
|
|
FF_DECORATIVE: family:='fdecorative';
|
|||
|
|
FF_DONTCARE: family:='fdontcare';
|
|||
|
|
FF_MODERN: family:='fmodern';
|
|||
|
|
FF_ROMAN: family:='froman';
|
|||
|
|
FF_SCRIPT: family:='fscript';
|
|||
|
|
FF_SWISS: family:='fswiss';
|
|||
|
|
else family:='froman';
|
|||
|
|
end;
|
|||
|
|
FontTable.Add('{\f'+IntToStr(FontTable.Count)+'\'+family+'\'+charset+' '+font.name+';}');
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TCtrlToRTF.SaveToFile(pFileName:String);
|
|||
|
|
begin
|
|||
|
|
StreamWriteStr(RTF,#13#10+'}}');
|
|||
|
|
RTF.SaveToFile(pFileName);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TCtrlToRTF.StreamWriteStr(var ms: TMemoryStream; s: string);
|
|||
|
|
begin
|
|||
|
|
ms.Write(s[1], Length(s));
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure Register;
|
|||
|
|
begin
|
|||
|
|
RegisterComponents('CynapSYS', [TCtrlToRTF]);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
end.
|
|||
|
|
|