Адрес этой странички : http://doc-prg.narod.ru/art_00904/art_00904.htm 
Дата обновления: 14.10.2007

© 14.10.2007 Сергей Попов

Delphi-5.
Базы Данных.
Экспорт открытого набора данных TQuery в HTML

Статью в виде файла (307 кб) можно скачать здесь: art_00904.zip 

При программировании прикладных задач иногда бывает необходимо экспортировать информацию (в контексте содержимого какого-либо Delphi-компонента) в файлы HTML-формата.
Ниже приведен текст простой функции, иллюстрирующей  экспорт информации в HTML-документ применительно к Delphi-компоненту TQuery.
 

function Query_CopyToHTML(Q : TQuery; SelNameFields : TStrings; Head : string; AlignTable,BorderTable,SizeFontTopHead : integer; ListOut : TStrings) : integer; //Экспорт открытого набора Q данных в HTML-документ //Q - открытый набор данных //SelNameFields - список выводимых полей открытого набора данных Q (может быть NIL) //Head - заголовок //AlignTable - выравниваение таблицы: <0-Left, =0-Center, >0-Right //BorderTable - толщина линии таблицы //SizeFontTopHead - Размер шрифта наименований колонок таблицы //ListOut - результат (содержание HTML-документа) Var YesListFields, YesNext, YesRef,Align,i : integer; List2 : TStrings; begin Result:=0; YesListFields:=0; ListOut.Clear; //------------------------- //Проверяем, задан ли список выводимых полей набора данных Q if SelNameFields<>NIL then begin if SelNameFields.Count>0 then begin YesListFields:=1; end; end; //------------------------- //---------------------------------------------- //Создаем заголовок HTML-документа ListOut.Add(Create_TopHTML(Head,'Query_To_HTML','windows-1251','#FFFFFF','')); ListOut.Add(Create_StringForHTML('Date : '+DateTimeToStr(Now),'','','',-1,FALSE,FALSE,FALSE)); ListOut.Add(Create_EmptyStringForHTML); ListOut.Add(Create_StringForHTML(Head,'','',IntToStr(SizeFontTopHead),0,TRUE,FALSE,TRUE)); //---------------------------------------------- List2:=TStringList.Create; TRY List2.Clear; //Создаем заголовок таблицы для HTML-документа ListOut.Add(Create_TopTable(AlignTable,BorderTable)); {Выводим инфу} Q.First; {Сначала наименования полей} for i:=0 to (Q.FieldCount-1) do begin YesNext:=0; if Q.Fields[i].Visible then begin YesNext:=1; if YesListFields>0 then begin //Список экспортируемых полей существует. //Проверяем, можно ли выводить это поле YesNext:=0; if SelNameFields.IndexOf(Q.Fields[i].FieldName)>=0 then begin YesNext:=1; end; end; end; if YesNext>0 then begin List2.Add('0|1|0|0|0| | |'+Q.Fields[i].DisplayLabel); end; end; //Выводим строку таблицы - соответствующую наименованиям полей ListOut.Add(Create_LineTableHTML(List2)); {Теперь информацию} Q.First; while not Q.EOF do begin //Sx:=''; List2.Clear; for i:=0 to (Q.FieldCount-1) do begin YesNext:=0; if Q.Fields[i].Visible then begin YesNext:=1; if YesListFields>0 then begin //Список экспортируемых полей существует. //Проверяем, можно ли выводить это поле YesNext:=0; if SelNameFields.IndexOf(Q.Fields[i].FieldName)>=0 then begin YesNext:=1; end; end; end; if YesNext>0 then begin YesRef:=0; Align:=-1; if Q.Fields[i].Alignment = taLeftJustify then begin Align:=-1; end; if Q.Fields[i].Alignment = taCenter then begin Align:=0; end; if Q.Fields[i].Alignment = taRightJustify then begin Align:=1; end; if POS(AnsiUpperCase('http://'),AnsiUpperCase(Q.Fields[i].AsString))>0 then begin //Считаем, что в этом поле - HTTP-ссылка YesRef:=1; end; if POS(AnsiUpperCase('ftp://'),AnsiUpperCase(Q.Fields[i].AsString))>0 then begin //Считаем, что в этом поле - FTP-ссылка YesRef:=1; end; if POS('@',Q.Fields[i].AsString)>0 then begin if POS('.',Q.Fields[i].AsString)>0 then begin //Считаем, что в этом поле - электронный адрес YesRef:=1; end; end; List2.Add(IntToStr(Align)+'|0|0|'+IntToStr(YesRef)+'|0| | |'+Q.Fields[i].AsString); end; end; //Выводим сформированную строку таблицы ListOut.Add(Create_LineTableHTML(List2)); Application.ProcessMessages; Q.Next; end; //Создаем заключительную часть таблицы для HTML-документа ListOut.Add(Create_BottomTable(AlignTable)); //Добавляем заключительную часть HTML-документа ListOut.Add(Create_BottomHTML); FINALLY if List2<>NIL then begin List2.Clear; List2.Free; List2:=NIL; end; END; end;

Ниже представлены исходные тексты вспомогательных функций.

function Create_TopHTML(Title,Content,HTML_Cyr,BkColor,BkColorFileName : string) : string; //Создать заголовок HTML-документа //Title,Content - содержание соотв. тэгов заголовка //HTML_Cyr - кодовая страница документа //BkColor - цвет фона (тэг <body>) документа //BkColorFileName - имя граф.файла, определяющего фон (тэг <body>) документа //Если заданы оба значения: BkColor и BkColorFileName, то BkColorFileName доминирует //Функция возвращает строку, содержащую заголовок HTML-документа begin BkColorFileName:=Trim(BkColorFileName); BkColor:=Trim(BkColor); Title:=Trim(Title); Content:=Trim(Content); HTML_Cyr:=Trim(HTML_Cyr); if length(HTML_Cyr)<=0 then HTML_Cyr:='windows-1251'; Result:=''; Result:=Result+'<html>'; Result:=Result+'<meta http-equiv="Content-Type"'; Result:=Result+'content="text/html; charset='+HTML_Cyr+'">'; Result:=Result+'<meta name="GENERATOR" content="'+Content+'">'; Result:=Result+'<title>'+Title+'</title>'; Result:=Result+'</head>'; if Length(BkColorFileName)>0 then begin Result:=Result+'<body background="'+BkColorFileName+'" bgproperties="fixed" '; Result:=Result+'bgcolor="'+BkColor+'"'+'>'; end else begin Result:=Result+'<body bgcolor="'+BkColor+'"'+'>'; end; end; function Create_BottomHTML : string; //Создать заключительную часть HTML-документа //Функция возвращает строку, содержащую заключительную часть HTML-документа begin Result:=''; Result:=Result+' <!-- copyright (i7) --><div align="center"><a href="http://www.ucoz.ru/" title="Создать сайт бесплатно"><img style="margin:0;padding:0;border:0;" alt="Hosted by uCoz" src="http://s205.ucoz.net/img/cp/11.gif" width="80" height="15" title="Hosted by uCoz" /></a><br /></div><!-- /copyright --> </body>'; Result:=Result+'</html>'; end; function Create_TopFontHTML(sFaceFont,sColorFont,sSizeFont : string; IsBold,IsItalic,IsUnderline : Boolean) : string; //Сформировать начальный тэг для шрифта //sFaceFont - имя шрифта //sColorFont - цвет шрифта //sSizeFont - размер шрифта //IsBold - если TRUE, то "жирный шрифт" //IsItalic - если TRUE, то "наклонный шрифт" //IsUnderline - если TRUE, то "подчернутый шрифт" //Функция возвращает сформированную строку begin sFaceFont:=Trim(sFaceFont); sColorFont:=Trim(sColorFont); sSizeFont:=Trim(sSizeFont); Result:=''; Result:=Result+'<FONT '; if Length(sColorFont)>0 then Result:=Result+'COLOR="'+sColorFont+'"'; if Length(sSizeFont)>0 then Result:=Result+' size="'+sSizeFont+'"'; if Length(sFaceFont)>0 then Result:=Result+' face="'+sFaceFont+'"'; Result:=Result+'>'; if IsBold then begin Result:=Result+'<strong>'; end; if IsItalic then begin Result:=Result+'<em>'; end; if IsUnderline then begin Result:=Result+'<u>'; end; end; function Create_BottomFontHTML(IsBold,IsItalic,IsUnderline : Boolean) : string; //Сформировать заключительный тэг для шрифта //IsBold - если TRUE, то был "жирный шрифт" //IsItalic - если TRUE, то был "наклонный шрифт" //IsUnderline - если TRUE, то был "подчернутый шрифт" begin Result:=''; if IsUnderline then begin Result:=Result+'</u>'; end; if IsItalic then begin Result:=Result+'</em>'; end; if IsBold then begin Result:=Result+'</strong>'; end; Result:=Result+'</FONT>'; end; function Create_EmptyStringForHTML : string; //Сформировать пустую строку для HTML-документа begin Result:='<p> </p>'; end; function Create_StringForHTML(sInfo, sFaceFont,sColorFont,sSizeFont : string; Align : integer; IsBold,IsItalic,IsUnderline : Boolean) : string; //Сформировать информационную строку для HTML-документа //sInfo - информативная строка (выводимый текст) //sFaceFont - имя шрифта //sColorFont - цвет шрифта //sSizeFont - размер шрифта //IsBold - если TRUE, то "жирный шрифт" //IsItalic - если TRUE, то "наклонный шрифт" //IsUnderline - если TRUE, то "подчернутый шрифт" //Align - выравнивание текста //Функция возвращает сформированную строку Var Sx : string; begin Sx:=''; Result:=''; if Length(sInfo)<=0 then sInfo:=' '; if Align<0 then begin Result:=Result+'<p>'; end else begin if Align=0 then begin Result:=Result+'<p align="center">'; end else begin Result:=Result+'<p align="right">'; end; end; Result:=Result+Create_TopFontHTML(sFaceFont,sColorFont,sSizeFont,IsBold,IsItalic,IsUnderline); Result:=Result+sInfo; Result:=Result+Create_BottomFontHTML(IsBold,IsItalic,IsUnderline); Result:=Result+'</p>'; end; function Create_TopTable(align, border : integer) : string; //Создать заголовок таблицы для HTML-документа //Функция возвращает сформированную строку begin Result:=''; if align<0 then begin Result:=Result+'<div align="left">'; end; if align=0 then begin Result:=Result+'<div align="center"><center>'; end; if align>0 then begin Result:=Result+'<div align="right">'; end; Result:=Result+'<table border="'+IntToStr(border)+'" cellpadding="0" cellspacing="0">'; end; function Create_BottomTable(align : integer) : string; //Создать заключительную часть таблицы для HTML-документа //Функция возвращает сформированную строку begin Result:=''; if align=0 then begin Result:='</table></center></div>'; end else begin Result:='</table></div>'; end; end; function Create_LineTableHTML(ListData : TStrings) : string; { Сформировать строку таблицы HTML-документа ListData - Входная информация Одна строка - одна ячейка слово1 - align (-1,0,1) слово2 - strong (0,1) слово3 - italic (0,1) слово4 - ссылка (0,1) слово5 - закладка (0,1) слово6 - ИмяСсылки слово7 - ИмяЗакладки слово8 - Информация (выводимый текст) Разделитель слов - символ | (вертикальная линия) //Функция возвращает сформированную строку } Var NameZakl, //закладка NameRef, //ссылка Sx : string; YesZakl,YesRef,strong,italic, align, i : integer; begin Result:=''; if ListData<>NIL then begin if ListData.Count>0 then begin //Начальный тэг строки таблицы Result:=Result+'<tr>'; i:=-1; while i<(ListData.Count-1) do begin i:=i+1; //----------------------------------------- //Атрибуты ячейки таблицы align := sp_StrToInt(sp_GetWordFromString('|',ListData[i],1),0); strong := sp_StrToInt(sp_GetWordFromString('|',ListData[i],2),0); italic := sp_StrToInt(sp_GetWordFromString('|',ListData[i],3),0); //----------------------------------------- //----------------------------------------- //Ссылка и закладка в ячейке таблицы YesRef := sp_StrToInt(sp_GetWordFromString('|',ListData[i],4),0); YesZakl := sp_StrToInt(sp_GetWordFromString('|',ListData[i],5),0); NameRef := Trim(sp_GetWordFromString('|',ListData[i],6)); NameZakl := Trim(sp_GetWordFromString('|',ListData[i],7)); //----------------------------------------- //----------------------------------------- //Информационная часть ячейки таблицы Sx:=Trim(sp_GetWordFromString('|',ListData[i],8)); if Length(NameRef)<=0 then NameRef:=Sx; if Length(NameRef)<=0 then YesRef:=0; if Length(NameZakl)<=0 then YesZakl:=0; //----------------------------------------- //----------------------------------------- //Формируем выходную (результирующую) строку if length(Sx)<=0 then begin Sx:=' '; end; if align<0 then begin //Начальный тэг ячейки строки таблицы Result:=Result+'<td>'; end else begin if align=0 then begin //Начальный тэг ячейки строки таблицы Result:=Result+'<td align="center">'; end else begin //Начальный тэг ячейки строки таблицы Result:=Result+'<td align="right">'; end; end; if YesRef>0 then begin Result:=Result+'<a href="'+NameRef+'"'; if YesZakl>0 then begin Result:=Result+' name="'+NameZakl+'"'; end; Result:=Result+'>'; end else begin if YesZakl>0 then begin Result:=Result+'<a name="'+NameZakl+'">'; end; end; if strong>0 then begin Result:=Result+'<strong>'; end; if italic>0 then begin Result:=Result+'<em>'; end; Result:=Result+Sx; if strong>0 then begin Result:=Result+'</strong>'; end; if italic>0 then begin Result:=Result+'</em>'; end; if YesRef>0 then begin Result:=Result+'</a>'; end else begin if YesZakl>0 then begin Result:=Result+'</a>'; end; end; //Заключительный тэг ячейки строки таблицы Result:=Result+'</td>'; //----------------------------------------- end; //Заключительный тэг строки таблицы Result:=Result+'</tr>'; end; end; end;

Проверим, как это работает.

Создадим Delphi-проект.

Рис.1. Форма проекта Query_to_HTML.dpr

Создадим обработчик события : нажатие на кнопку "Выполнить".

procedure TForm1.SpeedButton3Click(Sender: TObject); //Открыть набор данных begin // Query1.Close; Query1.SQL.Clear; Query1.SQL.Assign(Memo1.Lines); Query1.Open; end;

Создадим обработчик события : нажатие на кнопку "Экспорт".

procedure TForm1.SpeedButton2Click(Sender: TObject); //Экспорт begin if Query1.Active then begin //Экспорт открытого набора данных в HTML-документ Query_CopyToHTML(Query1, NIL, 'Пример экспорта TQuery в HTML (http://doc-prg.narod.ru/art_00904/art_00904.htm)', 0,1,3, RE_HTML.Lines); end else begin ShowMessage('Набор данных не открыт ...'); end; end;

Этот текст достаточно прост и не требует доп. пояснений.

Создадим обработчик события : нажатие на кнопку "Сохранить и открыть".

procedure TForm1.SpeedButton1Click(Sender: TObject); Var Sx : string; begin if SaveDialog1.Execute then begin Sx:=SaveDialog1.FileName; RE_HTML.Lines.SaveToFile(Sx); if ShellExecute(Handle, 'open', PCHAR(Sx) , nil, nil, sw_Show)<=32 then begin ShowMessage('Ошибка при открытии документа : '+Sx); end; end; end;

Скомпилируем проект и запустим программу на выполнение.

Ниже приведен результат тестирования функции Query_CopyToHTML.

Рис.2. Результат тестирования функции Query_CopyToHTML

 Теперь, сохраним результат в файл на диске :

Рис.3. Сохранить содержание HTML-документа в файл

После записи на диск - сформированный файл откроется в IE :

Рис.4. Сформированный HTML-документ

Результат момжно посмотреть здесь: открыть сформированный HTML-документ query_to_html.htm .

Исходные тексты этого проекта можно взять здесь (31 кб) :  query_to_html.zip

© 14.10.2007 Сергей Попов