Как простым образом конвертнуть битмап в строку?

← →
Starkom (2003-03-10 16:31) [0]

Есть необходимость сохранять бмп-картинки в строку. Потом, соответственно, читать их.
Как это реализовать? Есть же, как я понял какой-то механизм, с помощью которого Дельфи сохраняет прямо в дфм-ки битмапы.

← →
Yuri-7 (2003-03-10 17:58) [1]

Ну и зачем в строку обязательно? Delphi все равно потом хранит в ресурсах. Сохрани битмапы в ресурсах в программе и читай потом.

← →
Набережных С. (2003-03-10 19:29) [2]

Механизм есть - ObjectBinaryToText, ObjectTextToBinary.

← →
Barmutik (2003-03-10 20:10) [3]

Ну или можеш совсем глупо просто массив пикселов перегнать...

← →
Tux (2003-03-11 00:03) [4]

Base64

======================
не изобретайте лисапет

← →
boolean (2003-03-11 12:21) [5]

2 Бармутик: массив пикселов - это медленно и не нравится мне сама идея, хотя она всплывала.
2 Tux: можно поподробнее? А то одно слово Base64 мне ничего не подсказало.
2 Набережных С.: ObjectBinaryToText, насколько я понял используется в связке с WriteComponent, который требует TComponent. TBitmap же не является наследником TComponent, поэтому я не могу записать в поток TBitmap. Если использую TBitBtn, то тогда все нормально, но сохраняется излишняя информация, что не есть хорошо.
P.S. А как последовательно сохранить в стрим несколько компонентов? Последовательные вызовы WriteComponent не приводят к нужному результату - второй вызов ReadComponent выдает ошибку.

← →
Starkom (2003-03-11 12:23) [6]

предыдущая реплика конечно же была от автора вопроса

← →
REA (2003-03-11 12:49) [7]

Можно SaveToStream в TMemoryStream, а оттуда уже проще.

Несколько компонентов в стрим можно наверно так сохранить: создаешь контейнер - фиктивный родительский компонет и перечисляешь Child компоненты и сохраняешь уже его.
Ну или самому управлять загрузкой из потока.

← →
Starkom (2003-03-11 15:32) [8]

2 REA: а че с этим TMemoryStream делать то? Я пробовал - не получилось ничего.

← →
Starkom (2003-03-11 15:40) [9]

если юзать TBitmap.SaveToStream, не получится использовать ObjectBinaryToText

← →
REA (2003-03-11 15:43) [10]

А что именно не получилось? У MemoryStream есть свойство Memory.
Mожно сделать SetString(MyStr, PChar(MemoryStream.Memory), MemoryStream.Size);

← →
Starkom (2003-03-11 15:57) [11]

2 REA: ну получил я строку. А если привести ее обратно к PChar - получается лажа, потому что в MemoryStream.Memory полно нулей.
Строки должны работать только с текстовым представлением.

← →
REA (2003-03-11 16:11) [12]

Так тебе еще и байтики в буковки надо превратить? Ну тогда в цикле IntToStr(PByteArray(MemoryStream.Memory)[i]).

← →
Starkom (2003-03-11 16:27) [13]

2 REA: хмм, имхо, коряво это. Да и тормозить будет имхо.

← →
REA (2003-03-11 16:30) [14]

Ты попробуй - может и сойдет. Можно почти наверняка и быстрее, только непонятно зачем тогда в строку конвертировать.

← →
Starkom (2003-03-11 16:36) [15]

в стандартном механизме используется BinToHex - там по 32 байта за раз конвертится.
в лом просто самому процедуру переписывать :))

← →
Style (2003-03-11 16:38) [16]

Starkom Если надо в Text до переведи каждый байт в 16код и сохрани как текст так же и обратно!

Вот пример сохранения Монохромной картинки.. Придумай чегонить свое

for m := 1 to 64 do
begin
astr:= "";
str:= "";
for z := 1 to 128 do
begin
if(Frm_Main.LogoImage.Canvas.Pixels[z,64-m] <> сlBlack) then
str := str + "0" else str := str + "1";
end;
for z := 0 to 31 do
begin
if(copy(str,(z*4)+1,4) = "0000") then astr := astr + "0";
if(copy(str,(z*4)+1,4) = "0001") then astr := astr + "1";
if(copy(str,(z*4)+1,4) = "0010") then astr := astr + "2";
if(copy(str,(z*4)+1,4) = "0011") then astr := astr + "3";
if(copy(str,(z*4)+1,4) = "0100") then astr := astr + "4";
if(copy(str,(z*4)+1,4) = "0101") then astr := astr + "5";
if(copy(str,(z*4)+1,4) = "0110") then astr := astr + "6";
if(copy(str,(z*4)+1,4) = "0111") then astr := astr + "7";
if(copy(str,(z*4)+1,4) = "1000") then astr := astr + "8";
if(copy(str,(z*4)+1,4) = "1001") then astr := astr + "9";
if(copy(str,(z*4)+1,4) = "1010") then astr := astr + "A";
if(copy(str,(z*4)+1,4) = "1011") then astr := astr + "B";
if(copy(str,(z*4)+1,4) = "1100") then astr := astr + "C";
if(copy(str,(z*4)+1,4) = "1101") then astr := astr + "D";
if(copy(str,(z*4)+1,4) = "1110") then astr := astr + "E";
if(copy(str,(z*4)+1,4) = "1111") then astr := astr + "F";
end;
lst.Strings[lst.Count-1] := lst.Strings[lst.Count-1] + astr + chr(9);
end;
end;

← →
Набережных С. (2003-03-11 21:28) [17]

>boolean (11.03.03 12:21)
>но сохраняется излишняя информация
TBitmaps = class(TComponent) private FList: TObjectList; procedure ReadData(Stream: TStream); procedure WriteData(Stream: TStream); function GetBitmap(Index: integer): TBitmap; function GetCount: integer; protected procedure DefineProperties(Filer: TFiler); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function Add: TBitmap; procedure Delete(Index: integer); procedure Clear; property Count: integer read GetCount; property Bitmap[Index: integer]: TBitmap read GetBitmap; procedure WriteToText(const Stream: TStream); procedure ReadFromText(const Stream: TStream); end; { TBitmaps } function TBitmaps.Add: TBitmap; begin FList.Add(TBitmap.Create); Result:=TBitmap(FList[Pred(Flist.Count)]); end; procedure TBitmaps.Clear; begin FList.Clear; end; constructor TBitmaps.Create(AOwner: TComponent); begin inherited; FList:=TObjectList.Create; end; procedure TBitmaps.DefineProperties(Filer: TFiler); begin inherited; Filer.DefineBinaryProperty("Bitmaps", ReadData, WriteData, FList.Count > 0); end; procedure TBitmaps.Delete(Index: integer); begin FList.Delete(Index); end; destructor TBitmaps.Destroy; begin FList.Free; inherited; end; function TBitmaps.GetBitmap(Index: integer): TBitmap; begin Result:=TBitmap(FList[Index]); end; function TBitmaps.GetCount: integer; begin Result:=FList.Count; end; type TXBitmap = class(TBitmap); procedure TBitmaps.ReadData(Stream: TStream); var n: integer; begin Stream.ReadBuffer(n, SizeOf(n)); FList.Clear; FList.Count:=n; for n:=0 to Pred(FList.Count) do begin FList[n]:=TBitmap.Create; TXBitmap(FList[n]).ReadData(Stream); end; end; procedure TBitmaps.WriteData(Stream: TStream); var n: integer; begin n:=FList.Count; Stream.WriteBuffer(n, SizeOf(n)); for n:=0 to Pred(FList.Count) do TXBitmap(FList[n]).WriteData(Stream); end; procedure TBitmaps.ReadFromText(const Stream: TStream); var StmTmp: TMemoryStream; begin StmTmp:=TMemoryStream.Create; try ObjectTextToBinary(Stream, StmTmp); StmTmp.Position:=0; StmTmp.ReadComponent(Self); finally StmTmp.Free; end; end; procedure TBitmaps.WriteToText(const Stream: TStream); var StmTmp: TMemoryStream; begin StmTmp:=TMemoryStream.Create; try StmTmp.WriteComponent(Self); StmTmp.Position:=0; ObjectBinaryToText(StmTmp, Stream); finally StmTmp.Free; end; end; procedure Test; var Stm: TFileStream; n: integer; Btms: TBitmaps; begin Btms:=TBitmaps.Create(nil); Btms.Add.LoadFromFile("Bmp1.bmp"); Btms.Add.LoadFromFile("Bmp2.bmp"); Stm:=TFileStream.Create("Bitmaps.txt", fmCreate); Btms.WriteToText(Stm); Stm.Position:=0; Btms.Clear; Btms.ReadFromText(Stm); Stm.Free; with Image1.Picture.Bitmap do begin Width:=Image1.Width; Height:=Image1.Height; for n:=0 to Pred(Btms.Count) do Canvas.Draw(n*16, 0, Btms.Bitmap[n]); end; Btms.Free; end;
Дел на 20 минут.

← →
Starkom (2003-03-12 06:39) [18]

ну я уже сделал по своему:
(извиняюсь, конечно, если код корявый - я только учусь)

function ConvertBitmapToString(bmp:TBitmap): string;
var BMPstream : TMemoryStream;
TXTStream : TStringStream;
count : integer;
Buffer, Text : Pointer;
begin
BMPstream:=TMemoryStream.Create;
TXTStream:=TStringStream.Create("");

bmp.SaveToStream(BMPstream);
count:=BMPstream.size;

GetMem(Buffer, Count);
GetMem(Text, (Count + SizeOf(Integer))*2);

BinToHex(@count, Text, SizeOf(Integer));
TXTStream.Write(Text^, SizeOf(Integer) * 2);

BMPstream.Position:=0;

BMPstream.Read(Buffer^, Count);
BinToHex(Buffer, Text, Count);
TXTStream.Write(Text^, Count * 2);

result:=TXTStream.DataString;
TXTStream.Free; BMPstream.Free;

FreeMem(Buffer);
FreeMem(Text);
end;

function ConvertStringToBitmap(source:string): TBitmap;
var BMPstream : TMemoryStream;
TXTStream : TStringStream;
Buffer, Text : Pointer;
Count : integer;
begin
TXTStream:=TStringStream.Create(source);
BMPstream:=TMemoryStream.Create;

GetMem(Text, SizeOf(Integer) * 2);
GetMem(Buffer, SizeOf(Integer));

TXTStream.Read(Text^, SizeOf(Integer) * 2);
HexToBin(Text, Buffer, SizeOf(Integer) * 2);
Count:=Integer(Buffer^);

FreeMem(Text);
FreeMem(Buffer);

GetMem(Text, Count * 2);
GetMem(Buffer, Count);

TXTStream.Read(Text^, Count * 2);
HexToBin(Text, Buffer, Count * 2);
BMPstream.Write(Buffer^, Count);

BMPstream.Position:=0;
result:=TBitmap.Create;
result.LoadFromStream(BMPstream);

FreeMem(Text);
FreeMem(Buffer);
BMPStream.Free; TXTStream.Free;
end;

← →
Starkom (2003-03-12 06:41) [19]

это по сути и есть WriteComponent и ObjectBinaryToText.
А делать контейнер битмапа - наследник TComponent имхо не меньше писанины.

← →
vlad40 (2003-03-13 12:04) [20]

А как вам такой вариант?

function BitmapToString(bm: TBitmap): string ; var BinStream: TMemoryStream; i: LongInt; Buffer: byte; begin BinStream:=TMemoryStream.Create; try bm.SaveToStream(BinStream); BinStream.Seek(0, soFromBeginning); Result:=""; for i:=0 to BinStream.Size-1 do begin BinStream.ReadBuffer(Buffer,1); Result:= Result+IntToHex(Buffer,2); end; finally BinStream.Free; end ; end ; function StringToBitmap(s: string): TBitmap; var BinStream: TMemoryStream; i: LongInt; Buffer: byte; begin Result:=TBitmap.Create; BinStream:=TMemoryStream.Create; try for i:=1 to length(s) div 2 do begin Buffer:=StrToInt("$"+copy(s,i*2-1,2)); BinStream.Write(Buffer,1); end; BinStream.Seek(0, soFromBeginning); Result.LoadFromStream(BinStream); finally BinStream.Free; end ; end ;

← →
REA (2003-03-13 13:01) [21]

Все чудесно, но почему бы не хранить тогда в двоичной системе. Какой смысл все переводить в буквы?

← →
vlad40 (2003-03-13 13:55) [22]

Вопрос был про строку. Может хочет хранить в текстовых полях или переменных.

Как простым образом конвертнуть битмап в строку? Найти похожие ветки