Farbverlauf erstellen

FinnO · Verfasst: Do 04.06.09 14:37

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!

markieren

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:

markieren

Delphi-Quelltext

1:
2:

  DrawGradientTC(Paintbox1.Canvas,clLime,clRed,Point(0,0),Point(100,100),gmVertical); // senkrecht
  DrawGradientTC(Paintbox1.Canvas,clLime,clRed,Point(0,100),Point(100,200),gmHorizontal); // Horizontal

Ehemaliges Mitglied Erhaltene Danke: 1

Du solltest noch sicherstellen, dass TopLeft.Y <> BottomRight.Y bzw. TopLeft.X <> BottomRight.X (je nach Verlaufsrichtung) ist.

FinnO · Verfasst: Do 04.06.09 15:27

gemacht...

Torsten Richter · Hält's aus hier Beiträge: 11

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 · Verfasst: Mi 16.12.09 14:23

Was ist daran jetzt dezent? :???:

Bergmann89 · Verfasst: Mi 16.12.09 14: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.

_________________
Ich weiß nicht viel, lern aber dafür umso schneller^^

Milchbubi · Verfasst: Sa 09.10.10 19:54

Gute Arbeit!!!

Ich habe es so gemacht:

markieren

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 · Verfasst: Sa 09.10.10 20:14

jop.

BenBE · Verfasst: Sa 09.10.10 21:04

Wenn Du DivMod verwendest, kannst Du auf die Gleitkomma-Arithmetik verzichten und hast trotzdem akkurate Farben.

_________________

Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.

Jakob_Ullmann · Verfasst: Mo 11.10.10 13:33

Wie wäre es damit noch als Ergänzung für einen radialen Farbverlauf:

markieren

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;
// Was heißt eigentlich TC???
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); // ToDo: Scanline -> Performance
      end;

  Result := True;
end;

markieren

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:

// fünf Eckpunkte (vgl. eine CD gegen das Licht gehalten)
function DrawGradientRadial2TC(Canvas: TCanvas; Col1, Col2, Col3, Col4, Col5: TColor;
                              TopLeft, BottomRight, Center: TPoint; Size: Integer):
                                Boolean;
// Was heißt eigentlich TC???
var
  Steps, X, Y : Integer;
  deg, a, Size: Double;  // Winkel
  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
        // Winkel im Bogenmaß ermitteln -> arcsin
        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; // 180°; ArcSin() hätte 0° geliefert
        // Fall 1 : Col1 -> Col2
        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); // ToDo: Scanline -> Performance
        end
        // Fall 2 : Col2 -> Col3
        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); // ToDo: Scanline -> Performance
        end
        // Fall 3 : Col3 -> Col4
        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); // ToDo: Scanline -> Performance
        end
        // Fall 4 : Col4 -> Col5
        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); // ToDo: Scanline -> Performance
        end
        // Fall 5 : Col5 -> Col1
        else if deg <= 2*Pi then // 10/5*Pi
        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); // ToDo: Scanline -> Performance
        end
      end;

  Result := True;
end;

Beides ungetestet, aber sollte so funktionieren.

Den zweiten würde ich mir mal bei Inkscape wünschen.

FinnO · Verfasst: Mo 11.10.10 14:51

Vielen Dank. Habe gerade kein Delphi da, werde das aber bei zeiten Testen.

TC heißt ToCanvas. Eigentlich überflüssig

Vielen Dank nocheinmal!

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme