Conversions
From: Martin Larsson <martin.larsson@delfi-data.msmail.telemax.no>
var i : integer s : string; begin s := '$' + ThatHexString; i := StrToInt(a); end;
CONST HEX : ARRAY['A'..'F'] OF INTEGER = (10,11,12,13,14,15); VAR str : String; Int, i : integer; BEGIN READLN(str); Int := 0; FOR i := 1 TO Length(str) DO IF str[i] < 'A' THEN Int := Int * 16 + ORD(str[i]) - 48 ELSE Int := Int * 16 + HEX[str[i]]; WRITELN(Int); READLN; END.
From: Mark Bracey <mbracey@interaccess.com>
I guess you mean as a string, correct.
HexString := Format('%0x',DecValue);
From: gregc@cryptocard.com (Greg Carter)
These work on byte array to strings, also look at the Ord and Chr functions in Delphi.
BytesToHexStr does this [0,1,1,0] of byte would be converted to string := '30313130'; HexStrToBytes goes the other way.
unit Hexstr; interface uses String16, SysUtils; Type PByte = ^BYTE; procedure BytesToHexStr(var hHexStr: String; pbyteArray: PByte; InputLength: WORD); procedure HexStrToBytes(hHexStr: String; pbyteArray: Pointer); procedure HexBytesToChar(var Response: String; hexbytes: PChar; InputLength: WORD); implementation procedure BytesToHexStr(var hHexStr: String; pbyteArray: PByte; InputLength: WORD); Const HexChars : Array[0..15] of Char = '0123456789ABCDEF'; var i, j: WORD; begin SetLength(hHexStr, (InputLength * 2)); FillChar(hHexStr, sizeof(hHexStr), #0); j := 1; for i := 1 to InputLength do begin hHexStr[j] := Char(HexChars[pbyteArray^ shr 4]); inc(j); hHexStr[j] := Char(HexChars[pbyteArray^ and 15]); inc(j); inc(pbyteArray); end; end; procedure HexBytesToChar(var Response: String; hexbytes: PChar; InputLength: WORD); var i: WORD; c: byte; begin SetLength(Response, InputLength); FillChar(Response, SizeOf(Response), #0); for i := 0 to (InputLength - 1) do begin c := BYTE(hexbytes[i]) And BYTE($f); if c > 9 then Inc(c, $37) else Inc(c, $30); Response[i + 1] := char(c); end;{for} end; procedure HexStrToBytes(hHexStr: String; pbyteArray: Pointer); {pbyteArray must point to enough memory to hold the output} var i, j: WORD; tempPtr: PChar; twoDigits : String[2]; begin tempPtr := pbyteArray; j := 1; for i := 1 to (Length(hHexStr) DIV 2) do begin twoDigits := Copy(hHexStr, j, 2); Inc(j, 2); PByte(tempPtr)^ := StrToInt('$' + twoDigits); Inc(tempPtr); end;{for} end; end.
UNIT String16. interface {$IFNDEF Win32} procedure SetLength(var S: string; Len: Integer); procedure SetString(var Dst: string; Src: PChar; Len: Integer); {$ENDIF} implementation {$IFNDEF Win32} procedure SetLength(var S: string; Len: Integer); begin if Len > 255 then S[0] := Chr(255) else S[0] := Chr(Len) end; procedure SetString(var Dst: string; Src: PChar; Len: Integer); begin if Len > 255 then Move(Src^, Dst[1], 255) else Move(Src^, Dst[1], Len); SetLength(Dst, Len); end; {$ENDIF} end.
Can someone give me an idea of a simple way to convert binary (base2) to decimal(base10).
//////////////////////////////////////////////// // convert 32 bit base2 to 32 bit base10 // // max number = 99 999 999, return -1 if more // //////////////////////////////////////////////// function Base10(Base2:Integer) : Integer; assembler; asm cmp eax,100000000 // check upper limit jb @1 // ok mov eax,-1 // error flag jmp @exit // exit with -1 @1: push ebx // save registers push esi xor esi,esi // result = 0 mov ebx,10 // diveder base 10 mov ecx,8 // 8 nibbles (10^8-1) @2: mov edx,0 // clear remainder div ebx // eax DIV 10, edx mod 10 add esi,edx // result = result + remainder[I] ror esi,4 // shift nibble loop @2 // loop for all 8 nibbles mov eax,esi // function result pop esi // restore registers pop ebx @exit: end;
function IntToBin(Value: LongInt;Size: Integer): String; var i: Integer; begin Result:=''; for i:=Size downto 0 do begin if Value and (1 shl i)<>0 then begin Result:=Result+'1'; end else begin Result:=Result+'0'; end; end; end; function BinToInt(Value: String): LongInt; var i,Size: Integer; begin Result:=0; Size:=Length(Value); for i:=Size downto 0 do begin if Copy(Value,i,1)='1' then begin Result:=Result+(1 shl i); end; end; end;
Give this function any decimal value, specify a base (1..16) and it will return you a string containing the proper value, BaseX. You can use a similar method for Arabic/Roman conversion (see below).
function DecToBase( Decimal: LongInt; const Base: Byte): String; const Symbols: String[16] = '0123456789ABCDEF'; var scratch: String; remainder: Byte; begin scratch := ''; repeat remainder := Decimal mod Base; scratch := Symbols[remainder + 1] + scratch; Decimal := Decimal div Base; until ( Decimal = 0 ); Result := scratch; end;
function DecToRoman( Decimal: LongInt ): String; const Romans: Array[1..13] of String = ( 'I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M' ); Arabics: Array[1..13] of Integer = ( 1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000); var i: Integer; scratch: String; begin scratch := ''; for i := 13 downto 1 do while ( Decimal >= Arabics[i] ) do begin Decimal := Decimal - Arabics[i]; scratch := scratch + Romans[i]; end; Result := scratch; end;
From: vincze@ti.com (Michael Vincze)
Try:
var Icon : TIcon; Bitmap : TBitmap; begin Icon := TIcon.Create; Bitmap := TBitmap.Create; Icon.LoadFromFile('c:\picture.ico'); Bitmap.Width := Icon.Width; Bitmap.Height := Icon.Height; Bitmap.Canvas.Draw(0, 0, Icon ); Bitmap.SaveToFile('c:\picture.bmp'); Icon.Free; Bitmap.Free; end;
Is there an algorithm or routine to convert 32x32 bit Bitmaps to ICO's?
unit main; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,Dialogs,ExtCtrls, StdCtrls; type TForm1 = class(TForm) Button1: TButton; Image1: TImage; Image2: TImage; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.Button1Click(Sender: TObject); var winDC, srcdc, destdc : HDC; oldBitmap : HBitmap; iinfo : TICONINFO; begin GetIconInfo(Image1.Picture.Icon.Handle, iinfo); WinDC := getDC(handle); srcDC := CreateCompatibleDC(WinDC); destDC := CreateCompatibleDC(WinDC); oldBitmap := SelectObject(destDC, iinfo.hbmColor); oldBitmap := SelectObject(srcDC, iinfo.hbmMask); BitBlt(destdc, 0, 0, Image1.picture.icon.width, Image1.picture.icon.height, srcdc, 0, 0, SRCPAINT); Image2.picture.bitmap.handle := SelectObject(destDC, oldBitmap); DeleteDC(destDC); DeleteDC(srcDC); DeleteDC(WinDC); image2.Picture.Bitmap.savetofile(ExtractFilePath(Application.ExeName) + 'myfile.bmp'); end; procedure TForm1.FormCreate(Sender: TObject); begin image1.picture.icon.loadfromfile('c:\myicon.ico'); end; end.
From: miano@worldnet.att.net (John M. Miano)
This is a unit that I wrote for reading and writing Unix files.unit StreamFile; { Unix Stream File Interface Copyright 1996 by John Miano Software miano@worldnet.att.net } interface Uses SysUtils ; Procedure AssignStreamFile (var F : Text ; Filename : String) ; implementation Const BufferSize = 128 ; Type TStreamBuffer = Array [1..High (Integer)] of Char ; TStreamBufferPointer = ^TStreamBuffer ; TStreamFileRecord = Record Case Integer Of 1: ( Filehandle : Integer ; Buffer : TStreamBufferPointer ; BufferOffset : Integer ; ReadCount : Integer ; ) ; 2: ( Dummy : Array [1 .. 32] Of Char ) End ; Function StreamFileOpen (var F : TTextRec) : Integer ; Var Status : Integer ; Begin With TStreamFileRecord (F.UserData) Do Begin GetMem (Buffer, BufferSize) ; Case F.Mode Of fmInput: FileHandle := FileOpen (StrPas (F.Name), fmShareDenyNone) ; fmOutput: FileHandle := FileCreate (StrPas (F.Name)) ; fmInOut: Begin FileHandle := FileOpen (StrPas (F.Name), fmShareDenyNone Or fmOpenWrite or fmOpenRead) ; If FileHandle <> -1 Then status := FileSeek (FileHandle, 0, 2) ; { Move to end of file. } F.Mode := fmOutput ; End ; End ; BufferOffset := 0 ; ReadCount := 0 ; F.BufEnd := 0 ; { If this is not here it thinks we are at eof. } If FileHandle = -1 Then Result := -1 Else Result := 0 ; End ; End ; Function StreamFileInOut (var F : TTextRec) : Integer ; Procedure Read (var Data : TStreamFileRecord) ; Procedure CopyData ; Begin While (F.BufEnd < Sizeof (F.Buffer) - 2) And (Data.BufferOffset <= Data.ReadCount) And (Data.Buffer [Data.BufferOffset] <> #10) Do Begin F.Buffer [F.BufEnd] := Data.Buffer^ [Data.BufferOffset] ; Inc (Data.BufferOffset) ; Inc (F.BufEnd) ; End ; If Data.Buffer [Data.BufferOffset] = #10 Then Begin F.Buffer [F.BufEnd] := #13 ; Inc (F.BufEnd) ; F.Buffer [F.BufEnd] := #10 ; Inc (F.BufEnd) ; Inc (Data.BufferOffset) ; End ; End ; Begin F.BufEnd := 0 ; F.BufPos := 0 ; F.Buffer := '' ; Repeat Begin If (Data.ReadCount = 0) Or (Data.BufferOffset > Data.ReadCount) Then Begin Data.BufferOffset := 1 ; Data.ReadCount := FileRead (Data.FileHandle, Data.Buffer^, BufferSize) ; End ; CopyData ; End Until (Data.ReadCount = 0) Or (F.BufEnd >= Sizeof (F.Buffer) - 2) ; Result := 0 ; End ; Procedure Write (var Data : TStreamFileRecord) ; Var Status : Integer ; Destination : Integer ; II : Integer ; Begin With TStreamFileRecord (F.UserData) Do Begin Destination := 0 ; For II := 0 To F.BufPos - 1 Do Begin If F.Buffer [II] <> #13 Then Begin Inc (Destination) ; Buffer^[Destination] := F.Buffer [II] ; End ; End ; Status := FileWrite (FileHandle, Buffer^, Destination) ; F.BufPos := 0 ; Result := 0 ; End ; End ; Begin Case F.Mode Of fmInput: Read (TStreamFileRecord (F.UserData)) ; fmOutput: Write (TStreamFileRecord (F.UserData)) ; End ; End ; Function StreamFileFlush (var F : TTextRec) : Integer ; Begin Result := 0 ; End ; Function StreamFileClose (var F : TTextRec) : Integer ; Begin With TStreamFileRecord (F.UserData) Do Begin FreeMem (Buffer) ; FileClose (FileHandle) ; End ; Result := 0 ; End ; Procedure AssignStreamFile (var F : Text ; Filename : String) ; Begin With TTextRec (F) Do Begin Mode := fmClosed ; BufPtr := @Buffer ; BufSize := Sizeof (Buffer) ; OpenFunc := @StreamFileOpen ; InOutFunc := @StreamFileInOut ; FlushFunc := @StreamFileFlush ; CloseFunc := @StreamFileClose ; StrPLCopy (Name, FileName, Sizeof(Name) - 1) ; End ; End ; end.
Yes, ironic that it's so difficult to find routines to convert from decimal to binary isn't it!
The following should work.(for negative numbers too)
function DecToBinStr(n: integer): string; var S: string; i: integer; Negative: boolean; begin if n < 0 then Negative := true; n := Abs(n); for i := 1 to SizeOf(n) * 8 do begin if n < 0 then S := S + '1' else S := S + '0'; n := n shl 1; end; Delete(S,1,Pos('1',S) - 1);//remove leading zeros if Negative then S := '-' + S; Result := S; end;