Криптографический АРМ на базе стандартов с открытым ключом для платформы Android

package require Tk
package require tkpath 0.3.0

global mydir
set mydir [file dirname [info script]]
#Грузим картинки
#Логотип продукта
image create photo logo_product -file [file join $mydir "imageme" "validcertkey_51x24.png"] 
#Логотип производителя
image create photo logo_orel -file [file join $mydir "imageme" "я_орел_425x200.png"] -format "png -alpha 1.0"
#Андроида с tcl/tk
image create photo logo_and -file [file join $mydir "imageme" "AndTk_inv_147x173.png"] -format "png -alpha 1.0"
#Свиток опечатанный
image create photo svitok -file [file join $mydir "imageme" "blue_svitok.png"] -format "png -alpha 1.0"
#Плитка
image create photo tileand -file [file join $mydir "imageme" "tile_green_and_32x32.png"] -format "png -alpha 1.0"
#Увеличить/уменьшить (отрицательное значение - уменьшение)
proc scaleImage {im xfactor {yfactor 0}} {
   set mode -subsample
   if {$xfactor>=0 && $yfactor>=0} {
       set mode -zoom
   } else {
	set xfactor [expr $xfactor * -1]
   }
   if {$yfactor == 0} {set yfactor $xfactor}
   set t [image create photo]
   $t copy $im
   $im blank
   $im copy $t -shrink $mode $xfactor $yfactor
   image delete $t
}

proc createtile {w  backg} {
    image create photo tiled
    tiled copy $backg -to 0 0 $::scrwidth $::scrheight -shrink
    $backg copy tiled
    image delete tiled
# Мостим холст
    $w create image 0 0  
      -image $backg  
      -anchor nw
}

proc create_rectangle  {canv img x1 y1 x2 y2 color alfa {wbd 0} {colorline black} } {
    image create photo $img -format "default -colorformat  rgb"
    set rgb1 [winfo rgb $canv $color]
    set cr  [lindex $rgb1 0]
    set cg  [lindex $rgb1 1]
    set cb  [lindex $rgb1 2]
    set fill [format "#%04x%04x%04x" $cr $cg $cb ]
#Создаем цветной праямоугольник
    $img put $fill -to 0 0 [expr {$x2 - $x1}] [expr {$y2 -$y1}]
#Сохраняем картинку
    set dimg [$img data -format png]
#Создаем image с учетом alpha канала
    image create photo $img -data $dimg -format "png -alpha $alfa"
#    $img put [list $rgb1] -to 0 0 [expr {$x2 - $x1}] [expr {$y2 -$y1}]
#Отображаем цветной прямоугольник
    set imgr [$canv create image $x1 $y1 -image $img -anchor nw] 
    set cc [subst {butImg $img}]
    $canv bind $imgr <ButtonPress-1> $cc
#Оконтовка вокруг цветного прямоугольника
    if {$wbd > 0 } {
	set item [$canv create rect $x1 $y1 $x2 $y2 -outline $colorline -width $wbd ]
	$canv bind $item <ButtonPress-1> $cc
    }
   return $imgr
}

proc butImg {img} {
    tk_messageBox -title "Кнопка" -icon info -message "Нажали кнопку=$img" -detail "::screenwidth=$::scrwidthn::screenheight=$::scrheight" -parent .
    if {$img == "exit"} {
	set answer [tk_dialog .dialog2 "Конец работы" "Вы действительноnхотите выйти?" question 0 "Да" "Нет" ]
	if {$answer == 0} {
    	    exit
	}	
    }
}

proc page_titul {fr  logo_manufacturer} {
    global mydir
#Создаем холст на весь экран
    tkp::canvas $fr.can -borderwidth 0 -height [winfo screenheight .] -width [winfo screenwidth .] -relief flat
#Мостим холст плиткой 
    createtile "$fr.can"  "tileand"
    pack $fr.can  -anchor center -expand 1 -fill both -side top  -padx 0 -pady 0
#Вычисляем координаты для логотипа производителя
#update чтобы обновилась информация в БД об окнах
    update
#    set aa [winfo height $fr.labtitul]
    set aa $::padly
#Центрируем логотип разработчика
    set ha [image width $logo_manufacturer]
    set xman [expr {($::scrwidth - $ha) / 2 }]
    $fr.can create image $xman $aa -image $logo_manufacturer -anchor nw -tag tag_logo

    set blogo [$fr.can bbox tag_logo]
    set wexit [lindex $blogo 3]
    if {$::typetlf } {
	set dlx [expr {$::padlx / 1}]
	$fr.can create text [expr $dlx + 6] [expr {$wexit + $::padly + 6}] -anchor nw -text "Электронная подпись" -fill black -font {{Roboto Condensed Medium} 15 }
	$fr.can create text $dlx [expr {$wexit + $::padly}] -anchor nw -text "Электронная подпись" -fill white -font {{Roboto Condensed Medium} 15 } -tag id_text0
	update
	set blogo [$fr.can bbox id_text0]
	set wexit [lindex $blogo 3]
	$fr.can create text [expr $dlx + 4] [expr {$wexit + $::padly + 4 - 80}] -anchor nw -text "для платформы Android" -fill black -font {{Roboto Condensed Medium} 13}
	$fr.can create text $dlx [expr {$wexit + $::padly - 80}] -anchor nw -text "для платформы Android" -fill white -font {{Roboto Condensed Medium} 13} -tag id_text1
	set blogo [$fr.can bbox id_text1]
	set wexit [lindex $blogo 3]
	$fr.can create text [expr $dlx + 3] [expr {$wexit + $::padly + 3 - 50}] -anchor nw -text "№ 63 ФЗ "Об электроннойnподписи от 6 апреля 2011 года"" -fill black -font {{Roboto} 10}
	$fr.can create text $dlx [expr {$wexit + $::padly - 50}] -anchor nw -text "№ 63 ФЗ "Об электроннойnподписи от 6 апреля 2011 года"" -fill white -font {{Roboto} 10} -tag id_text2
	set blogo [$fr.can bbox id_text2]
	set wexit [lindex $blogo 3]
	$fr.can create text [expr $dlx + 2] [expr {$wexit + $::padly + 2 - 40}] -text "Авторы: В.Н. Орловnhttp://soft.lissi.ru, http://www.lissi.run+7(495)589-99-53ne-mail: support@lissi.runn" 
	-anchor nw -fill black  -font {{Roboto} 9}
	$fr.can create text $dlx [expr {$wexit + $::padly - 40}] -text "Авторы: В.Н. Орловnhttp://soft.lissi.ru, http://www.lissi.run+7(495)589-99-53ne-mail: support@lissi.runn" 
	-anchor nw -fill white -tag id_text3  -font {{Roboto} 9}
    } else {
	$fr.can create text [expr $::padlx + 2] [expr {$wexit + $::padly + 2}] -anchor nw -text "Электронная подпись" -fill black -font {{Nimbus Sans Narrow} 20}
	$fr.can create text $::padlx [expr {$wexit + $::padly}] -anchor nw -text "Электронная подпись" -fill white -font {{Nimbus Sans Narrow} 20} -tag id_text0
	set blogo [$fr.can bbox id_text0]
	set wexit [lindex $blogo 3]
	$fr.can create text [expr $::padlx + 2] [expr {$wexit + $::padly + 2 - 20}] -anchor nw -text "для платформы Android" -fill black -font {{Nimbus Sans Narrow} 18}
	$fr.can create text $::padlx [expr {$wexit + $::padly - 20}] -anchor nw -text "для платформы Android" -fill white -font {{Nimbus Sans Narrow} 18} -tag id_text1
	set blogo [$fr.can bbox id_text1]
	set wexit [lindex $blogo 3]
	$fr.can create text [expr $::padlx + 2] [expr {$wexit + $::padly + 2}] -anchor nw -text "№ 63 ФЗ "Об электроннойnподписи от 6 апреля 2011 года"" -fill black -font {{Nimbus Sans Narrow} 14}
	$fr.can create text $::padlx [expr {$wexit + $::padly}] -anchor nw -text "№ 63 ФЗ "Об электроннойnподписи от 6 апреля 2011 года"" -fill white -font {{Nimbus Sans Narrow} 14} -tag id_text2
	set blogo [$fr.can bbox id_text2]
	set wexit [lindex $blogo 3]
	$fr.can create text [expr $::padlx + 1] [expr {$wexit + $::padly + 1}] -text "Авторы: В.Н. Орловnhttp://soft.lissi.ru, http://www.lissi.run+7(495)589-99-53ne-mail: support@lissi.runn" 
	-anchor nw -fill black  -font {{Nimbus Sans Narrow} 12}
	$fr.can create text $::padlx [expr {$wexit + $::padly}] -text "Авторы: В.Н. Орловnhttp://soft.lissi.ru, http://www.lissi.run+7(495)589-99-53ne-mail: support@lissi.runn" 
	-anchor nw -fill white -tag id_text3  -font {{Nimbus Sans Narrow} 12} -tag id_text3
	set blogo [$fr.can bbox id_text2]
    }
    set blogo [$fr.can bbox id_text3]
    set wland [lindex $blogo 3]
    $fr.can create image $::padlx $wland -image logo_and -anchor nw -tag tag_land
    set ha [image height logo_and]
    set wa [image width logo_and]
    set ha1 [expr {$ha - ($ha / 2 ) }]
    $fr.can create image [expr {$wa - 80 }] [expr {$wland + $ha1}] -image svitok -anchor nw -tag tag_land
    if {$::typetlf} {
	set x1 [expr {$::padlx / 2}]
	set y1 [expr {$wland + 120}]
	set x2 [expr {$::::scrwidth - $x1}]
	set y2 [expr {$y1 + 120}]
	set wd 8
	set rr 18
    } else {
	set x1 [expr {$::padlx / 2}]
	set y1 [expr {$wland + 40}]
	set x2 [expr {$::::scrwidth - $x1}]
	set y2 [expr {$y1 + 40}]
	set wd 4
	set rr 6
    }

    set g5 [$fr.can gradient create linear -stops {{0 lightgreen} {1 green}}] 
    set S3 [$fr.can style create -stroke "skyblue" -fill  $g5 -strokewidth $wd  -fillopacity 0.6]
    set im1 [$fr.can create prect $x1 $y1 $x2 $y2 -rx $rr -style $S3]
    $fr.can bind $im1 <ButtonPress-1> {butImg "img1"}
#Печатаем техт
    set blogo [$fr.can bbox $im1]
    set by2 [lindex $blogo 3]
    set by1 [lindex $blogo 1]
    set bb [expr {($by2 - $by1) / 2}]
    set bx2 [lindex $blogo 2]
    set bx1 [lindex $blogo 0]
    set bbx [expr {($bx2 - $bx1) / 2}]
    set txt1 [$fr.can create text [expr {$x1 + $::padlx * 2}] [expr {$y1 + 1 }] -anchor nw -text "Сайт разработчика" -fill black -font {{Arial} 10 normal}] 
#Центрируем техт
    set btxt1 [$fr.can bbox $txt1]
#Смещение по оси Y
    set ty2 [lindex $btxt1 3]
    set ty1 [lindex $btxt1 1]
    set tt [expr {$ty2 - $ty1}]
    set tt [expr {$tt / 2}]
    set offsy [expr {($by1 + $bb) - ($ty1 + $tt)}]
#Смещение по оси X
    set tx2 [lindex $btxt1 2]
    set tx1 [lindex $btxt1 0]
    set ttx [expr {$tx2 - $tx1}]
    set ttx [expr {$ttx / 2}]
    set offsx [expr {($bx1 + $bbx) - ($tx1 + $ttx)}]
    $fr.can move $txt1 $offsx $offsy
    $fr.can bind $txt1 <ButtonPress-1> {butImg "img1"}

    if {$::typetlf} {
	set y1 [expr $y2 + 40]
	set x2 [expr {$::::scrwidth - $x1}]
	set y2 [expr {$y1 + 120}]
    } else {
	set y1 [expr {$y1 + 60}]
	set x2 [expr {$::::scrwidth - $x1}]
	set y2 [expr {$y1 + 40}]
    }
    set im1 [create_rectangle $fr.can "but2" $x1 $y1 $x2 $y2 "#2b972d" 0.6 $wd "skyblue"]
#Печатаем техт
    set blogo [$fr.can bbox $im1]
    set by2 [lindex $blogo 3]
    set by1 [lindex $blogo 1]
    set bb [expr {($by2 - $by1) / 2}]
    set bx2 [lindex $blogo 2]
    set bx1 [lindex $blogo 0]
    set bbx [expr {($bx2 - $bx1) / 2}]
    set txt1 [$fr.can create text [expr {$x1 + $::padlx * 2}] [expr {$y1 + 1 }] -anchor nw -text "Переход в основное меню" -fill black -font {{Roboto Condensed Medium} 12}] 
#Центрируем текст
    set btxt1 [$fr.can bbox $txt1]
#Смещение по оси Y
    set ty2 [lindex $btxt1 3]
    set ty1 [lindex $btxt1 1]
    set tt [expr {$ty2 - $ty1}]
    set tt [expr {$tt / 2}]
    set offsy [expr {($by1 + $bb) - ($ty1 + $tt)}]
#Смещение по оси X
    set tx2 [lindex $btxt1 2]
    set tx1 [lindex $btxt1 0]
    set ttx [expr {$tx2 - $tx1}]
    set ttx [expr {$ttx / 2}]
    set offsx [expr {($bx1 + $bbx) - ($tx1 + $ttx)}]
    $fr.can move $txt1 $offsx $offsy
    $fr.can bind $txt1 <ButtonPress-1> {butImg "but2"}
    if {$::typetlf} {
	set x1 [expr {$::padlx / 2}]
	set y1 [expr $y2 + 40]
	set x2 [expr {$::::scrwidth - $x1}]
	set y2 [expr {$y1 + 120}]
    } else {
	set x1 [expr {$::padlx / 2}]
	set y1 [expr {$y1 + 60}]
	set x2 [expr {$::::scrwidth - $x1}]
	set y2 [expr {$y1 + 40}]
    }
    set S3 [$fr.can style create -stroke skyblue -fill  $g5 -strokewidth $wd  -fillopacity 0.6]
    set im1 [$fr.can create prect $x1 $y1 $x2 $y2 -rx $rr -style $S3]
    set blogo [$fr.can bbox $im1]
    $fr.can bind $im1 <ButtonPress-1> {butImg "exit"}
    set by2 [lindex $blogo 3]
    set by1 [lindex $blogo 1]
    set bb [expr {($by2 - $by1) / 2}]
    set bx2 [lindex $blogo 2]
    set bx1 [lindex $blogo 0]
    set bbx [expr {($bx2 - $bx1) / 2}]
    set txt1 [$fr.can create text [expr {$x1 + $::padlx * 2}] [expr {$y1 + 1 }] -anchor nw -text "Конец работы" -fill black  -font {Arial 10 normal}]
    $fr.can bind $txt1 <ButtonPress-1> {butImg "exit"}
    set btxt1 [$fr.can bbox $txt1]
#Смещение по оси Y
    set ty2 [lindex $btxt1 3]
    set ty1 [lindex $btxt1 1]
    set tt [expr {$ty2 - $ty1}]
    set tt [expr {$tt / 2}]
    set offsy [expr {($by1 + $bb) - ($ty1 + $tt)}]
#Смещение по оси X
    set tx2 [lindex $btxt1 2]
    set tx1 [lindex $btxt1 0]
    set ttx [expr {$tx2 - $tx1}]
    set ttx [expr {$ttx / 2}]
    set offsx [expr {($bx1 + $bbx) - ($tx1 + $ttx)}]
    $fr.can move $txt1 $offsx $offsy
}
#Собственно скрипт
#Считываем размеры экрана
set ::scrwidth [winfo screenwidth .]
set ::scrheight [winfo screenheight .]
set ::typetlf 0
#Проверяем, что это телефон
if {$::scrwidth < $::scrheight} {
    set ::typetlf 1
}
set ::padls 20
set ::padlx 15
set ::padly 15
if {$::typetlf} {
	wm attributes . -fullscreen 1
	scaleImage icon_openfile_18x16 3
	scaleImage ::img::view_18x16 3
#Логотип производителя
	scaleImage logo_orel 2
#Логотип продуктв
	scaleImage logo_product 2
#Андроида tcl/tk
	scaleImage logo_and 3
#Свиток опечатанный
	scaleImage svitok 4
	set ::padls 50
	set ::padlx 75
	set ::padly 50
} else {
#Конфигурирование виджета под смартфон
    scaleImage logo_orel -2
    set ::scrwidth 370
    set ::scrheight 700
    wm minsize . $::scrwidth $::scrheight
    set geometr $::scrwidth
    append geometr "x"
    append geometr $::scrheight
    append geometr "+0+0"
    wm geometry . $geometr
}
#Создаем название продукта
set name_product "CryptoArmPKCS-A" 
label .labtitul -image logo_product -compound left -fg snow -text $name_product -font {Arial 10 bold} -anchor w  -width [winfo screenwidth .] -pady $::padls -padx 10 -bg #222222 
pack .labtitul -anchor nw -expand 0 -fill x -side top  -padx 1 -pady 0
#Создаем стартовую страницу
set i 0
ttk::frame .fr$i -pad 0 -padding 0
page_titul ".fr$i"  "logo_orel"
pack .fr$i -side top -anchor center -expand 1 -fill both -side top  -padx 0 -pady 0 
update

