Marco Cantù 1998, Mastering Delphi 4
Project: DBTOHTML.DPR
Project Structure
DBTOHTML.DPR
program DbToHtml;
uses
Forms,
DBHForm in 'DBHForm.pas' {Navigator};
{$R *.RES}
begin
Application.CreateForm(TNavigator, Navigator);
Application.Run;
end.
DBHFORM.PAS
unit DBHForm;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics,
Controls, Forms, DBCtrls, StdCtrls, DBTables,
ExtCtrls, Mask, Db, Dialogs;
type
TNavigator = class(TForm)
BtnPrint: TButton;
DBEdit3: TDBEdit;
Label3: TLabel;
Label2: TLabel;
DBEdit2: TDBEdit;
DBEdit1: TDBEdit;
Label1: TLabel;
DBNavigator1: TDBNavigator;
Table1: TTable;
DataSource1: TDataSource;
SaveDialog1: TSaveDialog;
Memo1: TMemo;
Label4: TLabel;
BtnSave: TButton;
CheckStart: TCheckBox;
BtnLine: TButton;
procedure BtnPrintClick(Sender: TObject);
procedure BtnSaveClick(Sender: TObject);
procedure BtnLineClick(Sender: TObject);
public
procedure AddHeader (Str: TStrings; Title: string);
procedure AddFooter (Str: TStrings);
procedure AddAllLines (Str: TStrings);
end;
var
Navigator: TNavigator;
implementation
{$R *.DFM}
uses
ShellAPI;
procedure TNavigator.AddHeader (
Str: TStrings; Title: string);
begin
Str.Add ('<HTML>');
Str.Add ('<HEAD>');
Str.Add ('<TITLE>' + Title + '</TITLE>');
Str.Add ('</HEAD>');
Str.Add ('<BODY>');
Str.Add ('<H1><CENTER>' + Title + '</CENTER></H1>');
end;
procedure TNavigator.AddFooter (Str: TStrings);
begin
Str.Add ('<HR>');
Str.Add ('Generated by the program ' +
ExtractFilename (Application.Exename));
Str.Add ('</BODY>');
Str.Add ('</HTML>');
end;
procedure TNavigator.BtnPrintClick(Sender: TObject);
begin
Memo1.Clear;
AddHeader (Memo1.Lines,
'Table: ' + Table1.TableName);
AddAllLines (Memo1.Lines);
AddFooter (Memo1.Lines);
BtnSave.Enabled := True;
end;
procedure TNAvigator.AddAllLines (Str: TStrings);
var
Bookmark: TBookmark;
begin
// disable the UI
Table1.DisableControls;
try
// store the current position
Bookmark := Table1.GetBookmark;
try
// scan the database table
Table1.First;
while not Table1.EOF do
begin
// send the two fields
Str.Add (Format ('The capital of %s is %s<p>',
[Table1.FieldByName ('Name').AsString,
Table1.FieldByName ('Capital').AsString]));
Table1.Next;
end;
finally
// go back to the bookmark and destroy it
Table1.GotoBookmark (Bookmark);
Table1.FreeBookmark (Bookmark);
end;
finally
// re-enable the controls
Table1.EnableControls;
end;
end;
procedure TNavigator.BtnSaveClick(Sender: TObject);
begin
if SaveDialog1.Execute then
begin
Memo1.Lines.SaveToFile (SaveDialog1.FileName);
if CheckStart.Checked then
ShellExecute (Handle, 'open',
PChar (SaveDialog1.FileName),
'', '', sw_ShowNormal);
end;
end;
procedure TNavigator.BtnLineClick(Sender: TObject);
var
I: Integer;
begin
Memo1.Clear;
AddHeader (Memo1.Lines, Table1.Fields[0].AsString);
for I := 1 to Table1.FieldCount - 1 do
Memo1.Lines.Add (Table1.Fields [I].FieldName + ': ' +
Table1.Fields [I].AsString + '<p>');
AddFooter (Memo1.Lines);
BtnSave.Enabled := True;
end;
end.
DBHFORM.DFM
object Navigator: TNavigator
Left = 190
Top = 108
Width = 427
Height = 380
Caption = 'Navigator'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
PixelsPerInch = 96
TextHeight = 13
object Label3: TLabel
Left = 40
Top = 124
Width = 48
Height = 13
Caption = 'Continent:'
end
object Label2: TLabel
Left = 40
Top = 91
Width = 35
Height = 13
Caption = 'Capital:'
end
object Label1: TLabel
Left = 40
Top = 56
Width = 39
Height = 13
Caption = 'Country:'
end
object Label4: TLabel
Left = 40
Top = 152
Width = 71
Height = 13
Caption = 'HTML Preview'
end
object BtnPrint: TButton
Left = 296
Top = 82
Width = 89
Height = 25
Caption = '&Print All'
TabOrder = 0
OnClick = BtnPrintClick
end
object DBEdit3: TDBEdit
Left = 104
Top = 120
Width = 169
Height = 21
DataField = 'Continent'
DataSource = DataSource1
TabOrder = 1
end
object DBEdit2: TDBEdit
Left = 104
Top = 86
Width = 169
Height = 21
DataField = 'Capital'
DataSource = DataSource1
MaxLength = 24
TabOrder = 2
end
object DBEdit1: TDBEdit
Left = 104
Top = 52
Width = 169
Height = 21
DataField = 'Name'
DataSource = DataSource1
MaxLength = 24
TabOrder = 3
end
object DBNavigator1: TDBNavigator
Left = 0
Top = 0
Width = 419
Height = 25
DataSource = DataSource1
VisibleButtons = [nbFirst, nbPrior, nbNext, nbLast, nbInsert, nbEdit, nbPost, nbCancel]
Align = alTop
Flat = True
TabOrder = 4
end
object Memo1: TMemo
Left = 40
Top = 176
Width = 345
Height = 153
TabOrder = 5
end
object BtnSave: TButton
Left = 296
Top = 122
Width = 89
Height = 25
Caption = 'Save HTML'
Enabled = False
TabOrder = 6
OnClick = BtnSaveClick
end
object CheckStart: TCheckBox
Left = 296
Top = 150
Width = 89
Height = 17
Caption = 'Start Browser'
Checked = True
State = cbChecked
TabOrder = 7
end
object BtnLine: TButton
Left = 296
Top = 52
Width = 89
Height = 25
Caption = 'Print &Line'
TabOrder = 8
OnClick = BtnLineClick
end
object Table1: TTable
Active = True
DatabaseName = 'DBDEMOS'
TableName = 'COUNTRY.DB'
Left = 16
Top = 48
end
object DataSource1: TDataSource
DataSet = Table1
Left = 16
Top = 96
end
object SaveDialog1: TSaveDialog
DefaultExt = 'HTM'
Filter = 'HTML file (*.htm)|*.htm|Any file (*.*)|*.*'
Options = [ofOverwritePrompt, ofPathMustExist, ofCreatePrompt]
Left = 16
end
end
Copyright Marco Cantù 1998