Создание своего диалога выбора цвета

В этой статье я решил описать один вариант создания своего диалога выбора цвета. Диалог выбора цвета, описанный в этой статье немного напоминает Photoshop-овский (но не совсем).

В общем приступим! Сначала создаём форму и помещаем туда всё необходимое:

7 компонентов типа TImage и назовём их так:

MainViewer – экран вывода градиента;
ScalKontr – определяет присутствие изменяемого компонента RGB цвета в градиенте (если выбран R_GB - то красного, если G_RB – то зелёного, если B_RG – то синего) от 0 до 255, путем нажатия курсора на нужную область.
Yarcost – шкала яркости выбранного оттенка.
Proba 1 – для выода цвета, находящегося под курсором при выборе насыщенности компонентом ScalKontr.
Proba 2 – для вывода оттенка, находящегося под курсором при выборе результата и яркости с помощью MainViewer или Yarcost.
ImageZahvat – для вывода выбранной в ScalKontr насыщенности.
Itog – для вывода выбранного оттенка.
12 Edit-ов, 3 RadioButton и 2 кнопки . Их оставим в покое (в смысле не переименовываем).

Теперь нам необходимо определиться с необходимыми процедурами.

Во-первых – это процедура генерирования шкалы контраста.

Во-вторых – это процедура генерирования градиента в MainViewer (в соответствии с выбранным типом градиента и выбранной насыщенностью).

В-третьих – процедура генерирования шкалы яркости, в соответствии с выбранным оттенком.

Начнём с первого. Сам нижеприведённый код я поместил в обработчик OnCreate формы.

Пояснения смотрите в комментариях к коду:

var 
  LineColor, ViewColor: TColor; 
  ColR, ColG, ColB, i, j:integer; 
begin 
  {Если выбран баланс Красного с Синим и Зелёным (R_GB)} 
  if RadioButton1.Checked then 
  begin 
    ColR:=255; 
    ColG:=0; 
    ColB:=0; 
    for j:=0 to 255 do 
    begin 
      LineColor:=RGB(255-j, 0, 0); //Изменяем значение красного цвета 
      for i:=0 to 17 do 
        ScalKontr.Canvas.Pixels[i, j]:=LineColor; //рисуем точку 
    end; 
  end; 
 
    {Если выбран баланс Зелёного с Красным и Синим (G_RB)} 
  if RadioButton2.Checked then 
  begin 
    ColR:=0; 
    ColG:=255; 
    ColB:=0; 
    for j:=0 to 255 do 
    begin 
      LineColor:=RGB(0, 255-j, 0); //Изменяем значение зелёного  цвета 
      for i:=0 to 17 do 
        ScalKontr.Canvas.Pixels[i,j]:=LineColor; //рисуем точку 
    end; 
  end; 
 
    {Если выбран баланс Синего с Красным и Зелёным (B_RG)} 
  if RadioButton3.Checked then 
  begin 
    ColR:=0; 
    ColG:=0; 
    ColB:=255; 
    for j:=0 to 255 do 
    begin 
      LineColor:=RGB(0, 0, 255-j); //Изменяем значение синего цвета 
      for i:=0 to 17 do 
        ScalKontr.Canvas.Pixels[i,j]:=LineColor; //рисуем точку 
    end; 
  end; 
end;
Думаю здесь всё понятно. Далее приступим к основной процедуре рисования градиента в MainViewer. Вот код:
procedure GenerateRGBInOutGrad(ClrOutR, ClrOutG, ClrOutB: Integer); 
var 
  i, j: Integer; //счётчики 
  PixelColor: TColor; //цвет пиксела 
  Holst: TBitMap; //Объект для записи пикселей 
