Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

Видеокурс программиста и крэкера 5D 2O17
(актуальность: октябрь 2O17)
Свежие инструменты, новые видеоуроки!

  • 400+ видеоуроков
  • 800 инструментов
  • 100+ свежих книг и статей

УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Экспортировать 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;
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS