Отправлено: 19.03.10 12:09. Заголовок: Помогите пожалуйста!

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

 Отправлено: 19.03.10 14:43. Заголовок: apposs пишет: нужно..

apposs пишет:

цитата:

нужно написать программку Калькулятор на языке программирования Clipper

Рабочий пример из старой коллекции для Клиппера 5-й версии и выше:

цитата:

#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() **help_old = name_hlp **name_hlp = "calculator" 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, 22+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 := ALLTRIM(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 = "(" ss := &st && ВЫЧИСЛЕНИЕ 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, 22+x_pos) scol := SETCOLOR() SET COLOR TO *+GR/BG @ 2+y_pos, 2+x_pos SAY " Error! Press space. " INKEY(10) flag_err := 0 SETCOLOR(scol) calc_str := st + SPACE(255-LEN(st)) RESTSCREEN(2+y_pos, 2+x_pos, 2+y_pos, 22+x_pos,buf) ENDI ENDI IF flag = 2 && ВЫЧИСЛЕНИЙ НЕ ТРЕБУЕТСЯ, ОЧИСТКА СТРОКИ calc_str := SPACE(255) flag := 0 ENDI IF flag = 3 && вывести выражение из памяти на дисплей calc_str := calc_mem flag := 0 ENDIF IF flag = 4 && ЗАПИСЬ ВЫРАЖЕНИЯ В ПАМЯТЬ st := STRTRAN(calc_str,"Н"," ") st := STRTRAN(st,chr(10)," ") st := STRTRAN(st,chr(13)," ") st := STRTRAN(st,"="," ") st:=ALLTRIM( st ) calc_mem := st + SPACE(255 - LEN(st) ) flag := 0 fl_mem := 1 ENDI IF flag = 5 && сложить выражения в памяти st := STRTRAN(calc_str,"Н"," ") st := STRTRAN(st,chr(10)," ") st := STRTRAN(st,chr(13)," ") st := STRTRAN(st,"="," ") st:=ALLTRIM( st ) st1 := STRTRAN(calc_mem,"Н"," ") st1 := STRTRAN(st1,chr(10)," ") st1 := STRTRAN(st1,chr(13)," ") st1 := STRTRAN(st1,"="," ") st1:=ALLTRIM( st1 ) calc_mem := st1 + " + " + st calc_mem := calc_mem + SPACE(255 - LEN(calc_mem) ) flag := 0 fl_mem := 1 ENDI IF flag = 6 && вычесть выражения в памяти st := STRTRAN(calc_str,"Н"," ") st := STRTRAN(st,chr(10)," ") st := STRTRAN(st,chr(13)," ") st := STRTRAN(st,"="," ") st:=ALLTRIM( st ) st1 := STRTRAN(calc_mem,"Н"," ") st1 := STRTRAN(st1,chr(10)," ") st1 := STRTRAN(st1,chr(13)," ") st1 := STRTRAN(st1,"="," ") st1:=ALLTRIM( st1 ) calc_mem := st1 + " - " + st calc_mem := calc_mem + SPACE(255 - LEN(calc_mem) ) flag := 0 fl_mem := 1 END END **name_hlp = help_old REST SCRE FROM sav_screen SETCOLOR(col_mn) SETCANCEL(.T.) SETCURSOR(cc) CLEA TYPE SETKEY(K_LEFT,l_eft) SETKEY(K_RIGHT,r_ight) SETKEY(K_ALT_F1,{||CALCIT()}) RETURN ********************************************************************** ** ОБРАБОТКА ЦИФРОВЫХ КЛАВИШ ** ********************************************************************** FUNCTION PRESS_D PARAMETERS mode,line,col PRIVATE col1,x1,y1,xx,yy,ch,ss_key x1 := 0 y1 := 0 xx := 0 yy := 0 IF mode = 3 SET COLOR TO +GR/BG SET CURSOR ON RETU 0 ENDI key := LASTKEY() IF key = 5 .or. key = 24 CLEAR TYPEAHEAD KEY := 13 ENDIF IF key = 27 key := 13 ENDIF ******************************************************** ** ПЕРЕМЕЩЕНИЕ КАЛЬКУЛЯТОРА ** ******************************************************** IF key = 408 .or. key = 416 .or. key = 411 .or. key = 413 .or. key = 407 .or. key = 415 .or. key = 409 .or. key = 417 ss11:=SAVESCREEN(y_pos,x_pos,13+y_pos, 41+x_pos) REST SCRE FROM sav_screen DO CASE CASE key = 408 && up IF y_pos - 1 >= 0 y_pos := y_pos - 1 ENDIF CASE key = 416 && doun IF y_pos + 2 + 13 <= 24 y_pos := y_pos + 1 ENDIF CASE key = 411 && left IF x_pos - 1 >= 0 x_pos := x_pos - 1 ENDIF CASE key = 413 && right IF x_pos + 2 + 41 <= 79 x_pos := x_pos + 1 ENDIF CASE key = 407 && HOME x_pos := 0 y_pos := 0 CASE key = 415 && END x_pos := 79 - 41-1 y_pos := 24 - 13-1 CASE key = 409 && pgup y_pos := 0 CASE key = 417 && pgdn y_pos := 24 - 13 -1 ENDCASE KEYBOARD CHR(23) RESTSCREEN(y_pos,x_pos,13+y_pos, 41+x_pos,ss11) COLORWIN(14+y_pos,1+x_pos,14+y_pos, 42+x_pos,"N+/N") COLORWIN(1+y_pos,42+x_pos,14+y_pos, 42+x_pos,"N+/N") ENDI col1 := SETCOLOR() SET COLOR TO +BG/BG @ 1+y_pos, 19+x_pos SAY col PICTURE "999" IF fl_mem = 1 @ 1+y_pos, 3+x_pos SAY "M" ENDI DO CASE ****************************************** ** цифровая клавиатура ** ****************************************** CASE key = 48 y1 := 9+y_pos x1 := 1+x_pos ch := '0' CASE key = 49 y1 := 9+y_pos x1 := 5+x_pos ch := '1' CASE key = 50 y1 := 9+y_pos x1 := 9+x_pos ch := '2' CASE key = 51 y1 := 9+y_pos x1 := 13+x_pos ch := '3' CASE key = 52 y1 := 9+y_pos x1 := 17+x_pos ch := '4' CASE key = 53 y1 := 9+y_pos x1 := 21+x_pos ch := '5' CASE key = 54 y1 := 9+y_pos x1 := 25+x_pos ch := '6' CASE key = 55 y1 := 9+y_pos x1 := 29+x_pos ch := '7' CASE key = 56 y1 := 9+y_pos x1 := 33+x_pos ch := '8' CASE key = 57 y1 := 9+y_pos x1 := 37+x_pos ch := '9' **************************************** ** арифметические действия ** **************************************** 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 := '.' CASE key = 40 y1 := 5+y_pos x1 := 21+x_pos ch := '(' CASE key = 41 y1 := 5+y_pos x1 := 25+x_pos ch := ')' CASE key = 37 y1 := 5+y_pos x1 := 29+x_pos ch := '%' CASE key = 61 y1 := 5+y_pos x1 := 33+x_pos ch := '=' *************************************** ** сброс ** *************************************** CASE key = 302 y1 := 5+y_pos x1 := 37+x_pos ch := 'C' *************************************** ** работа с памятью ** *************************************** && ЗАПИСЬ В ПАМЯТЬ CASE key = 273 y1 := 1+y_pos x1 := 25+x_pos ch := 'W' && ЧТЕНИЕ ИЗ ПАМЯТИ CASE key = 275 y1 := 1+y_pos x1 := 29+x_pos ch := 'R' && сложить в ПАМЯТИ CASE key = 387 .or. key = 334 y1 := 1+y_pos x1 := 33+x_pos ch := '+' && вычесть в ПАМЯТИ CASE key = 386 .or. key = 330 y1 := 1+y_pos x1 := 37+x_pos ch := '-' ENDCASE IF (key >= 48 .and. key <= 57) .or. (key >= 40 .and. key <= 43) .or. ; (key >= 45 .and. key <= 47) .or. key = 37 .or. key = 61 .or. key = 302 ; .OR. key = 273 ; .OR. key = 275 ; .or. key = 387 .or. key = 334 .or. key = 386 .or. key = 330 yy := y1+3 xx := x1+4 ss_key := SAVESCREEN(Y1,X1,YY,XX) SET COLOR TO W/W @ Y1,X1,Y1+3,X1+3 BOX " " SET COLOR TO +BG/W IF (key >= 48 .and. key <= 57) @ y1, x1, y1+2, x1+2 BOX "--¬¦--L¦ " @ y1+1,x1+1 SAY ch PICTURE "X" TONE(150,1) ENDI IF (key >= 40 .and. key <= 43) .or. (key >= 45 .and. key <= 47) .or. key = 302 .or. key = 37 .or. key = 61 @ y1, x1, y1+2, x1+2 BOX "-=¬¦-=L¦" @ y1+1,x1+1 SAY ch PICTURE "X" TONE(250,1) ENDI IF key = 273 ; .OR. key = 275 ; .or. key = 387 .or. key = 334 .or. key = 386 .or. key = 330 @ y1, x1, y1+2, x1+2 BOX "-=¬¦-=L¦" @ y1, x1+1 SAY "m" @ y1+1,x1+1 SAY ch PICTURE "X" TONE(450,1) ENDI RESTSCREEN(y1,x1,yy,xx,ss_key) SETCOLOR(col1) ENDI ******************************************* ** обработка знака = , enter ** ******************************************* IF key = 61 .or. key = 13 KEYBOARD CHR(23) flag := 1 ENDI ******************************************* ** очистка строки ** ******************************************* IF key = 302 KEYBOARD CHR(23) flag := 2 ENDI *************************************** ** записать в память ** *************************************** IF key = 273 KEYBOARD CHR(23) flag := 4 ENDI *************************************** ** ЧИТАТЬ ИЗ ПАМЯТИ ** *************************************** IF key = 275 KEYBOARD CHR(23) flag := 3 ENDI *************************************** ** сложить в ПАМЯТИ ** *************************************** IF key = 387 .or. key = 334 KEYBOARD CHR(23) flag := 5 ENDI *************************************** ** вычесть в ПАМЯТИ ** *************************************** IF key = 386 .or. key = 330 KEYBOARD CHR(23) flag := 6 ENDI SET COLOR TO +GR/BG SET CURSOR ON RETURN 0 ******************************************************** ** ПРОРИСОВКА КАЛЬКУЛЯТОРА ** ******************************************************** PROC INI_CALC(is_load_font) is_load_font:=IF(is_load_font=NIL,.F.,is_load_font) OP_WIN("+BG/W","+bG/W","+BG/W",0+y_pos, 0+x_pos, 13+y_pos, 41+x_pos, IF(!is_load_font,"-=¬¦-=L¦","гT¬¦-¦L¦"),'-'," ") SET COLOR TO +N/W @ 1+y_pos,1+x_pos,12+y_pos,40+x_pos BOX " " @ 1+y_pos, 28+x_pos SAY "- - - -" @ 2+y_pos, 24+x_pos SAY "- - - - -" @ 3+y_pos, 24+x_pos SAY "- - - - -" @ 4+y_pos, 2+x_pos SAY replicate('-',23)+" "+replicate('-',3)+" "+replicate('-',3)+" "+replicate('-',3)+" "+replicate('-',3) @ 5+y_pos, 4+x_pos SAY "- - - - - - - - - -" @ 6+y_pos, 4+x_pos SAY "- - - - - - - - - -" @ 7+y_pos, 4+x_pos SAY "- - - - - - - - - -" @ 8+y_pos, 2+x_pos SAY replicate('-',3)+" "+replicate('-',3)+" "+replicate('-',3)+" "+replicate('-',3)+" "+replicate('-',3)+" "+replicate('-',3)+" "+replicate('-',3)+" "+replicate('-',3)+" "+replicate('-',3)+" "+replicate('-',3) @ 9+y_pos, 4+x_pos SAY "- - - - - - - - - -" @ 10+y_pos, 4+x_pos SAY "- - - - - - - - - -" @ 11+y_pos, 4+x_pos SAY "- - - - - - - - - -" @ 12+y_pos, 2+x_pos SAY replicate('-',3)+" "+replicate('-',3)+" "+replicate('-',3)+" "+replicate('-',3)+" "+replicate('-',3)+" "+replicate('-',3)+" "+replicate('-',3)+" "+replicate('-',3)+" "+replicate('-',3)+" "+replicate('-',3) SET COLOR TO +BG/BG @ 1+y_pos, 1+x_pos, 3+y_pos, 23+x_pos BOX IF(!is_load_font,"-=¬¦-=L¦","гT¬¦-¦L¦") @ 5+y_pos, 1+x_pos, 7+y_pos, 3+x_pos BOX IF(!is_load_font,"-=¬¦-=L¦","гT¬¦-¦L¦") @ 5+y_pos, 13+x_pos, 7+y_pos, 15+x_pos BOX IF(!is_load_font,"-=¬¦-=L¦","гT¬¦-¦L¦") @ 5+y_pos, 5+x_pos, 7+y_pos, 7+x_pos BOX IF(!is_load_font,"-=¬¦-=L¦","гT¬¦-¦L¦") @ 5+y_pos, 9+x_pos, 7+y_pos, 11+x_pos BOX IF(!is_load_font,"-=¬¦-=L¦","гT¬¦-¦L¦") @ 5+y_pos, 29+x_pos, 7+y_pos, 31+x_pos BOX IF(!is_load_font,"-=¬¦-=L¦","гT¬¦-¦L¦") @ 5+y_pos, 21+x_pos, 7+y_pos, 23+x_pos BOX IF(!is_load_font,"-=¬¦-=L¦","гT¬¦-¦L¦") @ 5+y_pos, 25+x_pos, 7+y_pos, 27+x_pos BOX IF(!is_load_font,"-=¬¦-=L¦","гT¬¦-¦L¦") @ 5+y_pos, 17+x_pos, 7+y_pos, 19+x_pos BOX IF(!is_load_font,"-=¬¦-=L¦","гT¬¦-¦L¦") @ 5+y_pos, 33+x_pos, 7+y_pos, 35+x_pos BOX IF(!is_load_font,"-=¬¦-=L¦","гT¬¦-¦L¦") SET COLOR TO +GR/BG @ 2+y_pos,2+x_pos,2+y_pos,22+x_pos BOX " " @ 2+y_pos, 2+x_pos SAY CALC_STR PICTURE "XXXXXXXXXXXXXXXXXXXXX" @ 6+y_pos, 2+x_pos SAY "*" @ 6+y_pos, 14+x_pos SAY "-" @ 6+y_pos, 6+x_pos SAY "/" @ 6+y_pos, 10+x_pos SAY "+" @ 6+y_pos, 22+x_pos SAY "(" @ 6+y_pos, 26+x_pos SAY ")" @ 6+y_pos, 30+x_pos SAY "%" @ 6+y_pos, 34+x_pos SAY "=" @ 6+y_pos, 18+x_pos SAY "." SET COLOR TO +BG/B @ 9+y_pos, 1+x_pos, 11+y_pos, 3+x_pos BOX IF(!is_load_font,"--¬¦--L¦ ","гT¬¦-¦L¦ ") @ 10+y_pos, 2+x_pos SAY "0" @ 9+y_pos, 5+x_pos, 11+y_pos, 7+x_pos BOX IF(!is_load_font,"--¬¦--L¦ ","гT¬¦-¦L¦ ") @ 10+y_pos, 6+x_pos SAY "1" @ 9+y_pos, 9+x_pos, 11+y_pos, 11+x_pos BOX IF(!is_load_font,"--¬¦--L¦ ","гT¬¦-¦L¦ ") @ 10+y_pos, 10+x_pos SAY "2" @ 9+y_pos, 13+x_pos, 11+y_pos, 15+x_pos BOX IF(!is_load_font,"--¬¦--L¦ ","гT¬¦-¦L¦ ") @ 10+y_pos, 14+x_pos SAY "3" @ 9+y_pos, 17+x_pos, 11+y_pos, 19+x_pos BOX IF(!is_load_font,"--¬¦--L¦ ","гT¬¦-¦L¦ ") @ 10+y_pos, 18+x_pos SAY "4" @ 9+y_pos, 21+x_pos, 11+y_pos, 23+x_pos BOX IF(!is_load_font,"--¬¦--L¦ ","гT¬¦-¦L¦ ") @ 10+y_pos, 22+x_pos SAY "5" @ 9+y_pos, 25+x_pos, 11+y_pos, 27+x_pos BOX IF(!is_load_font,"--¬¦--L¦ ","гT¬¦-¦L¦ ") @ 10+y_pos, 26+x_pos SAY "6" @ 9+y_pos, 29+x_pos, 11+y_pos, 31+x_pos BOX IF(!is_load_font,"--¬¦--L¦ ","гT¬¦-¦L¦ ") @ 10+y_pos, 30+x_pos SAY "7" @ 9+y_pos, 33+x_pos, 11+y_pos, 35+x_pos BOX IF(!is_load_font,"--¬¦--L¦ ","гT¬¦-¦L¦ ") @ 10+y_pos, 34+x_pos SAY "8" @ 9+y_pos, 37+x_pos, 11+y_pos, 39+x_pos BOX IF(!is_load_font,"--¬¦--L¦ ","гT¬¦-¦L¦ ") @ 10+y_pos, 38+x_pos SAY "9" SET COLOR TO +BG/R @ 5+y_pos, 37+x_pos, 7+y_pos, 39+x_pos BOX IF(!is_load_font,"-=¬¦-=L¦","гT¬¦-¦L¦ ") @ 1+y_pos, 33+x_pos, 3+y_pos, 35+x_pos BOX IF(!is_load_font,"-=¬¦-=L¦","гT¬¦-¦L¦ ") IF !is_load_font @ 1+y_pos, 34+x_pos SAY "m" END @ 1+y_pos, 37+x_pos, 3+y_pos, 39+x_pos BOX IF(!is_load_font,"-=¬¦-=L¦","гT¬¦-¦L¦ ") IF !is_load_font @ 1+y_pos, 38+x_pos SAY "m" END @ 1+y_pos, 29+x_pos, 3+y_pos, 31+x_pos BOX IF(!is_load_font,"-=¬¦-=L¦","гT¬¦-¦L¦ ") IF !is_load_font @ 1+y_pos, 30+x_pos SAY "m" END @ 1+y_pos, 25+x_pos, 3+y_pos, 27+x_pos BOX IF(!is_load_font,"-=¬¦-=L¦","гT¬¦-¦L¦ ") IF !is_load_font @ 1+y_pos, 26+x_pos SAY "m" END SET COLOR TO +GR/R @ 2+y_pos, 30+x_pos SAY "R" @ 2+y_pos, 26+x_pos SAY "W" @ 2+y_pos, 38+x_pos SAY "-" @ 2+y_pos, 34+x_pos SAY "+" @ 6+y_pos, 38+x_pos SAY "C" RETURN FUNCTION LEN_TRIM PARAMETERS str RETU LEN(ALLTRIM(str)) ****************************************************************************** ** распахивающееся окно с тенью ** ****************************************************************************** PROC OP_WIN PARAMETERS mcol_brd,mmcol_txt,mcol_shd,y111,x111,y222,x222,bord,shad,txt PRIVATE col,x_cen,y_cen,s_x,s_y,d_x,d_y,xx111,xx222,yy111,yy222,i col:=SETCOLOR() SET CURSOR OFF x_cen:=(x222-x111)/2+x111 y_cen:=(y222-y111)/2+y111 s_x:=x222-x111 s_y:=y222-y111 IF s_x > s_y d_y:=s_y/s_x d_x:=1 ELSE d_x:=s_x/s_y d_y:=1 ENDI xx111:=x_cen-d_x xx222:=x_cen+d_x yy111:=y_cen-d_y yy222:=y_cen+d_y DO WHILE xx111>=x111 .and. xx222<=x222 .and. yy111>=y111 .and. yy222<=y222 IF xx111<80.AND.yy111<25.AND.xx222<80.AND.yy222<25 SET COLOR TO &mcol_brd @ yy111, xx111, yy222, xx222 BOX bord ENDIF IF xx111+1<80.AND.yy111+1<25.AND.xx222-1<80.AND.yy222-1<25 SET COLOR TO &mmcol_txt @ yy111+1, xx111+1, yy222-1, xx222-1 BOX txt ENDIF xx111:=xx111-d_x xx222:=xx222+d_x yy111:=yy111-d_y yy222:=yy222+d_y ENDDO SETCOLOR(cBack_shad) IF y222 +1 <25 .AND. x222+1 < 80 .AND. shad <>'-' COLORWIN(y222+1,x111+1,y222+1,x222+1,cBack_shad) COLORWIN(y111+1,x222+1,y222+1,x222+1,cBack_shad) ENDIF SET COLOR TO &mcol_brd @ y111, x111, y222, x222 BOX bord SET COLOR TO &mmcol_txt @ y111+1, x111+1, y222-1, x222-1 BOX txt setcolor(COL) SET CURSOR OFF *SETCURSOR(-1) RETU ****************************************************************************** ** СТАНДАРТНЫЙ ФОН В РАСПАХИВАЮЩЕМСЯ ОКНЕ ** ****************************************************************************** PROC STD_FON OP_WIN(back_c_brd,back_c_t, "n/bg", 0, 0, 24,79,back_typ_brd,'-',IIF(LEN(back_fill)<=1,REPLICATE(back_fill,9),back_fill)) SET COLOR TO &back_c_brd @ 0,2 SAY DATE() RETURN

