Icon yükleyebilen bir SpeedButton türevi..

// 15 Mayıs 2009 // Delphi, Grafik, Programlama

Delphi’nin kendi VCL’inde bulunan button sınıflarında Icon yüklenememesine hep kızmışımdır ama garip garip bitmap dosyaları ile hep idare etmiş ve aman sonra yazarım demiştim.Eh geçenlerde bir arkadaşımın da teşvikiyle oturdum yazdım.Sizlerle paylaşayım istedim. Buyrun; kodda anlaşılmayan sormak istediğiniz birşeyler olursa yardımcı olmaya çalışırım.

{
Icon Speed Button

11/05/2006

Author : Tuğrul HELVACI
Mail   : king_of_delphi@hotmail.com

You can load any icon file and you can use background bitmap.

Herhangi bir icon dosyası yükleyebilir, arka zemin için bir bitmap dosyası yükleyebilir,
başlık ve icon için X,Y koordinatlarını verebilirsiniz.
}

unit IconSpeedButton;

interface

uses
	Windows, SysUtils, Classes, Controls, Buttons, Messages, Types, Graphics, StdCtrls;

type
	TPaintType = (ptColor, ptBitmap);

	TIconSpeedButton = class(TSpeedButton)
	private
    fControlCanvas : TControlCanvas;
    fIcon,
    fDisabledIcon  : TIcon;

    fIconX,
    fIconY,
    fTextX,
    fTextY         : Integer;
    fColor         : TColor;
    fPaintType     : TPaintType;
    fBitmap        : TBitmap;
    fImageList     : TImageList;

    procedure SetIcon(const Value : TIcon);
    procedure SetColor(const Value : TColor);

    function GetIntegerValues(const AIndex : Integer)  :Integer;
    procedure SetIntegerValues(const AIndex : Integer; const Value : Integer);

    procedure SetPaintType(const Value : TPaintType);
    procedure SetBitmap(const Value : TBitmap);

    procedure ConvertGrayScale;
	protected
		property Canvas : TControlCanvas read fControlCanvas;
	public
		constructor Create(AOwner : TComponent); override;
		destructor Destroy; override;
    procedure WMPaint(var Message : TWMPaint); message WM_PAINT;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
	published
		property IconX      : Integer index 0 read GetIntegerValues write SetIntegerValues;
		property IconY      : Integer index 1 read GetIntegerValues write SetIntegerValues;
		property TextX      : Integer index 2 read GetIntegerValues write SetIntegerValues;
		property TextY      : Integer index 3 read GetIntegerValues write SetIntegerValues;

		property Icon       : TIcon read fIcon write SetIcon;
		property Color      : TColor read fColor write SetColor;
		property PaintType  : TPaintType read fPaintType write SetPaintType;
		property Bitmap     : TBitmap read fBitmap write SetBitmap;
	end;

	procedure Register;

implementation

