BitMap в Text [Решено]

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

BitMap в Text [Решено]

Сообщение veresk » 06.04.2012 10:02:23

Задался поиском наиболее простого перевода имеющегося BitMap в String. Раньше работал наоборот, загоняя текст и картинки в нетипизированный файл. Теперь вот решил сделать поизвращённее.
Методы нашёл такие:
1. Вручную перебрать все пиксели BitMap, оболванить их по некоторой матрице в текст и заиметь через это счастье.
2. Использовать кодирование в base64. Информации по этому вопросу нашёл ровно 2 поста на форуме, боюсь что ничерта не понял.
3. Использовать ObjectBinaryToText, хотя, говорят, метод тормознутый. Хотя описалова и мало. Зато точно есть и TextToObjectBinary, обратную процедуру проводить.

Какие-нибудь ещё способы сделать такое извращение имеются? Общая задача: сохранить несколько массивов String и несколько картинок в один файл и при необходимости, доставать оттуда это обратно в ImageList и в массивы. Я предполагаю такое решение, в текстовом файле:

Код: Выделить всё
<file>
<block_1>
<text_1>
dkmvlsekmvlskmfvblsmd
</text_1>
<image_1>
LKMLVMWPVPOEMPWOEFOK#POKE@#(R)T(*$%FUNRK
</image_1>
<text_2>
lkdmflvkmdlfkvmdlkfvm
</text_2>
</block_1>
<block_2>
...
</block_2>
</file>
Последний раз редактировалось veresk 10.04.2012 11:23:34, всего редактировалось 1 раз.
veresk
новенький
 
Сообщения: 48
Зарегистрирован: 31.01.2012 12:23:32

Re: BitMap в Text

Сообщение veresk » 10.04.2012 11:22:53

Решение не моё, но вот такое:

Код: Выделить всё
function BitmapToString(Bitmap: TBitmap): String;
  var
    x, y: Integer;
    S: String;

  begin


    S := '';
    for y := 0 to Bitmap.Height-1 do
      begin
        for x := 0 to Bitmap.Width-1 do
          begin
            S := S + IntToHex(Bitmap.Canvas.Pixels[x,y], BPP);
          end;
        S := S + '\';
      end;
    Result := S;
  end;

  function StringToBitmap(S: String): TBitmap;
  var
    Bitmap: TBitmap;
    Line: String;
    P: Integer;
    x, y: Integer;

  begin
    Bitmap := TBitmap.Create;
    P := pos('\', S);
    Bitmap.Width := P div BPP;
    Bitmap.Height := 1;

    Line := Copy(S, 1, P-1);
    Delete(S, 1, P);
    x := 0;
    y := 0;

    While P <> 0 do
      begin
        if length(Line) <> 0 then
          begin
            Bitmap.Canvas.Pixels[x, y] := StrToInt('$' + Copy(Line, 1, BPP));
            Delete(Line, 1, BPP);
            inc(x);
          end
        else
          begin
            P := pos('\', S);
            Line := Copy(S, 1, P-1);
            Delete(S, 1, P);
            inc(y);
            Bitmap.Height := y+1;
            x := 0;
          end;
      end;
    Bitmap.Height := Bitmap.Height - 1;
    Result := Bitmap;
  end;
veresk
новенький
 
Сообщения: 48
Зарегистрирован: 31.01.2012 12:23:32


Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 235

Рейтинг@Mail.ru