Форум: "Начинающим";
Текущий архив: 2006.12.24;
Скачать: [xml.tar.bz2];

Вниз

RGB CMY Палитра GetRValue и тд...   Найти похожие ветки 

← →
Vladimir1984   (2006-12-05 21:18) [0]

Не могу подобрать цвета чтобы переход был плавным:
Самый слабый - Красный
Слабый - Желтый
слабый средний - Зеленый
Сильный средний - Голубой
Сильный  - Синий
Самый Сильный - Магнетта

procedure TfrmPulsar3D.bmp1Click(Sender: TObject);
var
 i,j,k:Integer;
begin
 try
   if OpenPictureDialog1.Execute then
     if FileExists(OpenPictureDialog1.FileName) then
     begin
       bmp.Width:=0;
       bmp.Height:=0;
       bmp.LoadFromFile(OpenPictureDialog1.FileName);
       w:=bmp.Width;
       h:=bmp.Height;
       SetLength(vx,w);
       SetLength(nx,w);
       SetLength(cx,w);
       for i:=0 to w-1 do
       begin
         SetLength(vx[i],h);
         SetLength(nx[i],h);
         SetLength(cx[i],h);
       end;
       for i:=0 to w-1 do
         for j:=0 to h-1 do
       // Âûäåëÿåò çíà÷åíèå èíòåíñèâíîñòè èç çíà÷åíèÿ öâåòà RGB è CMY
       // ãäå R - Êðàñíûé, G - Çåëåíûé, B - Ñèíèé()
       //Ñ -  Cyan, M - Ìàãíåòòà, Y - Æåëòûé
         begin
           vx[i,j]:=(100+0.1*GetRValue(bmp.Canvas.Pixels[i,j])+1*
           GetGValue(bmp.Canvas.Pixels[i,j+1])+1*
           GetBValue(bmp.Canvas.Pixels[i,j])+
           GetCValue(bmp.Canvas.Pixels[i,j])-
           GetMValue(bmp.Canvas.Pixels[i,j])+0.32*
           GetYValue(bmp.Canvas.Pixels[i,j])

                     )/3/10;
           cx[i,j,1]:=GetRValue(bmp.Canvas.Pixels[i,j])/255;
           cx[i,j,2]:=GetGValue(bmp.Canvas.Pixels[i,j])/255;
           cx[i,j,3]:=GetBValue(bmp.Canvas.Pixels[i,j])/255;
         end;
       for i:=0 to w-1 do
         for j:=0 to h-1 do
           for k:=1 to 3 do
             nx[i,j,k]:=1;
       for i:=0 to w-2 do
         for j:=0 to h-2 do
           CalcNormals(i,vx[i,j],j,
                       i+1,vx[i+1,j],j,
                       i+1,vx[i+1,j+1],j+1,
                       nx[i,j,1],nx[i,j,2],nx[i,j,3]);
     end else
       MessageBox(Handle,
                  PAnsiChar("Ôàéë "+OpenPictureDialog1.FileName+" íå íàéäåí"),
                  "Îøèáêà",MB_OK or MB_ICONERROR);
 except
   MessageBox(Handle,
              PAnsiChar("Îøèáêà âî âðåìÿ çàãðóçêè ôàéëà "+
                OpenPictureDialog1.FileName),
              "Îøèáêà",MB_OK or MB_ICONERROR);
 end;

end;

---

← →
Vovan#2   (2006-12-05 21:42) [1]

Э-э, разбираюсь в вопросе. Просто заметил:


      SetLength(vx,w);
      SetLength(nx,w);
      SetLength(cx,w);
      for i:=0 to w-1 do
      begin
        SetLength(vx[i],h);
        SetLength(nx[i],h);
        SetLength(cx[i],h);
      end;


Можно проще:


      SetLength(vx, w, h);
      SetLength(nx, w, h);
      SetLength(cx, w, h);


И так и задумывалось?

---

← →
Vladimir1984   (2006-12-05 22:02) [2]

Спасибо, сократилб,поправил =)

изначально было вот так:        
      "vx[i,j]:=(GetRValue(bmp.Canvas.Pixels[i,j])+
          GetGValue(bmp.Canvas.Pixels[i,j+1])+
          GetBValue(bmp.Canvas.Pixels[i,j]))/3/12;"
Остальное не менял...
Уже целый день мучаюсь подобрать не могу ) Если вам поможет, то могу закинуть исходничек...

---

← →
Vladimir1984   (2006-12-05 22:03) [3]

