Mega Code Archive

 
Categories / Delphi / ADO Database
 

DBGrid To Html Table

Title: DBGrid To Html Table Question: Deal with Font, bgColor, Alignment. (*// function ColorToHtml(mColor: TColor): string; function StrToHtml(mStr: string; mFont: TFont = nil): string; //*) Answer: ///////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, ', '<', [rfReplaceAll]); Result := StringReplace(Result, '', '>', [rfReplaceAll]); if not Assigned(mFont) then Exit; vLeft := Format('', [mFont.Name, ColorToHtml(mFont.Color)]); vRight := ''; if fsBold in mFont.Style then begin vLeft := vLeft + ''; vRight := '' + vRight; end; if fsItalic in mFont.Style then begin vLeft := vLeft + ''; vRight := '' + vRight; end; if fsUnderline in mFont.Style then begin vLeft := vLeft + ''; vRight := '' + vRight; end; if fsStrikeOut in mFont.Style then begin vLeft := vLeft + ''; vRight := '' + 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('', [ColorToHtml(mDBGrid.Color)])); if mCaption '' then mStrings.Add(Format('%s', [StrToHtml(mCaption)])); vColFormat := ''; vColText := ''; vColFormat := vColFormat + ''#13#10; vColText := vColText + ''#13#10; J := 0; for I := 0 to mDBGrid.Columns.Count - 1 do if mDBGrid.Columns[I].Visible then begin vColFormat := vColFormat + Format( ' DisplayText%d'#13#10, [ColorToHtml(mDBGrid.Columns[I].Color), cAlignText[mDBGrid.Columns[I].Alignment], Round(vWidths[J] / vAllWidth * 100), J]); vColText := vColText + Format( ' %s'#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 + ''#13#10; vColText := vColText + ''#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(''); 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