Текущий архив: 2005.11.13;
Скачать: CL | DM;

Вниз

Как сделать компонент невидимим при клике по нему?   Найти похожие ветки 

← →
Dmitry_04   (2005-02-19 18:22) [0]

Написал я тут свой компонент... Скинообразную кнопочку, состоящую из трех изображений... Когда она ненажата, когда над ней курсор, и когда она нажата... А вопрос вот какой: как сделать при нажатии на нее ее невидимой? Visible:=false не работает... Может в коде компонента что не так? Вот он:

---

← →
Dmitry_04   (2005-02-19 18:22) [1]


type
 TShowSkinSpeedButtonPict = (shwPictureUp, shwPictureMove, shwPictureDown);

 TMSSkinSpeedButton = class(TGraphicControl)
 private
   FShowPictute: TShowSkinSpeedButtonPict;
   FPictureUp: TPicture;
   FPictureMove: TPicture;
   FPictureDown: TPicture;
...
   FMouseDownUp: Boolean;
...
   FAllowAllUp: Boolean;
   FDown: Boolean;
   function GetCanvas: TCanvas;
   procedure UpdateExclusive;
   procedure SetAllowAllUp(Value: Boolean);
   procedure SetPictureUp(Value: TPicture);
   procedure SetPictureMove(Value: TPicture);
   procedure SetPictureDown(Value: TPicture);
...
   procedure MouseEnter(var Message: TMessage); message CM_MOUSEENTER;
   procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
   procedure CMButtonPressed(var Message: TMessage); message CM_BUTTONPRESSED;
 protected
   function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
   function DestRect: TRect;
   function DoPaletteChange: Boolean;
   procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
   procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
   function GetPalette: HPALETTE; override;
   procedure Paint; override;
   procedure Progress(Sender: TObject; Stage: TProgressStage;
     PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string); dynamic;
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   property Canvas: TCanvas read GetCanvas;
 published
   property Align;
   property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False;
   property Anchors;
   property AutoSize;
   property Center: Boolean read FCenter write SetCenter default False;
   property Constraints;
   property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
   property Down: Boolean read FDown write SetDown default False;
...
   property Enabled;
   property IncrementalDisplay: Boolean read FIncrementalDisplay write FIncrementalDisplay default False;
   property PictureUp: TPicture read FPictureUp write SetPictureUp;
   property PictureMove: TPicture read FPictureMove write SetPictureMove;
   property PictureDown: TPicture read FPictureDown write SetPictureDown;
...
   property Visible;
   property OnClick;
...
   property OnDblClick;
...
   property OnMouseDown;
   property OnMouseMove;
   property OnMouseUp;
...
 end;

...

constructor TMSSkinSpeedButton.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FShowPictute := shwPictureUp;
 ControlStyle := ControlStyle + [csReplicatable];
 FPictureUp := TPicture.Create;
 FPictureMove := TPicture.Create;
 FPictureDown := TPicture.Create;
 FPictureUp.OnChange := PictureChanged;
 FPictureMove.OnChange := PictureChanged;
 FPictureDown.OnChange := PictureChanged;
 FPictureUp.OnProgress := Progress;
 FPictureMove.OnProgress := Progress;
 FPictureDown.OnProgress := Progress;
 FMouseDownUp:=false;
 Height := 22;
 Width := 23;
end;

destructor TMSSkinSpeedButton.Destroy;
begin
 FPictureUp.Free;
 FPictureMove.Free;
 FPictureDown.Free;
 inherited Destroy;
end;

...

procedure TMSSkinSpeedButton.Paint;
var
 Save: Boolean;
begin
 if csDesigning in ComponentState then
with inherited Canvas do
begin
  Pen.Style := psDash;
  Brush.Style := bsClear;
  Rectangle(0, 0, Width, Height);
end;
 Save := FDrawing;
 FDrawing := True;
 try
with inherited Canvas do
   begin
   if FShowPictute = shwPictureUp then
     begin
    StretchDraw(DestRect, PictureUp.Graphic);
     end;
   if FShowPictute = shwPictureMove then
     begin
    StretchDraw(DestRect, PictureMove.Graphic);
     end;
   if FShowPictute = shwPictureDown then
     begin
    StretchDraw(DestRect, PictureDown.Graphic);
     end;
   end;
 finally
FDrawing := Save;
 end;
end;

...

function TMSSkinSpeedButton.GetCanvas: TCanvas;
var
 Bitmap: TBitmap;
begin
 if FShowPictute = shwPictureUp then
   begin
     if PictureUp.Graphic = nil then
       begin
      Bitmap := TBitmap.Create;
        try
        Bitmap.Width := Width;
        Bitmap.Height := Height;
        PictureUp.Graphic := Bitmap;
        finally
        Bitmap.Free;
        end;
       end;
     if PictureUp.Graphic is TBitmap then
      Result := TBitmap(PictureUp.Graphic).Canvas
     else
      raise EInvalidOperation.Create(SImageCanvasNeedsBitmap);
   end;

 if FShowPictute = shwPictureMove then
   begin
     if PictureMove.Graphic = nil then
       begin
      Bitmap := TBitmap.Create;
        try
        Bitmap.Width := Width;
        Bitmap.Height := Height;
        PictureMove.Graphic := Bitmap;
        finally
        Bitmap.Free;
        end;
       end;
     if PictureMove.Graphic is TBitmap then
      Result := TBitmap(PictureMove.Graphic).Canvas
     else
      raise EInvalidOperation.Create(SImageCanvasNeedsBitmap);
   end;

 if FShowPictute = shwPictureDown then
   begin
     if PictureDown.Graphic = nil then
       begin
      Bitmap := TBitmap.Create;
        try
        Bitmap.Width := Width;
        Bitmap.Height := Height;
        PictureDown.Graphic := Bitmap;
        finally
        Bitmap.Free;
        end;
       end;
     if PictureDown.Graphic is TBitmap then
      Result := TBitmap(PictureDown.Graphic).Canvas
     else
      raise EInvalidOperation.Create(SImageCanvasNeedsBitmap);
   end;
end;

...

procedure TMSSkinSpeedButton.MouseEnter(var Message: TMessage);
begin
FMouseDownUp:=false;
if FAllowAllUp then
 begin
 if FDown=false then
   begin
   FShowPictute := shwPictureMove;
   Paint;
   end;
 end
else
 begin
 FShowPictute := shwPictureMove;
 Paint;
 end;
end;

procedure TMSSkinSpeedButton.CMMouseLeave(var Message: TMessage);
begin
FMouseDownUp:=true;
if FAllowAllUp then
 begin
 if FDown=false then
   begin
   FShowPictute := shwPictureUp;
   Paint;
   end;
 end
else
 begin
 FShowPictute := shwPictureUp;
 Paint;
 end;
end;

procedure TMSSkinSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if FAllowAllUp then
 begin
 if FDown then
   begin
   FDown:=false;
   end
 else
   begin
   FDown:=true;
   end;
 end;
FShowPictute := shwPictureDown;
Paint;
if FAllowAllUp then
 begin
 UpdateExclusive;
 end;
end;

procedure TMSSkinSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if FAllowAllUp then
 begin
 if FDown=false then
   begin
   if FMouseDownUp then
     begin
     FMouseDownUp:=false;
     end
   else
     begin
     FShowPictute := shwPictureMove;
     Paint;
     end;
   end;
 end
else
 begin
 if FMouseDownUp then
   begin
   FMouseDownUp:=false;
   end
 else
   begin
   FShowPictute := shwPictureMove;
   Paint;
   end;
 end;
end;

...

end.


---

← →
Dmitry_04   (2005-02-20 12:44) [2]

Мне кажется это связано с тем, что когда происходит событие "MouseUp" компонент перерисовывается... но почему он всетаки становится видимым я никак не пойму...

---

← →
Семен Сорокин ©   (2005-02-20 16:51) [3]

> Скинообразную кнопочку, состоящую из трех изображений...
> Когда она ненажата, когда над ней курсор, и когда она нажата...
>

Велосипед изобретаем? посмотрите справку по св-ву Glyph кнопки TSpeedButton

в MouseDown, MouseUp
про inherited не забыли?

---

← →
Dmitry_04   (2005-02-21 17:07) [4]

я не совсем понял как inherited там прописать... вначале, т.е. так:

procedure TMSSkinSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
if FAllowAllUp then
begin
...
end;

или в конце:

procedure TMSSkinSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if FAllowAllUp then
begin
...
end;
inherited;
end;

попробовал и так и так, всеравно не работает... может еще какнибудь inherited прописать надо?
Помогите пожалуйста!

---

← →
Семен Сорокин ©   (2005-02-21 18:08) [5]

> Dmitry_04   (21.02.05 17:07) [4]
> я не совсем понял как inherited там прописать... вначале,
> или в конце:
> попробовал и так и так, всеравно не работает... может еще
> какнибудь inherited прописать надо?
> Помогите пожалуйста!

если пропишешь перед своим кодом - то "дефолтный" обработчик выполнится до твоего кода, а если после - то, соответственно, твой код выполнится раньше, можно также передавать управление предкам при каких-либо условиях, например нередко можно встретить:
if SomeCondition then
 // что-то
else
 inherited
...
не следует также забывать, что inherited надо ставить и при обработке сообщений, чего, кстати, у Вас также не наблюдается.
И вообще советую прочесть справку по данному слову.

---

← →
Dmitry_04   (2005-02-21 18:39) [6]

Семен Сорокин надо inherited в OnMouseUp, OnMouseDown и в обработке сообщений написать inherited перед Paint? Т.е. так?

inherited Paint;

Я почитал про inherited и понял что это запускает метод родительского класса... Но где мне тут его прописать я так и не понял...:(

---

← →
Dmitry_04   (2005-02-22 13:23) [7]

Помогите пожалуйста! Как мне inherited прописать?

---

Страницы: 1 вся ветка

Текущий архив: 2005.11.13;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.03 c