Текущий архив: 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.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

---

← →
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.58 MB
Время: 0.027 c