?
Solved

saving a Bitmap image (non-VCL)

Posted on 2003-03-30
4
Medium Priority
?
492 Views
Last Modified: 2010-04-03
hello im trying to save a Screen Capture to a .bmp file.
http://delphi.skyfire.ca/Imaging/Bitmaps/SaveBitMap.html
but it seems he wrote the header wrong, since nothing but MSPaint reads it correctly, and some anomalys occur..

API only please, im not going to use the vcl
0
Comment
Question by:SabrWolf
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
4 Comments
 
LVL 34

Accepted Solution

by:
Slick812 earned 180 total points
ID: 8240947
hello --, The link you gave does not seem to work, but your problem might be that you are saving a Device Dependent Bitmap to file, I don't guess that most Graphic Editors will read DDB, since that has not been used for Bmp files since 93? ? You ask this question for 40 points, like it is simple, but dealing with API Bitmaps is very frustrating. . .Anyway, here is some code for a procedure that creates a Divice Independent Bitmap , DIB, and saves it to file.



procedure DibBmpToFile;
var
BmpDC, hDibBmp, FormDC, hBrush: Integer;
BitInfo1: TBitmapInfo;
pBits: pointer;
DibS: TDIBSection;
BFH1: TBitmapFileHeader;
hFile1, BytesWrite: Cardinal;
PalColors: array[Byte] of TRGBQuad;
begin
{Incase You need a Palette Bitmap with
BitInfo1.bmiHeader.biBitCount set to 1, 4. or 8
you will need to define your Palette}
ZeroMemory(@PalColors, sizeOf(PalColors));
PalColors[1].rgbBlue := 255;
PalColors[1].rgbGreen := 255;
PalColors[1].rgbRed := 255;
PalColors[2].rgbBlue := 255;
PalColors[3].rgbGreen := 255;
PalColors[4].rgbRed := 255;
PalColors[5].rgbBlue := 255;
PalColors[5].rgbRed := 255;
PalColors[6].rgbBlue := 255;
PalColors[6].rgbGreen := 255;
PalColors[7].rgbGreen := 255;
PalColors[7].rgbRed := 255;
PalColors[8].rgbGreen := 128;
PalColors[8].rgbRed := 128;
PalColors[8].rgbBlue := 128;
PalColors[9].rgbRed := 192;
PalColors[9].rgbGreen := 192;
PalColors[9].rgbBlue := 192;
PalColors[10].rgbRed := 128;
PalColors[11].rgbGreen := 128;
PalColors[12].rgbBlue := 128;
PalColors[13].rgbBlue := 128;
PalColors[13].rgbRed := 128;
PalColors[14].rgbGreen := 128;
PalColors[14].rgbRed := 128;
PalColors[15].rgbGreen := 128;
PalColors[15].rgbBlue := 128;
{the palette colors above are for the standard 16 colors
you can add the colors for index 16 - 255 if you need them}

ZeroMemory(@BitInfo1, sizeOf(BitInfo1));
BitInfo1.bmiHeader.biSize := sizeOf(BitInfo1.bmiHeader);
BitInfo1.bmiHeader.biBitCount := 8;
{IMPORTANT
you can change the Color Depth of the created DIB Bitmap here
with biBitCount, Values can be 1, 4, 8, 24 and 32}

BitInfo1.bmiHeader.biCompression := BI_RGB;
BitInfo1.bmiHeader.biWidth := 84;
BitInfo1.bmiHeader.biHeight := 30;
//BitInfo1.bmiHeader.biXPelsPerMeter := 5;
//BitInfo1.bmiHeader.biYPelsPerMeter := 5;
BitInfo1.bmiHeader.biPlanes := 1;
if BitInfo1.bmiHeader.biBitCount < 9 then
  begin
  {if you use a Palette then set the palette here}
  if BitInfo1.bmiHeader.biBitCount = 1 then
  hFile1 := 2*SizeOf(TRGBQuad) else
  if BitInfo1.bmiHeader.biBitCount = 4 then
  hFile1 := 16*SizeOf(TRGBQuad) else
  hFile1 := sizeof(PalColors);
  Move(PalColors, BitInfo1.bmiColors, hFile1);
  end;

pBits := nil;
BmpDC := CreateCompatibleDC(0);
hDibBmp := CreateDIBSection(BmpDC, BitInfo1, DIB_RGB_COLORS, pBits, 0, 0);
{CreateDIBSection will create a DIB, since the pBits is nil, no color bits are set}
if hDibBmp = 0 then
  begin
  DeleteDC(BmpDC);
  MessageBox(hForm1, 'ERROR - hDibBmp is Zero', 'ERROR for Dib Creation', MB_ICONINFORMATION);
  Exit;
  end;


