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 [ .. ] of char = (#$, #$, #$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 := ;
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 + ;
if (ABeginPos > ) and (nPos < nStrLen) then
begin
AEndPos := SearchChar(S, nPos, '>');
Result := AEndPos > ;
end;
end; function InnerGetTagName(const S: string; AStartPos: integer = ): string;
const
TailChar: array [ .. ] of char = (#$, #$, #$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 + ;
if (nBegin > ) 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, );
end; // ATagTail </html> ,输出 html
function GetTagNameByTail(const ATagTail: string): string; inline;
begin
Result := InnerGetTagName(ATagTail, );
end; function THtmlItemList.FindIndexByTagName(ATagName: string): integer;
var
i: integer;
begin
Result := -;
for i := Self.Count - downto 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 := -;
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 = then
begin
if length(TagTail) = 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 + ;
sTemp := Q.GetFormatedHtmlText; // 递归
if length(sTemp) > then
begin
if length(sHtmlText) > then
sHtmlText := sHtmlText + ##;
sHtmlText := sHtmlText + sTemp;
end;
end;
Result := Result + SpaceTimes(FLevel) + Taghead + ## + sHtmlText + ## + 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) > ) and (FChildren.Count = ) then
Result := InnerGetHtmlText; for Q in FChildren do
begin
sHtmlText := Q.GetHtmlText; // 递归
if length(sHtmlText) > then
begin
if (length(Result) > ) then
Result := Result + ##;
Result := Result + sHtmlText;
end;
end;
end; function THtmlItem.InnerGetHtmlText: string;
var
nLeft, nRight: integer;
begin
Result := '';
if Assigned(FParent) then
begin
nLeft := TagHeadEnd + ;
nRight := TagTailBegin - ;
Result := Result + copy(Html, nLeft, nRight - nLeft + );
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 := ;
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 + );
nPos := RightAngleBracketPos + ; if sTag[] = '/' then // 如果是</html>,往回找 <html>
begin sTagName := UpperCase(GetTagNameByTail(sTag));
HtmlItemIndex := L.FindIndexByTagName(sTagName); // 找与之配对的 <html 位置 if HtmlItemIndex > - then // 回找时,路过的 HtmlItem 都是 Child
begin Q := L[HtmlItemIndex];
Q.TagTail := sTag;
Q.TagTailBegin := LeftAngleBracketPos;
Q.TagTailEnd := RightAngleBracketPos; for i := L.Count - downto HtmlItemIndex + do
begin
M := L.PopLast;
M.FParent := Q; // 指定 Q 的 Parent
Q.FChildren.Insert(, 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 > then
begin
SetLength(Result, ATimes * );
D := PChar(Result);
for i := to ATimes * - do
D[i] := ' ';
end;
end;
end.
uHtmlItem.pas
delphi 面向对象实用技能教学一(递归)的更多相关文章
- delphi 面向对象实用技能教学二(封装)
面向对象编程手法,是一项综合技能,单独把谁拿出来说都不合适.本次重写 TSimpleThread ,使其能在 D7 下运行. 基于 TSimpleThread ,重磅推出 TSimpleUI.ExeP ...
- VS Code实用技能1 - 代码折叠、面包屑
VS Code实用技能 VS Code实用技能1 - 代码折叠.面包屑 一.代码折叠 ubuntu ctrl + shift + { ctrl + shift + } ctrl + k , ctrl ...
- excel操作数据实用技能
写代码写习惯了,在做数据预处理时也总是习惯性地用python.pandas来做处理,但其实有时候根本不需要写代码,用excel也能达到目的,甚至比写代码快很多,写代码要半天,excel只要几秒钟.下面 ...
- Git使用教程七——Git实用技能
Git实用技能 1.图形管理工具 Github for Desktop Source tree 老牌的GitGUl管理工具了,也号称是最好用的Git GUI工具.功能丰富,基本操作和高 级操作都非常流 ...
- Delphi 进阶基础技能说明
以下讨论均基于Delphi XE8,主要是利用DELPHI新版的功能,如:Unicode,泛型,匿名函数等[XE2 后应该都支持]. 用新特性的好处是少写代码,提高效率.本博客不再讨论Delphi旧版 ...
- 转：Delphi 6 实用函数
来自: daocaoren0824, 时间: -- ::, ID: 再给你一份 程序员实用函数 {▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎} {▎ ▎} {▎ 大 ...
- Delphi面向对象编程
一.面向对象介绍 OOP是使用独立的对象(包含数据和代码)作为应用程序模块的范例.虽然OOP不能使得代码容易编写,但是它能够使得代码易于维护.将数据和代码结合在一起,能够使定位和修复错误的工作简单化, ...
- JS高级. 04 增删改查面向对象版歌曲管理、递归、
增 数组.push() 删 数组.splice(开始删除索引,删除几个) 在当前对象中调用当前对象的方法中和属性,必须用this调用 nodeType判断节点类型 节点.nodeType == 1: ...
- Delphi面向对象的编程思想
第一章.建立面向对象的新思维 1.1.1历史背景 目前对象技术的前沿课题包括设计模式.分布式对象系统.和基于网络的对象应用等 目前面向对象的语言包含4个基本的分支: 1.基于Smalltalk的:包括 ...
随机推荐
- Delaunay三角化算法
参考:<平面域中的Delaunay三角算法>
- ORA-01578和ORA-26040--NOLOGGING操作引起的坏块-错误解释和解决方案(文档ID 1623284.1)
ORA-01578和ORA-26040--NOLOGGING操作引起的坏块-错误解释和解决方案(文档ID 1623284.1) (一)NOLOGGING操作引起的坏块(ORA-01578和ORA-26 ...
- Python之格式化输出，初始编码以及运算符
一.题型 1.使用while循环输入 1 2 3 4 5 6 8 9 10 count = 0 while count < 10: count += 1 #count = count + ...
- angular-单页面应用程序
我们都知道angularjs是单一页面应用程序,那什么是单一页面应用程序呢?单一页面应用程序到底有什么好处呢? 下面我们来看一下: 首先我觉得可以把页面的响应模式分成这样大概3个阶段: 1. 最传统的 ...
- Hibernate（十三）：HQL查询（二）
背景 基于上一章节<Hibernate(十二):HQL查询(一)>,已经学习了一部分关于HQL的用法: HQL带参数查询 HQL Order By排序查询 HQL 设置实体参数查询 本章节 ...
- python自带的web服务器
python自带的web服务器 python自带的包可以建立简单的web服务器 BaseHTTPServer 提供基本的web服务和处理类 SimpleHTTPServer 包含执行get请求的Sim ...
- 微信小程序：wx.request之post请求后端无法获取数据的问题
前言:小程序的开发中总是踩到各种坑,看文档也不知所云: 例如当我们在写微信小程序接口时,method请求方式有POST和GET两种,为了数据安全,我们会偏向于使用POST请求方式访问服务器端: 问题: ...
- CountDownLatch与thread-join()的区别
今天学习CountDownLatch这个类,作用感觉和join很像,然后就百度了一下,看了他们之间的区别.所以在此记录一下. 首先来看一下join,在当前线程中,如果调用某个thread的join方法 ...
- Swagger+Asp.net WebApi实例
第一步新建WebApi项目 文件-新建-项目,弹出以下页面 第二步,新建参数项目 第三步 1.自定义输入参数 2.定义公用输出参数 3.定义输出参数 4.定义返回模型 第四步,在webapi项目中新增 ...
- 关于装双系统Ubantu16.04+Win10引导问题
1.装完双系统,必定会遇到时间不一致的问题解决问题如下 sudo apt-get install ntpdate sudo ntpdate time.windows.com sudo hwclock ...