procedure Register;
begin
	RegisterComponents('Additional’, [TIconSpeedButton]);
end;

{ TIconSpeedButton }

procedure TIconSpeedButton.CMMouseEnter(var Message: TMessage);
var
	rRect : TRect;
begin
	inherited;
	Canvas.Brush.Color := clBtnShadow;
	rRect       := ClientRect;

  rRect.Left    := rRect.Left   + 1;
	rRect.Top     := rRect.Top    + 1;
	rRect.Right   := rRect.Right  - 1;
	rRect.Bottom  := rRect.Bottom - 1;

	Canvas.FrameRect(rRect);

	Canvas.Brush.Style := bsClear;
	Canvas.Font.Style := Canvas.Font.Style + [fsUnderline];
	Canvas.TextOut(
								TextX,
								TextY,
								Caption
								);
end;

procedure TIconSpeedButton.CMMouseLeave(var Message: TMessage);
begin
	inherited;
	Invalidate;
end;

procedure TIconSpeedButton.ConvertGrayScale;
var
	IconInfo : _ICONINFO;
	bmp      : TBitmap;

	iX,
	iY,
	iOrt     : Integer;
	clr      : TColor;
begin
	GetIconInfo(fDisabledIcon.Handle, IconInfo);

	bmp := TBitmap.Create;
	try
		bmp.Width := fDisabledIcon.Width;
		bmp.Height:= fDisabledIcon.Height;
		bmp.Handle:= IconInfo.hbmColor;

		for iX := 0 to bmp.Width - 1 do
			for iY := 0 to bmp.Height - 1 do
			begin
				clr := bmp.Canvas.Pixels[iX, iY];
				iOrt := (
									GetRValue(clr) +
									GetGValue(clr) +
									GetBValue(clr)
								) div 3;

				bmp.Canvas.Pixels[iX, iY] := RGB(iOrt, iOrt, iOrt);
			end;

		IconInfo.hbmColor := bmp.Handle;
    fDisabledIcon.Handle := CreateIconIndirect(IconInfo);

		fImageList.AddIcon(fDisabledIcon);
		fImageList.GetIcon(0, fDisabledIcon);
		fImageList.Delete(0);
	finally
		FreeAndNil(bmp);
	end;
end;

constructor TIconSpeedButton.Create(AOwner: TComponent);
begin
	inherited;

	fControlCanvas := TControlCanvas.Create;
	fControlCanvas.Control := Self;

	fIcon := TIcon.Create;
	fDisabledIcon := TIcon.Create;

	fImageList := TImageList.Create(Self);
	fImageList.Width := 32;
	fImageList.Height := 32;

	fIconX := 1;
	fIconY := 1;
	fTextX := 10;
	fTextY := 10;
	fColor := clWhite;
	fPaintType := ptColor;
	fBitmap := TBitmap.Create;
	fBitmap.Width := 100;
	fBitmap.Height := 100;
end;

destructor TIconSpeedButton.Destroy;
begin
	if Assigned(fControlCanvas)
  	then fControlCanvas.Free;

	if Assigned(fIcon)
  	then fIcon.Free;

	if Assigned(fDisabledIcon)
  	then fDisabledIcon.Free;

	if Assigned(fImageList)
  	then fImageList.Free;

	inherited;
end;

function TIconSpeedButton.GetIntegerValues(const AIndex: Integer): Integer;
begin
	case AIndex of
		0 : Result := fIconX;
		1 : Result := fIconY;
		2 : Result := fTextX;
		3 : Result := fTextY;
	end;
end;

procedure TIconSpeedButton.SetBitmap(const Value: TBitmap);
begin
  if fBitmap <> nil then
  begin
		fBitmap.Assign(Value);

		Invalidate;
  end;
end;

procedure TIconSpeedButton.SetColor(const Value: TColor);
var
	mRect : TRect;
begin
	fColor := Value;

	mRect := ClientRect;
	mRect.Left    := mRect.Left   + 1;
	mRect.Top     := mRect.Top    + 1;
	mRect.Right   := mRect.Right  - 1;
	mRect.Bottom  := mRect.Bottom - 1;

	case PaintType of
		ptColor : fControlCanvas.Brush.Color := fColor;
		ptBitmap: if Bitmap <> nil then fControlCanvas.Brush.Bitmap := Bitmap;
	end;

	fControlCanvas.FillRect(mRect);

	if Assigned(Icon)
  	then fControlCanvas.Draw(IconX,IconY,fIcon);

	fControlCanvas.Brush.Style := bsClear;
	fControlCanvas.Font := Font;
	fControlCanvas.TextOut(
													TextX,
													TextY,
													Caption
												);
end;

procedure TIconSpeedButton.SetIcon(const Value: TIcon);
begin
  if fIcon <> nil then
  begin
		fIcon.Assign(Value);

		Invalidate;
  end;
end;

procedure TIconSpeedButton.SetIntegerValues(const AIndex, Value: Integer);
begin
	case AIndex of
		0 : fIconX := Value;
		1 : fIconY := Value;
		2 : fTextX := Value;
		3 : fTextY := Value;
	end;

  Invalidate;
end;

procedure TIconSpeedButton.SetPaintType(const Value: TPaintType);
begin
	fPaintType := Value;

	Invalidate;
end;

procedure TIconSpeedButton.WMPaint(var Message: TWMPaint);
var
	mRect : TRect;
	mRgn  : HRGN;
	mColor: TColor;
begin
	inherited;

	try
		mRect := ClientRect;
		mRect.Left    := mRect.Left   + 1;
		mRect.Top     := mRect.Top    + 1;
		mRect.Right   := mRect.Right  - 1;
		mRect.Bottom  := mRect.Bottom - 1;

		case PaintType of
			ptColor : fControlCanvas.Brush.Color := Color;
			ptBitmap: if Bitmap <> nil then fControlCanvas.Brush.Bitmap := Bitmap;
		end;

		fControlCanvas.FillRect(mRect);

		fDisabledIcon.Assign(fIcon);
		ConvertGrayScale;

		if Assigned(Icon) then
			if Enabled
			then fControlCanvas.Draw(IconX,IconY,fIcon)
			else fControlCanvas.Draw(IconX,IconY,fDisabledIcon);

		fControlCanvas.Font := Font;
		mColor := Font.Color;

		fControlCanvas.Brush.Style := bsClear;

		if not Enabled
		then fControlCanvas.Font.Color := clGray
		else fControlCanvas.Font.Color := mColor;

		fControlCanvas.TextOut(
                            TextX,
                            TextY,
                            Caption
													);
	except
	end;
end;

end.

“Icon yükleyebilen bir SpeedButton türevi..” için 2 Yorum

  1. teşekkürler bilgiler için

  2. ENİGMA diyor ki:

    bunu nasıl kullanacaz

Güvenlik Sistemleri için yorum yazın