begin 
  Holst:=TBitMap.Create; //создаём объект типа TBitMap 
  Holst.Width:=256; //указываем ширины 
  Holst.Height:=256; //указываем высоту 
 
  if ClrDialog.RadioButton1.Checked then //если выбрана RadioButton1 
  begin 
     {Палитра красного с зелёным и синим} 
    for j:=0 to 255 do //цикл по оси Y 
    begin 
      for i:=0 to 255 do //цикл по оси X 
      begin 
        PixelColor:=RGB(ClrOutR, j, i); {привязываем значения зелёного и синего к изменениям координат и переводим из
RGB в TColor} 
        Holst.Canvas.Pixels[i, j]:=PixelColor; //Рисуем точку 
      end;
    end;
  end;
 
  if ClrDialog.RadioButton2.Checked=true then //если выбрана RadioButton2 
  begin 
    {Палитра зелёного с красным и синим} 
    for j:=0 to 255 do //цикл по оси Y 
    begin 
      for i:=0 to 255 do //цикл по оси X 
      begin 
        PixelColor:=RGB(j, ClrOutG, i); {привязываем значения красного и синего к изменениям координат и переводим из
RGB в TColor} 
        Holst.Canvas.Pixels[i, j]:=PixelColor; //Рисуем точку 
      end;
    end;
  end;
 
  if ClrDialog.RadioButton3.Checked=true then //если выбрана RadioButton3 
  begin 
    {Палитра синего с красным и зелёным} 
    for j:=0 to 255 do //цикл по оси Y 
    begin 
      for i:=0 to 255 do //цикл по оси X
      begin
        PixelColor:=RGB(j, i, ClrOutB); {привязываем значения красного и зелёного к изменениям координат и переводим из
RGB в TColor} 
        Holst.Canvas.Pixels[i, j]:=PixelColor; //Рисуем точку
      end;
    end;
  end;
 
  ClrDialog.MainViewer.Canvas.Draw(0,0,Holst); //рисуем всю картину на компонент TImage 
  Holst.Free; //освобождаем память, занимаемую объёктом Holst 
end;
Вот!

Ну и, наконец, код вывода шкалы яркости:
{========================================================== Процедура генерации полосы яркости выбранного оттенка}
procedure GenerYarkost(ColR, ColG, ColB: Real); 
var 
  i, j: integer; //счётчики 
  LineColor: TColor; //цвет TColor 
  StepR, StepG, StepB: Real; {шаг изменения для каждого цвета, необходимы для равномерного смешивания цветов по всей
длине линии яркости. }
begin
  ClrDialog.Edit4.Text:=IntToStr(round(ColR));   {Эти строки} 
  ClrDialog.Edit5.Text:=IntToStr(round(ColG));   {нужны лишь в моём} 
  ClrDialog.Edit6.Text:=IntToStr(round(ColB));   {примере. В Вашем может и не понадобятся.} 
 
  {Генерация шкалы яркости для выбранного оттенка} 
  StepR:=(256-ColR)/256; //определение шага для красного 
  StepG:=(256-ColG)/256; //определение шага для зелёного 
  StepB:=(256-ColB)/256; //определение шага для синего 
 
  j:=256; //здесь счётчику по Y-ку присваивается начальное значение 
  repeat
      j:=j-1; {Цикл по Y-ку организован с помощью repeat until чтобы 
    организовать обратный отсчёт от 256 до 1. Это сделано 
    для того, чтобы заполнять шкалу не с верху вниз, а снизу 
    вверх (т.к. начальная точка экранных координат 
    расположена в верхнем правом углу.)} 
 
    ColR:=ColR+StepR; {В каждом переходе цикла по Y} 
    ColG:=ColG+StepG; {увеличиваем значение соответствующего цвета} 
    ColB:=ColB+StepB; {на соответствующий ему шаг.} 
    for i:=0 to 17 do 
    begin 
      {На всякий случай проверим значения цветов на вхождение в пределы 255} 
      if ColR>255 then ColR:=255; 
      if ColG>255 then ColG:=255; 
      if ColB>255 then ColB:=255; 
 
      LineColor:=RGB(round(ColR), round(ColG), round(ColB)); //Записываем оттенок 
      ClrDialog.Yarcost.Canvas.Pixels[i, j]:=LineColor; //Рисуем точку в компонент TImage 
    end;
  until j=1;
