Solved

Bmp resolution

Posted on 2001-09-01
25
493 Views
Last Modified: 2010-04-06
Hi
How can i dedermine the resolution of bitmap?
0
Comment
Question by:vterekh
[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
  • 10
  • 10
  • 4
  • +1
25 Comments
 
LVL 11

Expert Comment

by:robert_marquardt
ID: 6447399
A bitmap has no resolution. It is a two dimensional array of pixels plus a color palette.
So you can give it any resolution you want.
0
 
LVL 1

Author Comment

by:vterekh
ID: 6447403
In that case how does PhotoShop create bmp files with resolution?
0
 
LVL 5

Expert Comment

by:alanwhincup
ID: 6447404
If you want its width x height without having it loaded into a TImage for example, you could do it like this:

procedure TForm1.Button1Click(Sender: TObject);
var
  DibHeader : TBitmapInfoHeader;
begin
  if OpenDialog1.Execute then
  begin
    with TFileStream.Create(OpenDialog1.FileName, fmOpenRead or fmShareDenyNone) do
    begin
      try
        Seek(SizeOf(BITMAPFILEHEADER), soFromBeginning);
        Read(DibHeader, SizeOf(DibHeader));
        ShowMessage(IntToStr(DibHeader.biWidth) + ' x ' + IntToStr(DibHeader.biHeight));
      finally
        Free;
      end;
    end;
  end;
end;

To use this just put a OpenDialog box on a form and put the above code in a buttons OnClick Event.

Cheers,

Alan
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 5

Expert Comment

by:alanwhincup
ID: 6447408
The dimensions of an image is what i just gave you above.... You might be wanting:

procedure TForm1.Button1Click(Sender: TObject);
var
  DibHeader : TBitmapInfoHeader;
begin
  if OpenDialog1.Execute then
  begin
    with TFileStream.Create(OpenDialog1.FileName, fmOpenRead or fmShareDenyNone) do
    begin
      try
        Seek(SizeOf(BITMAPFILEHEADER), soFromBeginning);
        Read(DibHeader, SizeOf(DibHeader));
        ShowMessage(IntToStr(DibHeader.biXPelsPerMeter));
      finally
        Free;
      end;
    end;
  end;
end;
0
 
LVL 1

Author Comment

by:vterekh
ID: 6447422
2 alanwhincup

Can i get this info from TImage component?
I tried but biXPelsPerMeter variable returned 0 :(
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6447427
This is actually the same solution Alan presented. I delved into the VCL code of TBitmap and found some exception. This routine also handles OS2 bitmap, but they do not have resoltion info...

I am still researching if you can get this information from the HBitmap.

Regards Jacco

procedure TForm1.Button1Click(Sender: TObject);
var
  HeaderSize: Integer;
  bmp: TBitmap;
  OS2Header: TBitmapCoreHeader;
  BitmapInfo: PBitmapInfo;
begin
   with TFileStream.Create('c:\d5tsts\buttonimages\bmpTelephone.bmp', fmOpenRead or fmShareDenyNone) do
   begin
     try
       Seek(SizeOf(TBitmapFileHeader), soFromBeginning);
       Read(HeaderSize, SizeOf(HeaderSize));
       GetMem(BitmapInfo, HeaderSize + 12 + 256 * SizeOf(TRGBQuad));
       with BitmapInfo^ do
       try
         if HeaderSize = SizeOf(TBitmapCoreHeader) then
         begin
           // bitmap is an OS2 bitmap
           Read(Pointer(LongInt(@OS2Header) + SizeOf(HeaderSize))^, SizeOf(OS2Header) - SizeOf(HeaderSize));
           FillChar(BitmapInfo^.bmiHeader, sizeof(BitmapInfo^.bmiHeader), 0);
           // no resolution info
         end else begin
           Read(Pointer(LongInt(BitmapInfo) + SizeOf(HeaderSize))^, HeaderSize - SizeOf(HeaderSize));
         end;
         Memo1.Lines.Add(IntToStr(bmiHeader.biXPelsPerMeter));
         Memo1.Lines.Add(IntToStr(bmiHeader.biYPelsPerMeter));
       finally
         FreeMem(BitmapInfo);
       end;
     finally
       Free;
     end;
   end;
end;
0
 
LVL 1

Author Comment

by:vterekh
ID: 6447430
2 alanwhincup

Can i get this info from TImage component?
I tried but biXPelsPerMeter variable returned 0 :(
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6447436
Here is how to get it from a bitmapo object.

From an image you can use

s := GetBitmapResolution(Image1.Picture.Bitmap.Handle);

Here you go,

Regards Jacco

function GetBitmapResolution(aBitmapHandle: HBITMAP): TPoint;
var
  dib: TDIBSection;
begin
  FillChar(dib, sizeof(dib), 0);
  if aBitmapHandle <> 0 then
    GetObject(aBitmapHandle, SizeOf(dib), @dib);
  Result.x := dib.dsBmih.biXPelsPerMeter;
  Result.y := dib.dsBmih.biYPelsPerMeter;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  bmp: TBitmap;
  s: TPoint;
begin
  bmp := TBitmap.Create;
  try
    bmp.LoadFromFile('c:\windows\steken.bmp');
    s := GetBitmapResolution(bmp.Handle);
    Memo1.Lines.Add(IntToStr(s.x));
    Memo1.Lines.Add(IntToStr(s.y));
  finally
    bmp.Free;
  end;
end;
0
 
LVL 1

Author Comment

by:vterekh
ID: 6447443
2 Jacco
Your second exsample returnes 0 :(
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6447450
This only works if you loaded a *.bmp file with resolution.

Can you send me the bmp file you are testing with? jacco.k@xs4all.nl

Regards Jacco
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6447452
This only works if you loaded a *.bmp file with resolution.

Can you send me the bmp file you are testing with? jacco.k@xs4all.nl

Regards Jacco
0
 
LVL 5

Expert Comment

by:alanwhincup
ID: 6447465
I would do it like this:

procedure TForm1.Button1Click(Sender: TObject);
var
 Dib : TDIBSection;
begin
  if Image1.Picture.Bitmap.Empty = False then
  begin
    FillChar(Dib, SizeOf(Dib), 0);
    GetObject(Image1.Picture.Bitmap.Handle, SizeOf(Dib), @Dib);
    ShowMessage(IntToStr(Dib.dsBmih.biXPelsPerMeter) + ' x ' + IntToStr(Dib.dsBmih.biYPelsPerMeter));
  end;
end;
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6447466
The resolution of seal.bmp gives

11811 x 11811 over here...

How are you loading the image, are you doing something with the images first?

Maybe you can send sources so I can sort thing out...

Regards Jacco
0
 
LVL 1

Author Comment

by:vterekh
ID: 6447467
Here is the example i use:

function GetBitmapResolution(aBitmapHandle: HBITMAP): TPoint;
var
 dib: TDIBSection;
begin
 FillChar(dib, sizeof(dib), 0);
 if aBitmapHandle <> 0 then
   GetObject(aBitmapHandle, SizeOf(dib), @dib);
 Result.x := dib.dsBmih.biXPelsPerMeter;
 Result.y := dib.dsBmih.biYPelsPerMeter;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
 bmp: TBitmap;
 s: TPoint;
begin
 OpenDialog1.Execute;
 bmp := TBitmap.Create;
 try
   bmp.LoadFromFile(OpenDialog1.FileName);
   s := GetBitmapResolution(bmp.Handle);
   Memo1.Lines.Add(IntToStr(s.x));
   Memo1.Lines.Add(IntToStr(s.y));
 finally
   bmp.Free;
 end;
end;
0
 
LVL 5

Expert Comment

by:alanwhincup
ID: 6447468
You would probably only need to show only the one value (biXPelsPerMeter)

procedure TForm1.Button1Click(Sender: TObject);
var
  Dib : TDIBSection;
begin
  if Image1.Picture.Bitmap.Empty = False then
  begin
    FillChar(Dib, SizeOf(Dib), 0);
    GetObject(Image1.Picture.Bitmap.Handle, SizeOf(Dib), @Dib);
    ShowMessage(IntToStr(Dib.dsBmih.biXPelsPerMeter));
  end
  else
    ShowMessage('No Bitmap is loaded.');
end;

I also added a message if no bitmap is in the TImage.
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6447476
Very strange you tried it with seal.bmp you've send...

Windows report 300 ppi

My program 11811 ppm

How can this be...

What operating system do you use? And what delphi version?

Mine is Windows ME and Delphi5

Regards Jacco
0
 
LVL 1

Author Comment

by:vterekh
ID: 6447479
2 alanwhincup

Like with the Jacco's example yours one returns zero too :(
May be it only work with TFileStream and information about resolution is lost when i load bmp into TImage?
0
 
LVL 1

Author Comment

by:vterekh
ID: 6447483
2 Jacco

all is alright

300ppi (pixels per inch)
11811ppm (pixels per meter)

It is equal values :)
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6447487
So does it work?

Does the code you use give 11811?

The code sample you showed should really work. (Only depending on delphi version maybe they did'nt load ppi information in versions below version 5)

Regards Jacco
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6447488
The information does not get lost when you use a TImage. At least not easily. Maybe if you change Image.Picture.Bitmap.Width or PixelFormat...

Regards Jacco
0
 
LVL 1

Author Comment

by:vterekh
ID: 6447489
i've increased question's points for your effort and time wasting, guys :)
0
 
LVL 1

Author Comment

by:vterekh
ID: 6447491
I use Delphi 6
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6447889
I don't have Delphi 6 at home. I don't know if you have the VCL sources. But if you look in Graphics.pas and look for biXPelsPerMeter maybe you find where they are stored now. They obviously don't store them in the DIB any more..

Regards Jacco
0
 
LVL 10

Accepted Solution

by:
Jacco earned 100 total points
ID: 6450039
Hi again,

Here is a "hack" that I tested with Delphi 6 under Windows NT. This hack works through illegal type-casting of the bitmap. This is done to access the private parts of the TBitmap and TBitmapImage objects. It appears that GetObject which was used in my previous solution does not return the resolution under some windows versions. (Obviously Window ME works ok) GetObject is also called in the TBitmap class as well but I think the information will be preserved unless you copy the image. Also when copying the bitmap to the clipboard then the resolution information will probably get lost.

Regards Jacco

type
  THackedImage = class(TSharedImage)
  private
    FHandle: HBITMAP;
    FMaskHandle: HBITMAP;
    FPalette: HPALETTE;
    FDIBHandle: HBITMAP;
    FDIB: TDIBSection;
  end;

  THackedBmp = class(TGraphic)
  private
    FHackedImage: THackedImage;
  end;

procedure TForm1.Button1Click(Sender: TObject);
var
  DIB: TDibSection;
begin
  Image1.Picture.LoadFromFile('c:\winnt\nwelcome.bmp');
  Memo1.Lines.Add(IntToStr(THackedBmp(Image1.Picture.Bitmap).FHackedImage.FDIB.dsBmih.biXPelsPerMeter));
end;
0
 
LVL 1

Author Comment

by:vterekh
ID: 6450136
Thanks, Jacco
It works.
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

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

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…

733 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