10分钟制作制作炫酷Windows Android IOS Dialogs对话框FMX界面,带透明度,可以将提示的内容问题和截屏任意分享至社交App

10分钟制作制作炫酷Windows Android IOS Dialogs对话框FMX界面

带透明度,可以将提示的内容问题和截屏任意分享至社交App

 

一、先看代码

unit CustomDialogsSimple1;

interface

uses
  System.SysUtils, System.Types, System.UITypes,
  System.Classes, System.Variants, System.Actions,
  System.Rtti,//:运行时刻库
  FMX.Types, FMX.Graphics, FMX.Controls,
  FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
  FMX.Edit, FMX.Effects, FMX.Controls.Presentation,
  FMX.Objects, FMX.Layouts,
  FMX.ScrollBox, FMX.Memo,
  FMX.ActnList, FMX.StdActns,  ,FMX.Platform //:平台服务
  ;

type
  TframeCustomDialogsSimple1 = class(TFrame)
    LayoutDiologTranslucent: TLayout;
    RectDiologTranslucent: TRectangle;
    RectDiolog: TRectangle;
    RectDiologTitle: TRectangle;
    lblDiologTitle: TLabel;
    RectDiologToolbar: TRectangle;
    GlowEffect1: TGlowEffect;
    lblRectDiologContentTips: TLabel;
    imgDiologTitle: TImage;
    LayoutRectDiologContent: TLayout;
    MemoTips: TMemo;
    LayoutRectDiologContentTips: TLayout;
    imgRectDiologContentTips: TImage;
    RectBtnOk: TRectangle;
    imgBtnOk: TImage;
    lblBtnOk: TLabel;
    RectBtnCancel: TRectangle;
    imgBtnCancel: TImage;
    lblBtnCancel: TLabel;
    btnCancel: TRectangle;
    btnOk: TRectangle;
    RectDiologContentTips: TRectangle;
    RectBtnHelpme: TRectangle;
    imgBtnHelpme: TImage;
    lblBtnHelpme: TLabel;
    btnHelpme: TRectangle;
    imgShare: TImage;
    LayoutShare: TLayout;
    RectShare: TRectangle;
    RectBtnShareText: TRectangle;
    imgBtnShareText: TImage;
    lblBtnShareText: TLabel;
    BtnShareText: TRectangle;
    RectBtnShareTo: TRectangle;
    imgBtnShareTo: TImage;
    lblBtnShareTo: TLabel;
    BtnShareTo: TRectangle;
    LayoutShareText: TLayout;
    MemoShareText: TMemo;
    LayoutShareTextTips: TLayout;
    RectShareTextTips: TRectangle;
    imgShareTextTips: TImage;
    lblShareTextTips: TLabel;
    RectShareText: TRectangle;
    lblRectShare: TLabel;
    RectLayoutShare: TRectangle;
    SpBtnShareTo: TSpeedButton;
    procedure btnOkClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure btnHelpmeClick(Sender: TObject);
    procedure BtnShareTextClick(Sender: TObject);
    procedure BtnShareToClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    //供调用者传入的回调参数:
    //FTips:string;
    frameCustomDialogsSimple1:TframeCustomDialogsSimple1;
    FTControl:TControl;//:供调用者传入的截屏控件
  end;
type
  TAProc<T> = reference to procedure(const Arg :T);
  TAFunc<T,TResult> = reference to function(const Arg :T):T;

var FTips:string;//:传出变量

  ///<summary>本单元通用截屏方法-可做入全局库:</summary>
  procedure FMakeScreenshot(
    ATControl:TControl;AImage:TImage);

implementation

uses myFuc_UnifiedPlatForm;  // :我的通用库
{$R *.fmx}

procedure TframeCustomDialogsSimple1.btnCancelClick(Sender: TObject);
var LAProc:TAProc<string>;
    LAFunc:TAFunc<string,Boolean>;
begin
  //MemoRectDiologContent.Lines.Add('        你点了取消,你要做什么在你的继承代码中写匿名过程TAProc<T>或写匿名函数TAFunc<T>');
  FTips:=sLineBreak+'你点了取消:'+sLineBreak
    +'        你点了取消,你要做什么在你的继承代码中调用你写好的过程或函数';
  //:FTips:回调测试用
  self.SendToBack;
  self.Visible:=false;
end;

procedure TframeCustomDialogsSimple1.btnOkClick(Sender: TObject);
var LAProc:TAProc<string>;
    LAFunc:TAFunc<string,Boolean>;
begin
  //MemoRectDiologContent.Lines.Add('        你点了确定,你要做什么在你的继承代码中写匿名过程TAProc<T>或写匿名函数TAFunc<T>');
  FTips:=sLineBreak+'你点了确定:'+sLineBreak
    +'        你点了确定,你要做什么在你的继承代码中调用你写好的过程或函数';
  //:FTips:回调测试用
  self.SendToBack;
  self.Visible:=false;
end;

procedure TframeCustomDialogsSimple1.btnHelpmeClick(Sender: TObject);
begin
  FMakeScreenshot(self.FTControl,self.imgShare);//:调截屏方法
  FTips:=sLineBreak+'你点了询问:'+sLineBreak
    +'        你点了询问,你可以用此接口截屏分享给需要帮助您的人';
  //:FTips:回调测试用
  LayoutDiologTranslucent.Visible:=true;
  RectDiolog.Visible:=false;

  LayoutShare.BringToFront;
  LayoutShare.Visible:=true;
end;

procedure TframeCustomDialogsSimple1.BtnShareTextClick(Sender: TObject);
begin
  LayoutShareText.Visible:=not(LayoutShareText.Visible);
end;

procedure TframeCustomDialogsSimple1.BtnShareToClick(Sender: TObject);

var LClipBoard:IFMXClipboardService; //:剪切板接口  //: FMX.Platform
    LTValue:TValue;//:设置剪切板的泛型值  //: System.Rtti
begin
  if MemoShareText.Lines.Text.Trim<>'' then
  if TPlatformServices.Current.SupportsPlatformService(
    IFMXClipboardService,IInterface(LClipBoard) ) then
  begin
    LTValue := TValue.From(MemoShareText.Lines.Text);
    LClipBoard.SetClipboard(LTValue);
  end;
  //:剪切复制说两句的内容;界面显示处理:
  LayoutShareText.Visible:=false;

  LayoutShare.SendToBack;
  LayoutShare.Visible:=false;
  imgShare.Visible:=false;

  LayoutDiologTranslucent.Visible:=true;
  RectDiolog.Visible:=true;
end;

procedure FMakeScreenshot(
  ATControl:TControl;AImage:TImage);
//本单元通用截屏方法-可做入全局库:
var LTBitmap:TBitmap;
begin
  LTBitmap:=ATControl.MakeScreenshot;
    //:FTControl:回调控件截屏
  AImage.Bitmap.SetSize(LTBitmap.Size);
  AImage.Bitmap.CopyFromBitmap(LTBitmap);
  AImage.Visible:=true;
end;

end.

 

 做出的效果：

 

 

二、怎么做的呢？步骤：

1、先用FMX Form临时窗体画UI界面（javaUI做的事情）：

底层Layout给透明度：

这样布局：

 

注意layer层之间Bringfront和SendToBack属性，

画出这样的效果：

2、创建Frame（javaUI做的事情）：

3、把你刚才在Form临时窗体中画的UI界面复制粘贴到上面的Frame（javaUI做的事情）：

这样的效果：

4、Frame UI界面简单的点击事件控制界面显示规则（java前端做的事情）：

//  几句话代码（见上面蓝色标注）:

5、将上述Frame界面拖入加载到你的APP应用窗体（javaUI做的事情）

6、写你的调用代码及逻辑代码（java后端开发做的事情）：

按钮事件代码：

分享代码：

一次一个分享动作：图片和文字只能二选一（除非 你做了多个动作代码，被某个Action连续调用，或者将文字画到图片中去）：

截屏传参：

大功告成！是不是很简单呀！

 

三、下面是在上述基础之上，附加：1、WIndows下拉起QQ、TIM、微信；2、访问注册表

3.1、全平台拉起QQ、TIM、微信等进行分享截屏及消息对话框内容

unit CustomDialogsSimple1;

interface

uses
  {$IFDEF MSWINDOWS}
  Winapi.ShellAPI,Winapi.Windows,
  RegistryWin32,
  {$ENDIF MSWINDOWS}
  System.SysUtils, System.Types, System.UITypes,
  System.Classes, System.Variants, System.Actions,
  System.IOUtils,System.Rtti,//:运行时刻库
  FMX.Types, FMX.Graphics, FMX.Controls,
  FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
  FMX.Edit, FMX.Effects, FMX.Controls.Presentation,
  FMX.Objects, FMX.Layouts,
  FMX.ScrollBox, FMX.Memo,
  FMX.ActnList, FMX.StdActns,
  FMX.Ani
  ,FMX.ImgList
  ,FMX.Platform //:平台服务
  ,myFuc_UnifiedPlatForm
  ;

