Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Мультимедиа
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 05.12.2012, 13:24
reqyz reqyz вне форума
Начинающий
 
Регистрация: 13.02.2010
Сообщения: 104
Репутация: 10
По умолчанию HDC в файл

Добрый день знатоки) помогите с переводом из HDC в файл. поясню, функцией GetWindowDC получаю HDC окна, как мне далее, используя только winapi сохранить в файл то что там внутри, если я знаю размеры изображения... выражусь иначе на всякий случай, как мне узнать область памяти где хранится изображение ну и т д, в общем получить ту картинку не используя модуль графикс и т д, только апикой?
Ответить с цитированием
  #2  
Старый 05.12.2012, 13:37
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

через BitBlt отрисуй свой device context на предварительно созданый device context BITMAP'а и сохряняй BITMAP в файл. пример есть в Win32 SDK Reference.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #3  
Старый 05.12.2012, 13:53
reqyz reqyz вне форума
Начинающий
 
Регистрация: 13.02.2010
Сообщения: 104
Репутация: 10
По умолчанию

да про BitBlt знаю, я не знаю как создать свой HDC и как потом до указателя на памть всего этого дела дойти, я в графике не очень) интернет копал, нашёл что то на английском и не на делфях, не помого( там не много строчек будет? может поможете подробней?
Ответить с цитированием
  #4  
Старый 05.12.2012, 14:13
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

много писать лень, да и некогда, собираюсь в Assassin’s Creed III зарубить...
а так CreateCompatibleDC, CreateBitmap, SelectObject, BitBlt, GetDIBits...
вообщем можно у TBitmap в Graphics посмотреть сохранение или в Win32 SDK Reference.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #5  
Старый 05.12.2012, 14:25
reqyz reqyz вне форума
Начинающий
 
Регистрация: 13.02.2010
Сообщения: 104
Репутация: 10
По умолчанию

Ладно, в графикс тбитмап первым делом посмотрел, но там извращение такое %-| фиг чего уследишь) сейчас сишную в делфю перевести пытаюсь

преобразовал вот это
Код:
inline int GetFilePointer(HANDLE FileHandle){
	return SetFilePointer(FileHandle, 0, 0, FILE_CURRENT);
}

