Entwickler-Ecke
Open Source Units - Farbverlauf erstellen
FinnO - Do 04.06.09 15:37
Titel: Farbverlauf erstellen
Da es im Forum immer öfter zu Fragen kommt, wie man einen Farbverlauf erstellen kann, habe ich mal eine Funktion gestrickt. Hier ist sie:
geändert: Schleife beginnt jetzt auch wirklich oben links!
Delphi-Quelltext
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:
| unit FinnOGraphics;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, extCtrls, StdCtrls;
type
TGradientMode = (gmVertical,gmHorizontal);
function DrawGradientTC(Canvas: TCanvas;
Col1,Col2 : TColor;
TopLeft,BottomRight : TPoint;
Mode : TGradientMode): Boolean; overload;
implementation
function DrawGradientTC(Canvas: TCanvas; Col1, Col2: TColor; TopLeft,
BottomRight: TPoint; Mode: TGradientMode): Boolean;
var
Steps : Integer;
DeltaR,
DeltaG,
DeltaB : Double;
r,g,b : Byte;
i: Integer;
begin
Result := False;
if (not Assigned(Canvas)) or (not (BottomRight.X > TopLeft.X) and not(BottomRight.Y > TopLeft.Y)) then Exit;
r := GetRValue(Col1);
g := GetGValue(Col1);
b := GetBValue(Col1);
case Mode of
gmVertical:
begin
Steps := BottomRight.Y - TopLeft.Y;
DeltaR := (GetRValue(Col2) - GetRValue(Col1)) / Steps;
DeltaG := (GetGValue(Col2) - GetGValue(Col1)) / Steps;
DeltaB := (GetBValue(Col2) - GetBValue(Col1)) / Steps;
for i := 0 to Steps do
begin
Canvas.Pen.Color := RGB(round(r+i*DeltaR),
round(g+i*DeltaG),
round(b+i*DeltaB) );
Canvas.MoveTo(TopLeft.X,i);
Canvas.LineTo(BottomRight.X,i);
end;
end;
gmHorizontal:
begin
Steps := BottomRight.X - TopLeft.X;
DeltaR := (GetRValue(Col2) - GetRValue(Col1)) / Steps;
DeltaG := (GetGValue(Col2) - GetGValue(Col1)) / Steps;
DeltaB := (GetBValue(Col2) - GetBValue(Col1)) / Steps;
for i := 0 to Steps do
begin
Canvas.Pen.Color := RGB(round(r+i*DeltaR),
round(g+i*DeltaG),
round(b+i*DeltaB) );
Canvas.MoveTo(i,TopLeft.Y);
Canvas.LineTo(i,BottomRight.Y);
end;
end;
end;
Result := True;
end;
end. |
Anwendungsbeispiel für einen Farbverlauf:
Delphi-Quelltext
1:
2:
| DrawGradientTC(Paintbox1.Canvas,clLime,clRed,Point(0,0),Point(100,100),gmVertical); DrawGradientTC(Paintbox1.Canvas,clLime,clRed,Point(0,100),Point(100,200),gmHorizontal); |
Delete - Do 04.06.09 15:56
Du solltest noch sicherstellen, dass TopLeft.Y <> BottomRight.Y bzw. TopLeft.X <> BottomRight.X (je nach Verlaufsrichtung) ist.
FinnO - Do 04.06.09 16:27
gemacht...
Torsten Richter - Mi 16.12.09 13:01
Hallo Finn Ole,
nette Idee! (wenn man dezente Farben benutzt)
ich habe mal folgendes in Form1.FormPaint und Form.Resize gemacht :
DrawGradientTC(Form1.Canvas,clLime,clRed,Point(0,0),Point(Form1.Width ,Form1.Height ),gmHorizontal);
gruss
Torsten
FinnO - Mi 16.12.09 15:23
Was ist daran jetzt dezent? :???:
Bergmann89 - Mi 16.12.09 15:58
Hey,
gute Arbeit. Wenn du noch Lust hast das Ganze etwas zu verbessern, könntest du n RichtungsVector übergeben lassen, der angibt in welche Richtung der Farbverlauf gehen soll...
MfG Bergmann.
Milchbubi - Sa 09.10.10 20:54
Gute Arbeit!!!
Ich habe es so gemacht:
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
| DrawGradientTC(Form1.Canvas,
ColorDialog1.Color,
ColorDialog2.Color,
Point(0,0),
Point(Form1.ClientWidth,Form1.ClientHeight),
gmVertical); |
und bin zu dem Schluss gekommen dass die For - Schleifen bei Null anfangen müssen damit kein grauer Streifen am Rand bleibt.
FinnO - Sa 09.10.10 21:14
jop.
BenBE - Sa 09.10.10 22:04
Wenn Du DivMod verwendest, kannst Du auf die Gleitkomma-Arithmetik verzichten und hast trotzdem akkurate Farben.
Jakob_Ullmann - Mo 11.10.10 14:33
Wie wäre es damit noch als Ergänzung für einen radialen Farbverlauf:
Delphi-Quelltext
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:
| function DrawGradientRadialTC(Canvas: TCanvas; Col1, Col2: TColor; TopLeft,
BottomRight, Center: TPoint; Size: Integer): Boolean;
var
Steps, X, Y : Integer;
dist : Double;
r,g,b : Byte;
begin
Result := False;
if (not Assigned(Canvas)) or (not (BottomRight.X > TopLeft.X)
and not(BottomRight.Y > TopLeft.Y)) then
Exit;
for x := TopLeft.X to BottomRight.X do
for y := TopLeft.Y to BottomRight.Y do
begin
dist := Min(Sqrt(Sqr(X - Center.X) + Sqr(Y - Center.Y)), Size);
r := Trunc(GetRValue(Col1) + (dist / Size) *
(GetRValue(Col2) - GetRValue(Col1)) );
g := Trunc(GetGValue(Col1) + (dist / Size) *
(GetGValue(Col2) - GetGValue(Col1)) );
b := Trunc(GetBValue(Col1) + (dist / Size) *
(GetBValue(Col2) - GetBValue(Col1)) );
Canvas.Pixels[X, Y] := RGB(r, g, b); end;
Result := True;
end; |
Delphi-Quelltext
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:
| function DrawGradientRadial2TC(Canvas: TCanvas; Col1, Col2, Col3, Col4, Col5: TColor;
TopLeft, BottomRight, Center: TPoint; Size: Integer):
Boolean;
var
Steps, X, Y : Integer;
deg, a, Size: Double; r,g,b : Byte;
begin
Result := False;
if (not Assigned(Canvas)) or (not (BottomRight.X > TopLeft.X) and
not(BottomRight.Y > TopLeft.Y)) then
Exit;
for x := TopLeft.X to BottomRight.X do
for y := TopLeft.Y to BottomRight.Y do
begin
Size := Sqrt(Sqr(X - Center.X) + Sqr(Y -Center.Y));
deg := ArcSin(Trunc((X - Center.X) / Size));
if (X = Center.X) and (Y > Center.Y) then
deg := Pi; if deg <= 2/5*Pi then
begin
a := (deg) / (2/5*Pi);
r := Trunc(GetRValue(Col1) + a *
(GetRValue(Col2) - GetRValue(Col1)) );
g := Trunc(GetGValue(Col1) + a *
(GetGValue(Col2) - GetGValue(Col1)) );
b := Trunc(GetBValue(Col1) + a *
(GetBValue(Col2) - GetBValue(Col1)) );
Canvas.Pixels[X, Y] := RGB(r, g, b); end
else if deg <= 4/5*Pi then
begin
a := (deg - 2/5*Pi) / (2/5*Pi);
r := Trunc(GetRValue(Col2) + a *
(GetRValue(Col3) - GetRValue(Col2)) );
g := Trunc(GetGValue(Col2) + a *
(GetGValue(Col3) - GetGValue(Col2)) );
b := Trunc(GetBValue(Col2) + a *
(GetBValue(Col3) - GetBValue(Col2)) );
Canvas.Pixels[X, Y] := RGB(r, g, b); end
else if deg <= 6/5*Pi then
begin
a := (deg - 4/5*Pi) / (2/5*Pi);
r := Trunc(GetRValue(Col3) + a *
(GetRValue(Col4) - GetRValue(Col3)) );
g := Trunc(GetGValue(Col3) + a *
(GetGValue(Col4) - GetGValue(Col3)) );
b := Trunc(GetBValue(Col3) + a *
(GetBValue(Col4) - GetBValue(Col3)) );
Canvas.Pixels[X, Y] := RGB(r, g, b); end
else if deg <= 8/5*Pi then
begin
a := (deg - 6/5*Pi) / (2/5*Pi);
r := Trunc(GetRValue(Col4) + a *
(GetRValue(Col5) - GetRValue(Col4)) );
g := Trunc(GetGValue(Col4) + a *
(GetGValue(Col5) - GetGValue(Col4)) );
b := Trunc(GetBValue(Col4) + a *
(GetBValue(Col5) - GetBValue(Col4)) );
Canvas.Pixels[X, Y] := RGB(r, g, b); end
else if deg <= 2*Pi then begin
a := (deg - 8/5*Pi) / (2/5*Pi);
r := Trunc(GetRValue(Col5) + a *
(GetRValue(Col1) - GetRValue(Col5)) );
g := Trunc(GetGValue(Col5) + a *
(GetGValue(Col1) - GetGValue(Col5)) );
b := Trunc(GetBValue(Col5) + a *
(GetBValue(Col1) - GetBValue(Col5)) );
Canvas.Pixels[X, Y] := RGB(r, g, b); end
end;
Result := True;
end; |
Beides ungetestet, aber sollte so funktionieren.
Den zweiten würde ich mir mal bei Inkscape wünschen.
FinnO - Mo 11.10.10 15:51
Vielen Dank. Habe gerade kein Delphi da, werde das aber bei zeiten Testen.
TC heißt ToCanvas. Eigentlich überflüssig ;)
Vielen Dank nocheinmal!
Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2024 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!