type
  TframeCustomDialogsSimple1 = class(TFrame)
    LayoutDiologTranslucent: TLayout;
    RectDiologTranslucent: TRectangle;
    RectDiolog: TRectangle;
    RectDiologTitle: TRectangle;
    lblDiologTitle: TLabel;
    RectDiologToolbar: TRectangle;
    GlowEffect1: TGlowEffect;
    lblRectDiologContentTips: TLabel;
    imgDiologTitle: TImage;
    LayoutRectDiologContent: TLayout;
    MemoTips: TMemo;
    LayoutRectDiologContentTips: TLayout;
    imgRectDiologContentTips: TImage;
    RectBtnOk: TRectangle;
    imgBtnOk: TImage;
    lblBtnOk: TLabel;
    RectBtnCancel: TRectangle;
    imgBtnCancel: TImage;
    lblBtnCancel: TLabel;
    btnCancel: TRectangle;
    btnOk: TRectangle;
    RectDiologContentTips: TRectangle;
    RectBtnHelpme: TRectangle;
    imgBtnHelpme: TImage;
    lblBtnHelpme: TLabel;
    btnHelpme: TRectangle;
    imgShare: TImage;
    LayoutShare: TLayout;
    RectShare: TRectangle;
    RectBtnShareText: TRectangle;
    imgBtnShareText: TImage;
    lblBtnShareText: TLabel;
    BtnShareText: TRectangle;
    RectBtnShareTo: TRectangle;
    imgBtnShareTo: TImage;
    lblBtnShareTo: TLabel;
    BtnShareTo: TRectangle;
    LayoutShareText: TLayout;
    MemoShareText: TMemo;
    LayoutShareTextTips: TLayout;
    RectShareTextTips: TRectangle;
    imgShareTextTips: TImage;
    lblShareTextTips: TLabel;
    RectShareText: TRectangle;
    lblRectShare: TLabel;
    RectLayoutShare: TRectangle;
    SpBtnShareTo: TSpeedButton;
    HorzScrollBox1: THorzScrollBox;
    PopupShareWindows: TPopup;
    Layout1: TLayout;
    Layout2: TLayout;
    Layout3: TLayout;
    Layout4: TLayout;
    Layout101: TLayout;
    Layout104: TLayout;
    Layout103: TLayout;
    Layout102: TLayout;
    Layout201: TLayout;
    Layout204: TLayout;
    Layout203: TLayout;
    Layout202: TLayout;
    Image101: TImage;
    Label101: TLabel;
    Image102: TImage;
    Label102: TLabel;
    btnQQ: TSpeedButton;
    btnWechat: TSpeedButton;
    ActionListShareWindows: TActionList;
    ActPopUpShareWindows: TControlAction;
    btnTIM: TSpeedButton;
    Image103: TImage;
    Label103: TLabel;
    procedure btnOkClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure btnHelpmeClick(Sender: TObject);
    procedure BtnShareTextClick(Sender: TObject);
    procedure BtnShareToClick(Sender: TObject);
    procedure ActPopUpShareWindowsExecute(Sender: TObject);
  private
    { Private declarations }

  public
    { Public declarations }
    //供调用者传入的回调参数:
    //FTips:string;
    frameCustomDialogsSimple1:TframeCustomDialogsSimple1;
    FTControl:TControl;  //:供调用者传入的截屏控件
    FCallmeForm:TForm; //:供调用者传入的调用本frame的窗体
    FQQisRunning:Boolean; //:QQ是否手动登录(QQ不像微信,App拉起会被腾讯安全警告，只能由浏览器打开)
    FTIMisRunning:Boolean;
  end;
type
  TAProc<T> = reference to procedure(const Arg :T);
  TAFunc<T,TResult> = reference to function(const Arg :T):T;

var FTips:string;//:传出变量
    FCurrShareName:string;

  ///<summary>本单元通用截屏方法-可做入全局库:</summary>
  procedure FMakeScreenshot(
    ATControl:TControl;AImage:TImage);

  //function SetRegStr(const ARootKey,AKeyName,AName,AValue
   //,AValueType:string):string;external 'ProDllWin32.dll' name 'SetRegStr';
     //:Dll方式需解决回调问题:Dll执行完主程序就自动关闭啦
implementation

{$R *.fmx}

procedure TframeCustomDialogsSimple1.btnCancelClick(Sender: TObject);
var LAProc:TAProc<string>;
    LAFunc:TAFunc<string,Boolean>;
begin
  {$IFDEF MSWINDOWS}
    KillApp('ProAPIRegistryWin32.exe');
  {$ENDIF MSWINDOWS}
  //MemoRectDiologContent.Lines.Add('        你点了取消,你要做什么在你的继承代码中写匿名过程TAProc<T>或写匿名函数TAFunc<T>');
  FTips:=sLineBreak+'你点了取消:'+sLineBreak
    +'        你点了取消,你要做什么在你的继承代码中调用你写好的过程或函数';
  //:FTips:回调测试用
  self.SendToBack;
  self.Visible:=false;
end;

procedure TframeCustomDialogsSimple1.btnOkClick(Sender: TObject);
var LAProc:TAProc<string>;
    LAFunc:TAFunc<string,Boolean>;
begin
  {$IFDEF MSWINDOWS}
    KillApp('ProAPIRegistryWin32.exe');
  {$ENDIF MSWINDOWS}
  //MemoRectDiologContent.Lines.Add('        你点了确定,你要做什么在你的继承代码中写匿名过程TAProc<T>或写匿名函数TAFunc<T>');
  FTips:=sLineBreak+'你点了确定:'+sLineBreak
    +'        你点了确定,你要做什么在你的继承代码中调用你写好的过程或函数';
  //:FTips:回调测试用
  self.SendToBack;
  self.Visible:=false;
end;

procedure TframeCustomDialogsSimple1.btnHelpmeClick(Sender: TObject);
var AAppKeyValue:string;
begin
  {$IFDEF MSWINDOWS}
    AAppKeyValue:='ProAPIRegistryWin32.exe';
    KillApp(AAppKeyValue);
  {$ENDIF MSWINDOWS}
  FMakeScreenshot(self.FTControl,self.imgShare);//:调截屏方法
  FTips:=sLineBreak+'你点了询问:'+sLineBreak
    +'        你点了询问,你可以用此接口截屏分享给需要帮助您的人';
  //:FTips:回调测试用
  LayoutDiologTranslucent.Visible:=true;
  RectDiolog.Visible:=false;

  LayoutShare.BringToFront;
  LayoutShare.Visible:=true;
end;

procedure TframeCustomDialogsSimple1.BtnShareTextClick(Sender: TObject);
begin
  LayoutShareText.Visible:=not(LayoutShareText.Visible);
end;

procedure TframeCustomDialogsSimple1.BtnShareToClick(Sender: TObject);
var LClipBoard:IFMXClipboardService; //:剪切板接口 //:FMX.Platform
    LTValue:TValue;//:设置剪切板的泛型值 //:System.Rtti
begin
  {$IFDEF MSWINDOWS}
    PopupShareWindows.Visible:=true;
  {$ELSE}
    LayoutShareText.Visible:=false;

    LayoutShare.SendToBack;
    LayoutShare.Visible:=false;
    imgShare.Visible:=false;

    LayoutDiologTranslucent.Visible:=true;
    RectDiolog.Visible:=true;
  {$ENDIF}
  //:界面显示处理;剪切复制说两句的内容:

  if MemoShareText.Lines.Text.Trim<>'' then
  if TPlatformServices.Current.SupportsPlatformService(
    IFMXClipboardService,IInterface(LClipBoard) ) then
  begin
    LTValue := TValue.From(MemoShareText.Lines.Text);
    LClipBoard.SetClipboard(LTValue);
  end;

end;

procedure TframeCustomDialogsSimple1.ActPopUpShareWindowsExecute(
  Sender: TObject);
  {$IFDEF MSWINDOWS}
var AAppKeyValue:string;
    LNativeUInt:NativeUInt;
  {$ENDIF MSWINDOWS}
begin
  {$IFDEF MSWINDOWS}
    //MemoTips.Lines.Add(Sender.ToString);
    try
      if (Sender as TControlAction).Target.Name='btnQQ' then
      begin
        try
          if FQQisRunning=false then
          begin
            //MemoTips.Lines.Add('QQ未运行');
            AAppKeyValue:='QQ.exe';
            try
              try
                FQQisRunning:=AppRunning(AAppKeyValue);
              except
                //
              end;
            finally
              if FQQisRunning=false then
              begin
                ShowAMessage('请先手动登录您的QQ',procedure begin end);
                Abort;
              end;
            end;
          end;
        finally
          if FQQisRunning=True then
          begin
            //MemoTips.Lines.Add('QQ已运行');
            AAppKeyValue:='';
            FCurrShareName:='tencent://Message/?Uin=461655651&websiteName=q-zone.qq.com&Menu=yes';
            //:测试纸适用Win32://ShellExecute(0, 'open','IExplore.EXE', PWideChar(WideString(FCurrShareName)), nil, SW_SHOWNORMAL);
            try
              ExeURL(AAppKeyValue,PWideChar(WideString(FCurrShareName)),SW_SHOWNORMAL);
              //:QQ是否手动登录(QQ不像微信,
                //:App拉起会被腾讯安全警告，只能由浏览器打开)
            finally
              FCallmeForm.Activate; self.SetFocus;
            end;

          end;
        end;
      end;
      if (Sender as TControlAction).Target.Name='btnTIM' then
      begin
        try
          if FTIMisRunning=false then
          begin
            //MemoTips.Lines.Add('TIM未运行');
            AAppKeyValue:='TIM.exe';
            try
              try
                FTIMisRunning:=AppRunning(AAppKeyValue);
              except
                //
              end;
            finally
              if FTIMisRunning=false then
              begin
                ShowAMessage('请先手动登录您的qq办公版TIM',procedure begin end);
                Abort;
              end;
            end;
          end;
        finally
          if FTIMisRunning=True then
          begin
            //MemoTips.Lines.Add('TIM已运行');
            AAppKeyValue:='';
            FCurrShareName:='tencent://Message/?Uin=461655651&websiteName=q-zone.qq.com&Menu=yes';
            //:测试纸适用Win32://ShellExecute(0, 'open','IExplore.EXE', PWideChar(WideString(FCurrShareName)), nil, SW_SHOWNORMAL);
            try
              ExeURL(AAppKeyValue,PWideChar(WideString(FCurrShareName)),SW_SHOWNORMAL);
              //:QQ是否手动登录(QQ不像微信,
                //:App拉起会被腾讯安全警告，只能由浏览器打开)
            finally
              FCallmeForm.Activate; self.SetFocus;
            end;

          end;
        end;
      end;

      if (Sender as TControlAction).Target.Name='btnWechat' then
      begin
        FCurrShareName:='WeChat';

        AAppKeyValue:='ProAPIRegistryWin32.exe';
          //:AAppKeyValue:若参数=''则不调用:
        LNativeUInt:=ExeApp(AAppKeyValue,FCurrShareName,SW_SHOW);
        //LNativeUInt:=ExeApp(AAppKeyValue,'WeChat',SW_SHOW);
          //:(SW_HIDE,SW_SHOW,...)
        //if LNativeUInt.ToString.Trim<>'' then
          //MemoTips.Lines.Add(LNativeUInt.ToString.Trim)
          //;
          //:LNativeUInt.ToString.Trim<>'':代表调用成功
          //ToString:System.SysUtils.TNativeUIntHelper
      end;
    finally
      LayoutShareText.Visible:=false;

      LayoutShare.SendToBack;
      LayoutShare.Visible:=false;
      imgShare.Visible:=false;

      LayoutDiologTranslucent.Visible:=true;
      RectDiolog.Visible:=true;
    end;

  PopupShareWindows.Visible:=false;
  {$ENDIF MSWINDOWS}
end;

procedure FMakeScreenshot(
  ATControl:TControl;AImage:TImage);
