How to get and set the DPI in a TBitmap (Views: 34)
Problem/Question/Abstract: How to get and set the DPI in a TBitmap Answer: I got tired of GetDIBits returning zero's in the BitmapInfoHeader XPelsPerMeter and YPelsPerMeter. The following unit allow you to get/set the dpi to a bitmap file or bitmap image. As has been discussed previously, a bitmap doesn't really have a dpi as far as the screen is concerned, just a height and width. But the original dpi is indispensable for determining the original size or the scale of the original scan, as is necessary in a program I am working on right now. The XPelsPerMeter and YPelsPerMeter are stored in 2 bytes each at an offset of 38(26h) and 42(2Ah), I don't know or care which one is at which address. These 2 values are virtually always the same. So in both of my 'Get' functions I just get the one at offset 38. When I set the dpi though, I write both. You can change this accordingly if you like. There are 39.370079 In/Meter, so, dpi * 39.370079 = dots/meter (PelsPerMeter). unit MyGraphic; interface uses SysUtils, Classes, Graphics, Dialogs; function GetBMPFileDPI(FileName: string): LongInt; procedure SetBMPFileDPI(FileName: string; DPI: Integer); function GetBmpDPI(Bitmap: TBitmap): LongInt; procedure SetBmpDPI(Bitmap: TBitmap; DPI: Integer); implementation function GetBMPFileDPI(FileName: string): LongInt; var Stream: TFileStream; Data: Word; A: Double; begin try Result := 0; Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); Stream.Position := 38; if Stream.Read(Data, 2) = 2 then begin A := Data; Result := Round(A / 39.370079); end; finally Stream.Free; end; end; procedure SetBMPFileDPI(FileName: string; DPI: Integer); var Stream: TFileStream; Data: Word; begin try Stream := TFileStream.Create(FileName, fmOpenWrite or fmShareExclusive); Data := Round(DPI * 39.370079); Stream.Position := 38; if Stream.Write(Data, 2) = 2 then begin Stream.Position := 42; end else {Error writing to Stream...} ShowMessage('Error writing to Stream. Data not written.'); finally Stream.Free; end; end; function GetBmpDPI(Bitmap: TBitmap): LongInt; var Stream: TMemoryStream; Data: Word; A: Double; begin try Result := 0; Stream := TMemoryStream.Create; Bitmap.SaveToStream(Stream); Stream.Position := 38; if Stream.Read(Data, 2) = 2 then begin A := Data; Result := Round(A / 39.370079); end; finally Stream.Free; end; end; procedure SetBmpDPI(Bitmap: TBitmap; DPI: Integer); var Stream: TMemoryStream; Data: Word; begin try Stream := TMemoryStream.Create; Bitmap.SaveToStream(Stream); Data := Round(DPI * 39.370079); Stream.Position := 38; if Stream.Write(Data, 2) = 2 then begin Stream.Position := 42; if Stream.Write(Data, 2) = 2 then begin Stream.Position := 0; Bitmap.LoadFromStream(Stream); end else {Error writing to Stream...} ShowMessage('Error writing to Stream. Data not written.'); end else {Error writing to Stream...} ShowMessage('Error writing to Stream. Data not written.'); finally Stream.Free; end; end; end. |