Color mixer

[WojTec]

I'm trying implement this tool:

Code:

http://www.design-lib.com/color_tool_mixer.php

I already have this:

Delphi-Quellcode:

type
  TColorArray = array of TColor;

function GetColors(const C1, C2: TColor; Steps: Byte): TColorArray;

function Blend(Color1, Color2: TColor; A: Byte): TColor;  // by R. M. Klever
var
  c1, c2: LongInt;
  r, g, b, v1, v2: byte;
begin
  A:= Round(2.55 * A);
  c1 := ColorToRGB(Color1);
  c2 := ColorToRGB(Color2);
  v1:= Byte(c1);
  v2:= Byte(c2);
  r:= A * (v1 - v2) shr 8 + v2;
  v1:= Byte(c1 shr 8);
  v2:= Byte(c2 shr 8);
  g:= A * (v1 - v2) shr 8 + v2;
  v1:= Byte(c1 shr 16);
  v2:= Byte(c2 shr 16);
  b:= A * (v1 - v2) shr 8 + v2;
  Result := (b shl 16) + (g shl 8) + r;
end;

var
  V, T: Byte;
begin
  SetLength(Result, 0);

  V := 100 div (Steps + 1);
  T := 0;

  while T < 100 do
  begin
    Inc(T, V);

    SetLength(Result, Length(Result) + 1);
    Result[High(Result)] := Blend(C1, C2, T);
  end;
end;

I don't know, don't want to working as expected, F1

[WojTec]

Delphi-Quellcode:

var
  V, T: Byte;
begin
  SetLength(Result, 0);

  V := 100 div (EnsureRange(ASteps, 1, 64) + 1);
  T := V;

  while (T < 100) and (100 - T >= V) do
  begin
    SetLength(Result, Length(Result) + 1);
    Result[High(Result)] := BlendColors(AColor1, AColor2, T);

    Inc(T, V);
  end;
end;

F1

[jaenicke]

Unfortunately you forgot to tell us what does happen instead of what should have happened.

And I do not know where you use this function and how you use this function.

[WojTec]

Did you saw link above? So, generaly thera are 2 colors on input and on output I want to array with n colors between input colors - it mean not full gradient, but just n colors.

[jaenicke]

I understood what you want to do but I have no idea what your problem is. Does the code result in a wrong display? Or do you have a problem when you try to use the code? At the moment I am not at home, I will continue there...

[WojTec]

1. It returns different colors than above script.
2. When steps > 15 then returns more colors than I want (in other words for steps 1-15 array has 1-15 colors, for more steps array hase more colors than should contain, eg for 16 it contains 19 colors or for 64 --> 99).

Maybe my idea is good but imprecise?

[freeway]

for 100 div (64 + 1) = 1 so you get 100 steps also 100 div (16 +1) = 5 you get 20 steps

Delphi-Quellcode:

 
var V,T : single;
    S : byte;

  V := 100 / (Steps + 1);
  T := 0;

  while T < 100 do
  begin
    T := T + V;     //add real
    S := trunc(T);  //get byte
    SetLength(Result, Length(Result) + 1);
    Result[High(Result)] := Blend(C1, C2, S);
  end;
end;

[Aphton]

Delphi-Quellcode:

uses Math;
(...)
function GetColors(const C1, C2: TColor; Steps: Byte): TColorArray;

function Blend(const Color1, Color2: TColor; const A: Byte): TColor; // by Aphton
var
  dA  : Single;
  c1  : Array[0..3] of Byte Absolute Color1;
  c2  : Array[0..3] of Byte Absolute Color2;
  rs  : Array[0..3] of Byte Absolute Result;
begin
  dA    := A/100;
  rs[0] := Round(c1[0] + (c2[0] - c1[0]) * dA);
  rs[1] := Round(c1[1] + (c2[1] - c1[1]) * dA);
  rs[2] := Round(c1[2] + (c2[2] - c1[2]) * dA);   
  rs[3] := 0;
end;

var
  i: Integer;
  V, T: Byte;
begin
  if Steps < 3 then Exit;

  SetLength(Result, Steps);
  dec(Steps);

  Result[0] := C1;
  Result[Steps] := C2;

  V := 100 div Steps;
  T := 0;

  for i := 1 to Steps - 1 do
  begin
    inc(T, V);
    Result[i] := Blend(C1, C2, Min(T, 100));
  end;
end;

10 Steps on color_tool_mixer.php = 12 with GetColors() (including Color1 and Color2)
Results in...

[Furtbichler]

Die Sache mit dem V := 100 div Steps; ist unglücklich und führt zu ungenauen Ergebnissen.

Wieso nicht einfach eine Mischroutine schreiben, die einen Float-Wert als Mischungsverhältnis akzeptiert (also einfach die von Aphton leicht umschreiben).

Delphi-Quellcode:

function Blend(const Color1, Color2: TColor; const MixRatio: Double): TColor; // by Aphton
var
   c1 : Array[0..3] of Byte Absolute Color1;
   c2 : Array[0..3] of Byte Absolute Color2;
   rs : Array[0..3] of Byte Absolute Result;
begin
   rs[0] := Round(c1[0] + (c2[0] - c1[0]) * MixRatio);
   rs[1] := Round(c1[1] + (c2[1] - c1[1]) * MixRatio);
   rs[2] := Round(c1[2] + (c2[2] - c1[2]) * MixRatio); 
   rs[3] := 0;
end;
...

Delta := 1/Steps;
MixRatio := 0;
For i:=0 To Steps-1 do begin
  ColorArray[i] := MixColors(Color1, color2, MixRatio);
  MixRatio := MixRatio + Delta
End;

Wer komplett auf Floatingpointarithmetik verzichten will, kann es so probieren

Delphi-Quellcode:

function Blend(const Color1, Color2: TColor; const MixColor1, MixColor2 : Integer): TColor; // by Aphton
// Mische zwei Farben im Verhältnis MixColor1:MixColor2
var
   c1 : Array[0..3] of Byte Absolute Color1;
   c2 : Array[0..3] of Byte Absolute Color2;
   rs : Array[0..3] of Byte Absolute Result;
   MixColors : Integer;

begin
   MixColors := MixColor1 + MixColor2;
   rs[0] := Min(255, (c1[0]*MixColor1 + c2[0]*MixColor2) div  MixColors);
   rs[1] := Min(255, (c1[0]*MixColor1 + c2[0]*MixColor2) div  MixColors);
   rs[2] := Min(255, (c1[0]*MixColor1 + c2[0]*MixColor2) div  MixColors);
   rs[3] := 0;
end;

...
For i:=1 To Steps-1 do 
  ColorArray[i] := MixColors(Color1, color2, i, Steps - i - 1);

Die Integer-Variante könnte marginal andere Ergebnisse liefern (sofern sie denn funktioniert).

[Aphton]

Ja stimmt, so ist es eig. besser.
Ich habs ja auch nur schnell hingeschrieben, nicht groß überlegt, sry xD