сохранение изображения с TFileStream

[andrey4623]

Здравствуйте!

Я записываю в файл разные данные (с помощью TFileStream). Так легко записывать текст или структурные данные. Но сохранить таким образом изображение в файл не получается. Если изначальная картинка весит 170 Кб, то полученный файл - всего 4 байта! Посмотрите, что здесь не так:

var
fs:TFileStream;
b:Tbitmap;
ms:TMemoryStream;
n:integer;
begin
fs:=TFileStream.Create('C:\123.abc' ,fmCreate);
b:=TBitmap.Create;
b:=Form1.Image1.Picture.Bitmap;

fs.Write(b, sizeof(b));


fs.Free;
b.Free;
ShowMessage('The picture was saved');
end;

[Virtson]

procedure TBitmap.WriteStream(Stream: TStream; WriteSize: Boolean);
const
  PalSize: array [Boolean] of Byte = (sizeof(TRGBQuad), sizeof(TRGBTriple));
var
  Size, ColorCount: DWORD;
  HeaderSize: DWORD;
  BMF: TBitmapFileHeader;
  Save: THandle;
  BC: TBitmapCoreHeader;
  Colors: array [Byte] of TRGBQuad;
begin
  FillChar(BMF, sizeof(BMF), 0);
  BMF.bfType := $4D42;
  if FImage.FSaveStream <> nil then
  begin
    Size := FImage.FSaveStream.Size;
    if WriteSize then
      Stream.WriteBuffer(Size, sizeof(Size));
    Stream.Write(FImage.FSaveStream.Memory^, FImage.FSaveStream.Size);
    Exit;
  end;
  DIBNeeded;
  with FImage do
  begin
    Size := 0;
    if FDIBHandle <> 0 then
    begin
      InternalGetDIBSizes(FDIBHandle, HeaderSize, Size, FDIB.dsbmih.biClrUsed);
      if FOS2Format then
      begin // OS2 format cannot have partial palette
        HeaderSize := sizeof(BC);
        if FDIB.dsbmih.biBitCount <= 8 then
          Inc(HeaderSize, sizeof(TRGBTriple) * (1 shl FDIB.dsbmih.biBitCount));
      end;
      Inc(Size, HeaderSize + sizeof(BMF));

      FillChar(BMF, sizeof(BMF), 0);
      BMF.bfType := $4D42;

      Canvas.RequiredState([csHandleValid]);
      Save := GDICheck(SelectObject(FCanvas.FHandle, FDIBHandle));
      ColorCount := GetDIBColorTable(FCanvas.FHandle, 0, 256, Colors);
      SelectObject(FCanvas.FHandle, Save);
      // GetDIBColorTable always reports the full palette; trim it back for partial palettes
      if (0 < FDIB.dsbmih.biClrUsed) and (FDIB.dsbmih.biClrUsed < ColorCount) then
        ColorCount := FDIB.dsbmih.biClrUsed;
      if (not FOS2Format) and (ColorCount = 0) and (FPalette <> 0) and not FHalftone then
      begin
        ColorCount := PaletteToDIBColorTable(FPalette, Colors);
        if FDIB.dsbmih.biBitCount > 8 then
        begin  // optional color palette for hicolor images (non OS2)
          Inc(Size, ColorCount * sizeof(TRGBQuad));
          Inc(HeaderSize, ColorCount * sizeof(TRGBQuad));
        end;
      end;

      BMF.bfSize := Size;
      BMF.bfOffBits := sizeof(BMF) + HeaderSize;
    end;

    if WriteSize then Stream.WriteBuffer(Size, SizeOf(Size));

    if Size <> 0 then
    begin
      FixupBitFields(FDIB);
      if (ColorCount <> 0) then
      begin
        if (FDIB.dsbmih.biClrUsed = 0) or (FDIB.dsbmih.biClrUsed <> ColorCount) then
          FDIB.dsbmih.biClrUsed := ColorCount;
        if FOS2Format then RGBQuadToTriple(Colors, Integer(ColorCount));
      end;
      if FOS2Format then
      begin
        with BC, FDIB.dsbmih do
        begin
          bcSize := sizeof(BC);
          bcWidth := biWidth;
          bcHeight := biHeight;
          bcPlanes := 1;
          bcBitCount := biBitCount;
        end;
        Stream.WriteBuffer(BMF, sizeof(BMF));
        Stream.WriteBuffer(BC, sizeof(BC));
      end
      else
      begin
        Stream.WriteBuffer(BMF, Sizeof(BMF));
        Stream.WriteBuffer(FDIB.dsbmih, Sizeof(FDIB.dsbmih));
        if (FDIB.dsbmih.biBitCount > 8) and
          ((FDIB.dsbmih.biCompression and BI_BITFIELDS) <> 0) then
          Stream.WriteBuffer(FDIB.dsBitfields, 12);
      end;
      Stream.WriteBuffer(Colors, ColorCount * PalSize[FOS2Format]);
      Stream.WriteBuffer(FDIB.dsbm.bmBits^, FDIB.dsbmih.biSizeImage);
    end;
  end;
