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

Вниз

Нужен алгоритм   Найти похожие ветки 

← →
Вова   (2014-02-09 21:12) [0]

Есть такая процедура, она заточена на приведение входящего цвета к фиксированному набору цветов. Никак не могу придумать, как сделать, чтобы можно бы цвета к которым можно приводить можно было заводить в процессе исполнения программы. Т.е. нужна идея механизма, которым можно описать цвет к которому привести исходный цвет, и собственно процедура которая его выполнить.


Function ConvertColorToRGBColorMap(color: LongInt; ColSel: string = "None")
 : TColorWithName;
var
 RGBV: trgbcolor;
 bg: Boolean;
 rb: Boolean;
 rg: Boolean;
 rRGB:TRGB;
begin

 RGBV.red   := color shr 16;;
 RGBV.green := color shr 8;
 RGBV.blue  := color;

 rb := almostEqual(RGBV.red, RGBV.blue);
 bg := almostEqual(RGBV.blue, RGBV.green);
 rg := almostEqual(RGBV.red, RGBV.green);

 with RGBV do

   if rg and rb and bg then // тогда это серый или черный или белый
   begin
     if red > 230 then // белый
     begin
       result.color := RGB2(255, 255, 255);
       result.Name := "White";
     end
     else if red > 120 then
     begin
       result.color := RGB2(190, 190, 190);
       result.Name := "LightGray";
     end
     else if (red > 60) then // темно серый
     begin
       result.color := RGB2(100, 100, 100);
       result.Name := "DarkGray";
     end
     else if red > 10 then //очень темно серый
     begin
        result.color := RGB2(50, 50, 50);
        result.Name  := "VeryDarkGray";
     end
     else
     begin
       result.color := RGB2(0, 0, 0);
       result.Name := "Black";
     end // черный
   end
   else
   begin
     if (red < green) and (red < blue) and bg and (blue > 130) then
     begin
       result.color := RGB2(0, 0, 255);
       result.Name := "Blue";
     end // result:= rgb(0,255,255)//голубой
     else if (green < red) and (green < blue) and rb and (red > 130) then
     begin
       result.color := RGB2(255, 0, 255);
       result.Name := "Pink";
     end // розовый
     else if (blue < green) and (blue < red) and rg and (green > 130) then
     begin
       result.color := RGB2(255, 255, 0);
       result.Name := "Yellow";
     end // желтый
     else if (red > green) and (red > blue) and (red > 130) then
     begin
       result.color := RGB2(255, 0, 0);
       result.Name := "Red";
     end // красный
     else if (blue > green) and (blue > red) and (blue > 130) then
     begin
       result.color := RGB2(0, 0, 255);
       result.Name := "Blue";
     end // синий
     else if (green > blue) and (green > red) and (green > 130) then
     begin
       result.color := RGB2(0, 255, 0);
       result.Name := "Green";
     end // зеленый
     else
     begin
       result.color := RGB2(0, 0, 0);
       result.Name := "Black";
     end
   end;

 if not(ColSel = "None") then
   if (ColSel = result.Name) then
   begin
     result.color := 255; // картинка инвертирована для дальнейшей обработки
   end
   else
   begin
     result.color := 0;
   end;
end;

---

← →
Вова   (2014-02-09 21:16) [1]

вернее не к набору цветов, а к одному из цветов в наборе. из процедуры собственно видно какие примерно цвета бывают и как их можно определить, но вот универсального ничего не придумывается.

---

← →
Jeer ©   (2014-02-09 23:41) [2]

Очередной поток неосознанного сознания.

P.S.
Еще раз попробуй внятно объяснить - что надо и что не получается.

---

← →
настоящий Вова   (2014-02-09 23:59) [3]

Вова, судя по твоей писанине, ты не Вова - ты, наверное, Waldemar. Ты сам понимаешь, о чём спрашиваешь?

---

← →
Вова   (2014-02-10 00:06) [4]

все тут норм ) я написал процедуру, в ней у меня входящий цвет преобразуется в один из описаных в этой процедуре, и по правилам описаным в этой процедуре. Мне же нужно создать универсальный механизм, т.е. чтобы на форме можно было указать параметры и назвать цвет с этими параметрами как либо ну например "Green", далее эти параметры записываются в базу данных и в нужный момент чтобы я мог достать из базы эти параметры и привести к любому цвету из базы переданный цвет.

Пока мне пришло в голову, только тупо взять все что есть в этой процедуре и сделать их параметрами на форме (

т.е. делаем 2 едита - R - начало диапазона, конец диапазона, и также по 2 на G и B. Далее 3 галочки almostEqual, и галочки red > blue и т.п.

ну и еще цвет к которому нужно привести. странная штука получается )

---

← →
Вова   (2014-02-10 00:08) [5]

> Вова, судя по твоей писанине, ты не Вова - ты, наверное,
>  Waldemar. Ты сам понимаешь, о чём спрашиваешь?


украл мой ник и ходит тут.

---

← →
Вова   (2014-02-10 00:09) [6]

Смысл в том, что сейчас чтобы поменять настройки цветов нужно переписывать процедуру, а должно быть, чтобы пользователь сам мог определить любые цвета которые ему нравятся.

---

← →
Вова   (2014-02-10 00:10) [7]

без вмешательства в исходный код программы

---

← →
Вова   (2014-02-10 00:17) [8]

18 галочек типа red > blue  получается (

---

← →
Вова   (2014-02-10 00:18) [9]

нет...12

---

← →
Jeer ©   (2014-02-10 00:29) [10]

Главное - что начал сам с собой говорить, так, что шанс есть.

---

← →
Стенка ©   (2014-02-10 01:25) [11]

Вова + цвет + привести + название + процедура = дежавю

---

← →
Anatoly Podgoretsky ©   (2014-02-10 17:46) [12]

> украл мой ник и ходит тут.

Где доказательство, может вор ты?

---

← →
Вова   (2014-02-10 18:16) [13]

> Где доказательство, может вор ты?


Мои потоки сознания тут уже который год, а такого умного Вовы как тот тут не бывало, он недавно появился.

---

← →
Inovet ©   (2014-02-10 18:27) [14]

> [12] Anatoly Podgoretsky ©   (10.02.14 17:46)
> Где доказательство, может вор ты?

Кто первый зарегится тот и будет настоящий.

---

← →
Вова   (2014-02-11 21:36) [15]

Вот что я изобрел. Но как то вдруг вышло, что эта радость на картинке размером 1980 на 1080 выполняется 29 секунд!!! это блин как? когда процедура в первом посте 300 миллисекунд. Где я не прав?


Function ConvertColorToRGBColorMap(color: LongInt;
 RedFrom, RedTo, GreenFrom, GreenTo, BlueFrom, BlueTo: Byte;
 CheckRb, CheckRg, CheckBg: Boolean; redMoregreen, redLesserGreen, redMoreBlue,
 redLesserBlue, GreenMoreBlue, GreenLesserBlue: Boolean;
 rezR, RezG, RezB: Byte): COLORREF;
var
 RGBV: trgbcolor;
 bg: Boolean;
 rb: Boolean;
 rg: Boolean;
 rRGB: TRGB;
begin
 // result.color := RGB2(255,255 , 0);
 // exit;
 // rrgb.RGB := color;
 // RGBV.red := rrgb.R;
 // RGBV.green := rrgb.G;
 // RGBV.blue := rrgb.B;

 RGBV.red   := color shr 16;
 RGBV.green := color shr 8;
 RGBV.blue  := color;

 rb := almostEqual(RGBV.red,  RGBV.blue, StrToInt(AddColorF.EqualDelta.Text));
 bg := almostEqual(RGBV.blue, RGBV.green,StrToInt(AddColorF.EqualDelta.Text));
 rg := almostEqual(RGBV.red,  RGBV.green,StrToInt(AddColorF.EqualDelta.Text));

 with RGBV do
 begin
   if (red >= RedFrom) and (red <= RedTo) and (green >= GreenFrom) and
     (blue <= BlueTo) and (blue <= BlueTo) then
   begin
     if CheckRb then
       if not rb then
       begin
         result := color;
         // проверка не пройдена, значит возвращаем непреобразованный цвет
         exit;
       end;

     if CheckRg then
       if not rg then
       begin
         result := color;
         // проверка не пройдена, значит возвращаем непреобразованный цвет
         exit;
       end;

     if CheckBg then
       if not bg then
       begin
         result := color;
         // проверка не пройдена, значит возвращаем непреобразованный цвет
         exit;
       end;

     if redMoregreen then
       if not(red > green) then
       begin
         result := color;
         // проверка не пройдена, значит возвращаем непреобразованный цвет
         exit;
       end;

     if redLesserGreen then
       if not(red < green) then
       begin
         result := color;
         // проверка не пройдена, значит возвращаем непреобразованный цвет
         exit;
       end;

     if redMoreBlue then
       if not(red > blue) then
       begin
         result := color;
         // проверка не пройдена, значит возвращаем непреобразованный цвет
         exit;
       end;

     if redLesserBlue then
       if not(red < blue) then
       begin
         result := color;
         // проверка не пройдена, значит возвращаем непреобразованный цвет
         exit;
       end;

     if GreenMoreBlue then
       if not(green > blue) then
       begin
         result := color;
         // проверка не пройдена, значит возвращаем непреобразованный цвет
         exit;
       end;

     if GreenLesserBlue then
       if not(green < blue) then
       begin
         result := color;
         // проверка не пройдена, значит возвращаем непреобразованный цвет
         exit;
       end;

     result := RGB2(rezR, RezG, RezB);
     // Если все проверки пройдены то возвращаем приведеный цвет

   end
   else
     result := color;
   // проверка не пройдена, значит возвращаем непреобразованный цвет
 end;

end;


tBmp2             := TBitmap.Create;
   tBmp2.Width       := R.Right  - R.Left;
   tBmp2.Height      := R.Bottom - R.Top;
   tBmp2.PixelFormat := pf32bit;
   tBmp2.Canvas.CopyRect(Rect(0, 0, tBmp2.Width, tBmp2.Height),
     TV.TempNormalBMP.Canvas, R);

   Start := tBmp2.ScanLine[tBmp2.Height - 1];
   //inc(Start, tBmp2.Width);
   Stop := Start;
   inc(Stop, (tBmp2.Width) * (tBmp2.Height - 1));

   T              := GetTickCount;
   repeat

     Start^ := ConvertColorToRGBColorMap(Start^, StrToInt(RedFrom.Text), StrToInt(RedTo.Text), StrToInt(GreenFrom.Text),
       StrToInt(GreenTo.Text), StrToInt(BlueFrom.Text), StrToInt(BlueTo.Text), RedAlmostEqualBlue.Checked, RedAlmostEqualGreen.Checked,
       GreenAlmostEqualBlue.Checked, redMoregreen.Checked, redLesserGreen.Checked, redMoreBlue.Checked,
       redLesserBlue.Checked, GreenMoreBlue.Checked, GreenLesserBlue.Checked, StrToInt(Rto.Text), StrToInt(Gto.Text), StrToInt(Bto.Text));
     inc(Start);
   until Start = Stop;
   T := GetTickCount - T;

   MessageDlg(IntToStr(T), mtError, [mbOK], 0);


---

← →
Вова   (2014-02-11 21:39) [16]

т.е. меня и секунда устроит, но 29 это ваще...

---

← →
Вова   (2014-02-11 22:22) [17]


Procedure TAddColorF.ShowOnTVProc();
var
 tBmp2: TBitmap;
 R: TRect;
 Start, Stop: pInteger;
 T: cardinal;
 RF,RT,GF,GT,BF,BT:byte;
 RR,GR,BR :byte;
begin
 if ShowOnTV.Checked then
 begin

   if TV.TempNormalBMP = nil then
     exit;

   RF := StrToInt(RedFrom.Text);
   RT := StrToInt(RedTo.Text);
   GF := StrToInt(GreenFrom.Text);
   GT := StrToInt(GreenTo.Text);
   BF := StrToInt(BlueFrom.Text);
   BT := StrToInt(BlueTo.Text);
   RR := StrToInt(Rto.Text);
   GR := StrToInt(Gto.Text);
   BR := StrToInt(Bto.Text);

   R := Rect(0, 0, TV.TempNormalBMP.Width, TV.TempNormalBMP.Height);

   tBmp2             := TBitmap.Create;
   tBmp2.Width       := R.Right  - R.Left;
   tBmp2.Height      := R.Bottom - R.Top;
   tBmp2.PixelFormat := pf32bit;
   tBmp2.Canvas.CopyRect(Rect(0, 0, tBmp2.Width, tBmp2.Height),
     TV.TempNormalBMP.Canvas, R);

   Start := tBmp2.ScanLine[tBmp2.Height - 1];
   //inc(Start, tBmp2.Width);
   Stop := Start;
   inc(Stop, (tBmp2.Width) * (tBmp2.Height - 1));

   T              := GetTickCount;
   repeat

     Start^ := ConvertColorToRGBColorMap(Start^, RF, RT, GF, GT, BF, BT, RedAlmostEqualBlue.Checked, RedAlmostEqualGreen.Checked,
       GreenAlmostEqualBlue.Checked, redMoregreen.Checked, redLesserGreen.Checked, redMoreBlue.Checked,
       redLesserBlue.Checked, GreenMoreBlue.Checked, GreenLesserBlue.Checked, RR, GR, BR);
     inc(Start);
   until Start = Stop;
   T := GetTickCount - T;

   MessageDlg(IntToStr(T), mtError, [mbOK], 0);

   TV.RefreshTV(tBmp2);
   tBmp2.Free;
 end;
end;

7 (

---

← →
Вова   (2014-02-11 22:26) [18]

о еще StrToInt в цикле нашел и 141 милисекунда )

приятно поговорить с умным человеком

---

← →
Йа   (2014-02-12 19:34) [19]

Почти топик про "стрелки" .... ))) Вова порвал!!!!! Пиши ещё!!!!
>настоящий Вова   (09.02.14 23:59) [3] - ))))))))

---

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

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

Наверх

Память: 0.52 MB
Время: 0.002 c