Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
KANSoftWare

Преобразование информации из табличных компонент в RTF

Delphi , Синтаксис , Преобразования


Автор: Delirium
WEB-сайт: http://delphibase.endimus.com 

{ **** UBPFD *********** by delphibase.endimus.com ****
>> 
Модуль содержит ряд функций, ориентированных на работу с VCL-компонентами.
Содержимое списков и таблиц, конвертируется в формат RTF, для дальнейшей
распечатки или копирования в буфер обмена.

Зависимости: SysUtils, Windows, Messages, Classes, Graphics, Controls,
StdCtrls, ExtCtrls, Grids, Forms, DBGrids
Автор:       Delirium, Master_BRAIN@beep.ru, ICQ:118395746, Москва
Copyright:   Copyright (c) 1999 by K. Nishita / Master BRAIN (Delirium) - 2002 г.
Дата:        9 июля 2002 г.
***************************************************** }

{*************************************************************}
{ }
{ Переработал компонент в unit, добавил фукцию }
{ по работе с TDBGrid. }
{ }
{ Master BRAIN (Delirium) - 2002 г. }
{ }
{*************************************************************}
{ 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. }
{*************************************************************}

unit CtrlToRTF;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  StdCtrls, ExtCtrls, Grids, Forms, DBGrids;

function RTFHeader: string;
function RTFFooter: string;
function ImageToRTF(Image: TImage; Alignment: TAlignment): string;
function MemoToRTF(Memo: TMemo): string;
function StringsToRTF(pStringList: TStrings; Font: TFont; Alignment:
  TAlignment): string;
function StringToRTF(pString: string; Font: TFont; Alignment: TAlignment):
  string;
function GridToRTF(Grid: TStringGrid): string;
function DBGridToRTF(DBGrid: TDBGrid): string;

implementation

var
  RTF, FontTable: TStrings;

function 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 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 GetRTFFontSize(Size: Integer): string;
begin
  Result := '\fs' + IntToStr(size * 2);
end;

function 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 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 Creator;
begin
  RTF := TStringList.Create;
  FontTable := TStringList.Create;
end;

procedure Destroyer;
begin
  RTF.Free;
  FontTable.Free;
end;

function RTFHeader: string;
var
  i: Integer;
begin
  Creator;

  RTF.Append('{\rtf1\ansi\ansicpg1252\deff0\deftab720');
  RTF.Append('{\fonttbl');
  for i := 0 to FontTable.count - 1 do
    RTF.Append(FontTable.Strings[i]);
  RTF.Append('}');
  RTF.Append('{\colortbl');
  RTF.Append('\red0\green0\blue0;'); {Black}
  RTF.Append('\red128\green0\blue0;'); {Maroon}
  RTF.Append('\red0\green128\blue0;'); {Green}
  RTF.Append('\red128\green128\blue0;'); {Olive}
  RTF.Append('\red0\green0\blue128;'); {Navy}
  RTF.Append('\red128\green0\blue128;'); {Purple}
  RTF.Append('\red0\green128\blue128;'); {Teal}
  RTF.Append('\red128\green128\blue128;'); {Gray}
  RTF.Append('\red192\green192\blue192;'); {Silver}
  RTF.Append('\red255\green0\blue0;'); {Red}
  RTF.Append('\red0\green255\blue0;'); {Lime}
  RTF.Append('\red255\green255\blue0;'); {Yellow}
  RTF.Append('\red0\green0\blue255;'); {Blue}
  RTF.Append('\red255\green0\blue255;'); {Fuchsia}
  RTF.Append('\red0\green255\blue255;'); {Aqua}
  RTF.Append('\red255\green255\blue255;'); {White}
  RTF.Append('}');

  Result := RTF.Text;

  Destroyer;
end;

function RTFFooter: string;
begin
  Result := #13#10+'}}';
end;

function GridToRTF(Grid: TStringGrid): string;
var
  i, j: Integer;
  Temp: double;
  FontColor, FontAttrib, FontSize, FontName: string;