end;

это все должно идти вместо fs.Write )

[mihali4]

Что-то очень уж сложно, по-моему.
У меня вот что получилось:

var
fs1: TMemoryStream;
fs2:TFileStream;
b: TBitmap;
begin
fs1:= TMemoryStream.Create;
Image1.Picture.Graphic.SaveToStream(fs1);
fs2 := TFileStream.Create('c:\123.abc', fmCreate);
fs2.CopyFrom(fs1,0);
fs1.FreeInstance;
fs2.FreeInstance;
ShowMessage('The picture was saved');
end;

Сменил на диске С:\ расширение у 123.abc на 123.jpg - увидел исходную картинку.

[andrey4623]

А как ее потом из этого файла извлечь?

[devi409]

Лично я делал так

potok := TMemoryStream.Create;
FileStream := TFileStream.Create(ChangeFileExt(ad ,'.tmp'), fmCreate);
Writer := TWriter.Create (FileStream, $1000);
BitMap.SaveToStream(potok)
Buffer := potok.Memory;
Size := potok.Size;
Writer.WriteInteger (Size);
Writer.Write (Buffer^, Size);

Writer.Free;
FileStream.Free;
potok1.Free;

только извлечение из файла должно быть в томже порядке как записывали

[andrey4623]

а извлечь эту картинку из файла не получается...
Кстати, а так можно любой файл сохранять?

[mihali4]

а извлечь эту картинку из файла не получается...

В каком смысле? Я же сказал - если у сохраненной моим методом картинки просто установить подобающее расширение, то ее можно открывать хоть в графическом редакторе, хоть у себя в программе.
Но это так, просто для проверки.
А извлечь - если самое простое:
if OpenDialog1.Execute then
Image1.Picture.Graphic.LoadFromFile (OpenDialog1.FileName);
И тут по барабану, какое у файла расширение, лишь бы он был картинкой...
А если нужно опять с использованием потоков... Ну, заставьте себя хоть чуть-чуть потрудиться и переделайте мой вариант в обратный, для чтения, САМОСТОЯТЕЛЬНО.

[andrey4623]

Что-то не получается... Что тут не так:

var
fs1: TMemoryStream;
fs2:TFileStream;
b: TBitmap;
begin


fs2 := TFileStream.Create('c:\123.abc', fmOpenRead);
fs1:= TMemoryStream.Create;

fs1.CopyFrom(fs2,0);

Image1.Picture.Graphic.LoadFromStre am(fs1);
fs1.FreeInstance;
fs2.FreeInstance;

[andrey4623]

Подскажите, пожайлуста. Я с этими потоками вообще не врубаюсь, и что такое CopyFrom - темный лес.

Я читал литературу, что TFileStream имеет методы Write, Read, но с ними сам файл в файл не записать...

[Virtson]

Сообщение от mihali4

Что-то очень уж сложно, по-моему.

мой пример был бы такой :

var fs: TFileStream;
begin
 fs:= TFileStream.Create('C:\123.abc',fmCreate); 
 with Form1.Image1.Picture do
   Bitmap.WriteStream(fs, sizeof(Bitmap));
 fs.Free;
 ShowMessage('The picture was saved');
end;

я просто привел к сведению, что получается в месте Bitmap.WriteStream()
а Ваш код тоже использует этот метод, только скрыто )