Changeset 24 for branches/lazarus/Common/UHtmlClasses.pas

Timestamp:

Sep 8, 2010, 4:17:21 PM (14 years ago)

Author:

george

Message:

• Přidáno: Z PHP kódů převedeno zobrazení stránek a hlavního menu. Pro generování kostry použity třídy HTMLClasses a XMLClasses.
• Přidáno: Styly a obrázky.

File:

• branches/lazarus/Common/UHtmlClasses.pas (modified) (12 diffs)

branches/lazarus/Common/UHtmlClasses.pas

@@ -6 +6 @@
 
 uses
-  UXmlClasses, Classes, SysUtils;
+  UXmlClasses, Classes, SysUtils, Contnrs, UStringListEx;
 
 type
-  TStringArray = array of string;
-
   TDomainAddress = class(TPersistent)
   private
@@ -97 +95 @@
   public
     BlockType: TBlockType;
-    SubItems: TList; // of THtmlElement;
+    SubItems: TObjectList; // of THtmlElement;
     constructor Create;
     destructor Destroy; override;
@@ -113 +111 @@
 
   TSizeUnits = (suPixels, suPercents);
+
   THtmlSize = record
     Width: Integer;
@@ -130 +129 @@
   end;
 
-  THtmlPage = class
+  THtmlDocument = class
   private
     function GetAsXmlDocument: TXmlDocument;
   public
     Title: string;
-    Charset: string;
+    ContentEncoding: string;
+    ContentLanguage: string;
     Body: THtmlBlock;
+    Styles: TStringList;
+    Scripts: TStringList;
     property AsXmlDocument: TXmlDocument read GetAsXmlDocument;
     constructor Create;
@@ -142 +144 @@
   end;
 
-function Explode(Separator: Char; Source: string): TStringArray;
-
 implementation
-
-function Explode(Separator: Char; Source: string): TStringArray;
-begin
-  SetLength(Result, 0);
-  while Pos(Separator, Source) > 0 do begin
-    SetLength(Result, Length(Result) + 1);
-    Result[High(Result)] := Copy(Source, 1, Pos(Separator, Source) - 1);
-    Delete(Source, 1, Length(Result[High(Result)]) + 1);
-  end;
-  SetLength(Result, Length(Result) + 1);
-  Result[High(Result)] := Source;
-end;
 
 function LeftCutString(var Source, Output: string; Delimiter: string; Allowed: string = ''): Boolean;
@@ -210 +198 @@
 end;
 
-{ THtmlPage }
-
-constructor THtmlPage.Create;
+{ THtmlDocument }
+
+constructor THtmlDocument.Create;
 begin
   Body := THtmlBlock.Create;
-end;
-
-destructor THtmlPage.Destroy;
+  Styles := TStringList.Create;
+  Scripts := TStringList.Create;
+  ContentLanguage := 'en';
+  ContentEncoding := 'utf-8';
+end;
+
+destructor THtmlDocument.Destroy;
 begin
   Body.Free;
+  Styles.Free;
+  Scripts.Free;
   inherited;
 end;
 
-function THtmlPage.GetAsXmlDocument: TXmlDocument;
+function THtmlDocument.GetAsXmlDocument: TXmlDocument;
+var
+  DocType: TXMLTag;
+  HTMLTag: TXMLTag;
+  I: Integer;
 begin
   Result := TXmlDocument.Create;
   with Result, Content do begin
     Formated := True;
-    TagName := 'html';
-    with TXmlTag(SubElements[SubElements.Add(TXmlTag.Create)]) do begin
-      TagName := 'head';
+    DocType := TXMlTag.Create;
+    DocType.Name := '!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"';
+    Doctype.EndTagSymbol := '';
+    SubElements.Add(DocType);
+    HTMLTag := TXMLTag.Create;
+    with HTMLTag do begin
+      Name := 'html';
       with TXmlTag(SubElements[SubElements.Add(TXmlTag.Create)]) do begin
-        TagName := 'title';
-        with TXmlString(SubElements[SubElements.Add(TXmlString.Create)]) do begin
-          Text := Title;
+        Name := 'head';
+        with TXmlTag(SubElements[SubElements.Add(TXmlTag.Create)]) do begin
+          Name := 'title';
+          with TXmlString(SubElements[SubElements.Add(TXmlString.Create)]) do begin
+            Text := Title;
+          end;
+        end;
+        with TXmlTag(SubElements[SubElements.Add(TXmlTag.Create)]) do begin
+          Name := 'meta';
+          Attributes.AddNameValue('http-equiv', 'Content-Language');
+          Attributes.AddNameValue('content', ContentLanguage);
+        end;
+        with TXmlTag(SubElements[SubElements.Add(TXmlTag.Create)]) do begin
+          Name := 'meta';
+          Attributes.AddNameValue('http-equiv', 'Content-Type');
+          Attributes.AddNameValue('content', 'text/html; charset=' + ContentEncoding);
+        end;
+        for I := 0 to Styles.Count - 1 do
+        with TXmlTag(SubElements[SubElements.Add(TXmlTag.Create)]) do begin
+          Name := 'link';
+          Attributes.AddNameValue('rel', 'stylesheet');
+          Attributes.AddNameValue('href', Styles[I]);
+          Attributes.AddNameValue('type', 'text/css');
+          Attributes.AddNameValue('media', 'all');
+        end;
+        for I := 0 to Scripts.Count - 1 do
+        with TXmlTag(SubElements[SubElements.Add(TXmlTag.Create)]) do begin
+          Name := 'script';
+          ShringEmpty := False;
+          Attributes.AddNameValue('type', 'text/javascript');
+          Attributes.AddNameValue('src', Scripts[I]);
         end;
       end;
       with TXmlTag(SubElements[SubElements.Add(TXmlTag.Create)]) do begin
-        TagName := 'meta';
-        Attributes.AddNameValue('http-equiv', 'Content-Language');
-        Attributes.AddNameValue('content', 'cs');
-      end;
-      with TXmlTag(SubElements[SubElements.Add(TXmlTag.Create)]) do begin
-        TagName := 'meta';
-        Attributes.AddNameValue('http-equiv', 'Content-Type');
-        Attributes.AddNameValue('content', 'text/html; charset=' + Charset);
+        Name := 'body';
+        SubElements.Add(Body.AsXmlElement);
       end;
     end;
-    with TXmlTag(SubElements[SubElements.Add(TXmlTag.Create)]) do begin
-      TagName := 'body';
-      SubElements.Add(Body.AsXmlElement);
-
-
-    end;
+    SubElements.Add(HTMLTag);
   end;
 end;
@@ -261 +280 @@
 constructor THtmlBlock.Create;
 begin
-  SubItems := TList.Create;
+  SubItems := TObjectList.Create;
 end;
 
 destructor THtmlBlock.Destroy;
-var
-  I: Integer;
-begin
-  for I := 0 to SubItems.Count - 1 do THtmlElement(SubItems[I]).Free;
+begin
   SubItems.Free;
   inherited;
@@ -280 +296 @@
   with TXmlTag(Result) do begin
     case BlockType of
-      btBlockLevel: TagName := 'div';
-      btInline: TagName := 'span';
-      btNoTag: TagName := '';
+      btBlockLevel: Name := 'div';
+      btInline: Name := 'span';
+      btNoTag: Name := '';
     end;
     for I := 0 to SubItems.Count - 1 do
@@ -351 +367 @@
 procedure TIpAddress.SetAsString(const Value: string);
 var
-  Parts: TStringArray;
-begin
-  Parts := Explode('.', Value);
+  Parts: TStringListEx;
+begin
   try
+    Parts := TStringListEx.Create;
+    Parts.Explode('.', Value);
+    try
 //    if Length(Parts) = 4 then begin
-    Octets[0] := StrToInt(Parts[3]);
-    Octets[1] := StrToInt(Parts[2]);
-    Octets[2] := StrToInt(Parts[1]);
-    Octets[3] := StrToInt(Parts[0]);
+      Octets[0] := StrToInt(Parts[3]);
+      Octets[1] := StrToInt(Parts[2]);
+      Octets[2] := StrToInt(Parts[1]);
+      Octets[3] := StrToInt(Parts[0]);
 //    end else raise EConvertError.Create('String to IP address conversion error');
-  except
-    raise EConvertError.Create('String to IP address conversion error');
+    except
+      raise EConvertError.Create('String to IP address conversion error');
+    end;
+  finally
+    Parts.Free;
   end;
 end;
@@ -430 +451 @@
 procedure TDomainAddress.SetAsString(const Value: string);
 var
-  StrArray: TStringArray;
+  StrArray: TStringListEx;
   I: Integer;
 begin
-  StrArray := Explode('.', Value);
-  SetLength(Levels, Length(StrArray));
-  for I := 0 to High(StrArray) do Levels[High(StrArray) - I] := StrArray[I];
+  try
+    StrArray := TStringListEx.Create;
+    StrArray.Explode('.', Value);
+    SetLength(Levels, StrArray.Count);
+    for I := 0 to StrArray.Count do
+      Levels[StrArray.Count - I] := StrArray[I];
+  finally
+    StrArray.Free;
+  end;
 end;
 
@@ -455 +482 @@
   Result := TXmlTag.Create;
   with TXmlTag(Result) do begin
-    TagName := 'a';
+    Name := 'a';
     Attributes.Add('href='+Target.AsString);
     if Assigned(Content) then SubElements.Add(Content.AsXmlElement);
@@ -522 +549 @@
   Result := TXmlTag.Create;
   with TXmlTag(Result) do begin
-    TagName := 'img';
+    Name := 'img';
     Attributes.AddNameValue('src', Source.AsString);
     Attributes.AddNameValue('width', IntToStr(Size.Width));