//本单元通用截屏方法-可做入全局库:
var LTBitmap:TBitmap;
begin
  LTBitmap:=ATControl.MakeScreenshot;
    //:FTControl:回调控件截屏
  AImage.Bitmap.SetSize(LTBitmap.Size);
  AImage.Bitmap.CopyFromBitmap(LTBitmap);
  AImage.Visible:=true;
end;

//initialization

//finalization

end.

 

3.2、访问Win32注册表

unit RegistryWin32;
{Win32 API Interface Unit}

interface
uses
  Winapi.Windows,Winapi.ShellAPI,
  Winapi.TlHelp32, Winapi.PsAPI,
  System.Win.Registry,//:Windows注册表类
  System.Classes,
  System.SysUtils
  ,Vcl.Controls,Vcl.Forms
  ;

  ///<summary>设置注册表制定位置(ARootKey下AKeyName)键AName值AValue:</summary>
    ///<param name="ARootKey">=注册表主键</param>
    ///<param name="ARootKey">=主键下的某个目录键</param>
    ///<param name="AName">=目录键下的数值名称</param>
    ///<param name="AValue">=目录键下的数值数据</param>
    ///<param name="AValueType">=数值数据的类型('整型','字符串型','布尔型','浮点型','日期时间型','日期型','时间型')</param>
  procedure SetRegStr(const ARootKey,AKeyName,AName,AValue
    ,AValueType:string);
  ///<summary>读取注册表制定位置(ARootKey下AAppNameKey)键值:</summary>
  procedure readRegistry(
    const ARootKey:NativeUInt;
    const AAppNameKey:string;
    const AAppKeyName:string;
    var AAppKeyValue:String );
  ///<summary>当前Windows是64位还是32位操作系统:</summary>
  ///<summary>需要注意是GetNativeSystemInfo 函数从Windows XP 开始才有,</summary>
  ///<summary>而 IsWow64Process 函数从 Windows XP with SP2以及Windows Server 2003 with SP1开始才有</summary>
  ///<summary>所以使用该函数的时候最好用GetProcAddress:</summary>
  function IsWin64: string;

  ///<summary>Windows获取操作系统优先级:</summary>
  procedure GetPrivilege;
  ///<summary>Windows提示关机、强制关机、重启:</summary>
  procedure RebootSystem(const RebootStyle:string='重启');
  //调用ZwShutdownSystem()函数后，会通知硬件驱动保存内核数据，注册表和文件的缓存将会刷新到磁盘上,
  //然后将立即重启或关机，未保存的应用程序数据将丢失。
  //由于ZwShutdownSystem()通知硬件驱动后是瞬间关机的。为了系统与硬件的安全，
  //应使用ExitWindowsEx()进行正常关机。
  function RtlAdjustPrivilege(Privilege: ULONG; Enable: BOOLEAN;
             CurrentThread: BOOLEAN; Enabled: PBOOLEAN): DWORD; stdcall; external 'ntdll.dll';
  function ZwShutdownSystem(arg: DWORD): BOOLEAN; stdcall; external 'ntdll.dll';

  ///<summary>Win32执行一个外部应用:</summary>
    ///<param name="AppName">=外部应用全路径名称</param>
    ///<param name="AppParamStr">=向App传入的参数:ParamStr(0)不能调用(系统默认APP根目录):ParamStr(1)...ParamStr(N),可由分隔符代码调用</param>
    ///<param name="AShowWindowStyle">=(SW_HIDE,SW_SHOW,...)App显示方式</param>
  function ExeApp(var AppName:string;const AppParamStr:string;const AShowWindowStyle:NativeUInt):NativeUInt;

  function ExeURL(
    var AppName:string;
    const AppParamStr:string;
    const AShowWindowStyle:NativeUInt):NativeUInt;
  ///<summary>Win32强行杀死一个外部应用:</summary>
    ///<param name="AppName">=外部应用全路径名称</param>
  procedure KillApp(const AppName:string);
  procedure KillProcess(ExeName: string);

  function AppRunning(var AppName:string):Boolean;
implementation

procedure SetRegStr(const ARootKey,AKeyName,AName,AValue
  ,AValueType:string);
var Reg: TRegistry; AOldValue:string;
//比如AName:=EnableLUA
//比如AKeyName:='Software\Microsoft\Windows\CurrentVersion\Policies\System'
//AValueType:=('整型','字符串型','布尔型','浮点型','日期时间型','日期型','时间型')
begin
  Reg := TRegistry.Create;
  try
    if ARootKey='HKEY_LOCAL_MACHINE' then
      Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.OpenKey(AKeyName ,true);
    if not Reg.ValueExists(AName) then
    begin
      if AValueType='整型' then Reg.WriteInteger(AName,StrToInt(AValue));
      if AValueType='字符串型' then Reg.WriteString(AName,AValue);
      if AValueType='浮点型' then Reg.WriteFloat(AName,StrToFloat(AValue));
      if AValueType='日期时间型' then Reg.WriteDateTime(AName,StrToDateTime(AValue));
      if AValueType='日期型' then Reg.WriteDate(AName,StrToDate(AValue));
      if AValueType='时间型' then Reg.WriteTime(AName,StrToTime(AValue));
    end else
    begin
      if AValueType='整型' then
      begin
        AOldValue:=IntToStr(Reg.ReadInteger(AName));
        Reg.DeleteValue(AOldValue);
        Reg.WriteInteger(AName,StrToInt(AValue));
      end;
      if AValueType='字符串型' then
      begin
        AOldValue:=(Reg.ReadString(AName));
        Reg.DeleteValue(AOldValue);
        Reg.WriteString(AName,(AValue));
      end;
      if AValueType='浮点型' then
      begin
        AOldValue:=FloatToStr(Reg.ReadFloat(AName));
        Reg.DeleteValue(AOldValue);
        Reg.WriteFloat(AName,StrToFloat(AValue));
      end;
      if AValueType='日期时间型' then
      begin
        AOldValue:=DateTimeToStr(Reg.ReadDateTime(AName));
        Reg.DeleteValue(AOldValue);
        Reg.WriteDateTime(AName,StrToDateTime(AValue));
      end;
      if AValueType='时间型' then
      begin
        AOldValue:=TimeToStr(Reg.ReadTime(AName));
        Reg.DeleteValue(AOldValue);
        Reg.WriteTime(AName,StrToTime(AValue));
      end;
    end;
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
end;

procedure readRegistry(
  const ARootKey:NativeUInt;
  const AAppNameKey:string;
  const AAppKeyName:string;
  var AAppKeyValue:String );
//读取注册表制定位置(ARootKey下AAppNameKey)键值
{$IFDEF MSWINDOWS}
var
  ifIsWin64: String;
  TheReg: TRegistry;//注意:Win32 API:Windows 64-位下编译不生效的
  KeyName: String;
  ValueStr: String;
{$ENDIF MSWINDOWS}
begin
{$IFDEF MSWINDOWS}
  if AAppNameKey.Trim='' then exit;
  try

    TheReg:=TRegistry.Create;
    TheReg.RootKey:=ARootKey;
      //:HKEY_LOCAL_MACHINE;//Winapi.Windows
        //:等价于:NativeUInt($80000002) //System
      //:HKEY_CURRENT_USER = HKEY(NativeUInt($80000001));
    try
      ifIsWin64:=IsWin64;
    finally
      if AAppNameKey.Trim='QQ2009' then
      begin
        KeyName := 'Software\Tencent\'
          +AAppNameKey;
      end else
      if AAppNameKey.Trim='TIM' then
      begin
        KeyName := 'Software\Tencent\'
          +AAppNameKey;
      end else
      begin
        if pos('64-bit',ifIsWin64.trim)>=0 then //='64位操作系统'
          KeyName := 'Software\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\'
            +AAppNameKey; //+'WeChat';
        if pos('32-bit',ifIsWin64.trim)>=0 then//='32位操作系统'
         KeyName := 'Software\Microsoft\Windows\CurrentVersion\Uninstall\'
            +AAppNameKey; //+'WeChat';
      end;
    end;
      //:Windows任意安装和卸载的位置
      //:如需知道某App的具体安装和卸载程序全路径,
        //:就需要知道其下级的注册表节点名称,如+'WeChat'
    if TheReg.OpenKey(KeyName,true) then
    begin //回调安装全路径执行文件名AAppKeyValue:
      AAppKeyValue:=(TheReg.ReadString(AAppKeyName));
      //AAppKeyValue:=(TheReg.ReadString('DisplayIcon'));
        //:DisplayIcon一般软件开发会设置其键值为安装全路径执行文件名,
          //:但也不完全:取决于开发商

    end;
  finally
    TheReg.CloseKey;
    TheReg.Free;
  end;
{$ENDIF MSWINDOWS}
end;

//需要注意是GetNativeSystemInfo 函数从Windows XP 开始才有，
//而 IsWow64Process 函数从 Windows XP with SP2 以及 Windows Server 2003 with SP1 开始才有。
//所以使用该函数的时候最好用GetProcAddress
function IsWin64: string;
var LOSVer:System.SysUtils.TOSVersion;
{$IFDEF MSWINDOWS}
{
var
  Kernel32Handle: THandle;
  IsWow64Process: function(Handle: THandle; var Res: BOOL): BOOL; stdcall;
  GetNativeSystemInfo: procedure(var lpSystemInfo: TSystemInfo); stdcall;
  isWoW64: Bool;
  SystemInfo: TSystemInfo;
const
  PROCESSOR_ARCHITECTURE_AMD64 = 9;
  PROCESSOR_ARCHITECTURE_IA64 = 6;
}
{$ENDIF MSWINDOWS}
begin
  Result :=LOSVer.ToString;
{
  Result :=
    'Name:'+LOSVer.Name
    +',ToString:'+LOSVer.ToString
    +',Build:'+IntToStr(LOSVer.Build)
    +',Major:'+IntToStr(LOSVer.Major)
    +',Minor:'+IntToStr(LOSVer.Minor)
    +',ServicePackMajor:'+IntToStr(LOSVer.ServicePackMajor)
    +',ServicePackMinor:'+IntToStr(LOSVer.ServicePackMinor)
    ; }