end;
Вот в принципе все необходимые процедуры для написания такого диалога. Всё остальное – дело техники и это вы найдёте в примере к статье. Правда есть ещё один момент, который необходимо описать – это перевод из TColor в RGB формат. Чисто для примера сделаем 3 переменные типа integer (пусть это будут ColR , ColG и ColB ) и одну переменную типа TColor (Например, ColTColor). Далее присвоим значение переменной ColTColor. Пусть это будет зелёный (clGreen). Ну и, наконец, выделим из этой переменной значения RGB компонентов в соответствующие переменные типа integer. Весь код:
procedure TestTColorToRGB; 
var 
  ColR, ColG, ColB: integer; 
  ColTColor: TColor; 
begin 
  ColTColor:=clGreen; //присваиваем зелёный цвет 
 
  ColR:= ColTColor mod $100; //выделяем красный 
  ColG:=( ColTColor div $100) mod $100; //выделяем зелёный 
  ColB:= ColTColor div $10000; //выделяем синий 
end;
У переменных должны получиться следующие значения:

ColR = 0;
ColG = 255;
ColB = 0.

Вот и всё, Удачи!


  1. Ila
    Ila 2 months ago
    It is with sad regret to inform you StarDataGroup.com is shutting down.
    It has been a tough year all round and we decided to go out with a bang!

    Any group of databases listed below is $49 or $149 for all 16 databases in this one time offer.
    You can purchase it at www.StarDataGroup.com and view samples.

    - LinkedIn Database
    43,535,433 LinkedIn Records

    - USA B2B Companies Database
    28,147,835 Companies

    - Forex
    Forex South Africa 113,550 Forex Traders
    Forex Australia 135,696 Forex Traders
    Forex UK 779,674 Forex Traders

    - UK Companies Database
    521,303 Companies

    - German Databases
    German Companies Database: 2,209,191 Companies
    German Executives Database: 985,048 Executives

    - Australian Companies Database
    1,806,596 Companies

    - UAE Companies Database
    950,652 Companies

    - Affiliate Marketers Database
    494,909 records

    - South African Databases
    B2B Companies Database: 1,462,227 Companies
    Directors Database: 758,834 Directors
    Healthcare Database: 376,599 Medical Professionals
    Wholesalers Database: 106,932 Wholesalers
    Real Estate Agent Database: 257,980 Estate Agents
    Forex South Africa: 113,550 Forex Traders

    Visit www.stardatagroup.com or contact us with any queries.

    Kind Regards,
    StarDataGroup.com
  2. Forrest
    Forrest 2 months ago
    It is with sad regret to inform you StarDataGroup.com is shutting down.

    Fire sale till the 7th of Feb.

    Any group of databases listed below is $49 or $149 for all 16 databases in this one time offer.
    You can purchase it at www.StarDataGroup.com and view samples.

    - LinkedIn Database
    43,535,433 LinkedIn Records

    - USA B2B Companies Database
    28,147,835 Companies

    - Forex
    Forex South Africa 113,550 Forex Traders
    Forex Australia 135,696 Forex Traders
    Forex UK 779,674 Forex Traders

    - UK Companies Database
    521,303 Companies

    - German Databases
    German Companies Database: 2,209,191 Companies
    German Executives Database: 985,048 Executives

    - Australian Companies Database
    1,806,596 Companies

    - UAE Companies Database
    950,652 Companies

    - Affiliate Marketers Database
    494,909 records

    - South African Databases
    B2B Companies Database: 1,462,227 Companies
    Directors Database: 758,834 Directors
    Healthcare Database: 376,599 Medical Professionals
    Wholesalers Database: 106,932 Wholesalers
    Real Estate Agent Database: 257,980 Estate Agents
    Forex South Africa: 113,550 Forex Traders

    Visit www.stardatagroup.com or contact us with any queries.

    Kind Regards,
    StarDataGroup.com
  3. Robbin
    Robbin a month ago
    It is with sad regret to inform you StarDataGroup.com is shutting down.

    Fire sale going on!

    Any group of databases listed below is $49 or $149 for all 16 databases in this one time offer.
    You can purchase it at www.StarDataGroup.com and view samples.

    - LinkedIn Database
    43,535,433 LinkedIn Records

    - USA B2B Companies Database
    28,147,835 Companies

    - Forex
    Forex South Africa 113,550 Forex Traders
    Forex Australia 135,696 Forex Traders
    Forex UK 779,674 Forex Traders

    - UK Companies Database
    521,303 Companies

    - German Databases
    German Companies Database: 2,209,191 Companies
    German Executives Database: 985,048 Executives

    - Australian Companies Database
    1,806,596 Companies

    - UAE Companies Database
    950,652 Companies

    - Affiliate Marketers Database
    494,909 records

    - South African Databases
    B2B Companies Database: 1,462,227 Companies
    Directors Database: 758,834 Directors
    Healthcare Database: 376,599 Medical Professionals
    Wholesalers Database: 106,932 Wholesalers
    Real Estate Agent Database: 257,980 Estate Agents
    Forex South Africa: 113,550 Forex Traders

    Visit www.stardatagroup.com or contact us with any queries.

    Kind Regards,
    StarDataGroup.com
  4. Deloris
    Deloris a month ago
    Use SendBulkMails.com to run email campaigns from your own private dashboard.

    Cold emails are allowed and won't get you blocked :)

    - 1Mil emails / mo @ $99 USD
    - Dedicated IP and Domain Included
    - Detailed statistical reports (delivery, bounce, clicks etc.)
    - Quick and easy setup with extended support at no extra cost.
    - Cancel anytime!

    Regards,
    www.SendBulkMails.com
  5. Elisa
    Elisa a month ago
    Do you need more clients?

    We have amazing databases starting at $9.99 until the end of the Month!

    Visit us at StarDataGroup.com
  6. SendBulkMails.com
    SendBulkMails.com a month ago
    SendBulkMails.com allows you to reach out to clients via cold email marketing.

    - 1Mil emails starter package
    - Dedicated IP and Domain Included

    - Detailed statistical reports (delivery, bounce, clicks etc.)

    - Quick and easy setup with extended support at no extra cost.

    - Cancel anytime!

    SendBulkMails.com
  7. Dwayne
    Dwayne a month ago
    Hey,

    Listen, business is tough right now for most people.

    Does this sound like your situation?

    -Not enough quality leads?
    -Not enough revenue?
    -Always looking for more business?
    -Working too hard?

    I have the solution to help make this a great year for your business.

    I will show you how to Drive Revenue, Sales and Commissions...during the day and more importantly while you sleep...

    ==> https://sesforyou.com

    Regards,
    SesForYou.com
  8. Audrea
    Audrea 16 days ago
    Hello,

    BestLocalData.com has a special package you get any group of databases for $49 or $249 for all 16 databases and unlimited emails for a year(Domain, IP, Dashboard included).

    You can purchase it on BestLocalData.com and see samples if you are interested.
  9. Arthur
    Arthur 13 days ago
    Your All In One Solution For Creating All The Content You'll Ever Need.

    Proprietary AI Turns YouTube Videos Into Traffic Getting Articles At The Press Of A Button!

    We’ve Been Getting Free Autopilot Traffic From Google Without SEO Experience For Over 2 Years By Converting Others YouTube Videos Into Articles…

    https://warriorplus.com/o2/a/gmvfs/0
  10. Theron
    Theron 12 days ago
    Need extra income?

    A fully hosted, done for you content + monetisation and a stunning design web based software that creates a fully automated done for you cryptocurrency affiliate site,

    Visit us: https://warriorplus.com/o2/a/f5s4y/0
  11. Bonnie
    Bonnie 2 days ago
    Hey,

    It was nice speaking to you the other day, this is the service I was telling you about that helped us boost our ROI almost 2000%

    Its a company called Lifemail.studio sorry it took so long to get back to you. They allow you to send any email doesn't matter what.

    We dealt with a guy named Michael, he was friendly and got us setup really quickly.

    Regards,
    Bonnie
Отменить.