Так выглядит окно калькулятора:

 Отправлено: 19.03.10 14:51. Заголовок: Ужас! Этим кодом над..

Ужас! Этим кодом надо пугать начинающих программистов, что если они так будут писать, то за ними придут из милиции!:)

 Отправлено: 19.03.10 14:54. Заголовок: Спасибо вам gfilatov..

Спасибо вам gfilatov2002 огромное, очень мне помогли!!!

 Отправлено: 19.03.10 17:05. Заголовок: Григорьев Владимир п..

Григорьев Владимир пишет:

цитата:

Ужас! Этим кодом надо пугать начинающих программистов,

Ну так научил бы человека как правильно код писать , возможно кому то еще бы пригодилось

 Отправлено: 20.03.10 08:15. Заголовок: Dima пишет: Ну так ..

Dima пишет:

цитата:

Ну так научил бы человека как правильно код писать , возможно кому то еще бы пригодилось

Вот именно ))

 Отправлено: 20.03.10 11:06. Заголовок: Блин все не могу раз..

Блин все не могу разобраться с запуском, помогоите люди. Напишите пожалуйста подробней о запуске, если не сложно. Заранее спасибо.
Вот что у меня выдает при запуске: http://radikal.ru/F/s43.radikal.ru/i099/1003/d3/aa0ad7487afd.jpg.html

 Отправлено: 20.03.10 11:37. Заголовок: Покажите, плиз, соде..

