Мастера у меня назрел еще такой вопрос! Можно ли из 3-х Image(картинок) сделать компонент-кнопку, т.е у меня есть три картинки: кнопка обычная, нажатая и активная (на ней курсор мышки)? Я конечно могу каждый раз на форму кидать по три Image, вставляя в каждый Image картинку, но это только на одну кнопку 3 image'a, а если я хочу 10 кнопок, то это будет уже 30 image'ей!!! Я представляю, что у кнопки должны быть такие свойства как у Image'a, и в свойствах этого компонета дожны быть ссылки на 3 картинки, отвечающие нужному состоянию. Сразу скажу, что BitBtn не подойдет, так как форма кнопки прямоугольником и не повторяет форму рисунка в картинки. Компонент Image он тоже прямоугольный, но если всавить в него картинку и назначить свойство Transparent, Image станет при этом позрачный и повторит форму рисунка в картинке, т.е. рисунка кнопки.
destructor TSpriteButton.Destroy;
begin
FPictureNormal.Free;
FPictureFocused.Free;
FPicturePressed.Free;
FPictureDisabled.Free;
inherited;
end;
procedure TSpriteButton.SetPictureNormal(const Value: TPicture);
begin
PictureNormal.Assign(Value);
if Assigned(Value) then
begin
Width := Value.Width;
Height := Value.Height;
end;
if not FDrawing then Invalidate;
end;
procedure TSpriteButton.SetPictureFocused(const Value: TPicture);
begin
FPictureFocused.Assign(Value);
end;
procedure TSpriteButton.SetPicturePressed(const Value: TPicture);
begin
FPicturePressed.Assign(Value);
end;
procedure TSpriteButton.SetPictureDisabled(const Value: TPicture);
begin
FPictureDisabled.Assign(Value);
end;
procedure TSpriteButton.CMMouseEnter(var Message: TMessage);
begin
if Enabled = False then Exit;
FFocused := True;
if not FDrawing then Invalidate;
end;
procedure TSpriteButton.CMMouseLeave(var Message: TMessage);
begin
if Enabled = False then Exit;
FFocused := False;
if not FDrawing then Invalidate;
end;
procedure TSpriteButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if Enabled = False then Exit;
if Button = mbLeft then
begin
FPressed := True;
FFocused := True;
if not FDrawing then Invalidate;
end;
end;
procedure TSpriteButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if Enabled = False then Exit;
if Button = mbLeft then
begin
FPressed := False;
if not FDrawing then Invalidate;
end;
inherited;
end;
procedure TSpriteButton.OnPictureChange(Sender: TObject);
begin
Width := PictureNormal.Width;
Height := PictureNormal.Height;
if not FDrawing then Invalidate;
end;
procedure TSpriteButton.UpdateButtonState;
var
Picture: TPicture;
begin
if Enabled then
begin
if not (csDesigning in ComponentState) then
begin
if (FPressed and FFocused) then
Picture := PicturePressed
else
if (not FPressed and FFocused) then
Picture := PictureFocused
else
Picture := PictureNormal;
end else Picture := PictureNormal;
end else begin
FFocused := False;
FPressed := False;
Picture := PictureDisabled;
end;
if (Picture <> PictureNormal) and ((Picture.Width = 0) or (Picture.Height = 0)) then
Picture := PictureNormal;
if (csDesigning in ComponentState) and
((not Assigned(Picture.Graphic)) or (Picture.Width = 0) or (Picture.Height = 0)) then
begin
with Canvas do
begin
Pen.Style := psDash;
Pen.Color := clBlack;
Brush.Color := Color;
Brush.Style := bsSolid;
Rectangle(0, 0, Width, Height);
end;
Exit;
end;
if Assigned(Picture.Graphic) then
begin
if not ((Picture.Graphic is TMetaFile) or (Picture.Graphic is TIcon)) then
Picture.Graphic.Transparent := FTransparent;
Canvas.Draw(0, 0, Picture.Graphic);
end;
end;
procedure TSpriteButton.Paint;
var
R: TRect;
begin
if FDrawing then Exit;
FDrawing := True;
try
UpdateButtonState;
if Caption <> '' then
begin
R := ClientRect;
Canvas.Font.Assign(Font);
Canvas.Brush.Style := bsClear;
R := ClientRect;
R.Top := 0;
R.Bottom := 0;
Inc(R.Left, 14);
Dec(R.Right, 14);
DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_WORDBREAK or DT_CALCRECT);
procedure TSpriteButton.SetTransparent(const Value: Boolean);
begin
if Value <> FTransparent then
begin
FTransparent := Value;
if not FDrawing then Invalidate;
end;
end;
end.
Отличный вопрос!
Да, можно создать компонент, представляющий кнопку с изображением, которая имеет три состояния: нормальное, фокусированное и нажатое. Этот компонент может использоваться для избежания использования нескольких контролов "Изображение" на вашем форме.
Программный код, который вы предоставили, - это реализация такого компонента, называемого TSpriteButton. Он имеет свойства для каждого состояния (нормальное, фокусированное, нажатое) и методы для обновления визуального представления кнопки в зависимости от ее состояния.
Давайте разберемся, как работает этот компонент:
Компонент имеет три свойства-изображения: FPictureNormal, FPictureFocused и FPicturePressed, которые хранят изображения для каждого состояния.
Когда мышка наводится на кнопку или покидает ее, вызываются методы CMMouseEnter и CMMouseLeave, соответственно. Эти методы обновляют состояние фокуса кнопки.
Когда кнопка нажимается (например, при клике по ней), вызывается метод MouseDown, который обновляет состояние нажатия кнопки.
Метод UpdateButtonState вызывается для обновления визуального представления кнопки в зависимости от ее текущего состояния.
Метод Paint переопределяется для рисования кнопки с правильным изображением и текстом (если есть) для текущего состояния.
Чтобы использовать этот компонент, просто добавьте его на ваш форм и настройте его свойства соответствующим образом. Например, вы можете присвоить изображения каждому свойству-изображению (PictureNormal, PictureFocused и т.д.) и настроить другие свойства, такие как Enabled и Transparent.
В целом, TSpriteButton - это отличный пример создания повторно используемых компонентов, которые упрощают процесс разработки приложений с пользовательским интерфейсом. Если у вас есть конкретные вопросы к этому коду или вы хотите получить дополнительную информацию о каких-либо аспектах, не стесняйтесь задавать вопросы!
Можно ли из 3-х Image(картинок) сделать компонент-кнопку? - Да, это можно сделать с помощью создания собственного компонента на основе TGraphicControl или TCustomControl, как показано в примере кода SpriteButton.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Telegram-канал