Internet - gerando html a partir de tabela

Top  Previous  Next

--------------- Salvando o conteúdo de uma grid em HTML ----------------------

 

  Vai precisar de:

 

    1 TButton

    1 TQuery

    1 TDataSetTableProducer 

 

-------------------------------------------------------------------------------

 

uses ShellAPI;

 

procedure GerarHtml

const

  Campos: array[1..4of string = ('codigo','cod_barra''nome_redu','vlr_venda');

var

  L: TStringList;

  I: Integer;

  C: array [1..4of THtmlTableColumn;

begin

  Query.Select('* from produtos');

  TFloatField(Query.FieldByName('vlr_venda')).DisplayFormat := '#,##0.00';

 

  with DataSetTableProducer1 do

  begin

    // Limpa todas as colunas

    Columns.Clear;

 

    // cria as colunas em RunTime.... 

    // nota: não é obritorio fazer isso via codigo, clique 2x sobre o componente

    for I := 1 to 4 do

    begin

      C[I] := THtmlTableColumn.Create( DataSetTableProducer1.Columns );

      if I = 0 then Columns.Add;

      C[I].Field     := Query.FieldByName( Campos[I] );

      C[I].FieldName := Campos[I];

      Columns[I-1].Assign(C[I]);

      if Campos[I] <> 'nome_redu' then Columns[I-1].Align := haRight;

    end;

 

    // Associa Query

    DataSet := Query;

 

    // Cabecalho da pagina

    Header.Add('<html><head><title>Pagina teste</title></head><body>');

    Header.Add('<p><font size="4"><b>Exemplo de Página da Web criada a partir de tabelas no Delphi</b>');

    Header.Add('</font></p><p>Abaixo os dados:</p><hr><p>&nbsp;</p><p>&nbsp;</p></body></html>');

    Caption := '<p><font size="6">Outros</font></p>';

 

    // Atributos da grid html

    TableAttributes.BgColor     := 'White';

    TableAttributes.Border      := 1;

    TableAttributes.CellSpacing := 1;

    TableAttributes.CellPadding := 5;

 

    // salva

    L      := TStringList.Create;

    L.Text := Content;

    L.SaveToFile('C:\Pagina.html');

    ShellExecute(Handle, 'open''C:\Pagina.html''''', sw_ShowNormal);

    L.Free;

    for I := 1 to 4 do C[I].Free;

  end;

end;

 

// Pode-se personalizar algumas celulas em especial:

 

procedure TForm1.DataSetTableProducer1FormatCell(Sender: TObject; CellRow,

  CellColumn: Integer; var BgColor: THTMLBgColor; var Align: THTMLAlign;

  var VAlign: THTMLVAlign; var CustomAttrs, CellData: String);

begin

  if (CellColumn = 3and (CellRow > 0) then // é coluna valor?

  begin

    BgColor := 'Yellow';  // celula de valores amarela

    if Length(CellData)  > 4 then  // se o valor é > 9.99 então cor vermelha na letra:

      CellData := '<font color="#FF0000">' + CellData + '</font>';

  end

end;

 

----------------------------------------------------------------------------------

OBS:

Se derem erros do tipo Unit1.pas has compiled with different version of Unit2

deve copiar os PAS da pasta source da Unit1 para a LIB