Категория: Разработка Теги: Lazarus Опубликовано: 30 ноября 2020

Экспорт содержимого DBGrid в HTML - Lazarus

Когда-то давно у меня появилась потребность в программе реализовать функциональность сохранения отчетов, как один из форматов был выбран html. Для среды разработки Delphi много вариантов реализации данной функциональности, и хоть они и подходят с небольшими коррективами для среды разработки Lazarus, менять многие вещи в процессе работы над программой мне всё таки приходилось. В связи с этим, решил опубликовать код данной процедуры.

Стоит конечно отметить, что исходный код программы и так опубликован, но на данный момент яндекс и гугл не умеют индексировать файлы формата pas, тем более из архива. А так, человек набрав в поиске сформулированную мысль из своей головы может найти что-то подобное на данной странице.

Большим специалистом по Lazarus себя не считаю, но... примеров для этой среды не так много (если сравнивать с делфи), поэтому делаю так сказать свой вклад.

Итак, перейдём к самому коду. Сначала публикую исходный вариант, как он есть в моём проекте.

procedure TfMian.mExportHTMLClick(Sender: TObject);
var

t:TStringList;
i:Integer;
s:string;
filename : String;
//Для имени пк
i1: DWORD;
p1: PChar;


begin
i1:=255;
GetMem(p1, i1);
GetComputerName(p1, i1);
// если открыт авто поиск
if PageControl1.ActivePageindex=0 then
begin
SD2.FileName:=filename;
if SD2.Execute then
begin
filename:=SD2.FileName;
t:=TStringList.Create;
DBGrid1.DataSource.DataSet.first;
t.add('<html>');
t.add('<head>');
t.add('<meta http-equiv="Content-Type" content="text/html; charset=utf-8">');
t.add('</head>');
t.add('<h1 align=center>Lpro - Проверка лицензий установленных программ</h1>');
t.add('<h2 align=center>Имя компьютера: ' + p1 + '</h2>');
t.add('<html>');
t.add('<table border=1 align=center>');
//
t.add('<tr>');
t.add('<td> Исходное название');
t.add('<td> Название в БД');
t.add('<td> Тип ПО');
t.add('<td> Лицензия');
t.add('<td> Стоимость');
t.add('<td> Замена');
t.add('</tr>');
//
t.add('<tr>');
for i:=6 to DBGrid1.DataSource.DataSet.Fields.Count-1 do
t.add('<td>'+DBGrid1.DataSource.DataSet.fields[i].fieldname);
t.add('</tr>');
while not DBGrid1.DataSource.DataSet.eof do
begin
s:='<tr>';
for i:=0 to DBGrid1.DataSource.DataSet.Fields.Count-1 do
s:=s+'<td>'+DBGrid1.DataSource.DataSet.fields[i].AsString;
s:=s+'</tr>';
t.add(SysToUTF8(s)); // UTF8ToCP1251
DBGrid1.DataSource.DataSet.next;
end;
t.add('</table>');
t.add('<p align=center>Официальный сайт: <a href="http://xn--90abhbolvbbfgb9aje4m.xn--p1ai/">КонтинентСвободы.рф</a></p>');
t.add('</html>');
t.savetofile(filename);
end;
DBGrid1.DataSource.DataSet.first;

end;