Покажите, плиз, содержимое вашей папки C:\Lib, а также переменных окружения PATH, INCLUDE, LIB.

 Отправлено: 20.03.10 13:02. Заголовок: А что значит перемен..

А что значит переменных окружения PATH, INCLUDE, LIB?

 Отправлено: 20.03.10 13:05. Заголовок: Вот C:\Clipper&#..

Вот C:\Clipper\Lib
http://radikal.ru/F/s48.radikal.ru/i122/1003/e7/7eb328cefdfe.jpg.html

 Отправлено: 20.03.10 13:09. Заголовок: Запускаю я его на ви..

Запускаю я его на виртуальной машине, Windows95

 Отправлено: 20.03.10 13:12. Заголовок: Вот INCLUDE http://r..

Вот INCLUDE
http://radikal.ru/F/i058.radikal.ru/1003/1f/fe91dfd549ae.jpg.html

 Отправлено: 20.03.10 13:25. Заголовок: Сделайте батник: pa..

Сделайте батник:

path %path%;c:\clipper5
set INCLUDE=c:\clipper5\include
set LIB=c:\clipper5\lib

и перед сборкой программы вызовите его.

 Отправлено: 22.03.10 10:10. Заголовок: Вот так я запускаю: ..

Вот так я запускаю: http://jpe.ru/1/max/220310/0yx0rx5dv1.jpg
в файле kal.prg находится код программы "Калькулятор"
Вот что выдает после запуска: http://jpe.ru/1/max/220310/0tt3sxmnmw.jpg
Может я неправильно запуска?
А вот что выдает после запуска батника:
path %path%;c:\clipper5
set INCLUDE=c:\clipper5\include
set LIB=c:\clipper5\lib
http://jpe.ru/1/max/220310/0ri3e8pbyv.jpg
Или я даю команды не верные, подскажите пожалуйста?

 Отправлено: 22.03.10 12:48. Заголовок: Все нужно делать в о..