(*
//{$IFDEF MSWINDOWS}
  {
  Kernel32Handle := GetModuleHandle('KERNEL32.DLL');
  if Kernel32Handle = 0 then Kernel32Handle := LoadLibrary('KERNEL32.DLL');
  if Kernel32Handle <> 0 then
  }
if LOSVer.Platform in [pfWindows,pfWinRT] then
begin

  if LOSVer.Architecture in [arIntelX64,arARM64]  //(LOSVer.Architecture=TOSVersion.TArchitecture.arIntelX64)
    //or (LOSVer.Architecture=TOSVersion.TArchitecture.arARM64)
  then
  begin
    {
    IsWOW64Process := GetProcAddress(Kernel32Handle,'IsWow64Process');
    GetNativeSystemInfo := GetProcAddress(Kernel32Handle,'GetNativeSystemInfo');
    if Assigned(IsWow64Process) then
    begin
      IsWow64Process(GetCurrentProcess,isWoW64);
      if (isWoW64 and Assigned(GetNativeSystemInfo)
         )=true then
      begin
        GetNativeSystemInfo(SystemInfo);
        if (  (SystemInfo.wProcessorArchitecture = PROCESSOR_ARCHITECTURE_AMD64)
           or (SystemInfo.wProcessorArchitecture = PROCESSOR_ARCHITECTURE_IA64)
           )
        then
        Result := '64位操作系统64位处理器' else Result := '64位操作系统32位处理器';
      end;
    end; }
    Result := '64位操作系统'+LOSVer.ToString;
  end else Result := '32位操作系统'+LOSVer.ToString;
end;
*)
//{$ENDIF MSWINDOWS}

end;

procedure RebootSystem(const RebootStyle:string='重启');
//:RebootStyle:Windows提示关机、强制关机、重启:
begin
{$IFDEF MSWINDOWS}
  GetPrivilege;
  if RebootStyle='提示关机' then
    initiateSystemShutDown(nil,nil,0,true,false);
  if RebootStyle='强制关机' then
    ExitWindowsEx(EWX_SHUTDOWN+EWX_FORCE+EWX_POWEROFF+EWX_FORCEIFHUNG, 0);
  if RebootStyle='重启' then
    ExitWindowsEx(EWX_REBOOT OR EWX_FORCE or EWX_POWEROFF or EWX_FORCEIFHUNG, 0);
{$ENDIF MSWINDOWS}
end;

procedure GetPrivilege;
{$IFDEF MSWINDOWS}
var
  NewState:       TTokenPrivileges;
  lpLuid:         Int64;
  ReturnLength:   DWord;
  ToKenHandle:    THandle;
{$ENDIF MSWINDOWS}
begin
{$IFDEF MSWINDOWS}
  OpenProcessToken(GetCurrentProcess,
                   TOKEN_ADJUST_PRIVILEGES
                   OR TOKEN_ALL_ACCESS
                   OR STANDARD_RIGHTS_REQUIRED
                   OR TOKEN_QUERY,ToKenHandle);
  LookupPrivilegeValue(nil,'SeShutdownPrivilege',lpLuid);
  NewState.PrivilegeCount:=1;
  NewState.Privileges[0].Luid:=lpLuid;
  NewState.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;
  ReturnLength:=0;
  AdjustTokenPrivileges(ToKenHandle,False,NewState,0,nil,ReturnLength);
{$ENDIF MSWINDOWS}
end;

function ExeApp(var AppName:string;
  const AppParamStr:string;
  const AShowWindowStyle:NativeUInt):NativeUInt;
var LHandle:HWND;
    StartInfo:STARTUPINFO;
begin
  //AShowWindowStyle:=(SW_HIDE,SW_SHOW,...)
  //AppParamStr:向App传入的参数:ParamStr(0)不能调用,系统默认APP根目录
    //:ParamStr(1)...ParamStr(N),可由分隔符代码调用
{$IFDEF MSWINDOWS}
  if AppName.Trim='' then exit;
      LHandle:=0;
      Result:=
      ShellExecute(LHandle,'open'
        ,PWideChar(WideString(AppName))
        ,PWideChar(WideString(AppParamStr))//:向App传入的参数
        ,nil  //:App默认目录
        ,AShowWindowStyle //:App显示方式
        );

{$ENDIF MSWINDOWS}
end;

function ExeURL(
  var AppName:string;
  const AppParamStr:string;
  const AShowWindowStyle:NativeUInt):NativeUInt;
var LHandle:HWND;
    LNativeUInt:NativeUInt;
    //StartInfo:STARTUPINFO;
begin
  //AShowWindowStyle:=(SW_HIDE,SW_SHOW,...)
  //AppParamStr:向App传入的参数:ParamStr(0)不能调用,系统默认APP根目录
    //:ParamStr(1)...ParamStr(N),可由分隔符代码调用
{$IFDEF MSWINDOWS}
  if AppParamStr.Trim='' then exit;
  try
    LHandle:=0;
    LNativeUInt:=
    ShellExecute(
      0
      ,'open' //:nil:不能否则虽不影响执行但会报错
      ,'IExplore.EXE'
      ,PWideChar(WideString(AppParamStr))//:URL指令参数
      ,nil  //:App默认目录
      ,SW_SHOW //:App显示方式
      );
  except
    //
  end;
  Result:=LNativeUInt;
{$ENDIF MSWINDOWS}
end;

procedure KillApp(const AppName:string);
//Win32强行杀死一个外部应用:
begin
  if AppName.Trim='' then exit;
    WinExec( PAnsiChar(AnsiString('cmd.exe /c taskkill /f /t /im '+AppName))
      ,sw_hide);  //AppName:比如:ProAPIRegistryWin32.exe
