delphi XE 10实现App和PC下TreeView调用ImageList和Sqlite数据
2024-05-03 04:39:46
delphi XE 10实现App和PC下TreeView调用ImageList和Sqlite数据
一、工程
program TreeView;
usesSystem.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}
beginReportMemoryLeaksOnShutdown :=True;Application.Initialize;Application.CreateForm(TfmxMain, fmxMain);Application.Run;
end.二、主窗体
unit Main;
interface
usesSystem.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;
typeTfmxMain = 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;varfmxMain: TfmxMain;implementation
uses Unit1,Unit2;
{$R *.fmx}function myFuc(var APointer: Pointer):Pointer;
beginif APointer=nil then Result:=nilelse Result:=APointer;
end;procedure TfmxMain.ControlAction_Label1Execute(Sender: TObject);
beginif not Assigned(Form1) thenForm1 := TForm1.create(Application);//不Show出来就静默执行:Form1.Show;
end;procedure TfmxMain.ControlAction_Label2Execute(Sender: TObject);
begin//if Form2=nil then //:等效于:if not Assigned(Form2) thenForm2 := TForm2.create(Application);//if Assigned(Form2) then Form2.Label_Caption.Text:='过程指针类型始终与方法指针类型不兼容';//不Show出来就静默执行:Form2.Show;
end;procedure TfmxMain.FormShow(Sender: TObject);
beginLabel_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
usesSystem.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;
typeTForm1 = 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;varForm1: TForm1;implementation
uses myFuc_UnifiedPlatForm,myFuc_Client;
{$R *.fmx}procedure TForm1.ControlAction_btnExpandAllOrCollapseAllMenusExecute(Sender: TObject);
begin
//:伸缩: //ShowMessage('点了');FIFCollapse:=not FIFCollapse;if FIFCollapse=false thenTreeView_WorkSpace_Menus.CollapseAllelse 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<string>;//:被分割后的字符串数组LMenuNameDelim:string; //:被分割后的字符串LMenuNameDelimUpdated:string; //:被分割后的字符串发生了变化LCirclesDelim:Integer;//:字符串分割循环变量:高值:即数组LMenuNameStrArray长度-1LTreeViewItem:TTreeViewItem;
beginLImageStringList:=TStringList.Create;LImageListCount:=ImageList_Menus.Count;LMenuImageListIndex:=0;//0、准备数据源://1、将数据源加载到:TStringList数据源for LCircles := 0 to LImageListCount-1 dobeginLImageListItem:=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;trytry//2、TStringList数据源索引排序:LImageStringList.Sorted:=true;//:TStringList按照Pair的Name索引排序finallySystem.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 dobeginLImageStringListPair:=LImageStringList.Strings[LCircles];//:LImageStringListPair:财务管理-费用报销单=47LMenuName:=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<string>LMenuNameDelimCount:=Length(LMenuNameStrArray);//:获取循环高值:字符串动态数组TArray<string>的长度//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<>'')thenbegin //:根节点: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 dobeginLMenuNameDelim:=LMenuNameStrArray[LCirclesDelim];//:被分割后的字符串if (LMenuNameDelimUpdated.Trim=LMenuNameDelim.Trim) thenbegin//end elseif (LMenuNameDelimUpdated.Trim<>LMenuNameDelim.Trim)thenbeginMemo_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;finallyFreeAndNil(LImageStringList);end;end;function TForm1.CreateATreeViewItems(
const AIndex:Integer;AText:string;AParent:TFmxObject;//:非常关键的参数:指明该节点://:其父节点是TTreeView还是它的上级递归TTreeViewItemImageIndex:Integer;ASizeHeight,ASizeWidth:Single;MarginsLeft:Single;AOwnerObject:TFmxObject):TTreeViewItem;
var LTreeViewItem:TTreeViewItem;
beginInitATreeViewItems(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);
beginif AIFInited=false then //:尚未初始化beginATreeView.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);
beginFIFInited:=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;interfaceusesSystem.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;typeTForm2 = 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;///<summary>ControlAction动作:TTreeView取数:0、准备数据源;1、数据源本身已索引排序;2、TTreeView:TreeView_WorkSpace_Menus开始加载数据源的数据:</summary>procedure ControlAction_btnRenewMenusExecute(Sender: TObject);///<summary>ControlAction动作:TTreeView展开或收拢所有节点:</summary>procedure ControlAction_btnExpandAllOrCollapseAllMenusExecute(Sender: TObject);///<summary>ControlAction动作:遍历TreeView选中的节点:</summary>procedure ControlAction_btnEnumCheckedExecute(Sender: TObject);///<summary>ControlAction动作:遍历TreeView全选或全不选:</summary>procedure ControlAction_btnSelectAllOrNotExecute(Sender: TObject);///<summary>某节点TTreeViewItem被勾中或取消勾中处理其节点及其上下级节点:</summary>procedure TreeView_WorkSpace_MenusChangeCheck(Sender: TObject);///<summary>本地Sqlite数据库连接对象在连接前的处理事件:</summary>procedure FDConnSqliteBeforeConnect(Sender: TObject);procedure FormCreate(Sender: TObject);procedure FormClose(Sender: TObject; var Action: TCloseAction);procedure ControlAction_btnDeleteTreeItemExecute(Sender: TObject);///<summary>加树数据处理:</summary>procedure ControlAction_ListBox_Button_btnInsertExecute(Sender: TObject);///<summary>编枝数据处理:</summary>procedure ControlAction_ListBox_Button_btnEditExecute(Sender: TObject);///<summary>放弃处理编枝或加树:</summary>procedure ControlAction_ListBox_Button_btnCancelExecute(Sender: TObject);procedure ControlAction_btnAddNewTreeItemExecute(Sender: TObject);procedure ControlAction_btnAddNewTreeExecute(Sender: TObject);procedure FormShow(Sender: TObject);private{ Private declarations }///<summary>TTreeView及其从外部数据库是否完成初始化:</summary>FIFInited:Boolean;///<summary>TTreeView从外部数据库加载的sql:</summary>FSql:string;///<summary>TTreeView是否展开所有节点,调用者初始化传入默认:=false:</summary>FIFCollapse:Boolean;///<summary>全选或取消全选TTreeView的所有TTreeViewItem节点:</summary>FTreeViewSelectAllOrNot:Boolean;///<summary>当前TTreeViewItem节点:</summary>FTreeViewItemCurrt:TTreeViewItem;///<summary>当前TTreeViewItem节点的父节点:</summary>FTreeViewItemParent:TFmxObject;///<summary>动态新增的TreeViewItem节点的Tag整数唯一标识赋值:</summary>FTreeViewItemTag:Integer;///<summary>父节点的子节点增加1个打勾CreateATreeViewItems初始化:</summary>FTreeViewItemCheckedCount:TArray<Integer>;///<summary>父节点完成打勾(父已枚举)OnCreate调用者初始化传入:</summary>FErgodicParent:string;///<summary>加树还是编枝:</summary>FAddWhoParent:string;///<summary>当前窗体操作内存表FDMemTable_Main更新的总记录数:</summary>FDMemTable_Main_UpdatedCount:Integer;///<summary>TTreeView及其TreeViewItem属性的初始化:</summary>procedure InitATreeViewItems(const ATreeView: TTreeView;var AIFInited: Boolean); //:AIFInited调用者初始化传入默认:=false;///<summary>TTreeView的外部数据库FDQuery数据源初始化:</summary>procedure InitAFDQuery_Main(Sender: TObject; FDQuery: TFDQuery);///<summary>TreeView动态加载外部数据源的信息的过程方法:</summary>procedure TreeViewAddData(Sender: TObject; ATreeView: TTreeView);///<summary>TreeView动态加载外部数据源的字段值信息并生成动态新增的TreeViewItem节点:</summary>///<param name="AIndex">新增TTreeViewItem的索引号:</param>///<param name="AName">新增TTreeViewItem的名称:</param>///<param name="AText">新增TTreeViewItem的显示名:</param>///<param name="ATreeFiledName">新增的TTreeViewItem对应的外部数据源的字段名:</param>///<param name="AParent">新增TTreeViewItem的父节点父组件:关键:父组件可以是TreeView,也可以是某个TreeViewItem节点:</param>///<param name="ImageIndex">新增TTreeViewItem的TImageList中的图片索引号:</param>///<param name="ASizeHeight">新增TTreeViewItem的高Height:</param>///<param name="ASizeWidth">新增TTreeViewItem的宽Width:</param>///<param name="MarginsLeft">新增TTreeViewItem的左边界像素整数:</param>///<param name="AOwnerObject">新增TTreeViewItem的所有者:</param>///<returns> 如果过程方法 <b>InitATreeViewItems</b> 在此函数中执行后 <b>初始化</b> 成功 <c>则返回:TTreeViewItem</c> </returns>/// <remarks> 这个函数对FMX及VCL均通用 </remarks>function CreateATreeViewItems(const AIndex: Integer;AName:string;AText: string;ATreeFiledName:string;AParent: TFmxObject; ImageIndex: Integer; ASizeHeight, ASizeWidth,MarginsLeft: Single; AOwnerObject: TFmxObject):TTreeViewItem;///<summary>TTreeViewItem某节点被点击及展开切换的事件:</summary>procedure LAddObjectOnClick(Sender: TObject);///<summary>枚举TreeView选中的节点并决定是否变更选中状态,返回处理节点的列表TStringList:</summary>function EnumChecked(const AIFAncester:Boolean=true;AIFUpdateCheckedStatus:Boolean=true):TStringList;///<summary>TTreeView更新节点UI数据处理:</summary>function TreeViewItemUpdateData(AOperation:string;ABtnText:string;AFmxObject:TFmxObject):TTreeViewItem;///<summary>内存表FDMemTable_Main根据TTreeView节点UI数据更新而更新记录:</summary>function FDMemTable_Main_Update: Integer;public{ Public declarations }///<summary>FTFDMemTable_Main:传入后赋值给:本窗体组件FDMemTable_Main:</summary>FTFDMemTable_Main:TFDMemTable;///<summary>远程数据库某TreeView表的当前最大自增长数seeds_id,被调用者传入:</summary>FAddseeds_idCount:Integer;///<summary>远程数据库新增的某TreeView表的SortId,被调用者传入:</summary>FNewSortId_RemoteDataBaseTable:string;///<summary>调用本地数据库的ASql的表对象所对应的基础资料数据:</summary>procedure LoadLoacalDataTreetype(ASql:string);end;var FSqlite3Path,FSqlite3BackupPath :string;FSqlite3BackupFileName :string='CarveoutO2OBackup.s3db';FSqlite3FileName :string='CarveoutO2OTest.s3db';
varForm2: TForm2;function FTreeViewItemCurrtFieldSortid(ATreeViewItem:TTreeViewItem):string;implementation
usesmyFuc_UnifiedPlatForm,myFuc_Client;
varFTreeView:TMyTreeView;
{$R *.fmx}typeTProcedureMyProc = procedure; //:过程类型TMethodMyMethod = procedure of object; //:方法类型
varFmyProc:TProcedureMyProc; //:过程指针变量FmyMethod:TMethodMyMethod; //:方法指针变量
varFmyFunc_Pointer:Pointer; //:普通指针变量function myFunc(var APointer:Pointer):Pointer; //:函数:可供方法指针或过程指针调用,当然也可供方法或过程调用//var LAPointer:^Integer;
begin //LAPointer:=Pointer(1);if APointer=nil then Result:=nilelse Result:=APointer;
end;procedure myProc; //:过程
var LRef:Integer;
beginLRef:=1;@FmyProc:=@myProc; //:@myProc等价于:Pointer(myProc);FmyProc:=myProc;FmyFunc_Pointer:=myFunc(@FmyProc); //FmyProc:=nil;
end;function myMethod :string; //:函数:可供方法指针或过程指针调用,当然也可供方法或过程调用
var LRef:Integer;LStr:string;
beginLRef:=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) thenMemo_Test.Lines.Add(' 返回Assigned(@myProc)=true,方法指针能识别Assigned(@myProc),内存中的内容: '+PChar(@myProc) );if @myProc<>nil thenMemo_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) ) thenMemo_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=nilbeginMemo_Test.Lines.Add(' @FmyProc=nil');myProc;end else Memo_Test.Lines.Add(' 过程FmyProc及过程指针@FmyProc均不能识别Assigned');if FmyFunc_Pointer<>nil then //: 过程指针变量也能识别@FmyProc=nilMemo_Test.Lines.Add(' FmyFunc_Pointer<>nil,过程指针变量的内存值: '+PChar(@FmyFunc_Pointer) );if (@myProc<>nil) and (@FmyFunc_Pointer<>nil) thenbeginMemo_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);
beginForm2:=nil; //:close前先强制nil掉窗体对象,这样写会更安全些close;
end;procedure TForm2.FormCreate(Sender: TObject);
var LTreeView:TMyTreeView;
beginLTreeView:=TMyTreeView.Create(self);//TreeView_WorkSpace_MenusTreeView_WorkSpace_Menus.OnChangeCheck:=LTreeView.OnChangeCheck;tryif 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;finallyControlAction_btnRenewMenus.Execute;end;
end;procedure TForm2.InitATreeViewItems(const ATreeView: TTreeView;var AIFInited: Boolean);
beginif AIFInited=false then //:尚未初始化beginFIFInited:=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}trytryif TFile.Exists(productTextFile('',FSqlite3FileName))=false thenexit; //else ShowAMessage('存在数据库文件',procedure begin end)FDConnSqlite.ConnectionDefName:='CarveoutTest';//FDConnSqlite.DriverName:='SQLite';//:定义后会在运行时报错:只需定义连接定义名ConnectionDefName//if (FDConnSqlite.Connected=false) then//FDConnSqlite.Connected:=true;finallyFDQuery.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;exceptShowAMessage('打开数据库时发生错误!请联系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.GetLibraryPathif System.IOUtils.TFile.Exists(FSqlite3BackupPath)=false thenSystem.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 thenSystem.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 = trueFSqlite3FileName);if System.IOUtils.TFile.Exists(FSqlite3BackupPath)=false thenSystem.SysUtils.ForceDirectories(System.IOUtils.TPath.Combine(System.IOUtils.TPath.GetDocumentsPath ,'dbBackup') );{$ENDIF IOS}tryif System.IOUtils.TFile.Exists(FSqlite3BackupPath)=false thenbeginSystem.IOUtils.TFile.Copy(FSqlite3Path,FSqlite3BackupPath);end;finallyif System.IOUtils.TFile.Exists(FSqlite3BackupPath)=true thenFDConnSqlite.Params.Values['Database']:=FSqlite3Path;end;//测试:Label_Caption.Text:=FSqlite3Path;
end;procedure TForm2.ControlAction_btnExpandAllOrCollapseAllMenusExecute(Sender: TObject);
beginif not Assigned(FTreeView) thenFTreeView:=TMyTreeView.Create(self);FTreeView.DoExpandAllorCollapseAll(TreeView_WorkSpace_Menus);
{
//:伸缩: //ShowMessage('点了');FIFCollapse:=not FIFCollapse;if FIFCollapse=false thenTreeView_WorkSpace_Menus.CollapseAllelse 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
beginif FIFInited=True then //:若已完成初始化beginFDQuery_Main.DisableControls;FDQuery_Main.SQL.Text:=ASql;FDQuery_Main.EnableControls;trytryif not (FDQuery_Main.Connection.Connected=true) thenFDQuery_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;//下面测试看看获取的数据:{tryMemo_Test.BringToFront; Memo_Test.Visible:=true;Memo_Test.Lines.Clear;System.TMonitor.Enter(Memo_Test,0);Memo_Test.BeginUpdate;//:循环变量FCircle、递归循环变量FRecursewhile not (FDMemTable_Main.Eof) dobegin//for FCircle := 0 to FDMemTable_Main.RecordCount-1 doMemo_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);finallyend;//}end;exceptShowAMessage('打开数据表错误！',procedure begin end);end;end;end;procedure TForm2.TreeViewAddData(Sender: TObject;ATreeView:TTreeView);
var LCircles,LRecurse:Integer;//:循环变量FCircle、递归循环变量FRecurseLTTreeViewItem:TTreeViewItem;LMenuNameDelimUpdated:string; //:被分割后的字符串发生了变化LMenuImageListIndex:Integer;
begin//:TTreeView产生子节点: CreateATreeViewItemsif 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 dobeginif FDMemTable_Main.FieldByName('upper_sort_id').AsString.Trim='' thenbegin //:没有上级:TreeviewItem的父节点=TreeviewLTTreeViewItem:=CreateATreeViewItems((LCircles), //:索引号('TreeViewItem_WorkSpace_Menus_'+FDMemTable_Main.FieldByName('sort_id').AsString.Trim),//:产生TreeviewItem的nameFDMemTable_Main.FieldByName('sort_name').AsString.Trim,//:产生TreeviewItem的TextFDMemTable_Main.FieldByName('sort_id').AsString.Trim,(TreeView_WorkSpace_Menus as TFmxObject),//:父组件的TFmxObjectLMenuImageListIndex, //:图片索引号40,330,5, //:位置尺寸self //:所有者:应为窗体或TFrame);end;if FDMemTable_Main.FieldByName('upper_sort_id').AsString.Trim<>'' thenbegin //:没有上级:TreeviewItem的父节点=TreeviewItemCreateATreeViewItems((LCircles), //:索引号('TreeViewItem_WorkSpace_Menus_'+FDMemTable_Main.FieldByName('sort_id').AsString.Trim),//:产生TreeviewItem的nameFDMemTable_Main.FieldByName('sort_name').AsString.Trim,//:产生TreeviewItem的TextFDMemTable_Main.FieldByName('sort_id').AsString.Trim,( (FindComponent('TreeViewItem_WorkSpace_Menus_'+FDMemTable_Main.FieldByName('upper_sort_id').AsString.Trim)) as TFmxObject),//:父组件的TFmxObjectLMenuImageListIndex, //:图片索引号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还是它的上级递归TTreeViewItemImageIndex:Integer;ASizeHeight,ASizeWidth:Single;MarginsLeft:Single;AOwnerObject:TFmxObject):TTreeViewItem;
var LTreeViewItem:TTreeViewItem;
beginInitATreeViewItems(TreeView_WorkSpace_Menus,FIFInited);LTreeViewItem:=TTreeViewItem.Create( AOwnerObject ); //:所有者:应为窗体或TFrameLTreeViewItem.Index:=AIndex;//:索引会被TTreeView的节点自动索引所覆盖：应使用自定义索引LTreeViewItem.TagLTreeViewItem.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.TagSetLength(FTreeViewItemCheckedCount,LTreeViewItem.Tag+1);FTreeViewItemCheckedCount[LTreeViewItem.Tag]:=0;//:初始化TreeViewItem勾中数组TreeView.OnChangeCheckLTreeViewItem.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 TFmxObjectFTreeViewItemCurrt:=(Sender as TTreeViewItem);FTreeViewItemCurrt.SetFocus;FTreeViewItemCurrt.IsSelected:=true;if (Sender as TTreeViewItem).Level>1 thenbegin//:节点级数Level>1下级N:TTreeViewItemFTreeViewItemCurrt:=Sender as TTreeViewItem;FTreeViewItemParent:=((Sender as TTreeViewItem).ParentItem) as TTreeViewItem;//ShowAMessage('点了该节点:'+FTreeViewItemCurrt.Name+',父节点:'+FTreeViewItemParent.Name,procedure begin end);endelsebegin//Level=1顶级节点的父:TTreeView:FTreeViewItemCurrt:=Sender as TTreeViewItem;FTreeViewItemParent:=TreeView_WorkSpace_Menus;//ShowAMessage('点了该节点:'+FTreeViewItemCurrt.Name+',父节点:'+FTreeViewItemParent.Name,procedure begin end);end;if FTreeViewItemCurrt.IsExpanded=false thenFTreeViewItemCurrt.IsExpanded:=trueelse 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 thenbeginif (LLevel>1) then//:基线条件begintryif FTreeViewItemCheckedCount[FTreeViewItemTag]< (LFmxObject as TTreeViewItem).ParentItem.Count thenbeginif FErgodicParent<>'父已枚举' thenINC(FTreeViewItemCheckedCount[FTreeViewItemTag]);//:上级+1FErgodicParent:='';Memo_Test.Lines.Add('枚举对象:'+(Sender as TTreeViewItem).Text+':上级:'+(Sender as TTreeViewItem).ParentItem.Text+':被勾中数:'+IntToStr(FTreeViewItemCheckedCount[FTreeViewItemTag]) );end;finallyif FTreeViewItemCheckedCount[FTreeViewItemTag]= (Sender as TTreeViewItem).ParentItem.Count thenbeginFErgodicParent:='父已枚举';if (Sender as TTreeViewItem).ParentItem.IsChecked=false then(Sender as TTreeViewItem).ParentItem.IsChecked:=true;//:开始递归:上级枚举end;end;end elseif (LLevel=1) then//:基线条件beginif FTreeViewItemCheckedCount[FTreeViewItemTag]< (LFmxObject as TTreeViewItem).Count thenbeginif FErgodicParent<>'父已枚举' thenINC(FTreeViewItemCheckedCount[FTreeViewItemTag]);//:上级+1FErgodicParent:='';Memo_Test.Lines.Add('枚举对象:'+(Sender as TTreeViewItem).Text+':上级:'+(Sender as TTreeViewItem).Text+':被勾中数:'+IntToStr(FTreeViewItemCheckedCount[FTreeViewItemTag]) );end;end;end elseif (LFmxObject as TTreeViewItem).IsChecked=false thenbeginif (LLevel>1) then//:基线条件begintryif FTreeViewItemCheckedCount[FTreeViewItemTag]>0 thenbeginif FErgodicParent<>'父已枚举' thenDEC(FTreeViewItemCheckedCount[FTreeViewItemTag]);//:上级-1FErgodicParent:='';Memo_Test.Lines.Add('枚举对象:'+(Sender as TTreeViewItem).Text+':上级:'+(Sender as TTreeViewItem).ParentItem.Text+':被勾中数:'+IntToStr(FTreeViewItemCheckedCount[FTreeViewItemTag]) );end;finallyif FTreeViewItemCheckedCount[FTreeViewItemTag]=0//< (LFmxObject as TTreeViewItem).ParentItem.CountthenbeginFErgodicParent:='父已枚举';if (Sender as TTreeViewItem).ParentItem.IsChecked=true then(Sender as TTreeViewItem).ParentItem.IsChecked:=false;//:开始递归:上级枚举end;end;end elseif (LLevel=1) then//:基线条件begintryif FTreeViewItemCheckedCount[FTreeViewItemTag]>0 thenbeginif FErgodicParent<>'父已枚举' thenDEC(FTreeViewItemCheckedCount[FTreeViewItemTag]);//:上级-1FErgodicParent:='';Memo_Test.Lines.Add('枚举对象:'+(Sender as TTreeViewItem).Text+':上级:'+(Sender as TTreeViewItem).Text+':被勾中数:'+IntToStr(FTreeViewItemCheckedCount[FTreeViewItemTag]) );end;finallyend;end;end;//2、处理ChangeCheck的本级枚举:tryFErgodicParent:='';LFmxObject.EnumObjects(//const Proc: TFunc<TFmxObject, TEnumProcResult>function (LControl:TFmxObject):TEnumProcResultvar LEnumProcResult:TEnumProcResult;begin//2.1、处理ChangeCheck的本级枚举到其下级:if LControl.ClassName=EnumControlClassName thenbeginif EnumControlClassName='TTreeViewItem' thenbeginif (LFmxObject as TTreeViewItem).IsChecked=true thenbegin//Memo_Test.Lines.Add('枚举到了下级');if (LControl as TTreeViewItem).IsChecked=false thenbegin(LControl as TTreeViewItem).IsChecked:=true;end;//:开始递归:(本级有下级)中间级枚举end;if (LFmxObject as TTreeViewItem).IsChecked=false thenbeginif (LControl as TTreeViewItem).IsChecked=true thenbegin(LControl as TTreeViewItem).IsChecked:=false;end;//:开始递归:(本级有下级)中间级枚举end;end;end;//2.1、处理ChangeCheck的本级枚举为末级:if LControl.ClassName<>EnumControlClassName thenbegin//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);finallyend;end;
//}
begin
{if FIFInited=false then exit//:必须先完成初始化: 初始化在Checked:=falseelsebeginLLevel:=(Sender as TTreeViewItem).Level;if (LLevel=1) thenbeginFTreeViewItemTag:=(Sender as TTreeViewItem).Tag;//1、枚举子节点及其下级节点,自动勾或去勾://:同时子节点会开始递归本单元:LEnumControls((Sender as TTreeViewItem),'TTreeViewItem');end elseif (LLevel>1) thenbeginFTreeViewItemTag:=(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='全选'thenbegintryLabel_WorkSpace_Button_btnSelectAllOrNot.Text:='取消';finallyEnumChecked(true,FTreeViewSelectAllOrNot);end;end elsebegintryLabel_WorkSpace_Button_btnSelectAllOrNot.Text:='全选';finallyEnumChecked(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<string>;LLineStrOfStringList:string;
begin
//枚举TreeView选中的节点并决定是否变更选中状态：LStringList:=TStringList.Create;LTempStringList:=TStringList.Create;tryTreeView_WorkSpace_Menus.EnumControls(procedure (const AControl: TControl; var Done: boolean)beginif (AControl.ClassName = 'TTreeViewItem') thenbeginLAddObject:=TTreeViewItem(AControl);if (AIFUpdateCheckedStatus=true) thenbeginif (LAddObject as TTreeViewItem).Level=1 thenbeginif (LAddObject as TTreeViewItem).IsChecked=false thenbegin(LAddObject as TTreeViewItem).IsChecked:=True;endelse if (LAddObject as TTreeViewItem).IsChecked=True thenbegin(LAddObject as TTreeViewItem).IsChecked:=false;end;end;end;if (AIFUpdateCheckedStatus=false) thenbeginif (LAddObject as TTreeViewItem).IsChecked=True thenbeginif (AIFAncester=true) thenbeginif (LAddObject.TagString).Substring((LAddObject.TagString).IndexOf('=')+1,length(LAddObject.TagString) )=(LAddObject as TTreeViewItem).TextthenLStringList.Add(LAddObject.TagString);//:格式:LTreeViewItem.TagString:=ATreeFiledName.Trim+'='+AParent.Name;end elseif (AIFAncester=false) thenbeginif ( (LAddObject as TTreeViewItem).Count=0 )then //:找到末级反推上级:处理打勾操作beginif (LAddObject as TTreeViewItem).Level>1 thenbeginif ((LAddObject as TTreeViewItem).ParentItem.Count=FTreeViewItemCheckedCount[(LAddObject as TTreeViewItem).ParentItem.Tag]) thenbegin //:找到了上级打勾:即下级全打勾if LStringList.Text.Contains((LAddObject as TTreeViewItem).ParentItem.TagString)=false thenbegin//Memo_Test.Lines.Add('找到了上级打勾');LStringList.Add((LAddObject as TTreeViewItem).ParentItem.TagString);end;end elsebegin //:else:找到了只有个别下级打勾if LStringList.Text.Contains((LAddObject as TTreeViewItem).TagString)=false thenbegin//Memo_Test.Lines.Add('找到了只有个别下级打勾');LStringList.Add((LAddObject as TTreeViewItem).TagString);end;end;end;if (LAddObject as TTreeViewItem).Level=1 thenbegin //:末级是顶级if LStringList.Text.Contains((LAddObject as TTreeViewItem).TagString)=false thenbegin//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 dobeginSetLength(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 dobeginLLineStrOfStringList:=LStringList[LCircle].Split(LSeparator[0])[0];for LLineStrOfStringList in LTempStringList dobeginif ( LTempStringList[LCircle].IndexOf(LLineStrOfStringList)>=0 )and ( LTempStringList[LCircle]<>LLineStrOfStringList ) thenLStringList.Delete(LCircle);end;end;for LCircle := 0 to LStringList.Count-1 dobeginSetLength(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]是数据库查询条件需要的数据finallyFreeAndNil(LStringList); FreeAndNil(LTempStringList);end;end;procedure TForm2.ControlAction_btnDeleteTreeItemExecute(Sender: TObject);
var LStringList:TStringList;LFTreeViewItemCurrtFieldSortId:string;LExps:string;
beginif not Assigned(FTreeViewItemCurrt) thenbeginShowAMessage('请先点中要删除的节点!',procedure begin end);endelsebeginMemo_Test.Lines.Add('点中啦:'+FTreeViewItemCurrt.Name+':'+FTreeViewItemCurrt.Text);LStringList:=TStringList.Create;trytry//1、对象及组件移除并讲清单赋值LStringList:FTreeViewItemCurrt.BeginUpdate;FTreeViewItemCurrt.EnumControls(procedure (const AControl: TControl; var Done: boolean)var LAddObject:TFmxObject;beginif (AControl.ClassName = 'TTreeViewItem') thenbeginLAddObject:=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) thenFDMemTable_Main.Active:=true;FDMemTable_Main.First;while not FDMemTable_Main.Eof dobeginif FDMemTable_Main.LocateEx(LExps,[],0)= true thenFDMemTable_Main.Delete;FDMemTable_Main.Next;end;//: 补代码:删除后台sqlite3数据库表中的数据...:FDMemTable_Main.ApplyUpdates();FDMemTable_Main.First;end;finallyFreeAndNil(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='加树进入' thenbegin //Label_WorkSpace_Button_btnAddNewTreeTreeViewItemUpdateData('加树','新增',TreeView_WorkSpace_Menus);end;if FAddWhoParent='编枝进入' thenbeginLTreeViewItem:=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 thenbeginShowAMessage('请先加载数据源！',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);
beginif FIFInited=false thenbeginShowAMessage('请先取数！',procedure begin end);Abort; //:尚未初始化end;if not Assigned(FTreeViewItemCurrt) thenbeginShowAMessage('请先点中要编枝的节点!',procedure begin end);endelsebeginRectangle_WorkSpace_ListBox_AddNewTreeORTreeItem.Visible:=true;Rectangle_WorkSpace_ListBox_Button_btnEdit.Visible:=true;Edit_TreeViewItem_Name.Text:=FTreeViewItemCurrt.Text.Trim;//:本节点显示名if FTreeViewItemCurrt.Level>1 thenbeginLabel_TreeViewItem_Name.Hint:=FTreeViewItemCurrtFieldSortid(FTreeViewItemCurrt);//:本节点编码Label_TreeViewItem_upper_sort_id.Hint:=FTreeViewItemCurrtFieldSortid(FTreeViewItemCurrt.ParentItem);//:上级节点编码Edit_TreeViewItem_upper_sort_id.Text:=FTreeViewItemCurrt.ParentItem.Text;//:上级节点显示名end elsebeginLabel_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;
beginif Assigned(ATreeViewItem) thenbeginLFTreeViewItemCurrtFieldSortid:=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;beginFDMemTable_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 thenFNewSortId_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的nameEdit_TreeViewItem_Name.Text.Trim,//:产生TreeviewItem的Text显示名FNewSortId_RemoteDataBaseTable, //:数据库表的sort_id内码LParent,//:父组件的TFmxObjectImageList_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 thenbeginif AOperation='加树' thenbegin //:TreeView UI加树:LParent:=(TreeView_WorkSpace_Menus as TFmxObject);LMarginsLeft:=5;AddATreeViewItem;Result:=LTreeViewItem;end;if AOperation='编枝' thenbegin //:TreeViewItem UI编枝:if ABtnText='新增' thenbeginMemo_Test.Lines.Add('点了编枝新增！');tryLParent:=FindComponent(FTreeViewItemCurrt.Name) as TTreeViewItem;LMarginsLeft:=15;finallyMemo_Test.Lines.Add('父:'+(LParent as TTreeViewItem).Name);AddATreeViewItem;end;Result:=LTreeViewItem;end else if ABtnText='编辑' thenbegin(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;interfaceusesSystem.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;typeTFrameTreeView = 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 thenTreeView_WorkSpace_Menus.CollapseAllelse TreeView_WorkSpace_Menus.ExpandAll;
end;function TFrameTreeView.CreateATreeViewItems(
const AIndex:Integer;AText:string;AParent:TFmxObject;//:非常关键的参数:指明该节点://:其父节点是TTreeView还是它的上级递归TTreeViewItemImageIndex:Integer;ASizeHeight,ASizeWidth:Single;MarginsLeft:Single;AOwnerObject:TFmxObject):TTreeViewItem;
var LTreeViewItem:TTreeViewItem;
beginInitATreeViewItems(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);
beginif AIFInited=false then //:尚未初始化beginFIFInited:=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默认不展开是收拢的:调用onFramePaintAIFInited:=true; //:初始化完毕FIFInited:=true;end;
end;procedure TFrameTreeView.FramePaint(Sender: TObject; Canvas: TCanvas;const ARect: TRectF);
beginif FIFInited=false then //:尚未初始化beginInitATreeViewItems(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}///<summary>全局电话管理 接口变量引用:</summary>var TelephonyManager: JTelephonyManager;
// ///<summary>Android请求权限的全局变量:</summary>
// var MyPermissions: TArray<String>;FCAMERA, FINSTANT_APP_FOREGROUND_SERVICE,FMANAGE_DOCUMENTS, FREAD_EXTERNAL_STORAGE, FWRITE_EXTERNAL_STORAGE:string;///<summary>通用调用手机应用的Intent和Uri：</summary>procedure Call_URI(const AAction: JString; const AURI: string);///<summary>获取本机所有联系人：</summary>function FetchContactInfo(var aReturnStr:TStringList): TStringList;///<summary>短信收件箱列表：</summary>function FetchSms: string;///<summary>'直接没有任何提示的【静默发长短信】www.pulledup.cn' : ：</summary>///<summary>不能超过70个字：否则函数自动先做分割后，分别发：：</summary>///<summary>收短信：是一次性1条收看的：：</summary>procedure SentSMS(phoneNumber, SMSstring: string); // 直接没有任何提示的发送短信///<summary>调用系统程序发短信：</summary>procedure SentSMSfromIntent(phoneNumber, SMSstring: string); // 调用系统程序发短信///<summary>打电话：</summary>procedure PhoneCall(phoneNumber: string);///<summary>获取Android手机的MEID号(即设备的ID非运营商的入网号):</summary>function GetAndroidMEID: string;///<summary>获取Android手机的IMEI号(即运营商的入网号,双卡就2个):</summary>function GetAndroidIMEI: string;///<summary>获取Android手机SIM卡串号：</summary>function GetSN: string;///<summary>Andoid获取本机号码:</summary>function myPhoneNumber:string;///<summary>Andoid7.0及其以下安装apk:</summary>procedure ToInstallApk70Down(Apk: string);///<summary>Andoid安装apk:</summary>procedure ToInstallApk(Apk: string);///<summary>Andoid请求某一系统权限:</summary>procedure AndoidRequestPermissions(const RequestPermissions:Array of string);
{$ENDIF ANDROID}///<summary>01、1-based字符串转换到0-based 的函数：</summary>///<summary>别乱用弄懂0-based：</summary>///<summary>如何修改1-based字符串的例子,适用所有平台：</summary>function strConvt1To0(const S: string): string;///<summary>02、字符串被myDelimiter字符符号分隔符分割的数值获取，</summary>///<summary>并将其赋值给一个 TStringList：</summary>procedure myItems_Delimiter(myStr:String; myDelimiter:Char; mySplitStrL:TStringList);//03、控制虚拟键盘：//事实上，高版本POSIX焦点移到输入控件，即可显示//事实上，高版本POSIX焦点移开至非输入按钮等，即可关闭procedure myVKeyboard(aFmxObject:TFmxObject; aControlStr:String);///<summary>04、比较字段的旧值是否等于新值：</summary>function compareOldNew(Field: TField): boolean; overload;///<summary>05、比较内存表的中各字段是否有变化：</summary>function compareOldNew(aFDMemTable: TFDMemTable): Boolean; overload;///<summary>06、比较字符串A和B是否相等：</summary>function compareOldNew(AString,BString: String): Boolean; overload;///<summary>07、求中文字符串的字节长度：</summary>function GetStrGBOfByteCount(Data: String): Integer;///<summary>08、函数功能：当Str不满Len长度时，在Str前自动填充FillStr以补足长度：</summary>function FillBeforeString(const SourceStr: string; Len: Integer; FillStr: string): string;///<summary>09、函数功能：当Str不满Len长度时，在Str后自动填充FillStr以补足长度：</summary>function FillAfterString(const SourceStr: string; Len: Integer; FillStr: string): string;///<summary>10、求混合类型的中文字符串中的非汉子字符的字符总数：</summary>function ifSingleByte(sString: string=''):Integer;///<summary>11、求当前进程实例的操作系统平台、CPU架构、版本信息,用","和";"分割：</summary>function getOsArchVer(const AInfoType:string=''):string;///<summary>求字符串的Unicode字节数：</summary>function getBytesCountOfStr(var Text:string):Integer;///<summary>正则表达式:01手机号验证：</summary>function IsMobileNumber(var Text:string;const opermode:string='结果验证';const ifReturnError:string=''): string;///<summary>产生预发送的随机的4位数字验证码：</summary>function RandomVerificCode: string;///<summary>产生随机的N位数字字符串：</summary>function RandomNumberStr(const aInt:Integer=20): string;///<summary>产生随机的N位数字的以某个数字开头的秒数字符串：</summary>function RandomTimeSecondsStr(const aIntBegin:Integer=1000;aIntEnd:Integer=2000): string;///<summary>产生小于设定的数值的1位随机正整数0~aInt-1）：</summary>function RandomNumber(const aInt:Integer=3): Integer;///<summary>从ImageList向TBitmap赋值，见其中调用示例：</summary>function ImgGetFromImgList(Const ImgList:TImageList;Const xPT,yPT:Integer;Const indexImgList:Integer): TBitmap;///<summary>半角Cbd转全角Dbd）:</summary>///<summary>半角全角互转原理(全角即汉子的字符编码范围的子界)：</summary>///<summary>全角空格为12288，半角空格为32</summary>///<summary>其他字符半角(33-126)与全角(65281-65374)的对应关系是：均相差65248</summary>function CbdToDbd(const Text:string=''): string;///<summary>全角Dbd转半角Cbd）:</summary>///<summary>半角全角互转原理(全角即汉子的字符编码范围的子界)：</summary>///<summary>全角空格为12288，半角空格为32</summary>///<summary>其他字符半角(33-126)与全角(65281-65374)的对应关系是：均相差65248</summary>function DbdToCbd(const Text:string='';const KillChinese:string='去中文'): string;///<summary>delphi自带Indy函数实现MD5加密:</summary>function getMyIndyMD5String(const aSignName:string) : string;///<summary>delphi自带Hash函数实现加密:</summary>function getMyHashString(const aSignName:string) : string;///<summary>服务器端设置APP存取的系统路径(含路径):</summary>///<summary>没有就产生,有就不产生,不会覆盖:</summary>function ServerSubPathOfAppPublished(APath:string='';AProducedSubPath:string=''):Boolean;///<summary>服务器端获取APP存取的系统路径(含路径):</summary>function ServerGetSubPathOfAppPublished(UploadOrDownload:string='Upload';AFileType:string='pic';AProducedSubPath:string='';IfPathThumbnail:Boolean=false):string;///<summary>设置Text格式的文本文件的系统路径(含路径):</summary>function productTextFile(const aSubPath:string='';const targetFileName:string=''):string;///<summary>获取系统登录状态及系统配置信息全局参数:</summary>///<summary>(其中含中文属多字节字符集需转化)</summary>procedure getSysConfig(const FileName:string='myFile.ini');///<summary>设置并保存系统登录状态及系统配置信息全局参数:</summary>procedure setSysConfig;///<summary>取得计时时间，单位毫秒(ms):</summary>function getMyStickCount(starttime,stoptime:TDateTime):Integer;///<summary>便于差异化数据库扩展,设置通用的日期时间字段的select列表字段，返回字符串:</summary>function getDatetime(const aDatetimeField:string='';const Database:string=''):string;///<summary>便于差异化数据库扩展,设置通用的日期时间字段的where条件字段，返回字符串:</summary>function whereDatetime(const aDatetimeField:string='';const Database:string=''):string;///<summary>数据集的记录转JSonArray字符串:用FDBatchMove方法，select计算列结果列含\：</summary>///<summary>与DataSet2JSONuseDataset比较:所有字段类型与其数值类型表达一致:</summary>///<summary>返回数据集的记录:不含字段定义:</summary>function DataSet2JSONuseFDBatchMove(ADataset: TDataSet): string;///<summary>数据集的记录转JSonArray字符串:用Dataset遍历拼接Json格式的方法：</summary>///<summary>与DataSet2JSONuseFDBatchMove比较:所有字段数值均以字符串形式表达:</summary>///<summary>返回数据集的记录:不含字段定义:</summary>///<summary>样例： [{"CityId":"18","CityName":"西安"},{"CityId":"53","CityName":"广州"}]</summary>function DataSet2JSONuseDataset(ADataset: TDataSet): string;///<summary>FieldType转DML语句字段列属性字串:</summary>function FieldTypeToDMLFieldProperstr(AField: TField;AFieldType: TFieldType): string;///<summary>全局平台服务异步对话框服务-简单提示框:</summary>procedure ShowAMessage(const AMessage:string; const AProc:TProc);overload;///<summary>全局平台服务异步对话框服务-简单提示框:</summary>procedure ShowAMessage(const AMessage:string;const AX, AY: Integer);overload;///<summary>全局通用截屏方法:</summary>procedure FMakeScreenshot(ATControl:TControl;AImage:TImage);///<summary>强制设置TControl焦点,返回是否获得焦点:</summary>///<param name="ATControl">uses FMX.Controls,FMX.Objects;</param>function FocusMe(const ATControl:TControl):Boolean;///<summary>全局FMX窗体服务:uses FMX.Forms:</summary>var FFmxWindowService:IFMXWindowService;///<summary>全局剪切板接口:uses FMX.Platform:</summary>var FClipBoard:IFMXClipboardService;///<summary>全局剪切板获取的数值:uses System.Rtti:</summary>var FClipBoardValue:TValue; //:全局剪切板获取的数值///<summary>全局剪切板获取对象属性的泛型值:</summary>function ClipBoardGetObjectValue(const ATControl:TObject):Boolean;overload;///<summary>全局剪切板获取文本值:</summary>function ClipBoardGetObjectValue(const AText:string):Boolean;overload;///<summary>QQ是否手动登录(QQ不像微信,App拉起会被腾讯安全警告，只能由浏览器打开)</summary>var FQQisRunning:Boolean;///<summary>TIM是否手动登录(QQ不像微信,App拉起会被腾讯安全警告，只能由浏览器打开)</summary>var FTIMisRunning:Boolean;///<summary>当前分享名:</summary>var FCurrShareName:string;///<summary>Windows启动第三方APP库分享的点击事件:</summary>function ActionWinStartupThirdApp(Sender:TObject):Boolean;var FAStringListImported: IFuture<string>;var FAFileDbServerTime:string;///<summary>THTTPClient通过IHTTPResponse响应服务器端返回的///JsonObject为客户端调用者传入的TStringList(实际用string)赋值:///:TStringList、TMemo等只适合少量基础数据的加载:///:TListbox、TListview等TScrollBox类的///TStrings的基类也应当分页:</summary>procedure HttpRestByJsonObjectToStrList(var AStringListImported:System.string; //:调用者传入的TStringListconst 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;///<summary>我的JSON函数和过程-WritePair写Json对:</summary>procedure WritePair(JW:TJsonWriter;// TJsonTextWriter or TJsonObjectWriterconst sName,sValue:string);///<summary>我的JSON解析函数TJSONIterator:</summary>function JsonIteratorParsor(const AStrListResult:TStringList=nil;const AJsonStr:string='';const AKeySearch:string='';const AValueSearch:string=''):string;///<summary>WriteLog用文件流及写流工具写系统日志文件：///只能被1个App实例(内部的N个线程)同时写:///myFucWinPro还有1个writeLogsINI:在uses myFucWinPro中:</summary>procedure WriteLog(constAInfo: string='';AIP:string='127.0.0.1';AUserName:string='系统管理员';ADevice:string='电脑');///<summary>获取本机IPv4地址:</summary>function getLANIP:string;///<summary>获取本机网关的公网的IPv4地址:</summary>function GetWANIP(const InternetIP:Boolean=true): string;///<summary>有问题只能用简单的映射:16进制字符串转原字符串hextostring、StringToHex、HexToInt</summary>function hextostring(str: string): string;///<summary>有问题只能用简单的映射:字符串转16进制字符串hextostring、StringToHex、HexToInt</summary>function StringToHex(str: string): string;///<summary>有问题只能用简单的映射:16进制字符串转整数hextostring、StringToHex、HexToInt</summary>function HexToInt(hex: string): integer;///<summary>最简单的Rest服务调用:///若用于测试网络: </summary>///<param name="ATimeout">:超时要很短默认100毫秒:参考网络ping命令的超时</param>///<param name="ABaseUrl">:默认访问超稳定的百度搜索首页以此来判断:客户端网络问题:///所有Rest请求或delphi dataSnap客户端请求,///先判断客户端网络状态再开始做 </param>function RestWebService(const ABaseUrl:string='https://www.baidu.com/';ATimeout:Integer=100):string;overload;///<summary>(不)过滤非pascal语言的异常的方法: </summary>///<param name="KillExceptNodelphi">="true":非delphi异常就过滤掉并不弹出提示框</param>///<param name="KillExceptNodelphi">="false":true用完后应当及时false,恢复弹出提示框</param>procedure KillExceptNodelphi(AExceptNodelphi:Boolean);///<summary>连续产生ACharNums个字符的函数,///:即System.StringOfChar(Char,Integer): </summary>function IntendChar(AAnsiChar:Char;ACharNums:ShortInt):string;///<summary>Vcl返回是否成功,回调所有组件的TRttiType的实例TRttiInstanceType的元类的类名:</summary>function FillVclClasses(ATStrings:TStrings): Boolean;///<summary>Fmx返回是否成功,回调所有组件的TRttiType的实例TRttiInstanceType的元类的类名:</summary>function FillFmxClasses(ATStrings:TStrings;AIfRttiTypeList:Boolean=false): Boolean;///<summary>根据组件名或对象名返回对象的元类</summary>function FindAnyClass(const Name: string): TClass;///<summary>全局虚拟键盘 接口变量引用:</summary>var aKeyboard:IFMXVirtualKeyboardService;///<summary>全局平台服务对话框服务接口:</summary>FIFMXDialogServiceAsync:IFMXDialogServiceAsync;FIFMXDialogServiceSync:IFMXDialogServiceSync;
/<summary>服务器端全局变量汇总:</summary>
// ///<summary>当前连接的数据库名</summary>
// myGetCatalogNames:string;///<summary>客户端全局变量汇总:</summary>///<summary>全局变量"验证码网关手机号"引用11位手机号='18980851626':</summary>var gstrSenderPhone:string='18190910561';///<summary>全局变量"服务器域名"引用='www.cpuofbs.com'支持二级域名:</summary>var gstrIP:string='192.168.3.100';///<summary>全局变量"服务器端口号"引用='8086':</summary>var gstrPort:string='8080';///<summary>全局变量"客服电话"引用20位号码='02866000800':</summary>var gstrCunstomerServiceTel:string='02866000800';///<summary>全局变量"运营商编码"引用10位'001':</summary>var gstrComID:string='001';///<summary>全局变量“当前登录状态”默认未登录状态引用6位='未登录':</summary>var gstrLoginStatus:string='未登录';///<summary>全局变量“员工编码”30位引用='':</summary>var gstrClerk_id:string='';///<summary>全局变量“员工姓名”40位引用:</summary>var gstrClerk_name:string='';///<summary>全局变量“员工所在部门编码”30位引用:</summary>var gstrDept_id:string='';///<summary>全局变量“员工所在部门名称”60位引用:</summary>var gstrDept_name:string='';///<summary>全局变量“客户编码”引用30位='':</summary>var gstrCustomer_id:string='';///<summary>全局变量“客户姓名”引用40位='':</summary>var gstrCorp_name:string='';///<summary>全局变量“客户地址”引用100位='':</summary>var gstrCorp_addr:string='';///<summary>全局变量“记住密码的登录手机”引用11位手机号='18190910561':</summary>var gstrLoginPhone:string='';///<summary>全局变量“记住密码的登录密码”引用16位='':</summary>var gstrLoginPassword:string='';///<summary>全局变量“当前用户的登录编码”引用Ctl09003中user_id的20位='':</summary>var gstrUser_id:string='';///<summary>全局变量“点选类权限-是否允许修改单价和折扣：”引用Ctl09003登录账号表14位='不可改单价折扣':</summary>var gstrB_sd_priceANDi_discount:string='不可改单价折扣';//不改单价折扣///<summary>全局变量“点选类权限-是否可看成本毛利利润：”引用Ctl09003登录账号表='不可看成本毛利':</summary>var gstrB_Profit:string='不可看成本毛利';///<summary>全局变量“点选类权限-是否POS用户：”引用Ctl09003登录账号表10位='不是POS':</summary>var gstrB_pos:string='不是POS'; //非POS///<summary>全局变量“点选类权限-默认POS用户的仓位：”引用Ctl09003登录账号表store_struct_id仓位编码30位='所有仓位':</summary>var gstrB_posStore_struct_id:string='所有仓位';///<summary>全局变量“点选类权限-自定义的用户角色”引用Ctl09003登录账号表12位='未自定义角色':</summary>var gstrGspFunction:string='未自定义角色';///<summary>全局变量“查询类权限-是否只浏览自己的信息：”引用Ctl09003登录账号表8位='自己信息':</summary>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超出则会闪退,
//:所以在客户端组件装载该数据,可以用字符串截取后分页装载:///<summary>全局变量“点选类权限-登录手机用户编码所对应的：用户组的部门权限”引用:</summary>var gstrRightPowerJsonArrayCtl09005:string='';///<summary>全局变量“点选类权限-登录手机用户编码所对应的：用户的仓位权限”引用:</summary>var gstrRightPowerJsonArrayCtl09006:string='';
//---------------------以下非字段存取:-----------------------------------------------------///<summary>全局变量“点选类权限-登录手机用户用户组访问通配权限的myfile.ini返回行数”引用Integer=6:</summary>var gstrRightPowerJsonArrayCtl09105LinesCount:Integer=6;///<summary>模块权限列表TStringList，只能随全局变量的计算调用一次，不可重复：gstrRightPowerJsonArrayCtl09105</summary>var myRightPowerMemoList :TMemo;///<summary>某个模块的权限字串myFMXObjTagRightPower，只能随全局变量的计算调用一次，不可重复：gstrRightPowerJsonArrayCtl09105</summary>var myFMXObjTagRightPower :string;///<summary>全局常量“系统管理员（超级用户）”引用Ctl09003中user_id的20位='001':</summary>const gstrSysUser ='001';typeTJsonToKener = Class(TObject)privateJSonstr:UnicodeString; //JSonstr:WideString;publicconstructor Create;destructor Destroy;Override;procedure Addelement(Nodename,Nodevalue:String);procedure Clearelement;function ToStr:UnicodeString;end;type///<summary>ChangeX进制转化及字符串编码类的函数及方法</summary>ChangeX = object //:object代表程序类型为函数或过程的类public///<summary>10进制字符串转16进制字符串的ChangeX类函数:</summary>class function DexToHex(ADexNum:String):string;///<summary>16进制字符串转10进制字符串的ChangeX类函数:</summary>class function HexToDex(AHexNum:String):string;///<summary>字符串转Unicode编码字符串的ChangeX类函数:</summary>class function StrToUnicodeStr(ADefultStr:String):string;///<summary>Unicode编码字符串转字符串的ChangeX类函数:</summary>class function UnicodeStrToStr(AUnicodeStr:String):string;end;TMyTreeView =Class(TTreeView)private///<summary>从外部引入的TTreeView:</summary>FTreeView:TTreeView;///<summary>从外部引入的TTreeView的TCustomImageList:</summary>FImageList:TCustomImageList;///<summary>TTreeView及其从外部数据库是否完成初始化:</summary>FIFInited:Boolean;///<summary>TTreeView从外部数据库加载的sql:</summary>FSql:string;///<summary>TTreeView是否展开所有节点,调用者初始化传入默认:=false:</summary>FIFCollapse:Boolean;///<summary>全选或取消全选TTreeView的所有TTreeViewItem节点:</summary>FTreeViewSelectAllOrNot:Boolean;///<summary>当前TTreeViewItem节点:</summary>FTreeViewItemCurrt:TTreeViewItem;///<summary>当前TTreeViewItem节点的父节点:</summary>FTreeViewItemParent:TFmxObject;///<summary>动态新增的TreeViewItem节点的Tag整数唯一标识赋值:</summary>FTreeViewItemTag:Integer;///<summary>父节点的子节点增加1个打勾CreateATreeViewItems初始化:</summary>FTreeViewItemCheckedCount:TArray<Integer>;///<summary>父节点完成打勾(父已枚举)OnCreate调用者初始化传入:</summary>FErgodicParent:string;///<summary>加树还是编枝:</summary>FAddWhoParent:string;///<summary>当前窗体操作内存表FDMemTable_Main更新的总记录数:</summary>FDMemTable_Main_UpdatedCount:Integer;protectedpublicpublished///<summary>从外部引入的TTreeView:</summary>LTreeView:TTreeView;///<summary>从外部引入的TTreeView的TCustomImageList:</summary>LImageList:TCustomImageList;///<summary>TMyTreeView类的构造函数:</summary>///<remarks>注意:类方法和类构造函数中不能引用private受保护的类型:</remarks>constructor Create(AOwner: TComponent); override;///<summary>类方法:TTreeView及其TreeViewItem属性的初始化:</summary>///<param name="ATreeView">从外部引入的TTreeView:FTreeView:</param>///<param name="AImageList">ATreeView的TImageList:</param>///<param name="AIFInited">:FIFInited:TTreeView是否在本类的内部完成初始化:</param>///<returns>返回是否完成初始化:</returns>///<remarks>注意:类方法和类构造函数中不能引用private受保护的类型:</remarks>class function InitATreeViewItems(const ATreeView: TTreeView;const AImageList: TCustomImageList=nil;const AIFInited: Boolean=false ): Boolean; //:AIFInited调用者初始化传入默认:=false;///<summary>类方法:TreeView动态加载外部数据源的字段值信息并生成动态新增的TreeViewItem节点:</summary>///<param name="AIndex">新增TTreeViewItem的索引号:</param>///<param name="AName">新增TTreeViewItem的名称:</param>///<param name="AText">新增TTreeViewItem的显示名:</param>///<param name="ATreeFiledName">新增的TTreeViewItem对应的外部数据源的字段名:</param>///<param name="AParent">新增TTreeViewItem的父节点父组件:关键:父组件可以是TreeView,也可以是某个TreeViewItem节点:</param>///<param name="AImageList">新增TTreeViewItem的TImageList,可:=nil:</param>///<param name="ImageIndex">新增TTreeViewItem的TImageList中的图片索引号:</param>///<param name="ASizeHeight">新增TTreeViewItem的高Height:</param>///<param name="ASizeWidth">新增TTreeViewItem的宽Width:</param>///<param name="MarginsLeft">新增TTreeViewItem的左边界像素整数:</param>///<param name="AOwnerObject">新增TTreeViewItem的所有者:通常是调用窗体或TFrame:</param>///<returns> 如果过程方法 <b>InitATreeViewItems</b> 在此函数中执行后 <b>初始化</b> 成功 <c>则返回:TTreeViewItem</c> </returns>/// <remarks> 这个函数对FMX及VCL均通用:注意:类方法和类构造函数中不能引用private受保护的类型 </remarks>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;///<summary>某个TreeViewItem节点的复选框被Check的状态改变的监测事件:</summary>procedure OnChangeCheck(AItem:TObject);//:protected TCustomTreeView.OnChangeCheck///<summary>TreeView全部展开或全部收拢:</summary>function DoExpandAllorCollapseAll(ATreeView:TTreeView):Boolean;end;implementation{$IFDEF MSWINDOWS}
usesRegistryWin32 //: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);
varuri: Jnet_Uri;Intent: JIntent;
beginuri := 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; //联系人组IDmyCursorPosition,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' );trycursor := SharedActivity.getContentResolver.query(uri, nil, nil, nil, nil);exceptraise Exception.Create('主表query错误');end;if cursor.getCount=0 thenbegin//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笔数据begincontactIdIndex := 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笔数据！begindata1IdIndex:=cursorDetail.getColumnIndex(StringToJString('data1'));if data1IdIndex>=0 thendataDetail :=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;
varuri: Jnet_Uri;Intent: JIntent;
beginuri := StrToJURI('tel:'+phoneNumber);Intent := TJIntent.JavaClass.init(TJIntent.JavaClass.ACTION_CALL, uri);//直接拨打电话trySharedActivity.startActivity(Intent);excepton e: Exception dobeginShowMessage('错误: ' + 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) thenTelephonyManager := TJTelephonyManager.Wrap((TelephonyServiceNative as ILocalObject).GetObjectID);LPhoneNumber:=JStringToString(TelephonyManager.getLine1Number);//:取得手机号if LPhoneNumber.Trim='' thenResult:=''//JStringToString(TelephonyManager.getMeid)else Result:=LPhoneNumber;
end;function GetAndroidMEID: string;
//获取Android手机的MEID号(即设备的ID非运营商的入网号):{$IFDEF ANDROID}varobj: JObject;tm: JTelephonyManager;MEID: String;{$ENDIF}
begin{$IFDEF ANDROID}
// AndoidRequestPermissions('网络状态');
// AndoidRequestPermissions('WIFI状态');obj := SharedActivityContext.getSystemService(TJContext.JavaClass.TELEPHONY_SERVICE);if obj <> nil thenbegintm := TJTelephonyManager.Wrap((obj as ILocalObject).GetObjectID);if tm <> nil thenMEID := JStringToString(tm.getMeid);end;Result := MEID;{$ELSE}Result:='';{$ENDIF}
end;function GetAndroidIMEI: string;
//即SIM卡串号(运营商的入网号):{$IFDEF ANDROID}varobj: JObject;tm: JTelephonyManager;IMEI: String;{$ENDIF}
begin{$IFDEF ANDROID}
// AndoidRequestPermissions('网络状态');
// AndoidRequestPermissions('WIFI状态');obj := SharedActivityContext.getSystemService(TJContext.JavaClass.TELEPHONY_SERVICE);if obj <> nil thenbegintm := TJTelephonyManager.Wrap((obj as ILocalObject).GetObjectID);if tm <> nil thenIMEI := 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卡串号
varTelephonyServiceNative: JObject;
begin
// AndoidRequestPermissions('网络状态');
// AndoidRequestPermissions('WIFI状态');TelephonyServiceNative := SharedActivityContext.getSystemService(TJContext.JavaClass.TELEPHONY_SERVICE);if Assigned(TelephonyServiceNative) thenTelephonyManager := TJTelephonyManager.Wrap((TelephonyServiceNative as ILocalObject).GetObjectID);Result:=JStringToString(TelephonyManager.getDeviceId);//:取得SIM卡串号
end;// 直接没有任何提示的发长短信：
procedure SentSMS(phoneNumber, SMSstring: string);
//'直接没有任何提示的发长短信www.pulledup.cn' :
//不能超过70个字：否则函数自动先做分割后，分别发：//收短信：是一次性1条收看的：varjm: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);
varuri: Jnet_Uri;Intent: JIntent;
beginuri := 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;
varmyResult: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;
beginmyResult:=''; 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 thenbeginshowmessage('符合条件的短信数量为0。');exit;end;cursor.moveToLast; iCursorCounts:=cursor.getPosition;cursor.moveToFirst;//for myCursorPosition := 0 to cursor.getPosition dowhile myCursorPosition <= iCursorCounts do//对所有短信的循环begin//cursor.moveToFirst; //cursor.move(4); // 最后一条:moveToLastcontactIdIndex := cursor.getInt(cursor.getColumnIndex(StringToJString('_id')));// 得到当前短信的id号idhuihuaidx := cursor.getLong(1); // 短信会话的ID号，如果删除这个，则整个短信会话都会被删除addressidx := cursor.getColumnIndex(StringToJString('address')); // 电话//if ( JStringToString(cursor.getString(addressidx)) ='18980851626') thenbeginiFindCountCursor:=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:
varLFile: JFile;LIntent: JIntent;
begintryLFile := 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);exceptend;
end;procedure ToInstallApk(Apk: string);
//Andoid安装apk:
varLFile: JFile;LIntent: JIntent;LNet_Uri: Jnet_Uri;
beginif not TOSVersion.Check(7, 0) thenbeginToInstallApk70Down(Apk);Exit;end;LFile := TJFile.JavaClass.init(StringToJString(ExtractFilePath(Apk)), StringToJstring(ExtractFileName(Apk)));LIntent := TJIntent.Create;if TOSVersion.Check(8, 0) thenLIntent.setAction(TJIntent.JavaClass.ACTION_INSTALL_PACKAGE)elseLIntent.setAction(TJIntent.JavaClass.ACTION_VIEW);LIntent.addFlags(TJIntent.JavaClass.FLAG_ACTIVITY_NEW_TASK);if TOSVersion.Check(7, 0) thenbegin// fix: android.os.FileUriExposedException: exposed beyond app through Intent.getData()// Project -> Options -> Application -> Entitlement List -> Secure File Sharing -> Check it// :8.0以上要在manifest里加权限:// :<uses-permission android:name="android.permission.REQUEST_INSTALL_PACKAGES"/>LIntent.addFlags(TJIntent.JavaClass.FLAG_GRANT_READ_URI_PERMISSION);//TJFileProvider:uses Androidapi.JNI.SupportLNet_Uri := TJFileProvider.JavaClass.getUriForFile(TAndroidHelper.Context,StringToJString(JStringToString(TAndroidHelper.Context.getPackageName) + '.fileprovider'), LFile);endelseLNet_Uri := TJnet_Uri.JavaClass.fromFile(LFile);LIntent.setDataAndType(LNet_Uri, StringToJString('application/vnd.android.package-archive'));TAndroidHelper.Context.startActivity(LIntent);
end;procedure AndoidRequestPermissions(const RequestPermissions:Array of string);
var LhashCode:Integer; LPermission:string;///<summary>Android请求权限的全局变量:</summary>MyPermissions: TArray<String>;RequestPermissionsLenth:Integer;
begintry//Pos('读文件',RequestPermissions)>0 //:System.SysUtils.TStringHelper//if (RequestPermissions.Trim).IndexOf('摄像头',0,length((RequestPermissions.Trim)))>=0 thenif length(RequestPermissions)>0 thenfor RequestPermissionsLenth := Low(RequestPermissions) to High(RequestPermissions) dobeginif (RequestPermissions[RequestPermissionsLenth])='摄像头' thenbegintryFCAMERA := JStringToString(TJManifest_permission.JavaClass.CAMERA);SetLength(MyPermissions, Length(MyPermissions)+1);MyPermissions[Length(MyPermissions)-1]:= FCAMERA;exceptend;end; {if (RequestPermissions[RequestPermissionsLenth])='前台服务安装应用' thenbegintryFINSTANT_APP_FOREGROUND_SERVICE := JStringToString(TJManifest_permission.JavaClass.INSTANT_APP_FOREGROUND_SERVICE);SetLength(MyPermissions, Length(MyPermissions)+1);MyPermissions[Length(MyPermissions)-1] := FINSTANT_APP_FOREGROUND_SERVICE;exceptend;end;if (RequestPermissions.Trim)='安装应用' thenbegintryLPermission := JStringToString(TJManifest_permission.JavaClass.REQUEST_INSTALL_PACKAGES);SetLength(MyPermissions, Length(MyPermissions)+1);MyPermissions[Length(MyPermissions)-1] := LPermission;exceptend;end;if (RequestPermissions.Trim)='全局搜索' thenbegintryLPermission := JStringToString(TJManifest_permission.JavaClass.GLOBAL_SEARCH);SetLength(MyPermissions, Length(MyPermissions)+1);MyPermissions[Length(MyPermissions)-1] := LPermission;exceptend;end; }if (RequestPermissions[RequestPermissionsLenth])='管理文档' thenbegintryFMANAGE_DOCUMENTS := JStringToString(TJManifest_permission.JavaClass.MANAGE_DOCUMENTS);SetLength(MyPermissions, Length(MyPermissions)+1);MyPermissions[Length(MyPermissions)-1] := FMANAGE_DOCUMENTS;exceptend;end;if (RequestPermissions[RequestPermissionsLenth])='读取文件' thenbegintryFREAD_EXTERNAL_STORAGE := JStringToString(TJManifest_permission.JavaClass.READ_EXTERNAL_STORAGE);SetLength(MyPermissions, Length(MyPermissions)+1);MyPermissions[Length(MyPermissions)-1] := FREAD_EXTERNAL_STORAGE;exceptend;end;if (RequestPermissions[RequestPermissionsLenth])='写入文件' thenbegintryFWRITE_EXTERNAL_STORAGE := JStringToString(TJManifest_permission.JavaClass.WRITE_EXTERNAL_STORAGE);SetLength(MyPermissions, Length(MyPermissions)+1);MyPermissions[Length(MyPermissions)-1] := FWRITE_EXTERNAL_STORAGE;exceptend;end; {if (RequestPermissions.Trim)='读取手机状态' thenbegintryLPermission := JStringToString(TJManifest_permission.JavaClass.READ_PHONE_STATE);SetLength(MyPermissions, Length(MyPermissions)+1);MyPermissions[Length(MyPermissions)-1] := LPermission;exceptend;end;if (RequestPermissions.Trim)='INTERNET' thenbegintryLPermission := JStringToString(TJManifest_permission.JavaClass.INTERNET);SetLength(MyPermissions, Length(MyPermissions)+1);MyPermissions[Length(MyPermissions)-1] := LPermission;exceptend;end;if (RequestPermissions.Trim)='网络状态' thenbegintry//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;exceptend;end;if (RequestPermissions.Trim)='WIFI状态' thenbegintryLPermission := JStringToString(TJManifest_permission.JavaClass.ACCESS_WIFI_STATE);SetLength(MyPermissions, Length(MyPermissions)+1);MyPermissions[Length(MyPermissions)-1] := LPermission;exceptend;end;if (RequestPermissions.Trim)='在其他应用上层显示' thenbegin //比如:点播播放器悬浮窗权限tryLPermission := JStringToString(TJManifest_permission.JavaClass.SYSTEM_ALERT_WINDOW);SetLength(MyPermissions, Length(MyPermissions)+1);MyPermissions[Length(MyPermissions)-1] := LPermission;exceptend;end;if (RequestPermissions.Trim)='允许访问通知策略' thenbegintryLPermission := JStringToString(TJManifest_permission.JavaClass.ACCESS_NOTIFICATION_POLICY);SetLength(MyPermissions, Length(MyPermissions)+1);MyPermissions[Length(MyPermissions)-1] := LPermission;exceptend;end;if (RequestPermissions.Trim)='请求绑定通知监听服务' thenbegintryLPermission := JStringToString(TJManifest_permission.JavaClass.BIND_NOTIFICATION_LISTENER_SERVICE);SetLength(MyPermissions, Length(MyPermissions)+1);MyPermissions[Length(MyPermissions)-1] := LPermission;exceptend;end;if (RequestPermissions.Trim)='允许一个APP伴侣程序在后台运行' thenbegintryLPermission := JStringToString(TJManifest_permission.JavaClass.REQUEST_COMPANION_RUN_IN_BACKGROUND);SetLength(MyPermissions, Length(MyPermissions)+1);MyPermissions[Length(MyPermissions)-1] := LPermission;exceptend;end;if (RequestPermissions.Trim)='允许一个APP伴侣程序在后台使用数据' thenbegintryLPermission := JStringToString(TJManifest_permission.JavaClass.REQUEST_COMPANION_USE_DATA_IN_BACKGROUND);SetLength(MyPermissions, Length(MyPermissions)+1);MyPermissions[Length(MyPermissions)-1] := LPermission;exceptend;end;if (RequestPermissions.Trim)='写系统配置' thenbegintryLPermission := JStringToString(TJManifest_permission.JavaClass.WRITE_SETTINGS);SetLength(MyPermissions, Length(MyPermissions)+1);MyPermissions[Length(MyPermissions)-1] := LPermission;exceptend;end;if (RequestPermissions.Trim)='绑定条件提供者服务' thenbegintryLPermission := JStringToString(TJManifest_permission.JavaClass.BIND_CONDITION_PROVIDER_SERVICE);SetLength(MyPermissions, Length(MyPermissions)+1);MyPermissions[Length(MyPermissions)-1] := LPermission;exceptend;end;if (RequestPermissions.Trim)='绑定设备管理' thenbegintryLPermission := JStringToString(TJManifest_permission.JavaClass.BIND_DEVICE_ADMIN);SetLength(MyPermissions, Length(MyPermissions)+1);MyPermissions[Length(MyPermissions)-1] := LPermission;exceptend;end; //}end;exceptend;// 调用方法：动态请求所有程序需要用到的权限,根据需要您可以减少:// 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 dobeginif not ( (Strs[i].trim)='' ) thenbeginmyDelimiter_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='显示' thenaKeyboard.ShowVirtualKeyboard(aFmxObject) //显示虚拟键盘else if aControlStr='关闭' then aKeyboard.HideVirtualKeyboard;//隐藏虚拟键盘end;function compareOldNew(Field: TField): boolean; overload;
begin//::TField : uses Data.DB//Varisnull : uses System.Variantsif VarIsnull(Field.OldValue) thenresult := falseelseif Field.DataType in [ftString,ftWideString] thenbeginif VarToStr(Field.OldValue).Trim <> VarToStr(Field.NewValue).Trim thenresult := falseelseresult := true;end elseif Field.OldValue <> Field.NewValue thenresult := falseelseresult := true;
end;function compareOldNew(aFDMemTable: TFDMemTable): Boolean; overload;
var icount:integer; //icount:aFDMemTable字段数sFieldNotChaged:Boolean;
begin//TField : uses Data.DB//::TFDMemTable : uses FireDAC.Comp.ClientsFieldNotChaged:=true;for icount:=0 to aFDMemTable.Fields.Count-1 dobeginif compareOldNew(aFDMemTable.Fields[icount])=false thenbeginsFieldNotChaged:=false;Exit(sFieldNotChaged); //符合条件即返回end;end;Result := sFieldNotChaged;
end;function compareOldNew(AString,BString: String): Boolean; overload;
beginif AString.Trim=BString.Trim thenResult:=trueelse Result:=false;
end;function GetStrGBOfByteCount(Data: String): Integer;
varEncoding: TEncoding;
beginEncoding := TEncoding.GetEncoding('GB2312'); //GB2312Result := 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;
beginTargetStr:='';//for iCircle := 1 to Len - GetStrGBOfByteCount(SourceStr.trim) dofor iCircle := 1 to Len - length(SourceStr.trim) doTargetStr:= 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;
beginTargetStr:='';StringReplace (SourceStr.trim, ' ', '_', [rfReplaceAll, rfIgnoreCase]);if length(SourceStr.trim)<=Len thenbegin//for iCircle_ZH := 1 to Len - GetStrGBOfByteCount(SourceStr.trim) dofor iCircle_ZH := 1 to Len - length(SourceStr.trim) dobegin//先补差的中文字符：TargetStr:= TargetStr+ FillStr+ FillStr ; //：补2个单字符FillStr//再补非中文字符：if ifSingleByte(SourceStr.Trim)>0 then //:存在非中文字符beginfor iCircle_EN := 1 to ifSingleByte(SourceStr.Trim) dobeginTargetStr:= TargetStr+ FillStr ; //：补1个单字符FillStrend;end;end;end;Result:= SourceStr.trim + TargetStr ;
end;function ifSingleByte(sString: string=''):Integer;
var s :string; myBytes:TBytes; Encoding: TEncoding;
var j,k:Integer;
begins:=''; k:=0;Encoding := TEncoding.GetEncoding('GB2312');myBytes := Encoding.GetBytes(sString.trim);for j := 0 to ByteLength(sString)-1 dobeginif (Encoding.GetString(myBytes[j])<>'?')and (Encoding.GetString(myBytes[j])<>'r')and (Encoding.GetString(myBytes[j])<>#13)and (Encoding.GetString(myBytes[j])<>#10)thenbegink:=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架构、版本信息,用","和";"分割：
varLOutputStr:String;
beginLOutputStr:='';if AInfoType<>'' thenbegin //'详细信息':if TOSVersion.Platform=TOSVersion.TPlatform.pfWindows thenLOutputStr:='平台:'+'pfWindows,'else if TOSVersion.Platform=TOSVersion.TPlatform.pfAndroid thenLOutputStr:='平台:'+'pfAndroid,'else if TOSVersion.Platform=TOSVersion.TPlatform.pfiOS thenLOutputStr:='平台:'+'pfiOS,'else if TOSVersion.Platform=TOSVersion.TPlatform.pfMacOS thenLOutputStr:='平台:'+'pfMacOS,'else if TOSVersion.Platform=TOSVersion.TPlatform.pfWinRT thenLOutputStr:='平台:'+'pfWinRT,'else if TOSVersion.Platform=TOSVersion.TPlatform.pfLinux thenLOutputStr:='平台:'+'pfLinux,';LOutputStr:=LOutputStr+'版本名称:'+TOSVersion.Name+',';if TOSVersion.Architecture=TOSVersion.TArchitecture.arIntelX86 thenLOutputStr:=LOutputStr+'CPU架构:'+'arIntelX86,'else if TOSVersion.Architecture=TOSVersion.TArchitecture.arIntelX64 thenLOutputStr:=LOutputStr+'CPU架构:'+'arIntelX64,'else if TOSVersion.Architecture=TOSVersion.TArchitecture.arARM32 thenLOutputStr:=LOutputStr+'CPU架构:'+'arARM32,'else if TOSVersion.Architecture=TOSVersion.TArchitecture.arARM64 thenLOutputStr:=LOutputStr+'CPU架构:'+'arARM64,';LOutputStr:=LOutputStr+'主版本号:'+TOSVersion.Major.ToString+';'+'小版本号:'+TOSVersion.Minor.ToString+';'+'发行版本号:'+TOSVersion.Build.ToString+',';LOutputStr:=LOutputStr+'主服务包编号:'+TOSVersion.ServicePackMajor.ToString+';'+'小服务包编号:'+TOSVersion.ServicePackMinor.ToString+'';end elsebegin //'概要信息':LOutputStr:=LOutputStr+TOSVersion.ToString+',';if TOSVersion.Architecture=TOSVersion.TArchitecture.arIntelX86 thenLOutputStr:=LOutputStr+'CPU架构'+'(IntelX86)'else if TOSVersion.Architecture=TOSVersion.TArchitecture.arIntelX64 thenLOutputStr:=LOutputStr+'CPU架构'+'(IntelX64)'else if TOSVersion.Architecture=TOSVersion.TArchitecture.arARM32 thenLOutputStr:=LOutputStr+'CPU架构'+'(ARM32)'else if TOSVersion.Architecture=TOSVersion.TArchitecture.arARM64 thenLOutputStr:=LOutputStr+'CPU架构'+'(ARM64)'end;Result:=LOutputStr;
end;function getBytesCountOfStr(var Text:string):Integer;
var Encoding:TEncoding;
begin//字符集编码://Encoding := TEncoding.GetEncoding('UTF8'); //GB2312Encoding := TEncoding.Unicode;//按上述定义的字符集编码方式，将字符串Text转化一遍：//先将String：GetBytes->TBytes,再TBytes->StringResult:=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'); //GB2312Encoding := TEncoding.Unicode;//按上述定义的字符集编码方式，将字符串Text转化一遍：//先将String：GetBytes->TBytes,再TBytes->StringEncoding.GetString( Encoding.GetBytes(Text) );//正则表达式电话号码: 1[3|5|7|8]d\9Result := errorInfo;errorInfo:=''; aStr3to11:='';if opermode.Trim='输入验证' then //分流结果验证、输入验证beginText:=Text;//strConvt1To0(Text); //:千万不能用！if (length(Text)=1) thenif (Text <> '1') then//if (Text.Substring(0, 1) <> '1') thenbeginText:='';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') thenbegin//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) thenbeginByteCount:=0;for aStr3to11 in sNum dobeginif (Text.Substring(length(Text)-1, 1 ) <> aStr3to11) thenINC(ByteCount);if ByteCount=10 thenbeginText:=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) thenbeginText:=Text.Substring(0, 11 );errorInfo:='手机号码错误：'+#13+#10+'总长度不能超过11位';end;end;if opermode.Trim='结果验证' thenbegin1-based字符串转换到0-based 的函数: .Trim .Substring(0, 1)sNum:='0123456789';myPhoneNum:=Text.Trim;//strConvt1To0(Text.Trim); //不乱用！if (myPhoneNum.Substring(0, 1) <> '1') thenbegin //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') thenbegin //Text:=Text.Substring(0, 1);errorInfo:=errorInfo+#13+#10+'第2位数字:3或4或5或7或8';end;for iCircle := 3 to 11 do //后9位 11begin//Byte1Num :Byte; ord(1位字符串：即字符)//char(ASCII码):0~9的Byte(10进制，范围0~255)：48~57(*if length(Str1Num)=1 thenByte1Num:=ord( Str1Num[1] );if not( Byte1Num in [48..57] ) thenbegin 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 dobeginif (Str1Num <> aStr3to11) thenINC(ByteCount);//ByteCount:=ByteCount+1;end;if ByteCount=10 thenerrorInfo:=errorInfo+#13+#10+'第'+IntToStr(iCircle)+'位错误，应为0~9任意数字';end;if length(myPhoneNum.Trim)>11 thenbeginText:=Text.Substring(0, 11 );errorInfo:=errorInfo.Trim+#13+#10+'总长度不能超过11位';end;end;if errorInfo='' then Result :='正确' elsebegin//比如：返回错误信息: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;
beginResultStr:='';for iCircle := 1 to 4 dobeginRandomize;ResultStr:=ResultStr+IntToStr(Random(10));end;Result:=ResultStr.Trim;
end;function RandomNumberStr(const aInt:Integer=20): string;//产生随机的N位数字字符串：var iCircle:Integer; ResultStr: string;beginResultStr:='';for iCircle := 1 to aInt dobeginRandomize;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;beginResultStr:='0';//{$IFDEF POSIX}while (ResultStr.ToInteger=0)or (ResultStr.ToInteger<aIntBegin)or (ResultStr.ToInteger>aIntEnd) dobeginResultStr:='';beginRandomize;ResultStr:=IntToStr(Random(aIntEnd));end;end;//{$ELSE}//{$ENDIF}Result:=ResultStr.Trim;end;function RandomNumber(const aInt:Integer=3): Integer;
//产生小于设定的数值的1位随机正整数0~aInt-1）:
beginRandomize;Result:=Random(aInt);
end;function ImgGetFromImgList(Const ImgList:TImageList;Const xPT,yPT:Integer;Const indexImgList:Integer): TBitmap;//从ImageList向TBitmap赋值:
var aSizeF:TSizeF;aBitmap: TBitmap;
beginaBitmap:=TBitmap.create;aBitmap.Resize( xPT,yPT );aSizeF.cx:=xPT; aSizeF.cy:=yPT;if ImgList.BitmapExists(indexImgList)=true thenResult :=ImgList.Bitmap(aSizeF,indexImgList)//ShowMessagePos('列表中无图片！',180,300); //ShowMessage('列表中无图片！');elseResult:=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'); //GB2312Encoding := TEncoding.Unicode;//按上述定义的字符集编码方式，将字符串Text转化一遍：//先将String：GetBytes->TBytes,再TBytes->String
// Encoding.GetString( Encoding.GetBytes(Text) );sStr:=Text;for iCharCount := Low(Text) to High(Text) dobeginif ord(sStr[iCharCount])=32then 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) dobeginsTempStr:=Text[iStrLen]; //一个字符一个字符的替换：//开始替换：aByteArray:=Encoding.GetBytes(sTempStr); //：字节数组iBeginChar:=Low(aByteArray);for iCharCount := iBeginCharto High(aByteArray) dobegin//得到字节数组中的每个字节sTempStr:=sTempStr+#13+#10+'第['+IntToStr(iCharCount)+']个字节：'+IntToStr(aByteArray[iCharCount]);end;sStr:=sStr+sTempStr+#13+#10;end; //:输出测试 *)for iStrLen := Low(Text) to High(Text) dobeginsTempStr:=Text[iStrLen]; //一个字符一个字符的替换：//开始替换：
//(*//Unicode编码：aByteArray:=Encoding.GetBytes(sTempStr); //：获取字节数组if aByteArray[1]=255 then //非全角空格的全角字符（【句号】无全角）：第2个字节=255beginif aByteArray[0]<=126 thensTempStr:=Char(aByteArray[0]+32) //正常情况：其半角字节=第1个字节+32else if aByteArray[0]>126 then //特例：比如半角(aByteArray[0]$=36)的全角￥(aByteArray[0]=229)sTempStr:=Char( aByteArray[1]+10-aByteArray[0] ) //=36 ：即半角$;end elseif aByteArray[1]=48 then //全角特例：第2个字节=48beginif 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 elseif aByteArray[1]=32 then //半角特例中文半角引号“”：第2个字节=32beginif 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 elseif aByteArray[1]=0 then //半角字符：第2个字节=0sTempStr:=Char(aByteArray[0]) //其半角字节=第1个字节else //则是中文beginif KillChinese='去中文' then sTempStr:=''else sTempStr:=sTempStr;end;
//*)
(*//GB2312编码：中午和全角是 双字节，半角和其它为单字节aByteArray:=Encoding.GetBytes(sTempStr); //：获取字节数组if aByteArray[0]=163 then //非全角空格的全角字符：第1个字节=163sTempStr:=Chr(aByteArray[1]-128) //其半角字节=第2个字节-128elseif aByteArray[0]=161 then //全角空格：第1个字节=161sTempStr:=Char(32) //其半角字节=32elseif ( (aByteArray[0]>=33) and (aByteArray[0]<=126) ) then //半角字符：第1个字节>=33 and <=126sTempStr:=Char(aByteArray[0]) //其半角字节=第1个字节else if aByteArray[0]>163 then//则是中文beginif 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;
beginEncoding := 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='' thenbegincheckInput:=//System.IOUtils.TPath.GetLibraryPathExtractFilePath(ParamStr(0))+'WorkPath\'+UploadOrDownload.Trim+'\'+AFileType+'\';if IfPathThumbnail=true then checkInput:=checkInput+'Thumbnail\';end elsebegincheckInput:=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 thenResult:='错误路径' 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<string>):Boolean;//2、AppDocumentsPath:分平台约定值-APP对外发布文件的路径{$IFDEF MSWINDOWS}//在APP包的安装根路径:AppDocumentsPath:=ExtractFilePath(ParamStr(0));//:等价://System.IOUtils.TPath.GetLibraryPath;{$ENDIF MSWINDOWS}{$IFDEF MSWINDOWS}//Windows平台路径:if APath.Trim='' thenbegin //:3、默认要产生的路径://APP对外发布文件的路径变量AppDocumentsPath下-工作目录 WorkPath//3.1、上传路径之://3.1.1、图片路径://部门Pic路径:department,文件de开头if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\pic\department\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\pic\department\Thumbnail\');//员工Pic路径:employee,文件e0开头if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\pic\employee\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\pic\employee\Thumbnail\');//库房Pic路径:storehouse,文件s0开头if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\pic\storehouse\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\pic\storehouse\Thumbnail\');//行政区划Pic路径:region,文件r0开头if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\pic\region\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\pic\region\Thumbnail\');//物品类别Pic路径: itemtype,文件it开头if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\pic\itemtype\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\pic\itemtype\Thumbnail\');//物料Pic路径: matter,文件cp开头if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\pic\matter\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\pic\matter\Thumbnail\');//客户Pic路径: customer,文件c0开头if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\pic\customer\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\pic\customer\Thumbnail\');//供应商Pic路径: supplier,文件g0开头if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\pic\supplier\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\pic\supplier\Thumbnail\');//结算方式Pic路径: settle,文件st开头if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\pic\settle\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\pic\settle\Thumbnail\');//会计科目Pic路径: account,文件a0开头if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\pic\account\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\pic\account\Thumbnail\');//核算项目Pic路径: accountitem,文件ai开头if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\pic\accountitem\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\pic\accountitem\Thumbnail\');//3.1.2、视频路径: 打开时,用库媒体工具打开if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\movies\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\movies\Thumbnail\');//3.1.3、音频路径: 打开时,用库媒体工具打开if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\musics\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Upload\musics\Thumbnail\');//3.1.4、文件路径: 打开时,用内嵌webbrowser打开if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Upload\files\Thumbnail\')=false thenSystem.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 thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\pic\department\Thumbnail\');//员工Pic路径:employee,文件e0开头if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\pic\employee\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\pic\employee\Thumbnail\');//库房Pic路径:storehouse,文件s0开头if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\pic\storehouse\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\pic\storehouse\Thumbnail\');//行政区划Pic路径:region,文件r0开头if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\pic\region\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\pic\region\Thumbnail\');//物品类别Pic路径: itemtype,文件it开头if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\pic\itemtype\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\pic\itemtype\Thumbnail\');//物料Pic路径: matter,文件cp开头if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\pic\matter\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\pic\matter\Thumbnail\');//客户Pic路径: customer,文件c0开头if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\pic\customer\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\pic\customer\Thumbnail\');//供应商Pic路径: supplier,文件g0开头if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\pic\supplier\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\pic\supplier\Thumbnail\');//结算方式Pic路径: settle,文件st开头if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\pic\settle\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\pic\settle\Thumbnail\');//会计科目Pic路径: account,文件a0开头if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\pic\account\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\pic\account\Thumbnail\');//核算项目Pic路径: accountitem,文件ai开头if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\pic\accountitem\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\pic\accountitem\Thumbnail\');//3.2.2、视频路径: 打开时,用库媒体工具打开if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\movies\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\movies\Thumbnail\');//3.2.3、音频路径: 打开时,用库媒体工具打开if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\musics\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\musics\Thumbnail\');//3.2.4、文件路径: 打开时,用内嵌webbrowser打开if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'WorkPath\Download\files\Thumbnail\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'WorkPath\Download\files\Thumbnail\');end elsebegin//你自己的上传路径:if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'your\'+APath.Trim+'\Upload\'+AProducedSubPath.Trim+'\')=false thenSystem.IOUtils.TDirectory.CreateDirectory(AppDocumentsPath+'your\'+APath.Trim+'\Upload\'+AProducedSubPath.Trim+'\');//你自己的下载路径:if System.IOUtils.TDirectory.Exists(AppDocumentsPath+'your\'+APath.Trim+'\Download\'+AProducedSubPath.Trim+'\')=false thenSystem.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);trytargetFileName:='myFile.ini';targetFileName:=productTextFile('',targetFileName);if targetFileName.Trim<>'' thenbeginaMemSysConfig.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<>'' thenbeginif targetFileName.Trim<>'' thenaMemSysConfig.Lines.SaveToFile(targetFileName.Trim);end;end;finallyFreeAndNil(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 pageEncoding := TEncoding.GetEncoding('GB2312');//按上述定义的字符集编码方式载入外部文件:aMemSysConfig.lines.LoadFromFile:aMemSysConfig:=TMemo.Create(nil);trytargetFileName:=FileName;//'myFile.ini';targetFileName:=productTextFile('',targetFileName);if targetFileName.Trim<>'' thenbegin//调本地配置文件myFile.ini:aMemSysConfig.lines.LoadFromFile(targetFileName.Trim,Encoding);if aMemSysConfig.Text.Trim<>'' thenbeginfor iCircle := 0 to aMemSysConfig.lines.count-1 dobegin //如果配置文件中一行都没有，则取变量默认值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;finallyFreeAndNil(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列表字段，返回字符串:
beginResult:='';if Database ='mssql' thenbeginResult:=' convert(varchar(23),'+aDatetimeField+',121) ';end;if Database ='oracle' thenbeginResult:=' to_char('+aDatetimeField+',''YYYY-MM-DD HH24:MI:SS.FF3'') ';end;if Database ='sqlite3' thenbeginResult:=' strftime(''%Y.%m.%d %H:%M:%f'','+aDatetimeField+',''localtime'') ';//:sqlite3只用于列表,不用于where条件end;end;function whereDatetime(const aDatetimeField:string='';const Database:string=''):string;
//便于差异化数据库扩展,设置通用的日期时间字段的where条件字段，返回字符串:
beginResult:='';if Database ='mssql' thenbeginResult:=' convert(varchar(23),'+aDatetimeField+',121) ';end;if Database ='oracle' thenbeginResult:=' to_char('+aDatetimeField+',''YYYY-MM-DD HH24:MI:SS.FF3'') ';end;if Database ='sqlite3' thenbeginResult:=' aDatetimeField ';end;
end;function DataSet2JSONuseFDBatchMove(ADataset: TDataSet): string;
//数据集的记录转JSon字符串:用FDBatchMove方法，select计算后的结果列含\：
varsSM: 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);tryFDBatchMoveDataSetReader.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;(*tryLStreamStr:= LStreamStr.Replace('\','',[rfReplaceAll]);//:替换不了finallyResult := LStreamStr;end; //*)finallysSM.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":"广州"}]
varLRecord: string;LField: TField;i: integer;
beginResult := '';if (ADataset.Active=false) or (ADataset.IsEmpty) then Exit;Result := '[';ADataset.DisableControls;ADataset.First;while not ADataset.Eof dobeginfor i := 0 to ADataset.FieldCount - 1 dobeginLField := ADataset.Fields[i];if LRecord = '' thenLRecord := '{"' + LField.FieldName + '":"' + LField.Text + '"'elseLRecord := LRecord + ',"' + LField.FieldName + '":"' + LField.Text + '"';if i = ADataset.FieldCount - 1 thenbeginLRecord := LRecord + '}';if Result = '[' thenResult := Result + LRecordelseResult := Result + ',' + LRecord;LRecord := '';end;end;ADataset.Next;end;ADataset.EnableControls;Result := Result + ']';
end;(*TJsonToKener*)
constructor TJsonToKener.Create;
begininherited;
end;destructor TJsonToKener.destroy;
begininherited;
end;procedure TJsonToKener.AddElement(nodeName,nodeValue:String);
beginif length(JSonStr)>0 thenJSonStr:=ConCat(JSonStr,',"',nodeName,'":',nodeValue)elseJSonStr:=ConCat(JSonStr,'"',nodeName,'":',nodeValue);
end;procedure TJsonToKener.ClearElement;
beginJSonStr:='';
end;function TJsonToKener.ToStr:UnicodeString;
beginResult:=ConCat('{',JSonStr,'}');
end;function FieldTypeToDMLFieldProperstr(AField: TField;AFieldType: TFieldType): string;
//FieldType转DML语句字段列属性字串:
var LFieldTypeStr,LDMLFieldNullTarget:string;
begincase AField.Required oftrue:LDMLFieldNullTarget:='not null';false:LDMLFieldNullTarget:='null';end;LFieldTypeStr:='ftUnknown';case AFieldType offtLargeint: 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)) thenbeginFIFMXDialogServiceAsync.MessageDialogAsync(AMessage,TMsgDlgType.mtInformation,[TMsgDlgBtn.mbOK,TMsgDlgBtn.mbCancel],TMsgDlgBtn.mbOK,0,procedure(const AResult: TModalResult)beginif 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;
beginLTBitmap:=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 thentryATControl.PaintTo(LTBitmap.Canvas, TRectF.Create(0, 0,LTBitmap.Width / SceneScale,LTBitmap.Height / SceneScale));finallyLTBitmap.Canvas.EndScene;end;tryAImage.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;finallyLTBitmap.free;end;
end;function FocusMe(const ATControl:TControl):Boolean;
//uses FMX.Controls,FMX.Objects
//强制设置TControl焦点,返回是否获得焦点:
beginATControl.CanFocus:=true;ATControl.SetFocus;if ATControl.IsFocused thenResult:=trueelse Result:=false;
end;function ClipBoardGetObjectValue(const ATControl:TObject):Boolean;overload;
//全局剪切板获取对象属性的泛型值://FClipBoard:IFMXClipboardService; //:全局剪切板接口 //:FMX.Platform//FClipBoardValue:TValue; //:全局剪切板获取的数值
begin //调用方法示例:ClipBoardGetObjectValue(imgShare.Bitmap);if ATControl<>nil thenif TPlatformServices.Current.SupportsPlatformService(IFMXClipboardService,IInterface(FClipBoard) ) thenbeginFClipBoardValue := 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<>'' thenif TPlatformServices.Current.SupportsPlatformService(IFMXClipboardService,IInterface(FClipBoard) ) thenbeginFClipBoardValue := 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拉起会被腾讯安全警告，只能由浏览器打开)</summary>//var FQQisRunning:Boolean;//IM是否手动登录(QQ不像微信,App拉起会被腾讯安全警告，只能由浏览器打开)</summary>//var FTIMisRunning:Boolean;//当前分享名:</summary>//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).;tryif SenderTargetName.IndexOf('btnQQ',0,length(SenderTargetName))>=0 thenbegintryif FQQisRunning=false thenbegin//MemoTips.Lines.Add('QQ未运行');AAppKeyValue:='QQ.exe';trytryFQQisRunning:=AppRunning(AAppKeyValue);except//end;finallyif FQQisRunning=false thenbeginLResult:=false;ShowAMessage('请先手动登录您的QQ',procedure begin end);Abort;end elseLResult:=true;end;end;finallyif FQQisRunning=True thenbegin//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);tryExeURL(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' thenif SenderTargetName.IndexOf('btnTIM',0,length(SenderTargetName))>=0 thenbegintryif FTIMisRunning=false thenbegin//MemoTips.Lines.Add('TIM未运行');AAppKeyValue:='TIM.exe';trytryFTIMisRunning:=AppRunning(AAppKeyValue);except//end;finallyif FTIMisRunning=false thenbeginLResult:=false;ShowAMessage('请先手动登录您的qq办公版TIM',procedure begin end);Abort;end elseLResult:=true;end;end;finallyif FTIMisRunning=True thenbegin//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);tryExeURL(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' thenif SenderTargetName.IndexOf('btnWechat',0,length(SenderTargetName))>=0 thenbeginFCurrShareName:='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.TNativeUIntHelperif LNativeUInt.ToString.Trim<>'' thenLResult:=trueelse LResult:=false;end;finallyend;if LResult=true then Result:=true else Result:=false;{$ENDIF MSWINDOWS}
end;procedure HttpRestByJsonObjectToStrList(var AStringListImported:string;//:调用者传入的TStringListconst 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;
beginLValueOfPropertyName:=AStringListImported;AStringListImported:=System.Threading.TTask.Future<string>(function: stringvar 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获取所需数据:beginLResultValue:='';LSReader:=TStringReader.Create(ARestRespContent);LJTReader:=TJSonTextReader.Create(LSReader);tryLJTReader.Rewind;//:开始"到头迭代"while (LJTReader.Read) dobegincase LJTReader.TokenType ofTJsonToken.None:;TJsonToken.StartObject:;TJsonToken.PropertyName:beginif LJTReader.Value.ToString=LValueOfPropertyName thenLResultValue:=LJTReader.ReadAsString;end;TJsonToken.String:begin//end;TJsonToken.EndObject:beginif LResultValue.Trim<>'' thenResult:=LResultValueelse Result:='';end;end;end;finallyLJTReader.Free; LSReader.Free;end;end;beginLURL:=UrlHttpHead.Trim+UrlRestMethod.Trim+UrlMethodName.Trim+UrlMethodParamsStr.Trim;LHttpC:=THTTPClient.Create;tryLIHttpR:=LHttpC.GET(LURL);LStrRespContent:=LIHttpR.ContentAsString(TEncoding.UTF8);//LJSonO:=TJSonObject.ParseJSonValue(LStrRespContent) as TJSonObject;tryResult:=ReadAValue(LStrRespContent);//:"到头迭代"法遍历TJSonObject获取所需数据//Result:=LStrRespContent;//LJSonO.GetValue<TJSonString>('DatabaseDatetime').Astring;finally//LJSonO.Free;end;finallyLHttpC.Free;end;end).Value;//AStringListImported:=FAStringListImported.Value;end;
(*
function String2Bytes(const AString: string): TBytes;
varCleanStr: string;
beginCleanStr := AString.Replace('-', '');SetLength(Result, Round(Length(CleanStr) / 2));HexToBin(PChar(CleanStr), 0, Result, 0, Length(Result));
end;function Bytes2String(const ABytes: TBytes): string;
varI: Integer;
beginResult := '';for I := Low(ABytes) to High(ABytes) doif I = 0 thenResult := IntToHex(ABytes[I], 2)elseResult := Result + '-' + IntToHex(ABytes[I], 2);
end;
*)
//我的JSON函数和过程:
procedure WritePair(JW:TJsonWriter;// TJsonTextWriter or TJsonObjectWriterconst sName,sValue:string);
beginJW.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:
vara:TJSonObject;SR:TStringReader;JTR:TJsonTextReader;LJInterator:TJSONIterator;sData:string;
beginsData:='';SR:=TStringReader.Create(AJsonStr);JTR:=TJsonTextReader.Create(SR);LJInterator:=TJSONIterator.Create(JTR);//LJInterator.Rewind;//Json Str回到头部:trytrywhile LJInterator.Next() dobeginif (LJInterator.Index=-1)and (LJInterator.&Type<>TJsonToken.StartArray)then //处理非数组:beginsData:=sData+ LJInterator.Key.Trim+':'+ LJInterator.AsString.Trim+sLineBreak;(*if AKeySearch.Trim='' thenbeginsData:=sData+ LJInterator.Key.Trim+':'+ LJInterator.AsString.Trim+sLineBreak;end elsebeginif LJInterator.Key.Trim=AKeySearch.Trim thensData:=sData+ LJInterator.Key.Trim+':'+ LJInterator.AsString.Trim+sLineBreak;end;*)end else //处理数组:beginif (LJInterator.Index=-1) thenbegin//if AKeySearch.Trim='' thensData:=sData+ LJInterator.Key.Trim+':';end elsebeginsData:=sData+sLineBreak+ LJInterator.AsString.Trim;{if LJInterator.Key.Trim=AKeySearch.Trim thenbeginif AValueSearch.Trim='' thenbeginsData:=sData+sLineBreak+ LJInterator.AsString.Trim;end elsebeginif LJInterator.AsString.Trim=AValueSearch.Trim thensData:=sData+sLineBreak+ LJInterator.AsString.Trim;end;end;}end;LJInterator.Recurse;//:递归TJsonArray或TJsonObjectend;end;exceptraise Exception.Create('JSon数据格式错误');SR.free;JTR.free;LJInterator.free;Result:='解析失败';end;AStrListResult.Append(sData);if sData.Trim<>'' thenResult:='解析成功'else Result:='解析失败';finallySR.free;JTR.free;LJInterator.free;end;end;procedure WriteLog(
constAInfo: 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 ForceDirectoriesForceDirectories(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) thenbegin //如果文件存在:LStream := TFileStream.Create(LFileName,fmOpenReadWrite //打开文件,可读可写or fmShareDenyWrite); //:fmShareDenyWrite:共享时拒绝被其他App同时写endelsebegin //如果文件不存在:LStream := TFileStream.Create(LFileName,fmCreate //:产生文件or fmShareDenyWrite); //:fmShareDenyWrite:共享时拒绝被其他App同时写end;LStream.Seek(0, soFromEnd); //:文件流TFileStream指向文件的末尾LOutputFile := TStreamWriter.Create(LStream,LEncoding);//:用文件流TFileStream产生1个“写流工具TStreamWriter”trytryTMonitor.Enter(LOutputFile);tryLOutputFile.WriteLine(AInfo);//:“写流工具TStreamWriter”写入一行字符串finallyTMonitor.Exit(LOutputFile);end;except//:写入错误end;finallyLStream.Free;LEncoding.Free;LOutputFile.Free;end;
end;function getLANIP:string;
//:获取本机IPv4地址:
varLIdIPWatch: TIdIPWatch; //TIdIPWatch类实例LEncoding:TEncoding;LResultStr:string;LStringList:TStringList;
beginLStringList:=TStringList.Create;LEncoding:=TEncoding.GetEncoding('UTF8');//创建TIdIPWatch类实例LIdIPWatch:=TIdIPWatch.Create(nil);LResultStr:='';trytryLIdIPWatch.ForceCheck;if LIdIPWatch.IsOnline=true thenLResultStr:=LEncoding.Getstring(LEncoding.GetBytes(LIdIPWatch.LocalIP)); //本机IPv4地址LStringList.Add(LResultStr); //本机IPv4地址finallyLResultStr:=LStringList.Text.Trim;end;Result:=LResultStr;finally//释放TIdIPWatch类实例LIdIPWatch.Free;LEncoding.Free;LStringList.Free;end;
end;function GetWANIP(const InternetIP:Boolean=true): string;
//:获取本机网关的公网的IPv4地址:
varLList:TList;LListCount :Integer;LResult:string;
beginif InternetIP thenbeginLResult:='';{$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;endelse Result:=getLANIP;
end;function hextostring(str: string): string;
//16进制字符串转原字符串
vars,t:string;i,j:integer;p:pchar;
begins:='';i:=1;while i< length(str) do begint:=str[i]+str[i+1];s:=s+chr(hextoint(t));i:=i+2;end;result:=s;
end;
//-----------------------------------------------
//16进制字符转整数,16进制字符与字符串转换中间函数
//-----------------------------------------------
function HexToInt(hex: string): integer;
vari: integer;function Ncf(num, f: integer): integer;vari: integer;beginResult := 1;if f = 0 then exit;for i := 1 to f doresult := result * num;end;function HexCharToInt(HexToken: char): integer;beginif HexToken > #97 thenHexToken := Chr(Ord(HexToken) - 32);Result := 0;if (HexToken > #47) and (HexToken < #58) then { chars 0....9 }Result := Ord(HexToken) - 48else if (HexToken > #64) and (HexToken < #71) then { chars A....F }Result := Ord(HexToken) - 65 + 10;end;
beginresult := 0;hex := ansiuppercase(trim(hex));if hex = '' thenexit;for i := 1 to length(hex) doresult := result + HexCharToInt(hex[i]) * ncf(16, length(hex) - i);
end;//-----------------------------------------------
//字符串转16进制字符
//-----------------------------------------------
function StringToHex(str: string): string;
vari : integer;s : string;
beginfor i:=1 to length(str) do begins := 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客户端请求,//:先判断客户端网络状态再开始做
varLRESTClient: TRESTClient;LRESTRequest: TRESTRequest;LRESTResponse: TRESTResponse;LResultStr:string;LRestReqErr:ERequestError; //:异常类:uses Rest.TypesLRestReqStatusCode:Integer; //:异常响应状态码:默认0:正常值200LRestReqStatusText:string; //:异常响应状态文本:默认''
begin//2、设置Rest组件参数:LRESTClient:= TRESTClient.Create(nil);//:很重要:回调的字符集和压缩编码:FallbackCharsetEncodingLRESTClient.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//同步执行:trytrytryLRESTRequest.Execute;//产生请求异常的响应结果://LRestReqStatusCode:=200; //:正确的返回//LRestReqStatusText:='OK';//:正确的返回excepttry{LRestReqErr:=ERequestError.Create(LRestReqStatusCode,LRestReqStatusText,LResultStr);if LRestReqStatusCode<>0 then//LRestReqStatusCode=0或LRestReqStatusText=''就不管什么情况反正出错了//:如果是请求错误(不含任何网络异常和服务器错误)//:所以不管请求,只用响应来做判断else //:是响应错误:}beginif 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)//:内部服务器无错误:调用了,但服务器无网络或服务器未能成功启动数据库问题导致不能成功产生响应thenLResultStr:='{"result":["服务器网络故障:可能Net Error或Server not started或Database Error"]}'elseLResultStr:='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;finallyif not LResultStr.Contains('Error') thenLResultStr:='{"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);
beginif AExceptNodelphi thenJITEnable:=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 thenif ByteLength(AAnsiChar)=0 thenbeginResult:='';exit;end;Result:='';for LNums := 0 to ACharNums-1 doResult:= Result +AAnsiChar;
end;///<summary>根据组件名或对象名返回对象的元类</summary>
function FindAnyClass(const Name: string): TClass;
varctx: TRttiContext;typ: TRttiType;list: TArray<TRttiType>;
beginResult := nil;ctx := TRttiContext.Create;list := ctx.GetTypes;for typ in list dobeginif 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)thenbeginResult := typ.AsInstance.MetaClassType;break;endelsebeginResult := nil;continue;end;end;ctx.Free;
end;///<summary>Fmx返回是否成功,回调所有组件的TRttiType的实例TRttiInstanceType的元类的类名:</summary>
function FillFmxClasses(ATStrings:TStrings;AIfRttiTypeList:Boolean=false): Boolean;
varctx: TRttiContext;typ: TRttiType;list: TArray<TRttiType>;
beginResult:=false;ctx := TRttiContext.Create;list := ctx.GetTypes;for typ in list dobeginif 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)thenbegincase AIfRttiTypeList offalse:if not typ.AsInstance.MetaClassType.ClassName.Contains('.') then //:不能获取TRttiType//and not typ.AsInstance.MetaClassType.ClassName.Contains('<') //:不能获取TRttiTypeATStrings.Add(typ.AsInstance.MetaClassType.ClassName+sLineBreak);true:ATStrings.Add(typ.AsInstance.MetaClassType.ClassName+':引用自:'+typ.AsInstance.MetaClassType.QualifiedClassName+sLineBreak+sLineBreak);end;endelsebegincontinue;end;end;ctx.Free;if ATStrings.Count=0 then Result:=falseelse Result:=true;
end;///<summary>Vcl返回是否成功,回调所有组件的TRttiType的实例TRttiInstanceType的元类的类名:</summary>
function FillVclClasses(ATStrings:TStrings): Boolean;
{$IFDEF MSWINDOWS}
varctx: TRttiContext;typ: TRttiType;list: TArray<TRttiType>;
{$ENDIF MSWINDOWS}
beginResult:=false;
{$IFDEF MSWINDOWS}ctx := TRttiContext.Create;list := ctx.GetTypes;for typ in list dobeginif 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)thenbeginATStrings.Add(typ.AsInstance.MetaClassType.ClassName+sLineBreak);endelsebegincontinue;end;end;ctx.Free;if ATStrings.Count=0 then Result:=falseelse Result:=true;
{$ENDIF MSWINDOWS}
end;//ChangeX进制转化及字符串编码类的函数及方法
class function ChangeX.UnicodeStrToStr(AUnicodeStr:String):string;
varLStrBytes:UCS4String;//Array of UCS4Char; UCS4Char = type Cardinal;LLength:Integer;LStringList:TStringList;LWideString:string;
beginLWideString:='';LStringList:=TStringList.Create;try //'\':#92 'U':#85 '\u':#117 '$':#36 space:' ':#32myItems_Delimiter(AUnicodeStr,char(92),LStringList);SetLength(LStrBytes,LStringList.Count);for LLength:=0 to (LStringList.Count)-1 dobeginLStrBytes[LLength]:=HexToDex(LStringList[LLength].ToLower //Lowercase()=.ToLower.Replace( char(117),char(32) ).Trim).ToInteger;end;LWideString:=UCS4StringToWideString(LStrBytes);Result:=LWideString;finallyLStringList.Free;end;
end;class function ChangeX.StrToUnicodeStr(ADefultStr:String):string;
varLStrBytes:UCS4String;//Array of UCS4Char; UCS4Char = type Cardinal;LLength:Integer;LUnicodeStrHex4:string;
beginLUnicodeStrHex4:='';LStrBytes:=WideCharToUCS4String( PWideChar(ADefultStr) );for LLength := 0 to length(LStrBytes)-1 dobeginLUnicodeStrHex4 :=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\u0000end;Result:=LUnicodeStrHex4;
end;class function ChangeX.HexToDex(AHexNum:string):string;
var LResultDexInt:Integer;
beginif TryStrToInt( ('$'+AHexNum),LResultDexInt )=True thenResult:=IntToStr(LResultDexInt)else Result:='';
end;class function ChangeX.DexToHex(ADexNum:string):string;
varLDex:Integer;
beginLDex:=StrToInt(ADexNum);Result:=IntToHex(LDex,2);
end;//TMyTreeView
function TMyTreeView.DoExpandAllorCollapseAll(ATreeView:TTreeView):Boolean;//:TreeView全部展开或全部收拢
beginFIFCollapse:=not FIFCollapse;if FIFCollapse=false thenATreeView.CollapseAll //:收拢else ATreeView.ExpandAll; //:展开Result:=FIFCollapse;
end;procedure TMyTreeView.OnChangeCheck(AItem:TObject);
var LLoop,LCountAllCheckedOfAParentItem,LCountAllUnCheckedOfAParentItem :Integer;LItem,LParentItem: TTreeViewItem;
begininherited DoChangeCheck(AItem as TTreeViewItem);LItem := TTreeViewItem(AItem as TTreeViewItem);for LLoop:=0 to LItem.Count - 1 doLItem.Items[LLoop].IsChecked := LItem.IsChecked;if TTreeViewItem(LItem).ParentItem<>nil thenbeginLParentItem :=TTreeViewItem(LItem).ParentItem;LCountAllCheckedOfAParentItem:=0;for LLoop:=0 to LParentItem.Count - 1 doif LParentItem.Items[LLoop].IsChecked=true thenLCountAllCheckedOfAParentItem:=LCountAllCheckedOfAParentItem+1;if LCountAllCheckedOfAParentItem=LParentItem.Count thenbeginLParentItem.IsChecked:=true;end;LCountAllUnCheckedOfAParentItem:=LParentItem.Count;for LLoop:=0 to LParentItem.Count - 1 doif LParentItem.Items[LLoop].IsChecked=false thenLCountAllUnCheckedOfAParentItem:=LCountAllUnCheckedOfAParentItem-1;if LCountAllUnCheckedOfAParentItem=0 thenbeginLParentItem.IsChecked:=false;end;end;
end;constructor TMyTreeView.Create(AOwner: TComponent);
begininherited; //:首先继承if (LTreeView=nil) thenFTreeView:=selfelse FTreeView:=LTreeView;if (LImageList=nil) thenFImageList:=self.Imageselse FImageList:=LImageList;end;class function TMyTreeView.CreateATreeViewItems(
const AIndex:Integer;AName:string;AText:string;ATreeFiledName:string;AParent:TFmxObject;//:非常关键的参数:指明该节点://:其父节点是TTreeView还是它的上级递归TTreeViewItemAImageList: 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 ); //:所有者:应为窗体或TFrameLTreeViewItem.Index:=AIndex;//:索引会被TTreeView的节点自动索引所覆盖：应使用自定义索引LTreeViewItem.TagLTreeViewItem.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.OnChangeCheckLTreeViewItem.Align:=TAlignLayout.Left;LTreeViewItem.IsChecked:=false;LTreeViewItem.IsExpanded:=false;LTreeViewItem.IsSelected:=false;LTreeViewItem.StyleLookup:='treeviewitemstyle';//:继承即:scrollboxstyle.background.contentLTreeViewItem.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;//OnDblClickResult:=LTreeViewItem;
end;class function TMyTreeView.InitATreeViewItems(const ATreeView: TTreeView;const AImageList: TCustomImageList=nil;const AIFInited: Boolean=false ): Boolean;
beginif ATreeView=nil then begin Result:=false; exit; end;if AIFInited=false then //:尚未初始化beginATreeView.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
喜欢的话，就在下面点个赞、收藏就好了，方便看下次的分享：
delphi XE 10实现App和PC下TreeView调用ImageList和Sqlite数据相关推荐
- Delphi XE 10 跨平台三层数据库应用教程
Delphi XE 10 跨平台三层数据库应用教程 Delphi XE 开始越来越庞大,比经典的Delphi7难用,但依然是目前所有跨平台开发工具中开发效率最高.最容易上手的,其快速设计RAD理念是无 ...
- delphi xe 10.3 用FastReport打印预览当前记录
以下在WINDOWS10 + DELPHI XE 10.3 FireDAC +SQL SERVER 2008 下通过: 第一步,创建如下表单: 第二步 拖入以下几个控件: frxDBDat ...
- Delphi XE 10.4 FMX ListView 一个不易察觉的 BUG
Delphi XE 10.4 FMX ListView 一个不易察觉的 BUG 在使用 ListView DynamicAppearance 时发现非常强大,可以加很多东西,但没有发现复选框(哪位大佬 ...
- delphi xe 10.3 firemonkey stringdrig 插入，删除，添加
以下是在WIN7 64 ,delphi xe 10.3 以下成功运行: 运行界面: 代码 unit Unit1; interface uses System.SysUtils, System.Ty ...
- Delphi XE 10 跨平台三层数据库笔记
Delphi XE 开始越来越庞大,比经典的Delphi7难用,但依然是目前所有跨平台开发工具中开发效率最高.最容易上手的,其快速设计RAD理念是无与伦比的符合人性. 目前网上XE10类似教程很少,而 ...
- DELPHI XE 10.3开发安卓APP的经过
首先要感谢CSDN和各位上传东西上CSDN的朋友,我原来有900多分的,为上下载相关的东西,花掉了400多分. 本来想安装XE10.4的,无奈PJ不了,XE10.4前两天在一台WIN7 64位上成功安 ...
- Delphi XE 10.2.3使用CEF4Delphi取网页元素时碰到nbsp;变问号?的处理
用CEF4Delphi取网页元素时碰到ElementInnerText里含有" " 比如网页源码里是"内容 "取出来显示就变成"内容?" 搜 ...
- Delphi XE 10.1 Can't bind address: Address already in use. Exiting.
在真机调试安卓app的时候出现,后来重启一下手机就好了 转载于:https://www.cnblogs.com/limuzi/p/8038493.html
- delphi cef写入html,Delphi XE 10.2.3使用CEF4Delphi取网页元素时碰到nbsp;变问号?的处理...
用CEF4Delphi取网页元素时碰到ElementInnerText里含有" " 比如网页源码里是"内容 "取出来显示就变成"内容?" 搜 ...
最新文章
- Python3实现邮箱发送
- SELECT COUNT(*) 底层究竟干了啥么？
- Spring Cloud构建微服务架构（五）服务网关
- 1.1.3 以Self Host方式寄宿Web API
- 【Linux】一步一步学Linux——host命令(162)
- 【C语言实现反转数组】（用栈实现）51nod - 训练营
- ruby 将字符转数字计算_Ruby程序计算一个数字中的位数
- Android leak内存,GitHub - jin870132/memoryleakdemo: 安卓内存泄露几种常见形式及解决方案...
- hibernate get方法有执行sql但是后台拿不到_「6」进大厂必须掌握的面试题-Hibernate...
- shell技巧（sed 断句、读取指定行） 【ZT】
- 【Antlr】Antlr preview 不能使用了
- 10-2-DBUtils工具
- 计算同比和环比的区别_【数据说第三期】同比和环比数据分析时，有哪些需要注意的点？...
- word打开文档很久很慢_word打开慢,教您怎么解决word打开慢
- 密码学专题 非对称加密算法指令概述 DH算法指令
- 使用jqery模拟网易严选购物车功能
- python应用之Word生成
- TSP问题解析篇之自适应大邻域搜索(ALNS)算法深度通读（附python代码）
- 支持win7的node.js版本+node和npm版本不匹配问题解决
- ASP.NET Core 基础（十三）——模型绑定与模型验证