Delphi 7 Yarı Bilimsel Hesap Makinesi - Samet Ugur SEVINCER

Delphi 7 Yarı Bilimsel Hesap Makinesi
[ Başlıklar(Programlama Dilleri) ] > [ Delphi 7 ] > [ Delphi 7 Yarı Bilimsel Hesap Makinesi ]
Oluşturma Tarihi: 04.06.2012 13.15 - Güncelleme Tarihi: 04.06.2012 13.19
Delphi 7 de 2010 yılında proje olarak yaptığımız yarı bilimsel hesap makinesinin kodlarını mantık oluşturması amacı ile yayınlamayı uygun gördüm.

Aldığımız proje itibarı ile hesap makinesinde standart 4 işlemin yanı sıra sin, cos, tan, cot işlemleri, faktöriyel hesabı, kare ve küp alma, üs alma, mod alma ile 2lik 8lik 10luk ve 16lık tabanlarda dönüşümler yapması gerekmekte idi.

Kod Bloğu
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, jpeg, ExtCtrls;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    Button12: TButton;
    Button13: TButton;
    Button14: TButton;
    Button15: TButton;
    Button16: TButton;
    Button17: TButton;
    Button18: TButton;
    Button19: TButton;
    Button20: TButton;
    Button21: TButton;
    Button22: TButton;
    Button23: TButton;
    Button25: TButton;
    Button26: TButton;
    Button27: TButton;
    Button28: TButton;
    Button30: TButton;
    Button31: TButton;
    Button33: TButton;
    Button35: TButton;
    Button36: TButton;
    Button37: TButton;
    Button38: TButton;
    Button40: TButton;
    Button24: TButton;
    Button41: TButton;
    Image1: TImage;
    Button42: TButton;
    Button43: TButton;
    Button44: TButton;
    Button45: TButton;
    Button46: TButton;
    Button48: TButton;
    Button39: TButton;
    Button29: TButton;
    Button32: TButton;
    Button34: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button25Click(Sender: TObject);
    procedure Button13Click(Sender: TObject);
    procedure Button14Click(Sender: TObject);
    procedure Button15Click(Sender: TObject);
    procedure Button16Click(Sender: TObject);
    procedure Button26Click(Sender: TObject);
    procedure Button18Click(Sender: TObject);
    procedure Button19Click(Sender: TObject);
    procedure Button20Click(Sender: TObject);
    procedure Button21Click(Sender: TObject);
    procedure Button22Click(Sender: TObject);
    procedure Button23Click(Sender: TObject);
    procedure Button24Click(Sender: TObject);
    procedure Button27Click(Sender: TObject);
    procedure Button17Click(Sender: TObject);
    procedure Button28Click(Sender: TObject);
    procedure Button36Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure Button41Click(Sender: TObject);
    procedure Button42Click(Sender: TObject);
    procedure Button43Click(Sender: TObject);
    procedure Button44Click(Sender: TObject);
    procedure Button45Click(Sender: TObject);
    procedure Button46Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button37Click(Sender: TObject);
    procedure Button40Click(Sender: TObject);
    procedure Button48Click(Sender: TObject);
    procedure Button35Click(Sender: TObject);
    procedure Button33Click(Sender: TObject);
    procedure Button31Click(Sender: TObject);
    procedure Button38Click(Sender: TObject);
    procedure Button29Click(Sender: TObject);
    procedure Button30Click(Sender: TObject);
    procedure Button39Click(Sender: TObject);
    procedure Button32Click(Sender: TObject);
    procedure Button34Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  atanan,ikinci,g,faktoriyel,sonuc:real;
  islem:char;
  x:double; v:integer; n:integer; p:integer;
  t,u,tut,r1,h:integer;

  rakam: string;

  sonraki: Char;
  ileri:boolean;
  f,a: string;
  y,s: integer;



const pi:double=3.14;

implementation
function dec2bin(dec: longint): string;

var
bin: string;
i, j: longint;

begin
if dec = 0 then
bin := ´0´
else
begin
bin := ´´;
i := 0;
while (1 shl (i + 1)) <= dec do
i := i + 1;
{ (1 shl (i + 1)) = 2^(i + 1) }
for j := 0 to i do
begin
if (dec shr (i - j)) = 1 then
bin := bin + ´1´
{ (dec shr (i - j)) = dec div 2^(i - j) }
else
bin := bin + ´0´;
dec := dec and ((1 shl (i - j)) - 1);
{ dec and ((1 shl (i - j)) - 1) = dec mod 2^(i - j) }
end;
end;
dec2bin := bin;
end;

function bin2dec(bin: string): longint;

var
j: longint;
error: boolean;
dec: longint;

begin
dec := 0;
error := false;
for j := 1 to length(bin) do
begin
if (bin[j] <> ´0´) and (bin[j] <> ´1´) then
error := true;
if bin[j] = ´1´ then
dec := dec + (1 shl (length(bin) - j));
{ (1 shl (length(bin) - j)) = 2^(length(bin)- j) }
end;
if error then
bin2dec := 0
else
bin2dec := dec;
end;

function dec2hex(dec: longint): string;

const
hexdigts: string[16] = ´0123456789ABCDEF´;

var
hex: string;
i, j: longint;

begin
if dec = 0 then
hex := ´0´
else
begin
hex := ´´;
i := 0;
while (1 shl ((i + 1) * 4)) <= dec do
i := i + 1;
{ 16^n = 2^(n * 4) }
{ (1 shl ((i + 1) * 4)) = 16^(i + 1) }
for j := 0 to i do
begin
hex := hex + hexdigts[(dec shr ((i - j) * 4)) + 1];
{ (dec shr ((i - j) * 4)) = dec div 16^(i - j) }
dec := dec and ((1 shl ((i - j) * 4)) - 1);
{ dec and ((1 shl ((i - j) * 4)) - 1) = dec mod 16^(i - j) }
end;
end;
dec2hex := hex;
end;

function hex2dec(hex: string): longint;

function digt(ch: char): byte;

const
hexdigts: string[16] = ´0123456789ABCDEF´;

var
i: byte;
n: byte;

begin
n := 0;
for i := 1 to length(hexdigts) do
if ch = hexdigts[i] then
n := i - 1;
digt := n;
end;

const
hexset: set of char = [´0´..´9´, ´A´..´F´];

var
j: longint;
error: boolean;
dec: longint;

begin
dec := 0;
error := false;
for j := 1 to length(hex) do
begin
if not (upcase(hex[j]) in hexset) then
error := true;
dec := dec + digt(upcase(hex[j])) shl ((length(hex) - j) * 4);
{ 16^n = 2^(n * 4) }
{ n shl ((length(hex) - j) * 4) = n * 16^(length(hex) - j) }
end;
if error then
hex2dec := 0
else
hex2dec := dec;
end;

function dec2oct(dec: longint): string;

const
octdigts: string[8] = ´01234567´;

var
oct: string;
i, j: longint;

begin
if dec = 0 then
oct := ´0´
else
begin
oct := ´´;
i := 0;
while (1 shl ((i + 1) * 3)) <= dec do
i := i + 1;
{ 8^n = 2^(n * 3) }
{ (1 shl (i + 1)) = 8^(i + 1) }
for j := 0 to i do
begin
oct := oct + octdigts[(dec shr ((i - j) * 3)) + 1];
{ (dec shr ((i - j) * 3)) = dec div 8^(i - j) }
dec := dec and ((1 shl ((i - j) * 3)) - 1);
{ dec and ((1 shl ((i - j) * 3)) - 1) = dec mod 8^(i - j) }
end;
end;
dec2oct := oct;
end;

function oct2dec(oct: string): longint;

const
octset: set of char = [´0´..´7´];

var
j: longint;
error: boolean;
dec: longint;

begin
dec := 0;
error := false;
for j := 1 to length(oct) do
begin
if not (upcase(oct[j]) in octset) then
error := true;
dec := dec + (ord(oct[j]) - 48) shl ((length(oct) - j) * 3);
{ 8^n = 2^(n * 3) }
{ n shl ((length(oct) - j) * 3) = n * 8^(length(oct) - j) }
end;
if error then
oct2dec := 0
else
oct2dec := dec;
end;

