Delphi 掌控PageControl中的右上方的左右箭头事件

本文整理自网络，侵删。

 
unit Unit1;

interface

uses
  Windows, Messages, Classes, ComCtrls;

type
  TLRClickingEvent = procedure(Sender: TObject; var AllowClick: Boolean) of Object;

  TLRPageControl = class(TPageControl)
  private
    IsLeftBtn: Boolean;
    FOnLeftClick, FOnRightClick: TNotifyEvent;
    FOnLRClicking: TLRClickingEvent;
    procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
    procedure DoLeftClick;
    procedure DoRightClick;
    procedure DoLRClicking(var AllowClick: Boolean);
  published
    property OnLeftClick: TNotifyEvent read FOnLeftClick write FOnLeftClick;
    property OnLRClicking: TLRClickingEvent read FOnLRClicking write FOnLRClicking;
    property OnRightClick: TNotifyEvent read FOnRightClick write FOnRightClick;
  end;

implementation

uses
  CommCtrl;

{ TLRPageControl }

procedure TLRPageControl.DoLeftClick;
begin
  if Assigned(FOnLeftClick) then FOnLeftClick(Self);
end;

procedure TLRPageControl.DoLRClicking(var AllowClick: Boolean);
begin
  if Assigned(FOnLRClicking) then FOnLRClicking(Self, AllowClick);
end;

procedure TLRPageControl.DoRightClick;
begin
  if Assigned(FOnRightClick) then FOnRightClick(Self);
end;

procedure TLRPageControl.WMHScroll(var Message: TWMHScroll);
begin
  inherited;
  if Message.ScrollCode = SB_THUMBPOSITION then
    if IsLeftBtn then DoLeftClick
    else DoRightClick;
end;

procedure TLRPageControl.WMNotify(var Message: TWMNotify);
var
  AllowClick: Boolean;
begin
  inherited;
  with Message do
    if NMHdr^.code = UDN_DELTAPOS then
    begin
      IsLeftBtn := PNMUpDown(NMHdr).iDelta < 0;
      AllowClick := not LongBool(Result);
      DoLRClicking(AllowClick);
      LongBool(Result) := not AllowClick;
    end;
end;

end.

来源：https://blog.csdn.net/gencheng/article/details/1606403
 
 

相关阅读 >>

Delphi memo1删除前n行

Delphi创建密钥文件

Delphi 保存图片到数据库

Delphi idhttpserver使用注意问题

winapi 字符及字符串函数(5): ischaralpha - 是否是个字母

Delphi 写log的代码(按日期)

Delphi concat 字符串函数

Delphi idftp连不上ftp服务器的解决方法

Delphi 2009 之 tstringbuilder 类[1]: create

Delphi try except语句 和 try finally语句用法以及区别

更多相关阅读请进入《Delphi》频道 >>

转载请注明出处：木庄网络博客 » Delphi 掌控PageControl中的右上方的左右箭头事件