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.
teşekkürler bilgiler için
bunu nasıl kullanacaz