
27.03.2011, 20:01
|
Прохожий
|
|
Регистрация: 14.03.2011
Сообщения: 15
Репутация: 10
|
|
переводить выбранный рисунок из файла в схему для вышивания
Здравствуйте! Написала программу, и немного запуталась в ней. Программа должна переводить выбранный рисунок из файла в схему для вышивания. Помогите, пожалуйста, найти ошибку. Зарание спасибо.
Вот весь код:
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Jpeg;
type
TForm1 = class(TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
Button2: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
k: real;
Csr: real;
Cn: real;
r,g,b: integer;
i,j,ii: integer;
jj,ik,jk:real;
Win, Wout, Hin, Hout: integer;
Nmin,N, Cmin:real;
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
close;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
// Выбираем картинку
if opendialog1.Execute then
// Определяем коэффициент масштабирования картинки
k:=Win/Wout;
k:=Hin/Hout;
// Цикл перебора по всем блокам входной картинки. Размер блока k*k
begin
// Вычисляем средний цвет блока
Csr:=1/(sqr(k));
for i:=0 to Image1.Width do
for j:=0 to Image1.Height do
begin
r:=0;
g:=0;
b:=0;
for ii:= -k to k do
for jj:= -k to k do
begin
ik:=i+ii;
jk:=j+jj;
if (ik>=0) and (jk>=0)
and (ik<= Image1.width) and (jk<= Image1.Height) then
begin
r:=r+Image1.texture[jk,ik].r;
g:=g+Image1.texture[jk,ik].g;
b:=b+Image1.texture[jk,ik].b;
end;
Image1.texture[j,i].r:=round(r*Csr);
Image1.texture[j,i].g:=round(g*Csr);
Image1.texture[j,i].b:=round(b*Csr);
end;
end;
end;
// Подбираем наиближайший цвет Nmin из набора среднему цвету блока Csr
begin
Nmin:=1000;
// Цикл по всем цветам Cn. Вычисляем расстояние между цветами Сn и Csr
begin
N:=(Csr-Cn)/Csr;
if N < Nmin then
Nmin:=N;
Cmin:=Cn;
end;
end;
// Вставляем цвет в ячейку выходной картинки соответсвующий блоку входной картинки
Cmin:=Cmin+Image1.texture[jk,ik].Cmin;
end;
end;
end;
end.
|