MiniProgramer
Messages postés37Date d'inscriptionsamedi 5 juillet 2008StatutMembreDernière intervention24 juillet 2008
-
5 juil. 2008 à 12:21
MiniProgramer
Messages postés37Date d'inscriptionsamedi 5 juillet 2008StatutMembreDernière intervention24 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);
f0xi
Messages postés4205Date d'inscriptionsamedi 16 octobre 2004StatutModérateurDernière intervention12 mars 202235 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;