VPF::Гистограмма - Форум программистов

Гость_welt

Дата 21.5.2005, 23:21 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Здравствуйте, помогите создать программу в Делфи.
Нужно нарисовать гистограмму зависимости количества пикселов от яркости. (что такое яркость я не очень представляю). Это наверное что-то наподобии гистограммы в Фотошоп, где по оси Х располагаются тоновые градации в диапазоне 0..255, а по оси У - количество пикселов каждого уровня. Заранее благодарен.

Illusion Dolphin

Дата 22.5.2005, 00:31 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 13
Всего: 63

А хоть бы и так:
(это рабочий код из моей программы, если что-нибудь будет не работать - может быть я не все типы выложил или функции дополнительные, т.е. чуть что спрашивай)

Код


type TBaseEffectCallBackProc = procedure(Progress : integer; var Break: boolean) of object;

Type
  TRGB=record
  b,g,r : byte;
  end;

  ARGB=array [0..1] of TRGB;
  PARGB=^ARGB;
  PRGB = ^TRGB;
  PRGBArray = array of PARGB;

  type
 T255ByteArray = array[0..255] of byte;
 T255IntArray = array[0..255] of Cardinal;

type
 TArPARGB = array of PARGB;
...

function Gistogramma(S : TBitmap; var Terminated : boolean; CallBack : TBaseEffectCallBackProc = nil; X : Extended =1; Y : Extended =0) : T255IntArray;
var
  i,j : integer;
  ps : PARGB;
  L : byte;
  Terminating : Boolean;
begin
 S.PixelFormat := pf24bit;
 for i:=0 to 255 do
 Result[i]:=0;
 Terminating:=false;
 Terminated:=false;
 for i:=0 to s.height-1 do
 begin
  ps:=S.ScanLine[i];
  for j:=0 to s.Width-1 do
  begin
   L:=Round(0.3*ps[j].r+0.59*ps[j].g+0.11*ps[j].b);
   inc(Result[L]);
  end;
  if i mod 50=0 then
  If Assigned(CallBack) then CallBack(Round(100*(i*X/S.Height+Y)),Terminating);
  if Terminating then
  begin
   Terminated:=true;
   Break;
  end;
 end;
end;

function GistogrammR(S : TBitmap; var Terminated : boolean; CallBack : TBaseEffectCallBackProc = nil; X : Extended =1; Y : Extended =0) : T255IntArray;
var
  i,j : integer;
  ps : PARGB;
  L : byte;
  Terminating : Boolean;
begin
 S.PixelFormat := pf24bit;
 for i:=0 to 255 do
 Result[i]:=0;
 Terminating:=false;
 Terminated:=false;
 for i:=0 to s.height-1 do
 begin
  ps:=S.ScanLine[i];
  for j:=0 to s.Width-1 do
  begin
   inc(Result[ps[j].r]);
  end;
  if i mod 50=0 then
  If Assigned(CallBack) then CallBack(Round(100*(i*X/S.Height+Y)),Terminating);
  if Terminating then
  begin
   Terminated:=true;
   Break;
  end;
 end;
end;

function GistogrammG(S : TBitmap; var Terminated : boolean; CallBack : TBaseEffectCallBackProc = nil; X : Extended =1; Y : Extended =0) : T255IntArray;
var
  i,j : integer;
  ps : PARGB;
  L : byte;
  Terminating : Boolean;
begin
 S.PixelFormat := pf24bit;
 for i:=0 to 255 do
 Result[i]:=0;
 Terminating:=false;
 Terminated:=false;
 for i:=0 to s.height-1 do
 begin
  ps:=S.ScanLine[i];
  for j:=0 to s.Width-1 do
  begin
   inc(Result[ps[j].g]);
  end;
  if i mod 50=0 then
  If Assigned(CallBack) then CallBack(Round(100*(i*X/S.Height+Y)),Terminating);
  if Terminating then
  begin
   Terminated:=true;
   Break;
  end;
 end;
end;