begin
  Creator;

  FontColor := GetRTFFontColorTableName(Grid.Font.Color);
  FontSize := GetRTFFontSize(Grid.Font.Size);
  FontAttrib := GetRTFFontAttrib(Grid.Font.Style);
  FontName := GetRTFFontTableName(Grid.Font.Name);
  RTF.Append('\par \pard\plain\cgrid');
  RTF.Append('{\stylesheet{\nowidctlpar\widctlpar\adjustright \fs20\cgrid \snext0 Normal;}');
  RTF.Append('{\*\cs10 \additive Default Paragraph Font;}}');
  RTF.Append('{\*\pnseclvl1\pnucrm\pnstart1\pnindent720\pnhang{\pntxta');
  RTF.Append('.}}{\*\pnseclvl2\pnucltr\pnstart1\pnindent720\pnhang');
  RTF.Append('{\pntxta .}}{\*\pnseclvl3\pndec\pnstart1' +
    '\pnindent720\pnhang{\pntxta');
  RTF.Append('.}}{\*\pnseclvl4\pnlcltr\pnstart1\pnindent720\pnhang{\pntxta');
  RTF.Append(')}}{\*\pnseclvl5\pndec\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta');
  RTF.Append(')}}{\*\pnseclvl6\pnlcltr\pnstart1\pnindent720\pnhang');
  RTF.Append('{\pntxtb (}{\pntxta )}}{\*\pnseclvl7\pnlcrm\pnstart1\pnindent720'
    +
    '\pnhang{\pntxtb (}{\pntxta');
  RTF.Append(')}}{\*\pnseclvl8\pnlcltr\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta');
  RTF.Append(')}}{\*\pnseclvl9\pnlcrm\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}');

  for i := 0 to Grid.RowCount - 1 do
  begin
    RTF.Append('\trowd');
    RTF.Append('\trgaph108');
    RTF.Append('\trrh260');
    RTF.Append('\trleft90');
    RTF.Append('\trbrdrt\brdrs\brdrw10');
    RTF.Append('\trbrdrl\brdrs\brdrw10');
    RTF.Append('\trbrdrb\brdrs\brdrw10');
    RTF.Append('\trbrdrr\brdrs\brdrw10');
    RTF.Append('\trbrdrh\brdrs\brdrw10');
    RTF.Append('\trbrdrv\brdrs\brdrw10');

    for j := 0 to Grid.ColCount - 1 do
    begin
      RTF.Append('\clvertalt');
      RTF.Append('\clbrdrt\brdrs\brdrw10');
      RTF.Append('\clbrdrl\brdrs\brdrw10');
      RTF.Append('\clbrdrb\brdrs\brdrw10');
      RTF.Append('\clbrdrr\brdrs\brdrw10');
      if (j < Grid.FixedCols) or (i < Grid.FixedRows) then
        RTF.Append('\clcbpat8');
      RTF.Append('\cltxlrtb');
      Temp := (j + 1) * Grid.DefaultColWidth;
      Temp := (Temp / Screen.pixelsperinch) * 1440.0 + 108.0;
      RTF.Append('\cellx' + IntToStr(round(Temp)));
    end;
    RTF.Append('\pard\ri-123\nowidctlpar\widctlpar\intbl\adjustright');
    RTF.Append(' {' + FontName + FontSize + FontAttrib + FontColor + '\cgrid0');
    for j := 0 to Grid.ColCount - 1 do
      RTF.Append(Grid.Cells[j, i] + '\cell ');
    RTF.Append('}');
    RTF.Append('\pard \nowidctlpar\widctlpar\intbl\adjustright {\row}');
  end;

  RTF.Append('\pard\nowidctlpar\widctlpar\adjustright {');

  Result := RTF.Text;

  Destroyer;
end;

function DBGridToRTF(DBGrid: TDBGrid): string;
var
  j: Integer;
  Temp: double;
  FontColor, FontAttrib, FontSize, FontName: string;
