？？？？怎么搞定？？？？我在窗体外单击一下，窗体仍然具有焦点?

Refactoring 2002-11-11 06:29:26

还请指教???

...全文

31 25 打赏收藏转发到动态举报

写回复

用AI写文章

25 条回复

切换为时间正序

请发表友善的回复…

发表回复

langer1 2002-11-13

打赏
举报

//-----------------------------------------------------------
可以的，以下得到文件名与图标
procedure WMDropFiles(var message:TMessage);message WM_DropFiles; //拖放文件

procedure TfrmMain.WMDropFiles(var message:tmessage); //拖放文件

var
p:array[0..254] of char;
i ,ii ,I_FileCount:word;
I_Image : Integer;
ObjIco : TIcon;
NewFName: String;
begin
inherited;
FormState(1);

if SideBar.ActiveGroup.Caption ='系统菜单组' then begin
//如果当前图像列表为菜单列表，则退出警告
Application.MessageBox('不能在系统菜单栏里增加程序链接!','链接出错',Mb_IconInFormation);
Exit;
End;
ii :=SideBar.ActiveGroup.Index ;

{$IFDEF WIN32}
I:=dragqueryfile(message.wparam,$ffffffff,nil,0);
{$ELSE}
I:=dragqueryfile(message.wparam,$ffff,nil,0);
{$ENDIF}

I_FileCount:= i-1;
for i:=0 to I_FileCount do //可能拖动的是一组文件
begin
dragqueryfile(message.wparam,i,p,255); //strpas(p)为路径名
//if UserRegFile.IndexOf(StrPas(p))<0 then begin
UserRegFile.Add(SideBar.Groups.Items[ii].Caption +signStr + StrPas(p));
//如果开始不存在，则新增图像列表现不管了，想加就加
SideBar.Groups.Items[ii].Items.Add;
NewFName:= StrPas(p);

NewFName :=DirGetFName(NewFName); //读出文件名

SideBar.Groups.Items[ii].Items[SideBar.Groups.Items[ii].ItemCount-1].Caption := NewFName;
//-----------------------加载图片<<------------------------//
ObjIco := TIcon.Create;
ObjIco.Handle:=GetFileIcon(StrPas(p),False);
if ObjIco =nil then exit;
I_Image := BarIco.AddIcon(ObjIco);
SideBar.Groups.Items[ii].Items[SideBar.Groups.Items[ii].ItemCount-1].LargeImage := I_Image;
ObjIco.Free;
//----------------------->>加载图片------------------------//
SideBar.Groups.Items[ii].Items[SideBar.Groups.Items[ii].ItemCount-1].Tag :=TagBase+UserRegFile.Count-1;

//end;

end;
end;
//－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－//
以下为一API函数，运行程序
WinExec可以运行另一Exe文件
以下函数可以运行另一有路径的东东
ShellExecute(0 ,'Open',Pchar(FileName),nil,nil,Sw_Show);
QQ:5176905

NND,给你留言，说留言太长，累!!

zhangchao_7622 2002-11-13

打赏
举报

高人，如何改为C++呢？？？

Kingron 2002-11-12

打赏
举报

提问提拔要求说清楚：
>>是要你的程序永远有焦点是吗?

如果是这样，可以做到：
设置Application.OnDeActive事件即可！代码如下：
procedure ForceForegroundWindow(hwnd: THandle);
var
hlp: TForm;
begin
hlp := TForm.Create(nil);
try
hlp.BorderStyle := bsNone;
hlp.SetBounds(0, 0, 1, 1);
hlp.FormStyle := fsStayOnTop;
hlp.Show;
mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
SetForegroundWindow(hwnd);
finally
hlp.Free;
end;
end;

然后在Application.OnDeActive中添加代码：
ForceForegroundWindow(Handle)
Test Ok for WinXP。

理想 2002-11-12

打赏
举报

在“Hook Functions”里有个“MouseProc”，用它来试一下，就像屏蔽键盘一样，可以屏蔽鼠标事件。

LRESULT CALLBACK MouseProc(
int nCode, // hook code
WPARAM wParam, // message identifier
LPARAM lParam // mouse coordinates
);

hnxrm 2002-11-12

打赏
举报

搞不懂,这有什么用?是要你的程序永远有焦点是吗?

langer1 2002-11-12

打赏
举报

procedure TForm1.FormCreate(Sender: TObject);
begin
Dragacceptfiles(form1.handle,true);
end;

这是支持文件拖放的程序设置的东东，效果和你的差不多吧，你试试

dext 2002-11-12

打赏
举报

首先，你要的结果是在窗口丢失焦点后，然后再获得焦点。
其次，OnDeactive事件时发生在丢失焦点以前。
解决的方法有两个:
1.限制鼠标不要出你的窗体
2.修改VCL

Kingron 2002-11-12

打赏
举报

我测试是可以的，不过屏幕总是要闪烁一下，你还是用Mouse Hook吧，虽然复杂，但丝好用。

Kingron 2002-11-12

打赏
举报

>>我用的也是XP,但好像KingRom的代码并不能实现。
看看下面的可不可以？
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, AppEvnts, StdCtrls;

type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
AppEvent: TApplicationEvents;
procedure AppEventDeactivate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure ForceForegroundWindow(hwnd: THandle);
var
hlp: TForm;
begin
hlp := TForm.Create(nil);
try
hlp.BorderStyle := bsNone;
hlp.SetBounds(0, 0, 1, 1);
hlp.FormStyle := fsStayOnTop;
hlp.Show;
mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
SetForegroundWindow(hwnd);
finally
hlp.Free;
end;
end;

procedure TForm1.AppEventDeactivate(Sender: TObject);
begin
ForceForegroundWindow(Screen.Forms[0].Handle);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage('TEST');
end;

end.

object Form1: TForm1
Left = 192
Top = 114
Width = 696
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Memo1: TMemo
Left = 15
Top = 10
Width = 501
Height = 286
Lines.Strings = (
'Memo1')
TabOrder = 0
end
object Button1: TButton
Left = 95
Top = 340
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 1
OnClick = Button1Click
end
object AppEvent: TApplicationEvents
OnDeactivate = AppEventDeactivate
Left = 530
Top = 60
end
end

Refactoring 2002-11-12