package require Tk
package require tkpath 0.3.0
global mydir
set mydir [file dirname [info script]]
#Увеличить/уменьшить (отрицательное значение - уменьшение)
proc scaleImage {im xfactor {yfactor 0}} {
   set mode -subsample
   if {$xfactor>=0 && $yfactor>=0} {
       set mode -zoom
   } else {
	set xfactor [expr $xfactor * -1]
   }

   if {$yfactor == 0} {set yfactor $xfactor}
   set t [image create photo]
   $t copy $im
   $im blank
   $im copy $t -shrink $mode $xfactor $yfactor
   image delete $t
}

proc createtile {w  backg} {
    image create photo tiled
    tiled copy $backg -to 0 0 $::scrwidth $::scrheight -shrink
    $backg copy tiled
    image delete tiled
# Мостим холст
    $w create image 0 0  
      -image $backg  
      -anchor nw
}

proc butCliked {num fr} {
    pack forget  .fr1
    set ::tekFrfunc $fr
    pack $fr -side top -anchor center -expand 1 -fill both -side top  -padx 0 -pady 0 
    tk_dialog .dialog1 "Dear user:" "Button $num was clickednFr=$fr" info 0 OK 
}

proc butImg {img} {
    tk_messageBox -title "Кнопка" -icon info -message "Нажали кнопку=$img" -detail "::screenwidth=$::scrwidthn::screenheight=$::scrheight" -parent .
    if {$img == "exit"} {
	set answer [tk_dialog .dialog2 "Конец работы" "Вы действительноnхотите выйти?" question 0 "Да" "Нет" ]
	if {$answer == 0} {
    	    exit
	}	
    }
}

proc butReturn {} {
    pack forget  $::tekFrfunc
    pack .fr1 -side top -anchor center -expand 1 -fill both -side top  -padx 0 -pady 0 
#    tk_dialog .dialog1 "Dear user:" "Button $num was clickednFr=$fr" info 0 OK 
}

proc page_func {fr tile titul functions} {
#Кнопки  меню
    upvar $functions but
#Создаем шрифт для кнопок
    if {$::typetlf} {
	set feFONT_button "-family {Roboto} -size 9 -weight bold -slant roman"
	set widl 10
    } else {
	set feFONT_button "-family {Arial} -size 12 -weight bold -slant roman"
	set widl 5
    }
    catch {font delete fontTEMP_drawer}
    eval font create fontTEMP_drawer  $feFONT_button
#Вычисляем максимальныю длину текста
    set drawerCNT 0
    set strMaxWidthPx 15
    set Ndrawers [expr {[array size but] - 1}]
    while { $drawerCNT <= $Ndrawers } {
	set strWidthPx [font measure fontTEMP_drawer "$but($drawerCNT)"]
	if { $strWidthPx > $strMaxWidthPx } {
    	    set strMaxWidthPx $strWidthPx
	}
	incr drawerCNT
    }
    set drawerWidthPx [expr $strMaxWidthPx + 10]
    set xxx [expr {($::::scrwidth - $drawerWidthPx) / 2}]

    if {$fr != ".fr1"} {
	set hret [expr $::scrheight / 4]
    } else {
	set hret $::scrheight
    }
	set hret [expr $::scrheight / 4]
    tkp::canvas $fr.can -borderwidth 0 -height $hret -width $::scrwidth -relief flat
#Мостим холст плиткой 
    createtile "$fr.can"  $tile
    pack $fr.can  -anchor center -expand 1 -fill both -side top  -padx 0 -pady 0
    if {$titul != "" } {
	set allfunc $titul
	catch {font delete fontTEMP_titul}
	set font_titul "-family {Roboto Condensed Medium} -size 15"
        eval font create fontTEMP_titul  $font_titul
	set funcWidthPx [font measure fontTEMP_titul "$allfunc"]
	set dlx [expr {($::::scrwidth - $funcWidthPx) / 2}]

	$fr.can create text [expr $dlx + 6] [expr {6 + 6}] -anchor nw -text "$allfunc" -fill black -font fontTEMP_titul
	$fr.can create text $dlx 6 -anchor nw -text "$allfunc" -fill white -font fontTEMP_titul -tag id_text0
	set blogo [$fr.can bbox id_text0]
	set boxbut [expr ([lindex $blogo 3] + 6 + 6)]
    } else {
	set boxbut [expr 6 + 6]
    }
#Вычисляем самый широкий текст у кнопок
#См. выше
#Размещаем кнопки
    set BDwidth_canvas 0

    set maxTextHeightPx [font metrics fontTEMP_drawer -linespace] 

    set maxTextHeightPx [expr {$maxTextHeightPx + ( $maxTextHeightPx / 2)}]

    set drawerHeightPx $maxTextHeightPx

    set xLocTextPx [expr {($::::scrwidth - $drawerWidthPx) / 2}]

    set yLocTextPx [expr $BDwidth_canvas + ($drawerHeightPx / 2) + $boxbut]
    set canvasHeightPx [expr $Ndrawers * $drawerHeightPx]

    set drawerCNT 0
    set Ndrawers [expr {[array size but] - 1}]
    while { $drawerCNT <= $Ndrawers } {
      set yLineLocPx [ expr (( $drawerCNT ) * $drawerHeightPx + $boxbut)]
#Линия перед текстом
      $fr.can create line 
         $xLocTextPx $yLineLocPx 
         [expr $drawerWidthPx + $xLocTextPx] $yLineLocPx 
         -fill "#a0a0a0" -width $widl

      $fr.can create text [expr $xLocTextPx + 5] $yLocTextPx 
	-anchor w 
        -font fontTEMP_drawer 
        -text "$but($drawerCNT)" 
        -tag textlineTag($drawerCNT)

      if {$drawerCNT == 0} {
	    if {$fr == ".fr1"} {
		$fr.can bind textlineTag($drawerCNT)  <ButtonRelease-1>   {butImg "but1"}
	    } else {
		$fr.can bind textlineTag($drawerCNT)  <ButtonRelease-1>   {butReturn}
	    }
	} else {
	    frame .fn$drawerCNT -background white -relief flat -pady 0 -padx 0
	    set titul $but($drawerCNT)
	    set cmd "$fr.can bind textlineTag($drawerCNT)  <ButtonRelease-1>   {butCliked $drawerCNT .fn$drawerCNT}"
	    set cmd [subst "$cmd"]
	    eval $cmd 
	    set but1(0) "Возврат в основное меню"
	    page_func ".fn$drawerCNT" voda "$titul" "but1"
	}

	incr drawerCNT

	set yLocTextPx [ expr $yLocTextPx + $drawerHeightPx]
#Завершаюшая линия
	if { $drawerCNT > $Ndrawers } {
    	    set yLineLocPx [ expr (( $drawerCNT ) * $drawerHeightPx + $boxbut)]
    	    $fr.can create line $xLocTextPx $yLineLocPx 
            [expr $drawerWidthPx + $xLocTextPx] $yLineLocPx 
            -fill "#a0a0a0" -width $widl
	}
    }
}
#Собственно скрипт
#Считываем размеры экрана
set ::scrwidth [winfo screenwidth .]
set ::scrheight [winfo screenheight .]
set ::typetlf 0
#Проверяем, что это телефон
if {$::scrwidth < $::scrheight} {
    set ::typetlf 1
}
set ::padls 20
set ::padlx 15
set ::padly 15
if {$::typetlf} {
	wm attributes . -fullscreen 1
#Логотип продуктв
	scaleImage logo_product 2
	set ::padls 50
	set ::padlx 75
	set ::padly 50
} else {
#Конфигурирование виджета под смартфон
    set ::scrwidth 370
    set ::scrheight 700
    wm minsize . $::scrwidth $::scrheight
    set geometr $::scrwidth
    append geometr "x"
    append geometr $::scrheight
    append geometr "+0+0"
    wm geometry . $geometr
}

