1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169: 170: 171: 172: 173: 174: 175: 176:
| unit Gradient;
interface
uses Windows, Graphics, Math;
type TGradientOrientation = (goLeft2Right, goTop2Bottom, goRadInner2Outer); TGradRow = array of TColor;
procedure PaintGradient (GradCanvas: TCanvas; GradRect: TRect; CStart, CEnd: TColor; Orientation: TGradientOrientation; Flip: Boolean = False); procedure DrawGradRow(GradCanvas: TCanvas; GradRect: TRect; Colors: TGradRow; Orientation: TGradientOrientation; Flip: Boolean = False);
implementation
procedure PaintGradient(GradCanvas: TCanvas; GradRect: TRect; CStart, CEnd: TColor; Orientation: TGradientOrientation; Flip: Boolean = False); var tmpCol: TColor; ar,ag,ab: integer; sr,sg,sb, er,eg,eb: integer; uspsr, uspsg, uspsb: double;
GradLen: Integer;
radius: real;
x, y: Integer; mx, my: Integer;
begin if Flip then begin tmpCol := CStart; CStart := CEnd; CEnd := tmpCol; end;
sr := GetRValue(CStart); sg := GetGValue(CStart); sb := GetBValue(CStart);
er := GetRValue(CEnd); eg := GetGValue(CEnd); eb := GetBValue(CEnd);
if Orientation in [goLeft2Right,goTop2Bottom] then begin with GradCanvas do begin if Orientation = goLeft2Right then GradLen := GradRect.Right - GradRect.Left else GradLen := GradRect.Bottom - GradRect.Top;
if GradLen = 0 then Exit;
uspsr:= (er-sr) / GradLen; uspsg:= (eg-sg) / GradLen; uspsb:= (eb-sb) / GradLen;
for x:=0 to GradLen do begin ar := round(sr+uspsr*x); ag := round(sg+uspsg*x); ab := round(sb+uspsb*x);
Pen.Color := RGB(ar, ag, ab);
if Orientation = goLeft2Right then begin MoveTo(GradRect.Left+x, GradRect.Top); LineTo(GradRect.Left+x, GradRect.Bottom); end else begin MoveTo(GradRect.Left, GradRect.Top+x); LineTo(GradRect.Right, GradRect.Top+x); end; end; end; end else with GradCanvas do begin GradLen := min(GradRect.Right-GradRect.Left,GradRect.Bottom-GradRect.Top) div 2; if GradLen = 0 then Exit;
uspsr:= (er-sr) / GradLen; uspsg:= (eg-sg) / GradLen; uspsb:= (eb-sb) / GradLen;
mx := GradRect.Left+GradLen; my := GradRect.Top+GradLen;
for y := GradRect.Top to GradRect.Bottom do begin for x := GradRect.Left to GradRect.Right do begin radius := sqrt((mx-x)*(mx-x) + (my-y)*(my-y)); if radius < GradLen then begin ar := round(sr+uspsr*radius); ag := round(sg+uspsg*radius); ab := round(sb+uspsb*radius);
Pixels[x,y] := RGB(ar,ag,ab); end; end; end; end; end;
procedure DrawGradRow(GradCanvas: TCanvas; GradRect: TRect; Colors: TGradRow; Orientation: TGradientOrientation; Flip: Boolean = False); var x:integer; lRect: TRect; GradRectWidth, OneRectWidth: Integer; tmpGradRow: TGradRow;
begin if not (Orientation in [goLeft2Right, goTop2Bottom]) then exit; if High(Colors) < 1 then exit;
case Orientation of goLeft2Right: GradRectWidth := GradRect.Right-GradRect.Left; goTop2Bottom: GradRectWidth := GradRect.Bottom-GradRect.Top; end;
if Flip then begin setlength(tmpGradRow, High(Colors)); for x:=0 to High(Colors)+1 do tmpGradRow[x] := Colors[x]; for x:=High(tmpGradRow)+1 downto 0 do Colors[x] := tmpGradRow[(High(tmpGradRow)+1)-x]; end;
OneRectWidth := GradRectWidth div High(Colors);
for x:=0 to High(Colors) do begin case Orientation of goLeft2Right: begin lRect := GradRect; lRect.Left := GradRect.Left+OneRectWidth*x; lRect.Right := lRect.Left+OneRectWidth; end; goTop2Bottom: begin lRect := GradRect; lRect.Top := GradRect.Top+OneRectWidth*x; lRect.Bottom := lRect.Top+OneRectWidth; end; end;
PaintGradient(GradCanvas, lRect, Colors[x], Colors[x+1], Orientation); end; end;
end. |