function bin2hex(bin: string): string;

function sethex(st: string; var error: boolean): char;

var
ch: char;

begin
if st = ´0000´ then
ch := ´0´
else if st = ´0001´ then
ch := ´1´
else if st = ´0010´ then
ch := ´2´
else if st = ´0011´ then
ch := ´3´
else if st = ´0100´ then
ch := ´4´
else if st = ´0101´ then
ch := ´5´
else if st = ´0110´ then
ch := ´6´
else if st = ´0111´ then
ch := ´7´
else if st = ´1000´ then
ch := ´8´
else if st = ´1001´ then
ch := ´9´
else if st = ´1010´ then
ch := ´A´
else if st = ´1011´ then
ch := ´B´
else if st = ´1100´ then
ch := ´C´
else if st = ´1101´ then
ch := ´D´
else if st = ´1110´ then
ch := ´E´
else if st = ´1111´ then
ch := ´F´
else
error := true;
sethex := ch;
end;

var
hex: string;
i: integer;
temp: string[4];
error: boolean;

begin
error := false;
if bin = ´0´ then
hex := ´0´
else
begin
temp := ´´;
hex := ´´;
if length(bin) mod 4 <> 0 then
repeat
bin := ´0´ + bin;
until length(bin) mod 4 = 0;
for i := 1 to length(bin) do
begin
temp := temp + bin[i];
if length(temp) = 4 then
begin
hex := hex + sethex(temp, error);
temp := ´´;
end;
end;
end;
if error then
bin2hex := ´0´
else
bin2hex := hex;
end;

function hex2bin(hex: string): string;

var
bin: string;
i: integer;
error: boolean;

begin
error := false;
bin := ´´;
for i := 1 to length(hex) do
case upcase(hex[i]) of
´0´: bin := bin + ´0000´;
´1´: bin := bin + ´0001´;
´2´: bin := bin + ´0010´;
´3´: bin := bin + ´0011´;
´4´: bin := bin + ´0100´;
´5´: bin := bin + ´0101´;
´6´: bin := bin + ´0110´;
´7´: bin := bin + ´0111´;
´8´: bin := bin + ´1000´;
´9´: bin := bin + ´1001´;
´A´: bin := bin + ´1010´;
´B´: bin := bin + ´1011´;
´C´: bin := bin + ´1100´;
´D´: bin := bin + ´1101´;
´E´: bin := bin + ´1110´;
´F´: bin := bin + ´1111´;
else
error := true;
end;
if error then
hex2bin := ´0´
else
hex2bin := bin;
end;



