Solved

Bmp resolution

Posted on 2001-09-01
25
480 Views
Last Modified: 2010-04-06
Hi
How can i dedermine the resolution of bitmap?
0
Comment
Question by:vterekh
  • 10
  • 10
  • 4
  • +1
25 Comments
 
LVL 11

Expert Comment

by:robert_marquardt
Comment Utility
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
Comment Utility
In that case how does PhotoShop create bmp files with resolution?
0
 
LVL 5

Expert Comment

by:alanwhincup
Comment Utility
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
 
LVL 5

Expert Comment

by:alanwhincup
Comment Utility
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
Comment Utility
2 alanwhincup

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

Expert Comment

by:Jacco
Comment Utility
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
Comment Utility
2 alanwhincup

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

Expert Comment

by:Jacco
Comment Utility
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
Comment Utility
2 Jacco
Your second exsample returnes 0 :(
0
 
LVL 10

Expert Comment

by:Jacco
Comment Utility
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
Comment Utility
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
Comment Utility
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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 10

Expert Comment

by:Jacco
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
2 Jacco

all is alright

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

It is equal values :)
0
 
LVL 10

Expert Comment

by:Jacco
Comment Utility
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
Comment Utility
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
Comment Utility
i've increased question's points for your effort and time wasting, guys :)
0
 
LVL 1

Author Comment

by:vterekh
Comment Utility
I use Delphi 6
0
 
LVL 10

Expert Comment

by:Jacco
Comment Utility
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
Comment Utility
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
Comment Utility
Thanks, Jacco
It works.
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

Suggested Solutions

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
This video explains how to create simple products associated to Magento configurable product and offers fast way of their generation with Store Manager for Magento tool.

772 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now