///////Begin Source

function ColorToHtml(mColor: TColor): string;

begin

  mColor := ColorToRGB(mColor);

  Result := Format('#%.2x%.2x%.2x',

    [GetRValue(mColor), GetGValue(mColor), GetBValue(mColor)]);

end; { ColorToHtml }



function StrToHtml(mStr: string; mFont: TFont = nil): string;

var

  vLeft, vRight: string;

begin

  Result := mStr;

  Result := StringReplace(Result, '&', '&', [rfReplaceAll]);

  Result := StringReplace(Result, '<', '&LT;', [rfReplaceAll]);

  Result := StringReplace(Result, '>', '&GT;', [rfReplaceAll]);

  if not Assigned(mFont) then Exit;

  vLeft := Format('<FONT FACE="%s" COLOR="%s">',

    [mFont.Name, ColorToHtml(mFont.Color)]);

  vRight := '</FONT>';

  if fsBold in mFont.Style then begin

    vLeft := vLeft + '<B>';

    vRight := '</B>' + vRight;

  end;

  if fsItalic in mFont.Style then begin

    vLeft := vLeft + '<I>';

    vRight := '</I>' + vRight;

  end;

  if fsUnderline in mFont.Style then begin

    vLeft := vLeft + '<U>';

    vRight := '</U>' + vRight;

  end;

  if fsStrikeOut in mFont.Style then begin

    vLeft := vLeft + '<S>';

    vRight := '</S>' + vRight;

  end;

  Result := vLeft + Result + vRight;

end; { StrToHtml }



function DBGridToHtmlTable(mDBGrid: TDBGrid; mStrings: TStrings;

  mCaption: TCaption = ''): Boolean;

const

  cAlignText: array[TAlignment] of string = ('LEFT', 'RIGHT', 'CENTER');

var

  vColFormat: string;

  vColText: string;

  vAllWidth: Integer;

  vWidths: array of Integer;

  vBookmark: string;

  I, J: Integer;

begin

  Result := False;

  if not Assigned(mStrings) then Exit;

  if not Assigned(mDBGrid) then Exit;

  if not Assigned(mDBGrid.DataSource) then Exit;

  if not Assigned(mDBGrid.DataSource.DataSet) then Exit;

  if not mDBGrid.DataSource.DataSet.Active then Exit;

  vBookmark := mDBGrid.DataSource.DataSet.Bookmark;

  mDBGrid.DataSource.DataSet.DisableControls;

  try

    J := 0;

    vAllWidth := 0;

    for I := 0 to mDBGrid.Columns.Count - 1 do

      if mDBGrid.Columns[I].Visible then begin

        Inc(J);

        SetLength(vWidths, J);

        vWidths[J - 1] := mDBGrid.Columns[I].Width;

        Inc(vAllWidth, mDBGrid.Columns[I].Width);

      end;

    if J <= 0 then Exit;

    mStrings.Clear;

    mStrings.Add(Format('<TABLE BGCOLOR="%s" BORDER=1 WIDTH="100%%">',

      [ColorToHtml(mDBGrid.Color)]));

    if mCaption <> '' then

      mStrings.Add(Format('<CAPTION>%s</CAPTION>', [StrToHtml(mCaption)]));

    vColFormat := '';

    vColText := '';

    vColFormat := vColFormat + '<TR>'#13#10;

    vColText := vColText + '<TR>'#13#10;

    J := 0;

    for I := 0 to mDBGrid.Columns.Count - 1 do

      if mDBGrid.Columns[I].Visible then begin

        vColFormat := vColFormat + Format(

'  <TD BGCOLOR="%s" ALIGN=%s WIDTH="%d%%">DisplayText%d</TD>'#13#10,

          [ColorToHtml(mDBGrid.Columns[I].Color),

          cAlignText[mDBGrid.Columns[I].Alignment],

          Round(vWidths[J] / vAllWidth * 100), J]);

        vColText := vColText + Format(

'  <TD BGCOLOR="%s" ALIGN=%s WIDTH="%d%%">%s</TD>'#13#10,

          [ColorToHtml(mDBGrid.Columns[I].Title.Color),

          cAlignText[mDBGrid.Columns[I].Alignment],

          Round(vWidths[J] / vAllWidth * 100),

          StrToHtml(mDBGrid.Columns[I].Title.Caption,

            mDBGrid.Columns[I].Title.Font)]);

        Inc(J);

      end;

    vColFormat := vColFormat + '</TR>'#13#10;

    vColText := vColText + '</TR>'#13#10;

    mStrings.Text := mStrings.Text + vColText;

    mDBGrid.DataSource.DataSet.First;

    while not mDBGrid.DataSource.DataSet.Eof do begin

      J := 0;

      vColText := vColFormat;

      for I := 0 to mDBGrid.Columns.Count - 1 do

        if mDBGrid.Columns[I].Visible then begin

          vColText := StringReplace(vColText, Format('>DisplayText%d<', [J]),

            Format('>%s<', [StrToHtml(mDBGrid.Columns[I].Field.DisplayText,

              mDBGrid.Columns[I].Font)]),

            [rfReplaceAll]);

          Inc(J);

        end;

      mStrings.Text := mStrings.Text + vColText;

      mDBGrid.DataSource.DataSet.Next;

    end;

    mStrings.Add('</TABLE>');

  finally

    mDBGrid.DataSource.DataSet.Bookmark := vBookmark;

    mDBGrid.DataSource.DataSet.EnableControls;

    vWidths := nil;

  end;

  Result := True;

end; { DBGridToHtmlTable }

///////End Source



{ uses ShellApi; }



///////Begin Demo

procedure TForm1.Button1Click(Sender: TObject);

begin

  DBGridToHtmlTable(DBGrid1, Memo1.Lines, Caption);

  Memo1.Lines.SaveToFile('c:\temp.htm');

  ShellExecute(Handle, nil, 'c:\temp.htm', nil, nil, SW_SHOW);

end;

///////End Demo