delphi 面向对象实用技能教学一(递归)

Posted 晓不得2013

tags:

篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了delphi 面向对象实用技能教学一(递归)相关的知识,希望对你有一定的参考价值。

本例使用类与TList相结合,用简洁的方法,实现了一个 html 解析与格式化功能。
所用到的知识点如下:
1.类的提前申明
2.TList用法
3.String的指针操作
4.单例设计
5.递归用法

编程是综合实力的较量,把单个技术小点,结合起来,实现一个具体的功能才能创造价值。
为了让代码漂亮,需要反复修改,善用重构工具。

写完本例后的思考:
此类解析文本的工作,不适合用Class来实现,应该用接口。
原因是,如果要取Class中的Item并使用,此时Item到底由谁来负责释放的问题变得复杂了。
如:SuperObject.pas 解析JSON就是用的接口。系统自带单元,解析HTML Document 也是用的接口。
本例源码下载(XE8)

unit uHtmlItem;
interface
uses
  uSimpleList;

type
  THtmlItem = class; // 类型提前申明

  THtmlItemList = class(TSimpleList<THtmlItem>)
  private
    function FindIndexByTagName(ATagName: string): integer;
  protected
    procedure FreeItem(Item: THtmlItem); override;
  end;

  THtmlItem = class
  private
    FTagName: string;
    Taghead: string;
    TagTail: string;
    TagHeadBegin: integer;
    TagHeadEnd: integer;
    TagTailBegin: integer;
    TagTailEnd: integer;
    FLevel: integer; // 层级数
  private
    FChildren: THtmlItemList; // 为递归做准备
    FParent: THtmlItem;
    FHtml: string; // FHtml 单例
    function GetHtml: string;
    procedure SetHtml(const Value: string);
    function AddChild: THtmlItem; overload;
    function SpaceTimes(ATimes: integer): string;
    function InnerGetHtmlText: string;
  public
    constructor Create;
    destructor Destroy; override;
  protected
    property Html: string read GetHtml write SetHtml;
  public
    function GetHtmlText: string;
    function GetFormatedHtmlText: string;
  public
    class function ParseHtml(AHtml: string): THtmlItem;
  end;

implementation
{ THtmlItemList }
uses
  System.SysUtils;

// 跳过所有的空白 char ,直至找到一个非空白的char
function SkipBlankChar(const S: string; AStartPos: integer): integer;
const
  BlankChars: array [0 .. 3] of char = (#$20, #$09, #$0A, #$0D);
var
  D: PChar;
  C: char;
  i: integer;
begin
  Result := AStartPos;
  D := @S[AStartPos];
  for i := AStartPos to length(S) do
  begin
    for C in BlankChars do
      if D^ <> C then // 指针的使用
      begin
        Result := i;
        exit;
      end;
    inc(D);
  end;
end;

// 搜索 Char
function SearchChar(const S: string; AStartPos: integer; C: char): integer;
var
  i: integer;
  D: PChar;
begin
  Result := 0;
  D := @S[AStartPos];
  for i := AStartPos to length(S) do
  begin
    if D^ = C then
    begin
      Result := i;
      exit;
    end;
    inc(D);
  end;
end;

// 搜 <html >
function SearchTagHead(const S: string; AStartPos: integer; var ABeginPos, AEndPos: integer): boolean;
var
  nPos, nStrLen: integer;
begin
  Result := false;
  nStrLen := length(S);
  ABeginPos := SearchChar(S, AStartPos, \'<\');
  nPos := ABeginPos + 1;
  if (ABeginPos > 0) and (nPos < nStrLen) then
  begin
    AEndPos := SearchChar(S, nPos, \'>\');
    Result := AEndPos > 0;
  end;
end;

function InnerGetTagName(const S: string; AStartPos: integer = 2): string;
const
  TailChar: array [0 .. 4] of char = (#$20, #$09, #$0A, #$0D, \'>\');
var
  i, nPos, nStrLen: integer;
  D: PChar;
  C: char;
  nBegin: integer;
begin
  Result := \'\';
  nStrLen := length(S);
  nPos := AStartPos;
  nBegin := SkipBlankChar(S, nPos);
  nPos := nBegin + 1;
  if (nBegin > 0) and (nPos < nStrLen) then
  begin
    D := @S[nPos];
    for i := nPos to nStrLen do
    begin
      for C in TailChar do
        if D^ = C then
        begin
          Result := copy(S, nBegin, i - nBegin);
          exit;
        end;
      inc(D);
    end;
  end;
end;

// ATagHead -- <html xx=123> ,输出:html
function GetTagNameByHead(const ATagHead: string): string; inline;
begin
  Result := InnerGetTagName(ATagHead, 2);
end;

// ATagTail </html>  ,输出 html
function GetTagNameByTail(const ATagTail: string): string; inline;
begin
  Result := InnerGetTagName(ATagTail, 3);
end;

function THtmlItemList.FindIndexByTagName(ATagName: string): integer;
var
  i: integer;
begin
  Result := -1;
  for i := Self.Count - 1 downto 0 do
  begin
    if (Self[i].TagTail = \'\') and (Self[i].FTagName = ATagName) then
    begin
      Result := i;
      exit;
    end;
  end;
end;

procedure THtmlItemList.FreeItem(Item: THtmlItem);
begin
  inherited;
  Item.Free;
end;
{ THtmlItem }

function THtmlItem.AddChild: THtmlItem; // 函数的类型为本类型,这是类型提前申明的用法。
begin
  Result := THtmlItem.Create;
  Result.FParent := Self; // 为找到顶级父类提供线索
  FChildren.Add(Result);
end;

constructor THtmlItem.Create;
begin
  inherited;
  FChildren := THtmlItemList.Create;
  FLevel := -1;
end;

destructor THtmlItem.Destroy;
begin
  FChildren.Free;
  inherited;
end;

function THtmlItem.GetFormatedHtmlText: string;
var
  Q: THtmlItem;
  sTemp: string;
  sHtmlText: string;
begin
  Result := \'\';
  if FChildren.Count = 0 then
  begin
    if length(TagTail) = 0 then // 没有 TagTail 的 HtmlItem
      Result := SpaceTimes(FLevel) + Taghead
    else
      Result := SpaceTimes(FLevel) + Taghead + InnerGetHtmlText + TagTail;
  end
  else
  begin
    sHtmlText := \'\';
    for Q in FChildren do
    begin
      Q.FLevel := FLevel + 1;
      sTemp := Q.GetFormatedHtmlText; // 递归
      if length(sTemp) > 0 then
      begin
        if length(sHtmlText) > 0 then
          sHtmlText := sHtmlText + #13#10;
        sHtmlText := sHtmlText + sTemp;
      end;
    end;
    Result := Result + SpaceTimes(FLevel) + Taghead + #13#10 + sHtmlText + #13#10 + SpaceTimes(FLevel) + TagTail;
  end;
end;

function THtmlItem.GetHtml: string;
begin
  // 根 Item 才有 Html ,其它都是引用此 html
  if not Assigned(FParent) then
    Result := FHtml
  else
    Result := FParent.Html; // 实现 Html 内容为单例
end;

function THtmlItem.GetHtmlText: string;
var
  Q: THtmlItem;
  sHtmlText: string;
begin
  Result := \'\';

  if (length(TagTail) > 0) and (FChildren.Count = 0) then
    Result := InnerGetHtmlText;

  for Q in FChildren do
  begin
    sHtmlText := Q.GetHtmlText; // 递归
    if length(sHtmlText) > 0 then
    begin
      if (length(Result) > 0) then
        Result := Result + #13#10;
      Result := Result + sHtmlText;
    end;
  end;
end;

function THtmlItem.InnerGetHtmlText: string;
var
  nLeft, nRight: integer;
begin
  Result := \'\';
  if Assigned(FParent) then
  begin
    nLeft := TagHeadEnd + 1;
    nRight := TagTailBegin - 1;
    Result := Result + copy(Html, nLeft, nRight - nLeft + 1);
  end;
end;

class function THtmlItem.ParseHtml(AHtml: string): THtmlItem;
var
  i, nPos, HtmlItemIndex: integer;
  LeftAngleBracketPos: integer; // >位置
  RightAngleBracketPos: integer; // <位置
  nStrLen: integer;
  sTag, sTagName: string;
  Q, M: THtmlItem;
  L: THtmlItemList;
begin
  Result := THtmlItem.Create;
  nStrLen := length(AHtml);
  nPos := 1;
  Result.Html := AHtml;
  L := Result.FChildren;
  while nPos < nStrLen do
  begin
    // 找 <html >
    if SearchTagHead(AHtml, nPos, LeftAngleBracketPos, RightAngleBracketPos) then
    begin
      // 得到 <html > 或 </html >
      sTag := copy(AHtml, LeftAngleBracketPos, RightAngleBracketPos - LeftAngleBracketPos + 1);
      nPos := RightAngleBracketPos + 1;

      if sTag[2] = \'/\' then // 如果是</html>,往回找 <html>
      begin

        sTagName := UpperCase(GetTagNameByTail(sTag));
        HtmlItemIndex := L.FindIndexByTagName(sTagName); // 找与之配对的 <html 位置

        if HtmlItemIndex > -1 then // 回找时,路过的 HtmlItem 都是 Child
        begin

          Q := L[HtmlItemIndex];
          Q.TagTail := sTag;
          Q.TagTailBegin := LeftAngleBracketPos;
          Q.TagTailEnd := RightAngleBracketPos;

          for i := L.Count - 1 downto HtmlItemIndex + 1 do
          begin
            M := L.PopLast;
            M.FParent := Q; // 指定 Q 的 Parent
            Q.FChildren.Insert(0, M); // 把顺序放对
            // 从 List 取出并放进 Q 的 Children 中。
          end;

        end;
      end
      else
      begin // <html>
        Q := Result.AddChild;
        Q.FTagName := UpperCase(GetTagNameByHead(sTag));
        Q.Taghead := sTag;
        Q.TagHeadBegin := LeftAngleBracketPos;
        Q.TagHeadEnd := RightAngleBracketPos;
      end;
    end
    else
      break;
  end;
end;

procedure THtmlItem.SetHtml(const Value: string);
begin
  if not Assigned(FParent) then
    FHtml := Value
end;

function THtmlItem.SpaceTimes(ATimes: integer): string;
var
  i: integer;
  D: PChar;
begin
  Result := \'\';
  if ATimes > 0 then
  begin
    SetLength(Result, ATimes * 4);
    D := PChar(Result);
    for i := 0 to ATimes * 4 - 1 do
      D[i] := \' \';
  end;
end;
end.
uHtmlItem.pas

 

以上是关于delphi 面向对象实用技能教学一(递归)的主要内容,如果未能解决你的问题,请参考以下文章

❤️Python面向对象保姆式教学❤️,新手速成精英之路!

❤️Python面向对象保姆式教学❤️,新手速成精英之路!

教学典型案例18.开门小例子理解面向对象

Delphi面向对象设计的经验原则(61条)

面向对象 继承 派生

非常实用,推荐一种面向对象思维的单片机程序框架