Форум: "Начинающим";
Текущий архив: 2006.07.23;
Скачать: [xml.tar.bz2];

Вниз

Разбивание RGB на R, G и B. Скорость.   Найти похожие ветки 

← →
Kobik..   (2006-07-03 07:11) [0]

Задача: грузится картинка любого размера из файла. Растягивается на область конкретного размера (765х547). И еще надо массив всех точек, с разложением цветов на красный, зеленый, синий.

Первая часть
if kadr_bmp[kol_bm]=nil then kadr_bmp[kol_bm]:=tbitmap.create;
bm:=tbitmap.create;
bm.LoadFromFile(OpenPictureDialog1.FileName);
SetRect(rect1,1,1,765,574);
kadr_bmp[kol_bm].Width:=765;
kadr_bmp[kol_bm].Height:=574;
kadr_bmp[kol_bm].Canvas.StretchDraw(rect1,bm);
делается почти моментально.

Теперь разложение...
for i:=1 to 765 do for ii:=1 to 574 do
 begin
 current_display[kol_bm,i,ii].R:=kadr_bmp[kol_bm].Canvas.Pixels[i,ii]and $00FF0000 shr 16;
 current_display[kol_bm,i,ii].G:=kadr_bmp[kol_bm].Canvas.Pixels[i,ii]and $0000FF00 shr 8;
 current_display[kol_bm,i,ii].B:=kadr_bmp[kol_bm].Canvas.Pixels[i,ii]and $000000FF;
 end;
А эта операция длится секунды 2.

Может кто подскажет побыстрее способ?

---

← →
ЮЮ ©   (2006-07-03 07:28) [1]

см. ScanLine
или используй библиотеку Graphics32

---

← →
Kobik..   (2006-07-03 09:39) [2]

хм. Не понял.
ScanLine вернет массив RGB. Как это ускорит разложение?

---

← →
ЮЮ ©   (2006-07-03 09:45) [3]

использование ScanLine во много крат выстрее Pixels

---

← →
Kobik..   (2006-07-03 09:53) [4]

наверно я что-то не так делаю.

for y:=1 to 574 do
begin
p:=kadr_bmp[kol_bm].ScanLine[y];
for x:=1 to 765 do
  begin
 current_display[kol_bm,x,y].R:=p[x]and $00FF0000 shr 16;
 current_display[kol_bm,x,y].G:=p[x]and $0000FF00 shr 8;
 current_display[kol_bm,x,y].B:=p[x]and $000000FF;
 end;
end;
Первый раз по скорости примерно как и раньше. Если второй раз загрузить картинку, то почему-то вылетает на последней строке (y=574)

---

← →
tsa   (2006-07-03 09:55) [5]

Ассемблерные вставки попробуй
asm
     shr
end;

---

← →
Kobik..   (2006-07-03 10:04) [6]

ну с вылетом разобрался, надо же было с 0 начинать, а не с 1.

Но в любом случае я где-то накасячил с этим сканлайном, потому что рисуется не то, что должно.

---

← →
ЮЮ ©   (2006-07-03 10:26) [7]

в p[x] сидит не цвет (это же байт)
при bm.PixelFormat := pf32bit 4байта в p[x] соответтствуют одному пикселю

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ShellAPI, ExtCtrls, Buttons;

type
 TForm1 = class(TForm)
   Button1: TButton;
   Image1: TImage;
   Button2: TButton;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

uses Unit2, Unit3;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
 bm: TBitmap;
 cl: TColor;
 i, j: integer;
 start: Cardinal;
begin
 bm := TBitmap.Create;
 try
   bm.PixelFormat := pf32bit;
   bm.Width := 765;
   bm.Height := 574;
   start := GetTickCount;
   for i := 0 to bm.Height - 1 do
     for j := 0 to bm.Width - 1 do begin
       cl := i * bm.Width + j;
       bm.Canvas.Pixels[j, i] := cl;
     end;
   Image1.Picture.Assign(bm);
   Button1.Caption := IntToStr(GetTickCount - start);
 finally
   bm.Free;
 end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
 bm: TBitmap;
 cl: TColor;
 i, j: integer;
 start: Cardinal;
 P : PByteArray;
begin
 bm := TBitmap.Create;
 try
   bm.PixelFormat := pf32bit;
   bm.Width := 765;
   bm.Height := 574;
   start := GetTickCount;
   for i := 0 to bm.Height - 1 do begin
     p := bm.ScanLine[i];
     for j := 0 to bm.Width - 1 do begin
       cl := i * bm.Width + j;
       p^[j * 4 + 0] := cl and $00FF0000 shr 16;
       p^[j * 4 + 1] := cl and $0000FF00 shr 8;
       p^[j * 4 + 2] := cl and $000000FF ;
     end;
   end;
   Image1.Picture.Assign(bm);
   Button2.Caption := IntToStr(GetTickCount - start);
 finally
   bm.Free;
 end;
end;

end.

---

← →
Kobik..   (2006-07-03 10:59) [8]

спасибо. Теперь все работает просто супер :)

---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2006.07.23;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.013 c