SelectObject(BmpDC, hDibBmp);
hBrush := CreateSolidBrush($008080);
SelectObject(BmpDC, hBrush);
PatBlt(BmpDC,0,0,90, 30, PATCOPY);
SelectObject(BmpDC, GetStockObject(WHITE_PEN));
Rectangle(BmpDc,2,2,82,28);
SetBkMode(BmpDC, 1);
TextOut(BmpDC, 4,6, 'DIB Bitmap', 10);
{change the Bitmap by Drawing on BmpDC}

FormDC := GetDC(hForm1);
BitBlt(FormDC, 200,1, 84, 30, BmpDC,0,0, SRCCOPY);
ReleaseDC(hForm1,FormDC);
DeleteObject(hBrush);

DibS.dsbmih.biSize := sizeOf(DibS.dsbmih);
GetObject(hDibBmp, SizeOf(DibS), @DibS);
{you need to get the Information from the DIB with GetObject}
if DibS.dsbmih.biClrUsed > 0 then
GetDIBColorTable(BmpDC,0, DibS.dsbmih.biClrUsed-1, PalColors);
{the palette colors are already in PalColors, but this shows how to
get them from the DIB}
DeleteDC(BmpDC);
{be sure to Clean up by Deleting what you create}
FillChar(BFH1, sizeof(BFH1), 0);
BFH1.bfType := $4D42;
BFH1.bfOffBits := sizeof(BFH1)+BitInfo1.bmiHeader.biSize+(DibS.dsbmih.biClrUsed * SizeOf(TRGBQUAD));
BFH1.bfSize := BFH1.bfOffBits + DibS.dsbmih.biSizeImage;
hFile1 := CreateFile('E:\DibBmp1.bmp',GENERIC_WRITE,FILE_SHARE_READ,nil,CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN,0);
if hFile1 <> INVALID_HANDLE_VALUE then
  begin
  WriteFile(hFile1,BFH1, SizeOf(BFH1), BytesWrite, nil);
{write BMP file header}
  WriteFile(hFile1,DibS.dsBmih, SizeOf(DibS.dsBmih), BytesWrite, nil);
{write Bmp Info Header}
  if DibS.dsbmih.biClrUsed > 0 then
  WriteFile(hFile1,PalColors, DibS.dsbmih.biClrUsed * SizeOf(TRGBQUAD), BytesWrite, nil);
{write Palette color defintions if they are needed}
  WriteFile(hFile1,DibS.dsbm.bmBits^, DibS.dsbmih.biSizeImage, BytesWrite, nil);
{write Pixel color Bits defintions}
  CloseHandle(hFile1);
  end;
DeleteObject(hDibBmp);
end;




- - - - - - - - - - - - - - - - - - - - - - - - - - - - -

You should really just add the Graphics unit to your uses clause and use the TBitmap. . .
ask questions if you need more info
0
 

Author Comment

by:SabrWolf
ID: 8244311
thanks allot man, just one more thingy
ur function works ok if i try assigning hDibBmp as lets say Image1.Picture.Bitmap.Handle
but im capturing the screen ( also API ), heres the function :

procedure CapScreen;
var
dc,MemDc : hdc;
MemBitmap,OldMemBitmap  : hBitmap;
begin
dc := getdc(0);
MemDc := CreateCompatibleDc(dc);
MemBitmap := CreateCompatibleBitmap(dc, 512, 404);
OldMemBitmap := SelectObject(MemDc, MemBitmap);
BitBlt(MemDc,0 ,0, 512, 384, DC, Trunc((ix-512)/4), Trunc((iy-384)/4), SRCCOPY);
SaveBMP(MemBitmap);
DeleteDc(MemDc);
DeleteObject(MemBitmap);
end;

SaveBMP is ur function.
i get a file with only the BMP header and no image.
0
 

Author Comment

by:SabrWolf
ID: 8245966
found out myself, thanks allot ! i wish i could give u more points but i dont have any more :(
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Sometimes it takes a new vantage point, apart from our everyday security practices, to truly see our Active Directory (AD) vulnerabilities. We get used to implementing the same techniques and checking the same areas for a breach. This pattern can re…
In this video, Percona Solution Engineer Dimitri Vanoverbeke discusses why you want to use at least three nodes in a database cluster. To discuss how Percona Consulting can help with your design and architecture needs for your database and infras…
Suggested Courses
Course of the Month12 days, 12 hours left to enroll

777 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question