Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Скриптовые языки программирования > Python
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 27.02.2017, 02:25   #1
leprekod
Пользователь
 
Регистрация: 18.12.2016
Сообщений: 37
По умолчанию Tcl/Tk - перевод из римской системы счисления в арабскую и обратно.

Код:
# filebox.tcl --
source [file join [file dirname [info script]] rim_arab_1.tcl]
source [file join [file dirname [info script]] arab_rim_1.tcl]
package require Tk
set w .filebox
catch {destroy $w}
toplevel $w
wm title $w "Из римских в арабские!"
wm iconname $w "filebox"
ttk::frame $w._bg
place $w._bg -x 0 -y 0 -relwidth 1 -relheight 1
set font #4ddd84
ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Это приложение переводит числа из римской  системы    счисления,  в  арабскую и обратно!"
pack $w.msg -side top

    set i "Ввести число"
    set g [ttk::frame $w.$i]
    ttk::label  $g.lab    -text "Римское__число: $i: " -anchor e
	ttk::entry  $g.ent    -textvar Rim 
   	ttk::button $g.but    -text "Вычислить!!!" -command {tk_messageBox  -title "Арабское число"  -message [eval {Run $Rim}]}
    ttk::button $g.but1   -text "Очистить!"    -command {$g.ent delete 0 [string length $Rim]} 	
	pack $g.lab  -side left
    pack $g.ent  -side left   -expand yes -fill x
    pack $g.but  -side left
	pack $g.but1 -side left
    pack $g -fill x -padx 1c -pady 3
	
	set j "Ввести_число"
    set f [ttk::frame $w.$j]
    ttk::label  $f.lab1   -text "Арабское_число: $j: " -anchor e
	ttk::entry  $f.ent1   -textvar Arab  
    ttk::button $f.but2   -text "Вычислить!!!" -command {tk_messageBox  -title "Римское число"  -message [eval {Runo $Arab}]}
	ttk::button $f.but3   -text "Очистить!"    -command {$f.ent1 delete 0 [string length $Arab]} 
    pack $f.lab1  -side left
    pack $f.ent1  -side left   -expand yes   -fill x
    pack $f.but2  -side left
	pack $f.but3  -side left
    pack $f -fill x -padx 1c -pady 3
rim_arab_1.tcl
Код:
proc Run {Rim} {
set r_a(I) 1; set r_a(V) 5; set r_a(X) 10; set r_a(L) 50;
set r_a(C) 100; set r_a(D) 500; set r_a(M) 1000
#set Rim [gets stdin]
set RimCM [string map {IV IIII IX VIIII XL XXXX XC LXXXX CD CCCC CM DCCCC} $Rim]
set RimN [split $RimCM {}]
set Arab 0 
foreach P $RimN {set Arab [expr $Arab + $r_a($P)]}
set T $Arab
}
arab_rim_1.tcl
Код:
#!/usr/local/bin/wish
proc Runo {Arab} {
set a_r {I V X L C D M}
set Arabn [split $Arab {}]
set Zx [string reverse $Arabn]
set I 0; set W ""; set W2 ""                       
foreach V $Zx { set I2 [expr 2*$I]; set I1 [expr 2*$I+1]
                set I3 [expr 2*$I+2]; set V1 [expr $V - 5]
    	       if {$V == 4} {
				    append W [lindex $a_r $I1] [lindex $a_r $I2]
			   } elseif {$V == 9} {
				    append W [lindex $a_r $I3] [lindex $a_r $I2]
			   } elseif {$V1 < 0} {
			      for {set J 0} {$J < $V} {incr J} {
				    append W [lindex $a_r $I2]
			   }} else {
				  for {set J 0} {$J < $V1} {incr J} {
				    append W [lindex $a_r $I2]
				                                    } 
				    append W [lindex $a_r $I1]
			           }
			   incr I
			   }
			    set L [string reverse $W]
}
Остаётся только добавить что функции для перевода из одной системы в другую созданы с нуля, а GUI существенно переделан из приложения filebox.tcl - C:\Tcl\demos\Tk8.6 - ActiveTcl

Последний раз редактировалось leprekod; 27.02.2017 в 02:39.
leprekod вне форума Ответить с цитированием
Старый 27.02.2017, 02:39   #2
leprekod
Пользователь
 
Регистрация: 18.12.2016
Сообщений: 37
По умолчанию

Так как, GUI создавался не с 0, то, я не совсем чётко понимаю как работает эта часть кода ... , но она работает !!!
leprekod вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Перевод системы счисления AlexeyI Общие вопросы C/C++ 8 05.10.2015 11:40
Перевод из римской системы счисления в десятичную и наоборот Александр77777 Помощь студентам 3 19.01.2012 15:42
перевод из 5 в 10 системы счисления и обратно vrtp Общие вопросы C/C++ 7 25.12.2011 23:04
Перевод целого числа из 5 в 8 систему счисления и обратно. Whitt Помощь студентам 7 08.09.2010 07:14