end;

procedure KillProcess(ExeName: string);
const
  PROCESS_TERMINATE = $0001; //进程的PROCESS_TERMINATE访问权限
var
  ContinueLoop: Boolean;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  //获取系统所有进程快照
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  //调用Process32First前用Sizeof(FProcessEntry32)填充FProcessEntry32.dwSize
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  //获取快照中第一个进程信息并保存到FProcessEntry32结构体中
  ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);
  while integer(ContinueLoop) <> 0 do //循环枚举快照中所有进程信息
  begin
    //找到要中止的进程名
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeName))
      or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeName))) then
       TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0),FProcessEntry32.th32ProcessID), 0);     //中止进程
    ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32); //查找下一个符合条件进程
  end;
end;

function AppRunning(var AppName:string):Boolean;
var
  ContinueLoop: Boolean;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
  LFindmeCount:Integer;
begin
  LFindmeCount:=0;
  //获取系统所有进程快照
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  //调用Process32First前用Sizeof(FProcessEntry32)填充FProcessEntry32.dwSize
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  //获取快照中第一个进程信息并保存到FProcessEntry32结构体中
  ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);
  while integer(ContinueLoop) <> 0 do //循环枚举快照中所有进程信息
  begin
    //找到要中止的进程名
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(AppName))
      or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(AppName))) then
       LFindmeCount:=LFindmeCount+1;
    ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32); //查找下一个符合条件进程
  end;
  if LFindmeCount=0 then
  begin
    Result:=False;
  end else
  begin //App已在运行:
    Result:=true;
  end;
end;

end.

3.3、Windows 64-bit、Windows 32-bit编译平台兼容调用第三方App

{Windows 64-bit、Windows 32-bit编译平台兼容调用第三方App:}
{:让操作系统:更改UAC用户账户控制设置}
unit APIRegistryWin32;
interface

uses
  Winapi.Windows,
  Winapi.ShellAPI, Winapi.Messages,
  System.SysUtils, System.Variants,
  System.Classes,  System.IOUtils,
  Vcl.Graphics,Vcl.Controls,
  Vcl.Forms, Vcl.Dialogs

  ,RegistryWin32, Vcl.StdCtrls
  ,myFuc_UnifiedPlatForm    // :我的通用库
  ;

type
  TfrmRegistryWin32 = class(TForm)
    edtParamStr: TEdit;
    edtResultStr: TEdit;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmRegistryWin32: TfrmRegistryWin32;

implementation

{$R *.dfm}

procedure TfrmRegistryWin32.FormCreate(Sender: TObject);
var LAppKeyValue:string;
    LStrList:TStringList;
    LNativeUInt:NativeUInt;
begin
  edtParamStr.Text:=System.ParamStr(1);
    //:本工程被调用程序传入的参数
  LStrList:=TStringList.Create;
  try
    try
      SetRegStr('HKEY_LOCAL_MACHINE','Software\Microsoft\Windows\CurrentVersion\Policies\System'
        ,'EnableLUA','0','整型'); //\Wow6432Node
        //:让操作系统:更改UAC用户账户控制设置
      if trim(edtParamStr.Text)='WeChat' then
        readRegistry( HKEY_LOCAL_MACHINE
          ,trim(edtParamStr.Text),'DisplayIcon',LAppKeyValue);

      if trim(edtParamStr.Text)='QQ2009' then
      begin //:未用:QQ用浏览器打开的方式:
        try
          readRegistry( HKEY_LOCAL_MACHINE
            ,trim(edtParamStr.Text),'Install',LAppKeyValue);
        finally
          LAppKeyValue:=LAppKeyValue +'\bin\QQ.exe';
        end;
      end;

      if trim(edtParamStr.Text)='TIM' then
      begin //:未用:TIM用浏览器打开的方式:
        try
          readRegistry( HKEY_LOCAL_MACHINE
            ,trim(edtParamStr.Text),'Install',LAppKeyValue);
        finally
          LAppKeyValue:=LAppKeyValue +'\bin\TIM.exe';
        end;
      end;
      //:edtParamStr.Text根据传入参数读取注册表,打开第3方应用
      //edtParamStr.Text:'WeChat'
      //:HKEY_LOCAL_MACHINE;//Winapi.Windows
        //:等价于:NativeUInt($80000002) //System
      //:HKEY_CURRENT_USER = HKEY(NativeUInt($80000001));
    finally
      try
        LNativeUInt:=ExeApp(LAppKeyValue,'',SW_HIDE);
      finally
        if LNativeUInt.ToString.Trim<>'' then //:调用完毕
        begin
          edtResultStr.Text:=LAppKeyValue+'调用完毕'+ LNativeUInt.ToString;
          LAppKeyValue:=trim(edtResultStr.Text);
        end;
      end;
      //WinExec(PAnsiChar(AnsiString(LAppKeyValue)), SW_SHOW);
    //  ShellExecute(1,'open',PWideChar(WideString(LAppKeyValue)),nil,nil,SW_SHOW);
      //WinExec(PAnsiChar(AnsiString(LAppKeyValue)), SW_SHOW);
      //:所有的原生字符串类型String转PAnsiChar都需要经过AnsiString过渡
    end;

  finally
    FreeAndNil(LStrList);
  end;
end;

end.