mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-13 00:29:41 +01:00
360 lines
9.5 KiB
ObjectPascal
360 lines
9.5 KiB
ObjectPascal
{
|
|
$Id: header,v 1.1 2000/07/13 06:33:45 michael Exp $
|
|
This file is part of the Free Component Library (FCL)
|
|
Copyright (c) 1999-2000 by the Free Pascal development team
|
|
|
|
See the file COPYING.FPC, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
**********************************************************************}
|
|
unit htmlwriter;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, DOM, htmlelements;
|
|
|
|
type
|
|
|
|
HTMLWriterException = class (exception);
|
|
|
|
{ THTMLwriter }
|
|
|
|
THTMLwriter = class
|
|
private
|
|
FCurrentElement : THTMLCustomElement;
|
|
FDocument: THTMLDocument;
|
|
procedure SetDocument(const AValue: THTMLDocument);
|
|
procedure SetCurrentElement (AValue : THTMLCustomElement);
|
|
protected
|
|
function CreateElement (tag : THTMLElementClass; s : string) : THTMLCustomElement;
|
|
function CreateElement (tag : THTMLElementClass; sub : THTMLCustomElement) : THTMLCustomElement;
|
|
function CreateElement (tag : THTMLElementClass; subs : Array of THTMLCustomElement) : THTMLCustomElement;
|
|
function CreateElement (tag : THTMLElementClass; subs : TDOMNodelist) : THTMLCustomElement;
|
|
function StartElement (tag : THTMLElementClass) : THTMLCustomElement;
|
|
function EndElement (tag : THTMLElementClass) : THTMLCustomElement;
|
|
function AddElement (tag : THTMLElementClass) : THTMLCustomElement;
|
|
public
|
|
constructor create (aDocument : THTMLDocument);
|
|
procedure AddElement (el : THTMLCustomElement);
|
|
procedure AddElements (subs : TDOMNodelist);
|
|
procedure AddElements (subs : array of THTMLCustomElement);
|
|
function Text (s : string) : THTML_Text;
|
|
function Text (Fmt : string; args : array of const) : THTML_Text;
|
|
{ Form input elements }
|
|
function FormText (aname, avalue: DOMstring) : THTML_Input;
|
|
function FormText (aname, avalue: DOMstring; alength : integer) : THTML_Input;
|
|
function FormMemo (aname, avalue: DOMstring; arows,acols: integer) : THTML_Textarea;
|
|
function FormSelect (aname: DOMstring; preselect, size: integer; Options: TStrings; UseValues:boolean) : THTML_Select;
|
|
function FormSelect (aname, preselect: DOMstring; size: integer; Options: TStrings; UseValues:boolean) : THTML_Select;
|
|
function FormPasswd (aname: DOMstring) : THTML_Input;
|
|
function FormCheckbox (aname, avalue: DOMstring; achecked: boolean) : THTML_Input;
|
|
function FormRadio (aname, avalue: DOMstring; achecked: boolean) : THTML_Input;
|
|
function FormSubmit (aname, avalue: DOMstring) : THTML_Input;
|
|
function FormImage (aname, imagesrc, ausemap: DOMstring) : THTML_Input;
|
|
function FormReset : THTML_Input;
|
|
function FormButton (aname, caption, aOnClick: DOMstring) : THTML_Input;
|
|
function FormHidden (aname, aValue: DOMstring) : THTML_Input;
|
|
function FormFile (aname, aValue:DOMstring) : THTML_Input;
|
|
{$i wtagsintf.inc}
|
|
property Document : THTMLDocument read FDocument write SetDocument;
|
|
property CurrentElement : THTMLCustomElement read FCurrentElement write SetCurrentElement;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses HTMLDefs;
|
|
|
|
resourcestring
|
|
sErrNoCorespondingParent = 'No open element found with tag "%s"';
|
|
|
|
{ THTMLwriter }
|
|
|
|
procedure THTMLwriter.SetDocument(const AValue: THTMLDocument);
|
|
begin
|
|
if FDocument <> AValue then
|
|
begin
|
|
FDocument := AValue;
|
|
FCurrentElement := nil;
|
|
end;
|
|
end;
|
|
|
|
function THTMLwriter.CreateElement(tag: THTMLElementClass; s: string): THTMLCustomElement;
|
|
begin
|
|
result := StartElement (tag);
|
|
Text (s);
|
|
EndElement (tag);
|
|
end;
|
|
|
|
function THTMLwriter.CreateElement(tag: THTMLElementClass; sub: THTMLCustomElement): THTMLCustomElement;
|
|
begin
|
|
result := StartElement (tag);
|
|
AddElement (sub);
|
|
EndElement (tag);
|
|
end;
|
|
|
|
function THTMLwriter.CreateElement(tag: THTMLElementClass; subs: array of THTMLCustomElement): THTMLCustomElement;
|
|
begin
|
|
result := StartElement (tag);
|
|
AddElements (subs);
|
|
EndElement (tag);
|
|
end;
|
|
|
|
function THTMLwriter.CreateElement(tag: THTMLElementClass; subs: TDOMNodelist): THTMLCustomElement;
|
|
begin
|
|
result := StartElement (tag);
|
|
AddElements (subs);
|
|
EndElement (tag);
|
|
end;
|
|
|
|
function THTMLwriter.StartElement(tag: THTMLElementClass): THTMLCustomElement;
|
|
begin
|
|
result := AddElement (tag);
|
|
FCurrentElement := result;
|
|
end;
|
|
|
|
function THTMLwriter.EndElement(tag: THTMLElementClass): THTMLCustomElement;
|
|
var d : TDOMNode;
|
|
begin
|
|
d := FCurrentElement;
|
|
while assigned(d) and not (d is tag) do
|
|
d := d.ParentNode;
|
|
if assigned (d) then
|
|
begin
|
|
result := THTMLCustomElement(d);
|
|
FCurrentElement := THTMLCustomElement(result.ParentNode);
|
|
end
|
|
else
|
|
raise HTMLWriterException.CreateFmt (sErrNoCorespondingParent, [tag.ClassName]);
|
|
end;
|
|
|
|
constructor THTMLwriter.create(aDocument: THTMLDocument);
|
|
begin
|
|
inherited create;
|
|
FDocument := aDocument;
|
|
end;
|
|
|
|
procedure THTMLwriter.SetCurrentElement(AValue: THTMLCustomElement);
|
|
begin
|
|
if not assigned (AValue) then
|
|
FCurrentElement := nil
|
|
else
|
|
if AValue.OwnerDocument = FDocument then
|
|
FCurrentElement := AValue;
|
|
end;
|
|
|
|
function THTMLwriter.AddElement(tag: THTMLElementClass): THTMLCustomElement;
|
|
begin
|
|
result := tag.Create (Document);
|
|
AddElement (result);
|
|
end;
|
|
|
|
procedure THTMLwriter.AddElement(el: THTMLCustomElement);
|
|
begin
|
|
if assigned (FCurrentElement) then
|
|
FCurrentElement.AppendChild (el)
|
|
else
|
|
FDocument.AppendChild (el);
|
|
end;
|
|
|
|
procedure THTMLwriter.AddElements(subs: TDOMNodelist);
|
|
var r : integer;
|
|
d : TDOMNode;
|
|
begin
|
|
for r := 0 to subs.count-1 do
|
|
begin
|
|
d := subs.item[r];
|
|
if d is THTMLCustomElement then
|
|
AddElement (THTMLCustomElement(d));
|
|
end;
|
|
end;
|
|
|
|
procedure THTMLwriter.AddElements(subs: array of THTMLCustomElement);
|
|
var r : integer;
|
|
begin
|
|
for r := 0 to high(subs) do
|
|
AddElement (subs[r]);
|
|
end;
|
|
|
|
function THTMLwriter.Text (s : string): THTML_Text;
|
|
begin
|
|
result := THTML_text(AddElement(THTML_Text));
|
|
result.NodeValue := s;
|
|
end;
|
|
|
|
function THTMLwriter.Text(Fmt: string; args: array of const): THTML_Text;
|
|
begin
|
|
result := text(format(fmt, args));
|
|
end;
|
|
|
|
{ Form input elements }
|
|
|
|
function THTMLwriter.FormText(aname, avalue: DOMstring): THTML_Input;
|
|
begin
|
|
result := input;
|
|
with result do
|
|
begin
|
|
thetype := itText;
|
|
name := aname;
|
|
value := avalue;
|
|
end;
|
|
end;
|
|
|
|
function THTMLwriter.FormText(aname, avalue: DOMstring; alength: integer): THTML_Input;
|
|
begin
|
|
result := FormText (aname, avalue);
|
|
result.size := inttostr(alength);
|
|
end;
|
|
|
|
function THTMLwriter.FormMemo(aname, avalue: DOMstring; arows, acols: integer): THTML_Textarea;
|
|
begin
|
|
result := textarea(avalue);
|
|
with result do
|
|
begin
|
|
name := aname;
|
|
rows := inttostr(arows);
|
|
cols := inttostr(acols);
|
|
end;
|
|
end;
|
|
|
|
function THTMLwriter.FormSelect(aname: DOMstring; preselect, size: integer;
|
|
Options: TStrings; UseValues:boolean): THTML_Select;
|
|
var r : integer;
|
|
n,v : string;
|
|
begin
|
|
result := StartSelect;
|
|
result.size := inttostr(size);
|
|
result.name := aname;
|
|
if UseValues then
|
|
for r := 0 to options.count-1 do
|
|
begin
|
|
Options.GetNameValue (r, v, n);
|
|
with Option (n) do
|
|
begin
|
|
selected := (preselect = r);
|
|
Value := v;
|
|
end;
|
|
end
|
|
else
|
|
for r := 0 to options.count-1 do
|
|
Option (Options[r]).selected := (preselect = r);
|
|
EndSelect;
|
|
end;
|
|
|
|
function THTMLwriter.FormSelect(aname, preselect: DOMstring; size: integer;
|
|
Options: TStrings; UseValues:boolean): THTML_Select;
|
|
begin
|
|
if UseValues then
|
|
result := FormSelect (aname, Options.IndexOfName(preselect), size, Options, UseValues)
|
|
else
|
|
result := FormSelect (aname, Options.IndexOf(preselect), size, Options, UseValues);
|
|
end;
|
|
|
|
function THTMLwriter.FormPasswd(aname: DOMstring): THTML_Input;
|
|
begin
|
|
result := input;
|
|
with result do
|
|
begin
|
|
thetype := itPassword;
|
|
name := aname;
|
|
end;
|
|
end;
|
|
|
|
function THTMLwriter.FormCheckbox(aname, avalue: DOMstring; achecked: boolean): THTML_Input;
|
|
begin
|
|
result := input;
|
|
with result do
|
|
begin
|
|
thetype := itCheckbox;
|
|
name := aname;
|
|
value := avalue;
|
|
checked := achecked;
|
|
end;
|
|
end;
|
|
|
|
function THTMLwriter.FormRadio(aname, avalue: DOMstring; achecked: boolean): THTML_Input;
|
|
begin
|
|
result := input;
|
|
with result do
|
|
begin
|
|
thetype := itCheckbox;
|
|
name := aname;
|
|
value := avalue;
|
|
checked := achecked;
|
|
end;
|
|
end;
|
|
|
|
function THTMLwriter.FormSubmit(aname, avalue: DOMstring): THTML_Input;
|
|
begin
|
|
result := input;
|
|
with result do
|
|
begin
|
|
thetype := itSubmit;
|
|
name := aname;
|
|
value := avalue;
|
|
end;
|
|
end;
|
|
|
|
function THTMLwriter.FormImage(aname, imagesrc, ausemap: DOMstring): THTML_Input;
|
|
begin
|
|
result := input;
|
|
with result do
|
|
begin
|
|
thetype := itimage;
|
|
name := aname;
|
|
src := imagesrc;
|
|
usemap := ausemap;
|
|
end;
|
|
end;
|
|
|
|
function THTMLwriter.FormReset: THTML_Input;
|
|
begin
|
|
result := input;
|
|
result.thetype := itReset;
|
|
end;
|
|
|
|
function THTMLwriter.FormButton(aname, caption, aOnClick: DOMstring): THTML_Input;
|
|
begin
|
|
result := input;
|
|
with result do
|
|
begin
|
|
thetype := itButton;
|
|
name := aname;
|
|
value := caption;
|
|
onclick := aonclick;
|
|
end;
|
|
end;
|
|
|
|
function THTMLwriter.FormHidden(aname, aValue: DOMstring): THTML_Input;
|
|
begin
|
|
result := Input;
|
|
with result do
|
|
begin
|
|
thetype := itHidden;
|
|
name := aname;
|
|
value := avalue;
|
|
end;
|
|
end;
|
|
|
|
function THTMLwriter.FormFile(aname, aValue: DOMstring): THTML_Input;
|
|
begin
|
|
result := Input;
|
|
with result do
|
|
begin
|
|
thetype := itFile;
|
|
name := aname;
|
|
value := aValue;
|
|
end;
|
|
end;
|
|
|
|
{$i wtagsimpl.inc}
|
|
|
|
end.
|
|
|