10 puanlık uzman sorusu, renk skalası oluşturmak

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
Cevapla
ertank
Kıdemli Üye
Mesajlar: 1650
Kayıt: 12 Eyl 2015 12:45

Re: 10 puanlık uzman sorusu, renk skalası oluşturmak

Mesaj gönderen ertank »

Merhaba,

Aşağıdaki kodu kullanabilirsiniz.

Kod: Tümünü seç

function GetColorBetween(StartColor, EndColor: TColor; PointValue, RangeStart, RangeEnd : Extended): TColor;
var
  F: Extended;
  r1: Byte;
  r2: Byte;
  r3: Byte;
  g1: Byte;
  g2: Byte;
  g3: Byte;
  b1: Byte;
  b2: Byte;
  b3: Byte;

    function CalcColorBytes(const 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 <= RangeStart then begin
    Result := StartColor;
    Exit();
  end;
  if PointValue >= RangeEnd then begin
    Result := EndColor;
    Exit();
  end;

  F := (PointValue - RangeStart) / (RangeEnd - RangeStart);
  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;
Kullanımı şöyle olacaktır:

Kod: Tümünü seç

  Label1.Color := GetColorBetween(clWhite, clMaroon, 1,    1, 1500);
  Label2.Color := GetColorBetween(clWhite, clMaroon, 5,    1, 1500);
  Label3.Color := GetColorBetween(clWhite, clMaroon, 600,  1, 1500);
  Label4.Color := GetColorBetween(clWhite, clMaroon, 300,  1, 1500);
  Label5.Color := GetColorBetween(clWhite, clMaroon, 1500, 1, 1500);
Örnek uygulama ektedir.
Dosya ekleri
gradientcolor.rar
(1.56 KiB) 45 kere indirildi
ertank
Kıdemli Üye
Mesajlar: 1650
Kayıt: 12 Eyl 2015 12:45

Re: 10 puanlık uzman sorusu, renk skalası oluşturmak

Mesaj gönderen ertank »

Her iki formül için örnek fonksiyon çağırma değerleri ile kullandığınız parametreleri paylaşabilir misiniz?
ertank
Kıdemli Üye
Mesajlar: 1650
Kayıt: 12 Eyl 2015 12:45

Re: 10 puanlık uzman sorusu, renk skalası oluşturmak

Mesaj gönderen ertank »

Değişken değerlerini de bildirebilir misiniz? Round() sonucu koda bakarak anlaşılamıyor.
ertank
Kıdemli Üye
Mesajlar: 1650
Kayıt: 12 Eyl 2015 12:45

Re: 10 puanlık uzman sorusu, renk skalası oluşturmak

Mesaj gönderen ertank »

Bu durumda ColorBetween() size %600 oranında bir değer hesaplamaya çalışacaktır. Sonuç olarak maviye yakın bir renk çıkarıyor ortaya. Formül oran parametre değerlerinin 600 olduğuna emin misiniz?
ertank
Kıdemli Üye
Mesajlar: 1650
Kayıt: 12 Eyl 2015 12:45

Re: 10 puanlık uzman sorusu, renk skalası oluşturmak

Mesaj gönderen ertank »

Benim testlerime göre her iki fonksiyon da aynı renk değerini hesaplıyor. Test kodu aşağıdaki gibi:

Kod: Tümünü seç

  Label1.Color := GetColorBetween(clCream, $FF993404, 150,    1, 600);
  Label2.Color := ColorBetween(clCream, $FF993404, Trunc(150 / 600 * 100));
Debug modunda Label1.Color ve Label2.Color değerleri aynı ve 14404289 oluyor.

Bununla birlikte sizin tercih ettiğiniz ikinci fonksiyon parametre değer kontrolü yapmadığı için hatalı parametre verildiği zaman "iki renk arası" değil belirtilmemiş başka bir renk değeri oluşturuyor.

Sanırım daha önce benim verdiğim fonksiyon parametreleri ile ilgili farklı bir kullanım olmuş ki tercih ettiğiniz ikinci fonksiyon kullanımı sizin için daha mantıklı renkler renkler oluşmuş.
Cevapla