Delphide renkli bir button yapalım.

Bu yazımızda Kol-Ce’ ye biraz ara verelim ve Delphi’ ye dönelim. Yaptığım bir projede renkli tuş gerekiyordu ve biraz uğraştıktan sonra gradient yapmaya karar verdim. Tümünü gradient yapınca pek güzel durmadı, bende Iphone telefonlarındaki table view lerde bulunan parçalı yani yarısını gradient diğer yarısınıda düz yapmaya karar verdim.

Ayrıca mouseover içinde belli bir değere göre hesaplayan bir fonksiyon buldum. Aşağıdaki fonksiyon iki rengin verilen bir alpha değeri kadar birbirine geçişini hesaplıyor. Bununla iki resmin birbiri üzerine saydam olarak çizebiliriz. Bu Microsoft’ un kullandığı BLENDFUNCTION biraz küçültülmüşü. Burada alpha değerini 255 e kadar hesaplama algoritması mevcut.

[code lang=”Delphi”]
function ColorBetween(C1, C2: TColor; blend: Extended): TColor;
var
r, g, b: Byte;

y1, y2: Byte;
begin
C1 := ColorToRGB(C1);
C2 := ColorToRGB(C2);

y1 := GetRValue(C1);
y2 := GetRValue(C2);

r := Round(y1 + (y2 – y1) * blend);

y1 := GetGValue(C1);
y2 := GetGValue(C2);

g := Round(y1 + (y2 – y1) * blend);

y1 := GetBValue(C1);
y2 := GetBValue(C2);

b := Round(y1 + (y2 – y1) * blend);
Result := RGB(r, g, b);
end;

[/code]
Bu bileşende iki türlü çizim mevcut birisi klasik dikdörtgen diğeride köşeli diktörtgen çiziyor. Köşeli diktörgen için Windows’ un SelectClipRgn apisini kullanarak çizim alanını kısıtladım.

Ekran görüntüsü:

[code lang=”Delphi”]
unit ParcaliTus;

interface

uses
SysUtils, Classes, Controls, windows, graphics, messages;
type
TDurum = (dNormal, dUzerinde, dBasildi);
TTipi = (tDikdortgen, tKoseli);

type
TParcaliTus = class(TGraphicControl)
private
FDurum: TDurum;
FTipi: TTipi;
FKose: integer;
procedure SetDurum(const Value: TDurum);
procedure SetTipi(const Value: TTipi);
procedure SetKose(const Value: integer);
private
FRenk: Tcolor;
FZeminRenk: Tcolor;
FPenRenk: tcolor;
FNormalBlend: Extended;
FUzeriBlend: Extended;
procedure SetRenk(const Value: Tcolor);
procedure SetZeminRenk(const Value: Tcolor);
procedure SetPenRenk(const Value: tcolor);
procedure SetNormalBlend(const Value: Extended);
procedure SetUzeriBlend(const Value: Extended);
property Durum: TDurum read FDurum write SetDurum;
{ Private declarations }
protected
procedure Paint; override;
function ColorBetween(C1, C2: TColor; blend: Extended): TColor;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X: Integer; Y: Integer); override;
procedure CMMouseenter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseleave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMFontchanged(var Message: TMessage); message CM_FONTCHANGED;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
Y: Integer); override;
procedure CMTextchanged(var Message: TMessage); message CM_TEXTCHANGED;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Renk: Tcolor read FRenk write SetRenk default ClRed;
property ZeminRenk: Tcolor read FZeminRenk write SetZeminRenk default clWhite;
property PenRenk: tcolor read FPenRenk write SetPenRenk default clBlack;
property NormalBlend: Extended read FNormalBlend write SetNormalBlend;
property UzeriBlend: Extended read FUzeriBlend write SetUzeriBlend;
property Tipi: TTipi read FTipi write SetTipi default tDikdortgen;
property Kose: integer read FKose write SetKose;
property Font;
property OnClick;
property Caption;
property Anchors;
property Align;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents(‘NoktaBarkodC’, [TParcaliTus]);
end;

{ TParcaliTus }

constructor TParcaliTus.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csOpaque];
FNormalBlend := 0.5;
FUzeriBlend := 0.4;
FKose := 20;
FTipi := tDikdortgen;
FRenk := clRed;
FZeminRenk := clWhite;
FPenRenk := clBlack;
FDurum := dNormal;
Font.Name := ‘Tahoma’;

end;

procedure GetRGB(Color: TColor; out R, G, B: Integer);
begin
Color := ColorToRGB(Color);
R := GetRValue(Color);
G := GetGValue(Color);
B := GetBValue(Color);
end;

function RGBToColor(R, G, B: Integer): TColor;
begin
if R < 0 then R := 0 else if R > 255 then R := 255;
if G < 0 then G := 0 else if G > 255 then G := 255;
if B < 0 then B := 0 else if B > 255 then B := 255;
Result := TColor(RGB(R, G, B));
end;

procedure Gradient(ACanvas: TCanvas; const ARect: TRect;
C1, C2: TColor);
var
I: Integer;
r, g, b: Integer;
rc1, gc1, bc1: Integer;
rc2, gc2, bc2: Integer;
begin
GetRGB(C1, rc1, gc1, bc1);
GetRGB(C2, rc2, gc2, bc2);
for I := 0 to ARect.Bottom do begin
r := rc1 + (((rc2 – rc1) * I) div (ARect.Bottom – ARect.Top));
g := gc1 + (((gc2 – gc1) * I) div (ARect.Bottom – ARect.Top));
b := bc1 + (((bc2 – bc1) * I) div (ARect.Bottom – ARect.Top));
ACanvas.Brush.Color := RGBToColor(r, g, b);
ACanvas.FillRect(Rect(ARect.Left, ARect.Top + I, ARect.Right, ARect.Top + I + 1))
end;
end;

procedure TParcaliTus.CMMouseenter(var Message: TMessage);
begin
if csDesigning in ComponentState then exit;
FDurum := dUzerinde;
Invalidate;
end;

procedure TParcaliTus.CMMouseleave(var Message: TMessage);
begin
if csDesigning in ComponentState then exit;
FDurum := dNormal;
Invalidate;

end;

function TParcaliTus.ColorBetween(C1, C2: TColor; blend: Extended): TColor;
var
r, g, b: Byte;

y1, y2: Byte;
begin
C1 := ColorToRGB(C1);
C2 := ColorToRGB(C2);

y1 := GetRValue(C1);
y2 := GetRValue(C2);

r := Round(y1 + (y2 – y1) * blend);

y1 := GetGValue(C1);
y2 := GetGValue(C2);

g := Round(y1 + (y2 – y1) * blend);

y1 := GetBValue(C1);
y2 := GetBValue(C2);

b := Round(y1 + (y2 – y1) * blend);
Result := RGB(r, g, b);
end;

destructor TParcaliTus.Destroy;
begin

inherited;
end;

procedure TParcaliTus.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
FDurum := dBasildi;
Invalidate;
inherited MouseDown(Button, Shift, X, Y);

end;

procedure TParcaliTus.Paint;
var
al: TRect;
col2: TColor;
rgn: Hrgn;
begin
al := GetClientRect;

with Canvas do
begin
if FTipi = tKoseli then
begin
rgn := CreateRoundRectRgn(Left, Top, left + Width, top + Height, FKose, FKose);
SelectClipRgn(canvas.handle, rgn);
end;
Brush.Style := bsSolid;

case Durum of
dNormal:
begin
col2 := ColorBetween(FRenk, FZeminRenk, FNormalBlend);
Brush.Color := col2;
Pen.Color := col2;
Rectangle(al);
al.Top := al.Bottom div 2;
Gradient(Canvas, al, FRenk, col2);
al := ClientRect;
Brush.Style := bsClear;
DrawText(Canvas.Handle, pchar(Caption), -1, al, DT_SINGLELINE or DT_CENTER or DT_VCENTER);

end;
dUzerinde:
begin
col2 := ColorBetween(FRenk, FZeminRenk, FUzeriBlend);
Brush.Color := col2;
Pen.Color := col2;
Rectangle(al);
al.Top := al.Bottom div 2;
Gradient(Canvas, al, FRenk, col2);
al := ClientRect;
Brush.Style := bsClear;
DrawText(Canvas.Handle, pchar(Caption), -1, al, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
end;

dBasildi:
begin
col2 := ColorBetween(FRenk, FZeminRenk, FNormalBlend);
Brush.Color := col2;
Pen.Color := col2;
Rectangle(al);
al.Top := al.Bottom div 2;
Gradient(Canvas, al, FRenk, col2);
al := ClientRect;
OffsetRect(al, 1, 1);
Brush.Style := bsClear;
DrawText(Canvas.Handle, pchar(Caption), -1, al, DT_SINGLELINE or DT_CENTER or DT_VCENTER);

end;

end;

al := ClientRect;
Pen.Color := FPenRenk;
Brush.Style := bsClear;
if FTipi = tDikdortgen then Rectangle(al);
if FTipi = tKoseli then
begin
SelectClipRgn(Canvas.Handle, 0);
DeleteObject(rgn);
end;
end;
end;

procedure TParcaliTus.SetNormalBlend(const Value: Extended);
begin
if FNormalBlend <> Value then
begin
FNormalBlend := Value;
Invalidate;
end;
end;

procedure TParcaliTus.SetPenRenk(const Value: tcolor);
begin
if FPenRenk <> Value then
begin
FPenRenk := Value;
Invalidate;
end;
end;

procedure TParcaliTus.SetRenk(const Value: Tcolor);
begin
if Renk <> Value then
begin
FRenk := Value;
Invalidate;
end;
end;

procedure TParcaliTus.SetUzeriblend(const Value: Extended);
begin
if FUzeriBlend <> Value then
begin
FUzeriBlend := Value;
Invalidate;
end;
end;

procedure TParcaliTus.SetZeminRenk(const Value: Tcolor);
begin
if ZeminRenk <> Value then
begin
FZeminRenk := Value;
Invalidate;
end;
end;

procedure TParcaliTus.SetDurum(const Value: TDurum);
begin
FDurum := Value;
end;

procedure TParcaliTus.CMFontchanged(var Message: TMessage);
begin
Canvas.Font.Assign(Font);
Invalidate;
end;

procedure TParcaliTus.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
FDurum := dUzerinde;
Invalidate;
inherited MouseUp(Button, Shift, X, y);

end;

procedure TParcaliTus.CMTextchanged(var Message: TMessage);
begin
Invalidate;
end;

procedure TParcaliTus.SetTipi(const Value: TTipi);
var
al: TRect;
begin
if FTipi <> Value then
begin
FTipi := Value;
Invalidate;
SetRect(al, Left, Top, Width, Height);
InvalidateRect(Parent.Handle, @al, true);

end;
end;

procedure TParcaliTus.SetKose(const Value: integer);
var
al: TRect;
begin
if FKose <> Value then
begin
FKose := Value;
Invalidate;
SetRect(al, Left, Top, Width, Height);
InvalidateRect(Parent.Handle, @al, true);
end;
end;

end.
[/code]