#Грузим картинки
image create photo voda -file [file join $mydir "imageme" "voda_400x800.png"]
#Логотип продукта
image create photo logo_product -file [file join $mydir "imageme" "validcertkey_51x24.png"] 
#Создаем название продукта
set name_product "CryptoArmPKCS-A" 
label .labtitul -image logo_product -compound left -fg snow -text $name_product -font {Arial 10 bold} -anchor w  -width [winfo screenwidth .] -pady $::padls -padx 10 -bg #222222 
pack .labtitul -anchor nw -expand 0 -fill x -side top  -padx 1 -pady 0
#Создаем страницы с функционалом
set i 1
ttk::frame .fr$i -pad 0 -padding 0
#Кнопки основного меню
set but(0) "Стартовая страница" 
set but(1) "Подписать документ"
set but(2) "Работаем с ЭП (PKCS7)" 
set but(3) "Запрос на сертификат" 
set but(4) "Просмотр запроса/сертификата" 
set but(5) "Список криптомеханизмов"
set but(6) "Просмотр ASN1-структуры" 
set but(7) "Объекты токена" 
set but(8) "Работаем с PKCS12/PFX" 
set but(9) "Самоподписанный сертификат"
set but(10) "Об Утилите/Дистрибутивы" 
set but(11) "Создать Токены"
set but(12) "Конфигурировние токена"
if {$::typetlf} {
    scaleImage voda 3 2
}
#Создаем страницу с функционалом
page_func ".fr$i" voda "Функционал" "but"
#Отображаем страницу с функционалом
pack .fr$i -side top -anchor center -expand 1 -fill both -side top  -padx 0 -pady 0