Solved

Bmp resolution

Posted on 2001-09-01
25
489 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
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
Does Powershell have you tied up in knots?

Managing Active Directory does not always have to be complicated.  If you are spending more time trying instead of doing, then it's time to look at something else. For nearly 20 years, AD admins around the world have used one tool for day-to-day AD management: Hyena. Discover why

 
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

PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

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…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
The Email Laundry PDF encryption service allows companies to send confidential encrypted  emails to anybody. The PDF document can also contain attachments that are embedded in the encrypted PDF. The password is randomly generated by The Email Laundr…

825 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