Developing.ru

Привет, монстры программирования.
Помогите найти ошибку в простейшей задачке.
Задача: При наведении мышкой на круг, он должен становиться полностью закрашенным, а при отведении курсора из круга он снова очищается.
На Form1 нанесена Panel1. На Panel1 нанесён Panel2 в виде квадрата. В Panel2 вписан круг (компонент Shape1).
Первоначальные параметры : Shape1.Brush.Style:=bsClear;
Shape1.Pen.Color:=clRed;
Далее я записываю прцедуру наведения мышки

procedure TForm1.Shp1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var bs:TBrushStyle;
r,cX,cY,MouseX,MouseY,d:real;
begin
MouseX:=X;
MouseY:=Y;

r:=Shp1.Width/2;// находим радиус круга
cX:=Panel1.Left+Panel2.Left+r;// находим координаты центра круга
cY:=Panel1.Top+Panel3.Top+r;
d:=sqr(abs(cX-MouseX))+sqr(abs(cY-MouseY));//находим квадрат расстояния от центра круга до любой произвольной точки ( полпжения курсора)
if d>sqr(r) then // если квадрат этого расстояния будет меньше квадрата радиуса, то курсор будет внутри круга
bs:=bsSolid
else
bs:=bsClear;

Shp2.Brush.Style:=bs;
Shp2.Brush.Color:=clRed ;
end;
Проблема заключается в том, что при отведении курсора мышки из круга он не очищается, т. е. не приводится в состояние Shape1.Brush.Style:=bsClear;
Может быть ошибка в формуле нахождения квадрата расстояния
И ещё может подскажите как сделать такой код с использованием функции
Я пытался сделать такую, но не с ней не работает :
function Polojenie (var d:real ):TBrushStyle;
var r,cX,cY,MouseX,MouseY:real;

begin
r:=Shp1.Width/2;
cX:=Panel1.Left+Panel2.Left+r;
cY:=Panel1.Top+Panel2.Top+r;

d:=sqr(Abs(cX-MouseX))+sqr(Abs(cY-MouseY));
if d<sqr(r) then
Polojenie:=bsSolid
else Polojenie:=bsClear;

end;

Проблема заключается в том, что при отведении курсора мышки из круга он не очищается,

Проблема заключается в том, что после выхода курсора из шейпа он перестает получать событие wm_mosemove и его обратотчик Shp1MouseMove не вызывается. Т.е. шейп не знает ничего о том, что мышь его покинула.

Для этих целей надо использовать оконный (windowed) объект, в момент создания определить windowrgn (область окна, если она не прямоугольная) и в оконной процедуре этого объекта ловить события CM_MOUSEENTER и CM_MOUSELEAVE.

Короче все оказалось гораздо проще.

Кладем на форму кнопку и экземпляр TPanel изменим его цвет для наглядности.
Потом можно положить сверху еще и TShape, но это уже мелочь.
Ниже полный текст модуля с всего двумя методами! (Один из которых к задаче практически не относится

)

До нажатия на кнопку panel1 имеет прямоугольную форму, а после нажатия - эллиптическую.
В любом случае в заголовке формы пишется корректный статус положения курсора.
VCL в D6 устроена так, что у всех контролов событие CM_MOUSEENTER/LEAVE транслируется
родительскому окну, так что если внутри панели появятся еще оконные объекты, то
это работать конечно же уже не будет. Прийдется субклассить панель и перекрыть у нее
message-методы CMMouseEnter/CMMouseLeave. Еще можно подменить оконную процедуру
"на лету". (VCL это позволяет, см свойство WindowProc).

А так (в данном примере) обработка входа и выхода курсора в область панели
обрабатывается не панелью а формой.

Разумеется вместо r:=CreateEllipticRgn(0,0,width,height); можно использовать другие методы
включая CombineRgn, порождая не только круглые, но и невыпуклые и даже "дырявые" области.

Код: Выделить всё

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  RXCtrls, AppEvnts, ActnList, GIFCtrl, Animate, ImageButton, ExtCtrls,
  StdCtrls;

type
  TForm1 = class(TForm)
    RxLabel1: TRxLabel;
    Shape1: TShape;
    Panel1: TPanel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure WndProc(var Message: TMessage); override;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  r: HRGN;
begin
  with panel1 do begin
    r:=CreateEllipticRgn(0,0,width,height);
    setwindowrgn(panel1.handle,r,true);
    deleteobject(r);
  end;
end;

procedure TForm1.WndProc(var Message: TMessage);
begin
  inherited;
  with Message do if Message. LParam=Longint(panel1) then begin
    case msg of
      CM_MOUSEENTER:caption:='Внутри';
      CM_MOUSELEAVE:caption:='Снаружи';
    end;
  end;
end;
end.

PS
Если хотите использовать только MouseMove и контролов на форме мало, то чисто логически:
если MouseMove возникает у нужного контрола (не забудьте толко отсечь лишнее от его
прямоугольной формы), то значит курсор внутри, а если у других контролов, то значит
вышел за пределы.

Developing.ru

Вопрос по задаче с procedure TForm1.Shp1MouseMove

Вопрос по задаче с procedure TForm1.Shp1MouseMove