bool SaveBMPFile(char *filename, HBITMAP bitmap, HDC bitmapDC, int width, int height){
	bool Success=0;
	HDC SurfDC=NULL;
	HBITMAP OffscrBmp=NULL;
	HDC OffscrDC=NULL;
	LPBITMAPINFO lpbi=NULL;
	LPVOID lpvBits=NULL;
	HANDLE BmpFile=INVALID_HANDLE_VALUE;
	BITMAPFILEHEADER bmfh;
	if ((OffscrBmp = CreateCompatibleBitmap(bitmapDC, width, height)) == NULL)
		return 0;
	if ((OffscrDC = CreateCompatibleDC(bitmapDC)) == NULL)
		return 0;
	HBITMAP OldBmp = (HBITMAP)SelectObject(OffscrDC, OffscrBmp);
	BitBlt(OffscrDC, 0, 0, width, height, bitmapDC, 0, 0, SRCCOPY);
	if ((lpbi = (LPBITMAPINFO)(new char[sizeof(BITMAPINFOHEADER) + 256 * sizeof(RGBQUAD)])) == NULL) 
		return 0;
	ZeroMemory(&lpbi->bmiHeader, sizeof(BITMAPINFOHEADER));
	lpbi->bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
	SelectObject(OffscrDC, OldBmp);
	if (!GetDIBits(OffscrDC, OffscrBmp, 0, height, NULL, lpbi, DIB_RGB_COLORS))
		return 0;
	if ((lpvBits = new char[lpbi->bmiHeader.biSizeImage]) == NULL)
		return 0;
	if (!GetDIBits(OffscrDC, OffscrBmp, 0, height, lpvBits, lpbi, DIB_RGB_COLORS))
		return 0;
	if ((BmpFile = CreateFile(filename,
						GENERIC_WRITE,
						0, NULL,
						CREATE_ALWAYS,
						FILE_ATTRIBUTE_NORMAL,
						NULL)) == INVALID_HANDLE_VALUE)
		return 0;
	DWORD Written;
	bmfh.bfType = 19778;
	bmfh.bfReserved1 = bmfh.bfReserved2 = 0;
	if (!WriteFile(BmpFile, &bmfh, sizeof(bmfh), &Written, NULL))
		return 0;
	if (Written < sizeof(bmfh)) 
		return 0; 
	if (!WriteFile(BmpFile, &lpbi->bmiHeader, sizeof(BITMAPINFOHEADER), &Written, NULL)) 
		return 0;
	if (Written < sizeof(BITMAPINFOHEADER)) 
		return 0;
	int PalEntries;
	if (lpbi->bmiHeader.biCompression == BI_BITFIELDS) 
		PalEntries = 3;
	else PalEntries = (lpbi->bmiHeader.biBitCount <= 8) ?
					  (int)(1 << lpbi->bmiHeader.biBitCount) : 0;
	if(lpbi->bmiHeader.biClrUsed) 
	PalEntries = lpbi->bmiHeader.biClrUsed;
	if(PalEntries){
	if (!WriteFile(BmpFile, &lpbi->bmiColors, PalEntries * sizeof(RGBQUAD), &Written, NULL)) 
		return 0;
		if (Written < PalEntries * sizeof(RGBQUAD)) 
			return 0;
	}
	bmfh.bfOffBits = GetFilePointer(BmpFile);
	if (!WriteFile(BmpFile, lpvBits, lpbi->bmiHeader.biSizeImage, &Written, NULL)) 
		return 0;
	if (Written < lpbi->bmiHeader.biSizeImage) 
		return 0;
	bmfh.bfSize = GetFilePointer(BmpFile);
	SetFilePointer(BmpFile, 0, 0, FILE_BEGIN);
	if (!WriteFile(BmpFile, &bmfh, sizeof(bmfh), &Written, NULL))
		return 0;
	if (Written < sizeof(bmfh)) 
		return 0;
	return 1;
}]
в это
Код:
function SaveBMPFile(filename:PChar;bitmap:HBITMAP;width,height:integer):boolean;
var
  Success:boolean;
  SurfDC,OffscrDC:HDC;
  OffscrBmp,OldBmp:HBITMAP;
  lpbi:PBitmapInfo;
//  lpvBits:LPVOID;
  BmpFile:THANDLE;
  bmfh:BITMAPFILEHEADER;
  lpvBits:Pointer;
  Written:DWORD;
  PalEntries:integer;
//
  bitmapDC:HDC;
begin

  bitmapDC:=GetWindowDC(bitmap);
//  bitmap:=GetBitmapFromDesktop(bitmapDC);
	Success:=false;
	SurfDC:=0;
	OffscrBmp:=0;
	OffscrDC:=0;
	lpbi:=nil;
