Из TPixBuf в TBitmap

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

Из TPixBuf в TBitmap

Сообщение Zinchenko.Sergey » 18.08.2009 23:29:29

В процессе написания кросс платформенного кода встал вопрос о том как быстро скопировать изображение из TPixBuf в TBitmap. Написал свой код - работает очень медленно (я не знаком с тонкостями lazarus'a и gdk/gtk ). Может кто сталкивался с похожей проблемой и поможет с решением. Заранее благодарен.
Zinchenko.Sergey
незнакомец
 
Сообщения: 3
Зарегистрирован: 18.08.2009 23:23:14

Re: Из TPixBuf в TBitmap

Сообщение carrots » 26.09.2009 17:00:30

А можно подробнее?
Для чего это делать?
Откуда у вас в Лазаре взялся TPixBuf?
Можете показать свой код?
Аватара пользователя
carrots
постоялец
 
Сообщения: 138
Зарегистрирован: 28.03.2008 02:13:02

Re: Из TPixBuf в TBitmap

Сообщение Zinchenko.Sergey » 27.09.2009 23:58:37

Код: Выделить всё
unit UnixScaner;

{$mode objfpc}{$H+}

interface

{$IFDEF UNIX}
uses
  ScanerTypes, graphics, x, xlib, glib, gdkpixbuf;{, LCLType, IntfGraphics,
  gdk2, gtkdef, gdk2pixbuf, gtk2, glib2}

  procedure FindAllPSTables(var WindowArray : TWindowArray; var Names : TArrayString);
  procedure GetWindowScreenShot(Window : TMyWindow; var Bitmap : TMyBitmap);
{$ENDIF}

implementation
{$IFDEF UNIX}

function gdk_pixbuf_xlib_get_from_drawable(dest:PGdkPixbuf; src:TDrawable; cmap:TColormap; visual:PVisual; src_x:longint;
             src_y:longint; dest_x:longint; dest_y:longint; width:longint; height:longint):PGdkPixbuf;cdecl; external 'libgdk_pixbuf_xlib' name 'gdk_pixbuf_xlib_get_from_drawable';
procedure gdk_pixbuf_xlib_init(display:PDisplay; screen_num:longint);cdecl; external 'libgdk_pixbuf_xlib' name 'gdk_pixbuf_xlib_init';


procedure FindXWindowsByMask(Display : PDisplay;
  Root : TWindow; const Name : String; var WindowArray : TWindowArray; var Names : TArrayString);
const
  StackDepth = 32;
type
  TWinArray = array[0..0] of TWindow;
  PWinArray = ^TWinArray;
  StackElem = record
    Children : PWinArray;
    NChildren, Position : Integer;
  end;
var
  Stack : array[0..StackDepth-1] of StackElem;
  StackPtr : Integer;
  retName : PChar;
  Wnd : TWindow;
begin
  SetLength(Names, 0);
  SetLength(WindowArray, 0);
  XFetchName(Display, Root, @retName);
  if Pos(Name, retName) > 0 then
  begin
    SetLength(Names, Length(Names) + 1);
    Names[Length(Names) - 1] := retName;
    SetLength(WindowArray, Length(WindowArray) + 1);
    WindowArray[Length(WindowArray) - 1] := Root;
  end;
  StackPtr := 0;
  Stack[StackPtr].Position := 0;
  XQueryTree(Display, Root, @Wnd, @Wnd,
     @(Stack[StackPtr].Children), @(Stack[StackPtr].NChildren));
  while True do
  if Stack[StackPtr].Position < Stack[StackPtr].NChildren then
  begin
    Wnd := Stack[StackPtr].Children^[Stack[StackPtr].Position];
    XFetchName(Display, Wnd, @retName);
    if Pos(Name, retName) > 0 then
    begin
      SetLength(Names, Length(Names) + 1);
      Names[Length(Names) - 1] := retName;
      SetLength(WindowArray, Length(WindowArray) + 1);
      WindowArray[Length(WindowArray) - 1] := Wnd;
    end;
    begin
      XFree(retName);
      if StackPtr < StackDepth - 1 then
      begin
        Inc(StackPtr);
        XQueryTree(Display, Wnd, @Wnd, @Wnd,
   @(Stack[StackPtr].Children), @(Stack[StackPtr].NChildren));
        Stack[StackPtr].Position := 0;
      end else Inc(Stack[StackPtr].Position);
    end;
  end else
  begin
    XFree(Stack[StackPtr].Children);
    Dec(StackPtr);
    if StackPtr = -1 then Exit;
    Inc(Stack[StackPtr].Position);
  end;
end;

procedure FindAllPSTables(var WindowArray : TWindowArray; var Names : TArrayString);
var
  Display: PDisplay;
  Root : TWindow;
begin
  Display := XOpenDisplay(nil);
  Root := XDefaultRootWindow(Display);
  FindXWindowsByMask(Display, Root, 'Table', WindowArray, Names);
end;

procedure PixBufToBitmap(var Image : PGdkPixbuf; var Bitmap : TBitmap);
var
  width, height, rowstride, n_channels, i, j : Integer;
  pixels, p : Pguchar;
begin
  n_channels := gdk_pixbuf_get_n_channels(Image);
  width := gdk_pixbuf_get_width(image);
  height := gdk_pixbuf_get_height(image);
  rowstride := gdk_pixbuf_get_rowstride(image);
  pixels := gdk_pixbuf_get_pixels(Image);
  Bitmap := TMyBitmap.Create;
  Bitmap.Height := height;
  Bitmap.Width := width;
  Bitmap.PixelFormat := pf32bit;

  for i := 0 to width do
    for j := 0 to height do
    begin
      p := pixels + j * rowstride + i * n_channels;
      Bitmap.Canvas.Pixels[i, j] := RGBToColor(Ord(p^),Ord((p+1)^),Ord((p+2)^));
    end;
end;

procedure GetWindowScreenShot(Window : TMyWindow; var Bitmap : TMyBitmap);
var
  Display: PDisplay;
  Image : PGdkPixbuf;
  wa : TXWindowAttributes;
begin
  Display := XOpenDisplay(nil);
  XGetWindowAttributes(Display, Window, @wa);
  gdk_pixbuf_xlib_init(Display, 0);
  image := gdk_pixbuf_xlib_get_from_drawable(nil, Window, 0, nil, 0, 0, 0, 0,
                                             wa.width, wa.height);
  PixBufToBitmap(Image, Bitmap);
//gdk_pixbuf_save(image, 'test.bmp', 'bmp', nil, [0]);
end;

{$ENDIF}
end.           


Добавлено спустя 2 минуты 47 секунд:
пиксбуф в лазаре есть - но не полностью (если точнее - частично неправильно...) в модуле до объявлял функции... а цель такая - скринить окна название которых совпадает по маске с заданным текстом... В приведённом коде всё работает - но медленно... Писал сам опираясь на авось и научный тык...
Zinchenko.Sergey
незнакомец
 
Сообщения: 3
Зарегистрирован: 18.08.2009 23:23:14

Re: Из TPixBuf в TBitmap

Сообщение carrots » 28.09.2009 00:54:58

Попробуй так:
Код: Выделить всё
procedure PixBufToBitmap(var Image : PGdkPixbuf; var Bitmap : TBitmap);
var
  width, height, rowstride, n_channels, i, j : Integer;
  pixels, p : Pguchar;
begin
  n_channels := gdk_pixbuf_get_n_channels(Image);
  width := gdk_pixbuf_get_width(image);
  height := gdk_pixbuf_get_height(image);
  rowstride := gdk_pixbuf_get_rowstride(image);
  pixels := gdk_pixbuf_get_pixels(Image);
  Bitmap := TMyBitmap.Create;
  Bitmap.Height := height;
  Bitmap.Width := width;
  Bitmap.PixelFormat := pf32bit;

  Bitmap.Canvas.Clear;
  for i := 0 to Width-1 do
    for J := 0 to Height-1 do
    begin
      p := pixels + j * rowstride + i * n_channels;
      PByteArray(Bitmap.RawImage.Data)^[(((J*Width)+i)*4)] := Ord((p+2)^);  // +2
      PByteArray(Bitmap.RawImage.Data)^[(((J*Width)+i)*4)+1] := Ord((p+1)^);// +1
      PByteArray(Bitmap.RawImage.Data)^[(((J*Width)+i)*4)+2] := Ord(p^);// +0
      PByteArray(Bitmap.RawImage.Data)^[(((J*Width)+i)*4)+3] := 0;
    end;
  Bitmap.LoadFromRawImage(Bitmap.RawImage,true);

end; 


Добавлено спустя 52 минуты 58 секунд:
Более надежный вариант, но в его случае нужно будет использовать IntfGraphics:
Код: Выделить всё
procedure PixBufToBitmap(var Image : PGdkPixbuf; var Bitmap : TBitmap);
var
  width, height, rowstride, n_channels, i, j : Integer;
  pixels, p : Pguchar;
  BmpData: TLazIntfImage;
begin
  n_channels := gdk_pixbuf_get_n_channels(Image);
  width := gdk_pixbuf_get_width(image);
  height := gdk_pixbuf_get_height(image);
  rowstride := gdk_pixbuf_get_rowstride(image);
  pixels := gdk_pixbuf_get_pixels(Image);
  Bitmap := TMyBitmap.Create;
  Bitmap.Height := height;
  Bitmap.Width := width;
  Bitmap.PixelFormat := pf32bit;

  BmpData := Bitmap.CreateIntfImage;
  try
  for i := 0 to Width-1 do
    for J := 0 to Height-1 do
    begin
      p := pixels + j * rowstride + i * n_channels;
      PByteArray(BmpData.PixelData)^[(((J*Width)+i)*4)] := Ord((p+2)^);  // +2
      PByteArray(BmpData.PixelData)^[(((J*Width)+i)*4)+1] := Ord((p+1)^);// +1
      PByteArray(BmpData.PixelData)^[(((J*Width)+i)*4)+2] := Ord(p^);// +0
      PByteArray(BmpData.PixelData)^[(((J*Width)+i)*4)+3] := 0;
    end;
  Bitmap.LoadFromIntfImage(BmpData);
  finally
  BmpData.Free;
  end;
end;
Аватара пользователя
carrots
постоялец
 
Сообщения: 138
Зарегистрирован: 28.03.2008 02:13:02


Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 39

Рейтинг@Mail.ru