 Mirror

Calculate a TColor between two other TColors (Views: 102)

 Problem/Question/Abstract:I needed a function that calculates a TColor-Value between two others from an Extended. This Extended should be limited from two other Extended Variables.Answer:Solve 1:I needed a function that calculates a TColor-Value between two others from an Extended. This Extended should be limited from two other Extended Variables. All Values  of "Pointvalue" less then "von" will return "Startcolor" and all Pointvalues greater than "Bis" gives EndColor back. Ist written with some Inline- Assemblercode. I think maybee its could be usefull for somebody else. function GetColorBetween(StartColor, EndColor: TColor; Pointvalue, Von, Bis:  Extended): TColor;var  F: Extended;  r1, r2, r3, g1, g2, g3, b1, b2, b3: Byte;  function CalcColorBytes(fb1, fb2: Byte): Byte;  begin    result := fb1;    if fb1 < fb2 then      Result := FB1 + Trunc(F * (fb2 - fb1));    if fb1 > fb2 then      Result := FB1 - Trunc(F * (fb1 - fb2));  end;begin  if Pointvalue <= Von then  begin    result := StartColor;    exit;  end;  if Pointvalue >= Bis then  begin    result := EndColor;    exit;  end;  F := (Pointvalue - von) / (Bis - Von);  asm     mov EAX, Startcolor     cmp EAX, EndColor     je @@exit     mov r1, AL     shr EAX,8     mov g1, AL     shr Eax,8     mov b1, AL     mov Eax, Endcolor     mov r2, AL     shr EAX,8     mov g2, AL     shr EAX,8     mov b2, AL     push ebp     mov al, r1     mov dl, r2     call CalcColorBytes     pop ecx     push ebp     Mov r3, al     mov dL, g2     mov al, g1     call CalcColorBytes     pop ecx     push ebp     mov g3, Al     mov dL, B2     mov Al, B1     call CalcColorBytes     pop ecx     mov b3, al     XOR EAX,EAX     mov AL, B3     SHL EAX,8     mov AL, G3     SHL EAX,8     mov AL, R3     @@Exit:     mov @result, eax  end;end;Solve 2://------------------------------------------------------------------------------// Function for getting mixed color from two given colors, with a relative// distance from two colors determined by Position value inside// MinPosition..MaxPosition range// Author: Dmitri Papichev (c) 2001// License type: Freeware//------------------------------------------------------------------------------function GetMixedColor(const StartColor,  EndColor: TColor;  const MinPosition,  Position,  MaxPosition: integer): TColor;var  Fraction: double;  R, G, B,    R0, G0, B0,    R1, G1, B1: byte;begin  {process Position out of range situation}  if (MaxPosition < MinPosition) then  begin    raise Exception.Create      ('GetMixedColor: MaxPosition is less then MinPosition');  end; {if}  {if Position is outside MinPosition..MaxPosition range, the closest boundary   is effectively substituted through the adjustment of Fraction}  Fraction :=    Min(1, Max(0, (Position - MinPosition) / (MaxPosition - MinPosition)));  {extract the intensity values}  R0 := GetRValue(StartColor);  G0 := GetGValue(StartColor);  B0 := GetBValue(StartColor);  R1 := GetRValue(EndColor);  G1 := GetGValue(EndColor);  B1 := GetBValue(EndColor);  {calculate the resulting intensity values}  R := R0 + Round((R1 - R0) * Fraction);  G := G0 + Round((G1 - G0) * Fraction);  B := B0 + Round((B1 - B0) * Fraction);  {combine intensities in a resulting color}  Result := RGB(R, G, B);end; {--GetMixedColor--}

<< Back to main page