📄 conv.htm
字号:
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
<html>
<head>
<title>UDDF - Conversions</title>
<META NAME="Description" CONTENT="Conversion section of the Delphi Developers FAQ" >
<META NAME="KeyWords" CONTENT="" >
</head>
<body bgcolor="#FFFFFF">
<CENTER>
<IMG SRC="../images/uddf.jpg"> </CENTER>
<HR SIZE="6" color="#00FF00">
<p align="center"><font color="#FF0000" size="7"
face="Arial Black">Conversions</font> </p>
<H1><A NAME="conv0">HEX -> Integer</A></H1>
<H2>Solution 1 </H2>
<p><i>From: Martin Larsson
<martin.larsson@delfi-data.msmail.telemax.no></i></p>
<hr>
<pre>var
i : integer
s : string;
begin
s := '$' + ThatHexString;
i := StrToInt(a);
end;
</pre>
<hr>
<H2>Solution 2 </H2>
<hr>
<pre>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.
</pre>
<hr>
<H1><A NAME="conv1">Dec To HEX</A></H1>
<p><i>From: Mark Bracey <mbracey@interaccess.com></i></p>
<p>I guess you mean as a string, correct.</p>
<hr>
<pre>HexString := Format('%0x',DecValue);
</pre>
<hr>
<H1><A NAME="conv2">ASCII to HEX / math</A></H1>
<p><i>From: gregc@cryptocard.com (Greg Carter)</i></p>
<p>These work on byte array to strings, also look at the Ord and
Chr functions in Delphi.</p>
<p>BytesToHexStr does this [0,1,1,0] of byte would be converted
to string := '30313130'; HexStrToBytes goes the other way. </p>
<hr>
<pre>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.
</pre>
<hr>
<hr>
<pre>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.
</pre>
<hr>
<p><H1><A NAME="conv3">Convert binary to decimal<img src="../images/new.gif" width=28 height=11 border=0 alt=" [NEW]"></p></A></H1>
<PRE>Can someone give me an idea of a simple way to convert binary (base2) to
decimal(base10).</PRE>
<H2>Solution 1</H2>
<I>[Anatoly Podgoretsky, kvk@estpak.ee]</I><P>
<Hr><PRE>////////////////////////////////////////////////
// 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;
</PRE><HR>
<H2>Solution 2</H2>
<I>[Oliver Townshend, oliver@zip.com.au]</I><P>
<Hr><PRE>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;
</PRE><HR>
<H2>Solution 3</H2>
<I>[Demian Lessa, knowhow@compos.com.br]</I><P>
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).<p>
<Hr><PRE>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;</PRE><HR>
Give this function any decimal value (1...3999), and it will return
you a string containing the proper value in Roman notation.<p>
<Hr><PRE>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;
</PRE><HR>
<H1><A NAME="conv4">Conversion from ICO to BMP</A></H1>
<p><i>From: vincze@ti.com (Michael Vincze)</i></p>
<p>Try:</p>
<hr>
<pre> 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;
</pre>
<hr>
<P><H1><A NAME="conv5">Unix strings (Reading and Writing Unix Files)</P></A></H1>
<P><I>From: miano@worldnet.att.net (John M. Miano)</I></P>
This is a unit that I wrote for reading and writing Unix files.
<HR><PRE>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.
</PRE><HR>
<p><H1><A NAME="conv6">JPEG and bitmaps in Delphi 3<img src="../images/new.gif" width=28 height=11 border=0 alt=" [NEW]"></p></A></H1>
<i>From: David Irizarry <xerxees@ix.netcom.com></i><p>
>
>Using Delphi 3, how do I translate a bitmap into an JPEG file?
>
Assume Image1 is a TImage component containing a bitmap. You could use the
following code segment to convert the bitmap into a JPEG file format: <p>
<hr><pre>var
MyJpeg: TJpegImage;
Image1: TImage;
begin
Image1:= TImage.Create;
MyJpeg:= TJpegImage.Create;
Image1.LoadFromFile('TestImage.BMP'); // Load the Bitmap from a file
MyJpeg.Assign(Image1.Picture.Bitmap); // Assign the BitMap to MyJpeg
object
MyJpeg.SaveToFile('MyJPEGImage.JPG'); // Save the JPEG to Disk
end;</pre><hr>
<P><H1><A NAME="conv7">Convert Wave format file to Raw data format<IMG SRC="../images/new.gif" WIDTH=28 HEIGHT=11 BORDER=0 ALT=" [NEW]"></P></A></H1>
<PRE>Does any body know how to convert a wave format file to raw format. e.g.
I want to strip out any header or encoding mechanism/method which may be
stored or encode in a wave file.</PRE>
I have a D1/D2 routine that reads WAV files and pulls out raw data, but it
doesn't decompress using the various forms of compression.<p>
<HR><PRE>
unit LinearSystem;
interface
{============== WAV Format Coding Type ==================}
type WAVHeader = record
nChannels : Word;
nBitsPerSample : LongInt;
nSamplesPerSec : LongInt;
nAvgBytesPerSec : LongInt;
RIFFSize : LongInt;
fmtSize : LongInt;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -