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 掌控PageControl中的右上方的左右箭头事件

相关推荐

评论