Все нужно делать в одном сеансе CMD.
По порядку:
1. Пуск -> Выполнить -> Cmd. Открылось окно.
2. CD <имя папки с программой> (в эту же папку положите вышеуказанный батник).
3. Запускаете батник (он устанавливает значения переменных окружения)
4. Потом делаете то, что делали раньше. (RTlink, по-моему, надо запускать так: RTLINK fi kal)

 Отправлено: 22.03.10 13:34. Заголовок: а на какой винде дел..

а на какой винде делать, это не имеет значени? Или только на 95-ой?

 Отправлено: 22.03.10 14:00. Заголовок: Снова ничего не полу..

Снова ничего не получилось, делал все по инструкции как вы написали PSP, сейчас выложу результат полученного.
http://jpe.ru/1/max/220310/0fbpihu385.jpg
Судя по результату он не может создать файл kal.obj?

 Отправлено: 22.03.10 15:12. Заголовок: apposs inkey.ch есл..

apposs
inkey.ch если в папке include ?

 Отправлено: 22.03.10 21:13. Заголовок: apposs пишет: Судя ..

apposs пишет:

цитата:

Судя по результату он не может создать файл kal.obj?

RTLINK не может найти этот файл, ибо Clipper не смог его создать по причине отсутствия файла inkey.ch
Судя по Вашим скриншотам файл inkey.ch находится в папке c:\clipper5\include
Чтобы компилятор мог найти его (и любой другой файл .ch), существует переменная окружения INCLUDE.
Перед компиляцией нужно указать set INCLUDE=<папка с файлами .ch> или скопировать нужные файлы (в данном случае inkey.ch) в текущую папку. Я не могу понять, где и какие файлы у Вас находятся.
PSP пишет:

цитата:

Все нужно делать в одном сеансе CMD.

Вот это тоже важно.

 Отправлено: 22.03.10 21:29. Заголовок: apposs пишет: а на ..

apposs пишет:

цитата:

а на какой винде делать, это не имеет значени? Или только на 95-ой?

да по барабану ;) хоть на windows 7.

 Отправлено: 22.03.10 21:29. Заголовок: PSP Может собрать е..

PSP
Может собрать ему прогу и выложить готовый вариант ? ;)))

 Отправлено: 22.03.10 22:17. Заголовок: Dima пишет: Может с..

Dima пишет:

цитата:

Может собрать ему прогу и выложить готовый вариант ? ;)))

Пусть учится... :)

 Отправлено: 23.03.10 02:15. Заголовок: Все с запуском разоб..

Все с запуском разобрался, тепепрь при запуске создаются файлы: .obj и .exe,но появилась новая проблемка, ошибка в коде вроде.
http://jpe.ru/1/max/220310/0ioq3mpskx.jpg

 Отправлено: 23.03.10 08:05. Заголовок: apposs Тут есть 3 в..

apposs
Тут есть 3 варианта

1. Прилинковать библиотеку Clipper Tool
2. Закоментировать в иcходном тексте вызов функции Colorwin
3. Написать свою функцию Colorwin

 Отправлено: 23.03.10 11:49. Заголовок: PSP расскажите попод..

