Ошибка компонента MySpeedButton

← →
VJar (2003-01-05 01:23) [0]

Этот компонент мне подкинули на форуме.
Я компоненты не писал еще, потому ошибку найти не так уж просто.
У следующего компонента, который рисует на SpeedButton рисунки из
ImageList, такая лажа:
На кнопке прорисовывается только рисунок с индексом 0.

unit MySpeedButton;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, ImgList;

type
TMySpeedButton = class(TSpeedButton)
private
FImageList:TCustomImageList;
FImageIndex:Integer;
{ Private declarations }
protected
procedure Paint; override;
{ Protected declarations }
public
procedure SetImageIndex(Value:Integer);
{ Public declarations }
published
property ImageList:TCustomImageList read FImageList write FImageList;
property ImageIndex:Integer read FImageIndex write SetImageIndex;
{ Published declarations }
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents("Opuhshii", [TMySpeedButton]);
end;

{ TMySpeedButton }

procedure TMySpeedButton.Paint;
begin
inherited;
if Assigned(FImageList) then
if (FImageIndex in [0..Pred(FImageList.Count)]) then begin
if not Enabled then begin
FImageList.Draw(Canvas,Round(Width/2-FImageList.Width/2),Round(Height/2-FImageList.Height/2),FImageIndex,False)
end else
FImageList.Draw(Canvas,Round(Width/2-FImageList.Width/2),Round(Height/2-FImageList.Height/2),FImageIndex,True);
end;
end;

procedure TMySpeedButton.SetImageIndex(Value: Integer);
begin
if Assigned(FImageList) then
if (Value in [0..Pred(FImageList.Count)]) then begin
FImageIndex:=Value;
Paint;
end;
end;

end.

← →
France (2003-01-05 10:12) [1]

Действительно, после компиляции все эти батоны имеют ImageIndex[0], несмотря на то, что в проекте все ImageIndex"ы расставлены верно. Но справиться с этой проблемой несложно. Надо в процедуре FormCreate написать вручную, какому батону какой ImageIndex соответствует. Т.е. код будет выглядеть примерно таким:

procedure TForm1.FormCreate(Sender: TObject);
begin
MySpeedButton1.ImageIndex:=0;
MySpeedButton2.ImageIndex:=1;
MySpeedButton3.ImageIndex:=2;
MySpeedButton4.ImageIndex:=3;
end;

Вот и все!!! Удачи!!!

← →
Юрий Зотов (2003-01-05 10:38) [2]

Не хочется обижать автора компонента, но это, извините, не компонент, а ... нечто. Компоненты так не пишут. Как минимум, необходимо заместить Notification и написать метод SetImageList (c соответствующим изменением объявления свойства). Иначе при удалении ImageList"а гарантированно идет Access Violation. Далеее - совершенно непонятно, что делает метод SetImageIndex в секции public, ибо ему прямая дорога в private. Вообще, этот метод просто не нужен (поскольку в Paint и так есть все проверки) и даже, похоже, вреден - скорее всего, именно из-за него расставленные в design-time значения индексов не считываются из DFM.

В общем... "три строки - три ошибки". Увы.

← →
Opuhshii (2003-01-05 15:45) [3]

Вообще сие было задумано не как полноценный компонент которой имеет право жить в первозданном виде, а скорее всего как пример что реализовать требуемое можно и своими силами без сторонних компонент, хотя вообще да,.. it"s my fault... все таки надо было писать правильно все, либо вообще не писать... к тому
procedure TMySpeedButton.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (Operation = opRemove) and (AComponent = ImageList) then begin ImageList := nil end; end; procedure TMySpeedButton.SetImageList(Value: TCustomImageList); begin FImageList:=Value; Paint; end; procedure TMySpeedButton.SetImageIndex(Value: Integer); begin FImageIndex:=Value; Paint; end;
хотя, и это не проверял,.. но примерно так,..

← →
Юрий Зотов (2003-01-05 16:31) [4]

А вот так будет еще лучше. Поскольку ImageList не обязан находиться на той же форме. И поскольку лишние перерисовки никому не нужны.

procedure TMySpeedButton.SetImageList(Value: TCustomImageList);
begin
if FImageList <> Value then
begin
if FImageList <> nil then RemoveFreeNotification(FImageList);
FImageList := Value;
if FImageList <> nil then FreeNotification(FImageList);
Paint
end
end;

В метод SetImageIndex тоже лучше добавить проверку
if FImageIndex <> Value then...
Это тоже исключит лишние перерисовки.

Ошибка компонента MySpeedButton Найти похожие ветки