//	lpvBits=NULL;
  BmpFile:=INVALID_HANDLE_VALUE;
  Result:=false;
  OffscrBmp := CreateCompatibleBitmap(bitmapDC, width, height);
	if (OffscrBmp = NULL)then
		exit;
  OffscrDC := CreateCompatibleDC(bitmapDC);
	if (OffscrDC = NULL)then
		exit;
	OldBmp := HBITMAP(SelectObject(OffscrDC, OffscrBmp));
	BitBlt(OffscrDC, 0, 0, width, height, bitmapDC, 0, 0, SRCCOPY);
  getmem(lpbi,sizeof(BITMAPINFOHEADER) + 256 * sizeof(RGBQUAD));
	if (lpbi = nil)then
		exit;
  FillChar(lpbi.bmiHeader,sizeof(BITMAPINFOHEADER),#0);
	lpbi.bmiHeader.biSize := sizeof(BITMAPINFOHEADER);
	SelectObject(OffscrDC, OldBmp);
	if(GetDIBits(OffscrDC, OffscrBmp, 0, height, nil, lpbi^, DIB_RGB_COLORS)=0)then
		exit;
  GetMem(lpvBits, lpbi^.bmiHeader.biSizeImage);
//  if lpvBits = nil then ...}

	if (lpvBits = nil)then
		exit;
	if (GetDIBits(OffscrDC, OffscrBmp, 0, height, lpvBits, lpbi^, DIB_RGB_COLORS)=0)then
		exit;
  BmpFile:= CreateFile(filename,
						GENERIC_WRITE,
						0, nil,
						CREATE_ALWAYS,
						FILE_ATTRIBUTE_NORMAL,
						0);
	if (BmpFile = INVALID_HANDLE_VALUE)then
		exit;
	bmfh.bfType := 19778;
	bmfh.bfReserved1 := 0;
  bmfh.bfReserved2 := 0;
	if (not WriteFile(BmpFile, bmfh, sizeof(bmfh), Written, nil))then
		exit;
	if (Written < sizeof(bmfh))then
		exit;
	if (not WriteFile(BmpFile, lpbi.bmiHeader, sizeof(BITMAPINFOHEADER), Written, nil))then
		exit;
	if (Written < sizeof(BITMAPINFOHEADER))then
		exit;
	if (lpbi.bmiHeader.biCompression = BI_BITFIELDS)then
		PalEntries := 3
	else
  if((lpbi.bmiHeader.biBitCount <= 8))then
//    PalEntries := (int)(1 << lpbi->bmiHeader.biBitCount)
  else
		PalEntries:=0;
	if(lpbi.bmiHeader.biClrUsed<>0)then
	PalEntries := lpbi.bmiHeader.biClrUsed;
	if(PalEntries<>0)then
  begin
	if (not WriteFile(BmpFile, lpbi.bmiColors, PalEntries * sizeof(RGBQUAD), Written, nil))then
		exit;
  if (Written < PalEntries * sizeof(RGBQUAD))then
		exit;
	end;
	bmfh.bfOffBits := GetFilePointer(BmpFile);
	if ( not WriteFile(BmpFile, lpvBits, lpbi.bmiHeader.biSizeImage, Written, nil))then
		exit;
	if (Written < lpbi.bmiHeader.biSizeImage)then
		exit;
	bmfh.bfSize := GetFilePointer(BmpFile);
	SetFilePointer(BmpFile, 0, 0, FILE_BEGIN);
	if (not WriteFile(BmpFile, bmfh, sizeof(bmfh), Written, nil))then
    exit;
	if (Written < sizeof(bmfh))then
		exit;
	result:=true;
end;

но не работает( помогите, подскажите, поправьте пожалуйста

Последний раз редактировалось reqyz, 05.12.2012 в 15:36.
Ответить с цитированием
  #6  
Старый 05.12.2012, 20:16
reqyz reqyz вне форума
Начинающий
 
Регистрация: 13.02.2010
Сообщения: 104
Репутация: 10
По умолчанию

Ну кто нибудь!!!! помогите, я не в том разделе написал что-ли?
Ответить с цитированием
  #7  
Старый 05.12.2012, 20:18
reqyz reqyz вне форума
Начинающий
 
Регистрация: 13.02.2010
Сообщения: 104
Репутация: 10
По умолчанию

GetDIBits вроде пиксели возвращает, отзовитесь) напишите примерчик..
Ответить с цитированием
  #8  
Старый 05.12.2012, 22:47
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

Как то писал для подобных случаев
Код:
procedure SaveBitmap(Name : String; bmp : HBITMAP);
var
  FileHandle	: THandle;
  Size, Res,
  HeaderSize	: DWORD;
  BFH		: TBITMAPFILEHEADER;
  BIH		: TBITMAPINFOHEADER;
  FDIB		: TDIBSection;

  function BytesPerScanline(PixelsPerScanline, BitsPerPixel, Alignment: Longint): Longint;
  begin
    dec(Alignment);
    Result := ((PixelsPerScanline * BitsPerPixel) + Alignment) and not Alignment;
    Result := Result div 8;
  end;

  procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP; var BI: TBitmapInfoHeader);
  var
    DS		: TDIBSection;
    Bytes	: Integer;
  begin
    DS.dsbmih.biSize := 0;
    Bytes := GetObject(Bitmap, SizeOf(DS), @DS);
    if (Bytes >= (SizeOf(DS.dsbm) + SizeOf(DS.dsbmih))) and (DS.dsbmih.biSize >= SizeOf(DS.dsbmih)) then
      BI := DS.dsbmih
    else
    begin
      FillChar(BI, SizeOf(BI), 0);
      with BI, DS.dsbm do
      begin
	biSize   := SizeOf(BI);
	biWidth  := bmWidth;
	biHeight := bmHeight;
      end;
    end;
    BI.biBitCount := DS.dsbm.bmBitsPixel * DS.dsbm.bmPlanes;
    BI.biPlanes   := 1;
    if BI.biSizeImage = 0 then
      BI.biSizeImage := BytesPerScanLine(BI.biWidth, BI.biBitCount, 32) * Abs(BI.biHeight);
  end;

