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

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

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

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

gfilatov2002: 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 Так выглядит окно калькулятора:

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

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


Dima: Григорьев Владимир пишет: Ужас! Этим кодом надо пугать начинающих программистов, Ну так научил бы человека как правильно код писать , возможно кому то еще бы пригодилось

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

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

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

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

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

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

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

PSP: Сделайте батник: path %path%;c:\clipper5 set INCLUDE=c:\clipper5\include set LIB=c:\clipper5\lib и перед сборкой программы вызовите его.

apposs: Вот так я запускаю: 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 Или я даю команды не верные, подскажите пожалуйста?

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

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

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

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

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

Dima: apposs пишет: а на какой винде делать, это не имеет значени? Или только на 95-ой? да по барабану ;) хоть на windows 7.

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

PSP: Dima пишет: Может собрать ему прогу и выложить готовый вариант ? ;))) Пусть учится... :)

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

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

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

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

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

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

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

apposs: http://jpe.ru/1/max/230310/01jwbi48w3.jpg

apposs: inkey.ch

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

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

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

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

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

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

PSP: apposs пишет: PSP выложите пожалуйста .obj и .prg Не знаю, что это даст... http://files.mail.ru/8Q9BGO

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

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

PSP: apposs пишет: PSP у вас есть возможность полную сборку выложить? Сборку чего?

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

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

TimTim: Извините за оффтоп PSP пишет: У Вас что на экране после запуска Kal.exe? Вспоминаю себя начинающего. На экране чаще всего вот это самое

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

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

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

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

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

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

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

apposs: И так, укоротил я код калькуратора, как мне нужно было. Подскажите пожалуйста как сделать, чтобы калькулятор вызывался клавишей <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

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

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

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

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

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

apposs: Все скачал!

apposs: Блин ни чего не получается, что же это такое. Как сделать что бы при делении на "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 Ппомогите!

PSP: Переменная 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.

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

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



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