Форум » Clipper » Помогите пожалуйста! » Ответить

Помогите пожалуйста!

apposs: Здраствуйте! Очень нужна помощь, нужно написать программку Калькулятор на языке программирования Clipper, буду очень благодарен: Написать процедуру "Калькулятор", которая вызывается клавишей <F3>. Калькулятор должен выполнять 4 арифмитических действия. В нем должно быть окошко, куда вводятся числа и где отображается результат вычислений ----------- | 50.10 | -----------

Ответов - 64, стр: 1 2 3 4 All

PSP: #include "inkey.ch" PROCEDURE Main() PRIVATE calc_str := SPACE(255) PRIVATE back_shad := "W/N" set scor off setcolor ("w/bg+") clear Calcit() RETURN ****************** PROCEDURE Calcit() LOCAL l_eft:=SETKEY(K_LEFT,),r_ight:=SETKEY(K_RIGHT,) SETKEY(K_ALT_F1,) PARA cBack_shad,is_load_font PRIVATE x_pos:=1,y_pos:= 1 PRIVATE sav_screen,ss,st,a,str_tmp,flag,flag_err,buf,scol PRIVATE fl_mem,help_old,col_mn PRIVATE ss11, cc ************************* ** Начальные установки ** ************************* cc:= SETCURSOR() && Сохранить курсор sav_screen:=SAVESCREEN() && Сохранить экран SETCANCEL(.F.) col_mn:=SETCOLOR() ss :=0.0 st := " " flag_err:= 0 flag := 0 fl_mem := 0 INI_CALC(is_load_font) WHILE LASTKEY() <> 27 IF LEN_TRIM(calc_str) = 0 calc_str := "0"+SPACE(253) ENDIF SET COLOR TO +GR/BG SET CURSOR ON calc_str := MEMOEDIT(CALC_STR,2+y_pos, 2+x_pos, 2+y_pos, 20+x_pos, .T. ,"press_d", LEN(calc_str) ) SET CURSOR OFF IF flag = 1 && ВЫЧИСЛЕНИЕ ВЫРАЖЕНИЯ st := STRTRAN(calc_str,"Н"," ") st := STRTRAN(st,chr(10)," ") st := STRTRAN(st,chr(13)," ") st := STRTRAN(st,"="," ") st:=STRTRAN(st,"%","/100*") st_1 := SUBSTR(st,1,1) && ОЦЕНКА ПЕРВОГО СИМВОЛА СТРОКИ IF (st_1 >= "0" .and. st_1 <= "9") .or. st_1 = "+" .or. st_1 = "-" .or. st_1 = "(" bLastHandler := ErrorBlock( { | oErr | NewHandler( oErr ) } ) BEGIN SEQUENCE ss := &st && ВЫЧИСЛЕНИЕ RECOVER USING oErr buf:=SAVESCREEN(2+y_pos, 2+x_pos, 2+y_pos, 18+x_pos) scol := SETCOLOR() SET COLOR TO *+R/G @ 2+y_pos, 2+x_pos SAY " ERROR! PRESS SPACE" INKEY(0) flag_err := 0 ss := 0 END ErrorBlock( bLastHandler ) ELSE flag_err := 1 && ОШИБКА ENDIF IF flag_err = 0 && ЕСЛИ ОШИБКИ ВЫЧИСЛЕНИЯ НЕТ str_tmp:=ALLTRIM(STR(ss)) calc_str := ALLTRIM(STR(ss))+SPACE(255-LEN(str_tmp)) flag := 0 *********************** &&-- ОБРАБОТКА ОШИБКИ ВЫРАЖЕНИЯ -------------- ELSE buf:=SAVESCREEN(2+y_pos, 2+x_pos, 2+y_pos, 18+x_pos) scol := SETCOLOR() SET COLOR TO *+R/G @ 2+y_pos, 2+x_pos SAY " ERROR! PRESS SPACE" INKEY(0) flag_err := 0 ENDI ENDI END FUNCTION NewHandler( oErr ) BREAK oErr RETURN NIL ********************************** ** ОБРАБОТКА ЦИФРОВЫХ КЛАВИШ ** ********************************** FUNCTION PRESS_D key := LASTKEY() DO CASE **************************** ** арифметические действия ** **************************** CASE key = 42 y1 := 5+y_pos x1 := 1+x_pos ch := '*' CASE key = 47 y1 := 5+y_pos x1 := 5+x_pos ch := '/' CASE key = 43 y1 := 5+y_pos x1 := 9+x_pos ch := '+' CASE key = 45 y1 := 5+y_pos x1 := 13+x_pos ch := '-' CASE key = 46 y1 := 5+y_pos x1 := 17+x_pos ch := '.' ENDCASE *************************** ** обработка знака = , enter ** *************************** IF key = 61 .or. key = 13 KEYBOARD CHR(23) flag := 1 ENDI ******************************* ** ПРОРИСОВКА КАЛЬКУЛЯТОРА ** ******************************* PROC INI_CALC(is_load_font) is_load_font:=IF(is_load_font=NIL,.F.,is_load_font) SET COLOR TO +G/B @ 1+y_pos, 1+x_pos, 3+y_pos, 22+x_pos BOX IF(!is_load_font," "," ") FUNCTION LEN_TRIM PARAMETERS str RETU LEN(ALLTRIM(str)) RETURN

apposs: Спасибо PSP, все работает!

PSP: apposs пишет: Спасибо PSP, все работает! Не за что. :)


z-piter: Ну вот, если "это, откомпелировать - будет работать, делал кода-то в незапамятные времена, на "скорую руку" ***** set cursor off clear @ 10,10 say 'Нажмите клавишу F3' r1r=inkey(0) if r1r=-2 do klkt endif proc klkt @ 10,10 say 'Введите "строку вычислений" и нажмите клавишу "Enter" ' ram=chr(218)+chr(196)+chr(191)+chr(179)+chr(217)+chr(196)+chr(192)+chr(179) set color to w+/b,n+/bg+ save screen to kalk aa=space(77) row_=10 a1_10='0123456789.=+-/*:' @ row_+2,1 clear to row_+4,78 @ row_+1,0,row_+5,79 box ram @ row_+3,1 say 'Режим калькулятора. Клавиши: "+","-","*"(умножить),"/"(деление)' @ row_+4,1 say ' Bнимание : в конце строки должен находиться знак "=" ' do while.t. save screen to kalk_k set cursor on do while.t. @ row_+2,1 get aa read if at('=',aa)=0 loop else exit endif enddo set cursor off lin=1 lin1=0 do while.t. if lin1=0 rez=val(substr(aa,1,lin)) endif znak=substr(aa,lin,1) if znak='+'.or.znak='-'.or.znak='*'.or.znak='/'.or.znak='=' if znak='=' aa=substr(aa,1,lin)+alltrim(str(rez,10,2)) set color to n+/bg+ @ row_+2,1 say space(79) @ row_+2,1 say aa set color to w+/b,n+/bg+ exit endif lin1=lin znak1=' ' do while.t. lin=lin+1 znak1=substr(aa,lin,1) if znak1='+'.or.znak1='-'.or.znak1='*'.or.znak1='/'.or.znak1='=' ab=substr(aa,lin1+1,lin-lin1-1) do case case znak='+' rez=rez+val(ab) case znak='-' rez=rez-val(ab) case znak='/' rez=rez/val(ab) case znak='*' rez=rez*val(ab) endcase set color to n+/bg+ @ row_+2,1 say space(77) @ row_+2,1 say aa+alltrim(str(rez,10,2)) set color to w+/b,n+/bg+ znak= ' ' znak1=' ' lin=lin-1 exit endif enddo endif lin=lin+1 enddo @ row_+3,1 clear to row_+4,78 @ row_+3,20 say 'Peзультат = '+alltrim(str(rez,18,2))+' Продолжить ? ' PR_noo=2 @ row_+4,45 say '(Возврат в "строку" - кл."Esc")' @ row_+4,15 prompt ' ДА ' @ row_+4,30 prompt ' HET ' menu to pr_noo do case case pr_noo=1 aa=alltrim(str(rez,18,2))+space(77-len(alltrim(str(rez,18,2)))) restore screen from kalk_k loop case pr_noo=2 if r1r=-2 @ row_+2,1 clear to row_+4,78 @ row_+3,1 say ' Расчет ЗАКОНЧЕН. ' @ row_+4,1 say aa inkey(5) endif clear exit case pr_noo=0 aa=aa+space(77-len(aa)) restore screen from kalk_k loop endcase enddo *****



полная версия страницы