|
Code: |
|
procedure SGridToHtml(SG: TStringgrid; Dest: TMemo; BorderSize: Integer); var i, p: integer; SStyle1, SStyle2, Text: string; begin Dest.Clear; Dest.Lines.Add('<html>'); Dest.Lines.Add('<body>'); Dest.Lines.Add(' <table border="' + IntToStr(BorderSize) + '" width="' + IntToStr(SG.Width) + '" height="' + IntToStr(SG.Width) + '">');
for i := 0 to SG.RowCount - 1 do begin Dest.Lines.Add(' <tr>'); for p := 0 to SG.ColCount - 1 do begin SStyle1 := ''; SStyle2 := ''; if fsbold in SG.Font.Style then begin SStyle1 := SStyle1 + '<b>'; SStyle2 := SStyle2 + '</b>'; end; if fsitalic in SG.Font.Style then begin SStyle1 := SStyle1 + '<i>'; SStyle2 := SStyle2 + '</i>'; end; if fsunderline in SG.Font.Style then begin SStyle1 := SStyle1 + '<u>'; SStyle2 := SStyle2 + '</u>'; end; Text := sg.Cells[p, i]; if Text = '' then Text := ' '; Dest.Lines.Add(' <td width="' + IntToStr(sg.ColWidths[p]) + '" height="' + IntToStr(sg.RowHeights[p]) + '"><font color="#' + IntToHex(sg.Font.Color, 6) + '" face="' + SG.Font.Name + '">' + SStyle1 + Text + SStyle2 + '</font></td>'); end; Dest.Lines.Add(' </tr>'); end; Dest.Lines.Add(' </table>'); Dest.Lines.Add('</body>');; Dest.Lines.Add('</html>'); end;
// Example, Beispiel procedure TFormCSVInport.Button6Click(Sender: TObject); begin SGridToHtml(StringGrid1, Memo1, 1); Memo1.Lines.SaveToFile('c:\test.html'); end; |
- Назад
- Вперёд >>
Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.
ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!