Farbkreis zeichnen

[fkerber]

kalmi01 Stellt hier eine Möglichkeit vor, einen Farbkreis zu zeichen:

Delphi-Quellcode:

uses ..., Math, ...

[...]

procedure DrawColorCircle(const Size, HueLevel, SaturationLevel, ValueLevel : integer;
                                              const BackgroundColor : TColor;
                                              var BMP : TBitmap);
type
  TRGBTripleArray = array[0..32768] of TRGBTriple;
  pRGBTripleArray = ^TRGBTripleArray; // Pointer auf TRGBTripleArray

      function RGBtoRGBTriple(const red, green, blue : byte) :  TRGBTriple;
        begin
          with Result do 
            begin
               rgbtRed   := red;
               rgbtGreen := green;
               rgbtBlue  := blue
            end;
        end;

      function HSVtoRGBTriple (const H, S, V : integer ) : TRGBTriple;
        const
          divisor : integer = 255*60;
        var
          f, hTemp, p, q, t, VS :  integer;
        begin
          if (S = 0) then 
            Result := RGBtoRGBTriple(V, V, V)      // achromatic:  shades of gray
          else 
            begin                                  // chromatic color
              if (H = 360) then 
                hTemp := 0
              else 
                hTemp := H;

              f     := hTemp mod 60;               // f is IN [0, 59]
              hTemp := hTemp div 60;               // h is now IN [0,6)

              VS := V*S;
              p := V - VS div 255;                 // p = v * (1 - s)
              q := V - (VS*f) div divisor;         // q = v * (1 - s*f)
              t := V - (VS*(60 - f)) div divisor;  // t = v * (1 - s * (1 - f))

              case hTemp of
                0: Result := RGBtoRGBTriple(V, t, p);
                1: Result := RGBtoRGBTriple(q, V, p);
                2: Result := RGBtoRGBTriple(p, V, t);
                3: Result := RGBtoRGBTriple(p, q, V);
                4: Result := RGBtoRGBTriple(t, p, V);
                5: Result := RGBtoRGBTriple(V, p, q);
                else Result := RGBtoRGBTriple(0, 0, 0);
              end;
            end;
        end;

      var
        dSquared, H, S, V, i, j, Radius, RadiusSquared, X, Y : integer;
        row  : pRGBTripleArray;
      begin
        BMP.PixelFormat := pf24bit;
        BMP.Width       := Size;
        BMP.Height      := Size;

        // Fill with background color
        BMP.Canvas.Brush.Color := BackGroundColor;
        BMP.Canvas.FillRect(bmp.Canvas.ClipRect);

        Radius := size div 2;
        RadiusSquared := Radius*Radius;

        V := ValueLevel;
        for j := 0 to bmp.Height-1 do
         begin
           Y   := Size - 1 - j - Radius;  {Center is Radius offset}
           row := BMP.Scanline[Size - 1 - j];

           for i := 0 to BMP.Width - 1 do
             begin
               X        := i - Radius;
               dSquared := (X * X) + (Y * Y);

               if  dSquared <= RadiusSquared then
                 begin
                   S := Round((255 * Sqrt(dSquared)) / Radius);
                   H := Round(180 * (1 + ArcTan2(X, Y) / PI));   // 0..360 degrees

                   // Shift 90 degrees so H=0 (red) occurs along "X" axis
                   H := H + 90;
                   if (H > 360)  then H := H - 360;

                   row[i] := HSVtoRGBTriple(H, S, V);
                 end;
              end;
           end;
      end;

Ein Aufruf könnte so aussehen:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var test: TBitmap;
begin
        test:=TBitmap.create;
        DrawColorCircle(500,0,500,250,clwhite,test);
        Form1.Canvas.Draw(0,0,test);
end;

Ciao, Frederic