Собственно проблема из ряда вон. Имеется код, переводящий картинку из цветной в ЧБ. Code: unit main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TForm1 = class(TForm) imga: TPanel; imgb: TPanel; Load_b: TButton; bnw: TButton; OpFile: TOpenDialog; log: TMemo; procedure Load_bClick(Sender: TObject); procedure bnwClick(Sender: TObject); private { Private declarations } public { Public declarations } end; type //Для шустрого обращения к пикселям TRGBA = array[0..32767]of TRGBTriple; PRGBA = ^TRGBA; //Массив черно-белых точек :D TPBWA = array[0..3000,0..3000] of boolean; PPBWA = ^TPBWA; //Массив Черно-серо-белых точегг :D TPYA = array[0..3000,0..3000]of byte; PPYA = ^TPYA; var Form1: TForm1; prePixArr:PPYA; PixArr:PPBWA; canv_a,canv_b:TBitmap; cimga,cimgb:TCanvas; implementation {$R *.dfm} procedure TForm1.bnwClick(Sender: TObject); VAR i,j:integer; dY:integer; // Средний серый тон brow:PRGBA; begin log.Lines.Add('H('+inttostr(canv_a.Width)+')*W('+inttostr(canv_a.Height)+') = ' + inttostr(canv_a.Width*canv_a.Height)); log.Lines.Add('Размер Y матрицы в памяти ' + inttostr(canv_a.Width*canv_a.Height*64)); PrePixArr:=AllocMem(canv_a.Width*canv_a.Height*64); for i:=canv_a.Height-1 downto 0 do Begin brow := canv_a.ScanLine[i]; for j:=canv_a.Width-1 downto 0 do Begin prePixArr^[j,i]:=byte(round(0.3*brow^[j].rgbtRed+0.59*brow^[j].rgbtGreen+0.11*brow^[j].rgbtBlue)); End; End; //Медленный наглядный показ результата преобразование цветного в серое dY:=0; For i:=0 to canv_a.Width-1 do for j:=0 to canv_a.Height-1 do Begin cimgb.Pixels[i,j]:=RGB(prePixArr^[i,j],prePixArr^[i,j],prePixArr^[i,j]); dY:=prePixArr^[i,j] + dY; End; dY:=round(dY) div (canv_a.Width*canv_a.Height); log.Lines.Add('Применены оттенки серого. dY = '+inttostr(round(dY))); // Преобразование серого в полностью ЧБ. PixArr:=allocmem(canv_a.Width*canv_a.Height*64); log.Lines.Add('Размер ЧБ матрицы в памяти:'+inttostr(canv_a.Width*canv_a.Height*64)); For i:=0 to canv_a.Width-1 do for j:=0 to canv_a.Height-1 do Begin if prePixArr^[i,j]<dY then PixArr^[i,j]:=true else PixArr^[i,j]:=false; if PixArr^[i,j]=true then cimgb.Pixels[i,j]:=clBlack else cimgb.Pixels[i,j]:=clWhite; End; end; procedure TForm1.Load_bClick(Sender: TObject); VAR r1:TRect; begin freemem(prePixArr); freemem(PixArr); OpFile.Execute; if OpFile.FileName<>'' then Begin canv_a:=TBitmap.Create; canv_a.LoadFromFile(OpFile.FileName); canv_a.PixelFormat:=pf24bit; cimga:=TCanvas.Create; cimga.Handle:=GetDC(imga.Handle); r1.TopLeft:=Point(0,0); r1.BottomRight:=point(canv_a.Width,canv_a.Height); cimga.CopyRect(r1,canv_a.Canvas,r1); canv_b:=TBitmap.Create; canv_b.LoadFromFile(OpFile.FileName); canv_b.PixelFormat:=pf24bit; cimgb:=TCanvas.Create; cimgb.Handle:=GetDC(imgb.Handle); r1.TopLeft:=Point(0,0); r1.BottomRight:=point(320,240); cimgb.CopyRect(r1,canv_b.Canvas,r1); canv_b.Free; End; end; end. Очевидно что в строках Code: PixArr:=allocmem(canv_a.Width*canv_a.Height*64); и Code: PrePixArr:=AllocMem(canv_a.Width*canv_a.Height*64); цифра 64 явно завышена. Ведь для сохранения матрицы boolean размером x*y надо x*y*sizeof(boolean) байт памяти. НО! Отсюда по подробнее с проблемой: Если ставлю sizeof, или числа меньше 12, вместо 64 программа после обработки части изображения выдает ошибку. Какую - догадаться не сложно. Разумеется ошибка доступа к памяти. Если делаю 12 и больше - обрабатывает часть картинки и выдает ошибку. При некоторых значениях обрабатывает ВСЮ картинку и только потом выдает ошибку. Так-же плохо работает если при указании типа массива делать числа не 0..3000 а другие, уже зависимость от чисел 12, 64 и т.п. иная. В общем очень очень очень странно это. Может ошибка в коде? Или я что-то про размеры массива не понимаю?
Во первых всегда используй для таких целей формат 24 бита(ну собсна ты так и делаешь), далее делаем так : Code: type TXPixel = record b, g, r : Byte; // В битмапах BGR end; TXPixelArray = array[0..0] of TXPixel; //Уличная магия? Неее, тут нужно указать что массив не динамический, но пустой PXPixelArray = ^TXPixelArray; //Обращение к пикселям ... Var prePixArr : PXPixelArray; Begin for i:=canv_a.Height-1 downto 0 do Begin prePixArr := canv_a.ScanLine[i]; for j:=canv_a.Width-1 downto 0 do Begin PixelData^[j].r := 0; PixelData^[j].b := 0; PixelData^[j].g := 0; End; End; В этом примере вся картинка станет черной, без всяких доп. массивов.
Мне не нужна черная картинка. Мне нужно цветную превратить в черно-белую. То-есть перевести в градации серого и потом цвета, ярче среднего тона всей картинки сделать белыми, а темнее - черными. Да и вопрос не в реализации алгоритма, а в динамическом массиве. Спасибо за 0..0, попробую.
Не получается. Провел тест этой унылости - такой код: Code: type a = array[0..3000,0..3000]of integer; //[0..0,0..0]of integer; pa = ^a; procedure TForm1.Button1Click(Sender: TObject); VAR i,j:integer; p:pa; begin p:=allocmem(500*500*sizeof(integer)); for i:=0 to 499 do for j:=0 to 499 do p^[i,j]:=i*j; i:=23; j:=56; showmessage(inttostr(p^[i,j])); end; Результат: 1. При [0..0,0..0] в p^[i,j] оказывается 0! Хотя должно быть 23*56. 2. При [0..3000,0..3000] программа выдает ошибку. Code: Access violation *** write of address Может дело в компиляторе? Delphi XE.
ты не правильно выделяешь память под массив, точнее определяешь её размер, для твоего примера надо так: Code: // так как у тебя определен тип как: a = array[0..3000,0..3000] of integer; // то: p:= allocmem(3001*500*sizeof(integer)); безопаснее конечно же так: Code: type a = array[0..3000,0..3000] of integer; ................. var p: pa; begin p:= allocmem(sizeof(a)); информация, грубо говоря в памяти для массива вида [0..x, 0..y] располагается так: Code: x0:y0,x1:y0,x2:y0...x:y0,x0:y1,x1:y1......x,y то есть, если на пальцах объяснить, то сначала первые 3001 значения Y0, потом 3001 значения Y1 и так далее... а у тебя получается 500 значений Y0 ... и далее, до 500 значений Y499 отсюда и ошибка доступа к памяти, во как, думаю ты меня понял =)
Ура! Мне объяснили. Теперь всё встало на свои места. Спасибо. А то гугл уже забананить меня успел за насилие и попытки выяснить суть смысла причины.