Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Есть цвет фона, надо вычислить наиболее контрастный цвет для [D7]

Страницы: 1 2 3 >
Вин2 © (2005-06-12 02:12:00)
текста на нём. Как это можно сделать ?

Вин2 (2005-06-25 06:19:00) [1]

> GuAV © (15.06.05 17:07) [46]
>
> > По формулам получается, что на этом фоне : "C08080"
> > лучше писать чёрным. А на самом деле белым. Как быть ?
>
>
> Не уверен что белый лучше.
> Можно, как уже предлагалось, попробовать задать таблицу
> соответствия в HLS или RGB

Хотелось бы простое решение. Без таблиц.

GuAV (2005-06-15 17:07:00) [2]
Font.Color = clWhite Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False end object Label1: TLabel Left = 32 Top = 8 Width = 73 Height = 13 Caption = 'A contrast label' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False end end object RadioGroup1: TRadioGroup Left = 0 Top = 8 Width = 145 Height = 161 Caption = 'RadioGroup1' Items.Strings = ( '-=XP=-' 'Alx2' 'MBo' 'Стандаpт CCIR 601-1' 'Anatoly Podgoretsky' 'Стандаpт CCIR 709' 'Стандаpт ITU') TabOrder = 0 OnClick = RadioGroup1Click end object DrawGrid1: TDrawGrid Left = 152 Top = 8 Width = 725 Height = 440 Anchors = [akLeft, akTop, akRight, akBottom] ColCount = 16 RowCount = 16 TabOrder = 2 OnClick = DrawGrid1Click OnDrawCell = DrawGrid1DrawCell end object TrackBar1: TTrackBar Left = 0 Top = 256 Width = 150 Height = 45 Max = 240 Position = 240 TabOrder = 3 TickStyle = tsManual OnChange = TrackBar1Change end object TrackBar2: TTrackBar Left = 0 Top = 304 Width = 145 Height = 25 Max = 15 TabOrder = 4 OnChange = TrackBar1Change end object TrackBar3: TTrackBar Left = 0 Top = 344 Width = 145 Height = 25 Max = 15 TabOrder = 5 OnChange = TrackBar1Change end object Edit1: TEdit Left = 8 Top = 416 Width = 89 Height = 21 TabOrder = 6 Text = '$C08080' end object TrackBar4: TTrackBar Left = 0 Top = 376 Width = 145 Height = 37 Max = 255 Position = 127 TabOrder = 7 TickStyle = tsManual OnChange = TrackBar1Change end object Button1: TButton Left = 104 Top = 416 Width = 41 Height = 25 Caption = 'Button1' TabOrder = 8 OnClick = Button1Click end end

GuAV (2005-06-15 17:07:00) [3]

> По формулам получается, что на этом фоне : "C08080"
> лучше писать чёрным. А на самом деле белым. Как быть ?

Не уверен что белый лучше.
Можно, как уже предлагалось, попробовать задать таблицу соответствия в HLS или RGB или ещё каких координатах.
Можно попробовать подобрать допуск более 127 (этот цвет почти на грани для методов 5, 6 ) - вот доработанная тестовая прога:

unit1.pas

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Grids, StdCtrls, ExtCtrls, ComCtrls; type TForm1 = class(TForm) RadioGroup1: TRadioGroup; Panel1: TPanel; DrawGrid1: TDrawGrid; TrackBar1: TTrackBar; TrackBar2: TTrackBar; TrackBar3: TTrackBar; Edit1: TEdit; Label2: TLabel; Label3: TLabel; TrackBar4: TTrackBar; Button1: TButton; Label1: TLabel; procedure DrawGrid1Click(Sender: TObject); procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure RadioGroup1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure TrackBar1Change(Sender: TObject); procedure Button1Click(Sender: TObject); end; var Form1: TForm1; implementation {$R *.dfm} uses GraphUtil; function ContrastColor(AColor: TColor; aMethod, Therhold: Integer): TColor; const TolerSq = 16 * 16; var R, G, B: Word; begin R := GetRValue(aColor); G := GetGValue(aColor); B := GetBValue(aColor); case aMethod of 0: begin { -=XP=- } if R + G + B < 3 * Therhold then Result := clWhite else Result := clBlack end; 1: begin { Alx 2} if R > Therhold then R := 0 else r := 255; if G > Therhold then G := 0 else g := 255; if B > Therhold then B := 0 else b := 255; Result := RGB(R, G, B) end; 2: begin { MBO } if Sqr(GetRValue(AColor) - $80) + Sqr(GetGValue(AColor) - $80) + Sqr(GetBValue(AColor) - $80) < TolerSq then Result := (AColor + $7F7F7F) and $FFFFFF else Result := AColor xor $FFFFFF end; { Перевод в шкалу серого } 3: begin { GuAV } { Стандаpт CCIR 601-1 } if 0.299 * R + 0.587 * G + 0.114 * B <= Therhold then Result := clWhite else Result := clBlack end; 4: begin { GuAV - Anatoly Podgoretsky } if 0.360 * R + 0.530 * G + 0.110 * B <= Therhold then Result := clWhite else Result := clBlack end; 5: begin { GuAV - Anatoly Podgoretsky Стандаpт CCIR 709 } if 0.213*R + 0.715*G + 0.072*B <= Therhold then Result := clWhite else Result := clBlack end; 6: begin { GuAV - Anatoly Podgoretsky Стандаpт ITU } if 0.222*R + 0.707*G + 0.071*B <= Therhold then Result := clWhite else Result := clBlack end else Result := aColor end end; procedure TForm1.FormCreate(Sender: TObject); begin DrawGrid1.DefaultColWidth := 44; DrawGrid1.DefaultRowHeight := 26; DrawGrid1.FixedCols := 0; DrawGrid1.FixedRows := 0; end; procedure TForm1.RadioGroup1Click(Sender: TObject); begin DrawGrid1.Invalidate; DrawGrid1Click(nil); end; procedure TForm1.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); begin DrawGrid1.Canvas.Brush.Color := ColorHLSToRGB( aRow * 16 + TrackBar2.Position, // 0..15 aCol * 16 + TrackBar3.Position, // 0..15 TrackBar1.Position); // 0..240 для Saturation DrawGrid1.Canvas.Font.Color := ContrastColor(DrawGrid1.Canvas.Brush.Color, RadioGroup1.ItemIndex); DrawGrid1.Canvas.Font.Color := ContrastColor( DrawGrid1.Canvas.Brush.Color, RadioGroup1.ItemIndex, TrackBar4.Position); DrawGrid1.Canvas.FillRect(Rect); DrawText(DrawGrid1.Canvas.Handle, PChar('Oaeno'#13 + IntToStr(aRow * 15) + ' ' + IntToStr(aCol * 15)), -1, Rect, DT_CENTER or DT_WORDBREAK) end; procedure TForm1.DrawGrid1Click(Sender: TObject); begin Panel1.Color := ColorHLSToRGB( DrawGrid1.Row * 16 + TrackBar2.Position, // 0..15 DrawGrid1.Col * 16 + TrackBar3.Position, // 0..15 TrackBar1.Position); Label1.Font.Color := ContrastColor( Panel1.Color, RadioGroup1.ItemIndex, TrackBar4.Position); end; procedure TForm1.TrackBar1Change(Sender: TObject); begin DrawGrid1.Invalidate; Panel1.Color := ColorHLSToRGB( DrawGrid1.Row * 16 + TrackBar2.Position, // 0..15 DrawGrid1.Col * 16 + TrackBar3.Position, // 0..15 TrackBar1.Position); Label1.Font.Color := ContrastColor( Panel1.Color, RadioGroup1.ItemIndex, TrackBar4.Position); end; procedure TForm1.Button1Click(Sender: TObject); var H, S, L: Word; begin ColorRGBToHLS(StrToInt(Edit1.Text), H, L, S); TrackBar1.Position := S; TrackBar2.Position := H mod 16; DrawGrid1.Row := H div 16; TrackBar3.Position := L mod 16; DrawGrid1.Col := L div 16; DrawGrid1.SetFocus; end; end.

unit1.dfm
object Form1: TForm1 Left = 78 Top = 97 Width = 891 Height = 478 Caption = 'Form1' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False OnCreate = FormCreate DesignSize = ( 883 451) PixelsPerInch = 96 TextHeight = 13 object Panel1: TPanel Left = 0 Top = 176 Width = 145 Height = 73 TabOrder = 1 object Label2: TLabel Left = 24 Top = 48 Width = 27 Height = 13 Caption = 'Black' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False end object Label3: TLabel Left = 88 Top = 48 Width = 28 Height = 13 Caption = 'White' Font.Charset = DEFAULT_CHARSET

Вин2 (2005-06-15 01:13:00) [4]
По формулам получается, что на этом фоне : "C08080" лучше писать чёрным. А на самом деле белым. Как быть ?

Ученик (2005-06-13 20:05:00) [5]
>GuAV © (13.06.05 16:05) [43]
Поддерживаю :-), мне эти варианты тоже больше понравились.

