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的:包括 ...
随机推荐
- fetch简明学习
前面的话 Fetch API 提供了一个 JavaScript接口,用于访问和操纵HTTP管道的部分,例如请求和响应.它还提供了一个全局 fetch()方法,该方法提供了一种简单,合乎逻辑的方式来跨网 ...
- 前端插件之Bootstrap Switch 选择框开关控制
简介 Bootstrap Switch是一款轻量级插件,可以给选择框设置类似于开关的样式 它是依赖于Bootstrap的一款插件 下载 下载地址 在线引用 导入 因为它是依赖于Bootstrap的一款 ...
- 有没有想过css定位与xpath的区别
我是这样理解的, css选择如同你尽可能具体的描述一个元素的形态, 包括他的: 标签, 类, id 以及这些的组合, 目标是尽可能确定元素的唯一坐标 , 以方便选择. 而xpath是根据元素的路径去确 ...
- 1025InnoDB log file 设置多大合适
转自 http://blog.csdn.net/langkeziju/article/details/51094289 数据库的东西,往往一个参数就牵涉N多知识点.所以简单的说一下.大家都知道inno ...
- C# 类型、存储和变量
如果广泛地描述C和C++程序的源代码的特征,可以说C程序是一组函数和数据类型,C++程序是一组函数和类,然而C#程序是一组类型声明. 既然C#程序就是一组类型声明,那么学习C#就是学习如何创建和使用类 ...
- linux实现文件的去重【转】
(1)两个文件的交集,并集 1. 取出两个文件的并集(重复的行只保留一份) cat file1 file2 | sort | uniq > file3 2. 取出两个文件的交集(只留下同时存在于 ...
- 学习ASP.NET Core Razor 编程系列六——数据库初始化
学习ASP.NET Core Razor 编程系列目录 学习ASP.NET Core Razor 编程系列一 学习ASP.NET Core Razor 编程系列二——添加一个实体 学习ASP.NET ...
- JavaScript数据结构与算法(八) 集合（ECMAScript 6中定义的类似的Set类）
TypeScript方式实现源码 // 特性: // 1. 集合是由一组无序且唯一(即不能重复)的项组成的.这个数据结构使用了与有限集合相同的数学概念,但应用在计算机科学的数据结构中. // 2. 也 ...
- JS实现手机访问pc网址自动跳转到wap网站
之前写pc端直接跳转wap端一直是后端java写的,跟js一样都是根据navigator.userAgent来判断设备是电脑还是手机的,我知道这种前端也可已完成的功能,只是后台比较强势,本人本着以和为 ...
- [LeetCode] Maximum Binary Tree 最大二叉树
Given an integer array with no duplicates. A maximum tree building on this array is defined as follo ...