Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 6

Chapter 23 - Project XmlEditOne

Project Structure

XmlEditOne.dpr
program XmlEditOne;

uses
  Forms,
  XmlEditForm in 'XmlEditForm.pas' {FormXmlEdit};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TFormXmlEdit, FormXmlEdit);
  Application.Run;
end.
XmlEditForm.pas
unit XmlEditForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, xmldom, XMLIntf, msxmldom, XMLDoc, ComCtrls, ToolWin, OleCtrls,
  SHDocVw;

type
  TFormXmlEdit = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    MemoXml: TMemo;
    ToolBar1: TToolBar;
    btnLoad: TToolButton;
    TabSheet5: TTabSheet;
    EditXmlFile: TEdit;
    Label1: TLabel;
    btnSave: TToolButton;
    xmlBar: TStatusBar;
    Label4: TLabel;
    EditFolder: TEdit;
    Label5: TLabel;
    EditBaseFile: TEdit;
    btnUpdate: TButton;
    cbAutoUpdate: TCheckBox;
    TabSheet7: TTabSheet;
    XmlBrowser: TWebBrowser;
    XMLDoc: TXMLDocument;
    ToolButton1: TToolButton;
    procedure btnLoadClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure MemoXmlChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnUpdateClick(Sender: TObject);
    procedure EditFolderOrFileChange(Sender: TObject);
    procedure TabSheet7Enter(Sender: TObject);
    procedure MemoXmlKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure MemoXmlMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormXmlEdit: TFormXmlEdit;

implementation

{$R *.DFM}

procedure TFormXmlEdit.btnLoadClick(Sender: TObject);
begin
  // try to load the file
  MemoXml.Lines.LoadFromFile (EditXmlFile.Text);
end;

procedure TFormXmlEdit.btnSaveClick(Sender: TObject);
begin
  // save the file
  MemoXml.Lines.SaveToFile (EditXmlFile.Text);
end;

procedure TFormXmlEdit.MemoXmlChange(Sender: TObject);
var
  eParse: IDOMParseError;
begin
  XmlDoc.Active := True;
  xmlBar.Panels[1].Text := 'OK';
  xmlBar.Panels[2].Text := '';
  (XmlDoc as IXMLDocumentAccess).DOMPersist.loadxml(MemoXml.Text);
  eParse := (XmlDoc.DOMDocument as IDOMParseError);
  if eParse.errorCode <> 0 then
    with eParse do
    begin
      xmlBar.Panels[1].Text := 'Error in: ' + IntToStr (Line) +
        '.' + IntToStr (LinePos);
      xmlBar.Panels[2].Text := SrcText + ': ' + Reason;
    end;
end;

procedure TFormXmlEdit.FormCreate(Sender: TObject);
begin
  EditFolder.Text := ExtractFilePath (Application.ExeName);
  btnUpdateClick (self);
end;

procedure TFormXmlEdit.btnUpdateClick(Sender: TObject);
begin
  EditXmlFile.Text := EditFolder.Text +
    EditBaseFile.Text + '.xml';
end;

procedure TFormXmlEdit.EditFolderOrFileChange(Sender: TObject);
begin
  if cbAutoUpdate.Checked then
    btnUpdateClick (self);
end;

procedure TFormXmlEdit.TabSheet7Enter(Sender: TObject);
begin
  XmlBrowser.Navigate (EditXmlFile.Text);
end;

procedure TFormXmlEdit.MemoXmlKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  xmlBar.Panels[0].Text :=
    'Pos: ' + IntToStr (MemoXml.CaretPos.Y + 1) +
    '.' + IntToStr (MemoXml.CaretPos.X + 1);
end;

procedure TFormXmlEdit.MemoXmlMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  xmlBar.Panels[0].Text :=
    'Pos: ' + IntToStr (MemoXml.CaretPos.Y + 1) +
    '.' + IntToStr (MemoXml.CaretPos.X + 1);
end;

end.
XmlEditForm.dfm
object FormXmlEdit: TFormXmlEdit
  Left = 203
  Top = 141
  Width = 621
  Height = 385
  Caption = 'Xml Edit One'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Microsoft Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object PageControl1: TPageControl
    Left = 0
    Top = 25
    Width = 613
    Height = 333
    ActivePage = TabSheet1
    Align = alClient
    TabIndex = 1
    TabOrder = 0
    object TabSheet5: TTabSheet
      Caption = 'Settings'
      ImageIndex = 4
      object Label1: TLabel
        Left = 184
        Top = 88
        Width = 36
        Height = 13
        Caption = 'Xml File'
      end
      object Label4: TLabel
        Left = 32
        Top = 24
        Width = 29
        Height = 13
        Caption = 'Folder'
      end
      object Label5: TLabel
        Left = 296
        Top = 24
        Width = 69
        Height = 13
        Caption = 'Base Filename'
      end
      object EditXmlFile: TEdit
        Left = 184
        Top = 104
        Width = 281
        Height = 21
        TabOrder = 0
      end
      object EditFolder: TEdit
        Left = 32
        Top = 40
        Width = 249
        Height = 21
        TabOrder = 1
        OnChange = EditFolderOrFileChange
      end
      object EditBaseFile: TEdit
        Left = 296
        Top = 40
        Width = 169
        Height = 21
        TabOrder = 2
        Text = 'Sample'
        OnChange = EditFolderOrFileChange
      end
      object btnUpdate: TButton
        Left = 48
        Top = 88
        Width = 75
        Height = 25
        Caption = 'Update Files'
        TabOrder = 3
        OnClick = btnUpdateClick
      end
      object cbAutoUpdate: TCheckBox
        Left = 48
        Top = 120
        Width = 81
        Height = 17
        Caption = 'Auto Update'
        Checked = True
        State = cbChecked
        TabOrder = 4
      end
    end
    object TabSheet1: TTabSheet
      Caption = 'XML'
      object MemoXml: TMemo
        Left = 0
        Top = 0
        Width = 605
        Height = 284
        Align = alClient
        Font.Charset = DEFAULT_CHARSET
        Font.Color = clWindowText
        Font.Height = -16
        Font.Name = 'Courier New'
        Font.Style = [fsBold]
        ParentFont = False
        ScrollBars = ssVertical
        TabOrder = 0
        OnChange = MemoXmlChange
        OnKeyUp = MemoXmlKeyUp
        OnMouseUp = MemoXmlMouseUp
      end
      object xmlBar: TStatusBar
        Left = 0
        Top = 284
        Width = 605
        Height = 21
        Panels = <
          item
            Width = 70
          end
          item
            Width = 70
          end
          item
            Width = 500
          end>
        SimplePanel = False
      end
    end
    object TabSheet7: TTabSheet
      Caption = 'XML View'
      ImageIndex = 6
      OnEnter = TabSheet7Enter
      object XmlBrowser: TWebBrowser
        Left = 0
        Top = 0
        Width = 605
        Height = 305
        Align = alClient
        TabOrder = 0
        OnEnter = TabSheet7Enter
        ControlData = {
          4C000000873E0000861F00000000000000000000000000000000000000000000
          000000004C000000000000000000000001000000E0D057007335CF11AE690800
          2B2E126208000000000000004C0000000114020000000000C000000000000046
          8000000000000000000000000000000000000000000000000000000000000000
          00000000000000000100000000000000000000000000000000000000}
      end
    end
  end
  object ToolBar1: TToolBar
    Left = 0
    Top = 0
    Width = 613
    Height = 25
    ButtonHeight = 21
    ButtonWidth = 44
    Caption = 'ToolBar1'
    EdgeBorders = [ebTop, ebBottom]
    Flat = True
    ShowCaptions = True
    TabOrder = 1
    object btnLoad: TToolButton
      Left = 0
      Top = 0
      Caption = '&Load'
      ImageIndex = 0
      OnClick = btnLoadClick
    end
    object btnSave: TToolButton
      Left = 44
      Top = 0
      Caption = '&Save'
      ImageIndex = 2
      OnClick = btnSaveClick
    end
    object ToolButton1: TToolButton
      Left = 88
      Top = 0
      Caption = 'Refresh'
      ImageIndex = 3
      OnClick = TabSheet7Enter
    end
  end
  object XMLDoc: TXMLDocument
    Left = 376
    Top = 32
    DOMVendorDesc = 'MSXML'
  end
end