الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

تحويل Hbitmap To Jpeg من غير اضافه Jpeg في اليوزس

بدأه super_rio في 27 فبراير 2008 · 2 رد · 790 مشاهدة · في لغة Delphi
مشاركة: واتساب X فيسبوك تيليجرام
#1 صاحب الموضوع
  



function GetBitmapFromDesktop: HBitmap;
var
  DC, MemDC: HDC;
  Bitmap, OBitmap: HBitmap;
  BitmapWidth, BitmapHeight: integer;
begin
  DC := GetDC(GetDesktopWindow);
  MemDC := CreateCompatibleDC(DC);
  BitmapWidth := GetDeviceCaps(DC, 8);
  BitmapHeight := GetDeviceCaps(DC, 10);
  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;
function SaveBitmapToFile ( h_Bitmap : HBITMAP; lpFileName : PChar ) :
integer
 ;
var
  h_DC : HDC;
  iBits : integer;
  wBitCount : WORD;
  dwPaletteSize ,
	dwBmBitsSize ,
	dwDIBSize , dwWritten : DWORD;
  _Bitmap : BITMAP;
  bmfHdr : BITMAPFILEHEADER;
  bi : BITMAPINFOHEADER;
  lpbi : PBITMAPINFOHEADER;
  fh , hDib , hPal , hOldPal : HWND;
begin
  hOldPal := 0;
  dwPaletteSize := 0;
  Result := 0;

  h_DC := CreateDC ( 'DISPLAY' , nil , nil , nil );
  iBits := GetDeviceCaps ( h_DC , BITSPIXEL ) * GetDeviceCaps ( h_DC , 
PLANES )
   ;
  DeleteDC ( h_DC );
  if ( iBits <= 1 ) then
	wBitCount := 1
  else
	if ( iBits <= 4 ) then
	wBitCount := 4
  else
	if ( iBits <= 8 ) then
	wBitCount := 8
  else
	if ( iBits <= 24 ) then
	wBitCount := 24
  else
	if ( iBits <= 32 ) then
	wBitCount := 32;
  if ( wBitCount <= 8 ) then
	dwPaletteSize := ( 1 shr wBitCount ) * sizeof ( RGBQUAD );
  GetObject ( h_Bitmap , sizeof ( BITMAP ) , @_Bitmap );
  bi.biSize := sizeof ( BITMAPINFOHEADER );
  bi.biWidth := _Bitmap.bmWidth;
  bi.biHeight := _Bitmap.bmHeight;
  bi.biPlanes := 1;
  bi.biBitCount := wBitCount;
  bi.biCompression := BI_RGB;
  bi.biSizeImage := 0;
  bi.biXPelsPerMeter := 0;
  bi.biYPelsPerMeter := 0;
  bi.biClrUsed := 0;
  bi.biClrImportant := 0;

  dwBmBitsSize := Round ( ( ( _Bitmap.bmWidth * wBitCount + 31 ) / 32 ) * 4 
*
	_Bitmap.bmHeight );

  hDib := GlobalAlloc ( GHND , dwBmBitsSize + dwPaletteSize +
	sizeof ( BITMAPINFOHEADER ) );
  lpbi := PBITMAPINFOHEADER ( GlobalLock ( hDib ) );
  lpbi^ := bi;
  hPal := GetStockObject ( DEFAULT_PALETTE );
  if ( hPal <> 0 ) then
	begin
	  h_DC := GetDC ( 0 );
	  hOldPal := SelectPalette ( h_DC , HPALETTE ( hPal ) , FALSE );
	  RealizePalette ( h_DC );
	end;
  GetDIBits ( h_DC , h_Bitmap , 0 , _Bitmap.bmHeight , nil , PBITMAPINFO ( 
lpbi
	) ^ , DIB_RGB_COLORS ); //
  if ( hOldPal <> 0 ) then
	begin
	  SelectPalette ( h_DC , HPALETTE ( hOldPal ) , TRUE );
	  RealizePalette ( h_DC );
	  ReleaseDC ( 0 , h_DC );
	end;
  fh :=
	CreateFile ( lpFileName , GENERIC_WRITE , 0 , nil , CREATE_ALWAYS ,
	FILE_ATTRIBUTE_NORMAL + FILE_FLAG_SEQUENTIAL_SCAN , 0 );
  if ( fh = INVALID_HANDLE_VALUE ) then
	exit;
  bmfHdr.bfType := $4D42; // "BM"
  dwDIBSize := sizeof ( BITMAPFILEHEADER ) + sizeof ( BITMAPINFOHEADER ) +
	dwPaletteSize + dwBmBitsSize;
  bmfHdr.bfSize := dwDIBSize;
  bmfHdr.bfReserved1 := 0;
  bmfHdr.bfReserved2 := 0;
  bmfHdr.bfOffBits := DWORD ( sizeof ( BITMAPFILEHEADER ) ) +
	DWORD ( sizeof ( BITMAPINFOHEADER ) ) + dwPaletteSize;

  WriteFile ( fh , bmfHdr , sizeof ( BITMAPFILEHEADER ) , dwWritten , nil );
  WriteFile ( fh , lpbi^ , dwDIBSize , dwWritten , nil );
  GlobalUnlock ( hDib );
  GlobalFree ( hDib );
  CloseHandle ( fh );
  Result := dwWritten;

end;


begin
   SaveBitmapToFile(GetBitMapFromDesktop,'m.bmp')

end.

هذا الكود ما توصلت ايه وهو كود محول من لغه السي ولكن ما احصل عليه هو صوره سوداء

#2

اخي هات كود السي

أضاعوني وأي فتى أضاعـوا * * * ليـوم كــريهـة وســـداد ثغــــر

وخـــــلونـي ومعتـرك المنايـا * * * وقد شـــرعوا أسنــتهم لنحـري

كأني لم أكــــــن فيهـم وسيطـا * * * ولم تك نســبتي في آل عمــرو

أجرر في الجـــوامع كـل يـوم * * * ألا لله مظــــلمتـي وهـصـــري

عسى الملك المجيب لمن دعاه * * * سينجيني فيعلم كيــف شكـري

فأجـــزي بالكرامـة أهـل ودي * * * وأجزي بالضـغينة أهل ضري

منتديات الرياضيات العربية

#3

هل هناك اي كود يستطيع ضغطها بدون اضافه jpeg

لليوزس

مواضيع مشابهة