Marco Cantù 1998, Mastering Delphi 4

Project: CREATEG.DPR


Project Structure


CREATEG.DPR

program Createg;

uses
  Forms,
  GraphF in 'GraphF.pas' {GraphForm},
  TablesF in 'TablesF.pas' {TablesForm};

{$R *.RES}

begin
  Application.CreateForm(TGraphForm, GraphForm);
  Application.Run;
end.

GRAPHF.PAS

unit GraphF;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics,
  Controls, StdCtrls, Forms, DBCtrls, DB, DBTables, ExtCtrls,
  Mask, Buttons, Dialogs, TablesF, Menus;

type
  EMyDatabaseError = class (EDatabaseError) end;
  TGraphForm = class(TForm)
    ScrollBox: TScrollBox;
    Label1: TLabel;
    EditDescription: TDBEdit;
    Label3: TLabel;
    EditDate: TDBEdit;
    Label4: TLabel;
    DBImage: TDBImage;
    Panel1: TPanel;
    DataSource1: TDataSource;
    Table1: TTable;
    SpeedAdd: TSpeedButton;
    SpeedDelete: TSpeedButton;
    Table2: TTable;
    CheckBox1: TCheckBox;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    N2: TMenuItem;
    Open1: TMenuItem;
    New1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    DBNavigator: TDBNavigator;
    SpeedOpen: TSpeedButton;
    SpeedNew: TSpeedButton;
    Record1: TMenuItem;
    Add1: TMenuItem;
    Delete1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure New1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure Add1Click(Sender: TObject);
    procedure Delete1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  GraphForm: TGraphForm;

implementation

{$R *.DFM}

procedure TGraphForm.FormCreate(Sender: TObject);
var
  Code: Word;
  Done: Boolean;
begin
  Done := False;
  while not Done do
  try
    Code := MessageDlg (
      'Do you want to create a new table?' +
      #13'(choose No to load an existing table,' +
      #13'Cancel to quit)',
      mtConfirmation, mbYesNoCancel, 0);
    if Code = idYes then
      New1Click (self)
    else if Code = idNo then
      Open1Click (self)
    else
      Application.Terminate;
    Done := True;
  except
    on E: EMyDatabaseError do
      ShowMessage (E.Message);
  end; // end of try-except and while blocks
end;

procedure TGraphForm.CheckBox1Click(Sender: TObject);
begin
  DBImage.Stretch := CheckBox1.Checked;
end;

procedure TGraphForm.New1Click(Sender: TObject);
var
  TableName: string;
  TbNames: TStringList;
begin
  {request the name of the new table to the user,
  raising an expcetion in case Cancel is pressed}
  TableName := '';
  if InputQuery ('New Table',
    'Enter a new table name:', TableName) then
  begin
    if TableName = '' then
      raise EMyDatabaseError.Create (
        'Invalid table name');

    {if the table already exists in the DBDEMOS
    database, do not overwrite it}
    TbNames := TStringList.Create;
    try
      Session.GetTableNames ('DBDEMOS', '',
        False, False, TbNames);
      if TbNames.IndexOf (TableName) >= 0 then
        raise EMyDatabaseError.Create (
          'Table already exists');
    finally
      TbNames.Free;
    end;

    {close the current table}
    Table1.Close;

    {set the name and type of the new table}
    Table1.TableName := TableName;
    Table1.TableType := ttParadox;

    {define the three fields and the index}
    with Table1.FieldDefs do
    begin
      Clear;
      Add ('Description', ftString, 50, True);
      Add ('Time', ftDateTime, 0, False);
      Add ('Graphics', ftGraphic, 0, False);
    end;
    Table1.IndexDefs.Clear;
    Table1.IndexDefs.Add('DescrIndex', 'Description',
      [ixPrimary, ixUnique]);

    {create the table using the above definitions}
    Table1.CreateTable;
    Table1.Open;
    Caption := 'Create Graphics - ' + TableName;
  end
  else // if InputQuery
    // if OnCreate called this methods
    if Sender = self then
      raise EMyDatabaseError.Create (
      'Table creation aborted by the user');