В изначальном варианте по-моему можно (нужно) заменить везде 15
на 16, индексы меняются от 0 до 15, максимальное значение 240

GuAV (2005-06-13 16:05:00) [6]
Добавил трекбары

DrawGrid1.Canvas.Brush.Color := ColorHLSToRGB( aRow * 15 + TrackBar2.Position, // 0..15 aCol * 15 + TrackBar3.Position, // 0..15 TrackBar1.Position); // 0..240 для Saturation

Поэксперементировал, получилось, что для меня 5 или 6 лучше (они почти не различаются).

Ученик (2005-06-12 22:52:00) [7]
Итоговый вариант :-)

function ContrastColor(AColor: TColor; aMethod: Integer): TColor; const TolerSq = 16 * 16; var R, G, B: Word; begin R := GetRValue(aColor); G := GetGValue(aColor); B := GetBValue(aColor); case aMethod of 0: begin { -=XP=- } if R + G + B < 384 then Result := clWhite else Result := clBlack end; 1: begin { Alx 2} if R > 127 then R := 0 else r := 255; if G > 127 then G := 0 else g := 255; if B > 127 then B := 0 else b := 255; Result := RGB(R, G, B) end; 2: begin { MBO } if Sqr(GetRValue(AColor) - $80) + Sqr(GetGValue(AColor) - $80) + Sqr(GetBValue(AColor) - $80) < TolerSq then Result := (AColor + $7F7F7F) and $FFFFFF else Result := AColor xor $FFFFFF end; { Перевод в шкалу серого } 3: begin { GuAV } { Стандаpт CCIR 601-1 } if 0.299 * R + 0.587 * G + 0.114 * B <= 127 then Result := clWhite else Result := clBlack end; 4: begin { GuAV - Anatoly Podgoretsky } if 0.360 * R + 0.530 * G + 0.110 * B <= 127 then Result := clWhite else Result := clBlack end; 5: begin { GuAV - Anatoly Podgoretsky Стандаpт CCIR 709 } if 0.213*R + 0.715*G + 0.072*B <= 127 then Result := clWhite else Result := clBlack end; 6: begin { GuAV - Anatoly Podgoretsky Стандаpт ITU } if 0.222*R + 0.707*G + 0.071*B <= 127 then Result := clWhite else Result := clBlack end else Result := aColor end end;

GuAV (2005-06-12 21:44:00) [8]

> (как в стандаpтной VGA-ой функции):

А как эту самую стандаpтную функцию вызвать ?

GuAV (2005-06-12 21:33:00) [9]
Ученик (12.06.05 21:25) [37]
Только вот с самой таблицей Ученик (12.06.05 20:00) [32] есть небольшие (или большие) проблемы, серого не видно :-(

Если таки остановится на "или clWhite или clBlack", то небольшие, иначе хуже, попытка поцветной инверсии серого даст тот же серый.

GuAV (2005-06-12 21:31:00) [10]

> if 0.299*R + 0.587*G + 0.114*B <= 120 then

Небольшая поправочка 0.299 + 0.587 + 0.114 = 1, поэтому

if 0.299*R + 0.587*G + 0.114*B <= 127then

можно попробовать оптимизировать (за счёт точности) сведя к целочисленным сдвигам, вроде [33].
или к целочисленному умножению (если оно быстрее вещесвенного, в чём не уверен).

Anatoly Podgoretsky (2005-06-12 21:30:00) [11]
Ученик (12.06.05 21:25) [37]
Ну не совсем, намек был сделан в Anatoly Podgoretsky © (12.06.05 15:30) [27], а к решению подошли постепенно, совместными усилиями.

Ученик (2005-06-12 21:25:00) [12]
>GuAV © (12.06.05 20:44) [33]
>Anatoly Podgoretsky © (12.06.05 21:01) [35]
Да похоже, два цвета это оптимальный выбор, большое спасибо всем отвечавшим, по, крайней мере, от меня.

>Anatoly Podgoretsky © (12.06.05 21:01) [35]
Скрывали, да :-)