begin
  GetObject(bmp, SizeOf(FDIB), @FDIB);
  with FDIB, dsbm, dsbmih do
  begin
    biSize     := sizeof(dsbmih);
    biWidth    := bmWidth;
    biHeight   := bmHeight;
    biPlanes   := 1;
    biBitCount := bmPlanes * bmBitsPixel;
  end;
  
  InitializeBitmapInfoHeader(Bmp, BIH);
  HeaderSize := SizeOf(TBitmapInfoHeader);
  Size := BIH.biSizeImage;
  inc(Size, HeaderSize + SizeOf(BFH));

  FillChar(BFH, SizeOf(BFH), 0);
  BFH.bfType    := $4D42;
  BFH.bfSize    := Size;
  BFH.bfOffBits := SizeOf(BFH) + HeaderSize;

  FileHandle := CreateFile(PChar(Name + '.bmp'), GENERIC_WRITE, FILE_SHARE_WRITE, NIL, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  WriteFile(FileHandle, BfH, SizeOf(BFH), Res, NIL);
  WriteFile(FileHandle, FDIB.dsbmih, SizeOf(FDIB.dsbmih), Res, NIL);
  WriteFile(FileHandle, FDIB.dsbm.bmBits^, FDIB.dsbmih.biSizeImage, Res, NIL);
  CloseHandle(FileHandle);
end;
Рассчитпно на 24-битный битмап.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
Этот пользователь сказал Спасибо angvelem за это полезное сообщение:
reqyz (06.12.2012)
  #9  
Старый 06.12.2012, 05:32
reqyz reqyz вне форума
Начинающий
 
Регистрация: 13.02.2010
Сообщения: 104
Репутация: 10
По умолчанию

Цитата:
Сообщение от angvelem
Как то писал для подобных случаев
Код:
procedure SaveBitmap(Name : String; bmp : HBITMAP);
var
  FileHandle	: THandle;
  Size, Res,
  HeaderSize	: DWORD;
  BFH		: TBITMAPFILEHEADER;
  BIH		: TBITMAPINFOHEADER;
  FDIB		: TDIBSection;

  function BytesPerScanline(PixelsPerScanline, BitsPerPixel, Alignment: Longint): Longint;
  begin
    dec(Alignment);
    Result := ((PixelsPerScanline * BitsPerPixel) + Alignment) and not Alignment;
    Result := Result div 8;
  end;

  procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP; var BI: TBitmapInfoHeader);
  var
    DS		: TDIBSection;
    Bytes	: Integer;
  begin
    DS.dsbmih.biSize := 0;
    Bytes := GetObject(Bitmap, SizeOf(DS), @DS);
    if (Bytes >= (SizeOf(DS.dsbm) + SizeOf(DS.dsbmih))) and (DS.dsbmih.biSize >= SizeOf(DS.dsbmih)) then
      BI := DS.dsbmih
    else
    begin
      FillChar(BI, SizeOf(BI), 0);
      with BI, DS.dsbm do
      begin
	biSize   := SizeOf(BI);
	biWidth  := bmWidth;
	biHeight := bmHeight;
      end;
    end;
    BI.biBitCount := DS.dsbm.bmBitsPixel * DS.dsbm.bmPlanes;
    BI.biPlanes   := 1;
    if BI.biSizeImage = 0 then
      BI.biSizeImage := BytesPerScanLine(BI.biWidth, BI.biBitCount, 32) * Abs(BI.biHeight);
  end;

