Можно ли из 3-х Image(картинок) сделать компонент-кнопку?
Мастера у меня назрел еще такой вопрос! Можно ли из 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.
Статья Можно ли из 3-х Image(картинок) сделать компонент-кнопку? раздела Компоненты и Классы Кнопки может быть полезна для разработчиков на Delphi и FreePascal.
