david
15113e1a5e
- Habilitado portapapeles git-svn-id: https://192.168.0.254/svn/Proyectos.Tecsitel_FactuGES2/trunk@392 0c75b7a4-871f-7646-8a2f-f78d34cc349f
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.
|
||
|