function GistogrammB(S : TBitmap; var Terminated : boolean; CallBack : TBaseEffectCallBackProc = nil; X : Extended =1; Y : Extended =0) : T255IntArray;
var
  i,j : integer;
  ps : PARGB;
  Terminating : boolean;
begin
 S.PixelFormat := pf24bit;
 for i:=0 to 255 do
 Result[i]:=0;
 Terminating:=false;
 Terminated:=false;
 for i:=0 to s.height-1 do
 begin
  ps:=S.ScanLine[i];
  for j:=0 to s.Width-1 do
  begin
   inc(Result[ps[j].b]);
  end;
  if i mod 50=0 then
  If Assigned(CallBack) then CallBack(Round(100*(i*X/S.Height+Y)),Terminating);
  if Terminating then
  begin
   Terminated:=true;
   Break;
  end;
 end;
end;

function GetGistogrammBitmap(Height : integer; SBitmap : TBitmap; Options : byte; var MinC, MaxC : Integer) : TBitmap;
var
  t : boolean;
  i, MaxCount : integer;
  G : T255IntArray;
  GE : array[0..255] of extended;
begin
 Result:=TBitmap.create;
 Result.PixelFormat:=pf24bit;
 case Options of
  0 : G:=Gistogramma(SBitmap,t);
  1 : G:=GistogrammR(SBitmap,t);
  2 : G:=GistogrammG(SBitmap,t);
  3 : G:=GistogrammB(SBitmap,t);
 end;
 MaxCount:=1;
 for i:=5 to 250 do
 if G[i]>MaxCount then MaxCount:=G[i];
 for i:=0 to 255 do
 GE[i]:=G[i]/MaxCount;
 MinC:=0;
 for i:=0 to 255 do
 begin
  if GE[i]>0.05 then
  begin
   MinC:=i;
   break;
  end;
 end;
 MaxC:=0;
 for i:=255 downto 0 do
 begin
  if GE[i]>0.05 then
  begin
   MaxC:=i;
   break;
  end;
 end;
 Result.Width:=256;
 Result.Height:=Height;
 Result.Canvas.Rectangle(0,0,256,Height);
 for i:=0 to 255 do
 begin
  Result.Canvas.MoveTo(i+1,Height);
  Result.Canvas.LineTo(i+1,Height-Round(Height*GE[i]));
 end;
 Result.Canvas.Pen.Color:=$888888;
 Result.Canvas.MoveTo(MinC,0);
 Result.Canvas.LineTo(MinC,Height);
 Result.Canvas.Pen.Color:=$888888;
 Result.Canvas.MoveTo(MaxC,0);
 Result.Canvas.LineTo(MaxC,Height);
end;

Это сообщение отредактировал(а) Illusion Dolphin - 22.5.2005, 00:35

--------------------

В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5

Гость_welt

Дата 23.5.2005, 03:09 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Спасибо за код, Illusion Dolphin.
У меня правда возникли поблемы
Я захотел естественно сделать все на форме, используя Image1.
Не знал, как лучше сделать, поэтому сразу после окончания
type
TForm1=class(TForm)
поставил ваши три тайпа. После чего сразу вставил процедуры и функции т.е не загонял их в public или private. подскажите, правильно ли это с точки зрения синтаксиса, и если нет поправте.
Дальше создал Для начала две кнопки: одна для загрузки изображения в Image1, другая для вырисовки гистограммы (я захотел для зеленого цвета) в Image2. Ну с первой кнопкой все понятно. А вот со второй начались проблемы
Вот что я написал в обработчике.

Код


procedure TForm1.Bitbtn1.Click(Sender:TObject);
var
 c1,c2:integer;
begin
 GetGistogrammBitmap(100,Image1.Picture.Bitmap,2,c1,c2);
// насчет c1 c2 мне ничего другого не оставалось.
//т.к не знал что еще поставить...
end;

На этом проблемы не закончились...
Запустил я программу, загрузил картинку, нажал на вторую кнопку и ....
ничего.
Пришлось кое-что исправить в самой процедуре GetGistogrammBitmap.
Я заменил все резалты (кстати, почему к ним можно обращаться как к указателям? Им же можно только что-то присваивать.!?) (кроме первых двух) на Form1.Image1.Canvas.
..
Я понимаю, что так нельзя делать(Поэтому и прошу чтобы вы научили правильно вызывать вашу процедуру GetGistogrammBitmap )... но тем не менее заработало, гистограмму по зеленому она мне построила.... Но что было когда я построил для красного (впрочем тот же эффект наблюдался и для синего и просто для яркости)!
несмотря на высоту 100, линии были почти в самом низу-маленткие, т.е не в удобочитаемом виде. Одновременно я сравнивал с гистограммой в Фотошопе, открыв там ту же картинку. Там все было в порядке. Картина совпала только для зеленого, а для всего остального, как я уже говорил был неудобочитаемый формат....
[b]т.е встает вопрос как сделать нормальное отображение для всех каналов?[b]
вот та картинка которую я тестировал.
итак, мне нужно правильно разместить все в модуле, правильно вызвать процедуру(а на форме у меня предположим image1, image2)-т.е разобраться с resullt и тем что с ним связано и понять почему каналы так странно отображаются.
Очень надеюсь на вашу помощь.

Illusion Dolphin

Дата 23.5.2005, 09:20 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 13
Всего: 63

Объясняю различия гистограмм в фотошопе и тут для этой картинки. Дело в том, что часто ты видешь не реальную гистограмму, а её часть, это происходит, например, если у тебя есть фотка на чёрном фоне, который занимает пусть даже 20% всей площади. При этом количество чёрных пикселов будет превышать все другие во много раз. Если это отображать реально, то ты увидишь только одну палку слева и всё. По этому я максимум интенсивности для нормировки искал в интервале 5-250 (или около этого), а в фотошопе используется другая нормировка, и в тестовой картинке мексимальное число пикселей приходится где-то на интенсивность 7-12, в результате мой алгоритм отображает в реальную величину гистограмму, а фотошоп показывает нормированной по какому-то значению. Попробуй сравни гистограмму для обычной фотографии - они совпадут на 100%.

Теперь даю пример, как можно использовать это:

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtDlgs, StdCtrls, ExtCtrls, jpeg;

type TBaseEffectCallBackProc = procedure(Progress : integer; var Break: boolean) of object;

Type
  TRGB=record
  b,g,r : byte;
  end;

  ARGB=array [0..1] of TRGB;
  PARGB=^ARGB;
  PRGB = ^TRGB;
  PRGBArray = array of PARGB;

  type
 T255ByteArray = array[0..255] of byte;
 T255IntArray = array[0..255] of Cardinal;

type
 TArPARGB = array of PARGB;


type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    ComboBox1: TComboBox;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function Gistogramma(S : TBitmap; var Terminated : boolean; CallBack : TBaseEffectCallBackProc = nil; X : Extended =1; Y : Extended =0) : T255IntArray;
var
  i,j : integer;
  ps : PARGB;
  L : byte;
  Terminating : Boolean;
begin
 S.PixelFormat := pf24bit;
 for i:=0 to 255 do
 Result[i]:=0;
 Terminating:=false;
 Terminated:=false;
 for i:=0 to s.height-1 do
 begin
  ps:=S.ScanLine[i];
  for j:=0 to s.Width-1 do
  begin
   L:=Round(0.3*ps[j].r+0.59*ps[j].g+0.11*ps[j].b);
   inc(Result[L]);
  end;
  if i mod 50=0 then
  If Assigned(CallBack) then CallBack(Round(100*(i*X/S.Height+Y)),Terminating);
  if Terminating then
  begin
   Terminated:=true;
   Break;
  end;
 end;
end;

function GistogrammR(S : TBitmap; var Terminated : boolean; CallBack : TBaseEffectCallBackProc = nil; X : Extended =1; Y : Extended =0) : T255IntArray;
var
  i,j : integer;
  ps : PARGB;
  L : byte;
  Terminating : Boolean;
begin
 S.PixelFormat := pf24bit;
 for i:=0 to 255 do
 Result[i]:=0;
 Terminating:=false;
 Terminated:=false;
 for i:=0 to s.height-1 do
 begin
  ps:=S.ScanLine[i];
  for j:=0 to s.Width-1 do
  begin
   inc(Result[ps[j].r]);
  end;
  if i mod 50=0 then
  If Assigned(CallBack) then CallBack(Round(100*(i*X/S.Height+Y)),Terminating);
  if Terminating then
  begin
   Terminated:=true;
   Break;
  end;
 end;
end;

function GistogrammG(S : TBitmap; var Terminated : boolean; CallBack : TBaseEffectCallBackProc = nil; X : Extended =1; Y : Extended =0) : T255IntArray;
var
  i,j : integer;
  ps : PARGB;
  L : byte;
  Terminating : Boolean;
begin
 S.PixelFormat := pf24bit;
 for i:=0 to 255 do
 Result[i]:=0;
 Terminating:=false;
 Terminated:=false;
 for i:=0 to s.height-1 do
 begin
  ps:=S.ScanLine[i];
  for j:=0 to s.Width-1 do
  begin
   inc(Result[ps[j].g]);
  end;
  if i mod 50=0 then
  If Assigned(CallBack) then CallBack(Round(100*(i*X/S.Height+Y)),Terminating);
  if Terminating then
  begin
   Terminated:=true;
   Break;
  end;
 end;
end;

function GistogrammB(S : TBitmap; var Terminated : boolean; CallBack : TBaseEffectCallBackProc = nil; X : Extended =1; Y : Extended =0) : T255IntArray;
var
  i,j : integer;
  ps : PARGB;
  Terminating : boolean;
begin
 S.PixelFormat := pf24bit;
 for i:=0 to 255 do
 Result[i]:=0;
 Terminating:=false;
 Terminated:=false;
 for i:=0 to s.height-1 do
 begin
  ps:=S.ScanLine[i];
  for j:=0 to s.Width-1 do
  begin
   inc(Result[ps[j].b]);
  end;
  if i mod 50=0 then
  If Assigned(CallBack) then CallBack(Round(100*(i*X/S.Height+Y)),Terminating);
  if Terminating then
  begin
   Terminated:=true;
   Break;
  end;
 end;
end;

function GetGistogrammBitmap(Height : integer; SBitmap : TBitmap; Options : byte; var MinC, MaxC : Integer) : TBitmap;
var
  t : boolean;
  i, MaxCount : integer;
  G : T255IntArray;
  GE : array[0..255] of extended;
begin
 Result:=TBitmap.create;
 Result.PixelFormat:=pf24bit;
 case Options of
  0 : G:=Gistogramma(SBitmap,t);
  1 : G:=GistogrammR(SBitmap,t);
  2 : G:=GistogrammG(SBitmap,t);
  3 : G:=GistogrammB(SBitmap,t);
 end;
 MaxCount:=1;
 for i:=5 to 250 do
 if G[i]>MaxCount then MaxCount:=G[i];
 for i:=0 to 255 do
 GE[i]:=G[i]/MaxCount;
 MinC:=0;
 for i:=0 to 255 do
 begin
  if GE[i]>0.05 then
  begin
   MinC:=i;
   break;
  end;
 end;
 MaxC:=0;
 for i:=255 downto 0 do
 begin
  if GE[i]>0.05 then
  begin
   MaxC:=i;
   break;
  end;
 end;
 Result.Width:=256;
 Result.Height:=Height;
 Result.Canvas.Rectangle(0,0,256,Height);
 for i:=0 to 255 do
 begin
  Result.Canvas.MoveTo(i+1,Height);
  Result.Canvas.LineTo(i+1,Height-Round(Height*GE[i]));
 end;
 Result.Canvas.Pen.Color:=$888888;
 Result.Canvas.MoveTo(MinC,0);
 Result.Canvas.LineTo(MinC,Height);
 Result.Canvas.Pen.Color:=$888888;
 Result.Canvas.MoveTo(MaxC,0);
 Result.Canvas.LineTo(MaxC,Height);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  p : tpicture;
  b : tbitmap;
  minc,maxc : integer;
