{ LOG.PAS Copyright (c) Jan Benkovic } { Program vypoctu logaritmu troma sposobmi. } { - vypocet logaritmu s neznamym VYSLEDKOM } { - vypocet logaritmu s neznamym B } { - vypocet logaritmu s neznamym A } { } { Datum:06.02.2000 http://www.trsek.com } uses crt; var c: char; posun,kon: byte; a,b,vysledok,eps,x,x1,q,pom1:real; d,i,e:longint; pom: extended; procedure Koniec1; begin clrscr; gotoxy(30,10); Writeln('CREATED BY TRIO CREW '); gotoxy(36,11); Writeln('Macko 007 '); gotoxy(24,12); Writeln('http://freeweb.coco.cz/triocrew '); gotoxy(30,13); Writeln('Benkovic@internet.sk '); readkey; exit; end; procedure logaritmus; begin clrscr; posun:=0; kon:=0; a:=0; b:=0; i:=0; vysledok:=0; pom:=0; pom1:=0; Textcolor(Red); Writeln('Logaritmi >'); Writeln('Logaritmus A so zakladom B je VYSLEDOK'); Writeln; Textcolor(lightgray); Writeln('Ratat s neznamym VYSLEDKOM'); Writeln('Ratat s neznamym B'); Writeln('Ratat s neznamym A'); Writeln('Exit to OS'); gotoxy(30,4); Writeln('<-'); repeat repeat c:=readkey until (c='P')or(c='H')or(c=#13); case c of 'P': begin if posun=3 then else begin posun:=posun+1; gotoxy(30,4+posun); Writeln('<-'); gotoxy(30,4+posun-1); Writeln(' '); end; end; 'H': begin if posun=0 then else begin posun:=posun-1; gotoxy(30,4+posun); Writeln('<-'); gotoxy(30,4+posun+1); Writeln(' '); end; end; #13 :kon:=kon+1; end; until kon=1; if posun=0 then begin clrscr; Writeln('Logaritmus A so zakladom B je'); Write('Zadaj A '); Readln(a); Write('Zadaj B '); Readln(b); if (a=0)or(b=0)or(a=1) then begin gotoxy(1,1); Writeln('Logaritmus nema zmisel '); end else begin vysledok:=ln(b)/ln(a); gotoxy(31,1); Writeln(vysledok:10:20); end; readkey; logaritmus; end else if posun=1 then begin clrscr; Writeln('Logaritmus B so zakladom .. je VYSLEDOK'); Write('Zadaj B '); Readln(a); Write('Zadaj VYSLEDOK '); Readln(b); if b=3 then begin eps:=1; i:=20; repeat eps := eps/10; i:=i-1; until i=0; x1:= 1; repeat x:= x1; x1 := x+(a/(x*x)-x)/3; until abs(x1-x) < eps; gotoxy(1,1); Writeln('Logaritmus B so zakladom ',x1:10:20,' je VYSLEDOK'); readkey; logaritmus; end else if b=1 then begin gotoxy(1,1); Writeln('Logaritmus B so zakladom ',a:10:20,' je VYSLEDOK'); readkey; logaritmus; end else if b=0 then begin gotoxy(1,1); Writeln('Logaritmus nema zmisel '); readkey; logaritmus; end else begin pom:=b; repeat q:=b/2; b:=q; i:=i+1; until (b<=2); if b=1 then begin pom:=sqrt(a); gotoxy(1,1); Writeln('Logaritmus ',a:10:10,' so zakladom ',pom:10:10,' je VYSLEDOK'); readkey; logaritmus; end else if b<2 then begin gotoxy(1,1); Writeln('Logaritmus je ',pom:10:10,'-ta odmocnina s ',a:10:10); end else begin for d:= 1 to i+1 do begin pom1:=sqrt(pom); pom:=pom1; end; gotoxy(1,1); Writeln('Logaritmus ',a:10:10,' so zakladom ',pom1:10:10,' je VYSLEDOK'); end; readkey; logaritmus; end; end else if posun=2 then begin pom:=1; clrscr; Writeln('Logaritmus .. so zakladom B je VYSLEDOK'); Write('Zadaj B '); Readln(a); Write('Zadaj VYSLEDOK '); Readln(e); for i:= 1 to e do pom:=a*pom; gotoxy(1,1); Writeln('Logaritmus ',pom,' so zakladom B je VYSLEDOK'); readkey; logaritmus; end else if posun=3 then Koniec1; end; procedure Help; begin clrscr; gotoxy(13,1); Writeln('--------------------------HELP-------------------------'); gotoxy(13,2); Writeln('Logaritmi : '); gotoxy(13,3); Writeln('Program bol vytvoreny pre ulahcenie ratania logaritmov,'); gotoxy(13,4); Writeln('ktore sa na kalkulacke rataju zlozitejsie.'); gotoxy(13,5); Writeln; gotoxy(13,6); Writeln('V jednolivych urovniach sa pohybuje sipkami hore a '); gotoxy(13,7); Writeln('dole postup sa potvrdzuje ENTERom.'); gotoxy(13,8); WRiteln('Pri pisani jednotlivych cisle sa kurzor nezobrazuje'); gotoxy(13,9); Writeln; gotoxy(13,10); Writeln('Datum : 6.2.2000'); gotoxy(13,11); Writeln('Den : Nedela'); gotoxy(13,12); Writeln('Cas : 16.16'); gotoxy(13,13); Writeln('--------------------------EXIT-------------------------'); readkey; Koniec1; end; procedure Koniec; begin clrscr; gotoxy(30,10); Writeln('CREATED BY TRIO CREW '); gotoxy(36,11); Writeln('Macko 007 '); gotoxy(24,12); Writeln('http://freeweb.coco.cz/triocrew '); gotoxy(30,13); Writeln('Benkovic@internet.sk '); readkey; exit; end; begin asm mov ah,1 mov cx,2000h int 10h end; clrscr; gotoxy(33,8); Textcolor(Red); Writeln('L O G A R I T M I'); Textcolor(lightgray); gotoxy(36,10); Writeln('Logaritmus'); gotoxy(39,11); Writeln('Help'); gotoxy(36,12); Writeln('Exit to OS'); gotoxy(28,10); Writeln('->'); repeat repeat c:=readkey until (c='P')or(c='H')or(c=#13); case c of 'P': begin if posun=2 then else begin posun:=posun+1; gotoxy(28,10+posun); Writeln('->'); gotoxy(28,10+posun-1); Writeln(' '); end; end; 'H': begin if posun=0 then else begin posun:=posun-1; gotoxy(28,10+posun); Writeln('->'); gotoxy(28,11-posun); Writeln(' '); gotoxy(28,12); Writeln(' '); end; end; #13: kon:=kon+1; end; until kon=1; if posun=0 then Logaritmus else if posun=1 then Help else Koniec; end.