
02.12.2012, 11:51
|
Прохожий
|
|
Регистрация: 02.12.2012
Сообщения: 1
Репутация: 10
|
|
Составить программу умножения целых и вещественных чисел младшими разрядами вперед
Всем привет. Что-то подобное на данную программу получилось, но только для целых чисел. Можете подсказать как дополнить программу чтобы она переводила и умножала вещественные числа?
Заранее благодарна.
Код:
unit Unit23;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Math;
type
TForm1 = class(TForm)
pnl1: TPanel;
Label1: TLabel;
lbl1: TLabel;
Label2: TLabel;
Label3: TLabel;
Button1: TButton;
arg1: TEdit;
arg2: TEdit;
lbarg1: TEdit;
lbarg2: TEdit;
Label4: TLabel;
Button2: TButton;
lblResult: TEdit;
lbl2: TLabel;
lbl3: TLabel;
lbl4: TLabel;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
function Convert2Bin(dec: string): string;
function Convert2Dec( bin: string) : string;
function Multiply( a1, a2 : string) : string;
function BinaryInc( a1, a2 :string) :string;
function MyShl(a: string) : string;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
ThisFloat:Byte;
implementation
{$R *.dfm}
procedure TForm1.Button2Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i:Integer;
a1: string;
a2: string;
otv : string;
otv_bin: string;
begin
ThisFloat:=0;
begin
for i:=0 to arg1.GetTextLen do begin
if (arg1.Text[i] = ',') or (arg1.Text[i] = '.') then
thisfloat:=1;
end;
for i:=0 to arg2.GetTextLen do begin
if (arg1.Text[i] = ',') or (arg1.Text[i] = '.') then
thisfloat:=1;
end;
if ThisFloat=1 then begin Windows.Beep(1000,110);break end;
end;
a1 := Convert2Bin(arg1.Text);
a2 := Convert2Bin(arg2.Text);
otv_bin := Multiply(a1, a2);
otv := Convert2Dec(otv_bin);
lbarg1.Text := arg1.Text + ' (' + a1 + ')';
lbarg2.Text := arg2.Text + ' (' + a2 + ')';
lblResult.Text := otv + ' (' + otv_bin + ')' ;
end;
Function TForm1.Convert2Bin(dec: string): string;
Var
md: integer;
given: integer;
Begin
md := 0;
given := StrToInt(dec);
while given <>0 do
begin
md := given mod 2;
given := Floor(given/2);
result := IntToStr(md) + result;
end;
End;
Function TForm1.Convert2Dec( bin: string) : string;
var
i: Integer;
otv: string;
tmp: real;
begin
otv := '0';
for i:=1 to length(bin) do
begin
tmp := StrToInt(bin[i]) * power(2, length(bin)-i) + StrToInt(otv);
otv := FloatToStr(tmp);
end;
result := otv;
end;
Function TForm1.Multiply( a1, a2 : string) : string;
var
i: Integer;
summa: string;
begin
summa := '0';
for i:=length(a2) downto 1 do begin
if a2[i] = '1' then summa := BinaryInc(summa, a1);
a1 := MyShl(a1);
end;
result := summa;
end;
function TForm1.BinaryInc( a1, a2 :string):string;
var
a3: string;
summa : string;
to_add : string;
keep: integer;
i: Integer;
c: integer;
Begin
summa := '';
to_add := '';
keep := 0;
i := 0;
c := 0;
If length(a2) > length(a1) then begin
A3 := A1;
A1 := A2;
A2 := A3;
End;
While length(a1) <> length(a2) do begin
A2 := '0' + a2;
End;
for i:=length(a1) downto 1 do begin
begin
c := keep + StrToInt(a1[i]) + StrToInt(a2[i]);
if keep > 0 then keep := keep - 1;
if c > 1 then keep := keep + 1;
if (c mod 2) = 0 then
to_add := '0'
else
to_add := '1';
end;
summa := to_add + summa;
end;
if keep>0 then summa := '1' + summa;
result := summa;
End;
Function TForm1.MyShl(a: string) : string;
begin
Result := a + '0';
end;
end.
|