Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Компоненты";
Текущий архив: 2005.11.13;
Скачать: [xml.tar.bz2];

Вниз

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

 
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;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.49 MB
Время: 0.113 c
14-1130106837
Гость_
2005-10-24 02:33
2005.11.13
Памятник клавиатуре. Утащили две кнопки по 60 кг.


1-1130138943
td
2005-10-24 11:29
2005.11.13
только цифры в поле


14-1129884103
TButton
2005-10-21 12:41
2005.11.13
глючит звук


2-1129772183
UzJack
2005-10-20 05:36
2005.11.13
Проблема с DBGrid.


14-1130101965
saNat
2005-10-24 01:12
2005.11.13
Поиск ошибки в проекте





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский