protected
procedure Notification(Component: TComponent;Operation: TOperation); override;
procedure Paint; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Repaint;
property BoundsRect: TRect read GetBoundsRect;
published
property Color: TColor read FColor write FColor default clBtnFace;
property Glyph: TBitmap read FGlyph write SetGlyph;
property PopupMenu: TPopupMenu read FPopup write FPopup;
property RightMargin: Cardinal read FRightMargin write SetRightMargin default 66;
property Visible: Boolean read FVisible write SetVisible default False;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents(Liao, [TTitleBarButton]);
end;
{ TTitleBarButton }
constructor TTitleBarButton.Create(AOwner: TComponent);
var
ptr: Pointer;
begin
inherited;
FForm := GetParentForm(TControl(AOwner));
FGlyph := TBitmap.Create;
FColor := clBtnFace;
FVisible := False;
FRightMargin := 66;
FButtonDown := False;
FOldWndProc := Pointer(GetWindowLong(FForm.Handle,GWL_WNDPROC));
ptr := MakeObjectInstance(NewWndProc);
SetWindowLong(FForm.Handle, GWL_WNDPROC, Longint(ptr));
end;
destructor TTitleBarButton.Destroy;
begin
if not (csDestroying in FForm.ComponentState) then
begin
SetVisible(false);
SetWindowLong(FForm.Handle, GWL_WNDPROC, LongInt(FOldWndProc));
end;
FGlyph.Free;
inherited;
end;
procedure TTitleBarButton.NewWndProc(var message: TMessage);
function HitButton(APoint: TPoint): Boolean;
begin
APoint.x := APoint.x - FForm.Left;
APoint.y := APoint.y - FForm.Top;
Result := PtInRect(BoundsRect,APoint);
end;
var
p: TPoint;
begin
with message do
begin
if Visible then
begin
case Msg of
WM_NCPAINT , WM_NCACTIVATE :
begin
Result := CallWindowProc(FOldWndProc,FForm.Handle,Msg,WParam,LParam);
RePaint;
end;
WM_NCHITTEST :
begin
Result := CallWindowProc(FOldWndProc,FForm.Handle,Msg,WParam,LParam);
if Result = HTCAPTION then
begin
RePaint;
p.x := LoWord(LParam);
ScreenToClient(FForm.Handle,p);
with BoundsRect do //减去框架宽度
if (p.x >= Left-4) and (p.x <= Right-4) then Result := 888;
