Bu unit program bitmap grafik işleminde kullanılır.
Kod: Tümünü seç
{$N+}
Unit ads_Gradient;
{Copyright(c)1995 Pat Ritchie
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
maley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to maley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
interface
uses
WinTypes, WinProcs, Messages,
SysUtils, Classes, Controls,
Forms, Menus, Graphics;
type
TGradientDirection =
(gdTopToBottom,gdLeftToRight,gdInsideOut,gdStretchInsideOut);
TGradient = class(TGraphicControl)
private
FGradBMP : hBitmap;
fStartingColor : TColor;
fEndingColor: TColor;
fGradientDirection: TGradientDirection;
fGradWidth,fGradHeight:integer;
protected
procedure Paint; override;
procedure SetStartingColor(Value:TColor);
procedure SetEndingColor(Value:TColor);
procedure SetGradientDirection(Value:TGradientDirection);
procedure CreateGradient;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property GradientDirection:TGradientDirection read fGradientDirection write SetGradientDirection;
property ColorStart: TColor read fStartingColor write SetStartingColor default clBlue;
property ColorEnd: TColor read fEndingColor write SetEndingColor default clBlack;
property Align;
property DragCursor;
property DragMode;
property OnDragDrop;
property OnClick;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Unleash',[TGradient]);
end;
constructor TGradient.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fEndingColor := clBlack;
fStartingColor := clBlue;
fGradBMP := 0;
Width := 30;
Height := 30;
end;
destructor TGradient.Destroy;
begin
if fGradBMP <> 0 then DeleteObject(fGradBMP);
inherited Destroy;
end;
procedure TGradient.SetStartingColor(Value:TColor);
begin
if Value<>fStartingColor then
begin
fStartingColor := Value;
CreateGradient;
Invalidate;
end;
end;
procedure TGradient.SetEndingColor(Value:TColor);
begin
if Value<>fEndingColor then
begin
fEndingColor := Value;
CreateGradient;
Invalidate;
end;
end;
procedure TGradient.SetGradientDirection(Value:TGradientDirection);
begin
if Value<>fGradientDirection then
begin
fGradientDirection := Value;
CreateGradient;
Invalidate;
end;
end;
procedure TGradient.Paint;
var
MemDC,PaintDC : HDC;
OldBMP : hBitmap;
R : TRect;
begin
PaintDC := Canvas.Handle;
if (fGradWidth<>Width) or (fGradHeight<>Height) then
CreateGradient;
if (fGradWidth=0) or (fGradHeight=0) then exit;
MemDC := CreateCompatibleDC(PaintDC);
OldBMP := SelectObject(MemDC,fGradBMP);
R := Rect(Left,Top,Width+1,Height+1);
BitBlt(PaintDC,0,0,Width,Height,MemDC,0,0,SRCCOPY);
SelectObject(MemDC,OldBMP);
DeleteDC(MemDC);
end;
procedure TGradient.CreateGradient;
var
DC,MemDC : hDC;
OldBMP : hBitmap;
Brush : THandle;
i,j : integer;
R : TRect;
XInc,YInc : single;
C,C1 : TColorRef;
RStart,GStart,BStart,RDelta,GDelta,BDelta,
XOfs,YOfs : double;
REnd,BEnd,GEnd,R1,G1,B1 : integer;
CX,CY,GradSz,XNew,YNew:integer;
GradSzMinus1: integer;
Temp : string[20];
begin
G1 := 0; B1 := 0; GradSz := 0; XInc := 0; YInc := 0; R1 := 0;
if fGradBMP <> 0 then DeleteObject(fGradBMP);
fGradWidth := Width;
fGradHeight := Height;
if (fGradWidth=0) or (fGradHeight=0) then exit;
DC := GetDC(0);
MemDC := CreateCompatibleDC(DC);
fGradBMP := CreateCompatibleBitmap(DC,fGradWidth,fGradHeight);
OldBMP := SelectObject(MemDC,fGradBMP);
case fGradientDirection of
gdTopToBottom:
GradSz := fGradHeight;
gdLeftToRight:
GradSz := fGradWidth;
gdInsideOut,
gdStretchInsideOut:
begin
if fGradWidth > fGradHeight then
begin
GradSz := fGradWidth;
XInc := 1;
if fGradientDirection = gdStretchInsideOut then
YInc := (fGradHeight / fGradWidth)
else
YInc := 1;
end
else
begin
GradSz := fGradHeight;
YInc := 1;
if fGradientDirection = gdStretchInsideOut then
XInc := (fGradWidth / fGradHeight)
else
XInc := 1;
end;
CX := fGradWidth shr 1;
CY := fGradHeight shr 1;
end;
end;
{}
if fGradientDirection in [gdInsideOut,gdStretchInsideOut] then
begin
REnd := GetRValue(fEndingColor);
GEnd := GetGValue(fEndingColor);
BEnd := GetBValue(fEndingColor);
RStart := GetRValue(fStartingColor);
GStart := GetGValue(fStartingColor);
BStart := GetBValue(fStartingColor);
RDelta :=
(REnd-RStart)/((GradSz) div 2);
GDelta :=
(GEnd-GStart)/((GradSz) div 2);
BDelta :=
(BEnd-BStart)/((GradSz) div 2);
C := fStartingColor;
XOfs := 0;
YOfs := 0;
XNew := 0;
YNew := 0;
With R do begin
Left := CX; Top := CY;
Right := CX+1; Bottom := CY+1;
end;
While (R.Left >=0) or (R.Top>=0) do
begin
Brush := CreateSolidBrush(C);
FrameRect(MemDC,R,Brush);
DeleteObject(Brush);
XOfs := XOfs+XInc;
YOfs := YOfs+YInc;
if (XOfs-XNew) >= 1 then
begin
InflateRect(R,1,0);
Inc(XNew);
end;
if (YOfs-YNew) >= 1 then
begin
InflateRect(R,0,1);
Inc(YNew);
end;
if R1<>REnd then RStart := RStart+RDelta;
if G1<>GEnd then GStart := GStart+GDelta;
if B1<>BEnd then BStart := BStart+BDelta;
R1 := Round(RStart);
G1 := Round(GStart);
B1 := Round(BStart);
C := RGB(R1,G1,B1);
end;
end
else
begin
GradSzMinus1 := GradSz-1;
RDelta := (Integer(GetRValue(fEndingColor))-GetRValue(fStartingColor)) / GradSzMinus1;
GDelta := (Integer(GetGValue(fEndingColor))-GetGValue(fStartingColor)) / GradSzMinus1;
BDelta := (Integer(GetBValue(fEndingColor))-GetBValue(fStartingColor)) / GradSzMinus1;
C := fStartingColor;
C1 := C;
i := 0;
While i <= GradSzMinus1 do
begin
Brush := CreateSolidBrush(C);
case fGradientDirection of
gdTopToBottom:
begin
With R do
begin Left := 0; Right := Width; Top := i; Bottom := i+1; end;
end;
gdLeftToRight:
begin
With R do
begin Left := i; Right := i+1; Top := 0; Bottom := Height; end;
end;
end;
FrameRect(MemDC,R,Brush);
DeleteObject(Brush);
Inc(i);
C := RGB(Trunc(GetRValue(C1)+RDelta*(i-1)),Trunc(GetGValue(C1)+GDelta*(i-1)),Trunc(GetBValue(C1)+BDelta*(i-1)));
end;
end;
SelectObject(MemDC,OldBMP);
DeleteDC(MemDC);
ReleaseDC(0,DC);
end;
end.