end;

procedure TGraphForm.Open1Click(Sender: TObject);
var
  TbNames: TStringList;
  I: Integer;
  TableFound: Boolean;
begin
  {create the form of the dialog box,
  before filling its list box with the table names}
  TablesForm := TTablesForm.Create (Application);

  {retrieve the list of tables from the database}
  TableFound := False;
  TbNames := TStringList.Create;
  try
    Session.GetTableNames ('DBDEMOS', '',
      True, False, TbNames);

    {checks if the table has the proper fields,
    that is, if it was created by this program.
    The code uses a secondary table object}
    for I := 0 to TbNames.Count - 1 do
    begin
      Table2.TableName := TbNames [I];
      Table2.FieldDefs.Update;
      if (Table2.FieldDefs.Count = 3) and
        (Table2.FieldDefs[0].DataType = ftString) and
        (Table2.FieldDefs[1].DataType = ftDateTime) and
        (Table2.FieldDefs[2].DataType = ftGraphic) then
      begin
        {table fields match: add the table to the list}
        TablesForm.Listbox1.Items.Add (Table2.TableName);
        TableFound := True;
      end;
    end;
  finally
    TBNames.Free;
  end;

  {if no table was found, raise an exception}
  if not TableFound then
    raise EMyDatabaseError.Create (
      'No table with the proper structure');

  {otherwise, show the dialog box}
  TablesForm.ListBox1.ItemIndex := 0;
  if TablesForm.ShowModal = idOK then
  begin
    {if OK was pressed, open the table}
    Table1.Close;
    Table1.TableName := TablesForm.ListBox1.Items [
      TablesForm.ListBox1.ItemIndex];
    Table1.Open;
    Caption := 'Create Graphics - ' +
      Table1.TableName;
  end
  else
    // if OnCreate called this methods
    if Sender = self then
      raise EMyDatabaseError.Create (
        'Table selection aborted by the user');
end;

procedure TGraphForm.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TGraphForm.About1Click(Sender: TObject);
begin
  MessageDlg ('CreateG example, from the book' +
    #13'"Mastering Delphi", by Marco Cantù',
    mtInformation, [mbOK], 0);
end;

procedure TGraphForm.Add1Click(Sender: TObject);
var
  Descr: string;
begin
  if InputQuery ('New record',
    'Enter the description:', Descr) then
  begin
    Table1.Insert;
    EditDescription.Text := Descr;
    EditDate.Text := DateTimeToStr (Now);
    DBIMage.PasteFromClipboard;
    Table1.Post;
  end;
end;

procedure TGraphForm.Delete1Click(Sender: TObject);
begin
  if MessageDlg (
    'Are you sure you want to delete the current record?',
      mtConfirmation, [mbYes, mbNo], 0) = idYes then
    Table1.Delete;
end;

end.

TABLESF.PAS

unit TablesF;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons;

type
  TTablesForm = class(TForm)
    ListBox1: TListBox;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  TablesForm: TTablesForm;

implementation

{$R *.DFM}

end.

GRAPHF.DFM

object GraphForm: TGraphForm
  Left = 278
  Top = 121
  Width = 472
  Height = 402
  ActiveControl = Panel1
  Caption = 'Create Graphic'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clBlack
  Font.Height = -11
  Font.Name = 'Arial'
  Font.Style = []
  Menu = MainMenu1
  OldCreateOrder = True
  Position = poScreenCenter
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 14
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 464
    Height = 42
    Align = alTop
    TabOrder = 0
    object SpeedAdd: TSpeedButton
      Left = 138
      Top = 8
      Width = 65
      Height = 25
      Caption = 'Add...'
      Flat = True
      Glyph.Data = {
        76010000424D7601000000000000760000002800000020000000100000000100
        04000000000000010000120B0000120B00001000000000000000000000000000
        800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
        FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00555555555555
        55555555FFFFFFFF5555555000000005555555577777777FF555550999999900
        55555575555555775F55509999999901055557F55555557F75F5001111111101
        105577FFFFFFFF7FF75F00000000000011057777777777775F755070FFFFFF0F
        01105777F555557F75F75500FFFFFF0FF0105577F555FF7F57575550FF700008
        8F0055575FF7777555775555000888888F005555777FFFFFFF77555550000000
        0F055555577777777F7F555550FFFFFF0F05555557F5FFF57F7F555550F000FF
        0005555557F777557775555550FFFFFF0555555557F555FF7F55555550FF7000
        05555555575FF777755555555500055555555555557775555555}
      NumGlyphs = 2
      OnClick = Add1Click
    end
    object SpeedDelete: TSpeedButton
      Left = 203
      Top = 8
      Width = 65
      Height = 25
      Caption = 'Delete'
      Flat = True
      Glyph.Data = {
        76010000424D7601000000000000760000002800000020000000100000000100
        04000000000000010000120B0000120B00001000000000000000000000000000
        800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
        FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00555555555555
        55555FFFFFFF5F55FFF5777777757559995777777775755777F7555555555550
        305555555555FF57F7F555555550055BB0555555555775F777F55555550FB000
        005555555575577777F5555550FB0BF0F05555555755755757F555550FBFBF0F
        B05555557F55557557F555550BFBF0FB005555557F55575577F555500FBFBFB0
        B05555577F555557F7F5550E0BFBFB00B055557575F55577F7F550EEE0BFB0B0
        B05557FF575F5757F7F5000EEE0BFBF0B055777FF575FFF7F7F50000EEE00000
        B0557777FF577777F7F500000E055550805577777F7555575755500000555555
        05555777775555557F5555000555555505555577755555557555}
      NumGlyphs = 2
      OnClick = Delete1Click
    end
    object SpeedOpen: TSpeedButton
      Left = 73
      Top = 8
      Width = 65
      Height = 25
      Caption = 'Open...'
      Flat = True
      Glyph.Data = {
        76010000424D7601000000000000760000002800000020000000100000000100
        04000000000000010000120B0000120B00001000000000000000000000000000
        800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
        FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00555555555555
        5555555555555555555555555555555555555555555555555555555555555555
        555555555555555555555555555555555555555FFFFFFFFFF555550000000000
        55555577777777775F55500B8B8B8B8B05555775F555555575F550F0B8B8B8B8
        B05557F75F555555575F50BF0B8B8B8B8B0557F575FFFFFFFF7F50FBF0000000
        000557F557777777777550BFBFBFBFB0555557F555555557F55550FBFBFBFBF0
        555557F555555FF7555550BFBFBF00055555575F555577755555550BFBF05555
        55555575FFF75555555555700007555555555557777555555555555555555555
        5555555555555555555555555555555555555555555555555555}
      NumGlyphs = 2
      OnClick = Open1Click
    end
    object SpeedNew: TSpeedButton
      Left = 8
      Top = 8
      Width = 65
      Height = 25
      Caption = 'New...'
      Flat = True
      Glyph.Data = {
        76010000424D7601000000000000760000002800000020000000100000000100
        04000000000000010000120B0000120B00001000000000000000000000000000
        800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
        FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00555555555555
        55555555FFFFFFFF5555555000000005555555577777777FF555550999999900
        55555575555555775F55509999999901055557F55555557F75F5001111111101
        105577FFFFFFFF7FF75F00000000000011057777777777775F755070FFFFFF0F
        01105777F555557F7FF75500FFFFFF0F00105577F555FF7F77575550FF70000F
        0F0055575FF777757F775555000FFFFF0F005555777555FF7F77555550FF7000
        0F055555575FF777757F555555000FFFFF05555555777555FF7F55555550FF70
        0005555555575FF7777555555555000555555555555577755555555555555555
        5555555555555555555555555555555555555555555555555555}
      NumGlyphs = 2
      OnClick = New1Click
    end
    object DBNavigator: TDBNavigator
      Left = 268
      Top = 8
      Width = 188
      Height = 25
      DataSource = DataSource1
      VisibleButtons = [nbFirst, nbPrior, nbNext, nbLast]
      Flat = True
      TabOrder = 0
    end
  end
  object ScrollBox: TScrollBox
    Left = 0
    Top = 42
    Width = 464
    Height = 314
    Align = alClient
    BorderStyle = bsNone
    TabOrder = 1
    object Label1: TLabel
      Left = 3
      Top = 5
      Width = 61
      Height = 14
      Alignment = taRightJustify
      AutoSize = False
      Caption = 'Description'
      FocusControl = EditDescription
    end
    object Label3: TLabel
      Left = 3
      Top = 29
      Width = 62
      Height = 14
      Alignment = taRightJustify
      AutoSize = False
      Caption = 'Date/Time'
      FocusControl = EditDate
    end
    object Label4: TLabel
      Left = 27
      Top = 54
      Width = 34
      Height = 14
      Alignment = taRightJustify
      AutoSize = False
      Caption = 'Image'
      FocusControl = DBImage
    end
    object EditDescription: TDBEdit
      Left = 72
      Top = 3
      Width = 256
      Height = 22
      DataField = 'Description'
      DataSource = DataSource1
      MaxLength = 100
      TabOrder = 0
    end
    object EditDate: TDBEdit
      Left = 72
      Top = 27
      Width = 256
      Height = 22
      DataField = 'Time'
      DataSource = DataSource1
      MaxLength = 100
      TabOrder = 1
    end
    object DBImage: TDBImage
      Left = 72
      Top = 51
      Width = 385
      Height = 254
      Center = False
      DataField = 'Graphics'
      DataSource = DataSource1
      Stretch = True
      TabOrder = 2
    end
    object CheckBox1: TCheckBox
      Left = 392
      Top = 24
      Width = 65
      Height = 17
      Caption = 'Stretch'
      Checked = True
      State = cbChecked
      TabOrder = 3
      OnClick = CheckBox1Click
    end
  end
  object DataSource1: TDataSource
    DataSet = Table1
    Left = 8
    Top = 184
  end
  object Table1: TTable
    DatabaseName = 'DBDEMOS'
    Left = 8
    Top = 136
  end
  object Table2: TTable
    DatabaseName = 'DBDEMOS'
    Left = 8
    Top = 298
  end
  object MainMenu1: TMainMenu
    Left = 8
    Top = 242
    object File1: TMenuItem
      Caption = '&File'
      object New1: TMenuItem
        Caption = '&New...'
        OnClick = New1Click
      end
      object Open1: TMenuItem
        Caption = '&Open...'
        OnClick = Open1Click
      end
      object N2: TMenuItem
        Caption = '-'
      end
      object Exit1: TMenuItem
        Caption = 'E&xit'
        OnClick = Exit1Click
      end
    end
    object Record1: TMenuItem
      Caption = '&Record'
      object Add1: TMenuItem
        Caption = '&Add...'
        OnClick = Add1Click
      end
      object Delete1: TMenuItem
        Caption = '&Delete'
        OnClick = Delete1Click
      end
    end
    object Help1: TMenuItem
      Caption = '&Help'
      object About1: TMenuItem
        Caption = '&About...'
        OnClick = About1Click
      end
    end
  end
end

TABLESF.DFM

object TablesForm: TTablesForm
  Left = 238
  Top = 120
  BorderStyle = bsDialog
  Caption = 'Tables'
  ClientHeight = 198
  ClientWidth = 178
  Font.Color = clBlack
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  PixelsPerInch = 96
  TextHeight = 13
  object ListBox1: TListBox
    Left = 0
    Top = 0
    Width = 177
    Height = 161
    ItemHeight = 13
    TabOrder = 0
  end
  object BitBtn1: TBitBtn
    Left = 8
    Top = 168
    Width = 73
    Height = 25
    TabOrder = 1
    Kind = bkOK
  end
  object BitBtn2: TBitBtn
    Left = 96
    Top = 168
    Width = 73
    Height = 25
    TabOrder = 2
    Kind = bkCancel
  end
end


Copyright Marco Cantù 1998