整合营销服务商
电脑端+手机端+微信端=数据同步管理
免费咨询热线：
电脑端+手机端+微信端=数据同步管理
免费咨询热线：
用DeWeb可以实现用Delphi开发echarts图表
DeWeb : Delphi开发者的Web解决方案！
DeWeb是一个可以直接将Delphi程序快速转换为网页应用的工具！ 使用DeWeb, 开发者不需要学习HTML、JavaScript、Java、PHP、ASP、C#等新知识，用Delphi搞定一切。 DeWeb开发的网页支持所有客户端，包括手机、平板等。
网址：https://gitee.com/xamh/dewebsdk
采用DeWeb可以非常方便开发echarts图表应用。
还不会DeWeb开发的朋友请参考相关文档
1 打开一个基本DeWeb应用
比如自带的hello例程
2 创建echarts控件
拖放一个TMemo控件，设置其HelpKeyword为echarts
3 配置echarts控件
（1）在echarts官网打开拟开发的图表例程，如
https://echarts.apache.org/examples/zh/editor.html?c=pie-nest
效果图如下：
echarts图表效果
（2）复制该网页左侧的JS代码，注意：只复制option后{....}及其中的内容
（3）打开Notepad++, 新建一个文件，粘贴进去, 再全选，然后复制；
这一步骤主要是保持原代码的换行符。直接复制到TMemo控件中会丢失，导致错误。
（4）打开Delphi中TMemo控件的Lines, 粘贴进去
即内容为
{
tooltip: {
trigger: 'item',
formatter: '{a} <br/>{b}: {c} ({d}%)'
},
legend: {
data: [
'Direct',
'Marketing',
'Search Engine',
'Email',
'Union Ads',
'Video Ads',
'Baidu',
'Google',
'Bing',
'Others'
]
},
series: [
{
name: 'Access From',
type: 'pie',
selectedMode: 'single',
radius: [0, '30%'],
label: {
position: 'inner',
fontSize: 14
},
labelLine: {
show: false
},
data: [
{ value: 1548, name: 'Search Engine' },
{ value: 775, name: 'Direct' },
{ value: 679, name: 'Marketing', selected: true }
]
},
{
name: 'Access From',
type: 'pie',
radius: ['45%', '60%'],
labelLine: {
length: 30
},
label: {
formatter: '{a|{a}}{abg|}\n{hr|}\n {b|{b}：}{c} {per|{d}%} ',
backgroundColor: '#F6F8FC',
borderColor: '#8C8D8E',
borderWidth: 1,
borderRadius: 4,
rich: {
a: {
color: '#6E7079',
lineHeight: 22,
align: 'center'
},
hr: {
borderColor: '#8C8D8E',
width: '100%',
borderWidth: 1,
height: 0
},
b: {
color: '#4C5058',
fontSize: 14,
fontWeight: 'bold',
lineHeight: 33
},
per: {
color: '#fff',
backgroundColor: '#4C5058',
padding: [3, 4],
borderRadius: 4
}
}
},
data: [
{ value: 1048, name: 'Baidu' },
{ value: 335, name: 'Direct' },
{ value: 310, name: 'Email' },
{ value: 251, name: 'Google' },
{ value: 234, name: 'Union Ads' },
{ value: 147, name: 'Bing' },
{ value: 135, name: 'Video Ads' },
{ value: 102, name: 'Others' }
]
}
]
}在窗体的OnMouseDown事件中写入
dwEcharts(Memo1);
编译运行，即可得到
（5）更新数据。
执行到上一步，效果出来了，但会发现无法更新数据。
原因是代码中把数据（data部分）写成固定的了
先需要把TMemo的内容改成以下。注意"data:XXX"的变化
{
tooltip: {
trigger: 'item',
formatter: '{a} <br/>{b}: {c} ({d}%)'
},
legend: {
data: [
'Direct',
'Marketing',
'Search Engine',
'Email',
'Union Ads',
'Video Ads',
'Baidu',
'Google',
'Bing',
'Others'
]
},
series: [
{
name: 'Access From',
type: 'pie',
selectedMode: 'single',
radius: [0, '30%'],
label: {
position: 'inner',
fontSize: 14
},
labelLine: {
show: false
},
data: this.value0
},
{
name: 'Access From',
type: 'pie',
radius: ['45%', '60%'],
labelLine: {
length: 30
},
label: {
formatter: '{a|{a}}{abg|}\n{hr|}\n {b|{b}：}{c} {per|{d}%} ',
backgroundColor: '#F6F8FC',
borderColor: '#8C8D8E',
borderWidth: 1,
borderRadius: 4,
rich: {
a: {
color: '#6E7079',
lineHeight: 22,
align: 'center'
},
hr: {
borderColor: '#8C8D8E',
width: '100%',
borderWidth: 1,
height: 0
},
b: {
color: '#4C5058',
fontSize: 14,
fontWeight: 'bold',
lineHeight: 33
},
per: {
color: '#fff',
backgroundColor: '#4C5058',
padding: [3, 4],
borderRadius: 4
}
}
},
data: this.value1
}
]
}对应
this.value0应为
[
{ value: 1548, name: 'Search Engine' },
{ value: 775, name: 'Direct' },
{ value: 679, name: 'Marketing', selected: true }
]
this.value1应为
[
{ value: 1048, name: 'Baidu' },
{ value: 335, name: 'Direct' },
{ value: 310, name: 'Email' },
{ value: 251, name: 'Google' },
{ value: 234, name: 'Union Ads' },
{ value: 147, name: 'Bing' },
{ value: 135, name: 'Video Ads' },
{ value: 102, name: 'Others' }
]
在Delphi中的事件中组类似的字符串就可以了
具体做法是增加一个Timer, 时间设置为3000，代码如下：
procedure TForm1.Timer1Timer(Sender: TObject);
var
sV0,sV1 : String;
sJS : String;
begin
//value0
//[
// { value: 1548, name: 'Search Engine' },
// { value: 775, name: 'Direct' },
// { value: 679, name: 'Marketing', selected: true }
//]
//value1
//[
// { value: 1048, name: 'Baidu' },
// { value: 335, name: 'Direct' },
// { value: 310, name: 'Email' },
// { value: 251, name: 'Google' },
// { value: 234, name: 'Union Ads' },
// { value: 147, name: 'Bing' },
// { value: 135, name: 'Video Ads' },
// { value: 102, name: 'Others' }
//]
//
//
Randomize;
//Get value0 string
sV0 :='this.value0=['
+'{ value: %d, name: ''Search Engine'' },'
+'{ value: %d, name: ''Direct'' },'
+'{ value: %d, name: ''Marketing'', selected: true }'
+'];';
sV0 :=Format(sV0,[Random(1500),Random(1000),Random(1000)]);
//Get value1 string
sV1 :='this.value1=['
+'{ value: %d, name: ''Baidu'' },'
+'{ value: %d, name: ''Direct'' },'
+'{ value: %d, name: ''Email'' },'
+'{ value: %d, name: ''Google'' },'
+'{ value: %d, name: ''Union Ads'' },'
+'{ value: %d, name: ''Bing'' },'
+'{ value: %d, name: ''Video Ads'' },'
+'{ value: %d, name: ''Others'' }'
+'];';
sV1 :=Format(sV1,[Random(1500),Random(1000),Random(1000),Random(1000),Random(1000),Random(1000),Random(1000),Random(1000)]);
//
dwRunJS(sV0+sV1,self);
dwEcharts(Memo1);
end;这样echarts图表就可以动态更新了。
关注我， 学习更多Delphi知识！
载大文件时，断点续传是很有必要的，特别是网速度慢且不稳定的情况下，很难保证不出意外，一旦意外中断，又要从头下载，会很让人抓狂。断点续传就能很好解决意外中断情况，再次下载时不需要从头下载，从上次中断处继续下载即可，这样下载几G或十几G大小的一个文件都没问题。本文介绍利用miniframe开源Web框架分别在lazarus、delphi下实现文件HTTP下载断点续传的功能。
本文Demo还实现了批量下载文件，同步服务器上的文件到客户端的功能。文件断点续传原理：分块下载，下载后客户端逐一合并，同时保存已下载的位置，当意外中断再次下载时从保存的位置开始下载即可。这其中还要保证，中断后再次下载时服务器上相应的文件如果更新了，还得重新下载，不然下载到的文件是错了。说明：以下代码lazarus或delphi环境下都能使用。全部源码及Demo请到miniframe开源web框架下载: https://www.wyeditor.com/miniframe/或https://github.com/dajingshan/miniframe。
文件下载断点续传服务器端很简单，只要提供客户端要求下载的开始位置和指定大小的块即可。
以下是服务器获取文件信息和下载一个文件一块的代码：
<%@//Script头、过程和函数定义
program codes;
%>
<%!//声明变量
var
i,lp: integer;
FileName, RelativePath, FromPath, ErrStr: string;
json: TminiJson;
FS: TFileStream;
function GetOneDirFileInfo(Json: TminiJson; Path: string): string;
var
Status: Integer;
SearchRec: TSearchRec;
json_sub: TminiJson;
begin
Path :=PathWithSlash(Path);
SearchRec :=TSearchRec.Create;
Status :=FindFirst(Path + '*.*', faAnyFile, SearchRec);
try
while Status=0 do
begin
if SearchRec.Attr and faDirectory=faDirectory then
begin
if (SearchRec.name <> '.') and (SearchRec.name <> '..') then
GetOneDirFileInfo(Json, Path + SearchRec.Name + '\');
end else
begin
FileName :=Path + SearchRec.Name;
try
if FileExists(FileName) then
begin
json_sub :=Pub.GetJson;
json_sub.SO; //初始化 或 json.Init;
json_sub.S['filename'] :=SearchRec.name;
json_sub.S['RelativePath'] :=GetDeliBack(FileName, FromPath);
json_sub.S['FileTime'] :=FileGetFileTimeA(FileName);
json_sub.I['size'] :=SearchRec.Size;
json.A['list'] :=json_sub;
end;
except
//print(ExceptionParam)
end;//}
end;
Status :=FindNext(SearchRec);
end;
finally
FindClose(SearchRec);
SearchRec.Free;
end;//*)
end;
%>
<%
begin
FromPath :='D:\code\delphi\sign\发行文件'; //下载源目录
json :=Pub.GetJson; //这样创建json对象不需要自己释放，系统自动管理
json.SO; //初始化 或 json.Init;
// 验证是否登录代码
{if not Request.IsLogin('Logined') then
begin
json.S['retcode'] :='300';
json.S['retmsg'] :='你还没有登录(no logined)！';
print(json.AsJson(true));
exit;
end;//}
json.S['retcode'] :='200';
json.S['retmsg'] :='成功！';
if Request.V('opr')='1' then
begin //获取服务上指定目录的文件信息
GetOneDirFileInfo(Json, FromPath);
end else
if Request.V('opr')='2' then
begin //下载指定文件给定大小的块
FromPath :=PathWithSlash(FromPath);
RelativePath :=Request.V('fn');
FileName :=FromPath + RelativePath;
Fs :=Pub.GetFS(FileName, fmShareDenyWrite, ErrStr);
if trim(ErrStr) <> '' then
begin
json.S['retcode'] :='300';
json.S['retmsg'] :=ErrStr;
print(json.AsJson(true));
exit;
end;
Fs.Position :=StrToInt(Request.V('pos'));
Response.ContentStream :=TMemoryStream.Create; //注意不能用 Pub.GetMs，这是因为Pub.GetMs创建的对象在动态脚本运行完就释放了
Response.ContentStream.CopyFrom(Fs, StrToInt(Request.V('size')));
//返回流数据
Response.ContentType :='application/octet-stream';
end;
print(json.AsJson(true));
end;
%>客户端收到块后，进行合并。全部块下载完成后，还要把新下载的文件的文件修改为与服务器上的文件相同。以下是客户端实现的主代码：
procedure TMainForm.UpgradeBlock_Run(var ThreadRetInfo: TThreadRetInfo);
const
BlockSize=1024*1024; //1M
var
HTML, ToPath, RelativePath, FN, Tmp, TmpFileName, FailFiles, SuccFiles, Newfn, TmpToPath: string;
Json, TmpJson: TminiJson;
lp, I, Number, HadUpSize, AllSize, AllBlockCount, MySize, MyNumber: Int64;
Flag: boolean;
SL, SLDate, SLSize, SLTmp: TStringlist;
MS: TMemoryStream;
Fs: TFileStream;
procedure HintMsg(Msg: string);
begin
FMyMsg :=Msg; // '正在获取文件列表。。。';
ThreadRetInfo.Self.Synchronize(ThreadRetInfo.Self, MyUpdateface); //为什么不直接用匿名，因为laz不支持
end;
begin
ToPath :='D:\superhtml'; //如果是当前程序更新 ExtractFilePath(ParamStr(0))
ThreadRetInfo.Ok :=false;
HintMsg('正在获取文件列表。。。');
if not HttpPost('/接口/同步文件到客户端.html?opr=1',
'', ThreadRetInfo.ErrStr, ThreadRetInfo.HTML) then exit;
if Pos('{', ThreadRetInfo.HTML) <> 1 then
begin
ThreadRetInfo.ErrStr :='请先检查脚本源码是否配置正确！';
exit;
end;
ToPath :=Pub.PathWithSlash(ToPath);
Json :=TminiJson.Create;
SL :=TStringlist.Create;
SLDate :=TStringlist.Create;
SLSize :=TStringlist.Create;
SLTmp :=TStringlist.Create;
try
Json.LoadFromString(ThreadRetInfo.HTML);
if json.S['retcode']='200' then
begin
TmpJson :=json.A['list'];
for lp :=0 to TmpJson.length - 1 do
begin
HintMsg(lp.ToString + '/' + TmpJson.length.ToString + '正在检查文件:' + RelativePath);
RelativePath :=TmpJson[lp].S['RelativePath'];
if trim(RelativePath)='' then Continue;
Flag :=FileExists(ToPath + RelativePath);
if Flag then
begin
if (PubFile.FileGetFileTimeA(ToPath + RelativePath)=TmpJson[lp].S['FileTime']) and
(PubFile.FileGetFileSize(ToPath + RelativePath)=TmpJson[lp].I['Size']) then
else
Flag :=false;
end;
if not Flag then //此文件需要更新
begin
SL.Add(RelativePath);
SLDate.Add(TmpJson[lp].S['FileTime']);
SLSize.Add(TmpJson[lp].S['Size']);
end;
end;
//开始下载
FailFiles :='';
SuccFiles :='';
HintMsg('需要更新的文件共有' + IntToStr(SL.Count) + '个。。。');
for lp :=0 to SL.Count - 1 do
begin
RelativePath :=SL[lp];
if RelativePath[1]='\' then RelativePath :=Copy(RelativePath, 2, MaxInt);
FN :=ToPath + RelativePath;
//先计算要分几个包，以处理进度
Number :=0;
HadUpSize :=0;
AllSize :=StrToInt64(SLSize[lp]);
AllBlockCount :=0;
while true do
begin
AllBlockCount :=AllBlockCount + 1;
if AllSize - HadUpSize >=BlockSize then
MySize :=BlockSize
else
MySize :=AllSize - HadUpSize;
HadUpSize :=HadUpSize + MySize;
if HadUpSize >=AllSize then
break;
end;
//开始分块下载
Number :=0;
HadUpSize :=0;
//AllSize :=Fs.Size;
//TmpToPath :=PubFile.FileGetTemporaryPath;
Newfn :='@_' + PubPWD.GetMd5(SLDate[lp] + SLSize[lp]) + ExtractFileName(FN); //Pub.GetClientUniqueCode;
if FileExists(ToPath + Newfn) and (FileExists(FN)) then
begin
SLTmp.LoadFromFile(ToPath + Newfn);
MyNumber :=StrToInt64(trim(SLTmp.Text));
Fs :=TFileStream.Create(FN, fmOpenWrite);
end else
begin
MyNumber :=0;
Fs :=TFileStream.Create(FN, fmCreate);
end;
try
while true do
begin
HintMsg('正在下载文件[' + Pub.GetDeliBack(RelativePath, '@@') + ']第[' + IntToStr(Number + 1) + '/' + IntToStr(AllBlockCount) + ']个包。。。');
if AllSize - HadUpSize >=BlockSize then
MySize :=BlockSize
else
MySize :=AllSize - HadUpSize;
Number :=Number + 1;
if (MyNumber=0) or (Number >=MyNumber) or (HadUpSize + MySize >=AllSize) then
begin
for I :=1 to 2 do //意外出错重试一次
begin
if not HttpPost('/接口/同步文件到客户端.html?opr=2fn=' + UrlEncode(RelativePath) +
'pos=' + UrlEncode(IntToStr(HadUpSize)) + 'size=' + UrlEncode(IntToStr(MySize)),
'', ThreadRetInfo.ErrStr, ThreadRetInfo.HTML, MS) then
begin
if I=2 then
begin
ThreadRetInfo.ErrStr :=Json.S['retmsg'];
exit;
end else
Continue;
end;
if Pos('{', ThreadRetInfo.HTML) < 1 then
begin
if I=2 then
begin
ThreadRetInfo.ErrStr :=Json.S['retmsg'];
exit;
end else
Continue;
end;
Json.LoadFromString(ThreadRetInfo.HTML);
if json.S['retcode'] <> '200' then
begin
if I=2 then
begin
ThreadRetInfo.ErrStr :=Json.S['retmsg'];
exit;
end else
Continue;
end;
break;
end;
if MS=nil then
begin
ThreadRetInfo.ErrStr :='没能下载到文件[' + RelativePath + ']！' + json.S['retmsg'];
exit;
end else
begin
Fs.Position :=HadUpSize;
MS.Position :=0;
Fs.CopyFrom(MS, MS.Size);
MS.Free;
MS :=nil;
SLTmp.Text :=Number.ToString;
try
SLTmp.SaveToFile(ToPath + Newfn);
except
end;
end;
end;
HadUpSize :=HadUpSize + MySize;
if HadUpSize >=AllSize then
begin //全部下载完成
Fs.Free;
Fs :=nil;
Sleep(10);
PubFile.FileChangeFileDate(Fn, SLDate[lp]);
DeleteFile(ToPath + Newfn);
SuccFiles :=SuccFiles + #13#10 + RelativePath;
break;
end;
end;
finally
if Fs <> nil then
Fs.Free;
end;
end;
ThreadRetInfo.HTML :='';
if trim(SuccFiles) <> '' then
ThreadRetInfo.HTML :='本次更新了以下文件：'#13#10 + SuccFiles;
//if trim(FailFiles) <> '' then
//ThreadRetInfo.HTML :=trim(ThreadRetInfo.HTML + #13#10'以下文件更新失败：'#13#10 + FailFiles);
end;
finally
SLTmp.Free;
SLSize.Free;
SL.Free;
Json.Free;
SLDate.Free;
end;
ThreadRetInfo.Ok :=true;
end;以下是Demo运行界面：
方描述
Unit that implements generic container classes to group data items in arrays, dictionaries, lists, stacks, queues, and more.
译文：实现泛型容器类的单元，以在数组中对数据项进行分组，词典，列表，堆栈，队列等。
起初在接触到Delphi的时候我以为没有这一部分内容，所有的都要自己实现，此处请原谅我的无知。。。。
关于从那个版本开始支持泛型的，我在官方文档上没有找到对应的说明，也可能是我英语太菜，在官网迷路了。
根据百度得来的结果2007的版本没有（真百度的）支持2009的版本（万一老师的博客上引用的也是这个版本）开始出现，也就是最早支持泛型容器的版本应该是Delphi2009
聊泛型容器避不开的就是泛型的概念，之前看哔哩哔哩的网友留言从泛型一节就是开始懵逼了。其实大可不必，泛型可以理解为一个变量，它的值是一个具体的类型
嗯，其实也可以把它当作孙大圣，它可以变成任何东西
在这个单元内一共定义了13个容器类，我们在其中甚至可以看到线程队列。那么问题来了，我们需要精通或者学习所有的类吗？答案是否定的
容器类就我个人的理解其实一共有两大表现形式，一种是列表形式的像数组，而另一种形式则以 Key,Value 成对的形式。也就是说我们从中选择两个比较有代表性的类进行学习即可。下面是我选择的两个类
注意：在单元内我们还可以看到相似的类例如 System.Generics.Collections.TObjectList<T> 和 System.Generics.Collections.TList<T>区别在于带有Object的类会在删除元素时释放对象，而没有带Object的不会释放
针对容器类学习的总原则是围绕增、删、改、查这几个核心的API功能即可，其他的就只能现用现查了，不知道别人写代码是什么习惯，我写代码的时候帮助文档基本上都是开着的。。。
下面是针对两个容器类的代码实现
实体类（TStudent）代码
type
TStudent=class
private
FName: string;
public
property Name: string read FName write FName;
// 构造方法
constructor Create; overload;
// 有参构造方法
constructor Create(FName: string); overload;
end;
constructor TStudent.Create;
begin
end;
constructor TStudent.Create(FName: string);
begin
Self.FName :=FName;
end;
操作类（即增、删、改、查），我没有使用内联，几次想用都删了
uses
System.Generics.Collections, System.SysUtils;
var
// 文档上的定义是TList<T>，而我们的定义尖括号中的是TStudent,这就是泛型的用法
StudentList: TList<TStudent>;
// 循环中使用获取TList成员
Stu: TStudent;
begin
// 初始化学生列表
StudentList :=TList<TStudent>.Create;
StudentList.add(TStudent.Create('小强'));
StudentList.add(TStudent.Create('萧蔷'));
StudentList.add(TStudent.Create('小黑'));
StudentList.add(TStudent.Create('小白'));
StudentList.add(TStudent.Create('小黄'));
// 开始之前输出一次
for Stu in StudentList do begin
Writeln('学生信息是：' + Stu.Name);
end;
// 泛型容器自带的删除函数，偷个懒
StudentList.Delete(0);
// 修改，查询到指定的学生，修改其值即可
StudentList.Items[0].Name :='小白';
// 查询，其实和数组的操作没有太大区别
for Stu in StudentList do begin
Writeln('学生信息是：' + Stu.Name);
end;
end.
此类容器的特点是 key 唯一，并且几乎所有的操作都是根据 key 来的
改造下实体类（TStudent）增加一个属性，代码如下
type
TStudent=class
private
FName: string;
FId: string;
public
property Name: string read FName write FName;
property Id: string read FId write FId;
// 构造方法
constructor Create; overload;
// 有参构造方法
constructor Create(FName: string; FId: string); overload;
end;
constructor TStudent.Create;
begin
end;
constructor TStudent.Create(FName: string; FId: string);
begin
Self.FName :=FName;
end;
操作类（即增、删、改、查）
{注意单元的引用}
uses
System.Generics.Collections, System.SysUtils;
var
// 文档上的定义是TList<T>，而我们的定义尖括号中的是TStudent,这就是泛型的用法
StudentMap: TDictionary<string, TStudent>;
// 循环中使用获取TList成员
Key: string;
Student,Stu: TStudent;
begin
// 初始化学生列表
StudentMap :=TDictionary<string, TStudent>.Create;
// 此处的添加其实并不是太好，根据文档描述，当我们添加的元素的key已经存在会抛出异常
// 建议使用AddOrSetValue
StudentMap.add('1001', TStudent.Create('1002', '小强'));
StudentMap.add('1002', TStudent.Create('1001', '萧蔷'));
StudentMap.add('1003', TStudent.Create('1003', '小黑'));
StudentMap.add('1004', TStudent.Create('1004', '小白'));
StudentMap.add('1005', TStudent.Create('1004', '小黄'));
// 注意此处获取是key,也就是1001 1002这些东西
for Key in StudentMap.Keys do begin
// 获取到key之后，再根据key获取对应value也就是学生对象
// 这里的获取方式有点儿任性居然要的是一个指针，而不是直接返回
StudentMap.TryGetValue(Key, Student);
// 最好判断一下，否则容易出现空指针
if (Student <> nil) then
Writeln('学生信息是：' + Student.Name)
end;
// 删除元素，无论什么操作都是通过key去操作，因为key是不可以重复的
StudentMap.Remove('1005');
// 修改，没有就添加，有就更新
StudentMap.AddOrSetValue('1004', TStudent.Create('1004', '小黄'));
// 直接获取value
for Stu in StudentMap.values do begin
// 最好判断一下，否则容易出现空指针
if (Stu <> nil) then
Writeln('学生信息是：' + Student.Name)
end;
end.
万一的博客：https://www.cnblogs.com/del/category/113556.html
官方文档：http://docwiki.embarcadero.com/Libraries/Sydney/en/System.Generics.Collections
*请认真填写需求信息，我们会在24小时内与您取得联系。
