Исходники и листинги ::: Delphi ::: Convert

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

unit convert;

interface

uses  SysUtils;

  function DecToBase(Decimal: LongInt;const Base: Byte): String;

  function px(s: string): integer;

  function ptype (int: integer): string;

  function num(tp, nm: string): string;

  function cut(str: string; fp, tp: integer): string;

  function inv(str: string): string;

  function bpln(str: string): string;

  function DecToBin(str: string): string;

  function HexToDec(str: string): string;

  function BinToDec(str: string): string;

  function DecToHex(str: string): string;

  function dectobins (str: string): string;

  function bintodecs(str: string): string;

implementation

function dectobins (str: string): string;

var

  d: real;

  i: integer;

  res: string;

begin

res := '';

d := strtofloat ('0'+','+str);

for i := 1 to 10 do

begin

  d := d*2;

  if trunc(d) >= 1 then

  begin

   d := d - 1;

   res := (res+'1');

  end else

  res := (res+'0');

end;

dectobins := res;

end;

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 px(s: string): integer;

var

  i, res: integer;

begin

res := 0;

for i := 1 to length(s) do

begin

  if (s[i] = ',') and (res=0) then

  res := i else  if (s[i] = ',') and (res<>0) then

  res:=-1;

end;

px := res;

end;

function ptype (int: integer): string;

begin

if (int >= -128) and (int <= 127) then

ptype := 'byte' else

if (int >= -32768) and (int <= 32767) then

ptype := 'word' else

if (int >= -2147483648) and (int <= 2147483647) then

ptype := 'dblword';

end;

function num(tp, nm: string): string;

var

  len, n, i: integer;

begin

len := length (nm);

if (tp = 'byte') and (len < 8) then

begin

  n := 8 - len;

  for i := 1 to n do

  nm := '0'+nm;

  num := nm;

end;

if (tp = 'word') and (len < 16) then

begin

  n := 16 - len;

  for i := 1 to n do

  nm := '0'+nm;

  num := nm;

end;

if (tp = 'dblword') and (len < 32) then

begin

  n := 32 - len;

  for i := 1 to n do

  nm := '0'+nm;

  num := nm;

end;

function cut(str: string; fp, tp: integer): string;

begin

cut := copy (str, fp, length(str)-fp-(length(str)-tp)+1);

end;

function inv(str: string): string;

var

  i: integer;

begin

for i := 1 to length (str) do

begin

case str[i] of '1': str[i] := '0';

                '0': str[i] := '1';

end;

inv := str;

end;

function bpln(str: string): string;

var

  c: integer;

  fl: boolean;

  ts: string;

begin

c := length(str);

ts := str;

fl := false;

repeat

  if str[c] = '0' then

  begin

   ts[c] := '1';

   fl := true;

  end;

  if str[c] = '1' then

   ts[c] := '0';

  c := c-1;

until (c = 0) or (fl = true);

if fl = true then bpln := ts;

if (c = 0) and (fl = false) then bpln := ('1'+ts);

end;

function dectobin(str: string): string;

var

  res, tmp, bin, s1, s2,

  b1, b2, t1, ft1, ft2: string;

  i: integer;

begin

if (str<>'') then

  begin

   res := '';

   i := px (str);

   if str[1]='-' then

    begin

     delete (str, 1, 1);

     if i = 0 then

      begin

       bin := dectobase(strtoint(str), 2);

       tmp := num (ptype(strtoint(str)), bin);

       bin := inv(tmp);

       res := bpln(bin);

      end;

     if i > 0 then

      begin

       s1 := cut (str, 1, i-2);

       s2 := cut (str, i+1, length(str));

       ft1 := ptype(strtoint(s1));

       b1 := dectobase(strtoint(s1), 2);

       b2 := dectobins(s2);

       t1 := num (ft1, b1);

       s1 := inv (t1);

       res := (bpln(s1)+','+b2);

      end;

     end else

    begin

     if i = 0 then

     res := dectobase(strtoint(str), 2);

     if i > 0 then

     begin

      s1 := cut (str, 1, i-1);

      s2 := cut (str, i+1, length(str));

      b1 := dectobase(strtoint(s1), 2);

      b2 := dectobins(s2);

      res := (b1+','+b2);

     end;

   dectobin := res;

  end;

function HexToDec(str: string): string;

const hex : array['A'..'F'] of integer = (10,11,12,13,14,15);

var

  int, i: integer;

begin

Int := 0;