TApplicationEvents控件的使用方法

Manchao丶

已于 2024-08-08 20:49:10 修改

阅读量162

点赞数 1

分类专栏： Delphi 文章标签：笔记

于 2024-07-31 17:03:39 首次发布

本文链接：https://blog.csdn.net/LiuManchao/article/details/140827427

版权

Delphi 专栏收录该内容

25 篇文章 1 订阅

订阅专栏

Combobox拦截滚轮事件和响应滚动事件

OnMessage方法：Application中的OnMessage方法可以处理属于Application的除WM_QUIT以外的所有消息。但该方法用于处理个别方法时，效率会很低，因为需要对WINDOWS中的众多的消息中筛选其中之一。

在滚动鼠标滚轮时，原意是想让整个页面向下Scroll，但是此时恰巧页面焦点聚焦在Combobox的文本框内，滚动滚轮却是把Combobox内的内容给改变了。正常情况下这个也不影响什么，有时也方便操作，但是在此时的情况下无疑是不合适的，因为用户可能在不知情的情况下会把Combobox内的内容给改变，这无疑是不能发生的，所以，我就自己写段代码，来阻止这种事情发生。

RzCombobox有滚轮事件，但是Delphi自带的Combobox还有Dev Express的cxCombobox没有此事件，那么我们就可以自己写代码来拦截滚轮事件，以下是代码：

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
type
  TForm1 = class(TForm)
    Panel1: TPanel;
    ComboBox1: TComboBox;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    Procedure OnMouseWheel(Var Msg: TMsg; var Handled: Boolean);
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := OnMouseWheel;
end;
procedure TForm1.OnMouseWheel(var Msg: TMsg; var Handled: Boolean);
begin
  if Msg.message = WM_MOUSEWHEEL then //多个过程都接收这一消息时会产生冲突，只会其中一个有效
  begin
    //ShowMessage(ActiveControl.ClassName);
    if ActiveControl IS TComboBox then //Delphi自带Combobox
    //if ActiveControl.ClassName = 'TcxCustomComboBoxInnerEdit' then //CxCombobox
    //if ActiveControl is TcxCustomComboBoxInnerEdit then //表格不响应滚轮
    //if ActiveControl is TStringGrid then //ActiveControl：指定以窗体为焦点的控件；不响应滚轮
    begin
      Handled := True;
    end;
  end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Application.OnMessage := nil;
end;
end.

响应滚动事件，添加控件ApplicationEvents1: TApplicationEvents;

procedure TFrm2.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
var
  sColumnCaption: string;
begin
  inherited;
   //窗体的滚动条响应鼠标滚轮
  if g_sEmbryoAutoDropDown = '2' then
  begin
    if Msg.message = WM_MOUSEWHEEL then
    begin
      if self.Visible then
      begin
        sColumnCaption := cxGrid1DBBandedTableView1.Controller.FocusedColumn.DataBinding.DefaultCaption;
        if Msg.wParam > 0 then
        begin
          cxGrid1DBBandedTableView1.DataController.DataSource.DataSet.MoveBy(-1);
          cxGrid1DBBandedTableView1.GetColumnByFieldName(sColumnCaption).Focused := True;
        end
        else
        begin
          cxGrid1DBBandedTableView1.DataController.DataSource.DataSet.MoveBy(1);
          cxGrid1DBBandedTableView1.GetColumnByFieldName(sColumnCaption).Focused := True;
        end;
        Handled := True;
      end
      else
        Handled := false;
    end;
  end;
end;

以下是OnMessage事件,用来阻止WebBrowser的右键菜单:

procedure TfrmSearch.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin
  //如果是Webbrowser，则不许使用右键菜单
  if IsChild(WebBrowser1.Handle,Msg.Hwnd) and ((Msg.Message = WM_RBUTTONDOWN) or (Msg.Message=WM_RBUTTONUP)) then
  begin
    Handled:=True;
  end;
end;

dbgrid中假如记录很多，使用鼠标滚动条滚动的时候，只会在dbgrid当前页面数据内滚动，而滚动条是不会动的，这样操作很不方便，需要再拖动滚动条去滚动数据。加了TApplicationEvents就可以去判断事件触发对应的方法。

代码：新建应用程序工程，直接在界面上放个dbgrid，高度不要太高，写form的oncreate事件和TApplicationEvents的onmessage事件。不放和放TApplicationEvents

nit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs,DBClient,DB, Grids, DBGrids, AppEvnts;

type

TForm1 = class(TForm)

DBGrid1: TDBGrid;

ApplicationEvents1: TApplicationEvents;

procedure FormCreate(Sender: TObject);

procedure ApplicationEvents1Message(var Msg: tagMSG;

var Handled: Boolean);

private

{ Private declarations }

cdstemp:TClientDataSet;

ds:TDataSource;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

var

i:Integer;

begin

//创建对象

cdstemp:=TClientDataSet.Create(Application);

ds:=TDataSource.Create(Application);

//创建dataset列

with cdstemp do

begin

Active:=False;

FieldDefs.Clear;

FieldDefs.Add('id',ftString,32);

CreateDataSet;

Active:=True;

end;

//生成测试数据

for i:=0 to 20 do

begin

cdstemp.Append;

cdstemp.FieldByName('id').AsInteger:=i;

cdstemp.Post;

end;

//绑定

ds.DataSet:=cdstemp;

DBGrid1.DataSource:=ds;

end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;

var Handled: Boolean);

begin

//先判断焦点在不在DBGrid上

if DBGrid1.Focused then

begin

//判断是不是鼠标滚轮事件

if Msg.message  =  WM_MOUSEWHEEL then

begin

if  Msg.wParam  >  0  then

//滚动条往上滚

SendMessage(DBGrid1.Handle,  WM_KEYDOWN,  VK_UP,  0)

else

//滚动条往下滚

SendMessage(DBGrid1.Handle,  WM_KEYDOWN,  VK_DOWN,  0);

Handled  :=  True;

end;

end;

end;

end.