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.