(*//

标题:数据网格处理成超文本表格

说明:支持对齐、字体、背景颜色;做打印又有一种新方法了！

设计:Zswang

日期:2002-05-19

支持:wjhu111@21cn.com

//*)

///////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 Result ='' then Result:='-';

 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