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的:包括 ...
随机推荐
- Python系列之 - 面向对象(1)
python是一门面向对象的编程语言,python中的一切均是对象. 有对象就提到类,对象和类就像是儿子和老子的关系,是不可分的一对. 什么是类 类就是具有一些共同特性的事物的统称.好比人类, ...
- H5 input输入限制最大位数，和调用小键盘需求发生冲突的解决办法
首先,限制输入最大位数时,input有自带的属性maxlength. <input type="text" name="email" maxlength= ...
- hive:默认允许动态分区个数为100，超出抛出异常：
在创建好一个分区表后,执行动态分区插入数据,抛出了错误: Caused by: org.apache.hadoop.hive.ql.metadata.HiveFatalException: [Erro ...
- Android:触屏事件
Android触屏事件包含两种: 1)屏幕触屏事件:重写onTouchEvent(MotionEvent event): 2)控件触屏事件:给控件注册触屏事件,setOnTouchEventListe ...
- QT 设计师使用样式表添加背景
QT create中样式表可以用来设置背景图.背景颜色.字体大小格式颜色等 1.添加背景图的话需要先添加资源文件 右击项目文件选择添加新文件,再选择QT资源文件(QT resource file)然后 ...
- js分页效果
<!DOCTYPE html> <html lang="en"> <head> <meta charset="UTF-8&quo ...
- 使用生成器把Kafka写入速度提高1000倍
title: 使用生成器把Kafka写入速度提高1000倍 toc: true comment: true date: 2018-04-13 21:35:09 tags: ['Python', '经验 ...
- webpack的学习准备工作
第一步:创建一个空项目,在terminal中 npm init 创建package.json文件,直接回车便可. 第二步:局部安装webpack: npm install --save-dev we ...
- python基础面试
1 请用自己的算法, 按升序合并如下两个list, 并去除重复的元素: list1 = [2, 3, 8, 4, 9, 5, 6]list2 = [5, 6, 10, 17, 11, 2] 答案: ...
- 区间(interval)
[问题描述]给定 N 个区间, 要求选出若干个区间 A1, A2, A3... Am (m > 1), 使得:|A1∩A2∩A3...∩Am| * |A1∪A2∪A3...∪Am|最大.[输入格 ...