Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium


saving a Bitmap image (non-VCL)

Posted on 2003-03-30
Medium Priority
Last Modified: 2010-04-03
hello im trying to save a Screen Capture to a .bmp file.
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
Question by:SabrWolf
  • 2
LVL 35

Accepted Solution

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;
BmpDC, hDibBmp, FormDC, hBrush: Integer;
BitInfo1: TBitmapInfo;
pBits: pointer;
DibS: TDIBSection;
BFH1: TBitmapFileHeader;
hFile1, BytesWrite: Cardinal;
PalColors: array[Byte] of TRGBQuad;
{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;
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
  {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);

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
  MessageBox(hForm1, 'ERROR - hDibBmp is Zero', 'ERROR for Dib Creation', MB_ICONINFORMATION);

SelectObject(BmpDC, hDibBmp);
hBrush := CreateSolidBrush($008080);
SelectObject(BmpDC, hBrush);
PatBlt(BmpDC,0,0,90, 30, PATCOPY);
SelectObject(BmpDC, GetStockObject(WHITE_PEN));
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);

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}
{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;
if hFile1 <> INVALID_HANDLE_VALUE then
  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}

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

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

Author Comment

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;
dc,MemDc : hdc;
MemBitmap,OldMemBitmap  : hBitmap;
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 is ur function.
i get a file with only the BMP header and no image.

Author Comment

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

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying 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

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
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…
This video shows how to quickly and easily deploy an email signature for all users in Office 365 and prevent it from being added to replies and forwards. (the resulting signature is applied on the server level in Exchange Online) The email signat…
Whether it be Exchange Server Crash Issues, Dirty Shutdown Errors or Failed to mount error, Stellar Phoenix Mailbox Exchange Recovery has always got your back. With the help of its easy to understand user interface and 3 simple steps recovery proced…
Suggested Courses
Course of the Month11 days, 20 hours left to enroll

564 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