begin
  GetObject(bmp, SizeOf(FDIB), @FDIB);
  with FDIB, dsbm, dsbmih do
  begin
    biSize     := sizeof(dsbmih);
    biWidth    := bmWidth;
    biHeight   := bmHeight;
    biPlanes   := 1;
    biBitCount := bmPlanes * bmBitsPixel;
  end;
  
  InitializeBitmapInfoHeader(Bmp, BIH);
  HeaderSize := SizeOf(TBitmapInfoHeader);
  Size := BIH.biSizeImage;
  inc(Size, HeaderSize + SizeOf(BFH));

  FillChar(BFH, SizeOf(BFH), 0);
  BFH.bfType    := $4D42;
  BFH.bfSize    := Size;
  BFH.bfOffBits := SizeOf(BFH) + HeaderSize;

  FileHandle := CreateFile(PChar(Name + '.bmp'), GENERIC_WRITE, FILE_SHARE_WRITE, NIL, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  WriteFile(FileHandle, BfH, SizeOf(BFH), Res, NIL);
  WriteFile(FileHandle, FDIB.dsbmih, SizeOf(FDIB.dsbmih), Res, NIL);
  WriteFile(FileHandle, FDIB.dsbm.bmBits^, FDIB.dsbmih.biSizeImage, Res, NIL);
  CloseHandle(FileHandle);
end;
Рассчитпно на 24-битный битмап.

Спасибо) только не работает

получаю HBitmap таким способом:
Код:
function GetDesktopBitmap: HBitmap;
var
 DC, MemDC: HDC;
 Bitmap, OBitmap: HBitmap;
 BitmapWidth, BitmapHeight: integer;
begin
 DC := GetDC(GetDesktopWindow);
 MemDC := CreateCompatibleDC(DC);
 BitmapWidth := GetDeviceCaps(DC, HORZRES);
 BitmapHeight := GetDeviceCaps(DC, VERTRES);

 Bitmap := CreateCompatibleBitmap(DC, BitmapWidth, BitmapHeight);
 OBitmap := SelectObject(MemDC, Bitmap);
 BitBlt(MemDC, 0, 0, BitmapWidth, BitmapHeight, DC, 0, 0, SRCCOPY);
 SelectObject(MemDC, OBitmap);
 DeleteDC(MemDC);
 ReleaseDC(GetDesktopWindow, DC);
 Result := Bitmap;
end;

вызываю всё так:
Код:
    SaveBitmap(SaveDialog1.FileName,GetDesktopBitmap);

в итоге получаю пустой файл( что тут не так? где ошибка?
Ответить с цитированием
  #10  
Старый 06.12.2012, 09:53
reqyz reqyz вне форума
Начинающий
 
Регистрация: 13.02.2010
Сообщения: 104
Репутация: 10
По умолчанию

Ну, спасибо что хоть зашли сюда, но справляться самому пришлось, привожу рабочий код на делфи, вдруг кто нибудь захочет сохранять HDC в BMP файл:
Код:
function DibNumColors(pv:pointer):WORD;
var
  bits:Integer;
  lpbi:PBITMAPINFOHEADER;
  lpbc:PBITMAPCOREHEADER;
begin
  lpbi := PBITMAPINFOHEADER(pv);
  lpbc := PBITMAPCOREHEADER(pv);

  if (lpbi^.biSize <> sizeof(BITMAPCOREHEADER))then
  begin
    if (lpbi^.biClrUsed <> 0)then
    begin
      Result:=lpbi^.biClrUsed;
      exit;
    end;
    bits := lpbi^.biBitCount;
  end
  else
    bits := lpbc^.bcBitCount;

  case (bits) of
    1: Result := 2;
    4: Result := 16;
    8: Result := 256;
    else
      Result:=0
  end;
end;


function PaletteSize(lpbi:PBITMAPINFOHEADER):WORD;
var
  NumColors:WORD;
begin
    NumColors := DibNumColors(lpbi);
    if (lpbi^.biSize = sizeof(BITMAPCOREHEADER))then
        Result := (NumColors * sizeof(RGBTRIPLE))
    else
        Result := (NumColors * sizeof(RGBQUAD));
end;


procedure WriteMapFileHeaderandConvertFromDwordAlignToPacked(fh:HFILE;pbf:PBITMAPFILEHEADER);
begin
  _lwrite(fh, @pbf^.bfType, sizeof (WORD));
  _lwrite(fh, @pbf^.bfSize, sizeof(DWORD) * 3);
end;

function lwrite(fh:Integer;pv:Pointer;ul:DWORD):DWORD;
const
  MAXREAD = 32768;
var
  ulT:DWORD;
  hp:PByte;
begin
  ulT := ul;
  hp := pv;
  Result:=0;

  while (ul > MAXREAD) do
  begin
    if (_lwrite(fh, LPSTR(hp), MAXREAD) <> MAXREAD)then
      exit;
    dec(ul,MAXREAD);
    inc(hp,MAXREAD);
  end;
  if (_lwrite(fh, LPSTR(hp), ul) <> ul)then
    exit;

  result := ulT;
end;



function WriteDIB(szFile:LPSTR;hdib:THANDLE):BOOL;
const
  BFT_BITMAP = $4d42;
  SIZEOF_BITMAPFILEHEADER_PACKED  = (
    sizeof(WORD) +
    sizeof(DWORD) +
    sizeof(WORD) +
    sizeof(WORD) +
    sizeof(DWORD));
var
  hdr:BITMAPFILEHEADER;
  lpbi:PBITMAPINFOHEADER;
  fh:HFILE;
  off:OFSTRUCT;
begin
  result:=false;
  if (hdib = 0)then
    exit;

  fh := OpenFile(szFile, off, OF_CREATE or OF_READWRITE);
  if (fh = -1)then
    exit;

  lpbi := GlobalLock(hdib);

  hdr.bfType          := BFT_BITMAP;
  hdr.bfSize          := DWORD(GlobalSize (hdib) + SIZEOF_BITMAPFILEHEADER_PACKED);
  hdr.bfReserved1     := 0;
  hdr.bfReserved2     := 0;
  hdr.bfOffBits       := DWORD(SIZEOF_BITMAPFILEHEADER_PACKED + lpbi^.biSize +
                          PaletteSize(lpbi));

{$IFDEF FIXDWORDALIGNMENT}
  _lwrite(fh, @hdr, SIZEOF_BITMAPFILEHEADER_PACKED);
{$ELSE}
  WriteMapFileHeaderandConvertFromDwordAlignToPacked(fh, @hdr);
{$ENDIF}

    lwrite (fh, LPSTR(lpbi), GlobalSize (hdib));

    GlobalUnlock (hdib);
    _lclose(fh);
    Result := TRUE;
end;

function WIDTHBYTES(i:integer):integer;
begin
  result:=round((i+31)/32*4);
end;

function DibFromBitmap(hbm:HBITMAP;biStyle:DWORD;biBits:WORD;hpal:HPALETTE):THANDLE;
var
  bm:BITMAP;
  bi:BITMAPINFOHEADER;
  lpbi:PBITMAPINFOHEADER;
  dwLen:DWORD;
  hdib,h:THANDLE;
  dc:HDC;
  p:pointer;
begin
  Result:=0;
  if (hbm=0)then
    Exit;

  if (hpal = 0)then
    hpal := GetStockObject(DEFAULT_PALETTE);//(HPALETTE__ *)

  GetObject(hbm,sizeof(bm),LPSTR(@bm));

  if (biBits = 0)then
    biBits :=  bm.bmPlanes * bm.bmBitsPixel;

  bi.biSize               := sizeof(BITMAPINFOHEADER);
  bi.biWidth              := bm.bmWidth;
  bi.biHeight             := bm.bmHeight;
  bi.biPlanes             := 1;
  bi.biBitCount           := biBits;
  bi.biCompression        := biStyle;
  bi.biSizeImage          := 0;
  bi.biXPelsPerMeter      := 0;
  bi.biYPelsPerMeter      := 0;
  bi.biClrUsed            := 0;
  bi.biClrImportant       := 0;
  dwLen  := bi.biSize + PaletteSize(@bi);

  dc := GetDC(0);
  hpal := SelectPalette(dc,hpal,FALSE);
  RealizePalette(dc);

  hdib := GlobalAlloc(GHND,dwLen);

  if (hdib<0)then
  begin
    SelectPalette(dc,hpal,FALSE);
    ReleaseDC(0,dc);
    exit;
  end;

  lpbi := GlobalLock(hdib);

  lpbi^ := bi;

  GetDIBits(dc, hbm, 0, bi.biHeight,nil, PBitMAPINFO(lpbi)^, DIB_RGB_COLORS);

  bi := lpbi^;
  GlobalUnlock(hdib);

  if (bi.biSizeImage = 0)then
  begin
    bi.biSizeImage := WIDTHBYTES(bm.bmWidth * biBits) * bm.bmHeight;

    if (biStyle <> BI_RGB)then
      bi.biSizeImage := round((bi.biSizeImage * 3) / 2);
  end;

  dwLen := bi.biSize + PaletteSize(@bi) + bi.biSizeImage;
  h := GlobalReAlloc(hdib,dwLen,0);
  if (h <> 0)then
    hdib := h
  else
  begin
    GlobalFree(hdib);
    hdib := 0;

    SelectPalette(dc,hpal,FALSE);
    ReleaseDC(0,dc);
    result:=hdib;
    exit;
  end;

  lpbi := GlobalLock(hdib);

  if (GetDIBits(dc,hbm,0,bi.biHeight,Pointer(longword(lpbi) + lpbi.biSize + PaletteSize(lpbi)),
    PBitMAPINFO(lpbi)^, DIB_RGB_COLORS) = 0)then
  begin
    GlobalUnlock(hdib);
    hdib := 0;
    SelectPalette(dc,hpal,FALSE);
    ReleaseDC(0,dc);
    Result := 0;
    exit;
  end;

  bi := lpbi^;
  GlobalUnlock(hdib);

  SelectPalette(dc,hpal,FALSE);
  ReleaseDC(0,dc);
  result:=hdib;
end;


function ScreenGrab(szFileName:PChar):boolean;
var
  xshift,yshift,xScreen,yScreen:integer;
  sz:SIZE;
  dstDC,srcDC,memDC:HDC;
  bm:HBITMAP;
  h:THANDLE;
begin
//////////////////////?????? ?????/////////////////////////////
  xshift := 0;
  yshift := 0;
  xScreen := GetSystemMetrics(SM_CXSCREEN);
  yScreen := GetSystemMetrics(SM_CYSCREEN);
	sz.cx := xScreen;
  sz.cy := yScreen;
  dstDC := GetDC(0);
  srcDC := GetWindowDC(0);
  memDC := CreateCompatibleDC(srcDC);
  bm := CreateCompatibleBitmap(dstDC,xScreen, yScreen);
  SelectObject(memDC,bm);
  BitBlt(memDC, 0, 0, sz.cx, sz.cy, srcDC,xshift, yshift, SRCCOPY);
///////////////////////////////////////////////////////////////
  h := DibFromBitmap(bm,0,16,0);
    if(not WriteDIB(szFileName,h))then
        result := FALSE
  else
  	result := TRUE;
end;
Ответить с цитированием
  #11  
Старый 06.12.2012, 11:46
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

Мой код рабочий, иначе бы не выкладывал , а вот использован неверно.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
  #12  
Старый 07.12.2012, 05:44
reqyz reqyz вне форума
Начинающий
 
Регистрация: 13.02.2010
Сообщения: 104
Репутация: 10
По умолчанию

Цитата:
Сообщение от angvelem
Мой код рабочий, иначе бы не выкладывал , а вот использован неверно.
а как верно?)
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 14:24.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter