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.

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

推荐分享