Dima и PSP расскажите поподробней как это все осуществить? Если можно на примере покажите?

 Отправлено: 23.03.10 11:55. Заголовок: Найдите в исходном т..

Найдите в исходном тексте все вызовы ColorWin и поставьте в начале этих строк // (два слэша). Получится комментарий.
Потом пересоберите программу.

 Отправлено: 23.03.10 12:07. Заголовок: Сделал как вы сказал..

Сделал как вы сказали PSP, сейчас результат выложу.

 Отправлено: 23.03.10 12:09. Заголовок: Вот что получилось: ..

Вот что получилось: http://jpe.ru/1/max/230310/03rmqwlys9.jpg

 Отправлено: 23.03.10 12:13. Заголовок: apposs С какими клю..

apposs
С какими ключами компилировал ?

 Отправлено: 23.03.10 12:16. Заголовок: http://jpe.ru/1/max/..

 Отправлено: 23.03.10 12:16. Заголовок: inkey.ch ..

inkey.ch

 Отправлено: 23.03.10 12:23. Заголовок: Я только что собрал ..

Я только что собрал эту прогу. Все работает.
У Вас что на экране после запуска Kal.exe?

 Отправлено: 23.03.10 12:26. Заголовок: После запуска открыв..

После запуска открывается окно с курсором и сразу закрываетс, выложите свой .exe я попробую запустить у себя.

 Отправлено: 23.03.10 12:28. Заголовок: http://files.mail.ru..

