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的:包括 ...
随机推荐
- requests.post发送字典套字典
import requests import json a = { "data": { "project": { "url": " ...
- linux centos-7.2-64bit 安装配置启动nginx
1.安装依赖包yum -y install openssl openssl-develyum install pcre*yum install openssl*yum install zlib yum ...
- Java-NIO（二）：缓冲区(Buffer)的数据存取
缓冲区(Buffer): 一个用于特定基本数据类行的容器.有java.nio包定义的,所有缓冲区都是抽象类Buffer的子类. Java NIO中的Buffer主要用于与NIO通道进行交互,数据是从通 ...
- Struts(十六)：通过CURD来学习Struts流程及ModelDriven的用法
背景: 从一个Member的增删改查,来了解Struts2的运行原理及学习ModelDriven拦截器.Preparable拦截器. 新建项目实现列表的展示及删除功能: web.xml <?xm ...
- 南京邮电大学java程序设计作业在线编程第二次作业
王利国的"Java语言程序设计第2次作业(2018)"详细 作业结果详细 总分:100 选择题得分:60 1. 表达式9==8&&3<7的运算结果是( ) ...
- [LeetCode] Subarray Product Less Than K 子数组乘积小于K
Your are given an array of positive integers nums. Count and print the number of (contiguous) subarr ...
- Java中数据表的建立
class Emp{ private int empno;//职工编号 private String ename;//姓名 private String job;//职位 private double ...
- 从零开始搭建口袋妖怪管理系统(1)-从Angular1.x开始
开坑,一直喜欢口袋妖怪,想着能写点有关的程序. 最近项目要改写管理系统,所以用Angular1.x搭建一个口袋妖怪管理系统试试. 巩固Ng1.x的知识+学习库的用法,然后算是记录一个系统从零开始到成型 ...
- [Luogu 3835]【模板】可持久化平衡树
Description 您需要写一种数据结构(可参考题目标题),来维护一些数,其中需要提供以下操作(对于各个以往的历史版本): 插入x数 删除x数(若有多个相同的数,因只删除一个,如果没有请忽略该操作 ...
- WISCO信息组NOIP模拟赛-部落冲突
传送门 首先肯定考虑树剖,这里没有要求区间加,所以可以用树状数组维护,不会卡常的 这里是边权,可以转化为点权:让每条边连接的较深的节点的点权等于边权即可,然后计算的时候减去lca #include&l ...