// если открыт ручной поиск
if PageControl1.ActivePageindex=1 then
begin
SD2.FileName:=filename;
if SD2.Execute then
begin
filename:=SD2.FileName;
t:=TStringList.Create;
DBGrid2.DataSource.DataSet.first;
t.add('<html>');
t.add('<head>');
t.add('<meta http-equiv="Content-Type" content="text/html; charset=utf-8">');
t.add('</head>');
t.add('<h1 align=center>Lpro - Проверка лицензий установленных программ</h1>');
t.add('<h2 align=center>Имя компьютера: ' + p1 + '</h2>');
t.add('<html>');
t.add('<table border=1 align=center>');
//
t.add('<tr>');
t.add('<td> ID');
t.add('<td> Название');
t.add('<td> Тип ПО');
t.add('<td> Лицензия');
t.add('<td> Стоимость');
t.add('<td> Замена');
t.add('</tr>');
//
t.add('<tr>');
for i:=6 to DBGrid2.DataSource.DataSet.Fields.Count-1 do
t.add('<td>'+DBGrid2.DataSource.DataSet.fields[i].fieldname);
t.add('</tr>');
while not DBGrid2.DataSource.DataSet.eof do
begin
s:='<tr>';
for i:=0 to DBGrid2.DataSource.DataSet.Fields.Count-1 do
s:=s+'<td>'+DBGrid2.DataSource.DataSet.fields[i].AsString;
s:=s+'</tr>';
t.add(SysToUTF8(s)); // UTF8ToCP1251
DBGrid2.DataSource.DataSet.next;
end;
t.add('</table>');
t.add('<p align=center>Официальный сайт: <a href="http://xn--90abhbolvbbfgb9aje4m.xn--p1ai/">КонтинентСвободы.рф</a></p>');
t.add('</html>');
t.savetofile(filename);
end;
DBGrid2.DataSource.DataSet.first;
FreeMem(p1);
end;

end;

У меня на главной странице есть вкладки, и экспорт нужно совершать в зависимости от того, какая вкладка активна, чтобы знать от куда брать данные. Вам скорее всего такое не нужно, поэтому ниже сделаю вариант без данных условий. Также хочу отметить, здесь записывается имя компьютера.

procedure TfMian.mExportHTMLClick(Sender: TObject);
var

t:TStringList;
i:Integer;
s:string;
filename : String;
//Для имени пк
i1: DWORD;
p1: PChar;
begin

 

i1:=255;
GetMem(p1, i1);
GetComputerName(p1, i1);

 

SD2.FileName:=filename;
if SD2.Execute then
begin
filename:=SD2.FileName;
t:=TStringList.Create;
DBGrid1.DataSource.DataSet.first;
t.add('<html>');
t.add('<head>');
t.add('<meta http-equiv="Content-Type" content="text/html; charset=utf-8">');
t.add('</head>');
t.add('<h1 align=center>Lpro - Проверка лицензий установленных программ</h1>');
t.add('<h2 align=center>Имя компьютера: ' + p1 + '</h2>');
t.add('<html>');
t.add('<table border=1 align=center>');
//
t.add('<tr>');
t.add('<td> Исходное название');
t.add('<td> Название в БД');
t.add('<td> Тип ПО');
t.add('<td> Лицензия');
t.add('<td> Стоимость');
t.add('<td> Замена');
t.add('</tr>');
//
t.add('<tr>');
for i:=6 to DBGrid1.DataSource.DataSet.Fields.Count-1 do
t.add('<td>'+DBGrid1.DataSource.DataSet.fields[i].fieldname);
t.add('</tr>');
while not DBGrid1.DataSource.DataSet.eof do
begin
s:='<tr>';
for i:=0 to DBGrid1.DataSource.DataSet.Fields.Count-1 do
s:=s+'<td>'+DBGrid1.DataSource.DataSet.fields[i].AsString;
s:=s+'</tr>';
t.add(SysToUTF8(s)); // UTF8ToCP1251
DBGrid1.DataSource.DataSet.next;
end;
t.add('</table>');
t.add('<p align=center>Официальный сайт: <a href="http://xn--90abhbolvbbfgb9aje4m.xn--p1ai/">КонтинентСвободы.рф</a></p>');
t.add('</html>');
t.savetofile(filename);
end;
DBGrid1.DataSource.DataSet.first;

Данный пример взят из программы Lpro, скачать и ознакомиться с её исходным кодом можно на данной странице. Если есть какие-то вопросы по коду, то их можно задать на той же странице.

Алексей Черемных

2017

Экспорт содержимого DBGrid в HTML - Lazarus

Похожие материалы: