DBGrid变换成HTML表格

DBGrid变换成HTML表格

提交日期:2003-8-9

关键词:DBGrid HTML

///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, '&', '&AMP;', [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:.htm'); ShellExecute(Handle, nil, 'c:.htm', nil, nil, SW_SHOW); end; ///End Demo