http://files.mail.ru/MXZYJ6
Единственное, кодировка после копипаста нарушилась.

 Отправлено: 23.03.10 12:28. Заголовок: Пробовал на windows9..

Пробовал на windows95 и XP запускать

 Отправлено: 23.03.10 12:29. Заголовок: Вот ваш запустился, ..

Вот ваш запустился, значит что то я сделал неправильно.

 Отправлено: 23.03.10 12:34. Заголовок: PSP выложите пожалуй..

PSP выложите пожалуйста .obj и .prg

 Отправлено: 23.03.10 12:44. Заголовок: apposs пишет: PSP в..

apposs пишет:

цитата:

PSP выложите пожалуйста .obj и .prg

Не знаю, что это даст... http://files.mail.ru/8Q9BGO

 Отправлено: 23.03.10 12:48. Заголовок: Точно, это ни чего н..

Точно, это ни чего не даст, нужно полную сборку.

 Отправлено: 23.03.10 12:52. Заголовок: PSP у вас есть возмо..

PSP у вас есть возможность полную сборку выложить?

 Отправлено: 23.03.10 12:54. Заголовок: apposs пишет: PSP у..

apposs пишет:

цитата:

PSP у вас есть возможность полную сборку выложить?

Сборку чего?

 Отправлено: 23.03.10 12:55. Заголовок: т.е. каталог где нах..

т.е. каталог где находится программа

 Отправлено: 23.03.10 13:20. Заголовок: Тут что то точно я н..

Тут что то точно я не учел, размер вашего .exe файла состовляет: 243кб, а размаер моего 201кб.

 Отправлено: 23.03.10 13:21. Заголовок: Извините за оффтоп P..

Извините за оффтоп
PSP пишет:

цитата:

У Вас что на экране после запуска Kal.exe?

Вспоминаю себя начинающего. На экране чаще всего вот это самое

 Отправлено: 23.03.10 13:24. Заголовок: После запуска открыв..

После запуска открывается окно с курсором и сразу закрывается.

 Отправлено: 23.03.10 13:42. Заголовок: Вот: http://files.ma..

Вот: http://files.mail.ru/QTLBAC
Это Clipper 5.2е + Blinker 5.1
Переименуйте в *.zip
Распаковать нужно в папку C:\CL52
В папке PRG лежит исходник. Там же есть батник c.bat
Просто запустите этот батник. Все должно собраться.

 Отправлено: 23.03.10 13:42. Заголовок: я уже и все повторил..

я уже и все повторил, результат тоже самый.

 Отправлено: 23.03.10 13:46. Заголовок: apposs пишет: я уже..

apposs пишет:

цитата:

я уже и все повторил, результат тоже самый.

См.выше. И еще совет: пользуйтесь каким-нибудь файл-менеджером. К примеру, Far-ом. Вам проще будет (и нам тоже ).

 Отправлено: 23.03.10 13:55. Заголовок: Все сработало, спаси..

Все сработало, спасибо огромное PSP. Теперь буду укорачивать код и разберусь в причина, почему у меня не запускалась прграммка.

 Отправлено: 23.03.10 13:55. Заголовок: apposs Компилируй c..

apposs
Компилируй c ключом -n

 Отправлено: 23.03.10 13:57. Заголовок: PSP пишет: См.выше...

PSP пишет:

цитата:

См.выше. И еще совет: пользуйтесь каким-нибудь файл-менеджером. К примеру, Far-ом. Вам проще будет (и нам тоже ).

Хорошо спасибо

 Отправлено: 29.03.10 06:46. Заголовок: И так, укоротил я ко..

И так, укоротил я код калькуратора, как мне нужно было. Подскажите пожалуйста как сделать, чтобы калькулятор вызывался клавишей <F3>. И еще у меня такая проблемка: после выполнения какого либо арифмитического действия, калькулятор выдает ошибку. Т.е если я пишу 2+2, по нажатию Enter он выдает правильный результат "=4", после я жму Enter, выдает ошибку. Приходиться заного запускать программку "Калькулятор" для последующего арифмитического действия.

Код:
#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 = "("
ss := &st && ВЫЧИСЛЕНИЕ
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 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

 Отправлено: 29.03.10 12:03. Заголовок: Могу скинуть докумен..

Могу скинуть документацию в формате NortonGuide по Clipper 5.2
Надо?

 Отправлено: 29.03.10 12:19. Заголовок: Да надо PSP, скинь п..

Да надо PSP, скиньте пожалуйста.

 Отправлено: 29.03.10 12:30. Заголовок: http://webfile.ru/43..

http://webfile.ru/4391532
Полное описание комманд, функций, операторов. Описание ошибок.
Есть справка по ClipperTools3.
Вьювер для просмотра этого формата: http://www.davep.org/norton-guides/WEGSetup.exe

 Отправлено: 29.03.10 12:32. Заголовок: Спасибо вам большое ..

Спасибо вам большое PSP.

 Отправлено: 29.03.10 12:45. Заголовок: Файлобменник перегру..

http://webfile.ru/4391532 Файлобменник перегружен . Незнаете как долго будет перегружен?

 Отправлено: 29.03.10 12:47. Заголовок: Все скачал! :sm36: ..

Все скачал!

 Отправлено: 01.04.10 02:48. Заголовок: Блин ни чего не полу..

Блин ни чего не получается, что же это такое. Как сделать что бы при делении на "0", программа выдовала ошибку. Не могу использовать правильно IF .. ELSE .. .
Вот отрывок из кода

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 = "("
ss := &st && ВЫЧИСЛЕНИЕ
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!"
INKEY(0)
flag_err := 0
ENDI
ENDI


Ппомогите!

 Отправлено: 01.04.10 09:33. Заголовок: Переменная flag_err ..

Переменная flag_err будет равна 1, если не выполнится условие (st_1 >= "0" .and. st_1 <= "9") .or. st_1 = "+" .or. st_1 = "-" .or. st_1 = "(".
Переменная st_1 равна первому символe строки st. Если st - это выражение, которое должен вычислить калькулятор, то первый символ ничего не даст при определении деления на 0.

 Отправлено: 02.04.10 11:11. Заголовок: PSP покажите пожалуй..

PSP покажите пожалуйста на примере, как осуществить "деление на ноль запрещено"

 Отправлено: 02.04.10 11:40. Заголовок: #include "inkey...

#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

 Отправлено: 03.04.10 07:57. Заголовок: Спасибо PSP, все раб..

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

 Отправлено: 03.04.10 14:17. Заголовок: apposs пишет: Спаси..

apposs пишет:

цитата:

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

Не за что. :)

 Отправлено: 18.08.10 12:33. Заголовок: Калькулятор

Ну вот, если "это, откомпелировать - будет работать, делал кода-то в незапамятные времена, на "скорую руку"

*****
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
*****