lazarus/examples/turbopower_ipro/htmain.pas

unit htmain;

{
  IMPORTANT:
  This DEFINE must be added to "Additions and Overrides" of the project
  options for this program to work correctly:
    -dHTML_RTTI
}

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  ExtCtrls, ComCtrls, StdCtrls,
  IpHtml, IpHtmlNodes;

type

  { TMainForm }

  TMainForm = class(TForm)
    IpHtmlPanel1: TIpHtmlPanel;
    Label1: TLabel;
    ListBox1: TListBox;
    OpenDialog1: TOpenDialog;
    BtnOpenHTMLFile: TButton;
    Panel1: TPanel;
    Panel2: TPanel;
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    TreeView1: TTreeView;
    procedure BtnOpenHTMLFileClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure IpHTMLPanel1CurElementChange(Sender: TObject);
    procedure IpHtmlPanel1HotChange(Sender: TObject);
    procedure IpHtmlPanel1HotClick(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
    procedure TreeView1Change(Sender: TObject; Node: TTreeNode);

  private
//    FCurCtrl: TControl;
    procedure AddNode(HTMLNode: TIpHTMLNode; AParent: TTreeNode);
    procedure HTMLGetImageX(Sender: TIpHtmlNode; const URL: string; var Picture: TPicture);
    procedure HTMLNodeChange(HTMLNode: TIpHtmlNode);
    procedure PopulateOutline(H: TIpHTML);
    procedure UpdateTreeView;

  public
    procedure OpenHTMLFile(const Filename: string);

  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

uses
  LazUTF8, LazFileUtils;

type
  TSimpleIpHtml = class(TIpHtml)
  public
    property OnGetImageX;
  end;


{ TMainForm }

procedure TMainForm.AddNode(HTMLNode: TIpHTMLNode; AParent: TTreeNode);
var
  i: Integer;
  treenode: TTreeNode;
begin
  treenode := TreeView1.Items.AddChildObject(AParent, HTMLNode.ClassName, HTMLNode);
  if HTMLNode is TIpHTMLNodeMulti then
    for i := 0 to pred(TIpHTMLNodeMulti(HTMLNode).ChildCount) do
      AddNode(TIpHTMLNodeMulti(HTMLNode).ChildNode[i], treenode);
end;

procedure TMainForm.BtnOpenHTMLFileClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
    OpenHtmlFile(OpenDialog1.FileName);
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  OpenHTMLFile('index.html');
end;

procedure TMainForm.HTMLGetImageX(Sender: TIpHtmlNode; const URL: string;
  var Picture: TPicture);
var
  PicCreated: boolean;
begin
  Picture := nil;
  try
    if FileExistsUTF8(URL) then begin
      PicCreated := False;
      if Picture=nil then begin
        Picture := TPicture.Create;   // Note: will be destroyed by IpHtmlPanel
        PicCreated := True;
      end;
      Picture.LoadFromFile(URL);
    end;
  except
    if PicCreated then
      Picture.Free;
    Picture := nil;
  end;
end;

procedure TMainForm.HTMLNodeChange(HTMLNode: TIpHtmlNode);
var
  i: Integer;
begin
  if HTMLNode <> nil then
    for i := 0 to pred(TreeView1.Items.Count) do
      if TreeView1.Items[i].Data = pointer(HTMLNode) then begin
        TreeView1.Selected := TreeView1.Items[i];
        break;
      end;
end;

procedure TMainForm.IpHTMLPanel1CurElementChange(Sender: TObject);
begin
  if IpHTMLPanel1.CurElement <> nil then
    HTMLNodeChange(IpHTMLPanel1.CurElement^.Owner);
end;

procedure TMainForm.IpHtmlPanel1HotChange(Sender: TObject);
begin
  if (IpHTMLPanel1.HotNode <> nil) then begin
    IpHTMLPanel1.HotNode.GetAttributes(Listbox1.Items, True, False);
    HTMLNodeChange(IpHTMLPanel1.HotNode);
  end;
end;

procedure TMainForm.IpHtmlPanel1HotClick(Sender: TObject);
var
  NodeA: TIpHtmlNodeA;
  NewFilename: String;
begin
  if IpHtmlPanel1.HotNode is TIpHtmlNodeA then begin
    NodeA := TIpHtmlNodeA(IpHtmlPanel1.HotNode);
    NewFilename := NodeA.HRef;
    OpenHTMLFile(NewFilename);
  end;
end;

procedure TMainForm.ListBox1DblClick(Sender: TObject);
var
  S, V: string;
  P: Integer;
begin
  if Listbox1.ItemIndex <> -1 then begin
    S := Listbox1.Items[Listbox1.ItemIndex];
    P := pos('=', S);
    V := copy(S, P + 1, MAXINT);
    if InputQuery('Change attribute value', copy(S, 1, P - 1), V) then begin
      TIpHTMLNode(TreeView1.Selected.Data).SetAttributeValue(S, V);
      TIpHTMLNode(TreeView1.Selected.Data).GetAttributes(Listbox1.Items, True, false);
      IpHTMLPanel1.Invalidate;
    end;
  end;
end;

procedure TMainForm.OpenHTMLFile(const Filename: string);
var
  fs: TFileStream;
  NewHTML: TSimpleIpHtml;
begin
  try
    fs:=TFileStream.Create(UTF8ToSys(Filename),fmOpenRead);
    try
      NewHTML := TSimpleIpHtml.Create; // Beware: Will be freed automatically by IpHtmlPanel1
      NewHTML.OnGetImageX := @HTMLGetImageX;
      NewHTML.LoadFromStream(fs);
    finally
      fs.Free;
    end;
    IpHtmlPanel1.SetHtml(NewHTML);
    UpdateTreeView;
  except
    on E: Exception do begin
      MessageDlg('Unable to open HTML file',
        'HTML File: '+Filename+LineEnding
        +'Error: '+E.Message,mtError,[mbCancel],0);
    end;
  end;
end;

procedure TMainForm.PopulateOutline(H: TIpHTML);
begin
  if H <> nil then
    AddNode(H.HTMLNode, nil);
end;

procedure TMainForm.TreeView1Change(Sender: TObject; Node: TTreeNode);
begin
  if Node <> nil then begin
    if (Node.Data <> nil) then begin
      Assert(TObject(Node.Data) is TIpHTMLNode);
      TIpHTMLNode(Node.Data).GetAttributes(Listbox1.Items, True, False);
    end;
  end;
end;

procedure TMainForm.UpdateTreeView;
begin
  TreeView1.Selected := nil;
  TreeView1.Items.Clear;
  Listbox1.Items.Clear;
  TreeView1.Items.BeginUpdate;
  try
    IpHTMLPanel1.EnumDocuments(@PopulateOutline);
  finally
    TreeView1.Items.EndUpdate;
  end;
  TreeView1.FullExpand;
  if TreeView1.Items.Count > 0 then
    TreeView1.Selected := TreeView1.Items[0];
end;

end.