Limpieza de código y de mensajes de warning
git-svn-id: https://192.168.0.254/svn/Proyectos.Tecsitel_FactuGES2/trunk@489 0c75b7a4-871f-7646-8a2f-f78d34cc349f
This commit is contained in:
parent
75215a1af9
commit
0d4cc87c6c
@ -32,7 +32,7 @@
|
||||
{ software. }
|
||||
{ 3. This notice may not be removed or altered from any }
|
||||
{ source distribution. }
|
||||
{ 4. You must register this software by visiting }
|
||||
{ 4. You must register this software by visiting }
|
||||
{ http://nishita.com. }
|
||||
{*************************************************************}
|
||||
|
||||
@ -41,49 +41,48 @@ unit CtlToRTF;
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs,{$ENDIF} Messages, Classes, Graphics, Controls,
|
||||
StdCtrls, ExtCtrls, Grids, Forms, cxGridTableView;
|
||||
|
||||
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;
|
||||
|
||||
TCtrlToRTF = class(TComponent)
|
||||
private
|
||||
{ Private declarations }
|
||||
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}
|
||||
@ -94,488 +93,490 @@ implementation
|
||||
|
||||
constructor TCtrlToRTF.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
RTF:=TMemoryStream.Create;
|
||||
FontTable:=TStringList.Create;
|
||||
inherited Create(AOwner);
|
||||
RTF := TMemoryStream.Create;
|
||||
FontTable := TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TCtrlToRTF.Destroy;
|
||||
begin
|
||||
RTF.Free;
|
||||
FontTable.Free;
|
||||
inherited Destroy;
|
||||
RTF.Free;
|
||||
FontTable.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TCtrlToRTF.CreateRTFHeader;
|
||||
var i:Integer;
|
||||
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,'}');
|
||||
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;
|
||||
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);}
|
||||
{FontColor:=GetRTFFontColorTableName(cxGridView.Font.Color);
|
||||
FontSize:=GetRTFFontSize(cxGridView.Font.Size);
|
||||
FontAttrib:=GetRTFFontAttrib(cxGridView.Font.Style);
|
||||
FontName:=GetRTFFontTableName(cxGridView.Font.Name);}
|
||||
|
||||
CreateRTFHeader;
|
||||
CreateRTFHeader;
|
||||
|
||||
FontColor:=GetRTFFontColorTableName(Windows.GetSysColor(COLOR_BTNTEXT));
|
||||
FontSize:=GetRTFFontSize(8);
|
||||
FontAttrib:=GetRTFFontAttrib([]);
|
||||
FontName:=GetRTFFontTableName('Tahoma');
|
||||
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 )}}');
|
||||
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
|
||||
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');
|
||||
// ¿¿¿¿¿ 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
|
||||
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');
|
||||
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 j:=0 to cxGridView.VisibleColumnCount-1 do
|
||||
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
|
||||
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<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)));
|
||||
{$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;
|
||||
|
||||
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;
|
||||
hmf: THandle;
|
||||
FCanvas: TCanvas;
|
||||
lpBits: pointer;
|
||||
dwSize: LongInt;
|
||||
h, h1, w, w1: double;
|
||||
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;
|
||||
dwSize := 0;
|
||||
|
||||
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;
|
||||
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;
|
||||
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;
|
||||
procedure TCtrlToRTF.LabelToRTF(pLabel: TLabel);
|
||||
var
|
||||
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);
|
||||
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;
|
||||
procedure TCtrlToRTF.TextBufToRTF(TextBuf: pointer; size: word; 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+' \par');
|
||||
RTF.Write(TextBuf^,size);
|
||||
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;
|
||||
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;
|
||||
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;
|
||||
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;
|
||||
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;
|
||||
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);
|
||||
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);
|
||||
procedure TCtrlToRTF.EditToRTF(pEdit: TEdit);
|
||||
begin
|
||||
StringToRTF(pEdit.Text,pEdit.Font,taLeftJustify);
|
||||
StringToRTF(pEdit.Text, pEdit.Font, taLeftJustify);
|
||||
end;
|
||||
|
||||
|
||||
function TCtrlToRTF.GetRTFFontTableName(FontName:string):string;
|
||||
var i:Integer;
|
||||
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;
|
||||
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;
|
||||
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;
|
||||
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;
|
||||
function TCtrlToRTF.GetRTFFontSize(Size: Integer): string;
|
||||
begin
|
||||
Result:='\fs'+IntToStr(size*2);
|
||||
Result := '\fs' + IntToStr(size * 2);
|
||||
end;
|
||||
|
||||
function TCtrlToRTF.GetRTF: String;
|
||||
var
|
||||
A : TStringList;
|
||||
A: TStringList;
|
||||
begin
|
||||
StreamWriteStr(RTF,#13#10+'}}');
|
||||
RTF.Position := 0;
|
||||
A := TStringList.Create;
|
||||
try
|
||||
A.LoadFromStream(RTF);
|
||||
Result := A.Text;
|
||||
finally
|
||||
FreeANDNIL(A);
|
||||
end;
|
||||
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;
|
||||
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;
|
||||
if Alignment = taCenter then Align := '\qc'
|
||||
else if Alignment = taRightJustify then Align := '\qr'
|
||||
else Align := '';
|
||||
Result := Align;
|
||||
end;
|
||||
|
||||
function TCtrlToRTF.GetRTFFontColorTableName(Color:TColor):string;
|
||||
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';
|
||||
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);
|
||||
procedure TCtrlToRTF.AddFontToTable(Font: TFont);
|
||||
var DC: HDC;
|
||||
SaveFont: HFont;
|
||||
SysMetrics, Metrics: TTextMetric;
|
||||
Temp:byte;
|
||||
I: Integer;
|
||||
charset,family:string;
|
||||
SaveFont: HFont;
|
||||
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+';}');
|
||||
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);
|
||||
procedure TCtrlToRTF.SaveToFile(pFileName: String);
|
||||
begin
|
||||
StreamWriteStr(RTF,#13#10+'}}');
|
||||
RTF.SaveToFile(pFileName);
|
||||
StreamWriteStr(RTF, #13#10 + '}}');
|
||||
RTF.SaveToFile(pFileName);
|
||||
end;
|
||||
|
||||
procedure TCtrlToRTF.StreamWriteStr(var ms: TMemoryStream; s: string);
|
||||
begin
|
||||
ms.Write(s[1], Length(s));
|
||||
ms.Write(s[1], Length(s));
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('CynapSYS', [TCtrlToRTF]);
|
||||
RegisterComponents('CynapSYS', [TCtrlToRTF]);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
|
||||
@ -22,9 +22,6 @@ procedure DesconectarTabla (ATarget: TDADataTable);
|
||||
procedure CopyDataTableDA5(ASource : TDADataTable; ATarget: TDADataTable;
|
||||
const OnlySelectedRows : Boolean = False);
|
||||
|
||||
procedure CopyDataTableDA3(ASource : TDADataTable; ATarget : TDADataTable;
|
||||
const OnlySelectedRows : Boolean = False);
|
||||
|
||||
procedure CloneDataTable(const ASource : TDACDSDataTable;
|
||||
var ATarget : TDACDSDataTable;
|
||||
RemoteUpdate: Boolean = True); overload;
|
||||
@ -344,89 +341,6 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure CopyDataTableDA3(ASource : TDADataTable; ATarget : TDADataTable;
|
||||
const OnlySelectedRows : Boolean = False);
|
||||
var
|
||||
DABin: Binary;
|
||||
DAAdapter : TDABINAdapter;
|
||||
AFilter : String;
|
||||
AFiltered : Boolean;
|
||||
AObj : ISeleccionable;
|
||||
i : Integer;
|
||||
begin
|
||||
AFilter := '';
|
||||
AFiltered := False;
|
||||
|
||||
if OnlySelectedRows then
|
||||
begin
|
||||
if not Supports(ASource, ISeleccionable, aObj) then
|
||||
raise Exception.Create('El origen de datos no soporta la interfaz ISeleccionable (CopyDataTable)');
|
||||
|
||||
if ASource.Filtered then
|
||||
begin
|
||||
AFiltered := True;
|
||||
AFilter := ASource.Filter;
|
||||
ASource.Filtered := False;
|
||||
end;
|
||||
|
||||
ASource.Filter := '';
|
||||
if ASource.Active then
|
||||
ASource.Close;
|
||||
|
||||
//Si no hay elemento seleccionados filtramos para que ATarget se quede vacia
|
||||
if (AObj.SelectedRecords.Count = 0) then
|
||||
ASource.Filter := ASource.Filter + '(ID = ' + IntToStr(ID_NULO) + ')'
|
||||
//En caso contrario filtramos por los elementos seleccionados
|
||||
else
|
||||
for i := 0 to AObj.SelectedRecords.Count - 1 do
|
||||
begin
|
||||
if (i > 0) then
|
||||
ASource.Filter := ASource.Filter + ' or ';
|
||||
ASource.Filter := ASource.Filter + '(ID = ' + IntToStr(AObj.SelectedRecords.Items[i]) + ')';
|
||||
end;
|
||||
|
||||
ASource.Filtered := True;
|
||||
end;
|
||||
|
||||
DABin := Binary.Create;
|
||||
DAAdapter := TDABINAdapter.Create(nil);
|
||||
|
||||
ShowHourglassCursor;
|
||||
ASource.DisableControls;
|
||||
ATarget.DisableControls;
|
||||
try
|
||||
ATarget.LogicalName := ASource.LogicalName; // We need to specify new dataset LogicalName
|
||||
ATarget.RemoteFetchEnabled := False; // "Desconectamos" la tabla destino del servidor
|
||||
|
||||
if not ASource.Active then
|
||||
ASource.Open;
|
||||
ASource.First;
|
||||
|
||||
DAAdapter.WriteDataset(DABin, ASource, [woRows]);
|
||||
DAAdapter.ReadDataset(DABin, ATarget);
|
||||
DAAdapter.Finalize;
|
||||
|
||||
|
||||
ATarget.RemoteFetchEnabled := True; // "Conectamos" la tabla del servidor otra vez
|
||||
|
||||
// Dejar el filtro de la tabla origen como estaba
|
||||
if OnlySelectedRows then
|
||||
begin
|
||||
ASource.Filtered := False;
|
||||
ASource.Filter := AFilter;
|
||||
if AFiltered then
|
||||
ASource.Filtered := True;
|
||||
end;
|
||||
|
||||
finally
|
||||
FreeAndNil(DABin);
|
||||
FreeAndNil(DAAdapter);
|
||||
ASource.EnableControls;
|
||||
ATarget.EnableControls;
|
||||
HideHourglassCursor;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DuplicarRegistro(ASource : TDADataTable; ATarget : TDADataTable; Const WithPKKey: Boolean = False; Const WithFKKey: Boolean = False);
|
||||
var
|
||||
i, j: Integer;
|
||||
|
||||
@ -26,7 +26,7 @@ begin
|
||||
if StrIsDigit(Aux1) and StrIsDigit(Aux2) then
|
||||
Result := VarCompare(StrToIntSafe(Aux1), StrToIntSafe(Aux2))
|
||||
else
|
||||
VarCompare(Aux1, Aux2)
|
||||
Result := VarCompare(Aux1, Aux2)
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user