Автор | Сообщение |
|
| |
Пост N: 2
Зарегистрирован: 19.03.10
|
|
Отправлено: 19.03.10 12:09. Заголовок: Помогите пожалуйста!
Здраствуйте! Очень нужна помощь, нужно написать программку Калькулятор на языке программирования Clipper, буду очень благодарен: Написать процедуру "Калькулятор", которая вызывается клавишей <F3>. Калькулятор должен выполнять 4 арифмитических действия. В нем должно быть окошко, куда вводятся числа и где отображается результат вычислений ----------- | 50.10 | -----------
| |
|
Ответов - 64
, стр:
1
2
3
4
All
[только новые]
|
|
|
| moderator
|
Пост N: 21
Зарегистрирован: 11.02.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 |
| Так выглядит окно калькулятора:
| |
|
|
| постоянный участник
|
Пост N: 361
Зарегистрирован: 17.05.05
|
|
Отправлено: 19.03.10 14:51. Заголовок: Ужас! Этим кодом над..
Ужас! Этим кодом надо пугать начинающих программистов, что если они так будут писать, то за ними придут из милиции!:)
| |
|
|
| |
Пост N: 4
Зарегистрирован: 19.03.10
|
|
Отправлено: 19.03.10 14:54. Заголовок: Спасибо вам gfilatov..
Спасибо вам gfilatov2002 огромное, очень мне помогли!!!
| |
|
|
| |
Пост N: 1440
Зарегистрирован: 17.05.05
|
|
Отправлено: 19.03.10 17:05. Заголовок: Григорьев Владимир п..
Григорьев Владимир пишет: цитата: | Ужас! Этим кодом надо пугать начинающих программистов, |
| Ну так научил бы человека как правильно код писать , возможно кому то еще бы пригодилось
| |
|
|
| |
Пост N: 5
Зарегистрирован: 19.03.10
|
|
Отправлено: 20.03.10 08:15. Заголовок: Dima пишет: Ну так ..
Dima пишет: цитата: | Ну так научил бы человека как правильно код писать , возможно кому то еще бы пригодилось |
| Вот именно ))
| |
|
|
| |
Пост N: 6
Зарегистрирован: 19.03.10
|
|
Отправлено: 20.03.10 11:06. Заголовок: Блин все не могу раз..
| |
|
|
| постоянный участник
|
Пост N: 336
Зарегистрирован: 27.01.07
|
|
Отправлено: 20.03.10 11:37. Заголовок: Покажите, плиз, соде..
Покажите, плиз, содержимое вашей папки C:\Lib, а также переменных окружения PATH, INCLUDE, LIB.
| |
|
|
| |
Пост N: 7
Зарегистрирован: 19.03.10
|
|
Отправлено: 20.03.10 13:02. Заголовок: А что значит перемен..
А что значит переменных окружения PATH, INCLUDE, LIB?
| |
|
|
| |
Пост N: 8
Зарегистрирован: 19.03.10
|
|
Отправлено: 20.03.10 13:05. Заголовок: Вот C:\Clipper..
| |
|
|
| |
Пост N: 9
Зарегистрирован: 19.03.10
|
|
Отправлено: 20.03.10 13:09. Заголовок: Запускаю я его на ви..
Запускаю я его на виртуальной машине, Windows95
| |
|
|
| |
Пост N: 10
Зарегистрирован: 19.03.10
|
|
Отправлено: 20.03.10 13:12. Заголовок: Вот INCLUDE http://r..
| |
|
|
|
| постоянный участник
|
Пост N: 337
Зарегистрирован: 27.01.07
|
|
Отправлено: 20.03.10 13:25. Заголовок: Сделайте батник: pa..
Сделайте батник: path %path%;c:\clipper5 set INCLUDE=c:\clipper5\include set LIB=c:\clipper5\lib и перед сборкой программы вызовите его.
| |
|
|
| |
Пост N: 11
Зарегистрирован: 19.03.10
|
|
Отправлено: 22.03.10 10:10. Заголовок: Вот так я запускаю: ..
| |
|
|
| постоянный участник
|
Пост N: 338
Зарегистрирован: 27.01.07
|
|
Отправлено: 22.03.10 12:48. Заголовок: Все нужно делать в о..
Все нужно делать в одном сеансе CMD. По порядку: 1. Пуск -> Выполнить -> Cmd. Открылось окно. 2. CD <имя папки с программой> (в эту же папку положите вышеуказанный батник). 3. Запускаете батник (он устанавливает значения переменных окружения) 4. Потом делаете то, что делали раньше. (RTlink, по-моему, надо запускать так: RTLINK fi kal)
| |
|
|
| |
Пост N: 12
Зарегистрирован: 19.03.10
|
|
Отправлено: 22.03.10 13:34. Заголовок: а на какой винде дел..
а на какой винде делать, это не имеет значени? Или только на 95-ой?
| |
|
|
| |
Пост N: 13
Зарегистрирован: 19.03.10
|
|
Отправлено: 22.03.10 14:00. Заголовок: Снова ничего не полу..
| |
|
|
| |
Пост N: 1447
Зарегистрирован: 17.05.05
|
|
Отправлено: 22.03.10 15:12. Заголовок: apposs inkey.ch есл..
apposs inkey.ch если в папке include ?
| |
|
|
| постоянный участник
|
Пост N: 339
Зарегистрирован: 27.01.07
|
|
Отправлено: 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. |
| Вот это тоже важно.
| |
|
|
| |
Пост N: 1459
Зарегистрирован: 17.05.05
|
|
Отправлено: 22.03.10 21:29. Заголовок: apposs пишет: а на ..
apposs пишет: цитата: | а на какой винде делать, это не имеет значени? Или только на 95-ой? |
| да по барабану ;) хоть на windows 7.
| |
|
|
| |
Пост N: 1460
Зарегистрирован: 17.05.05
|
|
Отправлено: 22.03.10 21:29. Заголовок: PSP Может собрать е..
PSP Может собрать ему прогу и выложить готовый вариант ? ;)))
| |
|
|
| постоянный участник
|
Пост N: 340
Зарегистрирован: 27.01.07
|
|
Отправлено: 22.03.10 22:17. Заголовок: Dima пишет: Может с..
Dima пишет: цитата: | Может собрать ему прогу и выложить готовый вариант ? ;))) |
| Пусть учится... :)
| |
|
|
|
| |
Пост N: 14
Зарегистрирован: 19.03.10
|
|
Отправлено: 23.03.10 02:15. Заголовок: Все с запуском разоб..
| |
|
|
| |
Пост N: 1461
Зарегистрирован: 17.05.05
|
|
Отправлено: 23.03.10 08:05. Заголовок: apposs Тут есть 3 в..
apposs Тут есть 3 варианта 1. Прилинковать библиотеку Clipper Tool 2. Закоментировать в иcходном тексте вызов функции Colorwin 3. Написать свою функцию Colorwin
| |
|
|
| |
Пост N: 15
Зарегистрирован: 19.03.10
|
|
Отправлено: 23.03.10 11:49. Заголовок: PSP расскажите попод..
Dima и PSP расскажите поподробней как это все осуществить? Если можно на примере покажите?
| |
|
|
| постоянный участник
|
Пост N: 341
Зарегистрирован: 27.01.07
|
|
Отправлено: 23.03.10 11:55. Заголовок: Найдите в исходном т..
Найдите в исходном тексте все вызовы ColorWin и поставьте в начале этих строк // (два слэша). Получится комментарий. Потом пересоберите программу.
| |
|
|
| |
Пост N: 16
Зарегистрирован: 19.03.10
|
|
Отправлено: 23.03.10 12:07. Заголовок: Сделал как вы сказал..
Сделал как вы сказали PSP, сейчас результат выложу.
| |
|
|
| |
Пост N: 17
Зарегистрирован: 19.03.10
|
|
Отправлено: 23.03.10 12:09. Заголовок: Вот что получилось: ..
| |
|
|
| |
Пост N: 1469
Зарегистрирован: 17.05.05
|
|
Отправлено: 23.03.10 12:13. Заголовок: apposs С какими клю..
apposs С какими ключами компилировал ?
| |
|
|
| |
Пост N: 18
Зарегистрирован: 19.03.10
|
|
Отправлено: 23.03.10 12:16. Заголовок: http://jpe.ru/1/max/..
| |
|
|
| |
Пост N: 19
Зарегистрирован: 19.03.10
|
|
Отправлено: 23.03.10 12:16. Заголовок: inkey.ch ..
inkey.ch
| |
|
|
| постоянный участник
|
Пост N: 342
Зарегистрирован: 27.01.07
|
|
Отправлено: 23.03.10 12:23. Заголовок: Я только что собрал ..
Я только что собрал эту прогу. Все работает. У Вас что на экране после запуска Kal.exe?
| |
|
|
|
| |
Пост N: 20
Зарегистрирован: 19.03.10
|
|
Отправлено: 23.03.10 12:26. Заголовок: После запуска открыв..
После запуска открывается окно с курсором и сразу закрываетс, выложите свой .exe я попробую запустить у себя.
| |
|
|
| постоянный участник
|
Пост N: 343
Зарегистрирован: 27.01.07
|
|
Отправлено: 23.03.10 12:28. Заголовок: http://files.mail.ru..
| |
|
|
| |
Пост N: 21
Зарегистрирован: 19.03.10
|
|
Отправлено: 23.03.10 12:28. Заголовок: Пробовал на windows9..
Пробовал на windows95 и XP запускать
| |
|
|
| |
Пост N: 22
Зарегистрирован: 19.03.10
|
|
Отправлено: 23.03.10 12:29. Заголовок: Вот ваш запустился, ..
Вот ваш запустился, значит что то я сделал неправильно.
| |
|
|
| |
Пост N: 23
Зарегистрирован: 19.03.10
|
|
Отправлено: 23.03.10 12:34. Заголовок: PSP выложите пожалуй..
PSP выложите пожалуйста .obj и .prg
| |
|
|
| постоянный участник
|
Пост N: 344
Зарегистрирован: 27.01.07
|
|
Отправлено: 23.03.10 12:44. Заголовок: apposs пишет: PSP в..
| |
|
|
| |
Пост N: 24
Зарегистрирован: 19.03.10
|
|
Отправлено: 23.03.10 12:48. Заголовок: Точно, это ни чего н..
Точно, это ни чего не даст, нужно полную сборку.
| |
|
|
| |
Пост N: 25
Зарегистрирован: 19.03.10
|
|
Отправлено: 23.03.10 12:52. Заголовок: PSP у вас есть возмо..
PSP у вас есть возможность полную сборку выложить?
| |
|
|
| постоянный участник
|
Пост N: 345
Зарегистрирован: 27.01.07
|
|
Отправлено: 23.03.10 12:54. Заголовок: apposs пишет: PSP у..
apposs пишет: цитата: | PSP у вас есть возможность полную сборку выложить? |
| Сборку чего?
| |
|
|
| |
Пост N: 26
Зарегистрирован: 19.03.10
|
|
Отправлено: 23.03.10 12:55. Заголовок: т.е. каталог где нах..
т.е. каталог где находится программа
| |
|
|
|
| |
Пост N: 27
Зарегистрирован: 19.03.10
|
|
Отправлено: 23.03.10 13:20. Заголовок: Тут что то точно я н..
Тут что то точно я не учел, размер вашего .exe файла состовляет: 243кб, а размаер моего 201кб.
| |
|
|
| |
Пост N: 77
Зарегистрирован: 10.07.07
|
|
Отправлено: 23.03.10 13:21. Заголовок: Извините за оффтоп P..
Извините за оффтоп PSP пишет: цитата: | У Вас что на экране после запуска Kal.exe? |
| Вспоминаю себя начинающего. На экране чаще всего вот это самое
| |
|
|
| |
Пост N: 28
Зарегистрирован: 19.03.10
|
|
Отправлено: 23.03.10 13:24. Заголовок: После запуска открыв..
После запуска открывается окно с курсором и сразу закрывается.
| |
|
|
| постоянный участник
|
Пост N: 346
Зарегистрирован: 27.01.07
|
|
Отправлено: 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 Просто запустите этот батник. Все должно собраться.
| |
|
|
| |
Пост N: 29
Зарегистрирован: 19.03.10
|
|
Отправлено: 23.03.10 13:42. Заголовок: я уже и все повторил..
я уже и все повторил, результат тоже самый.
| |
|
|
| постоянный участник
|
Пост N: 347
Зарегистрирован: 27.01.07
|
|
Отправлено: 23.03.10 13:46. Заголовок: apposs пишет: я уже..
apposs пишет: цитата: | я уже и все повторил, результат тоже самый. |
| См.выше. И еще совет: пользуйтесь каким-нибудь файл-менеджером. К примеру, Far-ом. Вам проще будет (и нам тоже ).
| |
|
|
| |
Пост N: 30
Зарегистрирован: 19.03.10
|
|
Отправлено: 23.03.10 13:55. Заголовок: Все сработало, спаси..
Все сработало, спасибо огромное PSP. Теперь буду укорачивать код и разберусь в причина, почему у меня не запускалась прграммка.
| |
|
|
| |
Пост N: 1473
Зарегистрирован: 17.05.05
|
|
Отправлено: 23.03.10 13:55. Заголовок: apposs Компилируй c..
apposs Компилируй c ключом -n
| |
|
|
| |
Пост N: 31
Зарегистрирован: 19.03.10
|
|
Отправлено: 23.03.10 13:57. Заголовок: PSP пишет: См.выше...
PSP пишет: цитата: | См.выше. И еще совет: пользуйтесь каким-нибудь файл-менеджером. К примеру, Far-ом. Вам проще будет (и нам тоже ). |
| Хорошо спасибо
| |
|
|
| |
Пост N: 32
Зарегистрирован: 19.03.10
|
|
Отправлено: 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
| |
|
|
| постоянный участник
|
Пост N: 351
Зарегистрирован: 27.01.07
|
|
Отправлено: 29.03.10 12:03. Заголовок: Могу скинуть докумен..
Могу скинуть документацию в формате NortonGuide по Clipper 5.2 Надо?
| |
|
|
| |
Пост N: 33
Зарегистрирован: 19.03.10
|
|
Отправлено: 29.03.10 12:19. Заголовок: Да надо PSP, скинь п..
Да надо PSP, скиньте пожалуйста.
| |
|
|
| постоянный участник
|
Пост N: 352
Зарегистрирован: 27.01.07
|
|
Отправлено: 29.03.10 12:30. Заголовок: http://webfile.ru/43..
| |
|
|
| |
Пост N: 34
Зарегистрирован: 19.03.10
|
|
Отправлено: 29.03.10 12:32. Заголовок: Спасибо вам большое ..
Спасибо вам большое PSP.
| |
|
|
| |
Пост N: 35
Зарегистрирован: 19.03.10
|
|
Отправлено: 29.03.10 12:45. Заголовок: Файлобменник перегру..
| |
|
|
| |
Пост N: 36
Зарегистрирован: 19.03.10
|
|
Отправлено: 29.03.10 12:47. Заголовок: Все скачал! :sm36: ..
Все скачал!
| |
|
|
| |
Пост N: 37
Зарегистрирован: 19.03.10
|
|
Отправлено: 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 Ппомогите!
| |
|
|
| постоянный участник
|
Пост N: 356
Зарегистрирован: 27.01.07
|
|
Отправлено: 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.
| |
|
|
| |
Пост N: 38
Зарегистрирован: 19.03.10
|
|
Отправлено: 02.04.10 11:11. Заголовок: PSP покажите пожалуй..
PSP покажите пожалуйста на примере, как осуществить "деление на ноль запрещено"
| |
|
|
| постоянный участник
|
Пост N: 362
Зарегистрирован: 27.01.07
|
|
Отправлено: 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
| |
|
|
| |
Пост N: 39
Зарегистрирован: 19.03.10
|
|
Отправлено: 03.04.10 07:57. Заголовок: Спасибо PSP, все раб..
Спасибо PSP, все работает!
| |
|
|
| постоянный участник
|
Пост N: 364
Зарегистрирован: 27.01.07
|
|
Отправлено: 03.04.10 14:17. Заголовок: apposs пишет: Спаси..
apposs пишет: цитата: | Спасибо PSP, все работает! |
| Не за что. :)
| |
|
|
| |
Пост N: 2
Зарегистрирован: 18.08.10
|
|
Отправлено: 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 *****
| |
|
Ответов - 64
, стр:
1
2
3
4
All
[только новые]
|
|
|