Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Экспортировать DBGrid в HTML

Автор: Тенцер А.Л.

Звонит юзеp oпеpатоpу АТС:
- Девушка! Мне тут какой-то совеpшенно дикий счет пpишел за услуги связи...
- Ваш номеp?
- 555-55-55
- Так... Все веpно. Это счет за секс-услуги по телефону.
- Да ты че! Я такой гадостью сpоду не занимался!
- Как? А неделю назад вы звонили Васе Пупкину по телефону 444-44-44 и пытались настpоить полуось?


type
 TGridToHTMLOption = (ghWithHeaders);
 TGridToHTMLOptions = set of TGridToHTMLOption;

function DBGridToHTML(Grid : TDBGrid;
  ExportOptions: TGridToHTMLOptions): String;
const
  HTMLStart =
   '< !DOCTYPE HTML PUBLIC " -//W3C//DTD HTML 4.0 Transitional//EN" > '#13
+
   '< HTML> '#13 +
   '< HEAD> < META http-equiv=Content-Type content=" text/html;
charset=windows-1251" > '#13 +
   '< STYLE> '#13 +
   'BODY {'#13 +
   ' BACKGROUND: white;'#13 +
   ' COLOR: black;'#13 +
   ' FONT-FAMILY: arial;'#13 +
   ' FONT-SIZE: 8pt;'#13 +
   ' VERTICAL-ALIGN: top'#13 +
   '}'#13 +
   'TABLE {'#13 +
   ' BACKGROUND: white;'#13 +
   ' BORDER-BOTTOM: silver 0px solid;'#13 +
   ' BORDER-LEFT: silver 1px solid;'#13 +
   ' BORDER-RIGHT: silver 0px solid;'#13 +
   ' BORDER-TOP: silver 1px solid;'#13 +
   ' FONT-FAMILY: arial;'#13 +
   ' FONT-SIZE: 8pt;'#13 +
   ' FONT-WEIGHT: normal;'#13 +
   '}'#13 +
   'TD {'#13 +
   ' BORDER-BOTTOM: silver 1px solid;'#13 +
   ' BORDER-LEFT: silver 0px solid;'#13 +
   ' BORDER-RIGHT: silver 1px solid;'#13 +
   ' BORDER-TOP: silver 0px solid;'#13 +
   ' VERTICAL-ALIGN: top;'#13 +
   ' TEXT-ALIGN: left;'#13 +
   '}'#13 +
   'TD.grid {'#13 +
   ' TEXT-ALIGN: left;'#13 +
   '}'#13 +
   'TD.gridr {'#13 +
   ' TEXT-ALIGN: right;'#13 +
   '}'#13 +
   'TD.gridc {'#13 +
   ' TEXT-ALIGN: center;'#13 +
   '}'#13 +
   'TH {'#13 +
   ' BACKGROUND: silver;'#13 +
   ' BORDER-BOTTOM: gray 1px solid;'#13 +
   ' BORDER-LEFT: gray 0px solid;'#13 +
   ' BORDER-RIGHT: gray 1px solid;'#13 +
   ' BORDER-TOP: gray 0px solid;'#13 +
   ' FONT-WEIGHT: bold;'#13 +
   '}'#13 +
   'TH.grid {'#13 +
   ' TEXT-ALIGN: left;'#13 +
   '}'#13 +
   'TH.gridr {'#13 +
   ' TEXT-ALIGN: right;'#13 +
   '}'#13 +
   'TH.gridc {'#13 +
   ' TEXT-ALIGN: center;'#13 +
   '}'#13 +
   '< /STYLE> '#13 +
   '< TITLE> Печать таблицы< /TITLE> '#13 +
   '< /HEAD> '#13 +
   '< BODY> '#13;
  HTMLEnd = '< /BODY> < /HTML> ';
  TableStart = '< TABLE WIDTH=" 100%"  CELLSPACING=0 CELLPADDING=1> '#13;
  TableEnd = '< /TABLE> '#13;
  HeaderRowStart = '< TR> '#13;
  HeaderRowEnd = '< /TR> '#13;
  BodyRowStart = '< TR> '#13;
  BodyRowEnd = '< /TR> '#13;

const
  StyleNames: array [TAlignment] of String = ('grid', 'gridr',
'gridc');

  function TD(Column: TColumn; IsTitle: Boolean; Widht: Integer):
String;
  var
    S: String;
    Align: TAlignment;
    Tag: String;
  begin
    if IsTitle then begin
      Tag := 'TH';
      Align := Column.Title.Alignment;
      S := StyleNames[Align];
    end else begin
      Tag := 'TD';
      Align := Column.Alignment;
      if Align = taLeftJustify then begin
        if (Column.Field is TBCDField) or
           (Column.Field is TCurrencyField) then
          Align := taRightJustify;
        if (Column.Field is TBooleanField) then
          Align := taCenter;
      end;
      S := StyleNames[Align];
      if (Column.Field is TBCDField) or (Column.Field is
TIntegerField) then
        S := S + ' NOWRAP'
    end;
    if Widht >  0 then
      S := S + Format(' WIDTH=" %d%%" ', [Widht]);
    Result := '< ' + Tag + ' class=' + S + '> ';
    if IsTitle then begin
      S := Column.Title.Caption
    end else begin
      if Column.Field is TBooleanField then
      with TBooleanField(Column.Field) do begin
        if Length(DisplayValues) = 0 then begin
          if AsBoolean then
            S := 'да'
          else
            S := 'нет';
        end else
          S := Column.Field.DisplayText;
      end else
        S := Column.Field.DisplayText;
    end;
    if Length(Trim(S)) = 0 then
      S := ' ';
    Result := Result + S + '< /' + Tag + '> '#13;
  end;

var
 BM : String;
 I : Integer;
 Widhts: array of Integer;
 TotalWidht: Integer;
begin
  Result := '';
  with Grid  do begin
    if Assigned(DataSource) and
       Assigned(DataSource.DataSet) and
       DataSource.DataSet.Active then
    with DataSource.DataSet do begin
      DisableControls;
      BM := BookMark;
      SetLength(Widhts, Columns.Count);
      TotalWidht := 0;
      for I := 0 to Pred(Columns.Count) do begin
        if Assigned(Columns[I].Field) then begin
          Widhts[I] := Columns[I].Width;
          Inc(TotalWidht, Widhts[I]);
        end;
      end;
      for I := 0 to High(Widhts) do begin
        Widhts[I] := Widhts[I] * 100 div TotalWidht;
      end;
      Result := HTMLStart;
      Result := Result + TableStart;
      if (ghWithHeaders in ExportOptions) then begin
        Result := Result + HeaderRowStart;
        for I := 0 to Pred(Columns.Count) do begin
          if Assigned(Columns.Items[I].Field) then begin
            Result := Result + TD(Columns.Items[I], TRUE, Widhts[I]);
          end;
        end;
        Result := Result + HeaderRowEnd;
      end;
      First;
      while not Eof do begin
        Result := Result + BodyRowStart;
        for I := 0 to Pred( Columns.Count ) do begin
          if Assigned(Columns.Items[I].Field) then begin
            Result := Result + TD(Columns.Items[I], FALSE,
-1{Integer(Widhts[Index]});
          end;
        end;
        Result := Result + BodyRowEnd;
        Next;
      end;
      Result := Result + TableEnd + HTMLEnd;
      BookMark := BM;
      EnableControls;
    end;
  end;
end;

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.