delphi 怎样实现弹出对话框后，不点确定程序继续执行后面的代码

2017-05-16 09:41:03 768 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

在 Delphi 下自定义通用对话框------自定义打开文件对话框在 Delphi 下自定义通用对话框--------------自定义打开文件对话框几次碰到有人在论坛里问如何在 Delphi 下自定义通用对话框，本人对此问题也比较感兴趣，所以抽点时间搞了下，现在把“成果”与大家分享。本文的题目大了点，通用对话框有好多，但这里只以打开文件对话框为例。其实自定义所有通用对话框的原理是一样的。第一步：建立对话框模版先来说个概念：对话框模版。对阅读详情

我想实现的功能如题，我用了showmessage()和Application.messagebox()，好像都不行，我也不方便再建一个Form,请教高手有其他方法吗？

...全文

Delphi弹出式菜单设计.5 5.1弹出菜单弹出菜单又称为快捷菜单，是在某个组件上右击时弹出的菜单。快捷菜单中提供了与该组件相关的命令，如下图所示。与主菜单相比，弹出菜单具有更高的灵活性，它不但可以用于窗体本身，还可以用于窗体中的各种组件。 1.创建弹出菜单在De 阅读详情

zhanghj5258

语言基础/算法/系统设计 16,741 成员 33,233 内容

+ 关注 + 加入社区

切换为时间正序

hongss 2017-05-17

打赏
举报

lyhoo163 2017-05-17

打赏
举报

{******************************************************
{                                                                                                 
{       一种自动关闭对话框的简单方法                                                       
{                                                                                                  
{   使用方法：打开对话框前调用 SetDlgAutoClose                                      
{             参数1： 设定多长时间后关闭                                                   
{             参数2： 是否在对话框标题栏进行倒计时提示                                 
{             取消自动关闭调用 ResetDlgAutoClose                                       
{                                                                                                   
{       任何转载请保留此文件的完整，如果进行修改请                                     
{   通知作者，谢谢合作。                                                                      
{                                                                                                   
{   作者: lichaohui  2004-03-03                                                            
{   Email: mastercn@163.com                                                                                           
{                                                                                                           
{*******************************************************

unit TimerDlg;

interface

uses
  Windows, Messages, SysUtils, Classes, Forms, ExtCtrls;


// 如果指定的时间没有操作对话框,则自动关闭
procedure ResetDlgAutoClose;
procedure SetDlgAutoClose(nTime: Integer; ADoHint: Boolean = False);
  
implementation


{** 如果对话框被打开,则在指定时间后关闭,并在标题栏进行提示 }
var
  nWndCount: Integer = 0;
  SavWnds, SavWnds2: array of THandle;
  hDlgWnd: THandle = 0;
  hTimerk: Integer = 0;
  nTimerTick: Integer = 0;
  nLastTrk: Integer = 0;
  nDoHint: Integer = 0;
  nCapCt: Integer = 0;
  nSavCapt: String = '';
  fTimer1: TTimer = nil;

function MyEnumProc(hWnd: THandle; lParam: Integer): Boolean; stdcall;
var
  n: Integer;
begin
  Result := True;
  if lParam = 0 then
  begin
    if not IsWindowEnabled(hWnd) then Exit;
    if not IsWindowVisible(hWnd) then Exit;
  end;
  n := (nWndCount + 10) div 10 * 10;
  SetLength(SavWnds, n);
  SavWnds[nWndCount] := hWnd;
  Inc(nWndCount);
end;

procedure MyTimerProc(hWnd: THandle; uMsg: Integer;
  idEvent: Integer; dwTime: Integer);
var
  i, t: Integer;
  function FindInArray(ar: array of THandle; hd: THandle): Boolean;
  var
    t: Integer;
  begin
    Result := False;
    for t := Low(ar) to High(ar) do
    begin
      Result := ar[t] = hd;
      if Result then Break;
    end;
  end;
begin
  if (hDlgWnd = 0) and (SavWnds = nil) and (SavWnds2 <> nil) then
  begin
    nWndCount := 0;
    EnumThreadWindows(GetCurrentThreadId, @MyEnumProc, 0);
    SetLength(SavWnds, nWndCount);
    for i := Low(SavWnds) to High(SavWnds) do
    begin
      if not FindInArray(SavWnds2, SavWnds[i]) then
      begin
        if SavWnds[i] = GetActiveWindow then
        begin
          hDlgWnd := SavWnds[i];
        end;
      end;
    end;
    if hDlgWnd = 0 then ResetDlgAutoClose;
    nLastTrk := GetTickCount;
    SetLength(nSavCapt, 500);
    t := GetWindowText(hDlgWnd, PChar(nSavCapt), 500);
    SetLength(nSavCapt, t);
    nCapCt := 0;
  end
  else
  if (hDlgWnd <> 0) then
  begin
    if not IsWindow(hDlgWnd) or
      not IsWindowVisible(hDlgWnd) or
      not IsWindowEnabled(hDlgWnd) then
    begin
      ResetDlgAutoClose;
      Exit;
    end;
    t := GetTickCount;
    t := (nTimerTick - (t - nLastTrk) - 1);
    if t <= 0 then
    begin
      // try to use SendMessge instead using PostMessage
      PostMessage(hDlgWnd, WM_SYSCOMMAND,SC_CLOSE, 0);
//      SendMessage(hDlgWnd, WM_SYSCOMMAND,SC_CLOSE, 0);
    (* 2 lines added by jiatao
      SetForegroundWindow(hDlgWnd);
      PostMessage(hDlgWnd, WM_KEYDOWN,VK_RETURN,0);
    *)
      SetForegroundWindow(hDlgWnd);
      PostMessage(hDlgWnd, WM_KEYDOWN,VK_RETURN,0);

      ResetDlgAutoClose;
    end
    else
    if (nDoHint > 0) then
    begin
      t := (t + 1000) div 1000;
      if nCapCt <> t then
      begin
        SetWindowText(hDlgWnd,
          PChar(Format('(%d)%2s%s', [t, ' ', nSavCapt])));
        nCapCt := t;
      end;
    end;
  end;
end;

procedure TimerFunc(Sender: TObject);
begin
  MyTimerProc(0, 0, 0, 0);
end;

procedure SetDlgAutoClose(nTime: Integer; ADoHint: Boolean = False);
var
  FakeEvt: TNotifyEvent;
  Ptrs: array[1..2] of Pointer absolute FakeEvt;
begin
  ResetDlgAutoClose;
  nWndCount := 0;
  EnumThreadWindows(GetCurrentThreadId, @MyEnumProc, 1);
  SetLength(SavWnds, nWndCount);
  SavWnds2 := SavWnds;
  SavWnds := nil;
  if not Assigned(fTimer1) then
  begin
    fTimer1 := TTimer.Create(Application);
    Ptrs[2] := nil;
    Ptrs[1] := @TimerFunc;
    fTimer1.OnTimer := FakeEvt;
    fTimer1.Interval := 100;
    fTimer1.Enabled := True;
  end;
  nLastTrk := GetTickCount;
  nDoHint := Ord(ADoHint);
  nTimerTick := nTime;
end;

procedure ResetDlgAutoClose;
begin
  if hDlgWnd <> 0 then
  begin
    SetWindowText(hDlgWnd, PChar(nSavCapt));
  end;
  if Assigned(fTimer1) then
    FreeAndNil(fTimer1);
  nWndCount := 0;
  hDlgWnd := 0;
  SavWnds := nil;
  SavWnds2 := nil;
  nTimerTick := 0;
end;

end.

lyhoo163 2017-05-17

打赏
举报

那你在Form中，加一个Panel，就可以了，定时5秒，退出。或鼠标点击退出。

linghengmao 2017-05-17

打赏
举报

form.show; form.update; Application.ProcessMessages;

hongss 2017-05-17

打赏
举报

如果只是提示的话，可以用Panel的visible属性实现，用户点击的时候visible为false

zhanghj5258 2017-05-17

打赏
举报

引用 1 楼 lyhoo163 的回复:

{******************************************************
{                                                                                                 
{       一种自动关闭对话框的简单方法                                                       
{                                                                                                  
{   使用方法：打开对话框前调用 SetDlgAutoClose                                      
{             参数1： 设定多长时间后关闭                                                   
{             参数2： 是否在对话框标题栏进行倒计时提示                                 
{             取消自动关闭调用 ResetDlgAutoClose                                       
{                                                                                                   
{       任何转载请保留此文件的完整，如果进行修改请                                     
{   通知作者，谢谢合作。                                                                      
{                                                                                                   
{   作者: lichaohui  2004-03-03                                                            
{   Email: mastercn@163.com                                                                                           
{                                                                                                           
{*******************************************************

unit TimerDlg;

interface

uses
  Windows, Messages, SysUtils, Classes, Forms, ExtCtrls;


// 如果指定的时间没有操作对话框,则自动关闭
procedure ResetDlgAutoClose;
procedure SetDlgAutoClose(nTime: Integer; ADoHint: Boolean = False);
  
implementation


{** 如果对话框被打开,则在指定时间后关闭,并在标题栏进行提示 }
var
  nWndCount: Integer = 0;
  SavWnds, SavWnds2: array of THandle;
  hDlgWnd: THandle = 0;
  hTimerk: Integer = 0;
  nTimerTick: Integer = 0;
  nLastTrk: Integer = 0;
  nDoHint: Integer = 0;
  nCapCt: Integer = 0;
  nSavCapt: String = '';
  fTimer1: TTimer = nil;

function MyEnumProc(hWnd: THandle; lParam: Integer): Boolean; stdcall;
var
  n: Integer;
begin
  Result := True;
  if lParam = 0 then
  begin
    if not IsWindowEnabled(hWnd) then Exit;
    if not IsWindowVisible(hWnd) then Exit;
  end;
  n := (nWndCount + 10) div 10 * 10;
  SetLength(SavWnds, n);
  SavWnds[nWndCount] := hWnd;
  Inc(nWndCount);
end;

procedure MyTimerProc(hWnd: THandle; uMsg: Integer;
  idEvent: Integer; dwTime: Integer);
var
  i, t: Integer;
  function FindInArray(ar: array of THandle; hd: THandle): Boolean;
  var
    t: Integer;
  begin
    Result := False;
    for t := Low(ar) to High(ar) do
    begin
      Result := ar[t] = hd;
      if Result then Break;
    end;
  end;
begin
  if (hDlgWnd = 0) and (SavWnds = nil) and (SavWnds2 <> nil) then
  begin
    nWndCount := 0;
    EnumThreadWindows(GetCurrentThreadId, @MyEnumProc, 0);
    SetLength(SavWnds, nWndCount);
    for i := Low(SavWnds) to High(SavWnds) do
    begin
      if not FindInArray(SavWnds2, SavWnds[i]) then
      begin
        if SavWnds[i] = GetActiveWindow then
        begin
          hDlgWnd := SavWnds[i];
        end;
      end;
    end;
    if hDlgWnd = 0 then ResetDlgAutoClose;
    nLastTrk := GetTickCount;
    SetLength(nSavCapt, 500);
    t := GetWindowText(hDlgWnd, PChar(nSavCapt), 500);
    SetLength(nSavCapt, t);
    nCapCt := 0;
  end
  else
  if (hDlgWnd <> 0) then
  begin
    if not IsWindow(hDlgWnd) or
      not IsWindowVisible(hDlgWnd) or
      not IsWindowEnabled(hDlgWnd) then
    begin
      ResetDlgAutoClose;
      Exit;
    end;
    t := GetTickCount;
    t := (nTimerTick - (t - nLastTrk) - 1);
    if t <= 0 then
    begin
      // try to use SendMessge instead using PostMessage
      PostMessage(hDlgWnd, WM_SYSCOMMAND,SC_CLOSE, 0);
//      SendMessage(hDlgWnd, WM_SYSCOMMAND,SC_CLOSE, 0);
    (* 2 lines added by jiatao
      SetForegroundWindow(hDlgWnd);
      PostMessage(hDlgWnd, WM_KEYDOWN,VK_RETURN,0);
    *)
      SetForegroundWindow(hDlgWnd);
      PostMessage(hDlgWnd, WM_KEYDOWN,VK_RETURN,0);

      ResetDlgAutoClose;
    end
    else
    if (nDoHint > 0) then
    begin
      t := (t + 1000) div 1000;
      if nCapCt <> t then
      begin
        SetWindowText(hDlgWnd,
          PChar(Format('(%d)%2s%s', [t, ' ', nSavCapt])));
        nCapCt := t;
      end;
    end;
  end;
end;

procedure TimerFunc(Sender: TObject);
begin
  MyTimerProc(0, 0, 0, 0);
end;

procedure SetDlgAutoClose(nTime: Integer; ADoHint: Boolean = False);
var
  FakeEvt: TNotifyEvent;
  Ptrs: array[1..2] of Pointer absolute FakeEvt;
begin
  ResetDlgAutoClose;
  nWndCount := 0;
  EnumThreadWindows(GetCurrentThreadId, @MyEnumProc, 1);
  SetLength(SavWnds, nWndCount);
  SavWnds2 := SavWnds;
  SavWnds := nil;
  if not Assigned(fTimer1) then
  begin
    fTimer1 := TTimer.Create(Application);
    Ptrs[2] := nil;
    Ptrs[1] := @TimerFunc;
    fTimer1.OnTimer := FakeEvt;
    fTimer1.Interval := 100;
    fTimer1.Enabled := True;
  end;
  nLastTrk := GetTickCount;
  nDoHint := Ord(ADoHint);
  nTimerTick := nTime;
end;

procedure ResetDlgAutoClose;
begin
  if hDlgWnd <> 0 then
  begin
    SetWindowText(hDlgWnd, PChar(nSavCapt));
  end;
  if Assigned(fTimer1) then
    FreeAndNil(fTimer1);
  nWndCount := 0;
  hDlgWnd := 0;
  SavWnds := nil;
  SavWnds2 := nil;
  nTimerTick := 0;
end;

end.

大哥，我是想弹出对话框后，不影响程序的继续运行，程序会继续执行后面的代码，对话框是给用户的提示，是让用户自己点确定的，用户不点确定就一直在那

delphi 怎样实现弹出对话框后，不点确定程序继续执行后面的代码

相关推荐