Текущий архив: 2006.04.16;
Скачать: CL | DM;

Вниз

Сохранение bmp файла из image с нужным dpi   Найти похожие ветки 

← →
Jimmy   (2005-11-12 18:39) [0]

Подскажите, как сохранить из Image bmp файл с нужным dpi, например равным 300, так как по умолчанию dpi созданной bmp"шки 72 dpi. Заранее спасибо.

---

← →
Gydvin ©   (2005-11-14 06:15) [1]

Вот чуть заколдованный код - BMP, JPG

Высчитываешь размер при нужном тебе  dpi,
сохраняешь в файл, потом этим

procedure tkart.SetResJpg(name: string; dpix, dpiy: Integer);
const
  BufferSize = 50;
  DPI = 1; //inch
 DPC = 2; //cm
var
  Buffer: string;
  index: INTEGER;
  FileStream: TFileStream;
  xResolution: WORD;
  yResolution: WORD;
  _type: Byte;
begin
  FileStream := TFileStream.Create(name,
    fmOpenReadWrite);
  try
    SetLength(Buffer, BufferSize);
    FileStream.Read(buffer[1], BufferSize);
    index := POS("JFIF",buffer);
    if index > 0
      then begin
      FileStream.Seek(index + 6, soFromBeginning);
      _type := DPI;
      FileStream.write(_type, 1);
      xresolution := swap(dpix);
      FileStream.write(xresolution, 2);
      yresolution := swap(dpiy);
      FileStream.write(yresolution, 2);
    end  ;

    index := POS("BM",buffer);
    if index > 0
      then begin
      FileStream.Seek(index + 37, soFromBeginning);
     // FileStream.write(_type, 1);
      xresolution :=  strtoint(floattostr(RoundFloat(strtofloat(inttostr(dpix))*39.4,0)));
      //swap(dpix);
   //   showmessage(floattostr(RoundFloat(strtofloat(inttostr(xresolution))/39.4,0)));
      FileStream.write(xresolution, 2);
       FileStream.Seek(index + 41, soFromBeginning);
      yresolution :=strtoint(floattostr(RoundFloat(strtofloat(inttostr(dpiy))*39.4,0)));

      //swap(dpiy);
      FileStream.write(yresolution, 2);
    end

  finally
    FileStream.Free;
  end;
end;

---

← →
Gydvin ©   (2005-11-14 06:20) [2]

Забыл, тоже надо

function RoundFloat(R: Extended; Decimals: Integer): Extended;
var
Factor: Extended;
begin
Factor := Int(Exp(Decimals * Ln(10)));
Result := Round(Factor * R) / Factor;
end;
function cifrak(s:string):integer;
begin
if s="0" then result:=1 else
if s="1" then result:=1 else
if s="2" then result:=1 else
if s="3" then result:=1 else
if s="4" then result:=1 else
if s="5" then result:=1 else
if s="6" then result:=1 else
if s="7" then result:=1 else
if s="8" then result:=1 else
if s="9" then result:=1 else result:=0;

end;

---

← →
Jimmy   (2005-11-15 19:40) [3]

Спасибо, сейчас попробую разобраться...

---

← →
Jimmy   (2005-11-17 18:53) [4]

Все получилось! Еще раз большое спасибо...

---

Страницы: 1 вся ветка

Текущий архив: 2006.04.16;
Скачать: CL | DM;

Наверх

Память: 0.47 MB
Время: 0.084 c