Текущий архив: 2005.07.18;
Скачать: CL | DM;
ВнизЕсть цвет фона, надо вычислить наиболее контрастный цвет для Найти похожие ветки
← →
GuAV © (2005-06-12 21:33) [40]Ученик (12.06.05 21:25) [37]
Только вот с самой таблицей Ученик (12.06.05 20:00) [32] есть небольшие (или большие) проблемы, серого не видно :-(
Если таки остановится на "или clWhite или clBlack", то небольшие, иначе хуже, попытка поцветной инверсии серого даст тот же серый.
← →
GuAV © (2005-06-12 21:44) [41]
> (как в стандаpтной VGA-ой функции):
А как эту самую стандаpтную функцию вызвать ?
← →
Ученик (2005-06-12 22:52) [42]Итоговый вариант :-)
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-13 16:05) [43]Добавил трекбары
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-13 20:05) [44]>GuAV © (13.06.05 16:05) [43]
Поддерживаю :-), мне эти варианты тоже больше понравились.
В изначальном варианте по-моему можно (нужно) заменить везде 15
на 16, индексы меняются от 0 до 15, максимальное значение 240
← →
Вин2 (2005-06-15 01:13) [45]По формулам получается, что на этом фоне : "C08080" лучше писать чёрным. А на самом деле белым. Как быть ?
← →
GuAV © (2005-06-15 17:07) [46]
> По формулам получается, что на этом фоне : "C08080"
> лучше писать чёрным. А на самом деле белым. Как быть ?
Не уверен что белый лучше.
Можно, как уже предлагалось, попробовать задать таблицу соответствия в HLS или RGB или ещё каких координатах.
Можно попробовать подобрать допуск более 127 (этот цвет почти на грани для методов 5, 6 ) - вот доработанная тестовая прога:
unit1.pasunit 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.dfmobject 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
← →
GuAV © (2005-06-15 17:07) [47]
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
← →
Вин2 (2005-06-25 06:19) [48]
> GuAV © (15.06.05 17:07) [46]
>
> > По формулам получается, что на этом фоне : "C08080"
> > лучше писать чёрным. А на самом деле белым. Как быть ?
>
>
> Не уверен что белый лучше.
> Можно, как уже предлагалось, попробовать задать таблицу
> соответствия в HLS или RGB
Хотелось бы простое решение. Без таблиц.
Страницы: 1 2 вся ветка
Текущий архив: 2005.07.18;
Скачать: CL | DM;
Память: 0.56 MB
Время: 0.035 c