Txt2BMP ?

Hi

j ai une Function de google mais il ya des problemes !?

//-- TBitmap to String -----------------------
function BmpToTxt(const ABitmap: TBitmap): string;
  var X, Y: integer;
  function ColorToHex(AColor: TColor): string;
    begin
        Result := IntToHex(GetRValue(AColor), 2 ) +
                  IntToHex(GetGValue(AColor), 2 ) +
                  IntToHex(GetBValue(AColor), 2 );
    end;
begin
    Result := '';
    for Y := 0 to ABitmap.Height do
      begin
        if Y <> 0 then
          Result := Result + EL;
        for X := 0 to ABitmap.Width do
          Result := Result + ColorToHex(ABitmap.Canvas.Pixels[X, Y]);
      end;
end;
//-- String to TBitmap -----------------------
functionTxtToBmp(const Text: TStrings): TBitmap;
  var X, Y, cy, cx: integer;
      sClr: string;
  function HexToInt(HexStr: string): integer;
  begin
      if HexStr = '' then
        HexStr := 'FFFFFF';
      Result := StrToInt('0x' + HexStr);
  end;
  function StrToColor(AText: string): TColor;
  begin
      Result := RGB(HexToInt(Copy(AText, 1, 2)),
                    HexToInt(Copy(AText, 3, 2)),
                    HexToInt(Copy(AText, 5, 2)));
  end;
begin
    X := Length(Text[0]) div 6 - 1;
    Y := Text.Count - 1;
    Result := TBitmap.Create;
    Result.Width := X;
    Result.Height := Y;
    cy := Y;
    cx := X;
    for Y := 0 to cy do
      begin
        for X := 0 to cx do
          begin
            sClr := Copy(Text[Y], (X * 6) + 1, 6);
            Result.Canvas.Pixels[X, Y] := StrToColor(sClr);
          end;
      end;
end;

And you can use like this:

    Memo1.Text := BmpToTxt(Image1.Picture.Bitmap);
    Memo1.Lines.SaveToFile('C..Some.txt');

or

    Image1.Picture.Bitmap := TxtToBmp(Memo1.Lines);

Bonjour,

c'est quoi le probléme ? Message d'erreur ?

Oniria

1. //-- TBitmap to String -----------------------
Result := Result + EL; // undeclared EL

2. //-- String to Bitmap -----------------------
si je donne un Text in Memo1 et faire Click:
the value in memo1 is no valid Integer !

mais tu peut tester ;)

type
  DByte = array[0..1] of byte;

procedure BinToHex(const Buffer; const Len: integer; var Str: string);
var pB : ^byte;
    pR : ^DByte;
    N : integer;
const
  BTC : array[$0..$F] of byte = ($30,$31,$32,$33,$34,$35,$36,$37,
                                 $38,$39,$41,$42,$43,$44,$45,$46);
begin
  SetLength(Str, Len shl 1);
  pB := @Buffer;
  pR := @Str[1];
  for N := 0 to Len-1 do
  begin
    pR^[0] := BTC[pB^ shr 4];
    pR^[1] := BTC[pB^ and $0F];
    inc(pR);
    inc(pB);
  end;
end;

procedure HexToBin(const Str: string; const LenStr: integer; var Buffer);
var pB   : ^byte;
    pS   : ^DByte;
    LZ,N : integer;
    L,H  : byte;
begin
  LZ := LenStr shr 1;

  pS := @Str[1];
  pB := @Buffer;
  for N := 0 to LZ-2 do
  begin
    case pS^[0] of
      $30..$39 : H := (pS^[0] - $30) shl 4;
      $41..$46 : H := (pS^[0] - $37) shl 4;
      else
        break;
    end;
    case pS^[1] of
      $30..$39 : L := pS^[1] - $30;
      $41..$46 : L := pS^[1] - $37;
      else
        break;
    end;
    pB^ := byte(H or L);
    inc(pS);
    inc(pB);
  end;
end;

function BitmapToStr(const Bmp: TBitmap): string;
var pX : ^byte;
    TBmp: TBitmap;
begin
  TBmp := TBitmap.Create;
  try
    TBmp.Assign(Bmp);
    TBmp.PixelFormat := pf24bit;
    pX := TBmp.ScanLine[TBmp.Height-1];
    BinToHex(pX^, (TBmp.Width * TBmp.Height) * 3, Result);
  finally
    TBmp.Free;
  end;
end;

procedure StrToBitmap(const Str: string; const Width,Height: integer; Bmp: TBitmap);
var pX : ^byte;
    TBmp : TBitmap;
begin
  TBmp := TBitmap.Create;
  try
    TBmp.PixelFormat := pf24bit;
    TBmp.Width       := Width;
    TBmp.Height      := Height;
    pX := TBmp.ScanLine[TBmp.Height-1];
    HexToBin(Str, Length(Str), pX^);
    Bmp.Assign(TBmp);
  finally
    TBmp.Free;
  end;
end;


exemple :

procedure TForm1.Button1Click(Sender: TObject);
var StrL : TStringList;
begin
 StrL := TStringList.Create;
  try
    StrL.Text := BitmapToStr(Image1.picture.bitmap);
    StrL.SaveToFile('c:\data.txt');
  finally
    StrL.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var StrL : TStringList;
begin
  StrL := TStringList.Create;
  try
    StrL.LoadFromFile('c:\data.txt');
    StrToBitmap(StrL.Text, 512, 384, Image1.Picture.Bitmap);
  finally
    StrL.Free;
  end;
end;


voilou, non seulement ça marchera, mais en plus ça marchera mieux et plus vite.

note :

la taille du bitmap n'est pas sauvegarder, il faut la memoriser quelque part pour ensuite appeler StrToBitmap avec les bonnes dimensions.

---

error si je fais Click sur Button1:
scan Line Index put of Range

éssay ça
http://www.delphifr.com/codes/DFM-READER_46167.aspx

Matrix