1{ 2 $Id: header,v 1.1 2000/07/13 06:33:45 michael Exp $ 3 This file is part of the Free Component Library (FCL) 4 Copyright (c) 1999-2000 by the Free Pascal development team 5 6 See the file COPYING.FPC, included in this distribution, 7 for details about the copyright. 8 9 This program is distributed in the hope that it will be useful, 10 but WITHOUT ANY WARRANTY; without even the implied warranty of 11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 12 13 **********************************************************************} 14unit htmlwriter; 15 16{$mode objfpc}{$H+} 17 18interface 19 20uses 21 Classes, SysUtils, DOM, htmlelements; 22 23type 24 25 HTMLWriterException = class (exception); 26 27 { THTMLwriter } 28 29 THTMLwriter = class 30 private 31 FCurrentElement : THTMLCustomElement; 32 FDocument: THTMLDocument; 33 procedure SetDocument(const AValue: THTMLDocument); 34 procedure SetCurrentElement (AValue : THTMLCustomElement); 35 protected 36 function CreateElement (tag : THTMLElementClass; s : string) : THTMLCustomElement; 37 function CreateElement (tag : THTMLElementClass; sub : THTMLCustomElement) : THTMLCustomElement; 38 function CreateElement (tag : THTMLElementClass; subs : Array of THTMLCustomElement) : THTMLCustomElement; 39 function CreateElement (tag : THTMLElementClass; subs : TDOMNodelist) : THTMLCustomElement; 40 function AddElement (tag : THTMLElementClass) : THTMLCustomElement; 41 public 42 function StartElement (tag : THTMLElementClass) : THTMLCustomElement; 43 function EndElement (tag : THTMLElementClass) : THTMLCustomElement; 44 constructor create (aDocument : THTMLDocument); 45 procedure AddElement (el : THTMLCustomElement); 46 procedure AddElements (subs : TDOMNodelist); 47 procedure AddElements (subs : array of THTMLCustomElement); 48 function Text (s : string) : THTML_Text; 49 function Text (Fmt : string; args : array of const) : THTML_Text; 50 { Form input elements } 51 function FormText (aname, avalue: DOMstring) : THTML_Input; 52 function FormText (aname, avalue: DOMstring; alength : integer) : THTML_Input; 53 function FormMemo (aname, avalue: DOMstring; arows,acols: integer) : THTML_Textarea; 54 function FormSelect (aname: DOMstring; preselect, size: integer; Options: TStrings; UseValues:boolean) : THTML_Select; 55 function FormSelect (aname, preselect: DOMstring; size: integer; Options: TStrings; UseValues:boolean) : THTML_Select; 56 function FormPasswd (aname: DOMstring) : THTML_Input; 57 function FormCheckbox (aname, avalue: DOMstring; achecked: boolean) : THTML_Input; 58 function FormRadio (aname, avalue: DOMstring; achecked: boolean) : THTML_Input; 59 function FormSubmit (aname, avalue: DOMstring) : THTML_Input; 60 function FormImage (aname, imagesrc, ausemap: DOMstring) : THTML_Input; 61 function FormReset : THTML_Input; 62 function FormButton (aname, caption, aOnClick: DOMstring) : THTML_Input; 63 function FormHidden (aname, aValue: DOMstring) : THTML_Input; 64 function FormFile (aname, aValue:DOMstring) : THTML_Input; 65 { Other useful links to elements } 66 function Meta (aname, ahtpequiv,acontent: DOMString) : THTML_meta; 67 function Link (arel, ahref, athetype, amedia: DOMString) : THTML_link; 68 function Script (s, athetype, asrc: DOMString) : THTML_script; 69 {$i wtagsintf.inc} 70 property Document : THTMLDocument read FDocument write SetDocument; 71 property CurrentElement : THTMLCustomElement read FCurrentElement write SetCurrentElement; 72 end; 73 74implementation 75 76uses HTMLDefs; 77 78resourcestring 79 sErrNoCorespondingParent = 'No open element found with tag "%s"'; 80 81{ THTMLwriter } 82 83procedure THTMLwriter.SetDocument(const AValue: THTMLDocument); 84begin 85 if FDocument <> AValue then 86 begin 87 FDocument := AValue; 88 FCurrentElement := nil; 89 end; 90end; 91 92function THTMLwriter.CreateElement(tag: THTMLElementClass; s: string): THTMLCustomElement; 93begin 94 result := StartElement (tag); 95 Text (s); 96 EndElement (tag); 97end; 98 99function THTMLwriter.CreateElement(tag: THTMLElementClass; sub: THTMLCustomElement): THTMLCustomElement; 100begin 101 result := StartElement (tag); 102 AddElement (sub); 103 EndElement (tag); 104end; 105 106function THTMLwriter.CreateElement(tag: THTMLElementClass; subs: array of THTMLCustomElement): THTMLCustomElement; 107begin 108 result := StartElement (tag); 109 AddElements (subs); 110 EndElement (tag); 111end; 112 113function THTMLwriter.CreateElement(tag: THTMLElementClass; subs: TDOMNodelist): THTMLCustomElement; 114begin 115 result := StartElement (tag); 116 AddElements (subs); 117 EndElement (tag); 118end; 119 120function THTMLwriter.StartElement(tag: THTMLElementClass): THTMLCustomElement; 121begin 122 result := AddElement (tag); 123 FCurrentElement := result; 124end; 125 126function THTMLwriter.EndElement(tag: THTMLElementClass): THTMLCustomElement; 127var d : TDOMNode; 128begin 129 d := FCurrentElement; 130 while assigned(d) and not (d is tag) do 131 d := d.ParentNode; 132 if assigned (d) then 133 begin 134 result := THTMLCustomElement(d); 135 if result.ParentNode = FDocument then 136 FCurrentElement := nil 137 else 138 FCurrentElement := THTMLCustomElement(result.ParentNode); 139 end 140 else 141 raise HTMLWriterException.CreateFmt (sErrNoCorespondingParent, [tag.ClassName]); 142end; 143 144constructor THTMLwriter.create(aDocument: THTMLDocument); 145begin 146 inherited create; 147 FDocument := aDocument; 148end; 149 150procedure THTMLwriter.SetCurrentElement(AValue: THTMLCustomElement); 151begin 152 if not assigned (AValue) then 153 FCurrentElement := nil 154 else 155 if AValue.OwnerDocument = FDocument then 156 FCurrentElement := AValue; 157end; 158 159function THTMLwriter.AddElement(tag: THTMLElementClass): THTMLCustomElement; 160begin 161 result := tag.Create (Document); 162 AddElement (result); 163end; 164 165procedure THTMLwriter.AddElement(el: THTMLCustomElement); 166begin 167 if assigned (FCurrentElement) then 168 FCurrentElement.AppendChild (el) 169 else 170 FDocument.AppendChild (el); 171end; 172 173procedure THTMLwriter.AddElements(subs: TDOMNodelist); 174var r : integer; 175 d : TDOMNode; 176begin 177 for r := 0 to subs.count-1 do 178 begin 179 d := subs.item[r]; 180 if d is THTMLCustomElement then 181 AddElement (THTMLCustomElement(d)); 182 end; 183end; 184 185procedure THTMLwriter.AddElements(subs: array of THTMLCustomElement); 186var r : integer; 187begin 188 for r := 0 to high(subs) do 189 AddElement (subs[r]); 190end; 191 192function THTMLwriter.Text (s : string): THTML_Text; 193begin 194 result := THTML_text(AddElement(THTML_Text)); 195 result.NodeValue := s; 196end; 197 198function THTMLwriter.Text(Fmt: string; args: array of const): THTML_Text; 199begin 200 result := text(format(fmt, args)); 201end; 202 203{ Form input elements } 204 205function THTMLwriter.FormText(aname, avalue: DOMstring): THTML_Input; 206begin 207 result := input; 208 with result do 209 begin 210 thetype := itText; 211 name := aname; 212 value := avalue; 213 end; 214end; 215 216function THTMLwriter.FormText(aname, avalue: DOMstring; alength: integer): THTML_Input; 217begin 218 result := FormText (aname, avalue); 219 result.size := inttostr(alength); 220end; 221 222function THTMLwriter.FormMemo(aname, avalue: DOMstring; arows, acols: integer): THTML_Textarea; 223begin 224 result := textarea(avalue); 225 with result do 226 begin 227 name := aname; 228 rows := inttostr(arows); 229 cols := inttostr(acols); 230 end; 231end; 232 233function THTMLwriter.FormSelect(aname: DOMstring; preselect, size: integer; 234 Options: TStrings; UseValues:boolean): THTML_Select; 235var r : integer; 236 n,v : string; 237begin 238 result := StartSelect; 239 result.size := inttostr(size); 240 result.name := aname; 241 if UseValues then 242 for r := 0 to options.count-1 do 243 begin 244 Options.GetNameValue (r, v, n); 245 with Option (n) do 246 begin 247 selected := (preselect = r); 248 Value := v; 249 end; 250 end 251 else 252 for r := 0 to options.count-1 do 253 Option (Options[r]).selected := (preselect = r); 254 EndSelect; 255end; 256 257function THTMLwriter.FormSelect(aname, preselect: DOMstring; size: integer; 258 Options: TStrings; UseValues:boolean): THTML_Select; 259begin 260 if UseValues then 261 result := FormSelect (aname, Options.IndexOfName(preselect), size, Options, UseValues) 262 else 263 result := FormSelect (aname, Options.IndexOf(preselect), size, Options, UseValues); 264end; 265 266function THTMLwriter.FormPasswd(aname: DOMstring): THTML_Input; 267begin 268 result := input; 269 with result do 270 begin 271 thetype := itPassword; 272 name := aname; 273 end; 274end; 275 276function THTMLwriter.FormCheckbox(aname, avalue: DOMstring; achecked: boolean): THTML_Input; 277begin 278 result := input; 279 with result do 280 begin 281 thetype := itCheckbox; 282 name := aname; 283 value := avalue; 284 checked := achecked; 285 end; 286end; 287 288function THTMLwriter.FormRadio(aname, avalue: DOMstring; achecked: boolean): THTML_Input; 289begin 290 result := input; 291 with result do 292 begin 293 thetype := itCheckbox; 294 name := aname; 295 value := avalue; 296 checked := achecked; 297 end; 298end; 299 300function THTMLwriter.FormSubmit(aname, avalue: DOMstring): THTML_Input; 301begin 302 result := input; 303 with result do 304 begin 305 thetype := itSubmit; 306 name := aname; 307 value := avalue; 308 end; 309end; 310 311function THTMLwriter.FormImage(aname, imagesrc, ausemap: DOMstring): THTML_Input; 312begin 313 result := input; 314 with result do 315 begin 316 thetype := itimage; 317 name := aname; 318 src := imagesrc; 319 usemap := ausemap; 320 end; 321end; 322 323function THTMLwriter.FormReset: THTML_Input; 324begin 325 result := input; 326 result.thetype := itReset; 327end; 328 329function THTMLwriter.FormButton(aname, caption, aOnClick: DOMstring): THTML_Input; 330begin 331 result := input; 332 with result do 333 begin 334 thetype := itButton; 335 name := aname; 336 value := caption; 337 onclick := aonclick; 338 end; 339end; 340 341function THTMLwriter.FormHidden(aname, aValue: DOMstring): THTML_Input; 342begin 343 result := Input; 344 with result do 345 begin 346 thetype := itHidden; 347 name := aname; 348 value := avalue; 349 end; 350end; 351 352function THTMLwriter.FormFile(aname, aValue: DOMstring): THTML_Input; 353begin 354 result := Input; 355 with result do 356 begin 357 thetype := itFile; 358 name := aname; 359 value := aValue; 360 end; 361end; 362 363function THTMLwriter.Meta(aname, ahtpequiv, acontent: DOMString): THTML_meta; 364begin 365 result := tagmeta; 366 with result do 367 begin 368 name := aname; 369 httpequiv := ahtpequiv; 370 content := acontent; 371 end; 372end; 373 374function THTMLwriter.Link(arel, ahref, athetype, amedia: DOMString): THTML_link; 375begin 376 result := taglink; 377 with result do 378 begin 379 rel := arel; 380 href := ahref; 381 thetype := athetype; 382 media := amedia; 383 end; 384end; 385 386function THTMLwriter.Script(s, athetype, asrc: DOMString): THTML_script; 387begin 388 result := tagscript(s); 389 with result do 390 begin 391 thetype := athetype; 392 src := asrc; 393 end; 394end; 395 396{$i wtagsimpl.inc} 397 398end. 399 400