|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#16
|
||||
|
||||
Что бы увеличить скорость программы до макс. можно сделать так:
1.Открываем файл, читаем блоками в массив1. 2.Суммируем по 3 байта из массива1 и делим на 3 = средний цвет 3.Проверяем условие: средний цвет > 127 --> белый (1) иначе чёрный (0) 4.Заполняем массив2 из получившихся (0), (1). 5.Создаём заголовок bmp файла с пустыми данными рис. 6.Сохр. массив2 в файл bmp блоками в место где должны быть данные. Нужно разбираться с форматом ч/б bmp файла (структурой) для реализации алгоритма. А зачем файлы преобразовывать в двуцветные картинки? If end Then begin; |
#17
|
|||
|
|||
Цитата:
Это если BMP. Мне все равно нужно отрисовать её на Image, после чего я сохраняю её в JPG: Код:
JpegIm := TJpegImage.Create; JpegIm.Assign(bmp); JpegIm.CompressionQuality := 100; JpegIm.Compress; JpegIm.SaveToFile(dlgSave1.FileName); JpegIm.Destroy; Цитата:
Можно сказать, личные извращения Эх, я так обрадовался Вашему коду, который просто строит цветную картинку - скорость отличная, больше и не надо. А вот с двухцветной не получается так Что же придумать... |
#18
|
||||
|
||||
Заменил чтение блоком. Скорость возросла
Просто подумал как так цветное быстрее рисуется Код:
procedure TForm1.Button2Click(Sender: TObject); Type TRGB = Record B,G,R: Byte; end; PRGBLine = ^TRGBLine; TRGBLine = Array [0..65535] of TRGB; Var F: TFileStream; Bmp: TBitmap; Line: PRGBLine; R, j, i: Integer; C1, C2, C3, Y: Byte; begin if OpenDialog1.Execute Then F:= TFileStream.Create(OpenDialog1.FileName, fmOpenRead) Else Exit; Bmp:= TBitmap.Create; Bmp.PixelFormat:= pf24bit; if (F.Size Mod 3) = 0 Then R:= (F.Size Div 3) Else R:= (F.Size Div 3) + 1 ; Bmp.Width:= Round(Sqrt(R)); Bmp.Height:= Bmp.Width; if (Bmp.Width*Bmp.Height) < R Then Bmp.Height:= Bmp.Height + 1; For j:= 0 To Bmp.Height - 1 Do begin Line:= Bmp.ScanLine[j]; F.Read(Line^, Bmp.Width*3); For i:= 0 To Bmp.Width - 1 Do begin if (Line^[i].R + Line^[i].G + Line^[i].B) Div 3 > 127 Then begin Line^[i].R:= $FF; Line^[i].g:= $FF; Line^[i].B:= $FF; end Else begin Line^[i].R:= $00; Line^[i].g:= $00; Line^[i].B:= $00; end; end; end; Image1.Canvas.Draw(0, 0, Bmp); Bmp.SaveToFile('c:\test.bmp'); Bmp.Free; F.Free; end; If end Then begin; Последний раз редактировалось AND_REY, 01.06.2011 в 21:06. |
#19
|
|||
|
|||
Ничего себе! Ради интереса проверил на файле 100 Мб - меньше чем за 2 секунды. Даже получше, чем Ваш первый код для цветной картинки! Спасибо Вам большое!
И последний вопрос. Может, Вы и с этим поможете. Как лучше теперь эту двухцветную картинку обработать в том плане, чтобы пиксели обрабатывались по блокам, к примеру, 10х10 и, если в этом блоке кол-во черных пикселей будет больше белых, то весь этот квадрат 10х10 перерисовывался полность в черный? Тут, по идее, двумя циклами делать нужно: внутренний будет попиксельно проходить этот квадрат 10х10, высчитывать соотношение черных и белых пикселей, а затем перерисовывать его; а внешний цикл каким-то образом должен отвечать за позицию внутреннего цикла. Только тут, получается, что пройдя таким образом самую первую строчку, последний блок может получиться не 10х10, а, например, 6х10. С ним тогда нужно поступить аналогичным образом, после чего перейти к следующей строчке. |
#20
|
||||
|
||||
По такому алгоритму работает размытие изображения. Только все каналы
цвета надо усреднять к одному. В инете должен быть исходник. Только подкорректировать. If end Then begin; |
#21
|
|||
|
|||
Цитата:
Ну мне не совсем размытие надо, а, скорее, чтобы наподобие мозайки получилось. В принципе, как сейчас строится в 2 цвета, только, по сути, пиксель больше будет (как 10х10 пикселей, к примеру). |
#22
|
||||
|
||||
Ну это не совсем мозаика будет, а скорее размытие.
|
#23
|
|||
|
|||
В общем, кое-как получилось, в принципе.
Только не могу понять как теперь на Image отобразить уменьшенную получившуюся картинку. Вот изначально, когда она преобразовывается попиксельно в два цвета (черный и белый), размеры картинки, отображаемые в Image, одинаковые вне зависимости от того, какая в действительности ширина и высота исходной картинки. Потом я прохожусь циклами для преобразования квадратиков 10х10, опять таки хочу отобразить полученный результат на Image, но он уже отображается такой длины и высоты, как сама картинка, а не размеры Image. Т.е. во весь размер. Как сделать, чтобы она была по размерам Image? т.е. уменьшенная. Код:
procedure Tmp32jpg.btn1Click(Sender: TObject); Type TRGB = Record B,G,R: Byte; end; PRGBLine = ^TRGBLine; TRGBLine = Array [0..65535] of TRGB; Var F: TFileStream; Line: PRGBLine; R, j, i: Integer; C1, C2, C3, Y: Byte; mx,my:Integer; pix:Integer; chx,chy,m,n,m2,n2:Integer; begin if dlgOpen1.Execute Then F:= TFileStream.Create(dlgOpen1.FileName, fmOpenRead) Else Exit; Bmp:= TBitmap.Create; Bmp.PixelFormat:= pf24bit; if (F.Size Mod 3) = 0 Then R:= (F.Size Div 3) Else R:= (F.Size Div 3) + 1 ; Bmp.Width:= Round(Sqrt(R)); Bmp.Height:= Bmp.Width; if (Bmp.Width*Bmp.Height) < R Then Bmp.Height:= Bmp.Height + 1; For j:= 0 To Bmp.Height - 1 Do begin Line:= Bmp.ScanLine[j]; F.Read(Line^, Bmp.Width*3); For i:= 0 To Bmp.Width - 1 Do begin if (Line^[i].R + Line^[i].G + Line^[i].B) Div 3 > 127 Then begin Line^[i].R:= $FF; Line^[i].g:= $FF; Line^[i].B:= $FF; end Else begin Line^[i].R:= $00; Line^[i].g:= $00; Line^[i].B:= $00; end; end; end; img1.Canvas.Draw(0, 0, Bmp); mx:=10; my:=10; chx:=Bmp.Width div 10; chy:=Bmp.Height div 10; for m:=0 to chx do begin for m2:=0 to chy do begin pix:=0; for i:=m2*10 to (mx*(m2+1))-1 do begin for j:=m*10 to (my*(m+1))-1 do begin if bmp.Canvas.pixels[j,i]=$000000 then Inc(pix); end; end; if pix<=50 then begin for i:=m2*10 to mx*(m2+1) do begin for j:=m*10 to my*(m+1) do begin bmp.Canvas.Pixels[j,i]:=$ffffff; end; end; end; if pix>50 then begin for i:=m2*10 to mx*(m2+1) do begin for j:=m*10 to my*(m+1) do begin bmp.Canvas.Pixels[j,i]:=$000000; end; end; end; end; end; ShowMessage('bmp: '+inttostr(bmp.width) +' , img: '+inttostr(img1.width)); F.Free; end; Намудрил, походу, че-то в коде |
#24
|
||||
|
||||
Если просто уменьшить, то StretchBlt
|
#25
|
||||
|
||||
Навалял , вроде работет, разберайтесь.
Код:
procedure TForm1.Button1Click(Sender: TObject); Type TRGB = Record B,G,R: Byte; end; PRGBLine = ^TRGBLine; TRGBLine = Array [0..65535] of TRGB; Var F: TFileStream; Bmp: TBitmap; Line: PRGBLine; R, Mx, My, x, y, j, i, n: Integer; M: Array of Array of Integer; begin if OpenDialog1.Execute Then F:= TFileStream.Create(OpenDialog1.FileName, fmOpenRead) Else Exit; Bmp:= TBitmap.Create; Bmp.PixelFormat:= pf24bit; if (F.Size Mod 3) = 0 Then R:= (F.Size Div 3) Else R:= (F.Size Div 3) + 1 ; Bmp.Width:= Round(Sqrt(R)); Bmp.Height:= Bmp.Width; if (Bmp.Width*Bmp.Height) < R Then Bmp.Height:= Bmp.Height + 1; For j:= 0 To Bmp.Height - 1 Do begin Line:= Bmp.ScanLine[j]; F.Read(Line^, Bmp.Width*3); For i:= 0 To Bmp.Width - 1 Do begin if (Line^[i].R + Line^[i].G + Line^[i].B) Div 3 > 127 Then begin Line^[i].R:= $FF; Line^[i].g:= $FF; Line^[i].B:= $FF; end Else begin Line^[i].R:= $00; Line^[i].g:= $00; Line^[i].B:= $00; end; end; end; if (Bmp.Width Mod 10) = 0 Then Mx:= Bmp.Width Div 10 Else Mx:= (Bmp.Width Div 10) + 1; if (Bmp.Height Mod 10) = 0 Then My:= Bmp.Height Div 10 Else My:= (Bmp.Height Div 10) + 1; Setlength(M, My*10, Mx); For j:= 0 To Bmp.Height - 1 Do begin Line:= Bmp.ScanLine[j]; For i:= 0 To Mx - 1 Do begin n:= 0; For x:= 0 To 9 Do if Line^[i*10+x].R = $FF Then Inc(n) Else Dec(n); M[j,i]:= n; end; end; Image1.Width:= Mx*30; Image1.Height:= My*30; For i:= 0 To Mx - 1 Do For j:= 0 To My - 1 Do begin n:= 0; For y:= 0 To 9 Do n:= n + M[j*10+y,i]; if n >= 0 Then Image1.Canvas.Brush.Color:= clWhite Else Image1.Canvas.Brush.Color:= clSilver; Image1.Canvas.Rectangle(i*30,j*30,i*30+30,j*30+30); Image1.Canvas.TextOut(i*30+5,j*30+10,IntToStr(n)); end; Image1.Picture.SaveToFile('c:\test.bmp'); Bmp.Free; F.Free; end; If end Then begin; |
#26
|
|||
|
|||
Спасибо, парни! Всю суть понял, есть над чем теперь работать. Благодарю ещё раз!
|