Только вот с самой таблицей Ученик (12.06.05 20:00) [32] есть небольшие (или большие) проблемы, серого не видно :-(

Anatoly Podgoretsky (2005-06-12 21:04:00) [13]
GuAV © (12.06.05 20:44) [33]
Думаю, хорошей идеей будет выбор между clWhite и clBlack, а порог для всех 16ти строк выбрать руками.

С этим тоже согласен.

Anatoly Podgoretsky (2005-06-12 21:01:00) [14]
Вот четыре стандарта перевода в шкалу серого
1. 0,360*R + 0.530*G + 0.110*B 2. Стандаpт CCIR 601-1 (как в стандаpтной VGA-ой функции): 0,299*R + 0,587*G + 0,114*B 3. Стандаpт CCIR 709: 0,213*R + 0,715*G + 0,072*B 4. Стандаpт ITU: 0,222*R + 0,707*G + 0,071*B
Второй как раз наиболее оптимальный для мониторов RGB.

GuAV (2005-06-12 20:57:00) [15]
Нашел формулу:
Y = 0.299R + 0.587G + 0.114B

if 0.299*R + 0.587*G + 0.114*B <= 120 then

- думаю можно так и оставить.

GuAV (2005-06-12 20:44:00) [16]
Имхо, method 1 даёт хорошие результаты, если учитывать коэфициеты цветов.

end else if aMethod = 3 then begin { -=XP=- } if R + G * 2 + B <= 430 then Result := clWhite else Result := clBlack

Думаю, хорошей идеей будет выбор между clWhite и clBlack, а порог для всех 16ти строк выбрать руками.

Ученик (2005-06-12 20:00:00) [17]
Тема заинтересовала :-), тестовый "вырос" в это, может есть еще варианты

uses GraphUtil; { тестовая таблица 16 * 16 } function ContrastColor(AColor: TColor; aMethod: Integer): TColor; const TolerSq = 16 * 16; var R, G, B: Word; Hue, Luminance, Saturation: Word; begin R := GetRValue(aColor); G := GetGValue(aColor); B := GetBValue(aColor); if aMethod = 0 then begin { -=XP=- } if R + G + B 127 then R := 0 else r := 255; if G > 127 then G := 0 else g := 255; if B > 127 then B := 0 else b := 255; Result := RGB(R, G, B) end else if aMethod = 2 then begin { MBO } if Sqr(GetRValue(AColor) - $80) + Sqr(GetGValue(AColor) - $80) + Sqr(GetBValue(AColor) - $80) < TolerSq then Result := (AColor + $7F7F7F) and $FFFFFF else Result := AColor xor $FFFFFF; end else Result := aColor end; procedure TForm1.FormCreate(Sender: TObject); begin DrawGrid1.DefaultColWidth := 44; DrawGrid1.DefaultRowHeight := 26; DrawGrid1.FixedCols := 0; DrawGrid1.FixedRows := 0; end; procedure TForm1.RadioGroup1Click(Sender: TObject); begin DrawGrid1.Invalidate; DrawGrid1Click(nil); end; procedure TForm1.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); begin DrawGrid1.Canvas.Brush.Color := ColorHLSToRGB(aRow * 15, aCol * 15, 240); DrawGrid1.Canvas.Font.Color := ContrastColor(DrawGrid1.Canvas.Brush.Color, RadioGroup1.ItemIndex); DrawGrid1.Canvas.FillRect(Rect); DrawText(DrawGrid1.Canvas.Handle, PChar('Òåêñò'#13 + IntToStr(aRow * 15) + ' ' + IntToStr(aCol * 15)), -1, Rect, DT_CENTER or DT_WORDBREAK) end; procedure TForm1.DrawGrid1Click(Sender: TObject); begin Panel1.Color := ColorHLSToRGB(DrawGrid1.Row * 15, DrawGrid1.Col * 15, 240); Label1.Font.Color := ContrastColor(Panel1.Color, RadioGroup1.ItemIndex) end;

Anatoly Podgoretsky (2005-06-12 15:48:00) [18]
Нет, TColorDialog там для выбора цвета, а суть в образцах (шаблонах), что бы сразу видеть совместимость цветов. Различие там, в том что можно задавать фон и цвет символов, а для данной задачи это не требуется, поскольку идет речь о подборе к фиксированому фону. Разброс или из 8 или из 64 базовых цветов. Задача билзкая по сути.

Ученик (2005-06-12 15:35:00) [19]
>Anatoly Podgoretsky © (12.06.05 15:31) [28]
Имеется ввиду стандартный TColorDialog ?

Anatoly Podgoretsky (2005-06-12 15:33:00) [20]
Еше слева от эталона можно разместить три TTrackBar, по одному на RFB со значением 0..63 для изменения младщих 6 бит каждого цвета. Но это уже излишество.

Страницы: 1 2 3 >

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »