IT'S ALIVE!

[taval_glenke]

Если этот старый хрен не поставит мне зачет, то я не знаю, чо я делать буду. Ну ничо, до его вылавливания чуть больше четырех с половиной часов ^_^ Кузин, держись!


copy to clipboardподсветка кода

1. unit Analyze_v3_code;  
2. {Программа предназначена для !приблизительной! 
3. оценки содержания цветов в изображении. Возможна не 
4. совсем корректная работа с очень светлыми или наоборот, 
5. очень темными оттенками цветов. 
6. Значения выводятся в процентном отношении к общей площади 
7. изображения, белый цвет не учитывается. 
8. Формат входных данных - jpeg/jpg.}  
9.   
10. interface  
11.   
12. uses  
13.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
14.   Dialogs, ExtDlgs, StdCtrls, ExtCtrls, JPEG, Math;  
15.   
16. type  
17.   TForm1 = class(TForm)  
18.     img1: TImage;  
19.     btn1: TButton;  
20.     dlgOpenPic1: TOpenPictureDialog;  
21.     btn2: TButton;  
22.     grp1: TGroupBox;  
23.     lbl1: TLabel;  
24.     lbl2: TLabel;  
25.     lbl3: TLabel;  
26.     lbl4: TLabel;  
27.     lbl5: TLabel;  
28.     lbl6: TLabel;  
29.     lbl7: TLabel;  
30.     lbl8: TLabel;  
31.     lbl9: TLabel;  
32.     size: TLabel;  
33.     redc: TLabel;  
34.     yellowc: TLabel;  
35.     greenc: TLabel;  
36.     bluec: TLabel;  
37.     purplec: TLabel;  
38.     orangec: TLabel;  
39.     blackc: TLabel;  
40.     grayc: TLabel;  
41.     btn3: TButton;  
42.     lbl10: TLabel;  
43.     procedure btn1Click(Sender: TObject);  
44.     procedure btn2Click(Sender: TObject);  
45.     procedure FormClose(Sender: TObject; var Action: TCloseAction);  
46.     procedure btn3Click(Sender: TObject);  
47.     private  
48.     { Private declarations }  
49.     public  
50.     { Public declarations }  
51.     end;  
52.     TRGBColor = record //тип для хранения отдельных значений rgb-цвета  
53.       R,  
54.       G,  
55.       B : Byte;  
56.     end;  
57.   
58.     {тип для хранения HSB( то же самое, что HSV)-цвета. Hue, Saturation, Brightness - оттенок, насыщенность, яркость}  
59.     THSBColor = record  
60.       Hue, //оттенок  
61.       Sat, //насыщенность  
62.       Br : Double; // яркость  
63.     end;  
64.   
65. var  
66.   Form1: TForm1;  
67.   red,yellow,green,blue,purple,orange,black,gray,picsize{размер изображения}: Integer;  
68.   picpr{сколько пикселей в одном проценте площади изображения}: Double;  
69.   
70.   
71. implementation  
72.   
73. uses analyze_code_f2;  
74.   
75. {$R *.dfm}  
76.   
77. {Функция для конвертации rgb-цвета в hsb. Входное значение - запись с отдельными 
78. значениями цветовых составляющих (RGB), выходное - эквивалент в HSV}  
79. function RGBToHSB(rgb : TRGBColor) : THSBColor;  
80.  var  
81.     minRGB, maxRGB, delta : Double;  
82.     h , s , b : Double ;  
83.  begin  
84.     H := 0.0 ;  
85.     minRGB := Min(Min(rgb.R, rgb.G), rgb.B) ;  
86.     maxRGB := Max(Max(rgb.R, rgb.G), rgb.B) ;  
87.     delta := ( maxRGB - minRGB ) ;  
88.     b := maxRGB ;  
89.     if (maxRGB <> 0.0) then s := 255.0 * Delta / maxRGB  
90.     else s := 0.0;  
91.     if (s <> 0.0) then  
92.     begin  
93.       if rgb.R = maxRGB then h := (rgb.G - rgb.B) / Delta  
94.       else  
95.         if rgb.G = maxRGB then h := 2.0 + (rgb.B - rgb.R) / Delta  
96.         else  
97.           if rgb.B = maxRGB then h := 4.0 + (rgb.R - rgb.G) / Delta  
98.     end  
99.     else h := -1.0;  
100.     h := h * 60 ;  
101.     if h < 0.0 then h := h + 360.0;  
102.     with result do  
103.     begin  
104.       Hue := h;  
105.       Sat := s * 100 / 255;  
106.       Br := b * 100 / 255;  
107.     end;  
108.  end;  
109.   
110. {Преобразование загружаемого jpg-изображения в bmp для использования .Canvas.Pixels}  
111. procedure JPEGtoBMP(const FileName: TFileName);  
112. var  
113.   jpeg: TJPEGImage;  
114.   bmp:  TBitmap;  
115. begin  
116.   jpeg := TJPEGImage.Create;  
117.   try  
118.     jpeg.CompressionQuality := 100; {Default Value}  
119.     jpeg.LoadFromFile(FileName);  
120.     bmp := TBitmap.Create;  
121.     try  
122.       bmp.Assign(jpeg);  
123.       Form1.img1.Picture.Bitmap.Assign(bmp);  
124.     finally  
125.       bmp.Free  
126.     end;  
127.   finally  
128.     jpeg.Free  
129.   end;  
130. end;  
131.   
132. procedure TForm1.btn1Click(Sender: TObject);  
133. begin  
134.   if dlgopenpic1.Execute then  
135.     begin  
136.       JPEGtoBMP(dlgOpenPic1.FileName);  
137.     end;  
138. end;  

UPD: Во время написания этого поста ебучий интернет опять упал. Второй раз за час. Ну чозанахуй, а? =\ Месяцами же без глюков!