delphi XE 10实现App和PC下TreeView调用ImageList和Sqlite数据
delphi XE 10实现App和PC下TreeView调用ImageList和Sqlite数据
一、工程
program TreeView;
uses
System.StartUpCopy,
FMX.Forms,
Unit1 in 'Unit1.pas' {Form1},
FrmTreeView in 'FrmTreeView.pas' {FrameTreeView: TFrame},
Unit2 in 'Unit2.pas' {Form2},
Main in 'Main.pas' {fmxMain};
{$R *.res}
begin
ReportMemoryLeaksOnShutdown :=True;
Application.Initialize;
Application.CreateForm(TfmxMain, fmxMain);
Application.Run;
end.二、主窗体
unit Main;
interface
uses
System.SysUtils, System.Types, System.UITypes,
System.Classes, System.Variants, System.IOUtils,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
FMX.Layouts, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Ani, System.Actions,
FMX.ActnList;
type
TfmxMain = class(TForm)
NavBar_Pulledup: TRectangle;
StyleBook_MetropolisUIBlue: TStyleBook;
LayoutGloble: TLayout;
Rectangle_Caption: TRectangle;
Rectangle_Line: TRectangle;
Rectangle_WorkSpace: TRectangle;
Image_MenuClose: TImage;
BitmapListAnimation_MenuClose: TBitmapListAnimation;
Label_MenuClose: TLabel;
Label_Caption: TLabel;
Rectangle1: TRectangle;
Label1: TLabel;
Rectangle2: TRectangle;
Label2: TLabel;
ActionList1: TActionList;
ControlAction_Label1: TControlAction;
ControlAction_Label2: TControlAction;
ScrollBox1: TScrollBox;
procedure ControlAction_Label1Execute(Sender: TObject);
procedure ControlAction_Label2Execute(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
fmxMain: TfmxMain;
implementation
uses Unit1,Unit2;
{$R *.fmx}
function myFuc(var APointer: Pointer):Pointer;
begin
if APointer=nil then Result:=nil
else Result:=APointer;
end;
procedure TfmxMain.ControlAction_Label1Execute(Sender: TObject);
begin
if not Assigned(Form1) then
Form1 := TForm1.create(Application);
//不Show出来就静默执行:
Form1.Show;
end;
procedure TfmxMain.ControlAction_Label2Execute(Sender: TObject);
begin
//if Form2=nil then //:等效于:
if not Assigned(Form2) then
Form2 := TForm2.create(Application);
//if Assigned(Form2) then Form2.Label_Caption.Text:='过程指针类型始终与方法指针类型不兼容';
//不Show出来就静默执行:
Form2.Show;
end;
procedure TfmxMain.FormShow(Sender: TObject);
begin
Label_Caption.Text:=
System.IOUtils.TPath.Combine(
System.IOUtils.TPath.GetSharedDocumentsPath ,
Application.DefaultTitle
+System.SysUtils.PathDelim
+ 'CarveoutO2OTest.s3db' );
//}
end;
end.三、子窗体TForm1：FMX TreeView调用ImageList数据
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
FMX.Controls.Presentation, FMX.StdCtrls, FMX.ExtCtrls, FMX.ListBox,
FMX.Layouts, FMX.Objects, FMX.TreeView, System.ImageList, FMX.ImgList,
System.Actions, System.RegularExpressions,
FMX.ActnList, FMX.ScrollBox, FMX.Memo, FMX.Ani;
type
TForm1 = class(TForm)
StyleBook_MetropolisUIBlue: TStyleBook;
ImageList_Menus: TImageList;
TreeView_WorkSpace_Menus: TTreeView;
LayoutGloble: TLayout;
Rectangle_Caption: TRectangle;
Rectangle_Line: TRectangle;
Rectangle_WorkSpace: TRectangle;
NavBar_Pulledup: TRectangle;
Rectangle_WorkSpace_Button: TRectangle;
Rectangle_WorkSpace_Button_btnRenewMenus: TRectangle;
Label_WorkSpace_Button_btnRenewMenus: TLabel;
ActionList1: TActionList;
ControlAction_btnRenewMenus: TControlAction;
Memo_Test: TMemo;
ImageList_TreeView: TImageList;
Rectangle_WorkSpace_Button_btnExpandAllOrCollapseAllMenus: TRectangle;
Label_WorkSpace_Button_btnExpandAllOrCollapseAllMenus: TLabel;
ControlAction_btnExpandAllOrCollapseAllMenus: TControlAction;
Image_MenuClose: TImage;
BitmapListAnimation_MenuClose: TBitmapListAnimation;
Label_MenuClose: TLabel;
Label_Caption: TLabel;
procedure ControlAction_btnRenewMenusExecute(Sender: TObject);
function TreeView_WorkSpace_MenusCompare(Item1,
Item2: TTreeViewItem): Integer;
procedure TreeView_WorkSpace_MenusCalcContentBounds(Sender: TObject;
var ContentBounds: TRectF);
procedure TreeView_WorkSpace_MenusDragChange(SourceItem,
DestItem: TTreeViewItem; var Allow: Boolean);
procedure TreeView_WorkSpace_MenusClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ControlAction_btnExpandAllOrCollapseAllMenusExecute(
Sender: TObject);
private
{ Private declarations }
FIFCollapse:Boolean;
FIFInited:Boolean;
function CreateATreeViewItems(
const AIndex:Integer;
AText:string;
AParent:TFmxObject;
ImageIndex:Integer;
ASizeHeight,ASizeWidth:Single;
MarginsLeft:Single;
AOwnerObject:TFmxObject
):TTreeViewItem;
procedure InitATreeViewItems(
const ATreeView:TTreeView;var AIFInited:Boolean);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses myFuc_UnifiedPlatForm,myFuc_Client;
{$R *.fmx}
procedure TForm1.ControlAction_btnExpandAllOrCollapseAllMenusExecute(
Sender: TObject);
begin
//:伸缩: //ShowMessage('点了');
FIFCollapse:=not FIFCollapse;
if FIFCollapse=false then
TreeView_WorkSpace_Menus.CollapseAll
else TreeView_WorkSpace_Menus.ExpandAll;
end;
procedure TForm1.ControlAction_btnRenewMenusExecute(
Sender: TObject);
var LCircles:Integer;
LImageListCount,//LImageListItemID,
LImageListItemIndex:Integer;
LImageListItem:string;
LImageStringList:TStringList;
LMenuName:string; LMenuImageListIndex:Integer;
LImageStringListPair:string;
LMenuNameDelimCount:Integer; //:字符串被分隔符分割为LMenuNameDelimCount个部分
LSeparator: string; //:被分割的字符串中的分隔符字符串
LMenuNameStrArray:TArray;//:被分割后的字符串数组
LMenuNameDelim:string; //:被分割后的字符串
LMenuNameDelimUpdated:string; //:被分割后的字符串发生了变化
LCirclesDelim:Integer;
//:字符串分割循环变量:高值:即数组LMenuNameStrArray长度-1
LTreeViewItem:TTreeViewItem;
begin
LImageStringList:=TStringList.Create;
LImageListCount:=ImageList_Menus.Count;
LMenuImageListIndex:=0;
//0、准备数据源:
//1、将数据源加载到:TStringList数据源
for LCircles := 0 to LImageListCount-1 do
begin
LImageListItem:=
ImageList_Menus.Destination[LCircles].Layers[0].Name;
//LImageListItemID:=ImageList_Menus.Destination[LCircles].ID;
LImageListItemIndex:=
ImageList_Menus.Source[LCircles].Index;
//:TImageList中图的BitMap的索引
//ImageList_Menus.Destination[LCircles].Index;
LImageStringList.AddPair(LImageListItem,IntToStr(LImageListItemIndex));
//:TStringList成对加入数据,格式:财务管理-费用报销单=47
//Memo_Test.Lines.Add('DisplayName:'+LImageListItem.Trim+',ID:'+IntToStr(LImageListItemIndex)+',Index:'+IntToStr(LImageListItemIndex) );
end;
try
try
//2、TStringList数据源索引排序:
LImageStringList.Sorted:=true;
//:TStringList按照Pair的Name索引排序
finally
System.TMonitor.Enter(TreeView_WorkSpace_Menus,0);
TreeView_WorkSpace_Menus.Clear;
//TreeView_WorkSpace_Menus.Index:=0;
TreeView_WorkSpace_Menus.BeginUpdate;
Memo_Test.Lines.Clear;
//Memo_Test.Lines.Add(LImageStringList.Text);
LCircles := 0;
LMenuNameDelimUpdated:='';
for LCircles := 0 to LImageStringList.Count-1 do
begin
LImageStringListPair:=
LImageStringList.Strings[LCircles];
//:LImageStringListPair:财务管理-费用报销单=47
LMenuName:=LImageStringListPair.Substring(0,LImageStringListPair.LastDelimiter('=') );
LMenuImageListIndex:=StrToInt(LImageStringListPair.Substring(LImageStringListPair.LastDelimiter('=')+1,length(LImageStringListPair) ));
//Memo_Test.Lines.Add(LMenuName+',图片索引:'+IntToStr(LMenuImageListIndex) );
LSeparator:='-';
LMenuNameStrArray:=TRegEx.Split(LMenuName,LSeparator);
//:正则表达式分割字符串为字符串动态数组TArray
LMenuNameDelimCount:=Length(LMenuNameStrArray);
//:获取循环高值:字符串动态数组TArray的长度
//SetLength(LMenuNameStrArray,LMenuNameDelimCount);
LMenuNameDelim:='';
//Memo_Test.Lines.Add(IntToStr(Length(LMenuNameStrArray)));
//Memo_Test.Lines.Add('分割几部分:'+IntToStr(LMenuNameDelimCount)+','+LMenuNameDelimUpdated+','+LMenuNameStrArray[1]+',索引:'+IntToStr(LCircles+1)+',图片索引:'+IntToStr(LMenuImageListIndex) );
//Memo_Test.BeginUpdate;
if (LMenuNameDelimUpdated<>LMenuNameStrArray[0])
//and (LMenuNameStrArray[0].Trim<>'')
then
begin //:根节点:LMenuNameStrArray[0]
LMenuNameDelimUpdated:=LMenuNameStrArray[0]; //:被分割后的字符串发生了变化
Memo_Test.Lines.Add(LMenuNameDelimUpdated);
LTreeViewItem:=
CreateATreeViewItems(
(LCircles+1),
LMenuNameDelimUpdated,
(TreeView_WorkSpace_Menus as TFmxObject),
LMenuImageListIndex,
40,330,0,
self
);
end;
LCirclesDelim := 0;
for LCirclesDelim := 0 to LMenuNameDelimCount-1 do
begin
LMenuNameDelim:=LMenuNameStrArray[LCirclesDelim];
//:被分割后的字符串
if (LMenuNameDelimUpdated.Trim=LMenuNameDelim.Trim) then
begin
//
end else
if (LMenuNameDelimUpdated.Trim<>LMenuNameDelim.Trim)
then
begin
Memo_Test.Lines.Add(LMenuNameDelim+',索引:'+IntToStr(100*(LCircles+1)+(LCirclesDelim))+',图片索引:'+IntToStr(LMenuImageListIndex) );
CreateATreeViewItems(
100*(LCircles+1)+(LCirclesDelim),
LMenuName,
(LTreeViewItem as TFmxObject),
LMenuImageListIndex,
40,330,10,
self
);
end;
end;
//Memo_Test.EndUpdate;
end;
TreeView_WorkSpace_Menus.EndUpdate;
System.TMonitor.Exit(TreeView_WorkSpace_Menus);
end;
finally
FreeAndNil(LImageStringList);
end;
end;
function TForm1.CreateATreeViewItems(
const AIndex:Integer;
AText:string;
AParent:TFmxObject;
//:非常关键的参数:指明该节点:
//:其父节点是TTreeView还是它的上级递归TTreeViewItem
ImageIndex:Integer;
ASizeHeight,ASizeWidth:Single;
MarginsLeft:Single;
AOwnerObject:TFmxObject
):TTreeViewItem;
var LTreeViewItem:TTreeViewItem;
begin
InitATreeViewItems(TreeView_WorkSpace_Menus,FIFInited);
LTreeViewItem:=TTreeViewItem.Create( AOwnerObject );
LTreeViewItem.Index:=AIndex;
LTreeViewItem.Name:=
'TreeViewItem_WorkSpace_Menus_'
+IntToStr(AIndex);
//+FillBeforeString(IntToStr(AIndex),4,'0');
LTreeViewItem.Text:=AText;
LTreeViewItem.Parent:=AParent;
LTreeViewItem.ImageIndex:=ImageIndex;
LTreeViewItem.Align:=TAlignLayout.Left;
LTreeViewItem.IsChecked:=false;
LTreeViewItem.IsExpanded:=false;
LTreeViewItem.IsSelected:=false;
LTreeViewItem.StyleLookup:='treeviewitemstyle';
LTreeViewItem.StyledSettings:=
LTreeViewItem.StyledSettings-
[TStyledSetting.Family,
TStyledSetting.Size,
TStyledSetting.FontColor,
TStyledSetting.Other
];
LTreeViewItem.TextSettings.FontColor
:=TAlphaColor($FF1373A9);
LTreeViewItem.TextSettings.Font.Family:='微软雅黑';
LTreeViewItem.TextSettings.Font.Size:=16;
LTreeViewItem.Size.Height:=ASizeHeight;
LTreeViewItem.Size.Width:=ASizeWidth;
LTreeViewItem.Margins.Left:=MarginsLeft;
LTreeViewItem.Position.Y:=AIndex*40;
LTreeViewItem.IsExpanded:=false;
Result:=LTreeViewItem;
end;
procedure TForm1.InitATreeViewItems(
const ATreeView:TTreeView;var AIFInited:Boolean);
begin
if AIFInited=false then //:尚未初始化
begin
ATreeView.Align:=TAlignLayout.Client;
ATreeView.AutoHide:=false;//:默认true会自动隐藏滚动条
ATreeView.DisableFocusEffect:=false;
ATreeView.Images:=ImageList_Menus;
ATreeView.ItemHeight:=40;//:产生的TreeViewItem的行高
ATreeView.Margins.Left:=5; ATreeView.Margins.Right:=5;
ATreeView.MultiSelect:=true;//:多行选择
ATreeView.Opacity:=1;//0.85;
ATreeView.ShowCheckboxes:=true;
ATreeView.ShowScrollBars:=true;
ATreeView.ShowSizeGrip:=true;//:显示对Size的控制
ATreeView.Sorted:=false;
ATreeView.StyleLookup:='treeviewstyle';
AIFInited:=true; //:初始化完毕
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FIFInited:=false;
FIFCollapse:=false;
end;
procedure TForm1.TreeView_WorkSpace_MenusClick(Sender: TObject);
begin
//
end;
function TForm1.TreeView_WorkSpace_MenusCompare(
Item1, Item2: TTreeViewItem): Integer;
begin
//
end;
procedure TForm1.TreeView_WorkSpace_MenusDragChange(
SourceItem,
DestItem: TTreeViewItem; var Allow: Boolean);
begin
//
end;
procedure TForm1.TreeView_WorkSpace_MenusCalcContentBounds(
Sender: TObject;
var ContentBounds: TRectF);
begin
//
end;
end. 四、子窗体TForm2：FMX TreeView调用Sqlite数据
unit Unit2;
interface
uses
System.SysUtils, System.Types, System.UITypes,
System.Classes, System.Variants,System.IOUtils,
System.ImageList,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Layouts,
FMX.TreeView, FMX.StdCtrls, FMX.Controls.Presentation, FMX.ScrollBox,
FMX.Memo, FMX.Objects,
FMX.ImgList, System.Actions,
FMX.ActnList, FMX.Ani,
FMX.ListBox, FMX.Edit,
Data.DB,
FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error,
FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool,
FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.SQLite, FireDAC.Phys.SQLiteDef,
FireDAC.Stan.ExprFuncs, FireDAC.FMXUI.Wait, FireDAC.Stan.Param, FireDAC.DatS,
FireDAC.DApt.Intf, FireDAC.DApt,
FireDAC.Comp.DataSet,
FireDAC.Comp.Client, FireDAC.Comp.UI, FireDAC.Moni.Base,
FireDAC.Moni.FlatFile
;
type
TForm2 = class(TForm)
ActionList1: TActionList;
ControlAction_btnRenewMenus: TControlAction;
ControlAction_btnExpandAllOrCollapseAllMenus: TControlAction;
ImageList_Menus: TImageList;
ImageList_TreeView: TImageList;
LayoutGloble: TLayout;
Rectangle_Caption: TRectangle;
Rectangle_Line: TRectangle;
Rectangle_WorkSpace: TRectangle;
Memo_Test: TMemo;
Rectangle_WorkSpace_Button: TRectangle;
Rectangle_WorkSpace_Button_btnRenewMenus: TRectangle;
Label_WorkSpace_Button_btnRenewMenus: TLabel;
Rectangle_WorkSpace_Button_btnExpandAllOrCollapseAllMenus: TRectangle;
Label_WorkSpace_Button_btnExpandAllOrCollapseAllMenus: TLabel;
TreeView_WorkSpace_Menus: TTreeView;
NavBar_Pulledup: TRectangle;
StyleBook_MetropolisUIBlue: TStyleBook;
FDQuery_Main: TFDQuery;
Image_MenuClose: TImage;
BitmapListAnimation_MenuClose: TBitmapListAnimation;
Label_MenuClose: TLabel;
Label_Caption: TLabel;
FDMemTable_Main: TFDMemTable;
FDGUIxWaitCursor1: TFDGUIxWaitCursor;
FDPhysSQLiteDriverLink1: TFDPhysSQLiteDriverLink;
FDMoniFlatFileClientLink1: TFDMoniFlatFileClientLink;
FDConnSqlite: TFDConnection;
Rectangle_WorkSpace_Button_btnEnumChecked: TRectangle;
Label_WorkSpace_Button_btnEnumChecked: TLabel;
ControlAction_btnEnumChecked: TControlAction;
Rectangle_WorkSpace_Button_btnSelectAllOrNot: TRectangle;
Label_WorkSpace_Button_btnSelectAllOrNot: TLabel;
ControlAction_btnSelectAllOrNot: TControlAction;
Rectangle_WorkSpace_Button_btnAddNewTree: TRectangle;
Label_WorkSpace_Button_btnAddNewTree: TLabel;
ControlAction_btnAddNewTree: TControlAction;
Rectangle_WorkSpace_Button_btnAddNewTreeItem: TRectangle;
Label_WorkSpace_Button_btnAddNewTreeItem: TLabel;
ControlAction_btnAddNewTreeItem: TControlAction;
Rectangle_WorkSpace_Button_btnDeleteTreeItem: TRectangle;
Label_WorkSpace_Button_btnDeleteTreeItem: TLabel;
ControlAction_btnDeleteTreeItem: TControlAction;
ListBox_WorkSpace_ListBoxItem_AddNewTreeORTreeItem: TListBox;
Rectangle_WorkSpace_ListBox_Rectangle_AddNewTreeORTreeItem: TRectangle;
Rectangle_WorkSpace_ListBox_Button: TRectangle;
Rectangle_WorkSpace_ListBox_Button_btnInsert: TRectangle;
Rectangle_WorkSpace_ListBox_Button_btnCancel: TRectangle;
Label_WorkSpace_ListBox_Button_btnInsert: TLabel;
Rectangle_WorkSpace_ListBox_AddNewTreeORTreeItem: TRectangle;
Label_WorkSpace_ListBox_Button_btnCancel: TLabel;
ControlAction_ListBox_Button_btnInsert: TControlAction;
ControlAction_ListBox_Button_btnCancel: TControlAction;
ListBoxItem_TreeViewItem_Name: TListBoxItem;
Label_TreeViewItem_Name: TLabel;
Edit_TreeViewItem_Name: TEdit;
ListBoxItem_TreeViewItem_upper_sort_id: TListBoxItem;
Edit_TreeViewItem_upper_sort_id: TEdit;
Label_TreeViewItem_upper_sort_id: TLabel;
Rectangle_WorkSpace_ListBox_Button_btnEdit: TRectangle;
Label_WorkSpace_ListBox_Button_btnEdit: TLabel;
ControlAction_ListBox_Button_btnEdit: TControlAction;
Rect1Line: TRectangle;
Rect2Line: TRectangle;
///ControlAction动作:TTreeView取数:0、准备数据源;1、数据源本身已索引排序;2、TTreeView:TreeView_WorkSpace_Menus开始加载数据源的数据:
procedure ControlAction_btnRenewMenusExecute(Sender: TObject);
///ControlAction动作:TTreeView展开或收拢所有节点:
procedure ControlAction_btnExpandAllOrCollapseAllMenusExecute(
Sender: TObject);
///ControlAction动作:遍历TreeView选中的节点:
procedure ControlAction_btnEnumCheckedExecute(Sender: TObject);
///ControlAction动作:遍历TreeView全选或全不选:
procedure ControlAction_btnSelectAllOrNotExecute(Sender: TObject);
///某节点TTreeViewItem被勾中或取消勾中处理其节点及其上下级节点:
procedure TreeView_WorkSpace_MenusChangeCheck(Sender: TObject);
///本地Sqlite数据库连接对象在连接前的处理事件:
procedure FDConnSqliteBeforeConnect(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ControlAction_btnDeleteTreeItemExecute(Sender: TObject);
///加树数据处理:
procedure ControlAction_ListBox_Button_btnInsertExecute(Sender: TObject);
///编枝数据处理:
procedure ControlAction_ListBox_Button_btnEditExecute(Sender: TObject);
///放弃处理编枝或加树:
procedure ControlAction_ListBox_Button_btnCancelExecute(Sender: TObject);
procedure ControlAction_btnAddNewTreeItemExecute(Sender: TObject);
procedure ControlAction_btnAddNewTreeExecute(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
///TTreeView及其从外部数据库是否完成初始化:
FIFInited:Boolean;
///TTreeView从外部数据库加载的sql:
FSql:string;
///TTreeView是否展开所有节点,调用者初始化传入默认:=false:
FIFCollapse:Boolean;
///全选或取消全选TTreeView的所有TTreeViewItem节点:
FTreeViewSelectAllOrNot:Boolean;
///当前TTreeViewItem节点:
FTreeViewItemCurrt:TTreeViewItem;
///当前TTreeViewItem节点的父节点:
FTreeViewItemParent:TFmxObject;
///动态新增的TreeViewItem节点的Tag整数唯一标识赋值:
FTreeViewItemTag:Integer;
///父节点的子节点增加1个打勾CreateATreeViewItems初始化:
FTreeViewItemCheckedCount:TArray;
///父节点完成打勾(父已枚举)OnCreate调用者初始化传入:
FErgodicParent:string;
///加树还是编枝:
FAddWhoParent:string;
///当前窗体操作内存表FDMemTable_Main更新的总记录数:
FDMemTable_Main_UpdatedCount:Integer;
///TTreeView及其TreeViewItem属性的初始化:
procedure InitATreeViewItems(const ATreeView: TTreeView;
var AIFInited: Boolean); //:AIFInited调用者初始化传入默认:=false;
///TTreeView的外部数据库FDQuery数据源初始化:
procedure InitAFDQuery_Main(Sender: TObject; FDQuery: TFDQuery);
///TreeView动态加载外部数据源的信息的过程方法:
procedure TreeViewAddData(Sender: TObject; ATreeView: TTreeView);
///TreeView动态加载外部数据源的字段值信息并生成动态新增的TreeViewItem节点:
///新增TTreeViewItem的索引号:
///新增TTreeViewItem的名称:
///新增TTreeViewItem的显示名:
///新增的TTreeViewItem对应的外部数据源的字段名:
///新增TTreeViewItem的父节点父组件:关键:父组件可以是TreeView,也可以是某个TreeViewItem节点:
///新增TTreeViewItem的TImageList中的图片索引号:
///新增TTreeViewItem的高Height:
///新增TTreeViewItem的宽Width:
///新增TTreeViewItem的左边界像素整数:
///新增TTreeViewItem的所有者:
/// 如果过程方法 InitATreeViewItems 在此函数中执行后 初始化 成功 则返回:TTreeViewItem
/// 这个函数对FMX及VCL均通用
function CreateATreeViewItems(
const AIndex: Integer;
AName:string;
AText: string;
ATreeFiledName:string;
AParent: TFmxObject; ImageIndex: Integer; ASizeHeight, ASizeWidth,
MarginsLeft: Single; AOwnerObject: TFmxObject
):TTreeViewItem;
///TTreeViewItem某节点被点击及展开切换的事件:
procedure LAddObjectOnClick(Sender: TObject);
///枚举TreeView选中的节点并决定是否变更选中状态,返回处理节点的列表TStringList:
function EnumChecked(
const AIFAncester:Boolean=true;
AIFUpdateCheckedStatus:Boolean=true):TStringList;
///TTreeView更新节点UI数据处理:
function TreeViewItemUpdateData(
AOperation:string;
ABtnText:string;
AFmxObject:TFmxObject):TTreeViewItem;
///内存表FDMemTable_Main根据TTreeView节点UI数据更新而更新记录:
function FDMemTable_Main_Update: Integer;
public
{ Public declarations }
///FTFDMemTable_Main:传入后赋值给:本窗体组件FDMemTable_Main:
FTFDMemTable_Main:TFDMemTable;
///远程数据库某TreeView表的当前最大自增长数seeds_id,被调用者传入:
FAddseeds_idCount:Integer;
///远程数据库新增的某TreeView表的SortId,被调用者传入:
FNewSortId_RemoteDataBaseTable:string;
///调用本地数据库的ASql的表对象所对应的基础资料数据:
procedure LoadLoacalDataTreetype(ASql:string);
end;
var FSqlite3Path,FSqlite3BackupPath :string;
FSqlite3BackupFileName :string='CarveoutO2OBackup.s3db';
FSqlite3FileName :string='CarveoutO2OTest.s3db';
var
Form2: TForm2;
function FTreeViewItemCurrtFieldSortid(
ATreeViewItem:TTreeViewItem):string;
implementation
uses
myFuc_UnifiedPlatForm,myFuc_Client;
var
FTreeView:TMyTreeView;
{$R *.fmx}
type
TProcedureMyProc = procedure; //:过程类型
TMethodMyMethod = procedure of object; //:方法类型
var
FmyProc:TProcedureMyProc; //:过程指针变量
FmyMethod:TMethodMyMethod; //:方法指针变量
var
FmyFunc_Pointer:Pointer; //:普通指针变量
function myFunc(var APointer:Pointer):Pointer; //:函数:可供方法指针或过程指针调用,当然也可供方法或过程调用
//var LAPointer:^Integer;
begin //LAPointer:=Pointer(1);
if APointer=nil then Result:=nil
else Result:=APointer;
end;
procedure myProc; //:过程
var LRef:Integer;
begin
LRef:=1;
@FmyProc:=@myProc; //:@myProc等价于:Pointer(myProc);
FmyProc:=myProc;
FmyFunc_Pointer:=myFunc(@FmyProc); //FmyProc:=nil;
end;
function myMethod :string; //:函数:可供方法指针或过程指针调用,当然也可供方法或过程调用
var LRef:Integer;
LStr:string;
begin
LRef:=1; LStr:='AaBb方法指针。，．,';
Result:=LStr;
end;
procedure TForm2.FormShow(Sender: TObject);
//var LmyProcPointerValue:Integer;
begin
{
Memo_Test.Lines.Add('一、方法指针:');
Memo_Test.Lines.Add(' 比如1、:方法:procedure myProc;');
if Assigned(@myProc) then
Memo_Test.Lines.Add(' 返回Assigned(@myProc)=true,方法指针能识别Assigned(@myProc),内存中的内容: '+PChar(@myProc) );
if @myProc<>nil then
Memo_Test.Lines.Add(' 返回(@myProc<>nil)=true,方法指针能识别@myProc<>nil,内存中的内容: '+PChar(@myProc) );
@FmyMethod:=Pointer(myMethod);
if ( (@myMethod<>nil) and (@FmyMethod<>nil) )
and ( Assigned(@myMethod) and Assigned(@FmyMethod) ) then
Memo_Test.Lines.Add(' 比如2、:方法类型:type TMethodMyMethod = procedure of object;'+sLineBreak
+' 方法指针变量:var FmyMethod:TMethodMyMethod;'+sLineBreak
+' 赋值方法指针:@FmyMethod:=Pointer(myMethod);'+sLineBreak
+' 方法指针变量:var FmyMethod:TMethodMyMethod;'+sLineBreak
+' 返回方法指针所指的字符串的数值:'+PChar(@FmyMethod)
) else Memo_Test.Lines.Add(' 不返回任何结果');
Memo_Test.Lines.Add('二、过程指针,比如:');
Memo_Test.Lines.Add(
' TProcedureMyProc = procedure;'+sLineBreak
+' var FmyProc:TProcedureMyProc;'+sLineBreak
+' Procedure pointer types are always incompatible with method pointer types.'+sLineBreak
+' The value nil can be assigned to any procedural type:'+sLineBreak
+' 过程指针类型始终与方法指针类型不兼容。值nil可以分配给任何过程类型。比如: '+sLineBreak
+' if Assigned(FmyProc) then //: 过程不能识别Assigned(FmyProc)'+sLineBreak
+' if Assigned(@FmyProc) then //: 过程指针也不能识别Assigned(@FmyProc)'+sLineBreak
+' if FmyProc=nil then //: 过程不能识别FmyProc=nil且编译器会报错'+sLineBreak
+' if @FmyProc=nil then //: 但过程指针能识别@FmyProc=nil'+sLineBreak
);
if @FmyProc=nil then //: 但过程指针能识别@FmyProc=nil
begin
Memo_Test.Lines.Add(' @FmyProc=nil');
myProc;
end else Memo_Test.Lines.Add(' 过程FmyProc及过程指针@FmyProc均不能识别Assigned');
if FmyFunc_Pointer<>nil then //: 过程指针变量也能识别@FmyProc=nil
Memo_Test.Lines.Add(' FmyFunc_Pointer<>nil,过程指针变量的内存值: '+PChar(@FmyFunc_Pointer) );
if (@myProc<>nil) and (@FmyFunc_Pointer<>nil) then
begin
Memo_Test.Lines.Add(' @myProc<>nil,过程指针内存值: '+PChar(@myProc) );
Memo_Test.Lines.Add(' @myProc<>nil,过程指针变量内存值: '+PChar(@FmyFunc_Pointer) );
end;
Memo_Test.Lines.Add('三、结论:');
Memo_Test.Lines.Add(
' 1、无论方法指针还是过程指针,均能有效测试@P=nil或@P<>nil'+sLineBreak
+' 2、方法指针既能有效测试Assigned(@P)或not Assigned(@P),也能有效测试@P=nil或@P<>nil'+sLineBreak
+' 3、过程指针不能有效测试Assigned(@P)或not Assigned(@P),但能有效测试@P=nil或@P<>nil'
);
//}
end;
procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Form2:=nil; //:close前先强制nil掉窗体对象,这样写会更安全些
close;
end;
procedure TForm2.FormCreate(Sender: TObject);
var LTreeView:TMyTreeView;
begin
LTreeView:=TMyTreeView.Create(self);//TreeView_WorkSpace_Menus
TreeView_WorkSpace_Menus.OnChangeCheck
:=LTreeView.OnChangeCheck;
try
if FIFInited=false then //:尚未初始化
begin
//ShowAMessage('准备初始化',procedure begin end);
InitATreeViewItems(TreeView_WorkSpace_Menus,FIFInited);
FSql:=' select seeds_id,com_id,sort_name,sort_id,self_id,upper_sort_id,mainten_clerk_id,easy_id '
//+' from Ctl03200 '
+' from main.Ctl03200 where com_id=''0012'' ' //0012 //001
+' order by seeds_id '
; //:顺序产生以避免再去做TreeView对应字段的上下级解析
//:物品类别表:注意大小写敏感
InitAFDQuery_Main(Sender,FDQuery_Main);
FTreeViewSelectAllOrNot:=false;//:全不选
FErgodicParent:='';
FAddseeds_idCount:=0;
FDMemTable_Main_UpdatedCount:=0;
end;
finally
ControlAction_btnRenewMenus.Execute;
end;
end;
procedure TForm2.InitATreeViewItems(
const ATreeView: TTreeView;
var AIFInited: Boolean);
begin
if AIFInited=false then //:尚未初始化
begin
FIFInited:=false;
ATreeView.Align:=TAlignLayout.Client;
ATreeView.AutoHide:=false;//:默认true会自动隐藏滚动条
ATreeView.DisableFocusEffect:=false;
ATreeView.Images:=ImageList_Menus;
ATreeView.ItemHeight:=40;//:产生的TreeViewItem的行高
ATreeView.Margins.Left:=5; ATreeView.Margins.Right:=5;
ATreeView.MultiSelect:=true;//:多行选择
ATreeView.Opacity:=1;//0.85;
ATreeView.ShowCheckboxes:=true;
ATreeView.ShowScrollBars:=true;
ATreeView.ShowSizeGrip:=true;//:显示对Size的控制
ATreeView.Sorted:=false;
ATreeView.StyleLookup:='treeviewstyle';
FIFCollapse:=false; //:ATreeView默认不展开是收拢的:调用onFramePaint
//AIFInited:=true; //:初始化完毕
//FIFInited:=true; //:初始化完毕
end;
end;
procedure TForm2.InitAFDQuery_Main(
Sender: TObject;FDQuery:TFDQuery);
begin
{$IFDEF ANDROID}
AndoidRequestPermissions(['管理文档','读取文件','写入文件']);
{$ENDIF}
try
try
if TFile.Exists(productTextFile('',FSqlite3FileName))=false then
exit; //else ShowAMessage('存在数据库文件',procedure begin end)
FDConnSqlite.ConnectionDefName:='CarveoutTest';
//FDConnSqlite.DriverName:='SQLite';
//:定义后会在运行时报错:只需定义连接定义名ConnectionDefName
//if (FDConnSqlite.Connected=false) then
//FDConnSqlite.Connected:=true;
finally
FDQuery.FetchOptions.Mode:=fmOnDemand;//fmAll;
FDQuery.FetchOptions.RecordCountMode:=cmFetched;
FDQuery.FetchOptions.RowsetSize:=9999999;
FDQuery.FetchOptions.RecsMax:=-1;
FDQuery.FetchOptions.RecsSkip:=-1;
FDQuery.CachedUpdates:=true;
FDQuery_Main.Connection:=FDConnSqlite;
FDMemTable_Main.FetchOptions.Mode:=fmAll;
FDMemTable_Main.FetchOptions.RecordCountMode:=cmFetched;
FDMemTable_Main.FetchOptions.RowsetSize:=9999999;
FDMemTable_Main.FetchOptions.RecsMax:=-1;
FDMemTable_Main.FetchOptions.RecsSkip:=-1;
FDMemTable_Main.CachedUpdates:=true;
FIFInited:=true; //:初始化完毕
end;
except
ShowAMessage('打开数据库时发生错误!请联系02866000800客服!',procedure begin end);
end;
end;
procedure TForm2.FDConnSqliteBeforeConnect(Sender: TObject);
begin
//System.SysUtils, uses System.IOUtils ,System.StartUpCopy;
//System.SysUtils:
//PathDelim = {$IFDEF MSWINDOWS} '\'; {$ELSE} '/'; {$ENDIF}
//DriveDelim = {$IFDEF MSWINDOWS} ':'; {$ELSE} ''; {$ENDIF}
//PathSep = {$IFDEF MSWINDOWS} ';'; {$ELSE} ':'; {$ENDIF}
{$IFDEF MSWINDOWS}
FSqlite3BackupPath :=ExtractFilePath(ParamStr(0))+ 'dbBackup'+System.SysUtils.PathDelim+ FSqlite3BackupFileName;
FSqlite3Path :=ExtractFilePath(ParamStr(0))+ FSqlite3FileName; //:exe文件路径:不完全即:TPath.GetLibraryPath
if System.IOUtils.TFile.Exists(FSqlite3BackupPath)=false then
System.SysUtils.ForceDirectories(
System.IOUtils.TPath.Combine(
ExtractFilePath(ParamStr(0)) ,
'dbBackup') );
{$ENDIF MSWINDOWS}
{$IFDEF MACOS32}
FSqlite3BackupPath := FSqlite3BackupFileName;
FSqlite3Path := FSqlite3FileName;
{$ENDIF MACOS32}
{$IFDEF ANDROID}
FSqlite3BackupPath
:=System.IOUtils.TPath.Combine(
System.IOUtils.TPath.GetPublicPath , //:/storage/emulated/0/Android/data/com.embarcadero.MainPro/files下可见的路径
'dbBackup'+System.SysUtils.PathDelim+ FSqlite3BackupFileName);
FSqlite3Path
:=System.IOUtils.TPath.Combine(
System.IOUtils.TPath.GetDocumentsPath ,
FSqlite3FileName); //:GetDocumentsPath不可见
if System.IOUtils.TFile.Exists(FSqlite3BackupPath)=false then
System.SysUtils.ForceDirectories(
System.IOUtils.TPath.Combine(
System.IOUtils.TPath.GetPublicPath , //:GetPublicPath可见
'dbBackup') );
{$ENDIF ANDROID}
{$IFDEF IOS} //:IOS://不是GetHomePath，也不能加PathDelim ：//:=TPath.Combine(TPath.GetHomePath + PathDelim , 'CarveoutO2O.s3db'); //uses System.IOUtils ,System.StartUpCopy;
FSqlite3BackupPath
:=System.IOUtils.TPath.Combine(
System.IOUtils.TPath.GetDocumentsPath , //:/var/mobile/Containers/Data/Application/02029637-C492-4ECA-8D14-96731ADB7CC2/Documents下可见的路径
'dbBackup'+System.SysUtils.PathDelim+ FSqlite3BackupFileName);
FSqlite3Path
:=System.IOUtils.TPath.Combine(
System.IOUtils.TPath.GetDocumentsPath , //:GetDocumentsPath可见前提:Project-Options->Versin info->下增设了key：UIFileSharingEnabled = true
FSqlite3FileName);
if System.IOUtils.TFile.Exists(FSqlite3BackupPath)=false then
System.SysUtils.ForceDirectories(
System.IOUtils.TPath.Combine(
System.IOUtils.TPath.GetDocumentsPath ,
'dbBackup') );
{$ENDIF IOS}
try
if System.IOUtils.TFile.Exists(FSqlite3BackupPath)=false then
begin
System.IOUtils.TFile.Copy(
FSqlite3Path,
FSqlite3BackupPath);
end;
finally
if System.IOUtils.TFile.Exists(FSqlite3BackupPath)=true then
FDConnSqlite.Params.Values['Database']
:=FSqlite3Path;
end;
//测试:Label_Caption.Text:=FSqlite3Path;
end;
procedure TForm2.ControlAction_btnExpandAllOrCollapseAllMenusExecute(
Sender: TObject);
begin
if not Assigned(FTreeView) then
FTreeView:=TMyTreeView.Create(self);
FTreeView.DoExpandAllorCollapseAll(TreeView_WorkSpace_Menus);
{
//:伸缩: //ShowMessage('点了');
FIFCollapse:=not FIFCollapse;
if FIFCollapse=false then
TreeView_WorkSpace_Menus.CollapseAll
else TreeView_WorkSpace_Menus.ExpandAll;
}
end;
procedure TForm2.ControlAction_btnRenewMenusExecute(
Sender: TObject);
begin
//:取数:
//0、准备数据源:
//if FDMemTable_Main.IsEmpty then //:再次重新加载数据:无条件的！
LoadLoacalDataTreetype(FSql);
//:1、数据源本身已索引排序:
//2、TTreeView:TreeView_WorkSpace_Menus开始加载数据源的数据:
TreeViewAddData(Sender,TreeView_WorkSpace_Menus);
end;
procedure TForm2.LoadLoacalDataTreetype(
ASql:string );
var FCircle,FRecurse:Integer;
//:循环变量FCircle、递归循环变量FRecurse
begin
if FIFInited=True then //:若已完成初始化
begin
FDQuery_Main.DisableControls;
FDQuery_Main.SQL.Text:=ASql;
FDQuery_Main.EnableControls;
try
try
if not (FDQuery_Main.Connection.Connected=true) then
FDQuery_Main.Connection.Connected:=true;
FDQuery_Main.Active:=false;
FDQuery_Main.Active:=true;
while not(FDQuery_Main.Active=True) do sleep(0);
FDQuery_Main.First;
FDMemTable_Main.Active:=false;
FDMemTable_Main.CloneCursor(FDQuery_Main);
//FDMemTable_Main.CreateDataSet;
FDMemTable_Main.FieldDefs:=FDQuery_Main.FieldDefs;
//:内存表用上两种,不适合以下方式获取数据集:
//FDMemTable_Main.AppendData();
//FDMemTable_Main.CopyRecord();
//FDMemTable_Main.CopyDataSet(FDQuery_Main);
FDMemTable_Main.Active:=true;
while not(FDMemTable_Main.Active=true) do sleep(0);
FDMemTable_Main.First;
finally
//FDQuery_Main.Active:=false;
//if FDQuery_Main.Connection.Connected=true then
//FDQuery_Main.Connection.Close;
//下面测试看看获取的数据:
{
try
Memo_Test.BringToFront; Memo_Test.Visible:=true;
Memo_Test.Lines.Clear;
System.TMonitor.Enter(Memo_Test,0);
Memo_Test.BeginUpdate;
//:循环变量FCircle、递归循环变量FRecurse
while not (FDMemTable_Main.Eof) do
begin
//for FCircle := 0 to FDMemTable_Main.RecordCount-1 do
Memo_Test.Lines.Add(
FDMemTable_Main.FieldByName('sort_id').AsString.Trim
+','+FDMemTable_Main.FieldByName('upper_sort_id').AsString.Trim
+','+FDMemTable_Main.FieldByName('sort_name').AsString.Trim
);
FDMemTable_Main.Next;
end;
Memo_Test.EndUpdate;
System.TMonitor.Exit(Memo_Test);
finally
end;//}
end;
except
ShowAMessage('打开数据表错误！',procedure begin end);
end;
end;
end;
procedure TForm2.TreeViewAddData(
Sender: TObject;ATreeView:TTreeView);
var LCircles,LRecurse:Integer;
//:循环变量FCircle、递归循环变量FRecurse
LTTreeViewItem:TTreeViewItem;
LMenuNameDelimUpdated:string; //:被分割后的字符串发生了变化
LMenuImageListIndex:Integer;
begin
//:TTreeView产生子节点: CreateATreeViewItems
if not(FDMemTable_Main.Active=true) then exit;
if (FDMemTable_Main.RecordCount=0) then exit;
FDMemTable_Main.First;
LCircles:=0;
LMenuImageListIndex:=ImageList_Menus.Source[0].Index;
TreeView_WorkSpace_Menus.Clear;
System.TMonitor.Enter(TreeView_WorkSpace_Menus,0);
TreeView_WorkSpace_Menus.BeginUpdate;
while not FDMemTable_Main.Eof do
begin
if FDMemTable_Main.FieldByName('upper_sort_id').AsString.Trim
='' then
begin //:没有上级:TreeviewItem的父节点=Treeview
LTTreeViewItem:=
CreateATreeViewItems(
(LCircles), //:索引号
('TreeViewItem_WorkSpace_Menus_'
+FDMemTable_Main.FieldByName('sort_id').AsString.Trim),
//:产生TreeviewItem的name
FDMemTable_Main.FieldByName('sort_name').AsString.Trim,
//:产生TreeviewItem的Text
FDMemTable_Main.FieldByName('sort_id').AsString.Trim,
(TreeView_WorkSpace_Menus as TFmxObject),
//:父组件的TFmxObject
LMenuImageListIndex, //:图片索引号
40,330,5, //:位置尺寸
self //:所有者:应为窗体或TFrame
);
end;
if FDMemTable_Main.FieldByName('upper_sort_id').AsString.Trim
<>'' then
begin //:没有上级:TreeviewItem的父节点=TreeviewItem
CreateATreeViewItems(
(LCircles), //:索引号
('TreeViewItem_WorkSpace_Menus_'
+FDMemTable_Main.FieldByName('sort_id').AsString.Trim),
//:产生TreeviewItem的name
FDMemTable_Main.FieldByName('sort_name').AsString.Trim,
//:产生TreeviewItem的Text
FDMemTable_Main.FieldByName('sort_id').AsString.Trim,
( (FindComponent(
'TreeViewItem_WorkSpace_Menus_'
+FDMemTable_Main.FieldByName('upper_sort_id').AsString.Trim)
) as TFmxObject),
//:父组件的TFmxObject
LMenuImageListIndex, //:图片索引号
40,330,15, //:位置尺寸
self //:所有者
);
end;
LCircles:=LCircles+1;
FDMemTable_Main.Next;
end;
TreeView_WorkSpace_Menus.EndUpdate;
System.TMonitor.Exit(TreeView_WorkSpace_Menus);
end;
function TForm2.CreateATreeViewItems(
const AIndex:Integer;
AName:string;
AText:string;
ATreeFiledName:string;
AParent:TFmxObject;
//:非常关键的参数:指明该节点:
//:其父节点是TTreeView还是它的上级递归TTreeViewItem
ImageIndex:Integer;
ASizeHeight,ASizeWidth:Single;
MarginsLeft:Single;
AOwnerObject:TFmxObject
):TTreeViewItem;
var LTreeViewItem:TTreeViewItem;
begin
InitATreeViewItems(TreeView_WorkSpace_Menus,FIFInited);
LTreeViewItem:=TTreeViewItem.Create( AOwnerObject ); //:所有者:应为窗体或TFrame
LTreeViewItem.Index:=AIndex;//:索引会被TTreeView的节点自动索引所覆盖：应使用自定义索引LTreeViewItem.Tag
LTreeViewItem.Name:=AName; //:节点命名:不能重复
LTreeViewItem.Text:=AText; //:节点的显示文本
LTreeViewItem.Parent:=AParent;
//:父组件:关键:父组件可以是TreeView,也可以是某个TreeViewItem节点
//LTreeViewItem.TagString:=ATreeFiledName.Trim+'='+AParent.Name;
LTreeViewItem.TagString:=ATreeFiledName.Trim+'='+AText;
//:节点内部的个性化标签文字
LTreeViewItem.ImageIndex:=ImageIndex; //:节点的个性化图片索引
LTreeViewItem.Tag:=AIndex; //:自定义索引LTreeViewItem.Tag
SetLength(FTreeViewItemCheckedCount,LTreeViewItem.Tag+1);
FTreeViewItemCheckedCount[LTreeViewItem.Tag]:=0;
//:初始化TreeViewItem勾中数组TreeView.OnChangeCheck
LTreeViewItem.Align:=TAlignLayout.Left;
LTreeViewItem.IsChecked:=false;
LTreeViewItem.IsExpanded:=false;
LTreeViewItem.IsSelected:=false;
LTreeViewItem.StyleLookup:='treeviewitemstyle';
LTreeViewItem.StyledSettings:=
LTreeViewItem.StyledSettings-
[TStyledSetting.Family,
TStyledSetting.Size,
TStyledSetting.FontColor,
TStyledSetting.Other
];
LTreeViewItem.TextSettings.FontColor
:=TAlphaColor($FF1373A9);
LTreeViewItem.TextSettings.Font.Family:='微软雅黑';
LTreeViewItem.TextSettings.Font.Size:=16;
LTreeViewItem.Size.Height:=ASizeHeight;
LTreeViewItem.Size.Width:=ASizeWidth;
LTreeViewItem.Margins.Left:=MarginsLeft;
LTreeViewItem.Position.Y:=AIndex*40;
LTreeViewItem.IsExpanded:=false;
LTreeViewItem.OnClick:=LAddObjectOnClick;
Result:=LTreeViewItem;
end;
procedure TForm2.LAddObjectOnClick(Sender: TObject);
//某节点TTreeViewItem被点击切换:
begin
//FTreeViewItemCurrt FTreeViewItemParent TFmxObject
FTreeViewItemCurrt:=(Sender as TTreeViewItem);
FTreeViewItemCurrt.SetFocus;
FTreeViewItemCurrt.IsSelected:=true;
if (Sender as TTreeViewItem).Level>1 then
begin//:节点级数Level>1下级N:TTreeViewItem
FTreeViewItemCurrt:=Sender as TTreeViewItem;
FTreeViewItemParent:=
((Sender as TTreeViewItem).ParentItem) as TTreeViewItem;
//ShowAMessage('点了该节点:'+FTreeViewItemCurrt.Name+',父节点:'+FTreeViewItemParent.Name,procedure begin end);
end
else
begin//Level=1顶级节点的父:TTreeView:
FTreeViewItemCurrt:=Sender as TTreeViewItem;
FTreeViewItemParent:=TreeView_WorkSpace_Menus;
//ShowAMessage('点了该节点:'+FTreeViewItemCurrt.Name+',父节点:'+FTreeViewItemParent.Name,procedure begin end);
end;
if FTreeViewItemCurrt.IsExpanded=false then
FTreeViewItemCurrt.IsExpanded:=true
else FTreeViewItemCurrt.IsExpanded:=false;
Memo_Test.Lines.Add('点了该节点:'+FTreeViewItemCurrt.Name+',父节点:'+FTreeViewItemParent.Name);
end;
procedure TForm2.TreeView_WorkSpace_MenusChangeCheck(Sender: TObject);
{
//某节点TTreeViewItem被勾中切换:
var LLevel:Integer;
//var LErgodicSon,FErgodicParent:string;//:遍历谁
procedure LEnumControls(LFmxObject:TFmxObject;EnumControlClassName:string);
begin
//1、处理ChangeCheck的上级:
if (LFmxObject as TTreeViewItem).IsChecked=true then
begin
if (LLevel>1) then//:基线条件
begin
try
if FTreeViewItemCheckedCount[FTreeViewItemTag]
< (LFmxObject as TTreeViewItem).ParentItem.Count then
begin
if FErgodicParent<>'父已枚举' then
INC(FTreeViewItemCheckedCount[FTreeViewItemTag]);
//:上级+1
FErgodicParent:='';
Memo_Test.Lines.Add('枚举对象:'+(Sender as TTreeViewItem).Text+':上级:'+(Sender as TTreeViewItem).ParentItem.Text+':被勾中数:'+IntToStr(FTreeViewItemCheckedCount[FTreeViewItemTag]) );
end;
finally
if FTreeViewItemCheckedCount[FTreeViewItemTag]
= (Sender as TTreeViewItem).ParentItem.Count then
begin
FErgodicParent:='父已枚举';
if (Sender as TTreeViewItem).ParentItem.IsChecked=false then
(Sender as TTreeViewItem).ParentItem.IsChecked:=true;
//:开始递归:上级枚举
end;
end;
end else
if (LLevel=1) then//:基线条件
begin
if FTreeViewItemCheckedCount[FTreeViewItemTag]
< (LFmxObject as TTreeViewItem).Count then
begin
if FErgodicParent<>'父已枚举' then
INC(FTreeViewItemCheckedCount[FTreeViewItemTag]);
//:上级+1
FErgodicParent:='';
Memo_Test.Lines.Add('枚举对象:'+(Sender as TTreeViewItem).Text+':上级:'+(Sender as TTreeViewItem).Text+':被勾中数:'+IntToStr(FTreeViewItemCheckedCount[FTreeViewItemTag]) );
end;
end;
end else
if (LFmxObject as TTreeViewItem).IsChecked=false then
begin
if (LLevel>1) then//:基线条件
begin
try
if FTreeViewItemCheckedCount[FTreeViewItemTag]
>0 then
begin
if FErgodicParent<>'父已枚举' then
DEC(FTreeViewItemCheckedCount[FTreeViewItemTag]);
//:上级-1
FErgodicParent:='';
Memo_Test.Lines.Add('枚举对象:'+(Sender as TTreeViewItem).Text+':上级:'+(Sender as TTreeViewItem).ParentItem.Text+':被勾中数:'+IntToStr(FTreeViewItemCheckedCount[FTreeViewItemTag]) );
end;
finally
if FTreeViewItemCheckedCount[FTreeViewItemTag]
=0//< (LFmxObject as TTreeViewItem).ParentItem.Count
then
begin
FErgodicParent:='父已枚举';
if (Sender as TTreeViewItem).ParentItem.IsChecked=true then
(Sender as TTreeViewItem).ParentItem.IsChecked:=false;
//:开始递归:上级枚举
end;
end;
end else
if (LLevel=1) then//:基线条件
begin
try
if FTreeViewItemCheckedCount[FTreeViewItemTag]
>0 then
begin
if FErgodicParent<>'父已枚举' then
DEC(FTreeViewItemCheckedCount[FTreeViewItemTag]);
//:上级-1
FErgodicParent:='';
Memo_Test.Lines.Add('枚举对象:'+(Sender as TTreeViewItem).Text+':上级:'+(Sender as TTreeViewItem).Text+':被勾中数:'+IntToStr(FTreeViewItemCheckedCount[FTreeViewItemTag]) );
end;
finally
end;
end;
end;
//2、处理ChangeCheck的本级枚举:
try
FErgodicParent:='';
LFmxObject.EnumObjects(//const Proc: TFunc
function (LControl:TFmxObject):TEnumProcResult
var LEnumProcResult:TEnumProcResult;
begin
//2.1、处理ChangeCheck的本级枚举到其下级:
if LControl.ClassName=EnumControlClassName then
begin
if EnumControlClassName='TTreeViewItem' then
begin
if (LFmxObject as TTreeViewItem).IsChecked=true then
begin
//Memo_Test.Lines.Add('枚举到了下级');
if (LControl as TTreeViewItem).IsChecked=false then
begin
(LControl as TTreeViewItem).IsChecked:=true;
end;
//:开始递归:(本级有下级)中间级枚举
end;
if (LFmxObject as TTreeViewItem).IsChecked=false then
begin
if (LControl as TTreeViewItem).IsChecked=true then
begin
(LControl as TTreeViewItem).IsChecked:=false;
end;
//:开始递归:(本级有下级)中间级枚举
end;
end;
end;
//2.1、处理ChangeCheck的本级枚举为末级:
if LControl.ClassName<>EnumControlClassName then
begin
//Memo_Test.Lines.Add('末级被勾中:没有枚举到下级');
//Memo_Test.Lines.Add('枚举对象:'+(LFmxObject as TTreeViewItem).Text+':上级:'+(LFmxObject as TTreeViewItem).ParentItem.Text+':被勾中数:'+IntToStr(FTreeViewItemCheckedCount[FTreeViewItemTag]) );
end;
Result:=TEnumProcResult.Continue;//:直到再无可枚举的下级
end
);
finally
end;
end;
//}
begin
{
if FIFInited=false then exit//:必须先完成初始化: 初始化在Checked:=false
else
begin
LLevel:=(Sender as TTreeViewItem).Level;
if (LLevel=1) then
begin
FTreeViewItemTag:=(Sender as TTreeViewItem).Tag;
//1、枚举子节点及其下级节点,自动勾或去勾:
//:同时子节点会开始递归本单元:
LEnumControls((Sender as TTreeViewItem),'TTreeViewItem');
end else
if (LLevel>1) then
begin
FTreeViewItemTag:=(Sender as TTreeViewItem).ParentItem.Tag;
//1、枚举子节点及其下级节点,自动勾或去勾:
//:同时子节点会开始递归本单元:
LEnumControls((Sender as TTreeViewItem),'TTreeViewItem');
end;
end;
//}
end;
procedure TForm2.ControlAction_btnSelectAllOrNotExecute(Sender: TObject);
begin //:全选或全不选:
FTreeViewSelectAllOrNot:= true;
if Label_WorkSpace_Button_btnSelectAllOrNot.Text='全选'
then
begin
try
Label_WorkSpace_Button_btnSelectAllOrNot.Text:='取消';
finally
EnumChecked(true,FTreeViewSelectAllOrNot);
end;
end else
begin
try
Label_WorkSpace_Button_btnSelectAllOrNot.Text:='全选';
finally
EnumChecked(true,FTreeViewSelectAllOrNot);
end;
end;
end;
procedure TForm2.ControlAction_btnEnumCheckedExecute(Sender: TObject);
begin
//遍历TreeView选中的节点:
FTreeViewSelectAllOrNot:=false;
EnumChecked(false,FTreeViewSelectAllOrNot);
end;
function TForm2.EnumChecked(
const AIFAncester:Boolean=true;
AIFUpdateCheckedStatus:Boolean=true):TStringList;
var LAddObject:TFmxObject;
LStringList,LTempStringList:TStringList;
LCircle:Integer;
LSonTreeViewItemField:string; //:子节点的TreeViewItem的数据源字段
LSonTreeViewItemFieldStringListIndex:Integer; //:子节点的TreeViewItem的数据源字段在StringList中的索引
LSeparator: array of char;
LLineOfStringList :TArray;
LLineStrOfStringList:string;
begin
//枚举TreeView选中的节点并决定是否变更选中状态：
LStringList:=TStringList.Create;
LTempStringList:=TStringList.Create;
try
TreeView_WorkSpace_Menus.EnumControls(
procedure (const AControl: TControl; var Done: boolean)
begin
if (AControl.ClassName = 'TTreeViewItem') then
begin
LAddObject:=TTreeViewItem(AControl);
if (AIFUpdateCheckedStatus=true) then
begin
if (LAddObject as TTreeViewItem).Level=1 then
begin
if (LAddObject as TTreeViewItem).IsChecked=false then
begin
(LAddObject as TTreeViewItem).IsChecked:=True;
end
else if (LAddObject as TTreeViewItem).IsChecked=True then
begin
(LAddObject as TTreeViewItem).IsChecked:=false;
end;
end;
end;
if (AIFUpdateCheckedStatus=false) then
begin
if (LAddObject as TTreeViewItem).IsChecked=True then
begin
if (AIFAncester=true) then
begin
if (LAddObject.TagString).Substring(
(LAddObject.TagString).IndexOf('=')+1
,length(LAddObject.TagString) )=(LAddObject as TTreeViewItem).Text
then
LStringList.Add(LAddObject.TagString);
//:格式:LTreeViewItem.TagString:=ATreeFiledName.Trim+'='+AParent.Name;
end else
if (AIFAncester=false) then
begin
if ( (LAddObject as TTreeViewItem).Count=0 )
then //:找到末级反推上级:处理打勾操作
begin
if (LAddObject as TTreeViewItem).Level>1 then
begin
if ((LAddObject as TTreeViewItem).ParentItem.Count
=FTreeViewItemCheckedCount[(LAddObject as TTreeViewItem).ParentItem.Tag]) then
begin //:找到了上级打勾:即下级全打勾
if LStringList.Text.Contains((LAddObject as TTreeViewItem).ParentItem.TagString)
=false then
begin
//Memo_Test.Lines.Add('找到了上级打勾');
LStringList.Add((LAddObject as TTreeViewItem).ParentItem.TagString);
end;
end else
begin //:else:找到了只有个别下级打勾
if LStringList.Text.Contains((LAddObject as TTreeViewItem).TagString)
=false then
begin
//Memo_Test.Lines.Add('找到了只有个别下级打勾');
LStringList.Add((LAddObject as TTreeViewItem).TagString);
end;
end;
end;
if (LAddObject as TTreeViewItem).Level=1 then
begin //:末级是顶级
if LStringList.Text.Contains((LAddObject as TTreeViewItem).TagString)
=false then
begin
//Memo_Test.Lines.Add('找到了末级是顶级的节点');
LStringList.Add((LAddObject as TTreeViewItem).TagString);
end;
end;
end;
//:格式:LTreeViewItem.TagString:=ATreeFiledName.Trim+'='+AText;
end;
end;
end;
end;
//处理LStringList:
Done:=false;//:不要停继续找下一个
end
,true //:只枚举可见的组件
);
//LStringList.Sort; //:枚举类型只能按照索引号index排序
//LStringList的调用方法如下(可传递给sql条件拼接):测试枚举结果:
//{
//Memo_Test.Lines.Clear;
Memo_Test.BringToFront; Memo_Test.Visible:=true;
Memo_Test.BeginUpdate;
SetLength(LSeparator,1);
LSeparator[0]:='=';
for LCircle := 0 to LStringList.Count-1 do
begin
SetLength(LLineOfStringList,length(LStringList[LCircle]));
LLineOfStringList[0]:=LStringList[LCircle].Split(LSeparator[0])[0];
LLineOfStringList[1]:=LStringList[LCircle].Split(LSeparator[0])[1];
LTempStringList.Add(LLineOfStringList[0]);
end;
for LCircle := LStringList.Count-1 downto 0 do
begin
LLineStrOfStringList:=LStringList[LCircle].Split(LSeparator[0])[0];
for LLineStrOfStringList in LTempStringList do
begin
if ( LTempStringList[LCircle].IndexOf(LLineStrOfStringList)>=0 )
and ( LTempStringList[LCircle]<>LLineStrOfStringList ) then
LStringList.Delete(LCircle);
end;
end;
for LCircle := 0 to LStringList.Count-1 do
begin
SetLength(LLineOfStringList,length(LStringList[LCircle]));
LLineOfStringList[0]:=LStringList[LCircle].Split(LSeparator[0])[0];
LLineOfStringList[1]:=LStringList[LCircle].Split(LSeparator[0])[1];
Memo_Test.Lines.Add(LLineOfStringList[0]+'='+LLineOfStringList[1]);
end;
Memo_Test.EndUpdate;
//}
Result:=LStringList; //:LLineOfStringList[0]是数据库查询条件需要的数据
finally
FreeAndNil(LStringList); FreeAndNil(LTempStringList);
end;
end;
procedure TForm2.ControlAction_btnDeleteTreeItemExecute(
Sender: TObject);
var LStringList:TStringList;
LFTreeViewItemCurrtFieldSortId:string;
LExps:string;
begin
if not Assigned(FTreeViewItemCurrt) then
begin
ShowAMessage('请先点中要删除的节点!',procedure begin end);
end
else
begin
Memo_Test.Lines.Add('点中啦:'+FTreeViewItemCurrt.Name+':'+FTreeViewItemCurrt.Text);
LStringList:=TStringList.Create;
try
try
//1、对象及组件移除并讲清单赋值LStringList:
FTreeViewItemCurrt.BeginUpdate;
FTreeViewItemCurrt.EnumControls
(
procedure (const AControl: TControl; var Done: boolean)
var LAddObject:TFmxObject;
begin
if (AControl.ClassName = 'TTreeViewItem') then
begin
LAddObject:=TTreeViewItem(AControl);
FTreeViewItemCurrt.RemoveObject(LAddObject); //:对象移除子对象
self.RemoveComponent(LAddObject as TComponent); //:窗体移除组件(包含命名等组件属性)
end;
Done:=false;//:不要停继续找下一个
end
,true //:只枚举可见的组件
);
FTreeViewItemCurrt.EndUpdate;
LFTreeViewItemCurrtFieldSortId:=FTreeViewItemCurrt.TagString;
LFTreeViewItemCurrtFieldSortId
:=LFTreeViewItemCurrtFieldSortId.Substring(0,LFTreeViewItemCurrtFieldSortId.IndexOf('=') );
Memo_Test.Lines.Add('内存表需删除的记录其sort_id及上级upper_sort_id:'+LFTreeViewItemCurrtFieldSortId);
TreeView_WorkSpace_Menus.BeginUpdate;
TreeView_WorkSpace_Menus.RemoveObject(FTreeViewItemCurrt); //:对象移除子对象
self.RemoveComponent(FTreeViewItemCurrt as TComponent);//:窗体移除组件(包含命名等组件属性)
TreeView_WorkSpace_Menus.EndUpdate;
finally
//2、内存表删除记录其sort_id及上级upper_sort_id:
//:LFTreeViewItemCurrtFieldSortId:
LExps:=' sort_id='''+LFTreeViewItemCurrtFieldSortId
+''' or upper_sort_id='''+LFTreeViewItemCurrtFieldSortId+''' ';
if (FDMemTable_Main.Active=false) then
FDMemTable_Main.Active:=true;
FDMemTable_Main.First;
while not FDMemTable_Main.Eof do
begin
if FDMemTable_Main.LocateEx(LExps,[],0)
= true then
FDMemTable_Main.Delete;
FDMemTable_Main.Next;
end;
//: 补代码:删除后台sqlite3数据库表中的数据...:
FDMemTable_Main.ApplyUpdates();
FDMemTable_Main.First;
end;
finally
FreeAndNil(LStringList);
end;
end;
end;
procedure TForm2.ControlAction_ListBox_Button_btnEditExecute(
Sender: TObject);
begin //:编枝数据处理:
//1、UI控制显示:
Rectangle_WorkSpace_ListBox_AddNewTreeORTreeItem.Visible:=false;
//2、TTreeView更新节点UI数据处理:
TreeViewItemUpdateData(
'编枝',
'编辑',FTreeViewItemCurrt);
//3、内存表变更数据:
end;
procedure TForm2.ControlAction_ListBox_Button_btnInsertExecute(
Sender: TObject);
var LTreeViewItem:TTreeViewItem;
begin //:加树数据处理:
Rectangle_WorkSpace_ListBox_AddNewTreeORTreeItem.Visible:=false;
//2、TTreeView更新节点UI数据处理:
if FAddWhoParent='加树进入' then
begin //Label_WorkSpace_Button_btnAddNewTree
TreeViewItemUpdateData(
'加树',
'新增',TreeView_WorkSpace_Menus);
end;
if FAddWhoParent='编枝进入' then
begin
LTreeViewItem:=
TreeViewItemUpdateData(
'编枝',
'新增',FTreeViewItemCurrt);
end;
//3、内存表变更数据:
end;
procedure TForm2.ControlAction_ListBox_Button_btnCancelExecute(Sender: TObject);
begin //:放弃处理编枝或加树:
Rectangle_WorkSpace_ListBox_AddNewTreeORTreeItem.Visible:=false;
end;
procedure TForm2.ControlAction_btnAddNewTreeExecute(Sender: TObject);
begin //:加树:
if FIFInited=false then
begin
ShowAMessage('请先加载数据源！',procedure begin end);
Abort; //:尚未初始化
end;
Rectangle_WorkSpace_ListBox_AddNewTreeORTreeItem.Visible:=true;
Rectangle_WorkSpace_ListBox_Button_btnEdit.Visible:=false;
Edit_TreeViewItem_Name.Text:='';
//:本节点显示名
Label_TreeViewItem_Name.Hint
:='';
//:本节点编码
Label_TreeViewItem_upper_sort_id.Hint:='';//:上级节点编码
Edit_TreeViewItem_upper_sort_id.Text:=''; //:上级节点显示名
FAddWhoParent:='加树进入';
Memo_Test.Lines.Add('上级:'+Label_TreeViewItem_upper_sort_id.Hint+',显示名:'+Edit_TreeViewItem_upper_sort_id.Text );
end;
procedure TForm2.ControlAction_btnAddNewTreeItemExecute(Sender: TObject);
begin
if FIFInited=false then
begin
ShowAMessage('请先取数！',procedure begin end);
Abort; //:尚未初始化
end;
if not Assigned(FTreeViewItemCurrt) then
begin
ShowAMessage('请先点中要编枝的节点!',procedure begin end);
end
else
begin
Rectangle_WorkSpace_ListBox_AddNewTreeORTreeItem.Visible:=true;
Rectangle_WorkSpace_ListBox_Button_btnEdit.Visible:=true;
Edit_TreeViewItem_Name.Text:=FTreeViewItemCurrt.Text.Trim;
//:本节点显示名
if FTreeViewItemCurrt.Level>1 then
begin
Label_TreeViewItem_Name.Hint
:=FTreeViewItemCurrtFieldSortid(FTreeViewItemCurrt);
//:本节点编码
Label_TreeViewItem_upper_sort_id.Hint
:=FTreeViewItemCurrtFieldSortid(FTreeViewItemCurrt.ParentItem);
//:上级节点编码
Edit_TreeViewItem_upper_sort_id.Text:=FTreeViewItemCurrt.ParentItem.Text;
//:上级节点显示名
end else
begin
Label_TreeViewItem_Name.Hint
:=FTreeViewItemCurrtFieldSortid(FTreeViewItemCurrt);
//:本节点编码
Label_TreeViewItem_upper_sort_id.Hint:='';//:上级节点编码
Edit_TreeViewItem_upper_sort_id.Text:=''; //:上级节点显示名
end;
FAddWhoParent:='编枝进入';
Memo_Test.Lines.Add('点中啦:'+Label_TreeViewItem_Name.Hint+',显示名:'+Edit_TreeViewItem_Name.Text+',上级:'+Label_TreeViewItem_upper_sort_id.Hint+',显示名:'+Edit_TreeViewItem_upper_sort_id.Text );
end;
end;
function FTreeViewItemCurrtFieldSortid(
ATreeViewItem:TTreeViewItem):string;
var LFTreeViewItemCurrtFieldSortid:string;
begin
if Assigned(ATreeViewItem) then
begin
LFTreeViewItemCurrtFieldSortid:=ATreeViewItem.TagString;
Result
:=LFTreeViewItemCurrtFieldSortid.Substring(0,LFTreeViewItemCurrtFieldSortid.IndexOf('=') );
end else Result:='';
end;
function TForm2.TreeViewItemUpdateData(
AOperation:string;
ABtnText:string;
AFmxObject:TFmxObject):TTreeViewItem;
var LTreeViewItem:TTreeViewItem;
LSeeds_id:string;
LParent:TFmxObject;
LMarginsLeft:Single;
procedure AddATreeViewItem;
begin
FDMemTable_Main.Last;
INC(FAddseeds_idCount);
FNewSortId_RemoteDataBaseTable
:=IntToStr( FDMemTable_Main.FieldByName('seeds_id').AsInteger
+FAddseeds_idCount );
LSeeds_id:=FNewSortId_RemoteDataBaseTable;
if FNewSortId_RemoteDataBaseTable.IndexOf('IT')<0 then
FNewSortId_RemoteDataBaseTable
:='IT'+LSeeds_id;
//:实际使用时FNewSortId_RemoteDataBaseTable应被调用者计算后传入
System.TMonitor.Enter(TreeView_WorkSpace_Menus,0);
TreeView_WorkSpace_Menus.BeginUpdate;
LTreeViewItem:=CreateATreeViewItems(
FDMemTable_Main.RecordCount, //:索引号
'TreeViewItem_WorkSpace_Menus_'+LSeeds_id, //:产生TreeviewItem的name
Edit_TreeViewItem_Name.Text.Trim,//:产生TreeviewItem的Text显示名
FNewSortId_RemoteDataBaseTable, //:数据库表的sort_id内码
LParent,//:父组件的TFmxObject
ImageList_Menus.Source[0].Index, //:图片索引号
40,330,LMarginsLeft, //:位置尺寸
self //:所有者:应为窗体或TFrame
);
TreeView_WorkSpace_Menus.EndUpdate;
System.TMonitor.Exit(TreeView_WorkSpace_Menus);
Memo_Test.Lines.Add('索引号:'+IntToStr(FDMemTable_Main.RecordCount)
+',name:'+'TreeViewItem_WorkSpace_Menus_'+LSeeds_id
+',显示名:'+Edit_TreeViewItem_Name.Text.Trim
+',内码:'+FNewSortId_RemoteDataBaseTable
);
end;
begin //:TTreeView更新节点UI数据处理:
//if ATreeView<>nil then
begin
if AOperation='加树' then
begin //:TreeView UI加树:
LParent:=(TreeView_WorkSpace_Menus as TFmxObject);
LMarginsLeft:=5;
AddATreeViewItem;
Result:=LTreeViewItem;
end;
if AOperation='编枝' then
begin //:TreeViewItem UI编枝:
if ABtnText='新增' then
begin
Memo_Test.Lines.Add('点了编枝新增！');
try
LParent:=
FindComponent(
FTreeViewItemCurrt.Name
) as TTreeViewItem;
LMarginsLeft:=15;
finally
Memo_Test.Lines.Add('父:'+(LParent as TTreeViewItem).Name);
AddATreeViewItem;
end;
Result:=LTreeViewItem;
end else if ABtnText='编辑' then
begin
(AFmxObject as TTreeViewItem).Text:=Edit_TreeViewItem_Name.Text.Trim;
end;
Result:=(AFmxObject as TTreeViewItem);
end;
end;// else Result:=nil;
//Edit_TreeViewItem_Name.Text//:UI元素:本节点显示名
//Label_TreeViewItem_Name.Hint//:UI元素:本节点编码
//Label_TreeViewItem_upper_sort_id.Hint//:UI元素:上级节点编码
end;
function TForm2.FDMemTable_Main_Update:Integer;
var L:TFloatField; L2:TFloatValue;
begin //:逐笔更新:
//...
INC(FDMemTable_Main_UpdatedCount);
Result:=FDMemTable_Main_UpdatedCount;
//Edit_TreeViewItem_Name.Text//:UI元素:本节点显示名
//Label_TreeViewItem_Name.Hint//:UI元素:本节点编码
//Label_TreeViewItem_upper_sort_id.Hint//:UI元素:上级节点编码
end;
end. 五、测试转化未通用TFrame窗体TFrameTreeView
unit FrmTreeView;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
System.Actions, FMX.ActnList, FMX.Layouts, FMX.TreeView,
FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, FMX.Objects,
System.ImageList, FMX.ImgList, FMX.Ani, FireDAC.Stan.Intf,
FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf,
FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys,
FireDAC.Phys.SQLite, FireDAC.Phys.SQLiteDef, FireDAC.Stan.ExprFuncs,
FireDAC.FMXUI.Wait, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf,
FireDAC.DApt, Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client;
type
TFrameTreeView = class(TFrame)
ImageList_Menus: TImageList;
ImageList_TreeView: TImageList;
LayoutGloble: TLayout;
Rectangle_Caption: TRectangle;
Rectangle_Line: TRectangle;
Rectangle_WorkSpace: TRectangle;
Memo_Test: TMemo;
Rectangle_WorkSpace_Button: TRectangle;
Rectangle_WorkSpace_Button_btnRenewMenus: TRectangle;
Label_WorkSpace_Button_btnRenewMenus: TLabel;
Rectangle_WorkSpace_Button_btnExpandAllOrCollapseAllMenus: TRectangle;
Label_WorkSpace_Button_btnExpandAllOrCollapseAllMenus: TLabel;
TreeView_WorkSpace_Menus: TTreeView;
NavBar_Pulledup: TRectangle;
ActionList1: TActionList;
ControlAction_btnRenewMenus: TControlAction;
ControlAction_btnExpandAllOrCollapseAllMenus: TControlAction;
Image_MenuClose: TImage;
BitmapListAnimation_MenuClose: TBitmapListAnimation;
Label_MenuClose: TLabel;
Label_Caption: TLabel;
CarveouttestConnection: TFDConnection;
FDQuery_Main: TFDQuery;
procedure FramePaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
procedure ControlAction_btnExpandAllOrCollapseAllMenusExecute(
Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
FStringList:TStringList; //:TreeeView获取TImageList数据应用
FIFCollapse:Boolean; //:调用者初始化传入默认:=false;
FIFInited:Boolean; //:调用者初始化传入默认:=false;
function CreateATreeViewItems(
const AIndex:Integer;
AText:string;
AParent:TFmxObject;
ImageIndex:Integer;
ASizeHeight,ASizeWidth:Single;
MarginsLeft:Single;
AOwnerObject:TFmxObject
):TTreeViewItem;
procedure InitATreeViewItems(
const ATreeView:TTreeView;var AIFInited:Boolean);
end;
implementation
{$R *.fmx}
procedure TFrameTreeView.ControlAction_btnExpandAllOrCollapseAllMenusExecute(
Sender: TObject);
begin
//:伸缩: //ShowMessage('点了');
FIFCollapse:=not FIFCollapse;
if FIFCollapse=false then
TreeView_WorkSpace_Menus.CollapseAll
else TreeView_WorkSpace_Menus.ExpandAll;
end;
function TFrameTreeView.CreateATreeViewItems(
const AIndex:Integer;
AText:string;
AParent:TFmxObject;
//:非常关键的参数:指明该节点:
//:其父节点是TTreeView还是它的上级递归TTreeViewItem
ImageIndex:Integer;
ASizeHeight,ASizeWidth:Single;
MarginsLeft:Single;
AOwnerObject:TFmxObject
):TTreeViewItem;
var LTreeViewItem:TTreeViewItem;
begin
InitATreeViewItems(TreeView_WorkSpace_Menus,FIFInited);
LTreeViewItem:=TTreeViewItem.Create( AOwnerObject );
LTreeViewItem.Parent:=AParent;
LTreeViewItem.Name:=
'TreeViewItem_WorkSpace_Menus_'
+IntToStr(AIndex);
//+FillBeforeString(IntToStr(AIndex),4,'0');
LTreeViewItem.Index:=AIndex;
LTreeViewItem.ImageIndex:=ImageIndex;
LTreeViewItem.Text:=AText;
LTreeViewItem.Align:=TAlignLayout.Left;
LTreeViewItem.IsChecked:=false;
LTreeViewItem.IsExpanded:=false;
LTreeViewItem.IsSelected:=false;
LTreeViewItem.StyleLookup:='treeviewitemstyle';
LTreeViewItem.StyledSettings:=
LTreeViewItem.StyledSettings-
[TStyledSetting.Family,
TStyledSetting.Size,
TStyledSetting.FontColor,
TStyledSetting.Other
];
LTreeViewItem.TextSettings.FontColor
:=TAlphaColor($FF1373A9);
LTreeViewItem.TextSettings.Font.Family:='微软雅黑';
LTreeViewItem.TextSettings.Font.Size:=16;
LTreeViewItem.Size.Height:=ASizeHeight;
LTreeViewItem.Size.Width:=ASizeWidth;
LTreeViewItem.Margins.Left:=MarginsLeft;
LTreeViewItem.Position.Y:=AIndex*40;
Result:=LTreeViewItem;
end;
procedure TFrameTreeView.InitATreeViewItems(
const ATreeView: TTreeView;
var AIFInited: Boolean);
begin
if AIFInited=false then //:尚未初始化
begin
FIFInited:=false;
ATreeView.Align:=TAlignLayout.Client;
ATreeView.AutoHide:=false;//:默认true会自动隐藏滚动条
ATreeView.DisableFocusEffect:=false;
ATreeView.Images:=ImageList_Menus;
ATreeView.ItemHeight:=40;//:产生的TreeViewItem的行高
ATreeView.Margins.Left:=5; ATreeView.Margins.Right:=5;
ATreeView.MultiSelect:=true;//:多行选择
ATreeView.Opacity:=1;//0.85;
ATreeView.ShowCheckboxes:=true;
ATreeView.ShowScrollBars:=true;
ATreeView.ShowSizeGrip:=true;//:显示对Size的控制
ATreeView.Sorted:=false;
ATreeView.StyleLookup:='treeviewstyle';
FIFCollapse:=false; //:ATreeView默认不展开是收拢的:调用onFramePaint
AIFInited:=true; //:初始化完毕
FIFInited:=true;
end;
end;
procedure TFrameTreeView.FramePaint(Sender: TObject; Canvas: TCanvas;
const ARect: TRectF);
begin
if FIFInited=false then //:尚未初始化
begin
InitATreeViewItems(TreeView_WorkSpace_Menus,FIFInited);
end;
end;
end.六、我的部分统一平台函数库myFuc_UnifiedPlatForm 1，无论D1-D7还是移动平台：
//:uses myFuc_UnifiedPlatForm //:我的部分统一平台函数库1，无论D1-D7还是移动平台：
unit myFuc_UnifiedPlatForm;
interface
uses
{$IFDEF MSWINDOWS}
Winapi.Windows,Winapi.ShellAPI,
System.Win.Registry,//:Windows注册表类
WinInet,
{$ENDIF MSWINDOWS}
System.Classes,
System.SysUtils ,System.IOUtils
,System.StartUpCopy ,System.UITypes
, System.Math, System.Variants, System.Types
, system.hash //：系统自带的的Hash单元
, System.IniFiles //：INI配置文件操作单元
, System.DateUtils //:日期时间类
, System.Permissions //:系统权限
, System.Rtti //:系统运行时刻库:
//, System.Net.HTTPClientComponent
, System.Net.HttpClient
, System.Threading //:系统线程类
, System.TypInfo
, System.Generics.Collections
, System.Generics.Defaults
//Rest体系:
, REST.Response.Adapter, REST.Client
//:REST客户端组件引用://组件TRESTClient TRESTRequest TRESTResponse TRESTResponseDataSetAdapter的单元:
, REST.Authenticator.Basic//:Rest客户端基本鉴权单元:TSession会话方式
, REST.Authenticator.OAuth//:Rest客户端高级鉴权单元:AccessToken访问令牌方式或代码方式
, REST.BindSource//:Rest客户端数据绑定源
, REST.Utils//:Rest客户端实用工具:URIEncode、ExtractURLSegmentNames、ExtractGetParams、RESTComponentIsDesigning、TRESTFindDefaultComponent
, REST.Types//:Rest客户端请求的各种类型的常量、枚举的定义,异常捕获的定义
, REST.Consts//:Rest客户端的运行是提示常量
//Rest的以下体系中这套与Json的交互,既可用于客户端,也可用于服务器端:
, REST.Json.Types //:REST.Json特殊类型的运行时刻库:日期、布尔的编组与解析
, REST.Json.Interceptors
//:Json这些数据类型拦截器:实现对时区、日期时间中的分段、
//:数组中的局部字符串:转TListOfObjects = array of TObject及其反转
//:字符串中的局部字符串:转TObject及其反转
, REST.Json
//:TJson类封装:将TObject对象转Json和Json格式的string,
//:Json和Json格式的string转对象TObject,
//:Json格式化(TStringBuilder规范化重写)及
//:Json和Json格式的string规范化UTF8编码
, REST.JsonReflect//:Json映射:数据对象与编组、转化:
//:REST.JsonReflect来源于Data.DBXJSONReflect,只是它更轻量级.
//:最重要是它不依赖于注入到中JSON对象的元数据.
//:它的目的是“reflect映射”Json属性到TObject,反之亦然.
//:这里所有JSON对象创建或处理均以“plain”的方式对待.
//在本单元实现方式从设计的观点来看仍然是“粗糙”的,
//:但会随着时间的推移得以改善(10.3应该完善啦)
//重要:这里严重涉及RTTI,因此可能不能被禁用,必须引用System.RTTI.
//目前不建议直接使用这个单元,因为它的接口可能随时间而改变.
//:推荐使用REST.Json中的TJson类(或Data.DBXJSONReflect).
//REST.Json中的接口是稳定的.
//:10.0以前暂不建议直接使用它(10.3应该完善啦)
//:可替代方案:使用以下两个JSon映射互转的封装:
//数据库的JSon映射:数据对象与编组、转化:
// JSon数据:
, Data.FireDACJSONReflect ,Data.DBXJSONReflect
, Data.DBXJSONCommon
, Data.DB
//FDAC数据调用：
, FireDAC.Comp.Client
//FDAC数据集转Json：
, FireDAC.Comp.DataSet
, FireDAC.Comp.BatchMove
, FireDAC.Comp.BatchMove.DataSet
, FireDAC.Comp.BatchMove.JSON
// Datasnap数据、异常等类：
, Datasnap.DSClientRest
, FMX.Menus ,FMX.Dialogs ,FMX.Memo
, FMX.Graphics
, FMX.Controls ,FMX.Objects
, FMX.TreeView ,FMX.ImgList
//此3组控制平台虚拟键盘：FMX.Platform:平台服务
, FMX.VirtualKeyboard ,FMX.Platform
, FMX.Forms ,FMX.Types
, FMX.DeviceInfo //:第三方客制化设备管理单元
//JSON类-运行时刻库：C:\Program Files (x86)\Embarcadero\Studio\20.0\source\rtl\common
,System.JSON
,System.JSON.Types
,System.JSONConsts
,System.JSON.Utils
//全新JSON类-运行时刻库：C:\Program Files (x86)\Embarcadero\Studio\20.0\source\rtl\common
,System.JSON.Builders
,System.JSON.Readers
,System.JSON.Writers
,System.JSON.BSON
,System.JSON.Converters
,System.JSON.Serializers
//Indy组件:
, IdHashMessageDigest //：Indy的Hash和MD5单元
, IdIPWatch //：Indy本机IP
, IdHTTP ,IdStack //：Indy http协议、Indy栈
{$IFDEF IOS}
, iOSapi.Foundation, iOSapi.Helpers //2019-07-22临时添加：IOS运行时刻库
{$ENDIF IOS}
//下面Android的等系统调用： //调用安卓系统或调用安卓Intent和Uri
//FMX.PhoneDialer, //引用该单元，会导致程序运行后，如果手机打电话，会导致程序异常退出
{$IFDEF ANDROID}
,FMX.Helpers.Android
,Androidapi.Helpers
,Androidapi.JNI.GraphicsContentViewText
,Androidapi.JNI.Net
,Androidapi.JNI.JavaTypes
,Androidapi.JNI.Telephony
,Androidapi.JNI.Provider
,Androidapi.JNIBridge
,Androidapi.JNI.Os
,Androidapi.JNI.App
,Androidapi.JNI.Support
{$ENDIF ANDROID}
;
{$IFDEF ANDROID}
///全局电话管理 接口变量引用:
var TelephonyManager: JTelephonyManager;
// ///Android请求权限的全局变量:
// var MyPermissions: TArray;
FCAMERA, FINSTANT_APP_FOREGROUND_SERVICE,
FMANAGE_DOCUMENTS, FREAD_EXTERNAL_STORAGE, FWRITE_EXTERNAL_STORAGE
:string;
///通用调用手机应用的Intent和Uri：
procedure Call_URI(const AAction: JString; const AURI: string);
///获取本机所有联系人：
function FetchContactInfo(var aReturnStr:TStringList): TStringList;
///短信收件箱列表：
function FetchSms: string;
///'直接没有任何提示的【静默发长短信】www.pulledup.cn' : ：
///不能超过70个字：否则函数自动先做分割后，分别发：：
///收短信：是一次性1条收看的：：
procedure SentSMS(phoneNumber, SMSstring: string); // 直接没有任何提示的发送短信
///调用系统程序发短信：
procedure SentSMSfromIntent(phoneNumber, SMSstring: string); // 调用系统程序发短信
///打电话：
procedure PhoneCall(phoneNumber: string);
///获取Android手机的MEID号(即设备的ID非运营商的入网号):
function GetAndroidMEID: string;
///获取Android手机的IMEI号(即运营商的入网号,双卡就2个):
function GetAndroidIMEI: string;
///获取Android手机SIM卡串号：
function GetSN: string;
///Andoid获取本机号码:
function myPhoneNumber:string;
///Andoid7.0及其以下安装apk:
procedure ToInstallApk70Down(Apk: string);
///Andoid安装apk:
procedure ToInstallApk(Apk: string);
///Andoid请求某一系统权限:
procedure AndoidRequestPermissions(
const RequestPermissions:Array of string);
{$ENDIF ANDROID}
///01、1-based字符串转换到0-based 的函数：
///别乱用弄懂0-based：
///如何修改1-based字符串的例子,适用所有平台：
function strConvt1To0(const S: string): string;
///02、字符串被myDelimiter字符符号分隔符分割的数值获取，
///并将其赋值给一个 TStringList：
procedure myItems_Delimiter(myStr:String; myDelimiter:Char; mySplitStrL:TStringList);
//03、控制虚拟键盘：
//事实上，高版本POSIX焦点移到输入控件，即可显示
//事实上，高版本POSIX焦点移开至非输入按钮等，即可关闭
procedure myVKeyboard(aFmxObject:TFmxObject; aControlStr:String);
///04、比较字段的旧值是否等于新值：
function compareOldNew(Field: TField): boolean; overload;
///05、比较内存表的中各字段是否有变化：
function compareOldNew(aFDMemTable: TFDMemTable): Boolean; overload;
///06、比较字符串A和B是否相等：
function compareOldNew(AString,BString: String): Boolean; overload;
///07、求中文字符串的字节长度：
function GetStrGBOfByteCount(Data: String): Integer;
///08、函数功能：当Str不满Len长度时，在Str前自动填充FillStr以补足长度：
function FillBeforeString(const SourceStr: string; Len: Integer; FillStr: string): string;
///09、函数功能：当Str不满Len长度时，在Str后自动填充FillStr以补足长度：
function FillAfterString(const SourceStr: string; Len: Integer; FillStr: string): string;
///10、求混合类型的中文字符串中的非汉子字符的字符总数：
function ifSingleByte(sString: string=''):Integer;
///11、求当前进程实例的操作系统平台、CPU架构、版本信息,用","和";"分割：
function getOsArchVer(const AInfoType:string=''):string;
///求字符串的Unicode字节数：
function getBytesCountOfStr(var Text:string):Integer;
///正则表达式:01手机号验证：
function IsMobileNumber(var Text:string;
const opermode:string='结果验证';
const ifReturnError:string=''): string;
///产生预发送的随机的4位数字验证码：
function RandomVerificCode: string;
///产生随机的N位数字字符串：
function RandomNumberStr(const aInt:Integer=20): string;
///产生随机的N位数字的以某个数字开头的秒数字符串：
function RandomTimeSecondsStr(const aIntBegin:Integer=1000;aIntEnd:Integer=2000): string;
///产生小于设定的数值的1位随机正整数0~aInt-1）：
function RandomNumber(const aInt:Integer=3): Integer;
///从ImageList向TBitmap赋值，见其中调用示例：
function ImgGetFromImgList(Const ImgList:TImageList;
Const xPT,yPT:Integer;Const indexImgList:Integer): TBitmap;
///半角Cbd转全角Dbd）:
///半角全角互转原理(全角即汉子的字符编码范围的子界)：
///全角空格为12288，半角空格为32
///其他字符半角(33-126)与全角(65281-65374)的对应关系是：均相差65248
function CbdToDbd(const Text:string=''): string;
///全角Dbd转半角Cbd）:
///半角全角互转原理(全角即汉子的字符编码范围的子界)：
///全角空格为12288，半角空格为32
///其他字符半角(33-126)与全角(65281-65374)的对应关系是：均相差65248
function DbdToCbd(const Text:string='';const KillChinese:string='去中文'): string;
///delphi自带Indy函数实现MD5加密:
function getMyIndyMD5String(const aSignName:string) : string;
///delphi自带Hash函数实现加密:
function getMyHashString(const aSignName:string) : string;
///服务器端设置APP存取的系统路径(含路径):
///没有就产生,有就不产生,不会覆盖:
function ServerSubPathOfAppPublished(
APath:string='';AProducedSubPath:string=''):Boolean;
///服务器端获取APP存取的系统路径(含路径):
function ServerGetSubPathOfAppPublished(
UploadOrDownload:string='Upload';AFileType:string='pic';
AProducedSubPath:string='';IfPathThumbnail:Boolean=false):string;
///设置Text格式的文本文件的系统路径(含路径):
function productTextFile(const aSubPath:string='';const targetFileName:string=''):string;
///获取系统登录状态及系统配置信息全局参数:
///(其中含中文属多字节字符集需转化)
procedure getSysConfig(const FileName:string='myFile.ini');
///设置并保存系统登录状态及系统配置信息全局参数:
procedure setSysConfig;
///取得计时时间，单位毫秒(ms):
function getMyStickCount(starttime,stoptime:TDateTime):Integer;
///便于差异化数据库扩展,设置通用的日期时间字段的select列表字段，返回字符串:
function getDatetime(const aDatetimeField:string='';const Database:string=''):string;
///便于差异化数据库扩展,设置通用的日期时间字段的where条件字段，返回字符串:
function whereDatetime(const aDatetimeField:string='';const Database:string=''):string;
///数据集的记录转JSonArray字符串:用FDBatchMove方法，select计算列结果列含\：
///与DataSet2JSONuseDataset比较:所有字段类型与其数值类型表达一致:
///返回数据集的记录:不含字段定义:
function DataSet2JSONuseFDBatchMove(ADataset: TDataSet): string;
///数据集的记录转JSonArray字符串:用Dataset遍历拼接Json格式的方法：
///与DataSet2JSONuseFDBatchMove比较:所有字段数值均以字符串形式表达:
///返回数据集的记录:不含字段定义:
///样例： [{"CityId":"18","CityName":"西安"},{"CityId":"53","CityName":"广州"}]
function DataSet2JSONuseDataset(ADataset: TDataSet): string;
///FieldType转DML语句字段列属性字串:
function FieldTypeToDMLFieldProperstr(
AField: TField;
AFieldType: TFieldType): string;
///全局平台服务异步对话框服务-简单提示框:
procedure ShowAMessage(const AMessage:string; const AProc:TProc);overload;
///全局平台服务异步对话框服务-简单提示框:
procedure ShowAMessage(const AMessage:string;const AX, AY: Integer);overload;
///全局通用截屏方法:
procedure FMakeScreenshot(
ATControl:TControl;AImage:TImage);
///强制设置TControl焦点,返回是否获得焦点:
///uses FMX.Controls,FMX.Objects;
function FocusMe(const ATControl:TControl):Boolean;
///全局FMX窗体服务:uses FMX.Forms:
var FFmxWindowService:IFMXWindowService;
///全局剪切板接口:uses FMX.Platform:
var FClipBoard:IFMXClipboardService;
///全局剪切板获取的数值:uses System.Rtti:
var FClipBoardValue:TValue; //:全局剪切板获取的数值
///全局剪切板获取对象属性的泛型值:
function ClipBoardGetObjectValue(const ATControl:TObject):Boolean;overload;
///全局剪切板获取文本值:
function ClipBoardGetObjectValue(const AText:string):Boolean;overload;
///QQ是否手动登录(QQ不像微信,App拉起会被腾讯安全警告，只能由浏览器打开)
var FQQisRunning:Boolean;
///TIM是否手动登录(QQ不像微信,App拉起会被腾讯安全警告，只能由浏览器打开)
var FTIMisRunning:Boolean;
///当前分享名:
var FCurrShareName:string;
///Windows启动第三方APP库分享的点击事件:
function ActionWinStartupThirdApp(Sender:TObject):Boolean;
var FAStringListImported: IFuture;
var FAFileDbServerTime:string;
///THTTPClient通过IHTTPResponse响应服务器端返回的
///JsonObject为客户端调用者传入的TStringList(实际用string)赋值:
///:TStringList、TMemo等只适合少量基础数据的加载:
///:TListbox、TListview等TScrollBox类的
///TStrings的基类也应当分页:
procedure HttpRestByJsonObjectToStrList(
var AStringListImported:System.string; //:调用者传入的TStringList
const UrlHttpHead:string='https://192.168.3.100:8080';
UrlRestMethod:string='/datasnap/rest/TServerMethods1';
UrlMethodName:string='/getDatabaseDatetime';
UrlMethodParamsStr:string='/%20/文件系统' //:%20:空参数
);
//function Bytes2String(const ABytes: TBytes): string;
//function String2Bytes(const AString: string): TBytes;
///我的JSON函数和过程-WritePair写Json对:
procedure WritePair(
JW:TJsonWriter;// TJsonTextWriter or TJsonObjectWriter
const sName,sValue:string);
///我的JSON解析函数TJSONIterator:
function JsonIteratorParsor(
const AStrListResult:TStringList=nil;
const AJsonStr:string='';
const AKeySearch:string='';
const AValueSearch:string=''):string;
///WriteLog用文件流及写流工具写系统日志文件：
///只能被1个App实例(内部的N个线程)同时写:
///myFucWinPro还有1个writeLogsINI:在uses myFucWinPro中:
procedure WriteLog(
const
AInfo: string='';
AIP:string='127.0.0.1';
AUserName:string='系统管理员';
ADevice:string='电脑'
);
///获取本机IPv4地址:
function getLANIP:string;
///获取本机网关的公网的IPv4地址:
function GetWANIP(const InternetIP:Boolean=true): string;
///有问题只能用简单的映射:16进制字符串转原字符串hextostring、StringToHex、HexToInt
function hextostring(str: string): string;
///有问题只能用简单的映射:字符串转16进制字符串hextostring、StringToHex、HexToInt
function StringToHex(str: string): string;
///有问题只能用简单的映射:16进制字符串转整数hextostring、StringToHex、HexToInt
function HexToInt(hex: string): integer;
///最简单的Rest服务调用:
///若用于测试网络:
///:超时要很短默认100毫秒:参考网络ping命令的超时
///:默认访问超稳定的百度搜索首页以此来判断:客户端网络问题:
///所有Rest请求或delphi dataSnap客户端请求,
///先判断客户端网络状态再开始做
function RestWebService(
const ABaseUrl:string='https://www.baidu.com/';
ATimeout:Integer=100
):string;overload;
///(不)过滤非pascal语言的异常的方法:
///="true":非delphi异常就过滤掉并不弹出提示框
///="false":true用完后应当及时false,恢复弹出提示框
procedure KillExceptNodelphi(AExceptNodelphi:Boolean);
///连续产生ACharNums个字符的函数,
///:即System.StringOfChar(Char,Integer):
function IntendChar(AAnsiChar:Char;ACharNums:ShortInt):string;
///Vcl返回是否成功,回调所有组件的TRttiType的实例TRttiInstanceType的元类的类名:
function FillVclClasses(ATStrings:TStrings): Boolean;
///Fmx返回是否成功,回调所有组件的TRttiType的实例TRttiInstanceType的元类的类名:
function FillFmxClasses(ATStrings:TStrings;AIfRttiTypeList:Boolean=false): Boolean;
///根据组件名或对象名返回对象的元类
function FindAnyClass(const Name: string): TClass;
///全局虚拟键盘 接口变量引用:
var aKeyboard:IFMXVirtualKeyboardService;
///全局平台服务对话框服务接口:
FIFMXDialogServiceAsync:IFMXDialogServiceAsync;
FIFMXDialogServiceSync:IFMXDialogServiceSync;
/////服务器端全局变量汇总:
// ///当前连接的数据库名
// myGetCatalogNames:string;
///客户端全局变量汇总:
///全局变量"验证码网关手机号"引用11位手机号='18980851626':
var gstrSenderPhone:string='18190910561';
///全局变量"服务器域名"引用='www.cpuofbs.com'支持二级域名:
var gstrIP:string='192.168.3.100';
///全局变量"服务器端口号"引用='8086':
var gstrPort:string='8080';
///全局变量"客服电话"引用20位号码='02866000800':
var gstrCunstomerServiceTel:string='02866000800';
///全局变量"运营商编码"引用10位'001':
var gstrComID:string='001';
///全局变量“当前登录状态”默认未登录状态引用6位='未登录':
var gstrLoginStatus:string='未登录';
///全局变量“员工编码”30位引用='':
var gstrClerk_id:string='';
///全局变量“员工姓名”40位引用:
var gstrClerk_name:string='';
///全局变量“员工所在部门编码”30位引用:
var gstrDept_id:string='';
///全局变量“员工所在部门名称”60位引用:
var gstrDept_name:string='';
///全局变量“客户编码”引用30位='':
var gstrCustomer_id:string='';
///全局变量“客户姓名”引用40位='':
var gstrCorp_name:string='';
///全局变量“客户地址”引用100位='':
var gstrCorp_addr:string='';
///全局变量“记住密码的登录手机”引用11位手机号='18190910561':
var gstrLoginPhone:string='';
///全局变量“记住密码的登录密码”引用16位='':
var gstrLoginPassword:string='';
///全局变量“当前用户的登录编码”引用Ctl09003中user_id的20位='':
var gstrUser_id:string='';
///全局变量“点选类权限-是否允许修改单价和折扣：”引用Ctl09003登录账号表14位='不可改单价折扣':
var gstrB_sd_priceANDi_discount:string='不可改单价折扣';//不改单价折扣
///全局变量“点选类权限-是否可看成本毛利利润：”引用Ctl09003登录账号表='不可看成本毛利':
var gstrB_Profit:string='不可看成本毛利';
///全局变量“点选类权限-是否POS用户：”引用Ctl09003登录账号表10位='不是POS':
var gstrB_pos:string='不是POS'; //非POS
///全局变量“点选类权限-默认POS用户的仓位：”引用Ctl09003登录账号表store_struct_id仓位编码30位='所有仓位':
var gstrB_posStore_struct_id:string='所有仓位';
///全局变量“点选类权限-自定义的用户角色”引用Ctl09003登录账号表12位='未自定义角色':
var gstrGspFunction:string='未自定义角色';
///全局变量“查询类权限-是否只浏览自己的信息：”引用Ctl09003登录账号表8位='自己信息':
var gstrI_browse:string='自己信息'; //自己信息 他人信息
//请高手帮忙解决：MS SQL中存入文章超过1万字，字段类型该选哪个？现在用TEXT最多只能存2000汉字，varchar也试过了，最多只能存4000汉字，急急！
//MSSql的text类型别说存1万字，存1万个1万字也能存；另外用下面的语句设置一下：
//exec sp_configure 'max text repl size (B)', '655360' --调整长度限制为655360
//reconfigure --使配置生效
//SQL Server存取字符数很大字段的问题 https://www.cnblogs.com/arxive/p/5707619.html
//sqlite3数据库最大可以是多大？可以存放多少数据？读写性能怎么样？
//：https://blog.csdn.net/weixin_34290631/article/details/92962428
//SQLite的使用--SQLite语句：https://www.cnblogs.com/xiaotian666/p/5847185.html
//SQLite 命令：https://www.runoob.com/sqlite/sqlite-commands.html
//以下为Json格式字符串,类型:text存储可变长度的非Unicode数据,最大长度为2^31-1(2,147,483,647)个字符,按英文字符来算的话就是2G大小
//:但因为客户端组件的Cursor游标最多能装2M超出则会闪退,
//:所以在客户端组件装载该数据,可以用字符串截取后分页装载:
///全局变量“点选类权限-登录手机用户编码所对应的：用户组的部门权限”引用:
var gstrRightPowerJsonArrayCtl09005:string='';
///全局变量“点选类权限-登录手机用户编码所对应的：用户的仓位权限”引用:
var gstrRightPowerJsonArrayCtl09006:string='';
//---------------------以下非字段存取:-----------------------------------------------------
///全局变量“点选类权限-登录手机用户用户组访问通配权限的myfile.ini返回行数”引用Integer=6:
var gstrRightPowerJsonArrayCtl09105LinesCount:Integer=6;
///模块权限列表TStringList，只能随全局变量的计算调用一次，不可重复：gstrRightPowerJsonArrayCtl09105
var myRightPowerMemoList :TMemo;
///某个模块的权限字串myFMXObjTagRightPower，只能随全局变量的计算调用一次，不可重复：gstrRightPowerJsonArrayCtl09105
var myFMXObjTagRightPower :string;
///全局常量“系统管理员（超级用户）”引用Ctl09003中user_id的20位='001':
const gstrSysUser ='001';
type
TJsonToKener = Class(TObject)
private
JSonstr:UnicodeString; //JSonstr:WideString;
public
constructor Create;
destructor Destroy;Override;
procedure Addelement(Nodename,Nodevalue:String);
procedure Clearelement;
function ToStr:UnicodeString;
end;
type
///ChangeX进制转化及字符串编码类的函数及方法
ChangeX = object //:object代表程序类型为函数或过程的类
public
///10进制字符串转16进制字符串的ChangeX类函数:
class function DexToHex(ADexNum:String):string;
///16进制字符串转10进制字符串的ChangeX类函数:
class function HexToDex(AHexNum:String):string;
///字符串转Unicode编码字符串的ChangeX类函数:
class function StrToUnicodeStr(ADefultStr:String):string;
///Unicode编码字符串转字符串的ChangeX类函数:
class function UnicodeStrToStr(AUnicodeStr:String):string;
end;
TMyTreeView =Class(TTreeView)
private
///从外部引入的TTreeView:
FTreeView:TTreeView;
///从外部引入的TTreeView的TCustomImageList:
FImageList:TCustomImageList;
///TTreeView及其从外部数据库是否完成初始化:
FIFInited:Boolean;
///TTreeView从外部数据库加载的sql:
FSql:string;
///TTreeView是否展开所有节点,调用者初始化传入默认:=false:
FIFCollapse:Boolean;
///全选或取消全选TTreeView的所有TTreeViewItem节点:
FTreeViewSelectAllOrNot:Boolean;
///当前TTreeViewItem节点:
FTreeViewItemCurrt:TTreeViewItem;
///当前TTreeViewItem节点的父节点:
FTreeViewItemParent:TFmxObject;
///动态新增的TreeViewItem节点的Tag整数唯一标识赋值:
FTreeViewItemTag:Integer;
///父节点的子节点增加1个打勾CreateATreeViewItems初始化:
FTreeViewItemCheckedCount:TArray;
///父节点完成打勾(父已枚举)OnCreate调用者初始化传入:
FErgodicParent:string;
///加树还是编枝:
FAddWhoParent:string;
///当前窗体操作内存表FDMemTable_Main更新的总记录数:
FDMemTable_Main_UpdatedCount:Integer;
protected
public
published
///从外部引入的TTreeView:
LTreeView:TTreeView;
///从外部引入的TTreeView的TCustomImageList:
LImageList:TCustomImageList;
///TMyTreeView类的构造函数:
///注意:类方法和类构造函数中不能引用private受保护的类型:
constructor Create(AOwner: TComponent); override;
///类方法:TTreeView及其TreeViewItem属性的初始化:
///从外部引入的TTreeView:FTreeView:
///ATreeView的TImageList:
///:FIFInited:TTreeView是否在本类的内部完成初始化:
///返回是否完成初始化:
///注意:类方法和类构造函数中不能引用private受保护的类型:
class function InitATreeViewItems(
const ATreeView: TTreeView;
const AImageList: TCustomImageList=nil;
const AIFInited: Boolean=false ): Boolean; //:AIFInited调用者初始化传入默认:=false;
///类方法:TreeView动态加载外部数据源的字段值信息并生成动态新增的TreeViewItem节点:
///新增TTreeViewItem的索引号:
///新增TTreeViewItem的名称:
///新增TTreeViewItem的显示名:
///新增的TTreeViewItem对应的外部数据源的字段名:
///新增TTreeViewItem的父节点父组件:关键:父组件可以是TreeView,也可以是某个TreeViewItem节点:
///新增TTreeViewItem的TImageList,可:=nil:
///新增TTreeViewItem的TImageList中的图片索引号:
///新增TTreeViewItem的高Height:
///新增TTreeViewItem的宽Width:
///新增TTreeViewItem的左边界像素整数:
///新增TTreeViewItem的所有者:通常是调用窗体或TFrame:
/// 如果过程方法 InitATreeViewItems 在此函数中执行后 初始化 成功 则返回:TTreeViewItem
/// 这个函数对FMX及VCL均通用:注意:类方法和类构造函数中不能引用private受保护的类型
class function CreateATreeViewItems(
const AIndex: Integer;
AName:string;
AText: string;
ATreeFiledName:string;
AParent: TFmxObject;
AImageList: TCustomImageList;
ImageIndex: Integer;
ASizeHeight, ASizeWidth,
MarginsLeft: Single;
AOwnerObject: TFmxObject;
ATNotifyEvent:TNotifyEvent=nil
):TTreeViewItem;
///某个TreeViewItem节点的复选框被Check的状态改变的监测事件:
procedure OnChangeCheck(AItem:TObject);
//:protected TCustomTreeView.OnChangeCheck
///TreeView全部展开或全部收拢:
function DoExpandAllorCollapseAll(
ATreeView:TTreeView):Boolean;
end;
implementation
{$IFDEF MSWINDOWS}
uses
RegistryWin32 //:Win32注册表
,WinGetIP //:包含D:\PulledupO2O\myPublic\NetStatus\Windows
//,FileWriterMultyThreadU
//:多线程共享写日志文件资源//D:\开发测试\Samples\其它\myTestCode\DelphiCookbookThirdEdition\Chapter05\CODE\RECIPE01
;
{$ENDIF MSWINDOWS}
//uses ClientModuleUnit1;
//:千万别加，因为 服务器也要用此公共代码
{$IFDEF ANDROID}
// 通用调用手机应用的Intent和Uri：
procedure Call_URI(const AAction: JString; const AURI: string);
var
uri: Jnet_Uri;
Intent: JIntent;
begin
uri := StrToJURI(AURI);
Intent := TJIntent.JavaClass.init(AAction, uri);
SharedActivityContext.startActivity(Intent);
end;
// 获取本机所有联系人 ：
function FetchContactInfo(var aReturnStr:TStringList):TStringList;
var //主表：
uri: Jnet_Uri;
cursor: JCursor;
contactIdIndex: Integer; //联系人组ID
myCursorPosition,iCursorCounts,iFindCountCursor:Integer;
idDispname,findWondercontactIdStr: String; //联系人显示名
//从表：（联系人的详细信息data路径）
uriDetail: Jnet_Uri; cursorDetail: JCursor;
mycursorDetailPosition,icursorDetailCounts,iFindCountCursorDetail:Integer;
data1IdIndex: Integer; //某联系人组ID的data1的索引号
dataDetail,dataMimeType,datatype,findWonderDetailStr: String;
begin
//遍历循环需要很长时间：整个单元应当使用线程！！
uri := StrToJURI( 'content://com.android.contacts/raw_contacts' );
try
cursor := SharedActivity.getContentResolver
.query(uri, nil, nil, nil, nil);
except
raise Exception.Create('主表query错误');
end;
if cursor.getCount=0 then
begin
//showmessage('手机无联系人！');
exit;
end;
myCursorPosition:=0; iCursorCounts:=0; iFindCountCursor:=0;
cursor.moveToLast; iCursorCounts:=cursor.getPosition;
cursor.moveToFirst; findWondercontactIdStr:='';
while myCursorPosition <= iCursorCounts do//对所有联系人列表的循环
//while (cursor.moveToNext) do//:千万不能这样使用，否则会丢失第1笔数据
begin
contactIdIndex := cursor.getInt(
cursor.getColumnIndex(StringToJString('_id')) );
//cursor.getCount:联系人的组数：或办法，通过位置取出来：//IntToStr(iCursorCounts+1) ：
iFindCountCursor:=iFindCountCursor +1;
//Label1.Text:='共'+IntToStr(cursor.getCount)+'个联系人,'
//+'找到'+IntToStr(iFindCountCursor)+'个,索引号：'+IntToStr(contactIdIndex);
idDispname :=JStringToString(
cursor.getString(
cursor.getColumnIndex(StringToJString('display_name'))
) );
aReturnStr.Add('联系人索引号：'+IntToStr(contactIdIndex).Trim);
aReturnStr.Add('联系人显示名：'+idDispname.Trim);
//下面是联系人ididx的从表子路径IntToStr(contactIdIndex)下的/data子路径：
uriDetail:=StrToJURI('content://com.android.contacts/raw_contacts/'
+IntToStr(contactIdIndex)+'/data');
cursorDetail:=SharedActivity.getContentResolver
.query(uriDetail,nil,nil,nil,nil);
//下面写 获取联系人ididx的从表的data子路径（1列），data下面有很多子列字段：
//通过type类型：获取我们要的data子列的数据：
findWonderDetailStr:='';
mycursorDetailPosition:=0;//icursorDetailCounts:=0;iFindCountCursorDetail:=0;
data1IdIndex:=0;
cursorDetail.moveToFirst;
//对所有联系人列表的从表的循环：
while mycursorDetailPosition <= cursorDetail.getCount-1 do
//while (cursorDetail.moveToNext) do //:千万不能这样使用，否则会丢失第1笔数据！
begin
data1IdIndex:=cursorDetail.getColumnIndex(StringToJString('data1'));
if data1IdIndex>=0 then
dataDetail :=JStringToString(
cursorDetail.getString( data1IdIndex ) );
dataMimeType :=JStringToString(
cursorDetail.getString(
cursorDetail.getColumnIndex(StringToJString('mimetype')) ) );
//截取得到最后的列的数据类型:
datatype:=dataMimeType.Substring(dataMimeType.IndexOf('/')+1,length(dataMimeType));
if dataDetail.Trim<>'' then
// findWonderDetailStr:=findWonderDetailStr
// +'数据类型是：'+datatype+#13+#10+'数值是：'+dataDetail+#13+#10;
aReturnStr.Add('数据类型是：'+datatype.Trim);
aReturnStr.Add('数值是：'+dataDetail.Trim);
//如果只想取特定类型的字段：
//匹配是否为联系人名字：
//if datatype.Trim='name' then
//findWonderDetailStr:=findWonderDetailStr+'联系人姓名是：'+dataDetail+#13+#10;
//匹配是否为电话：
//if datatype.Trim='phone_v2' then
//findWonderDetailStr:=findWonderDetailStr+'电话号码是：'+dataDetail;
mycursorDetailPosition:=mycursorDetailPosition +1;
cursorDetail.moveToNext;
end;
// findWondercontactIdStr:=findWondercontactIdStr
// +#13+#10+'联系人索引号：'+IntToStr(contactIdIndex)
// +#13+#10+'联系人显示名：'+idDispname.Trim
// +#13+#10+findWonderDetailStr;
//游标用完关闭：非常重要：否则会消耗手机内存表资源，数据量大时，会在遍历过程中报未知错：
cursorDetail.close;
myCursorPosition:=myCursorPosition +1;
cursor.moveToNext;
end;
cursor.moveToFirst;
//游标用完关闭：非常重要：否则会消耗手机内存表资源，数据量大时，会在遍历过程中报未知错：
cursor.close;
//aReturnStr.Add(findWondercontactIdStr);
Result:=aReturnStr;
end;
// 打电话：
procedure PhoneCall(phoneNumber: string); // 打电话
//var
// phone: IFMXPhoneDialerService;
//begin
// if TPlatformServices.Current.SupportsPlatformService(IFMXPhoneDialerService,
// IInterface(phone)) then
// begin
// phone.Call(phoneNumber); //采用此，会方式导致程序运行后，如果手机打电话，会导致程序异常退出
// // 监听电话状态请用phone.OnCallStateChanged事件
// end;
var
uri: Jnet_Uri;
Intent: JIntent;
begin
uri := StrToJURI('tel:'+phoneNumber);
Intent := TJIntent.JavaClass.init(TJIntent.JavaClass.ACTION_CALL, uri);//直接拨打电话
try
SharedActivity.startActivity(Intent);
except
on e: Exception do
begin
ShowMessage('错误: ' + e.Message);
end;
end;
end;
//Andoid获取本机号码:大多获取不了，运营商为写入SIM卡
function myPhoneNumber:string;
var TelephonyServiceNative: JObject;
LPhoneNumber:string;
begin
// AndoidRequestPermissions('网络状态');
// AndoidRequestPermissions('WIFI状态');
TelephonyServiceNative := SharedActivityContext.getSystemService
(TJContext.JavaClass.TELEPHONY_SERVICE);
if Assigned(TelephonyServiceNative) then
TelephonyManager := TJTelephonyManager.Wrap
((TelephonyServiceNative as ILocalObject).GetObjectID);
LPhoneNumber:=JStringToString(TelephonyManager.getLine1Number);//:取得手机号
if LPhoneNumber.Trim='' then
Result:=''//JStringToString(TelephonyManager.getMeid)
else Result:=LPhoneNumber;
end;
function GetAndroidMEID: string;
//获取Android手机的MEID号(即设备的ID非运营商的入网号):
{$IFDEF ANDROID}
var
obj: JObject;
tm: JTelephonyManager;
MEID: String;
{$ENDIF}
begin
{$IFDEF ANDROID}
// AndoidRequestPermissions('网络状态');
// AndoidRequestPermissions('WIFI状态');
obj := SharedActivityContext.getSystemService
(TJContext.JavaClass.TELEPHONY_SERVICE);
if obj <> nil then
begin
tm := TJTelephonyManager.Wrap((obj as ILocalObject).GetObjectID);
if tm <> nil then
MEID := JStringToString(tm.getMeid);
end;
Result := MEID;
{$ELSE}
Result:='';
{$ENDIF}
end;
function GetAndroidIMEI: string;
//即SIM卡串号(运营商的入网号):
{$IFDEF ANDROID}
var
obj: JObject;
tm: JTelephonyManager;
IMEI: String;
{$ENDIF}
begin
{$IFDEF ANDROID}
// AndoidRequestPermissions('网络状态');
// AndoidRequestPermissions('WIFI状态');
obj := SharedActivityContext.getSystemService
(TJContext.JavaClass.TELEPHONY_SERVICE);
if obj <> nil then
begin
tm := TJTelephonyManager.Wrap((obj as ILocalObject).GetObjectID);
if tm <> nil then
IMEI := JStringToString(tm.getDeviceId);
end;
// if IMEI = '' then
// IMEI := JStringToString(TJSettings_Secure.JavaClass.getString
// (SharedActivity.getContentResolver,
// TJSettings_Secure.JavaClass.ANDROID_ID) );
Result := IMEI;
{$ELSE}
Result:='';
{$ENDIF}
end;
// 获取Android手机SIM卡串号：
function GetSN: string; // 获取Android手机SIM卡串号
var
TelephonyServiceNative: JObject;
begin
// AndoidRequestPermissions('网络状态');
// AndoidRequestPermissions('WIFI状态');
TelephonyServiceNative := SharedActivityContext.getSystemService
(TJContext.JavaClass.TELEPHONY_SERVICE);
if Assigned(TelephonyServiceNative) then
TelephonyManager := TJTelephonyManager.Wrap
((TelephonyServiceNative as ILocalObject).GetObjectID);
Result:=JStringToString(TelephonyManager.getDeviceId);//:取得SIM卡串号
end;
// 直接没有任何提示的发长短信：
procedure SentSMS(phoneNumber, SMSstring: string);
//'直接没有任何提示的发长短信www.pulledup.cn' :
//不能超过70个字：否则函数自动先做分割后，分别发：
//收短信：是一次性1条收看的：
var
jm:JSmsManager;
smsTo:JString;
Parts:JArraylist;
begin
//jm := TJSmsManager.Create; //:错误,问题见下：
//::下面这样做Android直发短信不通过手机Intent和uri：
//否则上面那样Android4无问题，6会闪退:
jm:=TJSmsManager.JavaClass.getDefault;
smsTo:=StringToJString(phoneNumber);
parts:=jm.divideMessage(StringToJString(SMSstring));
jm.sendMultipartTextMessage(smsTo, nil,Parts, nil, nil);
end;
// 调用系统程序发短信：
procedure SentSMSfromIntent(phoneNumber, SMSstring: string);
var
uri: Jnet_Uri;
Intent: JIntent;
begin
uri := StrToJURI('smsto:' + phoneNumber);
Intent := TJIntent.JavaClass.init(TJIntent.JavaClass.ACTION_SENDTO, uri);
Intent.putExtra(StringToJString('sms_body'),
StringToJString(SMSstring));
SharedActivityContext.startActivity(Intent);
end;
// 短信收件箱列表：
function FetchSms: string;
var
myResult:string; myCursorPosition,iCursorCounts,iFindCountCursor:Integer;
cursor: JCursor;
uri: Jnet_Uri;
address, person, msgdatesent, protocol, msgread, msgstatus, msgtype,
msgreplypathpresent, Subject, body, servicecenter, locked: string;
msgunixtimestampms: int64;
contactIdIndex, idhuihuaidx, addressidx, personidx, msgdateidx, msgdatesentidx,
protocolidx, msgreadidx, msgstatusidx, msgtypeidx, msgreplypathpresentidx,
subjectidx, bodyidx, servicecenteridx, lockedidx: integer;
begin
myResult:=''; myCursorPosition:=0; iCursorCounts:=0; iFindCountCursor:=0;
uri := StrToJURI('content://sms/inbox'); // 收件箱
//提取短信列表中最早的1条短信的内容content：
cursor := SharedActivity.getContentResolver.query(uri, nil, nil, nil, nil);
(* //managedQuery :高勇自己改写的
cursor := SharedActivity.managedQuery(uri,
// StrToJURI('content://sms/')所有短信，含发件箱,发件箱为StrToJURI('content://sms/sent')
//nil, StringToJString('1=1 and read=0) group by (address'), //查看没有读过的短信
nil, StringToJString('1=1) group by (address'), //查看所有收到的短信
// 类似于SQL语句,注意，括号只有一半，原因是它已经有一对括号了
nil, StringToJString('date asc')); // desc 降序
// 以上执行的语句是：SELECT * FROM sms WHERE (type=1) AND (1=1) group by (address) order by date asc
//*)
if cursor.getCount=0 then
begin
showmessage('符合条件的短信数量为0。');
exit;
end;
cursor.moveToLast; iCursorCounts:=cursor.getPosition;
cursor.moveToFirst;
//for myCursorPosition := 0 to cursor.getPosition do
while myCursorPosition <= iCursorCounts do//对所有短信的循环
begin
//cursor.moveToFirst; //cursor.move(4); // 最后一条:moveToLast
contactIdIndex := cursor.getInt(cursor.getColumnIndex(StringToJString('_id')));
// 得到当前短信的id号
idhuihuaidx := cursor.getLong(1); // 短信会话的ID号，如果删除这个，则整个短信会话都会被删除
addressidx := cursor.getColumnIndex(StringToJString('address')); // 电话
//if ( JStringToString(cursor.getString(addressidx)) ='18980851626') then
begin
iFindCountCursor:=iFindCountCursor +1;
//Label1.Text:='共'+IntToStr(iCursorCounts+1)+'条,'
//+'找到了：'+iFindCountCursor.ToString+'条';
personidx := cursor.getColumnIndex(StringToJString('person'));
msgdateidx := cursor.getColumnIndex(StringToJString('date'));
msgdatesentidx := cursor.getColumnIndex(StringToJString('date_sent'));
protocolidx := cursor.getColumnIndex(StringToJString('protocol'));
msgreadidx := cursor.getColumnIndex(StringToJString('read'));
msgstatusidx := cursor.getColumnIndex(StringToJString('status'));
msgtypeidx := cursor.getColumnIndex(StringToJString('type'));
msgreplypathpresentidx := cursor.getColumnIndex
(StringToJString('reply_path_present'));
subjectidx := cursor.getColumnIndex(StringToJString('subject'));
bodyidx := cursor.getColumnIndex(StringToJString('body'));
servicecenteridx := cursor.getColumnIndex(StringToJString('service_center'));
lockedidx := cursor.getColumnIndex(StringToJString('locked'));
address := JStringToString(cursor.getString(addressidx));
person := JStringToString(cursor.getString(personidx));
msgunixtimestampms := cursor.getLong(msgdateidx);
msgdatesent := JStringToString(cursor.getString(msgdatesentidx));
protocol := JStringToString(cursor.getString(protocolidx));
msgread := JStringToString(cursor.getString(msgreadidx));
msgstatus := JStringToString(cursor.getString(msgstatusidx));
msgtype := JStringToString(cursor.getString(msgtypeidx));
msgreplypathpresent := JStringToString
(cursor.getString(msgreplypathpresentidx));
Subject := JStringToString(cursor.getString(subjectidx));
body := JStringToString(cursor.getString(bodyidx));
servicecenter := JStringToString(cursor.getString(servicecenteridx));
locked := JStringToString(cursor.getString(lockedidx));
myResult:=myResult+ #13+#10
+IntToStr(trunc(msgunixtimestampms / 1000)) + #13+#10
+ '收件箱中发件人的号码：' +#13+#10+ address +#13+#10
+ 'person：' + person + #13+#10 + 'msgdatesent：' + msgdatesent + #13+#10 +
'protocol：' + protocol + #13+#10 + 'msgread：' + msgread + #13+#10 + 'msgstatus：' +
msgstatus + #13+#10 + 'msgtype：' + msgtype + #13+#10 + 'msgreplypathpresent：' +
msgreplypathpresent + #13+#10 + 'Subject：' + Subject + #13 + 'servicecenter：' +
servicecenter + #13+#10 + 'locked：' + locked + #13+#10
+ '内容：' + body+ #13+#10;
end;
myCursorPosition:=myCursorPosition +1;
cursor.moveToNext;
//if (cursor.isLast) then exit;
end;
Result := myResult;
//删除会话idhuihuaidx，即同一个号码的所有短信：
// SharedActivity.getContentResolver.delete(
// StrToJURI('content://sms/conversations/' + IntToStr(idhuihuaidx) ), nil, nil );
// 删除这个联系人组的contactIdIndex的短信：
// SharedActivity.getContentResolver.delete(
// StrToJURI('content://sms'),StringToJString('_id='+inttostr(contactIdIndex) ), nil);
end;
procedure ToInstallApk70Down(Apk: string);
//Andoid7.0及其以下安装apk:
var
LFile: JFile;
LIntent: JIntent;
begin
try
LFile := TJFile.JavaClass.init(StringToJString(ExtractFilePath(Apk)), StringToJstring(ExtractFileName(Apk)));
LIntent := TJIntent.Create;
LIntent.setAction(TJIntent.JavaClass.ACTION_VIEW);
LIntent.addFlags(TJIntent.JavaClass.FLAG_ACTIVITY_NEW_TASK);
LIntent.setDataAndType(TJnet_Uri.JavaClass.fromFile(LFile), StringToJString('application/vnd.android.package-archive'));
TAndroidHelper.Context.startActivity(LIntent);
except
end;
end;
procedure ToInstallApk(Apk: string);
//Andoid安装apk:
var
LFile: JFile;
LIntent: JIntent;
LNet_Uri: Jnet_Uri;
begin
if not TOSVersion.Check(7, 0) then
begin
ToInstallApk70Down(Apk);
Exit;
end;
LFile := TJFile.JavaClass.init(StringToJString(ExtractFilePath(Apk)), StringToJstring(ExtractFileName(Apk)));
LIntent := TJIntent.Create;
if TOSVersion.Check(8, 0) then
LIntent.setAction(TJIntent.JavaClass.ACTION_INSTALL_PACKAGE)
else
LIntent.setAction(TJIntent.JavaClass.ACTION_VIEW);
LIntent.addFlags(TJIntent.JavaClass.FLAG_ACTIVITY_NEW_TASK);
if TOSVersion.Check(7, 0) then
begin
// fix: android.os.FileUriExposedException: exposed beyond app through Intent.getData()
// Project -> Options -> Application -> Entitlement List -> Secure File Sharing -> Check it
// :8.0以上要在manifest里加权限:
// :Android请求权限的全局变量:
MyPermissions: TArray;
RequestPermissionsLenth:Integer;
begin
try
//Pos('读文件',RequestPermissions)>0 //:System.SysUtils.TStringHelper
//if (RequestPermissions.Trim).IndexOf('摄像头',0,length((RequestPermissions.Trim)))>=0 then
if length(RequestPermissions)>0 then
for RequestPermissionsLenth := Low(RequestPermissions) to High(RequestPermissions) do
begin
if (RequestPermissions[RequestPermissionsLenth])='摄像头' then
begin
try
FCAMERA := JStringToString(
TJManifest_permission.JavaClass
.CAMERA);
SetLength(MyPermissions, Length(MyPermissions)+1);
MyPermissions[Length(MyPermissions)-1]:= FCAMERA;
except
end;
end; {
if (RequestPermissions[RequestPermissionsLenth])='前台服务安装应用' then
begin
try
FINSTANT_APP_FOREGROUND_SERVICE := JStringToString(
TJManifest_permission.JavaClass
.INSTANT_APP_FOREGROUND_SERVICE);
SetLength(MyPermissions, Length(MyPermissions)+1);
MyPermissions[Length(MyPermissions)-1] := FINSTANT_APP_FOREGROUND_SERVICE;
except
end;
end;
if (RequestPermissions.Trim)='安装应用' then
begin
try
LPermission := JStringToString(
TJManifest_permission.JavaClass
.REQUEST_INSTALL_PACKAGES);
SetLength(MyPermissions, Length(MyPermissions)+1);
MyPermissions[Length(MyPermissions)-1] := LPermission;
except
end;
end;
if (RequestPermissions.Trim)='全局搜索' then
begin
try
LPermission := JStringToString(
TJManifest_permission.JavaClass
.GLOBAL_SEARCH);
SetLength(MyPermissions, Length(MyPermissions)+1);
MyPermissions[Length(MyPermissions)-1] := LPermission;
except
end;
end; }
if (RequestPermissions[RequestPermissionsLenth])='管理文档' then
begin
try
FMANAGE_DOCUMENTS := JStringToString(
TJManifest_permission.JavaClass
.MANAGE_DOCUMENTS);
SetLength(MyPermissions, Length(MyPermissions)+1);
MyPermissions[Length(MyPermissions)-1] := FMANAGE_DOCUMENTS;
except
end;
end;
if (RequestPermissions[RequestPermissionsLenth])='读取文件' then
begin
try
FREAD_EXTERNAL_STORAGE := JStringToString(
TJManifest_permission.JavaClass
.READ_EXTERNAL_STORAGE);
SetLength(MyPermissions, Length(MyPermissions)+1);
MyPermissions[Length(MyPermissions)-1] := FREAD_EXTERNAL_STORAGE;
except
end;
end;
if (RequestPermissions[RequestPermissionsLenth])='写入文件' then
begin
try
FWRITE_EXTERNAL_STORAGE := JStringToString(
TJManifest_permission.JavaClass
.WRITE_EXTERNAL_STORAGE);
SetLength(MyPermissions, Length(MyPermissions)+1);
MyPermissions[Length(MyPermissions)-1] := FWRITE_EXTERNAL_STORAGE;
except
end;
end; {
if (RequestPermissions.Trim)='读取手机状态' then
begin
try
LPermission := JStringToString(
TJManifest_permission.JavaClass
.READ_PHONE_STATE);
SetLength(MyPermissions, Length(MyPermissions)+1);
MyPermissions[Length(MyPermissions)-1] := LPermission;
except
end;
end;
if (RequestPermissions.Trim)='INTERNET' then
begin
try
LPermission := JStringToString(
TJManifest_permission.JavaClass
.INTERNET);
SetLength(MyPermissions, Length(MyPermissions)+1);
MyPermissions[Length(MyPermissions)-1] := LPermission;
except
end;
end;
if (RequestPermissions.Trim)='网络状态' then
begin
try
//LhashCode:=JObjectClass(
//TJManifest_permission.JavaClass
//._GetACCESS_NETWORK_STATE ).init.hashCode;
LPermission := JStringToString(
TJManifest_permission.JavaClass
.ACCESS_NETWORK_STATE);
SetLength(MyPermissions, Length(MyPermissions)+1);
MyPermissions[Length(MyPermissions)-1] := LPermission;
except
end;
end;
if (RequestPermissions.Trim)='WIFI状态' then
begin
try
LPermission := JStringToString(
TJManifest_permission.JavaClass
.ACCESS_WIFI_STATE);
SetLength(MyPermissions, Length(MyPermissions)+1);
MyPermissions[Length(MyPermissions)-1] := LPermission;
except
end;
end;
if (RequestPermissions.Trim)='在其他应用上层显示' then
begin //比如:点播播放器悬浮窗权限
try
LPermission := JStringToString(
TJManifest_permission.JavaClass
.SYSTEM_ALERT_WINDOW);
SetLength(MyPermissions, Length(MyPermissions)+1);
MyPermissions[Length(MyPermissions)-1] := LPermission;
except
end;
end;
if (RequestPermissions.Trim)='允许访问通知策略' then
begin
try
LPermission := JStringToString(
TJManifest_permission.JavaClass
.ACCESS_NOTIFICATION_POLICY);
SetLength(MyPermissions, Length(MyPermissions)+1);
MyPermissions[Length(MyPermissions)-1] := LPermission;
except
end;
end;
if (RequestPermissions.Trim)='请求绑定通知监听服务' then
begin
try
LPermission := JStringToString(
TJManifest_permission.JavaClass
.BIND_NOTIFICATION_LISTENER_SERVICE);
SetLength(MyPermissions, Length(MyPermissions)+1);
MyPermissions[Length(MyPermissions)-1] := LPermission;
except
end;
end;
if (RequestPermissions.Trim)='允许一个APP伴侣程序在后台运行' then
begin
try
LPermission := JStringToString(
TJManifest_permission.JavaClass
.REQUEST_COMPANION_RUN_IN_BACKGROUND);
SetLength(MyPermissions, Length(MyPermissions)+1);
MyPermissions[Length(MyPermissions)-1] := LPermission;
except
end;
end;
if (RequestPermissions.Trim)='允许一个APP伴侣程序在后台使用数据' then
begin
try
LPermission := JStringToString(
TJManifest_permission.JavaClass
.REQUEST_COMPANION_USE_DATA_IN_BACKGROUND);
SetLength(MyPermissions, Length(MyPermissions)+1);
MyPermissions[Length(MyPermissions)-1] := LPermission;
except
end;
end;
if (RequestPermissions.Trim)='写系统配置' then
begin
try
LPermission := JStringToString(
TJManifest_permission.JavaClass
.WRITE_SETTINGS);
SetLength(MyPermissions, Length(MyPermissions)+1);
MyPermissions[Length(MyPermissions)-1] := LPermission;
except
end;
end;
if (RequestPermissions.Trim)='绑定条件提供者服务' then
begin
try
LPermission := JStringToString(
TJManifest_permission.JavaClass
.BIND_CONDITION_PROVIDER_SERVICE);
SetLength(MyPermissions, Length(MyPermissions)+1);
MyPermissions[Length(MyPermissions)-1] := LPermission;
except
end;
end;
if (RequestPermissions.Trim)='绑定设备管理' then
begin
try
LPermission := JStringToString(
TJManifest_permission.JavaClass
.BIND_DEVICE_ADMIN);
SetLength(MyPermissions, Length(MyPermissions)+1);
MyPermissions[Length(MyPermissions)-1] := LPermission;
except
end;
end; //}
end;
except
end;
// 调用方法：动态请求所有程序需要用到的权限,根据需要您可以减少:
// PermissionsService.RequestPermissions([FPermissionCAMERA, FPermissionREAD_EXTERNAL_STORAGE, FPermissionWRITE_EXTERNAL_STORAGE, FPermissionREAD_PHONE_STATE, FPermissionACCESS_NETWORK_STATE,
// FPermissionBLUETOOTH_ADMIN, FPermissionBLUETOOTH, FPermissionACCESS_WIFI_STATE, FPermissionVIBRATE, FPermissionRECORD_AUDIO, FPermissionRECEIVE_SMS, FPermissionCALL_PHONE, FPermissionREAD_SMS,
// FPermissionACCESS_FINE_LOCATION, FPermissionINSTALL_PACKAGES, FPermissionINTERNET, FPermissionSEND_SMS, FPermissionWRITE_CONTACTS, FPermissionACCESS_LOCATION_EXTRA_COMMANDS,
// FPermissionREAD_PHONE_NUMBERS, FPermissionREAD_CONTACTS], nil, nil);
PermissionsService.RequestPermissions(
MyPermissions,
nil,
nil
); //System.Permissions
//Result:=//IntToStr(LhashCode)+':'+
IntToStr(Length(MyPermissions));
end;
{$ENDIF Android}
//一、记住Delphi移动编译器的字符串数组都是从0位开始的:///
//1-based字符串转换到0-based 的函数
//如何修改1-based字符串的例子，适用所有平台：
function strConvt1To0(const S: string): string;
var I, L: Integer;
begin //与原始函数：Trim 有区别
L := Length(S);
I := 1;
if (L > 0) and (S[I] > ' ') and (S[L] > ' ') then Exit(S);
while (I <= L) and (S[I] <= ' ') do Inc(I);
if I > L then Exit('');
while S[L] <= ' ' do Dec(L);
Result := Copy(S, I, L - I + 1);
end;
procedure myItems_Delimiter(myStr:String; myDelimiter:Char;
mySplitStrL:TStringList);
//02、字符串被myDelimiter字符符号分隔符分割的数值获取，
//并将其赋值给一个 TStringList ：
var strs :TStrings; //抽象 字符集合
i,myS1,myS2 :Integer; //有i个分隔符 ，就有i组数据
myDelimiter_return:string; //分别存放myStr分割的每一组字符串
begin
//开始计算被分隔符分割的信息
strs := TStringList.Create;
//strs.Delimiter := ','; //设置分割字符
strs.Delimiter := myDelimiter; //：客制化设置分割字符
strs.DelimitedText := (myStr.trim); //::::给被分割的 字符串赋值
mySplitStrL.clear;
for i := 0 to Strs.Count-1 do
begin
if not ( (Strs[i].trim)='' ) then
begin
myDelimiter_return:= (Strs[i].trim);
mySplitStrL.Add(myDelimiter_return);
end;
end;
strs.Free;
end;
procedure myVKeyboard(aFmxObject:TFmxObject; aControlStr:String);
begin
//事实上，高版本POSIX焦点移到输入控件，即可显示：
//事实上，高版本POSIX焦点移开至非输入按钮等，即可关闭：
aKeyboard:=TPlatformServices.Current
.GetPlatformService(IFMXVirtualKeyboardService)
as IFMXVirtualKeyboardService;
if aControlStr='显示' then
aKeyboard.ShowVirtualKeyboard(aFmxObject) //显示虚拟键盘
else if aControlStr='关闭' then aKeyboard.HideVirtualKeyboard;//隐藏虚拟键盘
end;
function compareOldNew(Field: TField): boolean; overload;
begin
//::TField : uses Data.DB
//Varisnull : uses System.Variants
if VarIsnull(Field.OldValue) then
result := false
else
if Field.DataType in [ftString,ftWideString] then
begin
if VarToStr(Field.OldValue).Trim <> VarToStr(Field.NewValue).Trim then
result := false
else
result := true;
end else
if Field.OldValue <> Field.NewValue then
result := false
else
result := true;
end;
function compareOldNew(aFDMemTable: TFDMemTable): Boolean; overload;
var icount:integer; //icount:aFDMemTable字段数
sFieldNotChaged:Boolean;
begin
//TField : uses Data.DB
//::TFDMemTable : uses FireDAC.Comp.Client
sFieldNotChaged:=true;
for icount:=0 to aFDMemTable.Fields.Count-1 do
begin
if compareOldNew(aFDMemTable.Fields[icount])=false then
begin
sFieldNotChaged:=false;
Exit(sFieldNotChaged); //符合条件即返回
end;
end;
Result := sFieldNotChaged;
end;
function compareOldNew(AString,BString: String): Boolean; overload;
begin
if AString.Trim=BString.Trim then
Result:=true
else Result:=false;
end;
function GetStrGBOfByteCount(Data: String): Integer;
var
Encoding: TEncoding;
begin
Encoding := TEncoding.GetEncoding('GB2312'); //GB2312
Result := Encoding.GetCharCount(Encoding.GetBytes(Data));
end;
function FillBeforeString(const SourceStr: string;
Len: Integer; FillStr: string): string;
//函数功能：当Str不满Len长度时，在Str前自动填充FillStr以补足长度:
var iCircle:Integer; TargetStr: string;
begin
TargetStr:='';
//for iCircle := 1 to Len - GetStrGBOfByteCount(SourceStr.trim) do
for iCircle := 1 to Len - length(SourceStr.trim) do
TargetStr:= TargetStr+ FillStr ;
//if odd( GetStrGBOfByteCount(SourceStr.trim) )=true then //奇数
//TargetStr:= TargetStr+ ' ';
Result:= TargetStr + SourceStr ;
end;
//函数功能：当Str不满Len长度时，在Str后自动填充FillStr以补足长度
function FillAfterString(const SourceStr: string; Len: Integer; FillStr: string): string;
var iCircle_ZH,iCircle_EN:Integer; TargetStr: string;
begin
TargetStr:='';
StringReplace (SourceStr.trim, ' ', '_', [rfReplaceAll, rfIgnoreCase]);
if length(SourceStr.trim)<=Len then
begin
//for iCircle_ZH := 1 to Len - GetStrGBOfByteCount(SourceStr.trim) do
for iCircle_ZH := 1 to Len - length(SourceStr.trim) do
begin
//先补差的中文字符：
TargetStr:= TargetStr+ FillStr+ FillStr ; //：补2个单字符FillStr
//再补非中文字符：
if ifSingleByte(SourceStr.Trim)>0 then //:存在非中文字符
begin
for iCircle_EN := 1 to ifSingleByte(SourceStr.Trim) do
begin
TargetStr:= TargetStr+ FillStr ; //：补1个单字符FillStr
end;
end;
end;
end;
Result:= SourceStr.trim + TargetStr ;
end;
function ifSingleByte(sString: string=''):Integer;
var s :string; myBytes:TBytes; Encoding: TEncoding;
var j,k:Integer;
begin
s:=''; k:=0;
Encoding := TEncoding.GetEncoding('GB2312');
myBytes := Encoding.GetBytes(sString.trim);
for j := 0 to ByteLength(sString)-1 do
begin
if (Encoding.GetString(myBytes[j])<>'?')
and (Encoding.GetString(myBytes[j])<>'r')
and (Encoding.GetString(myBytes[j])<>#13)
and (Encoding.GetString(myBytes[j])<>#10)
then
begin
k:=k+1;
s:=s+Encoding.GetString(myBytes[j]); //单字符顺序连接
end;
//+'单字符的字节总数：'+IntToStr(ByteLength(s.trim))
//+#13#10;
end;
(*
ShowMessage((s.trim+':单字符的字节总数='+IntToStr(ByteLength(s.trim)).trim )+#13#10
+(s.trim+':单字符总数='+IntToStr(length(s.trim)).trim )
); //*)
Result:=( k div 2);
//Result:=ByteLength(s.trim);
end;
function getOsArchVer(const AInfoType:string=''):string;
//11、求当前进程实例的操作系统平台、CPU架构、版本信息,用","和";"分割：
var
LOutputStr:String;
begin
LOutputStr:='';
if AInfoType<>'' then
begin //'详细信息':
if TOSVersion.Platform=TOSVersion.TPlatform.pfWindows then
LOutputStr:='平台:'+'pfWindows,'
else if TOSVersion.Platform=TOSVersion.TPlatform.pfAndroid then
LOutputStr:='平台:'+'pfAndroid,'
else if TOSVersion.Platform=TOSVersion.TPlatform.pfiOS then
LOutputStr:='平台:'+'pfiOS,'
else if TOSVersion.Platform=TOSVersion.TPlatform.pfMacOS then
LOutputStr:='平台:'+'pfMacOS,'
else if TOSVersion.Platform=TOSVersion.TPlatform.pfWinRT then
LOutputStr:='平台:'+'pfWinRT,'
else if TOSVersion.Platform=TOSVersion.TPlatform.pfLinux then
LOutputStr:='平台:'+'pfLinux,'
;
LOutputStr:=LOutputStr
+'版本名称:'+TOSVersion.Name+','
;
if TOSVersion.Architecture=TOSVersion.TArchitecture.arIntelX86 then
LOutputStr:=LOutputStr+'CPU架构:'+'arIntelX86,'
else if TOSVersion.Architecture=TOSVersion.TArchitecture.arIntelX64 then
LOutputStr:=LOutputStr+'CPU架构:'+'arIntelX64,'
else if TOSVersion.Architecture=TOSVersion.TArchitecture.arARM32 then
LOutputStr:=LOutputStr+'CPU架构:'+'arARM32,'
else if TOSVersion.Architecture=TOSVersion.TArchitecture.arARM64 then
LOutputStr:=LOutputStr+'CPU架构:'+'arARM64,'
;
LOutputStr:=LOutputStr
+'主版本号:'+TOSVersion.Major.ToString+';'
+'小版本号:'+TOSVersion.Minor.ToString+';'
+'发行版本号:'+TOSVersion.Build.ToString+','
;
LOutputStr:=LOutputStr
+'主服务包编号:'+TOSVersion.ServicePackMajor.ToString+';'
+'小服务包编号:'+TOSVersion.ServicePackMinor.ToString+''
;
end else
begin //'概要信息':
LOutputStr:=LOutputStr
+TOSVersion.ToString+',';
if TOSVersion.Architecture=TOSVersion.TArchitecture.arIntelX86 then
LOutputStr:=LOutputStr+'CPU架构'+'(IntelX86)'
else if TOSVersion.Architecture=TOSVersion.TArchitecture.arIntelX64 then
LOutputStr:=LOutputStr+'CPU架构'+'(IntelX64)'
else if TOSVersion.Architecture=TOSVersion.TArchitecture.arARM32 then
LOutputStr:=LOutputStr+'CPU架构'+'(ARM32)'
else if TOSVersion.Architecture=TOSVersion.TArchitecture.arARM64 then
LOutputStr:=LOutputStr+'CPU架构'+'(ARM64)'
end;
Result:=LOutputStr;
end;
function getBytesCountOfStr(var Text:string):Integer;
var Encoding:TEncoding;
begin
//字符集编码://Encoding := TEncoding.GetEncoding('UTF8'); //GB2312
Encoding := TEncoding.Unicode;
//按上述定义的字符集编码方式，将字符串Text转化一遍：
//先将String：GetBytes->TBytes,再TBytes->String
Result:=Encoding.GetCharCount( Encoding.GetBytes(Text) );
end;
function IsMobileNumber(var Text:string;
const opermode:string; const ifReturnError:string): string;
var Encoding:TEncoding;
sNum,myPhoneNum,Str1Num,aStr3to11,errorInfo:string;
iCircle,ByteCount:Integer;
Byte1Num:Byte;
begin
//字符集编码://Encoding := TEncoding.GetEncoding('UTF8'); //GB2312
Encoding := TEncoding.Unicode;
//按上述定义的字符集编码方式，将字符串Text转化一遍：
//先将String：GetBytes->TBytes,再TBytes->String
Encoding.GetString( Encoding.GetBytes(Text) );
//正则表达式电话号码: 1[3|5|7|8]d\9
Result := errorInfo;
errorInfo:=''; aStr3to11:='';
if opermode.Trim='输入验证' then //分流结果验证、输入验证
begin
Text:=Text;//strConvt1To0(Text); //:千万不能用！
if (length(Text)=1) then
if (Text <> '1') then
//if (Text.Substring(0, 1) <> '1') then
begin
Text:='';
errorInfo:='手机号码错误：'+#13+#10+'第1位数字应为:1';
end else myPhoneNum:=Text.Trim;
if (length(Text)=2) then
//if (Text.Substring(0, 2) <> '13')
if (Text.Substring(1, 1) <> '3')
and (Text.Substring(1, 1) <> '4')
and (Text.Substring(1, 1) <> '5')
and (Text.Substring(1, 1) <> '7')
and (Text.Substring(1, 1) <> '8') then
begin
//Text:=Text.Substring(0, 1);
Text:=Text.Substring(0, 1);
errorInfo:='手机号码错误：'+#13+#10+'第2位数字:3或4或5或7或8';
end else myPhoneNum:=myPhoneNum+Text.Trim;
sNum:='0123456789';
if (length(Text)>2) and (length(Text)<=11) then
begin
ByteCount:=0;
for aStr3to11 in sNum do
begin
if (Text.Substring(length(Text)-1, 1 ) <> aStr3to11) then
INC(ByteCount);
if ByteCount=10 then
begin
Text:=Text.Substring(0, length(Text)-1 );
errorInfo:='手机号码错误：'+#13+#10+'第3~11位数字:0~9任意数字';
end else myPhoneNum:=myPhoneNum+Text.Trim;
end;
end;
if (length(Text)>11) then
begin
Text:=Text.Substring(0, 11 );
errorInfo:='手机号码错误：'+#13+#10+'总长度不能超过11位';
end;
end;
if opermode.Trim='结果验证' then
begin
////1-based字符串转换到0-based 的函数: .Trim .Substring(0, 1)
sNum:='0123456789';
myPhoneNum:=Text.Trim;//strConvt1To0(Text.Trim); //不乱用！
if (myPhoneNum.Substring(0, 1) <> '1') then
begin //Text:='';
errorInfo:='手机号码错误：'+#13+#10+'第1位数字应为:1';
end;
if (myPhoneNum.Substring(0, 2) <> '13')
and (myPhoneNum.Substring(0, 2) <> '14')
and (myPhoneNum.Substring(0, 2) <> '15')
and (myPhoneNum.Substring(0, 2) <> '17')
and (myPhoneNum.Substring(0, 2) <> '18') then
begin //Text:=Text.Substring(0, 1);
errorInfo:=errorInfo+#13+#10+'第2位数字:3或4或5或7或8';
end;
for iCircle := 3 to 11 do //后9位 11
begin
//Byte1Num :Byte; ord(1位字符串：即字符)
//char(ASCII码):0~9的Byte(10进制，范围0~255)：48~57
(*
if length(Str1Num)=1 then
Byte1Num:=ord( Str1Num[1] );
if not( Byte1Num in [48..57] ) then
begin errorInfo:=errorInfo+chr(Byte1Num)+#13+#10;
errorInfo:=errorInfo+#13+#10
+'第'+IntToStr(iCircle)+'位错误，应为0~9任意数字'+#13+#10;
//Text:=Text.Substring(0, iCircle-1 );
end; *)
Str1Num:=(myPhoneNum.Substring(iCircle-1, 1));
ByteCount:=0;
for aStr3to11 in sNum do
begin
if (Str1Num <> aStr3to11) then
INC(ByteCount);//ByteCount:=ByteCount+1;
end;
if ByteCount=10 then
errorInfo:=errorInfo+#13+#10
+'第'+IntToStr(iCircle)+'位错误，应为0~9任意数字';
end;
if length(myPhoneNum.Trim)>11 then
begin
Text:=Text.Substring(0, 11 );
errorInfo:=errorInfo.Trim+#13+#10+'总长度不能超过11位';
end;
end;
if errorInfo='' then Result :='正确' else
begin
//比如：返回错误信息:
if ifReturnError.Trim<>'' then ShowMessage(errorInfo.Trim);
Result := errorInfo;
errorInfo:='';
end;
//在Delphi 2005就已經加入了
//For element in collection do statement語法，
//可以用來歷遍一個集合、數組等等,
//下面這個是For in 支持的類型:
// Classes.TList
// Classes.TCollection
// Classes.TStrings
// Classes.TInterfaceList
// Classes.TComponent
// Menus.TMenuItem
// ActnList.TCustomActionList
// Data.DB.TFields
// ComCtrls.TListItems
// ComCtrls.TTreeNodes
end;
function RandomVerificCode: string;
//产生预发送的随机的4位数字验证码:
var iCircle:Integer; ResultStr: string;
begin
ResultStr:='';
for iCircle := 1 to 4 do
begin
Randomize;
ResultStr:=ResultStr+IntToStr(Random(10));
end;
Result:=ResultStr.Trim;
end;
function RandomNumberStr(const aInt:Integer=20): string;
//产生随机的N位数字字符串：
var iCircle:Integer; ResultStr: string;
begin
ResultStr:='';
for iCircle := 1 to aInt do
begin
Randomize;
ResultStr:=ResultStr+IntToStr(Random(10));
end;
Result:=ResultStr.Trim;
end;
function RandomTimeSecondsStr(
const aIntBegin:Integer=1000;
aIntEnd:Integer=2000): string;
//产生随机的N位数字的以某个数字开头的秒数字符串：
var iCircle:Integer; ResultStr: string;
begin
ResultStr:='0';
//{$IFDEF POSIX}
while (ResultStr.ToInteger=0)
or (ResultStr.ToIntegeraIntEnd) do
begin
ResultStr:='';
begin
Randomize;
ResultStr:=IntToStr(Random(aIntEnd));
end;
end;
//{$ELSE}
//{$ENDIF}
Result:=ResultStr.Trim;
end;
function RandomNumber(const aInt:Integer=3): Integer;
//产生小于设定的数值的1位随机正整数0~aInt-1）:
begin
Randomize;
Result:=Random(aInt);
end;
function ImgGetFromImgList(Const ImgList:TImageList;
Const xPT,yPT:Integer;Const indexImgList:Integer): TBitmap;
//从ImageList向TBitmap赋值:
var aSizeF:TSizeF;
aBitmap: TBitmap;
begin
aBitmap:=TBitmap.create;
aBitmap.Resize( xPT,yPT );
aSizeF.cx:=xPT; aSizeF.cy:=yPT;
if ImgList.BitmapExists(indexImgList)=true then
Result :=ImgList.Bitmap(aSizeF,indexImgList)
//ShowMessagePos('列表中无图片！',180,300); //ShowMessage('列表中无图片！');
else
Result:=aBitmap; //不存在：就画空图像素
//调用方法示例：
// imgGesture.Bitmap
// :=ImgGetFromImgList(imgListGesture,280,140,0);
// 0:indexImgList,必须存在，否则返回空的 aBitmap
// 280,140：图片Bitmap的宽、高：取决于ImageList Source的图的大小TSizeF
// 如果ImageList Source的图TSizeF是64,64，如果调用所画的像素小于4,64，如下
// ImgGetFromImgList(imgListGesture,16,16,0); 画出来就是模糊的！
// 否则，相反：至少会保持64,64的精度
end;
function CbdToDbd(const Text:string=''): string;
//半角Cbd转全角Dbd:
//半角全角互转原理(全角即汉子的字符编码范围的子界)：
//全角空格为12288，半角空格为32
//其他字符半角(33-126)与全角(65281-65374)的对应关系是：均相差 65248
var sStr:string; iCharCount:Integer;
Encoding:TEncoding;
begin
//字符集编码://Encoding := TEncoding.GetEncoding('UTF8'); //GB2312
Encoding := TEncoding.Unicode;
//按上述定义的字符集编码方式，将字符串Text转化一遍：
//先将String：GetBytes->TBytes,再TBytes->String
// Encoding.GetString( Encoding.GetBytes(Text) );
sStr:=Text;
for iCharCount := Low(Text) to High(Text) do
begin
if ord(sStr[iCharCount])=32
then sStr[iCharCount]:=WideChar(12288);
if (ord(sStr[iCharCount])>=33) and (ord(sStr[iCharCount])<=126)
then sStr[iCharCount]:=WideChar( ord(sStr[iCharCount]) + 65248 );
if (Ord(sStr[iCharCount]) >= 65281) and (Ord(sStr[iCharCount]) <= 65374)
then continue;
end;
Result:=(sStr);
end;
function DbdToCbd(const Text:string='';const KillChinese:string='去中文'): string;
//：全角Dbd转半角Cbd
(*
//半角全角互转原理：：：
1、在windows和POSIX中,采用TEncoding.GetEncoding('GB2312')时：
中文和全角字符都占两个字节：
ASC编码：范围：0~255，共256个字符
！！ASC编码：asci chart 1 (codes 33 - 126 )：可见且可打印的字符
ASC编码：ascii chart 2 (codes 127 - 255 )：不可见且不可打印的控制符
！！其中：32位空格:可见且 非 打印字符
：33-126：为可见且 可 打印字符
！！全角空格:第1个字节 和 第2个字节 均为161。：
！！全角字符（除全角空格）的第1个字节总是被置为163，
而第2个字节则是 相同半角字符码加上128（不包括空格）
如半角a为65，则全角a：则是163（第1个字节）、 193 （第2个字节， 128 + 65 ）。
！！中文来讲，它的第一个字节被置为大于163，（
如 ' 阿 ' 为: 176 162 ）,我们可以在检测到中文时不进行转换。
2、在windows和POSIX中,采用TEncoding.Unicode时【最标准国际化的用法】
//非全角空格的全角字符（【句号】无全角，逗号有全角）：判断条件第2个字节=255，输出：其半角字节=第1个字节+32
//全角特例：
//2.1、全角空格：判断条件第2个字节=48而第1个字节0，输出：其半角字节=32
//2.2、全角逗号：判断条件第2个字节=48而第1个字节2，输出：其半角字节=46
//半角字符：判断条件第2个字节=0，输出：其半角字节=第1个字节
//中文：判断条件第2个字节<>0 and 48 and 255，输出：就是它本身
*)
var sStr,sTempStr:string; iStrLen,iCharCount,iBeginChar:Integer;
aByteArray:TBytes;
Encoding:TEncoding;
//aByte:Byte; //Byte:即0~255，即ASCii：Cardinal：SmallInt类型的正整数
begin
//GetTickCount:系统计数毫秒ms ：dTime: Cardinal; dTime:=GetTickCount;
Encoding := TEncoding.Unicode; //UTF8 Unicode
//Encoding := TEncoding.GetEncoding('GB2312'); //国标
Encoding.GetString( Encoding.GetBytes(Text) );
sStr:=''; sTempStr:='';
//测试：//Text:='＊*！!］]……^＆& 中……^．．．．．．......，,？?。.＂＂“”""``～~￥$';
//！＠＃％＆（）－＋＝～：；’、“，。、、？""《》Ａ／＼—￥“”……【】＂＂
(* //输出测试:
for iStrLen := Low(Text) to High(Text) do
begin
sTempStr:=Text[iStrLen]; //一个字符一个字符的替换：
//开始替换：
aByteArray:=Encoding.GetBytes(sTempStr); //：字节数组
iBeginChar:=Low(aByteArray);
for iCharCount := iBeginChar
to High(aByteArray) do
begin
//得到字节数组中的每个字节
sTempStr:=sTempStr+#13+#10+'第['+IntToStr(iCharCount)+']个字节：'
+IntToStr(aByteArray[iCharCount]);
end;
sStr:=sStr+sTempStr+#13+#10;
end; //:输出测试 *)
for iStrLen := Low(Text) to High(Text) do
begin
sTempStr:=Text[iStrLen]; //一个字符一个字符的替换：
//开始替换：
//(*
//Unicode编码：
aByteArray:=Encoding.GetBytes(sTempStr); //：获取字节数组
if aByteArray[1]=255 then //非全角空格的全角字符（【句号】无全角）：第2个字节=255
begin
if aByteArray[0]<=126 then
sTempStr:=Char(aByteArray[0]+32) //正常情况：其半角字节=第1个字节+32
else if aByteArray[0]>126 then //特例：比如半角(aByteArray[0]$=36)的全角￥(aByteArray[0]=229)
sTempStr:=Char( aByteArray[1]+10-aByteArray[0] ) //=36 ：即半角$
;
end else
if aByteArray[1]=48 then //全角特例：第2个字节=48
begin
if aByteArray[0]=0 then //:当第1个字节=0时，代表 空格
sTempStr:=Char(32) //其半角字节=32，代表 空格 做替换
else if aByteArray[0]=2 then //:当第1个字节=2时，代表 句号
sTempStr:=Char(46) //其半角字节=46，代表.号做替换
else if aByteArray[0]=16 then //:当第1个字节=16时，代表 【
sTempStr:=Char(91) //转换为：[
else if aByteArray[0]=17 then //:当第1个字节=0时，代表 】
sTempStr:=Char(93) //转换为：]
;
end else
if aByteArray[1]=32 then //半角特例中文半角引号“”：第2个字节=32
begin
if aByteArray[0]=28 then //:当第1个字节=28时，代表 中文半角左引号“
sTempStr:=Char(34) //其半角字节=32，代表英文"号做替换
else if aByteArray[0]=29 then //:当第1个字节=28时，代表 中文半角右引号”
sTempStr:=Char(34) //其半角字节=46，代表英文"号做替换
else if aByteArray[0]=20 then //:当第1个字节=28时，代表 全角减号—
sTempStr:=Char(45) //其半角字节=46，代表英文"号做替换
else if aByteArray[0]=38 then //:当第1个字节=38时，代表 全角省略号……即Shift+^
sTempStr:=sTempStr //：不定义也可以，Unicode本身就这样替换的，替换成半角省略号......
;
end else
if aByteArray[1]=0 then //半角字符：第2个字节=0
sTempStr:=Char(aByteArray[0]) //其半角字节=第1个字节
else //则是中文
begin
if KillChinese='去中文' then sTempStr:=''
else sTempStr:=sTempStr;
end;
//*)
(*
//GB2312编码：中午和全角是 双字节，半角和其它为单字节
aByteArray:=Encoding.GetBytes(sTempStr); //：获取字节数组
if aByteArray[0]=163 then //非全角空格的全角字符：第1个字节=163
sTempStr:=Chr(aByteArray[1]-128) //其半角字节=第2个字节-128
else
if aByteArray[0]=161 then //全角空格：第1个字节=161
sTempStr:=Char(32) //其半角字节=32
else
if ( (aByteArray[0]>=33) and (aByteArray[0]<=126) ) then //半角字符：第1个字节>=33 and <=126
sTempStr:=Char(aByteArray[0]) //其半角字节=第1个字节
else if aByteArray[0]>163 then//则是中文
begin
if KillChinese='去中文' then sTempStr:=''
else sTempStr:=sTempStr;
end; //：标点符号的范围aByteArray[0]不知晓！！！
//*)
//：替换结束
sStr:=sStr+sTempStr; //：循环内：将每个替换后的字符累加
end;
result:= sStr;
end;
function getMyIndyMD5String(const aSignName:string) : string;
var MD5: TIdHashMessageDigest5; Encoding:TEncoding;
begin
Encoding := TEncoding.Unicode;
Encoding.GetString( Encoding.GetBytes(aSignName) );
MD5 := TIdHashMessageDigest5.Create;
Result := MD5.HashStringAsHex(aSignName);
//:delphi自带Indy函数实现MD5加密:，在xe10.2版本测试通过。
//uses单元中加入 uses IdHashMessageDigest
// HashStringAsHex有错？！： HashBytesAsHex ???
//无错：
//function HashStringAsHex(const AStr: String; ADestEncoding: IIdTextEncoding =nil{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}): String;
//function HashBytesAsHex(const ASrc: TIdBytes): String;
end;
//貌似10.2中还有一个SHA的方法，回头慢慢研究一下。
function getMyHashString(const aSignName:string) : string;
begin
//
end;
function ServerGetSubPathOfAppPublished(
UploadOrDownload:string='Upload';AFileType:string='pic';
AProducedSubPath:string='';IfPathThumbnail:Boolean=false):string;
var checkInput:string;
begin
{$IFDEF MSWINDOWS}//在APP包的安装根路径:
if AProducedSubPath.Trim='' then
begin
checkInput:=//System.IOUtils.TPath.GetLibraryPath
ExtractFilePath(ParamStr(0))
+'WorkPath\'+UploadOrDownload.Trim+'\'+AFileType+'\';
if IfPathThumbnail=true then checkInput:=checkInput+'Thumbnail\';
end else
begin
checkInput:=System.IOUtils.TPath.GetLibraryPath
+'WorkPath\'+UploadOrDownload.Trim+'\'+AFileType+'\'+AProducedSubPath.Trim+'\';
if IfPathThumbnail=true then checkInput:=checkInput+'Thumbnail\';
end;
if System.IOUtils.TDirectory.Exists(checkInput)=false then
//if System.SysUtils.DirectoryExists(checkInput)=false then
Result:='错误路径' else //TDirectory //:直接返回路径,不然错误
Result:=checkInput;
{$ENDIF MSWINDOWS}
end;
function ServerSubPathOfAppPublished(
APath:string='';AProducedSubPath:string=''):Boolean;
var AppDocumentsPath:string;//:分平台约定值-APP对外发布文件的路径
begin
//:无需TGUID：全球唯一标识符,系统自动的:
//1、先检查内外部存储的读写权限
//(Windows简单检查管理员权限即可):
//function CheckSysPermits(APermitionList:TArray):Boolean;
//2、AppDocumentsPath:分平台约定值-APP对外发布文件的路径
{$IFDEF MSWINDOWS}//在APP包的安装根路径:
AppDocumentsPath:=ExtractFilePath(ParamStr(0));//:等价://System.IOUtils.TPath.GetLibraryPath;
{$ENDIF MSWINDOWS}
{$IFDEF MSWINDOWS}//Windows平台路径:
if APath.Trim='' then
begin //:3、默认要产生的路径:
//APP对外发布文件的路径变量AppDocumentsPath下-工作目录 WorkPath
//3.1、上传路径之:
//3.1.1、图片路径:
//部门Pic路径:department,文件de开头
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\pic\department\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\pic\department\Thumbnail\');
//员工Pic路径:employee,文件e0开头
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\pic\employee\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\pic\employee\Thumbnail\');
//库房Pic路径:storehouse,文件s0开头
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\pic\storehouse\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\pic\storehouse\Thumbnail\');
//行政区划Pic路径:region,文件r0开头
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\pic\region\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\pic\region\Thumbnail\');
//物品类别Pic路径: itemtype,文件it开头
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\pic\itemtype\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\pic\itemtype\Thumbnail\');
//物料Pic路径: matter,文件cp开头
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\pic\matter\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\pic\matter\Thumbnail\');
//客户Pic路径: customer,文件c0开头
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\pic\customer\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\pic\customer\Thumbnail\');
//供应商Pic路径: supplier,文件g0开头
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\pic\supplier\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\pic\supplier\Thumbnail\');
//结算方式Pic路径: settle,文件st开头
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\pic\settle\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\pic\settle\Thumbnail\');
//会计科目Pic路径: account,文件a0开头
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\pic\account\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\pic\account\Thumbnail\');
//核算项目Pic路径: accountitem,文件ai开头
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\pic\accountitem\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\pic\accountitem\Thumbnail\');
//3.1.2、视频路径: 打开时,用库媒体工具打开
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\movies\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\movies\Thumbnail\');
//3.1.3、音频路径: 打开时,用库媒体工具打开
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\musics\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\musics\Thumbnail\');
//3.1.4、文件路径: 打开时,用内嵌webbrowser打开
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\files\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\files\Thumbnail\');
//3.2、下载路径之:
//3.2.1、图片路径:
//部门Pic路径:department,文件de开头
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\pic\department\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\pic\department\Thumbnail\');
//员工Pic路径:employee,文件e0开头
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\pic\employee\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\pic\employee\Thumbnail\');
//库房Pic路径:storehouse,文件s0开头
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\pic\storehouse\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\pic\storehouse\Thumbnail\');
//行政区划Pic路径:region,文件r0开头
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\pic\region\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\pic\region\Thumbnail\');
//物品类别Pic路径: itemtype,文件it开头
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\pic\itemtype\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\pic\itemtype\Thumbnail\');
//物料Pic路径: matter,文件cp开头
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\pic\matter\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\pic\matter\Thumbnail\');
//客户Pic路径: customer,文件c0开头
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\pic\customer\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\pic\customer\Thumbnail\');
//供应商Pic路径: supplier,文件g0开头
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\pic\supplier\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\pic\supplier\Thumbnail\');
//结算方式Pic路径: settle,文件st开头
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\pic\settle\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\pic\settle\Thumbnail\');
//会计科目Pic路径: account,文件a0开头
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\pic\account\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\pic\account\Thumbnail\');
//核算项目Pic路径: accountitem,文件ai开头
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\pic\accountitem\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\pic\accountitem\Thumbnail\');
//3.2.2、视频路径: 打开时,用库媒体工具打开
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\movies\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\movies\Thumbnail\');
//3.2.3、音频路径: 打开时,用库媒体工具打开
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\musics\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\musics\Thumbnail\');
//3.2.4、文件路径: 打开时,用内嵌webbrowser打开
if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\files\Thumbnail\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\files\Thumbnail\');
end else
begin
//你自己的上传路径:
if System.IOUtils.TDirectory.Exists(AppDocumentsPath
+'your\'+APath.Trim+'\Upload\'+AProducedSubPath.Trim+'\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath
+'your\'+APath.Trim+'\Upload\'+AProducedSubPath.Trim+'\');
//你自己的下载路径:
if System.IOUtils.TDirectory.Exists(AppDocumentsPath
+'your\'+APath.Trim+'\Download\'+AProducedSubPath.Trim+'\')=false then
System.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath
+'your\'+APath.Trim+'\Download\'+AProducedSubPath.Trim+'\');
end;
{$ENDIF MSWINDOWS} //：为除了Windows的平台路径:
end;
function productTextFile(const aSubPath:string='';const targetFileName:string=''):string;
var aPath:string;
begin
//System.SysUtils, uses System.IOUtils ,System.StartUpCopy;
{$IFDEF MSWINDOWS}
aPath :=ExtractFilePath(ParamStr(0))+ targetFileName;
{$ENDIF MSWINDOWS}
{$IFDEF ANDROID}
//ANDROID的文档路径GetDocumentsPath: assets\internal\
//ANDROID机器的实际存取路径，可以：ShowMessage出来：
//ShowMessage(System.IOUtils.TPath.Combine(System.IOUtils.TPath.GetDocumentsPath , 'CarveoutO2O.s3db');
aPath :=System.IOUtils.TPath.Combine( System.IOUtils.TPath.GetDocumentsPath ,targetFileName);
//不是GetHomePath，也不能加PathDelim ：//:=System.IOUtils.TPath.Combine(System.IOUtils.TPath.GetHomePath + PathDelim , 'CarveoutO2O.s3db'); //uses System.IOUtils ,System.StartUpCopy;
{$ENDIF ANDROID}
{$IFDEF IOS}
//IOS的文档路径GetDocumentsPath: StartUp\Documents\
//iPhone机器的实际存取路径，可以：ShowMessage出来：
//ShowMessage(System.IOUtils.TPath.Combine(System.IOUtils.TPath.GetDocumentsPath , 'CarveoutO2O.s3db');
aPath :=System.IOUtils.TPath.Combine( System.IOUtils.TPath.GetDocumentsPath ,targetFileName);
//不是GetHomePath，也不能加PathDelim ：//:=TPath.Combine(System.IOUtils.TPath.GetHomePath + PathDelim , 'CarveoutO2O.s3db'); //uses System.IOUtils ,System.StartUpCopy;
{$ENDIF IOS}
{$IFDEF MACOS32}
aPath:=targetFileName;
{$ENDIF MACOS32}
Result:=aPath;
//{$IFDEF POXIS}
(*
showmessage(
'01、GetCachePath在:'+#10 + System.IOUtils.TPath.GetPathRoot(System.IOUtils.TPath.GetCachePath)+#10
+'02、GetTempPath在:' + System.IOUtils.TPath.GetTempPath+#10
+'03、GetHomePath在:' + System.IOUtils.TPath.GetHomePath+#10
+'04、GetDocumentsPath在:' + System.IOUtils.TPath.GetDocumentsPath+#10
+'GetSharedDocumentsPath:' + System.IOUtils.TPath.GetSharedDocumentsPath+#10
+'05、GetSharedPicturesPath在:' + System.IOUtils.TPath.GetSharedPicturesPath+#10
+'06、GetSharedDownloadsPath在:' + System.IOUtils.TPath.GetSharedDownloadsPath+#10
+'07、GetCachePath在:' + System.IOUtils.TPath.GetCachePath+#10
+'08、GetCameraPath在:' + System.IOUtils.TPath.GetCameraPath+#10
+'09、GetPicturesPath在:' + System.IOUtils.TPath.GetPicturesPath+#10
+'10、GetPublicPath在:' + System.IOUtils.TPath.GetPublicPath+#10
+'11、GetTempFileName在:' + System.IOUtils.TPath.GetTempFileName+#10
+'12、GetFileName在:' + System.IOUtils.TPath.GetFileName('CarveoutO2O.s3db')+#10
+'13、程序文件在:' + System.IOUtils.TPath.GetFileName('DepartmentClientMultideviceProject.rsm')+#10
+'15、文档路径在:' + System.IOUtils.TPath.GetFullPath(System.IOUtils.TPath.GetDocumentsPath)+#10
+'14、主路径的根节点在:' + System.IOUtils.TDirectory.GetDirectoryRoot(System.IOUtils.TPath.GetHomePath)+#10
+'14、此文件是否存在:' +
BoolToStr( System.IOUtils.TPath.HasValidFileNameChars(PChar('CarveoutO2O.s3db'),true) )
+#10
);
*)
end;
procedure setSysConfig;
var targetFileName:string; aMemSysConfig:TMemo;
iCircle:integer;
begin //设置系统登录状态及系统配置信息全局参数:
aMemSysConfig:=TMemo.Create(nil);
try
targetFileName:='myFile.ini';
targetFileName:=productTextFile('',targetFileName);
if targetFileName.Trim<>'' then
begin
aMemSysConfig.Lines.Clear;
aMemSysConfig.Lines.add(gstrSenderPhone.Trim); //0输入验证码网关手机号
aMemSysConfig.Lines.add(gstrIP.Trim); //1服务器IP地址或动态域名
aMemSysConfig.Lines.add(gstrPort.Trim); //2服务器端口号
aMemSysConfig.Lines.add(gstrCunstomerServiceTel.Trim); //3贵公司客服手机
aMemSysConfig.Lines.add(gstrComID.Trim); //4您的运营商编号
aMemSysConfig.Lines.add(gstrLoginStatus.Trim); //5未登录状态
aMemSysConfig.Lines.add(gstrClerk_id.Trim); //6当前登录的员工编码：默认=''
aMemSysConfig.Lines.add(gstrClerk_name.Trim); //7当前登录的员工姓名：默认=''
aMemSysConfig.Lines.add(gstrDept_id.Trim); //8当前登录的员工所在部门编码：默认=''
aMemSysConfig.Lines.add(gstrDept_name.Trim); //9当前登录的员工所在部门名称：默认=''
aMemSysConfig.Lines.add(gstrCustomer_id.Trim); //10当前登录的客户编码：默认=''
aMemSysConfig.Lines.add(gstrCorp_name.Trim); //11当前登录的客户姓名：默认=''
aMemSysConfig.Lines.add(gstrCorp_addr.Trim); //12当前登录的客户地址：默认=''
aMemSysConfig.Lines.add(gstrLoginPhone.Trim); //13记住密码的登录手机：默认=''
aMemSysConfig.Lines.add(gstrLoginPassword.Trim);//14记住密码的登录密码：默认=''
//写本地配置文件：
if (aMemSysConfig.Text).Trim<>'' then
begin
if targetFileName.Trim<>'' then
aMemSysConfig.Lines.SaveToFile(targetFileName.Trim);
end;
end;
finally
FreeAndNil(aMemSysConfig);
end;
end;
procedure getSysConfig(const FileName:string='myFile.ini');
//获取系统登录状态及系统配置信息全局参数(其中含中文属多字节字符集需转化):
var targetFileName,AText:string; aMemSysConfig:TMemo;
iCircle:integer; Encoding:TEncoding;
begin
//字符集编码://Encoding := TEncoding.GetEncoding('GB2312'); //UTF8
//必须做字符集转化Encoding,:
//:否则:因TMemo的lines(TStrings)默认属于UTF8字符集,载入时会乱码或报错并闪退内存泄漏:
//No mappingn for Unicode character exists in target multi-byte code page
Encoding := TEncoding.GetEncoding('GB2312');
//按上述定义的字符集编码方式载入外部文件:aMemSysConfig.lines.LoadFromFile:
aMemSysConfig:=TMemo.Create(nil);
try
targetFileName:=FileName;//'myFile.ini';
targetFileName:=productTextFile('',targetFileName);
if targetFileName.Trim<>'' then
begin
//调本地配置文件myFile.ini:
aMemSysConfig.lines.LoadFromFile(targetFileName.Trim,Encoding);
if aMemSysConfig.Text.Trim<>'' then
begin
for iCircle := 0 to aMemSysConfig.lines.count-1 do
begin //如果配置文件中一行都没有，则取变量默认值
if iCircle = 0 then //验证码网关手机号
gstrSenderPhone:=aMemSysConfig.lines[0];
if iCircle = 1 then //服务器IP地址或动态域名
gstrIP:=aMemSysConfig.lines[1];
if iCircle = 2 then //服务器端口号
gstrPort:=aMemSysConfig.lines[2];
if iCircle = 3 then //客服电话
gstrCunstomerServiceTel:=aMemSysConfig.lines[3];
if iCircle = 4 then //运营商编号
gstrComID:=aMemSysConfig.lines[4];
if iCircle = 5 then //当前登录状态：默认=未登录状态
gstrLoginStatus:=aMemSysConfig.lines[5];
if iCircle = 6 then //当前登录的员工编码：默认=''
gstrClerk_id:=aMemSysConfig.lines[6]; //权限依据：员工账号：员工编码
if iCircle = 7 then //当前登录的员工姓名：默认=''
gstrClerk_name:=aMemSysConfig.lines[7];
if iCircle = 8 then //当前登录的员工所在部门编码：默认=''
gstrDept_id:=aMemSysConfig.lines[8];
if iCircle = 9 then //当前登录的员工所在部门名称：默认=''
gstrDept_name:=aMemSysConfig.lines[9];
if iCircle = 10 then //当前登录的客户编码：默认=''
gstrCustomer_id:=aMemSysConfig.lines[10];
if iCircle = 11 then //当前登录的客户姓名：默认=''
gstrCorp_name:=aMemSysConfig.lines[11];
if iCircle = 12 then //当前登录的客户地址：默认=''
gstrCorp_addr:=aMemSysConfig.lines[12];
if iCircle = 13 then //记住密码的登录手机：默认=''
gstrLoginPhone:=aMemSysConfig.lines[13];//权限依据：员工账号：用户编码
if iCircle = 14 then //记住密码的登录密码：默认=''
gstrLoginPassword:=aMemSysConfig.lines[14];
end;
end;
end;
finally
FreeAndNil(aMemSysConfig); FreeAndNil(Encoding);
end;
end;
function getMyStickCount(starttime,stoptime:TDateTime):Integer;
begin//取得计时时间,单位毫秒(ms):
Result := System.DateUtils.MilliSecondsBetween(stoptime, starttime);
end;
function getDatetime(const aDatetimeField:string='';const Database:string=''):string;
//便于差异化数据库扩展,设置通用的日期时间字段的select列表字段，返回字符串:
begin
Result:='';
if Database ='mssql' then
begin
Result:=' convert(varchar(23),'+aDatetimeField+',121) ';
end;
if Database ='oracle' then
begin
Result:=' to_char('+aDatetimeField+',''YYYY-MM-DD HH24:MI:SS.FF3'') ';
end;
if Database ='sqlite3' then
begin
Result:=' strftime(''%Y.%m.%d %H:%M:%f'','+aDatetimeField+',''localtime'') ';
//:sqlite3只用于列表,不用于where条件
end;
end;
function whereDatetime(const aDatetimeField:string='';const Database:string=''):string;
//便于差异化数据库扩展,设置通用的日期时间字段的where条件字段，返回字符串:
begin
Result:='';
if Database ='mssql' then
begin
Result:=' convert(varchar(23),'+aDatetimeField+',121) ';
end;
if Database ='oracle' then
begin
Result:=' to_char('+aDatetimeField+',''YYYY-MM-DD HH24:MI:SS.FF3'') ';
end;
if Database ='sqlite3' then
begin
Result:=' aDatetimeField ';
end;
end;
function DataSet2JSONuseFDBatchMove(ADataset: TDataSet): string;
//数据集的记录转JSon字符串:用FDBatchMove方法，select计算后的结果列含\：
var
sSM: TStringStream; LStreamStr:string;
FDBatchMove: TFDBatchMove; //uses FireDAC.Comp.BatchMove;
FDBatchMoveDataSetReader: TFDBatchMoveDataSetReader; //uses FireDAC.Comp.BatchMove.DataSet;
FDBatchMoveJSONWriter: TFDBatchMoveJSONWriter;//uses FireDAC.Comp.BatchMove.JSON
//LTable: TFDMemTable;
begin
//LTable := TFDMemTable.Create(nil);
//LTable.CopyDataSet(ADataset, [coRestart, coAppend, coStructure]);
sSM := TStringStream.Create('', TEncoding.UTF8);
FDBatchMove := TFDBatchMove.Create(nil);
FDBatchMoveDataSetReader := TFDBatchMoveDataSetReader.Create(nil);
FDBatchMoveJSONWriter := TFDBatchMoveJSONWriter.Create(nil);
try
FDBatchMoveDataSetReader.DataSet := ADataset;//LTable;//ADataset;
//FDBatchMoveDataSetReader.DataSet.FieldDefs := LTable.FieldDefs;
FDBatchMoveJSONWriter.Stream := sSM;
FDBatchMove.Reader := FDBatchMoveDataSetReader;
FDBatchMove.Writer := FDBatchMoveJSONWriter;
FDBatchMove.Execute;
LStreamStr:=sSM.DataString;
Result := LStreamStr;
(*
try
LStreamStr:= LStreamStr.Replace('\','',[rfReplaceAll]);//:替换不了
finally
Result := LStreamStr;
end; //*)
finally
sSM.Free;
FDBatchMove.Free;
FDBatchMoveDataSetReader.Free;
FDBatchMoveJSONWriter.Free;
//FreeAndNil(LTable);
end;
end;
function DataSet2JSONuseDataset(ADataset: TDataSet): string;
//数据集转JSon字符串:用Dataset遍历拼接Json格式的方法：
//样例： [{"CityId":"18","CityName":"西安"},{"CityId":"53","CityName":"广州"}]
var
LRecord: string;
LField: TField;
i: integer;
begin
Result := '';
if (ADataset.Active=false) or (ADataset.IsEmpty) then Exit;
Result := '[';
ADataset.DisableControls;
ADataset.First;
while not ADataset.Eof do
begin
for i := 0 to ADataset.FieldCount - 1 do
begin
LField := ADataset.Fields[i];
if LRecord = '' then
LRecord := '{"' + LField.FieldName + '":"' + LField.Text + '"'
else
LRecord := LRecord + ',"' + LField.FieldName + '":"' + LField.Text + '"';
if i = ADataset.FieldCount - 1 then
begin
LRecord := LRecord + '}';
if Result = '[' then
Result := Result + LRecord
else
Result := Result + ',' + LRecord;
LRecord := '';
end;
end;
ADataset.Next;
end;
ADataset.EnableControls;
Result := Result + ']';
end;
(*TJsonToKener*)
constructor TJsonToKener.Create;
begin
inherited;
end;
destructor TJsonToKener.destroy;
begin
inherited;
end;
procedure TJsonToKener.AddElement(nodeName,nodeValue:String);
begin
if length(JSonStr)>0 then
JSonStr:=ConCat(JSonStr,',"',nodeName,'":',nodeValue)
else
JSonStr:=ConCat(JSonStr,'"',nodeName,'":',nodeValue);
end;
procedure TJsonToKener.ClearElement;
begin
JSonStr:='';
end;
function TJsonToKener.ToStr:UnicodeString;
begin
Result:=ConCat('{',JSonStr,'}');
end;
function FieldTypeToDMLFieldProperstr(
AField: TField;
AFieldType: TFieldType): string;
//FieldType转DML语句字段列属性字串:
var LFieldTypeStr,LDMLFieldNullTarget:string;
begin
case AField.Required of
true:
LDMLFieldNullTarget:='not null';
false:
LDMLFieldNullTarget:='null';
end;
LFieldTypeStr:='ftUnknown';
case AFieldType of
ftLargeint: LFieldTypeStr:='BIGINT'+' '+LDMLFieldNullTarget;
ftBytes: LFieldTypeStr:='BINARY'+' ('+IntToStr(AField.Size)+') '+LDMLFieldNullTarget;
ftBoolean: LFieldTypeStr:='BOOLEAN'+' '+LDMLFieldNullTarget;
ftString: LFieldTypeStr:='VARCHAR('+IntToStr(AField.Size)+')'+' '+LDMLFieldNullTarget;
ftDateTime: LFieldTypeStr:='DATETIME'+' '+LDMLFieldNullTarget;
ftTimeStamp: LFieldTypeStr:='DATETIME'+' '+LDMLFieldNullTarget;
ftFMTBcd: LFieldTypeStr :='int'+' ('
+IntToStr(AField.DataSet.FieldDefList.FieldByName(AField.FieldName).Precision)+','
+IntToStr(AField.Size)+') '+LDMLFieldNullTarget;
ftFloat: LFieldTypeStr :='FLOAT'+' ('
+IntToStr(AField.DataSet.FieldDefList.FieldByName(AField.FieldName).Precision)+','
+IntToStr(AField.Size)+') '+LDMLFieldNullTarget;
ftBlob: LFieldTypeStr:='IMAGE'+' '+LDMLFieldNullTarget;
ftInteger: LFieldTypeStr:='int'+' '+LDMLFieldNullTarget;
ftSmallint: LFieldTypeStr:='smallint'+' '+LDMLFieldNullTarget;
ftCurrency: LFieldTypeStr:='MONEY'+' '+'(19,4)'+' '+LDMLFieldNullTarget;
ftWideString: LFieldTypeStr:='NVARCHAR('+IntToStr(AField.Size)+')'+' '+LDMLFieldNullTarget;
ftWideMemo: LFieldTypeStr:='NTEXT'+' '+LDMLFieldNullTarget;
ftSingle: LFieldTypeStr:='REAL'+' '+LDMLFieldNullTarget;
ftByte: LFieldTypeStr:='int'+'(1)'+LDMLFieldNullTarget;
ftGuid: LFieldTypeStr:='uniqueidentifier'+' '+LDMLFieldNullTarget;
ftVarBytes: LFieldTypeStr:='VARBINARY('+IntToStr(AField.Size)+')'+' '+LDMLFieldNullTarget;
ftUnknown: LFieldTypeStr:='VARBINARY'+' '+LDMLFieldNullTarget;//:不做任何处理
else //:未遍历到的数据类型,均暂VARBINARY可变长二进制:
LFieldTypeStr:='VARBINARY'+' '+LDMLFieldNullTarget;
end;
Result:=LFieldTypeStr;
end;
procedure ShowAMessage(
const AMessage:string;
const AProc:TProc);overload;
var LIFModalResult:Boolean;
begin
//消息对话框平台服务异步模式:安卓不支持同步:
//:IOS是同步模式 //:Android异步模式 //:Win同步异步均支持:
if TPlatformServices.Current.SupportsPlatformService(IFMXDialogServiceAsync,
IInterface(FIFMXDialogServiceAsync)) then
begin
FIFMXDialogServiceAsync.MessageDialogAsync(
AMessage,
TMsgDlgType.mtInformation,
[TMsgDlgBtn.mbOK,TMsgDlgBtn.mbCancel],
TMsgDlgBtn.mbOK,
0,
procedure(const AResult: TModalResult)
begin
if AResult=mrOK then AProc;
end
//:IOS是同步模式在此不认AResult,在此就中断啦:调用者必须再次执行
//:Android异步模式 //:Win同步异步均支持:
);
end;
end;
procedure ShowAMessage(
const AMessage:string;const AX, AY: Integer);overload;
begin //消息对话框平台服务异步模式:安卓不支持同步:
(*
{$IFDEF ANDROID}
MessageDlgPosHelp(
AMessage,
TMsgDlgType.mtConfirmation,
[TMsgDlgBtn.mbOK,TMsgDlgBtn.mbCancel],
0,
AX, AY, '',
System.UITypes.TMsgDlgBtn.mbHelp
);
{$ELSE} //VCL模式下报错:'MessageDlgPos' is deprecated: 'Use FMX.DialogService methods'
MessageDlgPos(
AMessage,
TMsgDlgType.mtConfirmation,
[TMsgDlgBtn.mbOK,TMsgDlgBtn.mbCancel],
0,
AX, AY
);
{$ENDIF ANDROID}
*)
end;
procedure FMakeScreenshot(
ATControl:TControl;AImage:TImage);
//全局通用截屏方法:
var LTBitmap:TBitmap;
SceneScale: Single;
begin
LTBitmap:=
TBitmap.Create(
Round(ATControl.Width*ATControl.Scene.GetSceneScale),
Round(ATControl.Height*ATControl.Scene.GetSceneScale)
);
SceneScale:=ATControl.Scene.GetSceneScale;
LTBitmap.BitmapScale:=SceneScale;
LTBitmap.Clear(0);
if LTBitmap.Canvas.BeginScene then
try
ATControl.
PaintTo(LTBitmap.Canvas, TRectF.Create(0, 0,
LTBitmap.Width / SceneScale,
LTBitmap.Height / SceneScale));
finally
LTBitmap.Canvas.EndScene;
end;
try
AImage.Bitmap.Assign(LTBitmap);
{//不能直接这样截屏,否则有内存泄漏:
//ATControl.MakeScreenshot的返回值得不到释放:
//LTBitmap.Assign(ATControl.MakeScreenshot);
LTBitmap:=ATControl.MakeScreenshot;
//:FTControl:回调控件截屏
AImage.Bitmap.SetSize(LTBitmap.Size);
AImage.Bitmap.CopyFromBitmap(LTBitmap);
}
AImage.Visible:=true;
finally
LTBitmap.free;
end;
end;
function FocusMe(const ATControl:TControl):Boolean;
//uses FMX.Controls,FMX.Objects
//强制设置TControl焦点,返回是否获得焦点:
begin
ATControl.CanFocus:=true;
ATControl.SetFocus;
if ATControl.IsFocused then
Result:=true
else Result:=false;
end;
function ClipBoardGetObjectValue(const ATControl:TObject):Boolean;overload;
//全局剪切板获取对象属性的泛型值:
//FClipBoard:IFMXClipboardService; //:全局剪切板接口 //:FMX.Platform
//FClipBoardValue:TValue; //:全局剪切板获取的数值
begin //调用方法示例:ClipBoardGetObjectValue(imgShare.Bitmap);
if ATControl<>nil then
if TPlatformServices.Current.SupportsPlatformService(
IFMXClipboardService,IInterface(FClipBoard) ) then
begin
FClipBoardValue := TValue.From(ATControl);//:剪切板获取图片等对象属性
FClipBoard.SetClipboard(FClipBoardValue);
end;
if FClipBoardValue.IsEmpty then Result:=false else Result:=true;
end;
function ClipBoardGetObjectValue(const AText:string):Boolean;overload;
//全局剪切板获取对象泛型值:
//FClipBoard:IFMXClipboardService; //:全局剪切板接口 //:FMX.Platform
//FClipBoardValue:TValue; //:全局剪切板获取的数值
begin //调用方法示例:ClipBoardGetObjectValue(MemoShareText.Lines.Text);
if AText.Trim<>'' then
if TPlatformServices.Current.SupportsPlatformService(
IFMXClipboardService,IInterface(FClipBoard) ) then
begin
FClipBoardValue := TValue.From(AText);//:剪切板获取文字
FClipBoard.SetClipboard(FClipBoardValue);
end;
if FClipBoardValue.IsEmpty then Result:=false else Result:=true;
end;
function ActionWinStartupThirdApp(Sender:TObject):Boolean;
//Windows启动第三方APP库分享的点击事件:
//QQ是否手动登录(QQ不像微信,App拉起会被腾讯安全警告，只能由浏览器打开)
//var FQQisRunning:Boolean;
//IM是否手动登录(QQ不像微信,App拉起会被腾讯安全警告，只能由浏览器打开)
//var FTIMisRunning:Boolean;
//当前分享名:
//var FCurrShareName:string;
{$IFDEF MSWINDOWS}
var SenderTargetName:String;
AAppKeyValue:string;
LNativeUInt:NativeUInt;
LResult:Boolean;
{$ENDIF MSWINDOWS}
begin
{$IFDEF MSWINDOWS}
//MemoTips.Lines.Add(Sender.ToString);
LResult:=false;
SenderTargetName:=(Sender as TControl).Name;//(Sender as TObject).;
try
if SenderTargetName.IndexOf('btnQQ',0,length(SenderTargetName))>=0 then
begin
try
if FQQisRunning=false then
begin
//MemoTips.Lines.Add('QQ未运行');
AAppKeyValue:='QQ.exe';
try
try
FQQisRunning:=AppRunning(AAppKeyValue);
except
//
end;
finally
if FQQisRunning=false then
begin
LResult:=false;
ShowAMessage('请先手动登录您的QQ',procedure begin end);
Abort;
end else
LResult:=true;
end;
end;
finally
if FQQisRunning=True then
begin
//MemoTips.Lines.Add('QQ已运行');
AAppKeyValue:='';
FCurrShareName:='tencent://Message/?Uin=461655651&websiteName=q-zone.qq.com&Menu=yes';
//:测试纸适用Win32://ShellExecute(0, 'open','IExplore.EXE', PWideChar(WideString(FCurrShareName)), nil, SW_SHOWNORMAL);
try
ExeURL(AAppKeyValue,PWideChar(WideString(FCurrShareName)),SW_SHOWNORMAL);
//:QQ是否手动登录(QQ不像微信,
//:App拉起会被腾讯安全警告，只能由浏览器打开)
finally
//FCallmeForm.Activate; self.SetFocus;
end;
end;
end;
end;
//if (Sender as TControlAction).Target.Name='btnTIM' then
if SenderTargetName.IndexOf('btnTIM',0,length(SenderTargetName))>=0 then
begin
try
if FTIMisRunning=false then
begin
//MemoTips.Lines.Add('TIM未运行');
AAppKeyValue:='TIM.exe';
try
try
FTIMisRunning:=AppRunning(AAppKeyValue);
except
//
end;
finally
if FTIMisRunning=false then
begin
LResult:=false;
ShowAMessage('请先手动登录您的qq办公版TIM',procedure begin end);
Abort;
end else
LResult:=true;
end;
end;
finally
if FTIMisRunning=True then
begin
//MemoTips.Lines.Add('TIM已运行');
AAppKeyValue:='';
FCurrShareName:='tencent://Message/?Uin=461655651&websiteName=q-zone.qq.com&Menu=yes';
//:测试只适用Win32://ShellExecute(0, 'open','IExplore.EXE', PWideChar(WideString(FCurrShareName)), nil, SW_SHOWNORMAL);
try
ExeURL(AAppKeyValue,PWideChar(WideString(FCurrShareName)),SW_SHOWNORMAL);
//:QQ是否手动登录(QQ不像微信,
//:App拉起会被腾讯安全警告，只能由浏览器打开)
finally
//FCallmeForm.Activate; self.SetFocus;
end;
end;
end;
end;
//if (Sender as TControlAction).Target.Name='btnWechat' then
if SenderTargetName.IndexOf('btnWechat',0,length(SenderTargetName))>=0 then
begin
FCurrShareName:='WeChat';
AAppKeyValue:='ProAPIRegistryWin32.exe';
//:AAppKeyValue:若参数=''则不调用:
LNativeUInt:=ExeApp(AAppKeyValue,FCurrShareName,SW_SHOW);
//LNativeUInt:=ExeApp(AAppKeyValue,'WeChat',SW_SHOW);
//:(SW_HIDE,SW_SHOW,...)
//if LNativeUInt.ToString.Trim<>'' then
//MemoTips.Lines.Add(LNativeUInt.ToString.Trim)
//;
//:LNativeUInt.ToString.Trim<>'':代表调用成功
//ToString:System.SysUtils.TNativeUIntHelper
if LNativeUInt.ToString.Trim<>'' then
LResult:=true
else LResult:=false;
end;
finally
end;
if LResult=true then Result:=true else Result:=false;
{$ENDIF MSWINDOWS}
end;
procedure HttpRestByJsonObjectToStrList(
var AStringListImported:string;//:调用者传入的TStringList
const UrlHttpHead:string='https://192.168.3.100:8080';
UrlRestMethod:string='/datasnap/rest/TServerMethods1';
UrlMethodName:string='/getDatabaseDatetime';
UrlMethodParamsStr:string='/%20/文件系统' //:%20:方法的空参数
);
//THTTPClient通过IHTTPResponse响应服务器端返回的
//JsonObject为客户端调用者传入的TStringList(实际用string)赋值:
//:TStringList、TMemo等只适合少量基础数据的加载:
//:TListbox、TListview等TScrollBox类TStrings的基类也应当分页:
var LStrRespContent:string;
LValueOfPropertyName:string;
begin
LValueOfPropertyName:=AStringListImported;
AStringListImported
:=System.Threading.TTask.Future(
function: string
var LHttpC:THTTPClient;
LIHttpR:IHTTPResponse;
//uses System.Net.HttpClient,System.Net.HTTPClientComponent;
LJSonO:TJSonObject;
LURL:string;
function ReadAValue(const ARestRespContent:string):string;
var LResultValue:string;
LSReader:TStringReader;
LJTReader:TJSonTextReader; //uses System.Json.Reader;
//:"到头迭代"法遍历TJSonObject获取所需数据:
begin
LResultValue:='';
LSReader:=TStringReader.Create(ARestRespContent);
LJTReader:=TJSonTextReader.Create(LSReader);
try
LJTReader.Rewind;//:开始"到头迭代"
while (LJTReader.Read) do
begin
case LJTReader.TokenType of
TJsonToken.None:;
TJsonToken.StartObject:;
TJsonToken.PropertyName:
begin
if LJTReader.Value.ToString=LValueOfPropertyName then
LResultValue:=LJTReader.ReadAsString;
end;
TJsonToken.String:
begin
//
end;
TJsonToken.EndObject:
begin
if LResultValue.Trim<>'' then
Result:=LResultValue
else Result:='';
end;
end;
end;
finally
LJTReader.Free; LSReader.Free;
end;
end;
begin
LURL:=UrlHttpHead.Trim
+UrlRestMethod.Trim
+UrlMethodName.Trim
+UrlMethodParamsStr.Trim;
LHttpC:=THTTPClient.Create;
try
LIHttpR:=LHttpC.GET(LURL);
LStrRespContent:=LIHttpR.ContentAsString(TEncoding.UTF8);
//LJSonO:=TJSonObject.ParseJSonValue(LStrRespContent) as TJSonObject;
try
Result:=ReadAValue(LStrRespContent);
//:"到头迭代"法遍历TJSonObject获取所需数据
//Result:=LStrRespContent;//LJSonO.GetValue('DatabaseDatetime').Astring;
finally
//LJSonO.Free;
end;
finally
LHttpC.Free;
end;
end
).Value;
//AStringListImported:=FAStringListImported.Value;
end;
(*
function String2Bytes(const AString: string): TBytes;
var
CleanStr: string;
begin
CleanStr := AString.Replace('-', '');
SetLength(Result, Round(Length(CleanStr) / 2));
HexToBin(PChar(CleanStr), 0, Result, 0, Length(Result));
end;
function Bytes2String(const ABytes: TBytes): string;
var
I: Integer;
begin
Result := '';
for I := Low(ABytes) to High(ABytes) do
if I = 0 then
Result := IntToHex(ABytes[I], 2)
else
Result := Result + '-' + IntToHex(ABytes[I], 2);
end;
*)
//我的JSON函数和过程:
procedure WritePair(
JW:TJsonWriter;// TJsonTextWriter or TJsonObjectWriter
const sName,sValue:string);
begin
JW.WritePropertyName(sName);
JW.WriteValue(sValue);
//JW.WriteComment('批注:'+sName+''+sValue);
end;
function JsonIteratorParsor(
const AStrListResult:TStringList=nil;
const AJsonStr:string='';
const AKeySearch:string='';
const AValueSearch:string=''
):string;
//我的JSON解析函数TJSONIterator:
var
a:TJSonObject;
SR:TStringReader;
JTR:TJsonTextReader;
LJInterator:TJSONIterator;
sData:string;
begin
sData:='';
SR:=TStringReader.Create(AJsonStr);
JTR:=TJsonTextReader.Create(SR);
LJInterator:=TJSONIterator.Create(JTR);
//LJInterator.Rewind;//Json Str回到头部:
try
try
while LJInterator.Next() do
begin
if (LJInterator.Index=-1)
and (LJInterator.&Type<>TJsonToken.StartArray)
then //处理非数组:
begin
sData:=sData
+ LJInterator.Key.Trim
+':'
+ LJInterator.AsString.Trim
+sLineBreak;
(*
if AKeySearch.Trim='' then
begin
sData:=sData
+ LJInterator.Key.Trim
+':'
+ LJInterator.AsString.Trim
+sLineBreak;
end else
begin
if LJInterator.Key.Trim=AKeySearch.Trim then
sData:=sData
+ LJInterator.Key.Trim
+':'
+ LJInterator.AsString.Trim
+sLineBreak;
end;
*)
end else //处理数组:
begin
if (LJInterator.Index=-1) then
begin
//if AKeySearch.Trim='' then
sData:=sData
+ LJInterator.Key.Trim
+':';
end else
begin
sData:=sData
+sLineBreak
+ LJInterator.AsString.Trim;
{
if LJInterator.Key.Trim=AKeySearch.Trim then
begin
if AValueSearch.Trim='' then
begin
sData:=sData
+sLineBreak
+ LJInterator.AsString.Trim;
end else
begin
if LJInterator.AsString.Trim=AValueSearch.Trim then
sData:=sData
+sLineBreak
+ LJInterator.AsString.Trim;
end;
end;
}
end;
LJInterator.Recurse;//:递归TJsonArray或TJsonObject
end;
end;
except
raise Exception.Create('JSon数据格式错误');
SR.free;
JTR.free;
LJInterator.free;
Result:='解析失败';
end;
AStrListResult.Append(sData);
if sData.Trim<>'' then
Result:='解析成功'
else Result:='解析失败';
finally
SR.free;
JTR.free;
LJInterator.free;
end;
end;
procedure WriteLog(
const
AInfo: string='';
AIP:string='127.0.0.1';
AUserName:string='系统管理员';
ADevice:string='电脑' );
var //:只能被1个App实例(内部的N个线程)同时写:
LFileName: string;
LInfoEncodedUTF8: string;
LStream: TFileStream;
LEncoding:TEncoding;
LOutputFile: TStreamWriter;
begin
//DirectoryExists ForceDirectories
ForceDirectories(ExtractFilePath(ParamStr(0)) + 'Logs\');
LFileName := ExtractFilePath(ParamStr(0)) + 'Logs\'
+ AIP + '.json';
//+ FormatDateTime('YYYYMMDD',Now) + '.json'; //:每天1个文件
//+ FormatDateTime('YYYYMMDDHH',Now) + '.json'; //:每小时1个文件
//+ FormatDateTime('YYYYMMDDHHMMSS_ZZZ',Now) + '.json'; //:每秒1个文件
LEncoding:=TEncoding.GetEncoding('UTF8');
if FileExists(LFileName) then
begin //如果文件存在:
LStream := TFileStream.Create(
LFileName,
fmOpenReadWrite //打开文件,可读可写
or fmShareDenyWrite); //:fmShareDenyWrite:共享时拒绝被其他App同时写
end
else
begin //如果文件不存在:
LStream := TFileStream.Create(
LFileName,
fmCreate //:产生文件
or fmShareDenyWrite); //:fmShareDenyWrite:共享时拒绝被其他App同时写
end;
LStream.Seek(0, soFromEnd); //:文件流TFileStream指向文件的末尾
LOutputFile := TStreamWriter.Create(LStream,LEncoding);
//:用文件流TFileStream产生1个“写流工具TStreamWriter”
try
try
TMonitor.Enter(LOutputFile);
try
LOutputFile.WriteLine(AInfo);
//:“写流工具TStreamWriter”写入一行字符串
finally
TMonitor.Exit(LOutputFile);
end;
except
//:写入错误
end;
finally
LStream.Free;
LEncoding.Free;
LOutputFile.Free;
end;
end;
function getLANIP:string;
//:获取本机IPv4地址:
var
LIdIPWatch: TIdIPWatch; //TIdIPWatch类实例
LEncoding:TEncoding;
LResultStr:string;
LStringList:TStringList;
begin
LStringList:=TStringList.Create;
LEncoding:=TEncoding.GetEncoding('UTF8');
//创建TIdIPWatch类实例
LIdIPWatch:=TIdIPWatch.Create(nil);
LResultStr:='';
try
try
LIdIPWatch.ForceCheck;
if LIdIPWatch.IsOnline=true then
LResultStr:=LEncoding.Getstring(LEncoding.GetBytes(
LIdIPWatch.LocalIP)); //本机IPv4地址
LStringList.Add(LResultStr); //本机IPv4地址
finally
LResultStr:=LStringList.Text.Trim;
end;
Result:=LResultStr;
finally
//释放TIdIPWatch类实例
LIdIPWatch.Free;
LEncoding.Free;
LStringList.Free;
end;
end;
function GetWANIP(
const InternetIP:Boolean=true): string;
//:获取本机网关的公网的IPv4地址:
var
LList:TList;
LListCount :Integer;
LResult:string;
begin
if InternetIP then
begin
LResult:='';
{$IFDEF MSWINDOWS}
LResult:=
GetWanIP_Info; //:Windows获取本机网关的公网的IPv4地址
{$ENDIF MSWINDOWS}
//for LListCount := 0 to LList.Count-1 do
//LResult:=LResult+TAdapterInfo(LList.Items[0]).AdapterName;
Result:=LResult;
//LList.Free;
end
else Result:=getLANIP;
end;
function hextostring(str: string): string;
//16进制字符串转原字符串
var
s,t:string;
i,j:integer;
p:pchar;
begin
s:='';
i:=1;
while i< length(str) do begin
t:=str[i]+str[i+1];
s:=s+chr(hextoint(t));
i:=i+2;
end;
result:=s;
end;
//-----------------------------------------------
//16进制字符转整数,16进制字符与字符串转换中间函数
//-----------------------------------------------
function HexToInt(hex: string): integer;
var
i: integer;
function Ncf(num, f: integer): integer;
var
i: integer;
begin
Result := 1;
if f = 0 then exit;
for i := 1 to f do
result := result * num;
end;
function HexCharToInt(HexToken: char): integer;
begin
if HexToken > #97 then
HexToken := Chr(Ord(HexToken) - 32);
Result := 0;
if (HexToken > #47) and (HexToken < #58) then { chars 0....9 }
Result := Ord(HexToken) - 48
else if (HexToken > #64) and (HexToken < #71) then { chars A....F }
Result := Ord(HexToken) - 65 + 10;
end;
begin
result := 0;
hex := ansiuppercase(trim(hex));
if hex = '' then
exit;
for i := 1 to length(hex) do
result := result + HexCharToInt(hex[i]) * ncf(16, length(hex) - i);
end;
//-----------------------------------------------
//字符串转16进制字符
//-----------------------------------------------
function StringToHex(str: string): string;
var
i : integer;
s : string;
begin
for i:=1 to length(str) do begin
s := s + InttoHex(Integer(str[i]),2);
end;
Result:=s;
end;
function RestWebService(
const ABaseUrl:string='https://www.baidu.com/';
ATimeout:Integer=100):string;overload;
//:若用于测试网络:
//ATimeout:超时要很短默认100毫秒:参考网络ping命令的超时
//:默认访问超稳定的百度搜索首页以此来判断:客户端网络问题:
//:所有Rest请求或delphi dataSnap客户端请求,
//:先判断客户端网络状态再开始做
var
LRESTClient: TRESTClient;
LRESTRequest: TRESTRequest;
LRESTResponse: TRESTResponse;
LResultStr:string;
LRestReqErr:ERequestError; //:异常类:uses Rest.Types
LRestReqStatusCode:Integer; //:异常响应状态码:默认0:正常值200
LRestReqStatusText:string; //:异常响应状态文本:默认''
begin
//2、设置Rest组件参数:
LRESTClient:= TRESTClient.Create(nil);
//:很重要:回调的字符集和压缩编码:FallbackCharsetEncoding
LRESTClient.ResetToDefaults;
//:类会被重新产生,应放到其它属性之前
LRESTClient.BaseURL:=ABaseUrl;//:重要 :设置服务器方法的资源位置
LRESTClient.HandleRedirects:=true;//:允许处理重定向:重要
//:RaiseExceptionOn500:可返回App服务器内部异常状态
LRESTResponse:= TRESTResponse.Create(nil);
LRESTResponse.ResetToDefaults;
LRESTRequest:= TRESTRequest.Create(nil);
LRESTRequest.ResetToDefaults;
LRESTRequest.Client:=LRESTClient;
LRESTRequest.Method:=TRESTRequestMethod.rmGET;
LRESTRequest.Resource:='';
LRESTRequest.Response:=LRESTResponse;
LRESTRequest.Timeout:=ATimeout; //:默认值100
//同步执行:
try
try
try
LRESTRequest.Execute;
//产生请求异常的响应结果://LRestReqStatusCode:=200; //:正确的返回//LRestReqStatusText:='OK';//:正确的返回
except
try
{
LRestReqErr:=ERequestError.Create(
LRestReqStatusCode,LRestReqStatusText,LResultStr);
if LRestReqStatusCode<>0 then
//LRestReqStatusCode=0或LRestReqStatusText=''就不管什么情况反正出错了
//:如果是请求错误(不含任何网络异常和服务器错误)
//:所以不管请求,只用响应来做判断
else //:是响应错误:
}
begin
if LRESTRequest.Response.StatusCode=500 then
//or:if LRESTRequest.Response.StatusText.Contains('Internal Server Erro')
LResultStr:='{"result":["服务器内部错误:Internal Server Erro"]}'
else //:内部服务器错误:调用了,但请求格式错误或参数错误导致不能成功产生响应
if not (LRESTRequest.Response.StatusCode=500)
and not (LRESTRequest.Response.Status.SucessCreated_201)
//:内部服务器无错误:调用了,但服务器无网络或服务器未能成功启动数据库问题导致不能成功产生响应
then
LResultStr:='{"result":["服务器网络故障:可能Net Error或Server not started或Database Error"]}'
else
LResultStr:=
'ClientErrorBadRequest_400:'+BooltoStr(LRESTRequest.Response.Status.ClientErrorBadRequest_400,true)
+sLineBreak+'ClientErrorUnauthorized_401:'+BooltoStr(LRESTRequest.Response.Status.ClientErrorUnauthorized_401,true)
+sLineBreak+'ClientErrorForbidden_403:'+BooltoStr(LRESTRequest.Response.Status.ClientErrorForbidden_403,true)
+sLineBreak+'ClientErrorNotFound_404:'+BooltoStr(LRESTRequest.Response.Status.ClientErrorNotFound_404,true)
+sLineBreak+'ClientErrorNotAcceptable_406:'+BooltoStr(LRESTRequest.Response.Status.ClientErrorNotAcceptable_406,true)
+sLineBreak+'ClientErrorDuplicate_409:'+BooltoStr(LRESTRequest.Response.Status.ClientErrorDuplicate_409,true)
;
end;
finally
//LRestReqErr.Free;
end;
end;
finally
if not LResultStr.Contains('Error') then
LResultStr:='{"result":["成功执行:Success"]}';
//:直接返回成功执行的Json格式字符串
end;
finally
//LResultStr:=LRESTRequest.Response.Content;
Result:=LResultStr;//:返回Json格式字符串
//释放Rest组件:
LRESTClient.Free;
LRESTRequest.Free;
LRESTResponse.Free;
end;
end;
procedure KillExceptNodelphi(AExceptNodelphi:Boolean);
begin
if AExceptNodelphi then
JITEnable:=1 else JITEnable:=0;
if JITEnable=1 then NoErrMsg:=true else NoErrMsg:=false;
//KillExceptNodelphi(true);//:非delphi异常就过滤掉并不弹出提示框
//KillExceptNodelphi(false);//:true用完后应当及时false弹出提示框
end;
function IntendChar(
AAnsiChar:Char;
ACharNums:ShortInt):string;
var LNums:ShortInt;
begin
// #32:空格
//if length(AAnsiChar)=0 then
if ByteLength(AAnsiChar)=0 then
begin
Result:='';
exit;
end;
Result:='';
for LNums := 0 to ACharNums-1 do
Result:= Result +AAnsiChar;
end;
///根据组件名或对象名返回对象的元类
function FindAnyClass(const Name: string): TClass;
var
ctx: TRttiContext;
typ: TRttiType;
list: TArray;
begin
Result := nil;
ctx := TRttiContext.Create;
list := ctx.GetTypes;
for typ in list do
begin
if typ.IsInstance //:是实例化的类型
//and typ.IsManaged //:不能用:源代码意思好像是指的基本的数据类型或tkClass被UI引用:TypeInfo^.Kind
//and typ.IsPublicType //:是公开的类型
and SameStr( Uppercase(Name),Uppercase(typ.Name) )
and (Uppercase(Name)<>'TFRAME')//:相当于: and (typ.ClassName<>TFRAME.ClassName)
then
begin
Result := typ.AsInstance.MetaClassType;
break;
end
else
begin
Result := nil;
continue;
end;
end;
ctx.Free;
end;
///Fmx返回是否成功,回调所有组件的TRttiType的实例TRttiInstanceType的元类的类名:
function FillFmxClasses(
ATStrings:TStrings;
AIfRttiTypeList:Boolean=false): Boolean;
var
ctx: TRttiContext;
typ: TRttiType;
list: TArray;
begin
Result:=false;
ctx := TRttiContext.Create;
list := ctx.GetTypes;
for typ in list do
begin
if typ.IsInstance //:是实例化的类型
//and typ.IsManaged //:不能用:源代码意思好像是指的基本的数据类型或tkClass被UI引用:TypeInfo^.Kind
//and typ.IsPublicType //:是公开的类型
and (
typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.Types')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.Consts')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.StdCtrls')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.Graphics')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.ImgList')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.Edit')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.Text')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.TreeView')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.StdActns')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.ActnList')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.Layouts')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.TextLayout')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.Effects')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.Ani')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.BehaviorManager')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.Styles')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.VirtualKeyboard')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.AcceleratorKey')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.Presentation.Messages')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.Platform')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.Forms') //:FMX能获取TRttiType,VCL不能
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.Controls.Presentation')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.Controls.Model')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('FMX.Controls')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('Androidapi.JNI.Net.Wifi')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('TObject')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('System.Rtti')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('System.SyncObjs')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('System.Threading')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('System.Messaging')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('System.UITypes')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('System.SysUtils')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('System.Classes')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('System.TTypeKind')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('System')
or typ.AsInstance.MetaClassType.InheritsFrom(TObject) //TObject TClass TComponent TFmxObject
)
then
begin
case AIfRttiTypeList of
false:
if not typ.AsInstance.MetaClassType.ClassName.Contains('.') then //:不能获取TRttiType
//and not typ.AsInstance.MetaClassType.ClassName.Contains('<') //:不能获取TRttiType
ATStrings.Add(typ.AsInstance.MetaClassType.ClassName+sLineBreak);
true:
ATStrings.Add(typ.AsInstance.MetaClassType.ClassName
+':引用自:'
+typ.AsInstance.MetaClassType.QualifiedClassName
+sLineBreak+sLineBreak);
end;
end
else
begin
continue;
end
;
end;
ctx.Free;
if ATStrings.Count=0 then Result:=false
else Result:=true;
end;
///Vcl返回是否成功,回调所有组件的TRttiType的实例TRttiInstanceType的元类的类名:
function FillVclClasses(ATStrings:TStrings): Boolean;
{$IFDEF MSWINDOWS}
var
ctx: TRttiContext;
typ: TRttiType;
list: TArray;
{$ENDIF MSWINDOWS}
begin
Result:=false;
{$IFDEF MSWINDOWS}
ctx := TRttiContext.Create;
list := ctx.GetTypes;
for typ in list do
begin
if typ.IsInstance //:是实例化的类型
//and typ.IsManaged //:不能用:源代码意思好像是指的基本的数据类型或tkClass被UI引用:TypeInfo^.Kind
//and typ.IsPublicType //:是公开的类型
and (
typ.AsInstance.MetaClassType.QualifiedClassName.Contains('Vcl.StdCtrls')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('Vcl.ComCtrls')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('Vcl.ExtCtrls')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('Vcl.ActnList')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('Vcl.ImgList')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('Vcl.Graphics')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('Vcl.Menus')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('Vcl.Controls')
or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('TObject')
//or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('System.Classes')
//or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('Vcl.Themes') //:含枚举、集合、泛型列表和泛型字典
//or typ.AsInstance.MetaClassType.QualifiedClassName.Contains('Vcl.Forms') //:不能获取TRttiType
)
then
begin
ATStrings.Add(typ.AsInstance.MetaClassType.ClassName+sLineBreak);
end
else
begin
continue;
end
;
end;
ctx.Free;
if ATStrings.Count=0 then Result:=false
else Result:=true;
{$ENDIF MSWINDOWS}
end;
//ChangeX进制转化及字符串编码类的函数及方法
class function ChangeX.UnicodeStrToStr(AUnicodeStr:String):string;
var
LStrBytes:UCS4String;//Array of UCS4Char; UCS4Char = type Cardinal;
LLength:Integer;
LStringList:TStringList;
LWideString:string;
begin
LWideString:='';
LStringList:=TStringList.Create;
try //'\':#92 'U':#85 '\u':#117 '$':#36 space:' ':#32
myItems_Delimiter(AUnicodeStr,char(92),LStringList);
SetLength(LStrBytes,LStringList.Count);
for LLength:=0 to (LStringList.Count)-1 do
begin
LStrBytes[LLength]:=
HexToDex(
LStringList[LLength].ToLower //Lowercase()=.ToLower
.Replace( char(117),char(32) ).Trim
).ToInteger;
end;
LWideString:=UCS4StringToWideString(LStrBytes);
Result:=LWideString;
finally
LStringList.Free;
end;
end;
class function ChangeX.StrToUnicodeStr(ADefultStr:String):string;
var
LStrBytes:UCS4String;//Array of UCS4Char; UCS4Char = type Cardinal;
LLength:Integer;
LUnicodeStrHex4:string;
begin
LUnicodeStrHex4:='';
LStrBytes:=WideCharToUCS4String( PWideChar(ADefultStr) );
for LLength := 0 to length(LStrBytes)-1 do
begin
LUnicodeStrHex4 :=LUnicodeStrHex4
+'\u' +IntToHex(LStrBytes[LLength],4);
//:字符串的unicode编码(求Unicode16进制表示的每个字符):
//:16进制每个字符默认8位字节,只取其4位字节
//:只取其4位字节且在其前加'\u'代表其unicode编码
//:其中unicode字符串的最后1个字符'\u0000',代表其结束标志
//:结果:\u6211\u662F\u0064\u0068\u0025\uFF05\u4F60\u5144\u5F1F\u0000
end;
Result:=LUnicodeStrHex4;
end;
class function ChangeX.HexToDex(AHexNum:string):string;
var LResultDexInt:Integer;
begin
if TryStrToInt( ('$'+AHexNum),LResultDexInt )=True then
Result:=IntToStr(LResultDexInt)
else Result:='';
end;
class function ChangeX.DexToHex(ADexNum:string):string;
var
LDex:Integer;
begin
LDex:=StrToInt(ADexNum);
Result:=IntToHex(LDex,2);
end;
//TMyTreeView
function TMyTreeView.DoExpandAllorCollapseAll(
ATreeView:TTreeView):Boolean;
//:TreeView全部展开或全部收拢
begin
FIFCollapse:=not FIFCollapse;
if FIFCollapse=false then
ATreeView.CollapseAll //:收拢
else ATreeView.ExpandAll; //:展开
Result:=FIFCollapse;
end;
procedure TMyTreeView.OnChangeCheck(AItem:TObject);
var LLoop,
LCountAllCheckedOfAParentItem,
LCountAllUnCheckedOfAParentItem :Integer;
LItem,
LParentItem: TTreeViewItem;
begin
inherited DoChangeCheck(AItem as TTreeViewItem);
LItem := TTreeViewItem(AItem as TTreeViewItem);
for LLoop:=0 to LItem.Count - 1 do
LItem.Items[LLoop].IsChecked := LItem.IsChecked;
if TTreeViewItem(LItem).ParentItem<>nil then
begin
LParentItem :=TTreeViewItem(LItem).ParentItem;
LCountAllCheckedOfAParentItem:=0;
for LLoop:=0 to LParentItem.Count - 1 do
if LParentItem.Items[LLoop].IsChecked=true then
LCountAllCheckedOfAParentItem
:=LCountAllCheckedOfAParentItem+1;
if LCountAllCheckedOfAParentItem=LParentItem.Count then
begin
LParentItem.IsChecked:=true;
end;
LCountAllUnCheckedOfAParentItem:=LParentItem.Count;
for LLoop:=0 to LParentItem.Count - 1 do
if LParentItem.Items[LLoop].IsChecked=false then
LCountAllUnCheckedOfAParentItem
:=LCountAllUnCheckedOfAParentItem-1;
if LCountAllUnCheckedOfAParentItem=0 then
begin
LParentItem.IsChecked:=false;
end;
end;
end;
constructor TMyTreeView.Create(AOwner: TComponent);
begin
inherited; //:首先继承
if (LTreeView=nil) then
FTreeView:=self
else FTreeView:=LTreeView;
if (LImageList=nil) then
FImageList:=self.Images
else FImageList:=LImageList;
end;
class function TMyTreeView.CreateATreeViewItems(
const AIndex:Integer;
AName:string;
AText:string;
ATreeFiledName:string;
AParent:TFmxObject;
//:非常关键的参数:指明该节点:
//:其父节点是TTreeView还是它的上级递归TTreeViewItem
AImageList: TCustomImageList;
ImageIndex:Integer;
ASizeHeight,ASizeWidth:Single;
MarginsLeft:Single;
AOwnerObject:TFmxObject;
ATNotifyEvent:TNotifyEvent=nil
):TTreeViewItem;
var LTreeViewItem:TTreeViewItem;
begin
//if FTreeView<>nil then
//InitATreeViewItems(FTreeView,AImageList,FIFInited);
LTreeViewItem:=TTreeViewItem.Create( AOwnerObject ); //:所有者:应为窗体或TFrame
LTreeViewItem.Index:=AIndex;//:索引会被TTreeView的节点自动索引所覆盖：应使用自定义索引LTreeViewItem.Tag
LTreeViewItem.Name:=AName; //:节点命名:不能重复
LTreeViewItem.Text:=AText; //:节点的显示文本
LTreeViewItem.Parent:=AParent;//:父组件:关键:父组件可以是TreeView,也可以是某个TreeViewItem节点
//LTreeViewItem.TagString:=ATreeFiledName.Trim+'='+AParent.Name;
LTreeViewItem.TagString:=ATreeFiledName.Trim+'='+AText;
//:节点内部的个性化标签文字
LTreeViewItem.ImageIndex:=ImageIndex; //:节点的个性化图片索引
LTreeViewItem.Tag:=AIndex; //:自定义索引LTreeViewItem.Tag
// SetLength(FTreeViewItemCheckedCount,LTreeViewItem.Tag+1);
// FTreeViewItemCheckedCount[LTreeViewItem.Tag]:=0;
//:初始化TreeViewItem勾中数组TreeView.OnChangeCheck
LTreeViewItem.Align:=TAlignLayout.Left;
LTreeViewItem.IsChecked:=false;
LTreeViewItem.IsExpanded:=false;
LTreeViewItem.IsSelected:=false;
LTreeViewItem.StyleLookup:='treeviewitemstyle';
//:继承即:scrollboxstyle.background.content
LTreeViewItem.StyledSettings:=
LTreeViewItem.StyledSettings-
[TStyledSetting.Family,
TStyledSetting.Size,
TStyledSetting.FontColor,
TStyledSetting.Other
];
LTreeViewItem.TextSettings.FontColor:=
//TAlphaColorRec.White;
TAlphaColor($FF1373A9);
LTreeViewItem.TextSettings.Font.Family:='微软雅黑';
LTreeViewItem.TextSettings.Font.Size:=16;
LTreeViewItem.TextSettings.WordWrap:=true;
LTreeViewItem.Size.Height:=ASizeHeight;
LTreeViewItem.Size.Width:=ASizeWidth;
LTreeViewItem.Margins.Left:=MarginsLeft;
LTreeViewItem.Position.Y:= AIndex * 72;
LTreeViewItem.IsExpanded:=false;
LTreeViewItem.HelpKeyword:='双击复制到剪切板';
//LTreeViewItem.OnClick:=LAddObjectOnClick;
LTreeViewItem.OnClick:=ATNotifyEvent;
//OnDblClick
Result:=LTreeViewItem;
end;
class function TMyTreeView.InitATreeViewItems(
const ATreeView: TTreeView;
const AImageList: TCustomImageList=nil;
const AIFInited: Boolean=false ): Boolean;
begin
if ATreeView=nil then begin Result:=false; exit; end;
if AIFInited=false then //:尚未初始化
begin
ATreeView.Align:=TAlignLayout.Client;
ATreeView.AutoHide:=false;//:默认true会自动隐藏滚动条
ATreeView.DisableFocusEffect:=false;
ATreeView.Images:=AImageList;
ATreeView.ItemHeight:=72;//:产生的TreeViewItem的行高
ATreeView.Margins.Left:=5; ATreeView.Margins.Right:=5;
ATreeView.MultiSelect:=true;//:多行选择
ATreeView.Opacity:=1;//0.85;
ATreeView.ShowCheckboxes:=true;
ATreeView.ShowScrollBars:=true;
ATreeView.ShowSizeGrip:=true;//:显示对Size的控制
ATreeView.Sorted:=false;
//ATreeView.StyleLookup:='scrollboxstyle';//'treeviewstyle';
//ATreeView.ApplyStyleLookup;
Result:=true;
end;
end;
end.
七、我的统一平台函数单元myFuc_Client，无论D1-D7还是移动平台：//：详请下载下面的源码：
//我的部分统一平台函数单元myFuc_Client，无论D1-D7还是移动平台：
unit myFuc_Client;
//：详请下载下面的源码：
本博客关联文章：本文源码下载：https://download.csdn.net/download/pulledup/12578989
《TTreeView完整的枚举和递归算法》 https://blog.csdn.net/pulledup/article/details/103687816
喜欢的话，就在下面点个赞、收藏就好了，方便看下次的分享：