Change Logo and About dialog (added new homepage and git repo addresses)

This commit is contained in:
Sergey Kalinin 2018-02-05 13:09:23 +03:00
parent 8cf4ded785
commit cd2bfad674
6 changed files with 81 additions and 34 deletions

View File

@ -10,6 +10,7 @@
- Added binding mouse button: click on notebook tab highlight opened file name in tree
- Change "Paste from Clipboard" function
- Change popup editor menu (undo, redo, copy, paste, cut functions)
- Change Logo and About dialog
04.02.2018
- Fixed paste text highlight
@ -381,5 +382,6 @@ Fixed bug with PageRise function

BIN
img/projman.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 18 KiB

View File

@ -1173,3 +1173,4 @@ proc TextOperation {oper} {
####################################
GetOp

View File

@ -361,5 +361,6 @@ proc TopLevelHelp {} {

View File

@ -408,7 +408,7 @@ proc GetProj {tree} {
## ABOUT PROGRAMM DIALOG ##
proc AboutDialog {} {
global docDir imgDir tree noteBook ver fontNormal dataDir env
global docDir imgDir tree noteBook ver fontNormal dataDir env editor
set w {}
# prevent double creation "About" page
if { [catch {set w [$noteBook insert end about -text [::msgcat::mc "About ..."]]} ] } {
@ -416,20 +416,22 @@ proc AboutDialog {} {
return
}
frame $w.frmImg -borderwidth 2 -relief ridge -background white
image create photo imgAbout -format gif -file [file join $imgDir projman.gif]
label $w.frmImg.lblImg -image imgAbout
pack $w.frmImg.lblImg -side top -pady 5 -padx 5
image create photo imgLogo -format png -file [file join $imgDir projman.png]
# image create photo imgAbout -format png -file [file join $imgDir icons large projman.png]
label $w.frmImg.lblImgLogo -image imgLogo -border 0
#label $w.frmImg.lblImg -image imgAbout
pack $w.frmImg.lblImgLogo -side top -pady 5 -padx 5
frame $w.frmlbl -borderwidth 2 -relief ridge
label $w.frmlbl.lblVersion -text "[::msgcat::mc Version] $ver"
label $w.frmlbl.lblCompany -text "License: GPL"
label $w.frmlbl.lblAuthorName -text "[::msgcat::mc Author]: Sergey Kalinin"
label $w.frmlbl.lblEmail -text "[::msgcat::mc E-mail]: banzaj28@gmail.com"
label $w.frmlbl.lblWWW -fg black \
-text "[::msgcat::mc "Home page"]: https://bitbucket.org/svk28/projman/ , https://nuk-svk.ru"
label $w.frmlbl.lblEmail -text "[::msgcat::mc E-mail]: banzaj28@yandex.ru"
label $w.frmlbl.lblWWWhome -text "[::msgcat::mc "Home page"]: https://nuk-svk.ru"
label $w.frmlbl.lblWWWgit -text "Git repository: https://bitbucket.org/svk28/projman"
pack $w.frmlbl.lblVersion $w.frmlbl.lblCompany $w.frmlbl.lblAuthorName \
$w.frmlbl.lblEmail $w.frmlbl.lblWWW -side top -padx 5
$w.frmlbl.lblEmail $w.frmlbl.lblWWWhome $w.frmlbl.lblWWWgit -side top -padx 5
frame $w.frmThanks -borderwidth 2 -relief ridge
label $w.frmThanks.lblThanks -text "[::msgcat::mc Thanks]" -font $fontNormal
text $w.frmThanks.txtThanks -width 10 -height 10 -font $fontNormal\
@ -453,25 +455,34 @@ proc AboutDialog {} {
bind $w <Escape> "$noteBook delete about"
bind $w <Return> {$noteBook delete about}
#
#bind $w.frmlbl.lblWWW <Enter> {
# .frmBody.frmWork.noteBook.fabout.frmlbl.lblWWW configure -fg blue -cursor hand1
# LabelUpdate .frmStatus.frmHelp.lblHelp "Goto http://nuk-svk.ru"
#}
#bind $w.frmlbl.lblWWW <Leave> {
# .frmBody.frmWork.noteBook.fabout.frmlbl.lblWWW configure -fg black
# LabelUpdate .frmStatus.frmHelp.lblHelp ""
#}
#bind $w.frmlbl.lblWWW <ButtonRelease-1> {GoToURL "http://nuk-svk.ru"}
bind $w.frmlbl.lblWWWhome <Enter> {
.frmBody.frmWork.noteBook.fabout.frmlbl.lblWWWhome configure -fg blue -cursor hand1
LabelUpdate .frmStatus.frmHelp.lblHelp "Goto https://nuk-svk.ru"
}
bind $w.frmlbl.lblWWWhome <Leave> {
.frmBody.frmWork.noteBook.fabout.frmlbl.lblWWWhome configure -fg $editor(fg)
LabelUpdate .frmStatus.frmHelp.lblHelp ""
}
bind $w.frmlbl.lblWWWhome <ButtonRelease-1> {GoToURL "https://nuk-svk.ru"}
bind $w.frmlbl.lblWWWgit <Enter> {
.frmBody.frmWork.noteBook.fabout.frmlbl.lblWWWgit configure -fg blue -cursor hand1
LabelUpdate .frmStatus.frmHelp.lblHelp "Goto https://bitbucket.org/svk28/projman"
}
bind $w.frmlbl.lblWWWgit <Leave> {
.frmBody.frmWork.noteBook.fabout.frmlbl.lblWWWgit configure -fg $editor(fg)
LabelUpdate .frmStatus.frmHelp.lblHelp ""
}
bind $w.frmlbl.lblWWWgit <ButtonRelease-1> {GoToURL "https://bitbucket.org/svk28/projman"}
#
bind $w.frmlbl.lblEmail <Enter> {
.frmBody.frmWork.noteBook.fabout.frmlbl.lblEmail configure -fg blue -cursor hand1
LabelUpdate .frmStatus.frmHelp.lblHelp "Send email \"banzaj28@yandex.ru\""
}
bind $w.frmlbl.lblEmail <Leave> {
.frmBody.frmWork.noteBook.fabout.frmlbl.lblEmail configure -fg black
.frmBody.frmWork.noteBook.fabout.frmlbl.lblEmail configure -fg $editor(fg)
LabelUpdate .frmStatus.frmHelp.lblHelp ""
}
#bind $w.frmlbl.lblEmail <ButtonRelease-1> {SendEmail "http://nuk-svk.ru"}
bind $w.frmlbl.lblEmail <ButtonRelease-1> {SendEmail "banzaj28@yandex.ru"}
$noteBook raise about
@ -693,11 +704,45 @@ proc GoToURL {url} {
} elseif {$tcl_platform(platform) == "mac"} {
set pipe [open "|iexplore $url" "r"]
} elseif {$tcl_platform(platform) == "unix"} {
set pipe [open "|$env(BROWSER) $url" "r"]
#$env(BROWSER)
#set pipe [open "|$env(BROWSER) $url" "r"]
launchBrowser $url
return
}
fileevent $pipe readable
fconfigure $pipe -buffering none -blocking no
}
proc launchBrowser {url} {
global tcl_platform
if {$tcl_platform(platform) eq "windows"} {
# first argument to "start" is "window title", which is not used here
set command [list {*}[auto_execok start] {}]
# (older) Windows shell would start a new command after &, so shell escape it with ^
#set url [string map {& ^&} $url]
# but 7+ don't seem to (?) so this nonsense is gone
if {[file isdirectory $url]} {
# if there is an executable named eg ${url}.exe, avoid opening that instead:
set url [file nativename [file join $url .]]
}
} elseif {$tcl_platform(os) eq "Darwin"} {
# It *is* generally a mistake to use $tcl_platform(os) to select functionality,
# particularly in comparison to $tcl_platform(platform). For now, let's just
# regard it as a stylistic variation subject to debate.
set command [list open]
} else {
set command [list xdg-open]
}
exec {*}$command $url &
}
proc _launchBrowser {url} {
if [catch {launchBrowser $url} err] {
tk_messageBox -icon error -message "error '$err' with '$command'"
}
}
## SEND EMAIL PROCEDURE ##
proc SendEmail {mail} {
global env tcl_platform
@ -706,16 +751,11 @@ proc SendEmail {mail} {
} elseif {$tcl_platform(platform) == "mac"} {
} elseif {$tcl_platform(platform) == "unix"} {
# set pipe [open "|$env(BROWSER) $url" "r"]
set answer [tk_messageBox\
-message "[::msgcat::mc "Not implemented yet"]"\
-type ok -icon info]
case $answer {
ok {return 0}
}
}
# fileevent $pipe readable
# fconfigure $pipe -buffering none -blocking no
set pipe [open "|xdg-open $mail" "r"]
fileevent $pipe readable
fconfigure $pipe -buffering none -blocking no
}
}
## QUIT PROJECT MANAGER PROCEDURE ##
proc Quit {} {
@ -1060,3 +1100,5 @@ proc GetExtention {node} {
return $ext
}

View File

@ -118,3 +118,4 @@ option add *Listbox.background $editor(bg) startupFile
option add *Scrollbar.background $editor(bg) startupFile