begin
  Creator;
  FontColor := GetRTFFontColorTableName(DBGrid.Font.Color);
  FontSize := GetRTFFontSize(DBGrid.Font.Size);
  FontAttrib := GetRTFFontAttrib(DBGrid.Font.Style);
  FontName := GetRTFFontTableName(DBGrid.Font.Name);
  RTF.Append('\par \pard\plain\cgrid');
  RTF.Append('{\stylesheet{\nowidctlpar\widctlpar\adjustright \fs20\cgrid \snext0 Normal;}');
  RTF.Append('{\*\cs10 \additive Default Paragraph Font;}}');
  RTF.Append('{\*\pnseclvl1\pnucrm\pnstart1\pnindent720\pnhang{\pntxta');
  RTF.Append('.}}{\*\pnseclvl2\pnucltr\pnstart1\pnindent720\pnhang');
  RTF.Append('{\pntxta .}}{\*\pnseclvl3\pndec\pnstart1' +
    '\pnindent720\pnhang{\pntxta');
  RTF.Append('.}}{\*\pnseclvl4\pnlcltr\pnstart1\pnindent720\pnhang{\pntxta');
  RTF.Append(')}}{\*\pnseclvl5\pndec\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta');
  RTF.Append(')}}{\*\pnseclvl6\pnlcltr\pnstart1\pnindent720\pnhang');
  RTF.Append('{\pntxtb (}{\pntxta )}}{\*\pnseclvl7\pnlcrm\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta');
  RTF.Append(')}}{\*\pnseclvl8\pnlcltr\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta');
  RTF.Append(')}}{\*\pnseclvl9\pnlcrm\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}');
  DBGrid.DataSource.DataSet.DisableControls;
  DBGrid.DataSource.DataSet.First;
  while not DBGrid.DataSource.DataSet.Eof do
  begin
    RTF.Append('\trowd');
    RTF.Append('\trgaph108');
    RTF.Append('\trrh260');
    RTF.Append('\trleft90');
    RTF.Append('\trbrdrt\brdrs\brdrw10');
    RTF.Append('\trbrdrl\brdrs\brdrw10');
    RTF.Append('\trbrdrb\brdrs\brdrw10');
    RTF.Append('\trbrdrr\brdrs\brdrw10');
    RTF.Append('\trbrdrh\brdrs\brdrw10');
    RTF.Append('\trbrdrv\brdrs\brdrw10');
    Temp := 0;
    for j := 0 to DBGrid.Columns.Count - 1 do
    begin
      RTF.Append('\clvertalt');
      RTF.Append('\clbrdrt\brdrs\brdrw10');
      RTF.Append('\clbrdrl\brdrs\brdrw10');
      RTF.Append('\clbrdrb\brdrs\brdrw10');
      RTF.Append('\clbrdrr\brdrs\brdrw10');
      RTF.Append('\cltxlrtb');
      Temp := Temp + DBGrid.Columns[j].Width + 1;
      RTF.Append('\cellx' + IntToStr(Round((Temp / Screen.pixelsperinch * 1440.0)
        + 108.0)));
    end;
    RTF.Append('\pard\ri-123\nowidctlpar\widctlpar\intbl\adjustright');
    RTF.Append(' {' + FontName + FontSize + FontAttrib + FontColor + '\cgrid0');
    for j := 0 to DBGrid.Columns.Count - 1 do
      RTF.Append(DBGrid.Columns[j].Field.DisplayText + '\cell ');
    RTF.Append('}');
    RTF.Append('\pard \nowidctlpar\widctlpar\intbl\adjustright {\row}');
    DBGrid.DataSource.DataSet.Next;
  end;
  DBGrid.DataSource.DataSet.First;
  DBGrid.DataSource.DataSet.EnableControls;

  RTF.Append('\pard\nowidctlpar\widctlpar\adjustright {');

  Result := RTF.Text;

  Destroyer;
end;

function ImageToRTF(Image: TImage; Alignment: TAlignment): string;
type
  PtrRec = record
    Lo: Word;
    Hi: Word;
  end;
  PHugeByteArray = ^THugeByteArray;
  THugeByteArray = array[0..0] of Byte;

  function GetBigPointer(lp: pointer; Offset: LongInt): Pointer;
  begin
    GetBigPointer := @PHugeByteArray(lp)^[Offset];
  end;

var
  hmf: THandle;
  FCanvas: TCanvas;
  lpBits: pointer;
  dwSize: LongInt;
  h, h1, w, w1: double;
  Align: string;
  pPPoint: PPoint;
  pPSize: PSize;
  ST: TStream;
  SL: TStrings;

begin
  Creator;

  FCanvas := TCanvas.Create;
  FCanvas.Handle := CreateMetafile(nil);
  SetMapMode(FCanvas.Handle, mm_AnIsoTropic);
  pPPoint := nil;
  SetWindowOrgEx(FCanvas.Handle, 0, 0, pPPoint);
  pPSize := nil;
  SetWindowExtEx(FCanvas.Handle, Image.Width, Image.Height, pPSize);
  FCanvas.StretchDraw(rect(0, 0, Image.Width, Image.Height),
    Image.Picture.Graphic);
  hmf := CloseMetafile(FCanvas.Handle);
  dwSize := 0;
  dwSize := GetMetaFileBitsEx(hmf, dwSize, nil);
  GetMem(lpBits, dwSize);
  GetMetaFileBitsEx(hmf, dwSize, lpBits);
  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);
  RTF.Append('\par \pard' + Align + '\plain\cgrid {\pict');
  RTF.Append('\picscalex100');
  RTF.Append('\picscaley100');
  RTF.Append('\piccropl0');
  RTF.Append('\piccropr0');
  RTF.Append('\piccropt0');
  RTF.Append('\piccropb0');
  RTF.Append('\picw' + inttostr(round(w1)));
  RTF.Append('\pich' + inttostr(round(h1)));
  RTF.Append('\picwgoal' + inttostr(round(w)));
  RTF.Append('\pichgoal' + inttostr(round(h)));
  RTF.Append('\wmetafile8 \bin' + IntToStr(dwSize));
  ST := TMemoryStream.Create;
  ST.Write(lpBits^, dwSize);
  SL := TStringList.Create;
  SL.LoadFromStream(ST);
  RTF.Append(SL.Text);
  SL.Free;
  ST.Free;
  FreeMem(lpBits);
  RTF.Append('}');
  DeleteMetaFile(hmf);
  FCanvas.Free;

  Result := RTF.Text;

  Destroyer;
end;

function MemoToRTF(Memo: TMemo): string;
var
  i: Integer;
  Align, FontColor, FontAttrib, FontSize, FontName: string;
begin
  Creator;

  Align := GetRTFAlignment(Memo.Alignment);
  FontColor := GetRTFFontColorTableName(Memo.Font.Color);
  FontSize := GetRTFFontSize(Memo.Font.Size);
  FontAttrib := GetRTFFontAttrib(Memo.Font.Style);
  FontName := GetRTFFontTableName(Memo.Font.Name);
  RTF.Append('\par \pard' + Align + '\plain' + FontName + FontSize + FontAttrib
    + FontColor);
  for i := 0 to Memo.Lines.Count - 1 do
  begin
    RTF.Append(' \par ' + Memo.Lines[i]);
  end;

  Result := RTF.Text;

  Destroyer;
end;

function StringsToRTF(pStringList: TStrings; Font: TFont; Alignment:
  TAlignment): string;
var
  i: Integer;
  Align, FontColor, FontAttrib, FontSize, FontName: string;
begin
  Creator;

  Align := GetRTFAlignment(Alignment);
  FontColor := GetRTFFontColorTableName(Font.Color);
  FontSize := GetRTFFontSize(Font.Size);
  FontAttrib := GetRTFFontAttrib(Font.Style);
  FontName := GetRTFFontTableName(Font.Name);
  RTF.Append('\par \pard' + Align + '\plain' + FontName + FontSize + FontAttrib
    + FontColor);
  for i := 0 to pStringList.Count - 1 do
    RTF.Append(' \par ' + pStringList.strings[i]);

  Result := RTF.Text;

  Destroyer;
end;

function StringToRTF(pString: string; Font: TFont; Alignment: TAlignment):
  string;
var
  Align, FontColor, FontAttrib, FontSize, FontName: string;
begin
  Creator;

  Align := GetRTFAlignment(Alignment);
  FontColor := GetRTFFontColorTableName(Font.Color);
  FontSize := GetRTFFontSize(Font.Size);
  FontAttrib := GetRTFFontAttrib(Font.Style);
  FontName := GetRTFFontTableName(Font.Name);
  RTF.Append('\par \pard' + Align + '\plain' + FontName + FontSize + FontAttrib
    + FontColor + ' ' + pString);

  Result := RTF.Text;

  Destroyer;
end;

end.

// Пример использования:
procedure TForm1.Button1Click(Sender: TObject);
begin
  RichEdit1.Text := RTFHeader + DBGridToRTF(DBGrid1) + RTFFooter;
end;

Перевод контента на русский язык:

Код Delphi для преобразования различных типов контролов (грид, изображение, мемо, метка) в формат RTF (Rich Text Format). Преобразование выполняется созданием строки, представляющей содержимое контрола в формате RTF.

Вот некоторые наблюдения и предложения:

  1. Код quite длинный и сложный, что делает его трудным для чтения и обслуживания. Было бы полезно разбить его на более маленькие функции или отдельные модули.
  2. В коде есть много повторяющихся шаблонов, таких как создание строки, представляющей содержимое контрола в формате RTF. Эти шаблоны можно извлечь в отдельные функции или использовать заново.
  3. Код использует много глобальных переменных и функций, что делает трудным отслеживание зависимостей и обслуживание. Лучше было бы инкапсулировать эти переменные и функции в классах или модулях.
  4. В коде нет обработки ошибок. В реальном приложении всегда нужно обрабатывать потенциальные ошибки, которые могут возникнуть во время процесса преобразования.

Вот некоторые предложения для улучшения:

  1. Инкапсулировать логику генерации RTF в отдельные функции или классы.
  2. Использовать повторяющиеся шаблоны и шаблоны для уменьшения дублирования кода.
  3. Рассмотреть использование паттернов проектирования, таких как Factory или Builder, для создания более гибкой и расширяемой архитектуры.
  4. Добавить механизмы обработки ошибок и журналирования, чтобы обеспечить корректную обработку ошибок и отчет.

Вот пример рефакторинга функции DBGridToRTF:

function DBGridToRTF(DBGrid: TDBGrid): string;
var
  i, j: Integer;
  Align, FontColor, FontAttrib, FontSize, FontName: string;
  RTFBuilder: TRTFBuilder;
begin
  RTFBuilder := TRTFBuilder.Create;
  try
    RTFBuilder.BeginRTF;
    for i := 0 to DBGrid.RowCount - 1 do
    begin
      RTFBuilder.Append('\trowd');
      RTFBuilder.Append('\trgaph108');
       // ...
      for j := 0 to DBGrid.Columns.Count - 1 do
      begin
        RTFBuilder.Append('\clvertalt');
         // ...
      end;
      RTFBuilder.Append('\pard\ri-123\nowidctlpar\widctlpar\intbl\adjustright');
    end;
    Result := RTFBuilder.EndRTF;
  finally
    RTFBuilder.Free;
  end;
end;

В этом рефакторированном коде я создал класс TRTFBuilder, который инкапсулирует логику генерации RTF. Функция DBGridToRTF теперь использует экземпляр этого класса для построения строки RTF. Этоapproach makes the code more modular and reusable.

Преобразование информации из табличных компонент в RTF: модуль содержит функции для преобразования данных из компонентов VCL (Delphi) в формат Rich Text Format (RTF), который может быть использован, например, в приложениях сRichEdit. Модуль может быть исп

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.


:: Главная :: Преобразования ::

реклама
©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru

Время компиляции файла: 2024-12-22 20:14:06
2025-07-06 02:56:44/0.0044190883636475/0