{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
edit1.Text:=edit1.Text+´9´;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
edit1.Text:=edit1.Text+´8´;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
edit1.Text:=edit1.Text+´7´;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
edit1.Text:=edit1.Text+´6´;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
edit1.Text:=edit1.Text+´5´;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
edit1.Text:=edit1.Text+´4´;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
edit1.Text:=edit1.Text+´3´;
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
edit1.Text:=edit1.Text+´2´;
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
edit1.Text:=edit1.Text+´1´;
end;

procedure TForm1.Button11Click(Sender: TObject);
begin
edit1.Text:=edit1.Text+´0´;
end;

procedure TForm1.Button42Click(Sender: TObject);
begin
edit1.Text:=edit1.Text+´A´;
end;
procedure TForm1.Button43Click(Sender: TObject);
begin
edit1.Text:=edit1.Text+´B´;
end;
procedure TForm1.Button44Click(Sender: TObject);
begin
edit1.Text:=edit1.Text+´C´;
end;
procedure TForm1.Button45Click(Sender: TObject);
begin
edit1.Text:=edit1.Text+´D´;
end;
procedure TForm1.Button46Click(Sender: TObject);
begin
edit1.Text:=edit1.Text+´E´;
end;
procedure TForm1.Button10Click(Sender: TObject);
begin


      if pos(´,´,rakam) = 0 then
      begin
        if (rakam = ´´)or (rakam = ´-´) then edit1.Text:=edit1.Text+´,´;
        end;
      exit;

end;

procedure TForm1.Button25Click(Sender: TObject);
begin
edit1.clear;
end;

procedure TForm1.Button13Click(Sender: TObject);
begin
islem:=´+´;
atanan:=strtofloat(edit1.text);
edit1.text:=´´;
end;

procedure TForm1.Button14Click(Sender: TObject);
begin
islem:=´-´;
atanan:=strtofloat(edit1.text);
edit1.text:=´´;
end;

procedure TForm1.Button15Click(Sender: TObject);
begin
islem:=´*´;
atanan:=strtofloat(edit1.text);
edit1.text:=´´;
end;

procedure TForm1.Button16Click(Sender: TObject);
begin
islem:=´/´;
atanan:=strtofloat(edit1.text);
edit1.text:=´´;
end;

procedure TForm1.Button27Click(Sender: TObject);
begin
islem:=´%´;
atanan:=strtofloat(edit1.text);
edit1.text:=´´;

end;

procedure TForm1.Button24Click(Sender: TObject);
begin
atanan:=strtofloat(edit1.text);
edit1.text:=´´;
edit1.Text:=floattostr((cos(pi*atanan/180))/(sin(pi*atanan/180)));
end;
procedure TForm1.Button41Click(Sender: TObject);
begin

f:=Edit1.Text;
islem:=´u´;
edit1.Text:=´´;

end;



procedure TForm1.Button26Click(Sender: TObject);
begin
ikinci:=strtofloat(edit1.text);
a:=edit1.Text;
s:=1;
if islem=´u´ then begin edit1.Text:=´´; for y:=1 to strtoint(a) do begin s:=s*strtoint(f); end; edit1.text:=inttostr(s);end;
if islem=´+´ then begin edit1.Text:=´´; edit1.Text:=floattostr(ikinci+atanan);end;
if islem=´-´ then begin edit1.Text:=´´; edit1.Text:=floattostr(atanan-ikinci);end;
if islem=´*´ then begin edit1.Text:=´´; edit1.Text:=floattostr(ikinci*atanan);end;
if islem=´%´ then begin sonuc:=0; n:=trunc(atanan/ikinci); x:=n*ikinci; sonuc:=atanan-x; edit1.Text:=(floattostr(sonuc));end;
if ikinci=0 then begin showmessage(´Sıfıra Bölünemez!!!´) end else
if islem=´/´ then begin edit1.Text:=´´; edit1.Text:=floattostr(atanan/ikinci);end;

end;

procedure TForm1.Button18Click(Sender: TObject);
begin
atanan:=strtofloat(edit1.text);
edit1.Text:=´´; edit1.Text:=floattostr(atanan*atanan);
end;

procedure TForm1.Button19Click(Sender: TObject);
begin
atanan:=strtofloat(edit1.text);
edit1.Text:=´´; edit1.Text:=floattostr(atanan*atanan*atanan);
end;

procedure TForm1.Button20Click(Sender: TObject);
begin
atanan:=strtofloat(edit1.text);
edit1.text:=floattostr(sqrt(atanan));
end;

procedure TForm1.Button21Click(Sender: TObject);
begin
atanan:=strtofloat(edit1.text);
edit1.text:=´´;
edit1.Text:=floattostr(sin(pi*atanan/180));
end;

procedure TForm1.Button22Click(Sender: TObject);
begin
atanan:=strtofloat(edit1.text);
edit1.text:=´´;
edit1.Text:=floattostr(cos(pi*atanan/180));
end;

procedure TForm1.Button23Click(Sender: TObject);
begin
atanan:=strtofloat(edit1.text);
edit1.text:=´´;
edit1.Text:=floattostr((sin(pi*atanan/180))/(cos(pi*atanan/180)));
end;

procedure TForm1.Button17Click(Sender: TObject);
begin

v:=1;
for p:=1 to strtoint(edit1.text) do
 begin
v:=v*p;
 end;
edit1.text:=inttostr(v);
end;


procedure TForm1.Button28Click(Sender: TObject);
begin
edit1.Text:=´´;
edit1.Text:=´Kübra Gülmez © S.Uğur Sevinçer´;
end;

procedure TForm1.Button36Click(Sender: TObject);
begin
t:=strtointdef(edit1.Text,0);
Edit1.Text:=´´;
for u:=0 to 15 do
edit1.Text:=inttostr((t shr u) and 1) + edit1.Text;
end;






procedure TForm1.Button12Click(Sender: TObject);
begin
rakam:=edit1.Text;
  if pos(´-´,rakam)=1 then
    delete(rakam,1,1)
  else
    insert(´-´,rakam,1);
  if (sonraki <> ´´) and (ileri) then rakam:=´-´;
  if rakam=´-´ then ileri:=false;
   Edit1.Text:=rakam;

end;



procedure TForm1.FormCreate(Sender: TObject);
begin
      height :=300;
      Width :=460;
end;



procedure TForm1.Button29Click(Sender: TObject);
var
kkk:string;
begin
kkk:=edit1.Text;
edit1.Text:=inttostr(bin2dec(kkk));
end;



procedure TForm1.Button37Click(Sender: TObject);
var
ttt:integer;
begin
ttt:=strtoint(edit1.Text);
edit1.Text:=dec2hex(ttt);
end;

procedure TForm1.Button40Click(Sender: TObject);
var
kkk:string;
begin
kkk:=edit1.Text;
edit1.Text:=inttostr(hex2dec(kkk));
end;

procedure TForm1.Button48Click(Sender: TObject);
begin

edit1.Text:=edit1.Text+´F´;

end;

procedure TForm1.Button35Click(Sender: TObject);
var
ttt:integer;
begin
ttt:=strtoint(edit1.Text);
edit1.Text:=dec2oct(ttt);

end;

procedure TForm1.Button33Click(Sender: TObject);
var
kkk:string;
begin
kkk:=edit1.Text;
edit1.Text:=inttostr(oct2dec(kkk));

end;

procedure TForm1.Button31Click(Sender: TObject);
var
kkk:string;
begin
kkk:=edit1.Text;
edit1.Text:=bin2hex(kkk);
end;
procedure TForm1.Button38Click(Sender: TObject);
var
kkk:string;
begin
kkk:=edit1.Text;
edit1.Text:=hex2bin(kkk);
end;
procedure TForm1.Button30Click(Sender: TObject);

var
kkk:string;
begin
kkk:=edit1.Text;
edit1.Text:=dec2oct(bin2dec(kkk));
end;

procedure TForm1.Button39Click(Sender: TObject);
var
kkk:string;
begin
kkk:=edit1.Text;
edit1.Text:=dec2oct(hex2dec(kkk));
end;

procedure TForm1.Button32Click(Sender: TObject);
var
kkk:string;
begin
kkk:=edit1.Text;
edit1.Text:=dec2bin(oct2dec(kkk));
end;

procedure TForm1.Button34Click(Sender: TObject);
var
kkk:string;
begin
kkk:=edit1.Text;
edit1.Text:=dec2hex(oct2dec(kkk));

end;

end.
Örnek Program Sonucu:
Delphi 7 Proje dosyalarını indirmek için buraya tıklayınız.
Yorumunuzu Yazınız...	Ad Soyad
	E-Posta
	Kod
Samet Uğur SEVİNÇER: Not: Projeye katkılarından dolayı(ortak) Kübra Gülmez'e Teşekkürlerimi sunarım...
04.06.2012 13:53
Etiketler: delphi , 7 , hesap , makinesi , yarı , bilimsel , kod , program , dec , oct , hex , binary , faktoriyel , 2lik , kup , 8lik , 16lık , cos , sin , tan , cot , taban , donusumleri , donusum , kok
Sitede su anda 2 kişi bulunmaktadir. Bugune dek 446121 kisi tarafından, 733489 adet tiklama yapilmistir.
© Susbi.com
Version 1.1
Site_Map