begin
 if OpenPictureDialog1.Execute then
 begin
  p := tpicture.Create;
  p.LoadFromFile(OpenPictureDialog1.FileName);
  b:=Tbitmap.create;
  b.Assign(p.Graphic);
  p.free;
  b.PixelFormat:=pf24bit;
  Image1.Picture.Graphic:=GetGistogrammBitmap(100,b,ComboBox1.ItemIndex,minc,maxc);
  b.free;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 image1.Top:=10;
 image1.left:=10;
 image1.Width:=256;
 image1.Height:=100;
end;

end.

--------------------

Гость_welt

Дата 23.5.2005, 20:38 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Спасибо еще раз...
у меня возникла проблема... мне захотелось сделать с ComboBox также как в фотошоп: ведь

там нажимаешь Histogram и появляется гистограмма по яркости(отсюда я сделал вывод, что

ComboBox.ItemIndex:=0 т.е там три строчки Lumansity, Red, Green, Blue и по умолчанию

стоит на Limensity). Дальше я могу спокойно щелкать по пунктам из КомбоБокс. и прекрасно

переключается...
Мне что-то надо написать в

Код

 procedure TForm1.ComboBox.Change(....)

??? ведь в фотошопе картинка загружена один раз ,
и дальше строятся гистограммы.
А если писать каждый раз

Код



procedure TForm1.Button1Click(Sender: TObject);
var
  p : tpicture;
  b : tbitmap;
  minc,maxc : integer;
begin
 if OpenPictureDialog1.Execute then
 begin
  p := tpicture.Create;
  p.LoadFromFile(OpenPictureDialog1.FileName);
....
//ну и так далее...

то файл дудет загружаться по-новому....
т.е хочу сделать все также с комбобок как в фотошопе....

И еще у меня один вопрос. мне нужно написать модуль для выравнивания текста по правому

краю. Ширина 80 символов. Я знаю алгоритм(но навеное он слишком простой и неуверен, что

правильный). Вот он.
Считаю количество символов в строке и добавляю
слева (в начале строки) нужное количество пробелов до 80 символов. Ну а для большей

правильности можно перед подсчетом символов выбросить ненужные пробелы вконце строки...

что-то типа этого. Буду рад, если вы подскажите как это в паскале(а можно и в делфи)

сделать....

s-mike

Дата 25.5.2005, 06:55 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 425
Регистрация: 16.1.2005
Где: Киев

Репутация: 5
Всего: 16

Я вот немного не понял о чем идет речь:

Цитата

у меня возникла проблема... мне захотелось сделать с ComboBox также как в фотошоп: ведь

там нажимаешь Histogram и появляется гистограмма по яркости(отсюда я сделал вывод, что

ComboBox.ItemIndex:=0 т.е там три строчки Lumansity, Red, Green, Blue и по умолчанию

Хотя с фотошопом знаком неплохо. Можно скриншот?

--------------------

Преферанс для Android на базе исходников Марьяжа

Гость_welt

Дата 27.5.2005, 15:55 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

s-mike , открой Фотошоп. Дальше Image>Histogram, далее щелкай по каналам.....

Illusion Dolphin

Дата 27.5.2005, 17:03 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 13
Всего: 63

И ёжику ясно smile

, что в таком случае нужно сделать следующее:
1) открывает изображение и создаём из него TBitmap
(далее я даю по пунктам так, как это наиболее оптимально с точки зрения быстродействия, но для этого нужно модифицировать код немного)
2) делаем массив из PARGB и туда сканируем всё изображение при помощи scanline
3) Вызываем функцию, которая пройдётся по изображению один раз и сделает из него 4 массива типа T255IntArray (т.е. 4 функции нужно будет собрать в одну. этого можно не делать, но смотри коментарий выше)
4) закрываем изображение и выгружаем лишние русерсы (наш TBitmap)
5) в зависимости от значения MyComboBox.ItemIndex мы формируем на основе соответственного массива из п.3 изображение и заносим его в TImage;
вот и всё. теперь осталось тока это реализовать. что будет просто если есть понимание моего кода.

--------------------

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »