Delphi 1

Пример компонента "HotSpot"

Вот пример HotSpot-компонента, основанного на TPanel (небольшая переделка). Управляя событиями MouseDown и MouseUp можно получить эффект резинового контура.

unit Newpanel;

interface
Uses WinTypes, Classes, Controls, StdCtrls, ExtCtrls;

Type

tHotSpotClickEvent = Procedure ( Sender : tObject;

Button : tMouseButton;

Shift : tShiftState ) Of Object;

TNewPanel = Class ( tPanel )

Private

fHotSpotClick : tHotSpotClickEvent;

fHotSpot : tRect;

fInHotSpot : Boolean;

Function GetHotSpotTop : Word;

Function GetHotSpotLeft : Word;

Function GetHotSpotWidth : Word;

Function GetHotSpotHeight : Word;

Procedure SetHotSpotTop ( Value : Word );

Procedure SetHotSpotLeft ( Value : Word );

Procedure SetHotSpotWidth ( Value : Word );

Procedure SetHotSpotHeight ( Value : Word );

Protected

Procedure Paint; override;

Procedure MouseDown ( Button : tMouseButton; Shift : tShiftState; X, Y : Integer ); override;

Procedure MouseUp ( Button : tMouseButton; Shift : tShiftState; X, Y : Integer ); override;

Public

Procedure Click; override;

Property HotSpot : tRect Read fHotSpot Write fHotSpot;

Published

Property hsTop : Word Read GetHotSpotTop Write SetHotSpotTop;

Property hsLeft : Word Read GetHotSpotLeft Write SetHotSpotLeft;

Property hsWidth : Word Read GetHotSpotWidth Write SetHotSpotWidth;

Property hsHeight : Word Read GetHotSpotHeight Write SetHotSpotHeight;

Property OnHotSpot : tHotSpotClickEvent Read fHotSpotClick Write fHotSpotClick;

End;

Procedure Register;

implementation
Uses WinProcs, Graphics;

Procedure Register;
Begin

RegisterComponents('Custom',[TNewPanel]);

End;

Procedure TNewPanel.MouseDown ( Button : tMouseButton;

Shift : tShiftState;

X, Y : Integer );

Begin

If PtInRect ( fHotSpot, Point ( X, Y ) ) And

Assigned ( fHotSpotClick ) Then

fInHotSpot := True;

Inherited MouseDown ( Button, Shift, X, Y );

End;

Procedure TNewPanel.MouseUp ( Button : tMouseButton;

Shift : tShiftState;

X, Y : Integer );

Begin

Inherited MouseUp ( Button, Shift, X, Y );

If fInHotSpot Then

Begin

If Assigned ( fHotSpotClick ) Then

fHotSpotClick ( Self, Button, Shift );

fInHotSpot := False;

End;

End;

Procedure TNewPanel.Click;
Begin

If Not fInHotSpot Then

Inherited Click;

End;

Procedure TNewPanel.Paint;
Var

OldStyle : tPenStyle;

Begin

Inherited Paint;

If csDesigning in ComponentState Then

Begin

OldStyle := Canvas.Pen.Style;

Canvas.Pen.Style := psDash;

Canvas.Rectangle ( HotSpot.Left, HotSpot.Top, HotSpot.Right, HotSpot.Bottom );

Canvas.Pen.Style := OldStyle;

End;

End;

Procedure TNewPanel.SetHotSpotTop ( Value : Word );
Begin

fHotSpot.Bottom := fHotSpot.Bottom + Value - fHotSpot.Top;

fHotSpot.Top := Value;

Paint;

End;

Procedure TNewPanel.SetHotSpotLeft ( Value : Word );
Begin

fHotSpot.Right := fHotSpot.Right + Value - fHotSpot.Left;

fHotSpot.Left := Value;

Paint;

End;

Procedure TNewPanel.SetHotSpotWidth ( Value : Word );
Begin

fHotSpot.Right := fHotSpot.Left + Value;

Paint;

End;

Procedure TNewPanel.SetHotSpotHeight ( Value : Word );
Begin

fHotSpot.Bottom := fHotSpot.Top + Value;

Paint;

End;

Function TNewPanel.GetHotSpotTop : Word;
Begin

Result := fHotSpot.Top

End;

Function TNewPanel.GetHotSpotLeft : Word;
Begin

Result := fHotSpot.Left;

End;

Function TNewPanel.GetHotSpotWidth : Word;
Begin

Result := fHotSpot.Right - fHotSpot.Left;

End;

Function TNewPanel.GetHotSpotHeight : Word;
Begin

Result := fHotSpot.Bottom - fHotSpot.Top;

End;

End.

Надеюсь, с моей помощью вы найдете правильное направление,
Robert Wittig [000547]