Txt2BMP ?

Fermé
MiniProgramer Messages postés 37 Date d'inscription samedi 5 juillet 2008 Statut Membre Dernière intervention 24 juillet 2008 - 5 juil. 2008 à 12:21
MiniProgramer Messages postés 37 Date d'inscription samedi 5 juillet 2008 Statut Membre Dernière intervention 24 juillet 2008 - 5 juil. 2008 à 15:59
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);

4 réponses

Oniria Messages postés 292 Date d'inscription dimanche 14 mars 2004 Statut Membre Dernière intervention 18 décembre 2014 3
5 juil. 2008 à 13:11
Bonjour,

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

Oniria
0
MiniProgramer Messages postés 37 Date d'inscription samedi 5 juillet 2008 Statut Membre Dernière intervention 24 juillet 2008
5 juil. 2008 à 14:11
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 ;)
0
f0xi Messages postés 4205 Date d'inscription samedi 16 octobre 2004 Statut Modérateur Dernière intervention 12 mars 2022 37
5 juil. 2008 à 14:46
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.

<hr size="2" width="100%" />
0
MiniProgramer Messages postés 37 Date d'inscription samedi 5 juillet 2008 Statut Membre Dernière intervention 24 juillet 2008
5 juil. 2008 à 15:59
error si je fais Click sur Button1:
scan Line Index put of Range
0