Delphi-PRAXiS
Seite 1 von 4  1 23     Letzte » 

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Multimedia (https://www.delphipraxis.net/16-multimedia/)
-   -   Delphi Color mixer (https://www.delphipraxis.net/165379-color-mixer.html)

WojTec 27. Dez 2011 14:53

Color mixer
 
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 :sad:

WojTec 27. Dez 2011 17:08

Re: Color mixer
 
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 27. Dez 2011 17:29

AW: Color mixer
 
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 27. Dez 2011 19:24

Re: Color mixer
 
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 27. Dez 2011 19:50

AW: Color mixer
 
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 27. Dez 2011 21:37

Re: Color mixer
 
  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 27. Dez 2011 22:19

AW: Color mixer
 
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 28. Dez 2011 06:12

AW: Color mixer
 
Liste der Anhänge anzeigen (Anzahl: 1)
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 28. Dez 2011 08:41

AW: Color mixer
 
Die Sache mit dem
Delphi-Quellcode:
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 28. Dez 2011 08:59

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


Alle Zeitangaben in WEZ +1. Es ist jetzt 02:54 Uhr.
Seite 1 von 4  1 23     Letzte » 

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz