![]() |
|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
![]() |
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
#1
|
|||
|
|||
![]() Здравствуйте! Никак не могу заставить работать программу. Программа должна генерировать схему для вышивания, но она постоянно выдает ошибки...
Помогите, пожалуйста разорбраться и наконец-то "заставить" ее работать правильно, очень нужно. Заранее большое спасибо. Код:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Jpeg, Grids; type Trec=record r:integer; g:integer; b:integer; Csr:real; Cn:real; Cmin:real; end; type TForm1 = class(TForm) Button1: TButton; OpenDialog1: TOpenDialog; Button2: TButton; Image1: TImage; PaintBox1: TPaintBox; StringGrid1: TStringGrid; procedure Button1Click(Sender: TObject); procedure Col; procedure Resultat; procedure Button2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Col; var f: TextFile; N:integer; cl: string; Nmin: integer; Cmin: integer; rmin, m: integer; r,g,b:real; st:string; i,i1, jl, ik:integer; begin // чтение из файла stringgrid1.Rowcount:=0; assignfile(f,'c:\color.tbl'); reset(f); while not EOF(f) do begin readln(f,st); stringgrid1.Rowcount:=stringgrid1.Rowcount+1; i:=pos(#9,st); stringgrid1.Cells[1,stringgrid1.Rowcount]:=copy(st,1,i-1); st:=copy(st,i+1,999); i1:=i; i:=pos(#9,st); stringgrid1.Cells[2,stringgrid1.Rowcount]:=copy(st,1,i-1); st:=copy(st,i+1,999); i1:=i; i:=pos(#9,st); stringgrid1.Cells[3,stringgrid1.Rowcount]:=copy(st,1,i-1); st:=copy(st,i+1,999); i1:=i; i:=pos(#9,st); stringgrid1.Cells[4,stringgrid1.Rowcount]:=copy(st,1,i-1); st:=copy(st,i+1,999); i1:=i; i:=pos(#9,st); stringgrid1.Cells[5,stringgrid1.Rowcount]:=copy(st,1,i-1); st:=copy(st,i+1,999); i1:=i; i:=pos(#9,st); stringgrid1.Cells[6,stringgrid1.Rowcount]:=copy(st,1,i-1); st:=copy(st,i+1,999); i1:=i; i:=pos(#9,st); stringgrid1.Cells[7,stringgrid1.Rowcount]:=copy(st,1,i-1); end; begin rmin:=1000; begin // 2.2.2. Цикл по всем цветам из набора: // 2.2.2.1 Вычислить расстояние между цветами Cn и Csr по формуле m:=round((Csr-Cn)/Csr); // 2.2.2.2 Если m<rmin , то rmin = m и Cmin = Cn if m < Nmin then begin rmin:=m; Cmin:=Cn; end; // Присваивается значение цветов RBG cl:=inttohex(round(r*Csr),2)+inttohex(round(g*Csr),2)+inttohex(round(b*Csr),2); Image1.Picture.Bitmap.Canvas.Pixels[jl,ik]:= strtoint('$00'+cl); end; end; end; procedure TForm1.Resultat; var k,l: real; Csr: real; Cn: real; r,g,b: real; i,j,ii,jj:integer; C:integer; ik,jl:integer; Win, Wout, Hin, Hout: integer; Nmin,N, Cmin:real; begin // 1. Определяем коэффициент масштабирования картинки k:=10; // определяем ширину l:=10; // определяем длину // 2. Цикл перебора по всем блокам входной картинки. Блок размера k*k begin // 2.1 Вычислить средний цвет блока // Csr:=1/(k*l); for i:=0 to round(Image1.Width/k) do for j:=0 to round(Image1.Height/l) do begin r:=0; g:=0; b:=0; for ii:= round(0) to round(k-1) do for jj:= round(-l) to round(l) do begin ik:=i+ii; jl:=j*k+jj; Csr:=1/(k*l); if (ik>=0) and (jl>=0) and (ik<= Image1.width) and (jl<= Image1.Height) then begin C:=Image1.Picture.Bitmap.Canvas.Pixels[jl,ik]; r:=C mod $100; g:=(C div $100) mod $100; b:=C div $10000 end; end; end; //2.2 Подбираем наиближайший цвет Сmin из набора среднему цвету блока Csr Col; // Вставляем цвет в ячейку выходной картинки соответствующий блоку входной картинки Cmin:=Cmin+Image1.Picture.Bitmap.Canvas.Pixels[jl,ik]; end; end; procedure TForm1.Button1Click(Sender: TObject); begin close; end; procedure TForm1.Button2Click(Sender: TObject); begin if opendialog1.Execute then Resultat; end; end. |
#2
|
|||
|
|||
![]() Ошибки :
вы используете переменные в процедуре COL которые в ней не описаны описать как глобальные: Код:
Csr: real; Cn: real; несовпадение типов: дописать round Код:
Cmin:=round(Cn) Код:
jl:=round(j*k+jj); это что касается ошибок. Новый вирус - "БОМЖ"! Он просто роется в Корзине...и спит под ярлычком "Сетевое окружение" |