Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Можно ли из 3-х картинок сделать компонент-кнопку?

01.01.2007

Мастера у меня назрел еще такой вопрос! Можно ли из 3-х Image(картинок) сделать компонент-кнопку, т.е у меня есть три картинки: кнопка обычная, нажатая и активная (на ней курсор мышки)? Я конечно могу каждый раз на форму кидать по три Image, вставляя в каждый Image картинку, но это только на одну кнопку 3 image'a, а если я хочу 10 кнопок, то это будет уже 30 image'ей!!! Я представляю, что у кнопки должны быть такие свойства как у Image'a, и в свойствах этого компонета дожны быть ссылки на 3 картинки, отвечающие нужному состоянию. Сразу скажу, что BitBtn не подойдет, так как форма кнопки прямоугольником и не повторяет форму рисунка в картинки. Компонент Image он тоже прямоугольный, но если всавить в него картинку и назначить свойство Transparent, Image станет при этом позрачный и повторит форму рисунка в картинке, т.е. рисунка кнопки.

{*******************************************************}
{                                                       }
{       Sprite Button                                   }
{                                                       }
{       Copyright (c) 2004-2005, Михаил Мостовой        }
{                                (s-mike)               }
{       http://forum.sources.ru                         }
{       http://mikesoft.front.ru                        }
{                                                       }
{*******************************************************}
 
unit
SpriteBtn;
 
interface
 
uses
 
Windows, SysUtils, Classes, Controls, Graphics, Types, Messages;
 
type
 
TSpriteButton = class(TGraphicControl)
 
private
   
FPicturePressed: TPicture;
   
FPictureFocused: TPicture;
   
FPictureNormal: TPicture;
   
FPictureDisabled: TPicture;
   
FEnabled: Boolean;
   
FPressed: Boolean;
   
FFocused: Boolean;
   
FDrawing: Boolean;
   
FTransparent: Boolean;
    procedure
SetPictureFocused(const Value: TPicture);
    procedure
SetPicturePressed(const Value: TPicture);
    procedure
SetPictureNormal(const Value: TPicture);
    procedure
SetPictureDisabled(const Value: TPicture);
    procedure
CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure
CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure
OnPictureChange(Sender: TObject);
    procedure
UpdateButtonState;
    procedure
SetTransparent(const Value: Boolean);
 
protected
    procedure
Paint; override;
    procedure
MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure
MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
 
public
   
constructor Create(AOwner: TComponent); override;
    destructor
Destroy; override;
  published
    property
Action;
    property
Anchors;
    property
Caption;
    property
Enabled;
    property
Font;
    property
ShowHint;
    property
ParentShowHint;
    property
OnClick;
    property
OnMouseDown;
    property
PictureNormal: TPicture read FPictureNormal write SetPictureNormal;
    property
PictureFocused: TPicture read FPictureFocused write SetPictureFocused;
    property
PicturePressed: TPicture read FPicturePressed write SetPicturePressed;
    property
PictureDisabled: TPicture read FPictureDisabled write SetPictureDisabled;
    property
Transparent: Boolean read FTransparent write SetTransparent;
 
end;
 
procedure
Register;
 
implementation
 
uses
Consts;
 
procedure
Register;
begin
 
RegisterComponents('MSX Controls', [TSpriteButton]);
end;
 
{ TSpriteButton }
 
constructor TSpriteButton.Create(AOwner: TComponent);
begin
  inherited
;
 
 
FEnabled := True;
 
 
FPictureNormal := TPicture.Create;
 
FPictureNormal.OnChange := OnPictureChange;
 
FPictureFocused := TPicture.Create;
 
FPicturePressed := TPicture.Create;
 
FPictureDisabled := TPicture.Create;
 
 
FPressed := False;
 
FFocused := False;
 
 
FDrawing := False;
end;
 
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);
 
      R
.Right := ClientWidth - 14;
      R
.Top := (ClientHeight - (R.Bottom - R.Top)) div 2;
      R
.Bottom := ClientHeight;
 
     
DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_WORDBREAK or DT_CENTER);
   
end;
 
finally
   
FDrawing := False;
 
end;
end;
 
procedure
TSpriteButton.SetTransparent(const Value: Boolean);
begin
 
if Value <> FTransparent then
 
begin
   
FTransparent := Value;
   
if not FDrawing then Invalidate;
 
end;
end;
 
end.

Взято из https://forum.sources.ru