написать программу вычисления двоичного представления числа

Модераторы: Duncon, Naeel Maqsudov, Игорь Акопян, Хыиуду

Аватара пользователя
somewhere
Сообщения: 1858
Зарегистрирован: 31 авг 2006, 17:14
Откуда: 71 RUS
Контактная информация:

Прошу не винить за малофункциональность, но для решения именно этой задачи сгодиться. Формат числа немного изменился, теперь целая часть - 4 байта, остальные - дробная:

Код: Выделить всё

unit bbn;

interface

uses
  Windows, SysUtils, Classes, Controls, Forms, StdCtrls;

type

  TBigBinNumber = array [0..24] of byte;

  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    btnMul: TButton;
    Edit3: TEdit;
    btnDiv2: TButton;
    btnDiv: TButton;
    procedure btnMulClick(Sender: TObject);
    procedure btnDiv2Click(Sender: TObject);
    procedure btnDivClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  b	   : TBigBinNumber;

implementation

{$R *.dfm}

Function _binLoad(p1 :D WORD):TBigBinNumber;
begin
Result[0] := (p1 shr 24);
Result[1] := (p1 shr 16) and $FF;
Result[2] := (p1 shr 8) and $FF;
Result[3] := p1 and $FF;
FillChar(Result[4], 21, 0);
end;

function _binAdd(p1,p2:TBigBinNumber):TBigBinNumber;
var x, w: word;
begin
W := 0;
for x:=24 downto 0 do
	begin
	W := P1[X]+P2[X] + w shr 8;
	Result[X] := byte(W);
	end;
end;

function _binMul(p1,p2:TBigBinNumber):TBigBinNumber;
var x, y, w : Word;
	tmp  	: TBigBinNumber;
begin
Result := _binLoad(0);
For x:=24 downto 0 do
	begin
	w := 0;
	For y:=24 downto 0 do
		begin
		w := p1[x]*p2[y] + w shr 8;
		tmp[y] := byte(w);
		end;
	Result := _binAdd(Result, tmp);
	end;
end;

Function _binDiv2(p1:TBigBinNumber):TBigBinNumber;
var x 		 : Integer;
	oldcf, cf: Byte;
begin
oldcf := 0;
cf := 0;
For x:=0 to 24 do
	begin
	cf := p1[x] and 1;
	Result[x] := (p1[x] shr 1) or (oldcf shl 7);
	oldcf := cf;
	end;
end;

Function _binIDiv(p1:TBigBinNumber;p2:Byte):TBigBinNumber;
Var X       :Integer;
    T       :Word;
begin
T := 0;
For X:=0 to 24 do
    begin
    Result[X]:=(T+p1[x]) div p2;
    T := ((T+p1[x]) mod p2) shl 8;
    end;
end;

Function _binGetAsDouble(p1:TBigBinNumber) :D ouble;
var divizor : Double;
	x, y	: Integer;
begin
Result := 0;
Divizor := 65536;
Divizor := Divizor * 32768;
For X:=0 to 24 do
	for Y:=7 downto 0 do
		begin
		Result := Result + ((p1[X] shr Y) and 1) * divizor;
		divizor := divizor / 2;
		end;
end;

procedure TForm1.btnMulClick(Sender: TObject);
var p1,p2	: Integer;
begin
p1 := StrToInt(Edit1.Text);
p2 := StrToInt(Edit2.Text);
b := _binMul(_binLoad(p1), _binLoad(p2));
Edit3.Text := FloatToStrF(_binGetAsDouble(b), ffFixed, 10, 13);
end;

procedure TForm1.btnDiv2Click(Sender: TObject);
begin
b := _binDiv2(b);
Edit3.Text := FloatToStrF(_binGetAsDouble(b), ffFixed, 10, 13);
end;

procedure TForm1.btnDivClick(Sender: TObject);
begin
b := _binIDiv(_binLoad(StrToInt(Edit1.Text)), StrToInt(Edit2.Text));
Edit3.Text := FloatToStrF(_binGetAsDouble(b), ffFixed, 13, 13);
end;
end.
john_1
Сообщения: 19
Зарегистрирован: 16 ноя 2006, 07:18

я добил ее:
uses crt;
var
a,b,c:array[1..200] of longint;
w:array[1..200] of byte;
i,j,k,n,x,f,l,p:byte;
procedure perevod(m:byte); {procedure start}
begin
p:=30; {tochnost}
k:=1;
n:=5;
k:=k*10;
a[1]:=k div n;
c[1]:=k mod n;
for i:=2 to p do {delenie 1\n}
begin
a:=(c[i-1]*10) div n; {celaya}
c:=(c[i-1]*10) mod n; {ostatok}
end; {delenie 1\n END }

for i:=1 to p do {massiv summi}
begin
c:=0;
c:=c+a;
end;
for l:=1 to m-1 do {delenie massiva na 5}
begin
x:=0;
for j:=1 to p do b[j]:=a[j];
for i:=1 to p do
begin
x:=x*10+b;
b:=x div n;
x:=x mod n;
end; {end delenie massiva na 5}

for j:=1 to p do {summa 1\n^2+...}
begin
c[j]:=b[j]+c[j];
if (c[j] div 10)<>0 then
begin
c[j-1]:=c[j-1]+(c[j] div 10);
c[j]:=c[j] mod 10;
end; {end summa}
end;
for i:=1 to p do a:=b;
end;

for i:=1 to p do write(c[i]);
writeln;
for i:=2 to p+1 do begin {sdvig vpravo}
c[p-i+2]:=c[p-i+1];
end;

f:=0; {perevod v 2-nyu ss}
for j:=1 to 200 do
begin
for i:=p downto 1 do
begin
c[i]:=2*c[i]+f;
f:=(c[i] div 10);
c[i]:=c[i] mod 10;
end;
if c[1]=1 then
begin
c[1]:=0;
w[j]:=1;
end else
w[j]:=0;
end;
for i:=1 to 100 do write(w[i]);
end; {procedure end}
begin
perevod(8);
writeln;
writeln;
perevod(10);
writeln;
writeln;
perevod(20);
readln;
clrscr;
end.
Аватара пользователя
Игорь Акопян
Сообщения: 1440
Зарегистрирован: 13 окт 2004, 17:11
Откуда: СПБ
Контактная информация:

закрою эту тему и переименую,
про графику снёс сюда http://forum.developing.ru/showthread.php?t=7329
Изображение
Закрыто