Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 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.56 MB
Время: 0.035 c
1-1119908714
Контр
2005-06-28 01:45
2005.07.18
TPageControl - как спрятать у него все заголовки ?


14-1119343238
Holy
2005-06-21 12:40
2005.07.18
Предложения...


14-1119850846
Ega23
2005-06-27 09:40
2005.07.18
С днем рождения! 27 июня


1-1119909466
Контр
2005-06-28 01:57
2005.07.18
Почему могут не срабатывать сообщеня OnMouseEnter и OnMouseLeave?


4-1116185395
volser
2005-05-15 23:29
2005.07.18
Перехватить обновление рабочего стола





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский