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