Форум: "Прочее";
Текущий архив: 2011.05.15;
Скачать: [xml.tar.bz2];
ВнизБыстрый вывод пикселей на канву Найти похожие ветки
← →
qazxsw (2011-01-28 14:00) [0]Доброго времени суток. Вопрос к тем кто прогает в Lazarus.
У меня имеется двумерный массив с пикселями, как бы быстро вывести их на канву собственными средствами, тоесть сторонии компонентами пользоваться нельзя. В делфях я бы создал битмап и посредством сканлайн заполнил бы его, а затем draw на канву. А здесь как быть? попиксельный доступ к канве очень медленный...
← →
MBo © (2011-01-28 14:03) [1]а что, в Лазарусе битмапов нет?
← →
qazxsw (2011-01-28 14:08) [2]есть, но нет scanline
← →
MBo © (2011-01-28 14:23) [3]Первая же ссылка предлагает некое решение:
http://www.google.ru/search?client=opera&rls=ru&q=lazarus+scanline&sourceid=opera&ie=utf-8&oe=utf-8&channel=suggest
← →
qazxsw (2011-01-28 16:06) [4]Да смотрел я эту ерунду. Очень медлено...
254 тиков против 15 на scanline
← →
RWolf © (2011-01-28 16:15) [5]Битмап можно и в TMemoryStream загрузить, а там уже править его там как угодно с максимально возможной скоростью.
После редактирования — TBitmap.LoadFromStream.
← →
han_malign (2011-01-28 16:56) [6]
> У меня имеется двумерный массив с пикселями
...
> Битмап можно и в TMemoryStream загрузить
- пример для Delphiю. Т.к TBitmap принимает только поток с файловым заголовком(функции принимающие упакованный DIB спрятаны от доступа) - то было сделано логическое объединение двух кусков(чтобы лишний раз по 4 Mb в памяти не гонять), количество склеиваемых кусков можно при нужде и добавить...type
TPackedDIBFakeFileStream = class(TStream)
private
F_pFHdr: TBitmapFileHeader;
F_pDIB : PBitmapInfo;
F_cbPos: LongWord;
public
function GetSize: Int64; override;
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; OVERRIDE;
function Seek(Offset: Longint; Origin: Word): Longint; override;
constructor Create(pDIB: PBitmapInfo);
end;
implementation
{==============================================================================}
function TPackedDIBFakeFileStream.GetSize: Int64;
begin
Result:= F_pFHdr.bfSize;
end{};
{------------------------------------------------------------------------------}
function TPackedDIBFakeFileStream.Read(var Buffer; Count: Longint): Longint;
var _offs: integer;
begin
Result:= F_pFHdr.bfSize - F_cbPos;
if( Result > Count )then
Result:= Count;
if( Result > 0 )then begin
_offs:= F_cbPos-sizeof(F_pFHdr);
inc(F_cbPos, Result);
if( _offs < 0 )then begin
_offs:= -_offs;
if( _offs >= Result )then begin
move(PAnsiChar(@F_pFHdr)[sizeof(F_pFHdr)-_offs], Buffer, Result);
exit;
end;
move( F_pDIB^, PAnsiChar(@Buffer)[_offs], Result - _offs);
exit;
end;
move( PAnsiChar(F_pDIB)[_offs], Buffer, Result);
end;
end{};
{------------------------------------------------------------------------------}
function TPackedDIBFakeFileStream.Write(const Buffer; Count: Longint): Longint;
begin
Result:= 0;
{$IFOPT O-}asm int 3 end;{$ENDIF}
end{};
{------------------------------------------------------------------------------}
function TPackedDIBFakeFileStream.Seek(Offset: Longint; Origin: Word): Longint;
var _base: int64;
begin
case(Origin)of
ord(soBeginning): _base:= 0;
ord(soCurrent ): _base:= F_cbPos;
ord(soEnd ): _base:= F_pFHdr.bfSize;
else
raise ERangeError.CreateRes(@SRangeError);
end;
inc( _base, offset);
if( _base < 0 )then
Result:= 0
else
if( _base > F_pFHdr.bfSize )then
Result:= F_pFHdr.bfSize
else
Result:= _base;
F_cbPos:= Result;
end{};
{------------------------------------------------------------------------------}
constructor TPackedDIBFakeFileStream.Create(pDIB: PBitmapInfo);
var clr: LongWord;
begin
F_pDIB:= pDIB;
if( pDIB <> nil )then begin
clr:= 0;
if( F_pDIB.bmiHeader.biBitCount <= 8 )then clr:= 1 shl F_pDIB.bmiHeader.biBitCount;
if( F_pDIB.bmiHeader.biCompression = BI_BITFIELDS )then inc(clr, 3);
F_pFHdr.bfType:= $4D42;
F_pFHdr.bfOffBits:= sizeof(F_pFHdr) +
pDIB.bmiHeader.biSize + clr * sizeof(pDIB.bmiColors[0]);
F_pFHdr.bfSize:= F_pFHdr.bfOffBits + pDIB.bmiHeader.biSizeImage;
end;
//else all fields zeroed
end{};
{------------------------------------------------------------------------------}
{==============================================================================}
← →
Pavia © (2011-01-28 18:53) [7]Есть в лазариусе scanline только он спрятан. Там используется.
TBitmap.RawImage.Data
Вот пример перевода из моего класса TByteMap в TBitmap для дельфи и лазариуса.function ByteMap2BitMap(bm:TByteMap):TBitmap;
var
pf:TPixelFormat;
j,i:Integer;
p,p1:PByteArray;
begin
Result:=Nil;
{$IFDEF FPC}
if bm<>nil then
begin
case bm.UnitFormat of
uf1Unit:pf:=pf24bit;
uf3Unit:pf:=pf24bit;
uf4Unit:pf:=pf32bit;
else exit;
end;
Result:=TBitmap.Create;
Result.PixelFormat:=pf;
if bm.UnitFormat=uf1Unit then
begin
Result.Width:=bm.Width;
Result.Height:=bm.Height;
p:=PByteArray(Result.RawImage.Data);
for j:=0 to bm.Height-1 do
begin
p1:=bm.ScanLine[j];
for i:=0 to bm.Width-1 do
begin
p[i*3+0]:=p1[i];
p[i*3+1]:=p1[i];
p[i*3+2]:=p1[i];
end;
Inc(PByte(P),Result.RawImage.Description.BytesPerLine);
end;
exit;
end;
Result.Width:=bm.Width;
Result.Height:=bm.Height;
p:=PByteArray(Result.RawImage.Data);
for j:=0 to bm.Height-1 do
begin
move(bm.ScanLine[j]^,p^,bm.Width*bm.UnitFormat*SizeOf(Byte));
Inc(PByte(P),Result.RawImage.Description.BytesPerLine);
end;
end;
{$ELSE}
if bm<>nil then
begin
case bm.UnitFormat of
uf1Unit:pf:=pf8bit;
uf3Unit:pf:=pf24bit;
uf4Unit:pf:=pf32bit;
else exit;
end;
Result:=TBitmap.Create;
Result.PixelFormat:=pf;
if bm.UnitFormat=uf1Unit then
Result.Palette:=GetGrayPall;
Result.Width:=bm.Width;
Result.Height:=bm.Height;
for j:=0 to bm.Height-1 do
move(bm.ScanLine[j]^,Result.ScanLine[j]^,bm.Width*bm.UnitFormat*SizeOf(Byte));
end;
{$ENDIF}
end;
← →
qazxsw (2011-01-28 19:21) [8]
> Pavia © (28.01.11 18:53) [7]
Угу пасиб посмотрю.
Я тут еще спопсб надыбал, где-то 15-16 тиковprocedure TForm1.Button1Click(Sender: TObject);
var
bitmap: Tbitmap;
a, b: integer;
begin
a := GetTickCount;
bitmap := Tbitmap.Create;
bitmap.Width := 1000;
Bitmap.Height := 1000;
Test(bitmap);
canvas.Draw(0, 0, bitmap);
bitmap.Free;
b := GetTickCount;
ShowMessage(IntToStr(b - a));
end;
procedure TForm1.Test(var FBitmap: TBitMap);
var
y: integer;
RawImage: TRawImage;
BitmapHandle, MaskHandle: HBitmap;
FData, FFdata: PBGRPixel;
begin
ReAllocMem(FData, FBitmap.Width * FBitmap.Height * sizeof(TBGRPixel));
FFdata := FData;
/////////////////////////////Здесь можем рисовать
for y := 0 to FBitmap.Height*fbitmap.Width-1 do
begin
FFdata^.red := 0;
FFdata^.Green := 0;
FFdata^.Blue := 255;
Inc(FFdata);
end;
if (FBitmap.Width > 0) and (FBitmap.Height > 0) then
begin
RawImage.Init;
RawImage.Description.Init_BPP24_B8G8R8_BIO_TTB(FBitmap.Width, FBitmap.Height);
RawImage.Description.LineOrder := riloBottomToTop;
RawImage.Data := PByte(FData);
RawImage.DataSize := FBitmap.Width * FBitmap.Height * sizeof(TBGRPixel);
if not RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False) then
raise FPImageException.Create("Failed to create bitmap handle");
FBitmap.Handle := BitmapHandle;
FBitmap.MaskHandle := MaskHandle;
end;
FBitmap.Canvas.AntialiasingMode := amOff;
freemem(FData);
FData := nil;
end;
← →
qazxsw (2011-01-28 19:23) [9]да юниты
GraphType, LCLIntf, FPimage
← →
qazxsw (2011-01-28 19:32) [10]Эту забыл
type
PBGRPixel = ^TBGRPixel;
TBGRPixel = packed record
blue, green, red: byte;
end;
...............
← →
qazxsw (2011-01-29 04:32) [11]
> Pavia © (28.01.11 18:53) [7]
> p[i*3+0]:=p1[i];
> p[i*3+1]:=p1[i];
> p[i*3+2]:=p1[i];
Этот участок не очень понятен. Почему ко всем трем P применяется один и тот же байт P1[i] ?
← →
Pavia © (2011-01-29 10:26) [12]
> P1[i] ?
Это я градации серого 8бит перевожу в 24 бита Лазариус палитру не поддерживает. А если картинка изначально 24 битное, то код ниже.
Result.Width:=bm.Width;
Result.Height:=bm.Height;
p:=PByteArray(Result.RawImage.Data);
for j:=0 to bm.Height-1 do
begin
move(bm.ScanLine[j]^,p^,bm.Width*bm.UnitFormat*SizeOf(Byte));
Inc(PByte(P),Result.RawImage.Description.BytesPerLine);
end;
end;
← →
Anatoly Podgoretsky © (2011-01-29 13:21) [13]> qazxsw (29.01.2011 04:32:11) [11]
Gray Scale
← →
Anatoly Podgoretsky © (2011-01-29 13:22) [14]Правда паршивый
← →
qazxsw (2011-01-30 12:56) [15]
> > Pavia © (28.01.11 18:53) [7]
мх что-то не могу повторить код :(
на выделенной строке прога валитсяvar
p: PByteArray;
y: integer;
bitmap: TBitMap;
begin
bitmap := Tbitmap.Create;
bitmap.Width := 10;
Bitmap.Height := 10;
bitmap.PixelFormat := pf24bit;
p := PByteArray(bitmap.RawImage.Data);
p^[5]:=10;
bitmap.Free;
← →
Pavia © (2011-01-30 13:27) [16]У меня работает. Может от версии лазариуса зависит?
bitmap.PixelFormat := pf24bit; эта строчка в лазариусе не работает должным образом. Свойство носит только информативный характер.
← →
qazxsw (2011-01-30 13:42) [17]Lazarus-0.9.28.2
fpc-2.2.4
Страницы: 1 вся ветка
Форум: "Прочее";
Текущий архив: 2011.05.15;
Скачать: [xml.tar.bz2];
Память: 0.5 MB
Время: 0.003 c