Я имею ввиду поможет мне помочь =)

---

← →
Vovan#2   (2006-12-05 23:29) [4]

Да, закинь.

---

← →
Zeqfreed ©   (2006-12-06 00:00) [5]

Зачем тут CMYK? В модели HSL цвета идут именно в том порядке, который требуется. Формулы перевода есть в википедии (http://en.wikipedia.org/wiki/HSL_color_space). Чтобы получить плавный переход от одного цвета к другому, достаточно изменять H-координату цвета.

---

← →
Zeqfreed ©   (2006-12-06 00:12) [6]

Если такой результат устроит: http://zeespot.net.ru/images/hsl.png, то могу дать исходник :)

---

← →
Vladimir1984   (2006-12-06 00:22) [7]

Закинул...
http://slil.ru/23523666

---

← →
Vladimir1984   (2006-12-06 00:25) [8]

Zeqfreed
Незнаю, дайте исходник посмотрю )

---

← →
Zeqfreed ©   (2006-12-06 00:38) [9]

> Незнаю, дайте исходник посмотрю )

Что значит не знаю? :) Скриншот видно? То, что на ем нарисовано, хотябы отдаленно напоминает то, как вы себе это представляли? :)

Ладно, код прилагается:

unit main;

interface

uses

 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

 Dialogs, StdCtrls, ExtCtrls, Math;

type

 TRGB = record

  B, G, R : Byte;

 end;

 PARGB = ^ARGB;

 ARGB = array [0..1] of TRGB;

 TForm1 = class(TForm)

   ColorDialog1: TColorDialog;

   Button1: TButton;

   Image1: TImage;

   Button2: TButton;

   procedure Button1Click(Sender: TObject);

 private

   { Private declarations }

 public

   { Public declarations }

 end;

var

 Form1: TForm1;

implementation

{$R *.dfm}

function HSLToRGB(H, S, L : Single) : TRGB; overload;

 function Hue2RGB(v1, v2, vH : Single) : Single;

 begin

  if (vH < 0) then vH := vH + 1;

  if (vH > 1) then vH := vH - 1;

  if ((6 * vH) < 1) then

   Result := (v1 + (v2 - v1) * 6 * vH)

  else if ((2 * vH) < 1) then

   Result := v2

  else if ((3 * vH) < 2) then

   Result := (v1 + (v2 - v1) * ((2 / 3) - vH) * 6)

  else

   Result := v1;

 end;

var

 v1, v2 : Single;

begin

 if (S = 0) then begin

  Result.R := Trunc(L * 255);

  Result.G := Trunc(L * 255);

  Result.B := Trunc(L * 255);

 end else begin

  if (L < 0.5) then

   v2 := L * (1 + S)

  else

   v2 := (L + S) - (S * L);

  v1 := 2 * L - v2;

  Result.R := Trunc(255 * Hue2RGB(v1, v2, H + (1 / 3)));

  Result.G := Trunc(255 * Hue2RGB(v1, v2, H));

  Result.B := Trunc(255 * Hue2RGB(v1, v2, H - (1/3)));

 end;

end;

function HSLToRGB(H : Integer; S, L : Single) : TRGB; overload;

type

 TRGB = record

  R, G, B : Single;

 end;

var

 c2, sat, ctmp : TRGB;

begin

 while (H < 0) do H := H + 360;

 while (H > 360) do H := H - 360;

 if (H < 120) then begin

  sat.R := (120 - H) / 60.0;

  sat.G := H / 60.0;

  sat.B := 0;

 end else if (H < 240) then begin

  sat.R := 0;

  sat.G := (240 - H) / 60.0;

  sat.B := (H - 120) / 60.0;

 end else begin

  sat.R := (H - 240) / 60.0;

  sat.G := 0;

  sat.B := (360 - H) / 60.0;

 end;

 sat.R := Min(sat.r, 1);

 sat.G := Min(sat.g, 1);

 sat.B := Min(sat.b, 1);

 ctmp.R := 2 * S * sat.R + (1 - S);

 ctmp.G := 2 * S * sat.G + (1 - S);

 ctmp.B := 2 * S * sat.B + (1 - S);

 if (L < 0.5) then begin

  c2.R := L * ctmp.R;

  c2.G := L * ctmp.G;

  c2.B := L * ctmp.B;

 end else begin

  c2.R := (1 - L) * ctmp.R + 2 * L - 1;

  c2.G := (1 - L) * ctmp.G + 2 * L - 1;

  c2.B := (1 - L) * ctmp.B + 2 * L - 1;

 end;

 Result.R := Trunc(c2.R * 255);

 Result.G := Trunc(c2.G * 255);

 Result.B := Trunc(c2.B * 255);

end;

procedure DrawColorSquare(Dest : TBitmap; Width, Height : Integer; Lightness : Single);

var

 i, j : Integer;

 s, l : Single;

 p : PARGB;

begin

 l := Lightness;

 for j := 0 to Height - 1 do begin

  s := (Height-j) / Height;

  p := Dest.ScanLine[j];

  for i := 0 to Width - 1 do begin

   p[i] := HSLToRGB(i / Width, s, l); //p[i] := HSLToRGB(Trunc((i*360) / Width), s, l);

  end;

 end;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

 tmp : TBitmap;

begin

 tmp := TBitmap.Create();

 try

  tmp.PixelFormat := pf24bit;

  tmp.Width := Image1.Width;

  tmp.Height := Image1.Height;

  DrawColorSquare(tmp, tmp.Width, tmp.Height, 0.5);

  Image1.Canvas.Draw(0, 0, tmp);

 finally

  tmp.Free;

 end;

end;

end.



---

← →
Vladimir1984   (2006-12-06 00:53) [10]

Да на скриншоте сама Радуга  выглядит почти как надо )
Я просто начинающий программер, все долго доходит...Ну что поделать новичек...

---

← →
Zeqfreed ©   (2006-12-06 00:57) [11]

Ой, извиняюсь за пустые строки в коде.
Даже не знаю кого в них винить: xclip, mousepad, firefox или сайт :)
В следующий раз буду в pastebin тогда вставлять код, раз тут такие дела..

---

← →
vidiv ©   (2006-12-06 05:04) [12]

> Zeqfreed ©   (06.12.06 00:12) [6]
> Если такой результат устроит: http://zeespot.net.ru/images/hsl.
> png, то могу дать исходник :)

это где вообще?

---

← →
vidiv ©   (2006-12-06 05:50) [13]

procedure TForm1.Button1Click(Sender: TObject);
const RealWidth = 256*6;
     RealHeight = 256;
const ViewWidth = 500;
     ViewHeight = 300;
var X, Y, S, Phase:Integer;
var BMP:TBitmap;
   PLine:PIntegerArray;
begin
   BMP := TBitmap.Create;
   BMP.Width := ViewWidth;
   BMP.Height := ViewHeight;
   BMP.PixelFormat := pf32bit;

   for y:=0 to pred(ViewHeight) do begin
       PLine := BMP.ScanLine[y];
       for x:=0 to pred(ViewWidth) do begin
           Phase := x*RealWidth div ViewWidth;
           S := Phase mod 256;
           case Phase of
           0..255:    PLine^[x] := 255 shl 16 + S shl 8 + 0;
           256..511:  PLine^[x] := (255 - S) shl 16 + 255 shl 8 + 0;
           512..767: PLine^[x] := 0 shl 16 + 255 shl 8 + S;
           768..1023: PLine^[x] := 0 shl 16 + (255 - S) shl 8 + 255;
           1024..1279: PLine^[x] := S shl 16 + 0 shl 8 + 255;
           1280..1535: PLine^[x] := 255 shl 16 + 0 shl 8 + (255-S);
           else
               PLine^[x] := 0;
           end;
           for S :=0 to 2 do
               PByte(Integer(PLine)+X*4+S)^ := (PByte(Integer(PLine)+X*4+S)^ * (ViewHeight - y) + 127 * y) div ViewHeight;
       end;
   end;

   Canvas.Draw(0,0, BMP);
   BMP.Free;
end;

менять надо только ViewWidth и ViewHeight

---

← →
Zeqfreed ©   (2006-12-06 14:14) [14]

> это где вообще?

Ну как, Xubuntu (оконный менеджер - beryl), запущено через wine, естественно :)

---

← →
Vladimir1984   (2006-12-06 16:07) [15]

Я  не особо понял что там происходит, но понял одно. Зависимость высоты от оттенка проиходит тут:

vx[i,j]:=(GetRValue(bmp.Canvas.Pixels[i,j])+
          GetGValue(bmp.Canvas.Pixels[i,j])+
          GetBValue(bmp.Canvas.Pixels[i,j]))/3/10;

В этом случае  та радуга которая мне нужна в виде прямой под углом(от красного к магнетте), строится в виде зигзага...
Вот так -->  http://slil.ru/23526013/1556084683/RGB.jpg

А если немного изменить, например так:

vx[i,j]:=(GetRValue(bmp.Canvas.Pixels[i,j])+
          2*GetGValue(bmp.Canvas.Pixels[i,j])+
          3*GetBValue(bmp.Canvas.Pixels[i,j]))/3/10;

То получится такая картина--> http://slil.ru/23526054/1556084683/R2G3B.jpg

А нужно чтобы была такая:
http://slil.ru/23526112/1556084683/etallone.jpg
2 суток мучаюсь, никак подобрать не могу...

Эта часть в исходнике:

procedure TfrmPulsar3D.bmp1Click(Sender: TObject);
var
i,j,k:Integer;
begin
try
  if OpenPictureDialog1.Execute then
    if FileExists(OpenPictureDialog1.FileName) then
    begin
      bmp.Width:=0;
      bmp.Height:=0;
      bmp.LoadFromFile(OpenPictureDialog1.FileName);
      w:=bmp.Width;
      h:=bmp.Height;
      SetLength(vx,w);
      SetLength(nx,w);
      SetLength(cx,w);
      for i:=0 to w-1 do
      begin
        SetLength(vx[i],h);
        SetLength(nx[i],h);
        SetLength(cx[i],h);
      end;
      for i:=0 to w-1 do
        for j:=0 to h-1 do
      // Âûäåëÿåò çíà÷åíèå èíòåíñèâíîñòè èç çíà÷åíèÿ öâåòà RGB è CMY
      // ãäå R - Êðàñíûé, G - Çåëåíûé, B - Ñèíèé()
      //Ñ -  Cyan, M - Ìàãíåòòà, Y - Æåëòûé
        begin
          vx[i,j]:=(GetRValue(bmp.Canvas.Pixels[i,j])+
          0.5*GetGValue(bmp.Canvas.Pixels[i,j])+
          0.5*GetBValue(bmp.Canvas.Pixels[i,j])-

          1.0001*GetMValue(bmp.Canvas.Pixels[i,j])

                    )/3/10;
          cx[i,j,1]:=GetRValue(bmp.Canvas.Pixels[i,j])/255;
          cx[i,j,2]:=GetGValue(bmp.Canvas.Pixels[i,j])/255;
          cx[i,j,3]:=GetBValue(bmp.Canvas.Pixels[i,j])/255;
        end;
      for i:=0 to w-1 do
        for j:=0 to h-1 do
          for k:=1 to 3 do
            nx[i,j,k]:=1;
      for i:=0 to w-2 do
        for j:=0 to h-2 do
          CalcNormals(i,vx[i,j],j,
                      i+1,vx[i+1,j],j,
                      i+1,vx[i+1,j+1],j+1,
                      nx[i,j,1],nx[i,j,2],nx[i,j,3]);
    end else
      MessageBox(Handle,
                 PAnsiChar("Ôàéë "+OpenPictureDialog1.FileName+" íå íàéäåí"),
                 "Îøèáêà",MB_OK or MB_ICONERROR);
except
  MessageBox(Handle,
             PAnsiChar("Îøèáêà âî âðåìÿ çàãðóçêè ôàéëà "+
               OpenPictureDialog1.FileName),
             "Îøèáêà",MB_OK or MB_ICONERROR);
end;

end;

---

← →
vidiv ©   (2006-12-06 18:15) [16]

Чегото я не понял. Что вообще нужно получить в итоге?

---

← →
Vladimir1984   (2006-12-06 18:19) [17]

Вообще? Постоение поверхности типа карты высот по тем цветам...

---

← →
Vladimir1984   (2006-12-07 02:36) [18]

Ну есть желающие помочь? Кто первый поможет реально(!), с меня 10 бутылок пива, в любой валюте =)

---

← →
Zeqfreed ©   (2006-12-07 11:50) [19]

> Вообще? Постоение поверхности типа карты высот по тем цветам.

Это как? Повторюсь: я бы использовал модель HSL, т.к. она наиболее точно передает цвет так, как его воспринимает человек (в виде таких характеристик как насыщенность, яркость и собственно сам "цвет").

---

← →
Vladimir1984   (2006-12-07 18:35) [20]

Как бы мне в моем случае использвать эту модель? Я в дельфи почти не разбираюсь...но приходится именно на нем и работать...

---

← →
Zeqfreed ©   (2006-12-08 04:29) [21]

Что за случай-то? :)
Задачи пока не видно.

---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2006.12.24;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.53 MB
Время: 0.137 c