1#---------------------------------------------------------- 2# VisualQueryBuilder 3# 4# provides for rapid query building 5# 6#---------------------------------------------------------- 7# 8# The following package is required 9 package require Tktable 2.8 10 11# The following is the variable for Tktable 12# (which must be global) 13 14 global tbquery 15 16# 17namespace eval VisualQueryBuilder { 18 variable Win 19 variable hlite none 20 variable lbnam 21 22 # The following array will hold all the local variables 23 variable vqb 24} 25 26 27#---------------------------------------------------------- 28# ::VisualQueryBuilder::init 29#---------------------------------------------------------- 30# 31proc ::VisualQueryBuilder::init {} { 32 33 global PgAcVar tbquery 34 variable vqb 35 36 catch {unset vqb} 37 set vqb(rescriteria) {} 38 set vqb(links) {} 39 set vqb(ntables) 0 40 set vqb(tid) {}; # Array of lists containing table name and table id (needed for dragging individual tables) 41 set vqb(newtablename) {} 42 43 # Clear out table 44 array unset tbquery 45 46 # Set row headings for table query 47 set tbquery(1,0) "Field: " 48 set tbquery(2,0) "Table: " 49 set tbquery(3,0) "Sort: " 50 set tbquery(4,0) "Visible: " 51 set tbquery(5,0) "Criteria: " 52 set tbquery(6,0) "Or: " 53 54}; # end proc ::VisualQueryBuilder::init 55 56 57#---------------------------------------------------------- 58# ::VisualQueryBuilder::print 59#---------------------------------------------------------- 60# 61proc ::VisualQueryBuilder::print {} { 62 63 variable Win 64 variable vqb 65 66 set g [string trimleft [wm geometry .pgaw:VisualQuery] "="] 67 set vqb(xsize) [lindex [split $g "x+"] 0] 68 set vqb(ysize) [lindex [split $g "x+"] 1] 69 70 ::Printer::init "::VisualQueryBuilder::printcallback" 71 72}; # end proc ::VisualQueryBuilder::print 73 74 75#---------------------------------------------------------- 76# ::VisualQueryBuilder::printcallback 77#---------------------------------------------------------- 78# 79proc ::VisualQueryBuilder::printcallback {fid} { 80 81 variable vqb 82 83 set cv .pgaw:VisualQuery.pw.f0.frame.c 84 85 ::Printer::printStart $fid $vqb(xsize) $vqb(ysize) 1 86 ::Printer::printPage $fid 1 $cv 87 ::Printer::printStop $fid 88 89}; # end proc ::VisualQueryBuilder::print 90 91 92#------------------------------------------------------------ 93# ::VisualQueryBuilder::createDropDown 94#------------------------------------------------------------ 95# 96proc ::VisualQueryBuilder::createDropDown {} { 97 98 global PgAcVar 99 variable vqb 100 101 if {[winfo exists .pgaw:VisualQuery.ddf]} { 102 destroy .pgaw:VisualQuery.ddf 103 } else { 104 create_drop_down .pgaw:VisualQuery 70 27 200 105 focus .pgaw:VisualQuery.ddf.sb 106 foreach tbl [Database::getTablesList] {.pgaw:VisualQuery.ddf.lb insert end $tbl} 107 bind .pgaw:VisualQuery.ddf.lb <ButtonRelease-1> { 108 set i [.pgaw:VisualQuery.ddf.lb curselection] 109 if {$i!=""} { 110 set VisualQueryBuilder::vqb(newtablename) [.pgaw:VisualQuery.ddf.lb get $i] 111 VisualQueryBuilder::addNewTable 112 } 113 destroy .pgaw:VisualQuery.ddf 114 break 115 } 116 } 117 118 return 119 120}; # end proc ::VisualQueryBuilder::createDropDown 121 122 123#---------------------------------------------------------- 124# ::VisualQueryBuilder::addNewTable 125#---------------------------------------------------------- 126# 127proc ::VisualQueryBuilder::addNewTable {{tabx 0} {taby 0} {alias -1}} { 128 129 global PgAcVar CurrentDB 130 variable vqb 131 variable Win 132 133 if {$vqb(newtablename)==""} return 134 set fldlist {} 135 set l [split [string map {\" \'} $vqb(newtablename)] "."] 136 if {[llength $l] == 2} { 137 set schemaname [lindex $l 0] 138 } 139 set tablename [lindex $l end] 140 set ver [string range [::Database::getPgVersion $CurrentDB] 0 2] 141 setCursor CLOCK 142 set fldlist [::Database::getColumnsList $vqb(newtablename)] 143 setCursor DEFAULT 144 if {$fldlist==""} { 145 showError [format [intlmsg "Table '%s' not found!"] $vqb(newtablename)] 146 return 147 } 148 if {$alias==-1} { 149 set tabnum $vqb(ntables) 150 } else { 151 regsub t $alias "" tabnum 152 } 153 set vqb(tablename$tabnum) $vqb(newtablename) 154 set vqb(tablestruct$tabnum) $fldlist 155 set vqb(tablealias$tabnum) "t$tabnum" 156 set vqb(ali_t$tabnum) $vqb(newtablename) 157 set vqb(tablex$tabnum) $tabx 158 set vqb(tabley$tabnum) $taby 159 incr vqb(ntables) 160 if {$vqb(ntables)==1} { 161 repaintAll 162 } else { 163 drawTable [expr $vqb(ntables)-1] 164 } 165 set vqb(newtablename) {} 166 focus $Win(entertable) 167 168}; # end proc ::VisualQueryBuilder::addNewTable 169 170 171#---------------------------------------------------------- 172# ::VisualQueryBuilder::drawTable 173#---------------------------------------------------------- 174# 175proc ::VisualQueryBuilder::drawTable {it} { 176 177 global PgAcVar 178 variable vqb 179 variable hlite 180 variable lbnam 181 182 set cv .pgaw:VisualQuery.pw.f0.frame.c 183 set tbl .pgaw:VisualQuery.pw.f1.frame.tb 184 185 # Get the number of pixels for (scrollregion) 29.7cm and 21cm on the canvas 186 set nx [winfo fpixels $cv 29.7c] 187 set ny [winfo fpixels $cv 21.0c] 188 if {$vqb(tablex$it)==0} { 189 set posy 10 190 set allbox [$cv bbox ftbl] 191 if {$allbox==""} { 192 set posx 10 193 } else { 194 set posx [expr 20 + [lindex $allbox 2]] 195 } 196 # ToDo: Try to get smarter placement 197 if {$posx > $nx} { 198 set posx 20 199 set posy 20 200 } 201 set vqb(tablex$it) $posx 202 set vqb(tabley$it) $posy 203 } else { 204 set posx [expr int($vqb(tablex$it))] 205 set posy [expr int($vqb(tabley$it))] 206 } 207 208 # Remove leading and trailing double-quotes 209 set tablename [string trim $vqb(tablename$it) \"] 210 set tablealias $vqb(tablealias$it) 211 212 # Create table window (frame, label and Listbox) 213 set fnam tab$it 214 frame $cv.$fnam -borderwidth 2 -relief raised -height 10 -width 10 215 label $cv.$fnam.lab -borderwidth 2 -text $tablename 216 ListBox $cv.$fnam.lb -background #fefefe -foreground #000000 \ 217 -selectforeground white -selectbackground darkblue \ 218 -borderwidth 1 -highlightthickness 0 -deltay 14 -selectmode single\ 219 -yscrollcommand [subst {$cv.$fnam.sb set}] \ 220 -dragenabled 1 -dragevent 1 -dropenabled 1 -dropovermode i\ 221 -dropcmd {VisualQueryBuilder::lbdrop} 222 scrollbar $cv.$fnam.sb -borderwidth 1 -command [subst {$cv.$fnam.lb yview}] -highlightthickness 0 -orient vert 223 224 # Get the width of the longest field and height of fields 225 set w 0 226 set numflds 0 227 foreach fld $vqb(tablestruct$it) { 228 set tmp [font measure system -displayof $cv.$fnam.lb $fld] 229 if {$tmp > $w} { 230 set w $tmp} 231 incr numflds 232 } 233 set h [expr $numflds * 14] 234 235 # Add 30 to width to allow for left border where an image can be displayed 236 # Add 30 to height to allow for the label 237 set tid [$cv create window $posx $posy -anchor nw -window $cv.$fnam \ 238 -height [expr $h + 30] -width [expr $w + 30] -tags ftbl] 239 lappend vqb(tid) [list $cv.$fnam $tid] 240 pack $cv.$fnam.lab -side top -fill x 241 pack $cv.$fnam.lb -side left -expand 1 -fill y 242 foreach fld $vqb(tablestruct$it) {$cv.$fnam.lb insert end $fld -text $fld -data $it} 243 $cv.$fnam.lb bindText <Button-1> [list VisualQueryBuilder::clickListbox $cv.$fnam.lb] 244 $cv.$fnam.lb bindText <Double-Button-1> [list VisualQueryBuilder::dblclickListbox $cv.$fnam.lb] 245 246 # Set up events for dragging the tables on the canvas 247 bind $cv.$fnam.lab <ButtonPress-1> { 248 set dragx %x 249 set dragy %y 250 set w [winfo parent %W] 251 set tid [VisualQueryBuilder::findtid $w] 252 } 253 254 bind $cv.$fnam.lab <B1-Motion> { 255 set dx [expr %x - $dragx] 256 set dy [expr %y - $dragy] 257 .pgaw:VisualQuery.pw.f0.frame.c move $tid $dx $dy 258 VisualQueryBuilder::drawLinks 259 } 260 261 bind $cv.$fnam.lab <ButtonRelease-1> { 262 #set dragstart 0 263 } 264 265}; # end proc ::VisualQueryBuilder::drawTable 266 267 268#---------------------------------------------------------- 269# ::VisualQueryBuilder::clickListbox 270#---------------------------------------------------------- 271# 272proc ::VisualQueryBuilder::clickListbox {w i} { 273 VisualQueryBuilder::deselectGrid 274 VisualQueryBuilder::deselectLinks 275 VisualQueryBuilder::deselectTables 276 $w selection set $i 277 set VisualQueryBuilder::hlite tabl 278 set VisualQueryBuilder::lbnam $w 279} 280 281 282#---------------------------------------------------------- 283# ::VisualQueryBuilder::dblclickListbox 284#---------------------------------------------------------- 285# 286proc ::VisualQueryBuilder::dblclickListbox {w i} { 287 288 global PgAcVar 289 variable vqb 290 291 set cv .pgaw:VisualQuery.pw.f0.frame.c 292 set tbl .pgaw:VisualQuery.pw.f1.frame.tb 293 294 VisualQueryBuilder::deselectGrid 295 VisualQueryBuilder::deselectLinks 296 VisualQueryBuilder::deselectTables 297 $w selection set $i 298 set VisualQueryBuilder::hlite tabl 299 set VisualQueryBuilder::lbnam $w 300 301 # Find first free column in table 302 # If none free, add column to end of table 303 set cl -1 304 for {set c 1} {$c < [$tbl cget -cols]} {incr c} { 305 if {[$tbl get 1,$c] == ""} { 306 set cl $c 307 break 308 } 309 } 310 if {$cl == -1} { 311 $tbl insert cols $c 1 312 set cl [expr [$tbl cget -cols] - 1] 313 } 314 315 set f [winfo parent $w] 316 set tablename [$f.lab cget -text] 317 $tbl set 1,$cl $i 318 $tbl set 2,$cl $tablename 319 $tbl set 3,$cl Unsorted 320 $tbl set 4,$cl Yes 321} 322 323 324#---------------------------------------------------------- 325# ::VisualQueryBuilder::findtid 326#---------------------------------------------------------- 327# 328proc ::VisualQueryBuilder::findtid {w} { 329 variable vqb 330 331 foreach l $vqb(tid) { 332 if {[lindex $l 0]==$w} { 333 set tid [lindex $l 1] 334 break; 335 } 336 } 337 return $tid 338}; # end proc ::VisualQueryBuilder::findtid 339 340 341#---------------------------------------------------------- 342# ListBox drop (lbdrop) 343# 344# target: pathname of the listbox dropped onto 345# source: pathname of the drag source 346# lst : list describing where the drop occurs. It can be 347# {widget} 348# {item item} or 349# {position index} 350# op : current operation 351# type : data type (of drag source, should be LISTBOX_ITEM) 352# data : data (of drag source) 353#---------------------------------------------------------- 354# 355proc ::VisualQueryBuilder::lbdrop {target source lst op type data} { 356 global PgAcVar 357 variable vqb 358 359 set sourcetable [winfo parent [winfo parent $source]] 360 set targetfield [lindex $lst end] 361 set targettable [winfo parent $target] 362 363 if {$sourcetable!=$targettable} { 364 lappend vqb(links) [list $sourcetable $data $targettable $targetfield] 365 drawLinks 366 } 367} 368 369 370#---------------------------------------------------------- 371# ::VisualQueryBuilder::tableDrop 372#---------------------------------------------------------- 373# 374proc ::VisualQueryBuilder::tableDrop {target source x y currentop type data} { 375 376 global PgAcVar 377 variable vqb 378 379 set cv .pgaw:VisualQuery.pw.f0.frame.c 380 set tbl .pgaw:VisualQuery.pw.f1.frame.tb 381 382 set c [$tbl index @$x,$y col] 383 if {$c <= 0} return 384 385 # Check if already a field in this column. If yes 386 # insert this before the current column 387 if {[$tbl get 1,$c] != ""} { 388 $tbl insert cols $c -1 389 } 390 set it [[winfo parent $source] itemcget $data -data] 391 set tablename [string trim $vqb(tablename$it) \"] 392 $tbl set 1,$c $data 393 $tbl set 2,$c $tablename 394 $tbl set 3,$c Unsorted 395 $tbl set 4,$c Yes 396 397} 398 399 400#---------------------------------------------------------- 401# ::VisualQueryBuilder::drawLinks 402#---------------------------------------------------------- 403# 404proc ::VisualQueryBuilder::drawLinks {} { 405 406 global PgAcVar 407 variable vqb 408 409 if {[llength $vqb(links)]==0} return 410 411 set cv .pgaw:VisualQuery.pw.f0.frame.c 412 413 $cv delete links 414 set i 0 415 416 # vqb(links) is an array of lists 417 # each list (link) contains sourcetable, sourcefield, targettable, targetfield 418 foreach link $vqb(links) { 419 set sourcetable [lindex $link 0] 420 set sourcefield [lindex $link 1] 421 set targettable [lindex $link 2] 422 set targetfield [lindex $link 3] 423 424 # Compute the source and destination right edge 425 set tid [findtid $sourcetable] 426 set scoords [$cv bbox $tid] 427 set sre [lindex $scoords 2] 428 set tid [findtid $targettable] 429 set tcoords [$cv bbox $tid] 430 set dre [lindex $tcoords 2] 431 432 # Compute field bound boxes 433 set slb $sourcetable.lb 434 set sidx [$slb index $sourcefield] 435 set tlb $targettable.lb 436 set tidx [$tlb index $targetfield] 437 438 # Compute the auxiliary lines 439 if {$sre < $dre} { 440 # Source object is on the left of target object 441 set x1 $sre 442 set y1 [expr $sidx * 14 + [lindex $scoords 1] + 30] 443 $cv create line $x1 $y1 [expr $x1+10] $y1 -tags [subst {links lkid$i}] -width 3 444 set x2 [lindex $tcoords 0] 445 set y2 [expr $tidx * 14 + [lindex $tcoords 1] + 30] 446 $cv create line [expr $x2-10] $y2 $x2 $y2 -tags [subst {links lkid$i}] -width 3 447 $cv create line [expr $x1+10] $y1 [expr $x2-10] $y2 -tags [subst {links lkid$i}] -width 2 448 } else { 449 # source object is on the right of target object 450 set x1 $dre 451 set y1 [expr $tidx * 14 + [lindex $tcoords 1] + 30] 452 $cv create line $x1 $y1 [expr $x1+10] $y1 -tags [subst {links lkid$i}] -width 3 453 set x2 [lindex $scoords 0] 454 set y2 [expr $sidx * 14 + [lindex $scoords 1] + 30] 455 $cv create line $x2 $y2 [expr $x2-10] $y2 -tags [subst {links lkid$i}] -width 3 456 $cv create line [expr $x1+10] $y1 [expr $x2-10] $y2 -tags [subst {links lkid$i}] -width 2 457 } 458 incr i 459 } 460 461 $cv lower links 462 #$cv bind links <Button-1> {VisualQueryBuilder::linkClick %x %y} 463 464}; # end proc ::VisualQueryBuilder::drawLinks 465 466 467#---------------------------------------------------------- 468# ::VisualQueryBuilder::linkClick 469#---------------------------------------------------------- 470# 471proc ::VisualQueryBuilder::linkClick {obj} { 472 473 global PgAcVar 474 variable vqb 475 variable hlite 476 477 set cv .pgaw:VisualQuery.pw.f0.frame.c 478 479 set taglist [$cv gettags $obj] 480 481 # deselct everything 482 deselectGrid 483 deselectLinks 484 deselectTables 485 486 set lt [lindex $taglist 1] 487 $cv addtag hili withtag $lt 488 foreach i [$cv find withtag hili] { 489 $cv itemconfigure $i -fill blue 490 } 491 set hlite link 492}; # end proc ::VisualQueryBuilder::linkClick 493 494 495#---------------------------------------------------------- 496# ::VisualQueryBuilder::canvasClick 497#---------------------------------------------------------- 498# 499proc ::VisualQueryBuilder::canvasClick {x y} { 500 501 global PgAcVar 502 variable vqb 503 variable hlite 504 505 set cv .pgaw:VisualQuery.pw.f0.frame.c 506 507 # As the scrollregion for the canvas is larger than the 508 # screen, we need to convert the screen x,y coordinates 509 # to the canvas x,y coordinates. 510 set lx [$cv canvasx $x] 511 set ly [$cv canvasy $y] 512 set obj [$cv find overlapping $lx $ly $lx $ly] 513 if {$obj != ""} { 514 linkClick $obj 515 } else { 516 deselectGrid 517 deselectLinks 518 deselectTables 519 set hlite none 520 } 521} 522 523 524#---------------------------------------------------------- 525# ::VisualQueryBuilder::computeSQL 526#---------------------------------------------------------- 527# 528proc ::VisualQueryBuilder::computeSQL {} { 529 530 global PgAcVar 531 variable vqb 532 533 set cv .pgaw:VisualQuery.pw.f0.frame.c 534 set tbl .pgaw:VisualQuery.pw.f1.frame.tb 535 536 set vqb(rescriteria) {} 537 538 set sqlcmd "SELECT " 539 540 for {set c 1} {$c < [$tbl cget -cols]} {incr c} { 541 if {[string trim [$tbl get 4,$c]] == "Yes"} { 542 if {![string match "$sqlcmd" "SELECT "]} { 543 set sqlcmd "$sqlcmd, " 544 } 545 set f [$tbl get 1,$c] 546 set t [$tbl get 2,$c] 547 append sqlcmd "\"${t}\".\"${f}\"" 548 } 549 } 550 551 # Read table names from grid and sort unique to remove duplicates 552 set tables [list] 553 for {set c 1} {$c < [$tbl cget -cols]} {incr c} { 554 set t [string trim [$tbl get 2,$c]] 555 if {$t != ""} { 556 lappend tables "$t" 557 } 558 } 559 set tables [lsort -unique $tables] 560 append sqlcmd "\nFROM [join $tables ,] " 561 562 set sup1 {} 563 if {[llength $vqb(links)] > 0} { 564 set sup1 "\nWHERE " 565 foreach link $vqb(links) { 566 if {$sup1 != "\nWHERE "} { 567 append sup1 " AND " 568 } 569 foreach {t1 f1 t2 f2} $link {break} 570 set tab1 [$t1.lab cget -text] 571 set tab2 [$t2.lab cget -text] 572 append sup1 " (\"${tab1}\".\"${f1}\"=\"${tab2}\".\"${f2}\")" 573 } 574 } 575 576 577 # Expressions in multiple columns in a single row are treated as And criteria. To be 578 # selected as part of the query's results, a record must meet all the criteria in a given row. 579 # Expressions in different rows are treated as Or criteria. To be selected, a record needs 580 # to meet the criteria only in any one row. 581 #-------------------------------------------------------------------------- 582 # Assume this section is empty 583 set addSectionStart 0 584 585 # set start of this section to 'where' or 'and' 586 if {$sup1 == ""} { 587 set strt "\nWHERE (" 588 } else { 589 set strt " AND (" 590 } 591 592 for {set r 5} {$r < [$tbl cget -rows]} {incr r} { 593 set str "(" 594 for {set c 1} {$c < [$tbl cget -cols]} {incr c} { 595 if {[string trim [$tbl get $r,$c]] != ""} { 596 set f [$tbl get 1,$c] 597 set t [$tbl get 2,$c] 598 set o [$tbl get $r,$c] 599 append str "(\"${t}\".\"${f}\" $o) AND " 600 } 601 } 602 # remove last " and " if there is one 603 set pos [string last " AND " $str] 604 if {$pos > 0} { 605 set str [string range $str 0 [expr $pos - 1]] 606 } 607 append str ")" 608 if {$str != "()"} { 609 set addSectionStart 1 610 } 611 lappend vqb(rescriteria) $str 612 } 613 614 if {$addSectionStart == 1} { 615 set addor 0 616 append sup1 $strt 617 618 foreach s $vqb(rescriteria) { 619 if {$s != "()"} { 620 if {$addor == 1} { 621 append sup1 "\nOR " 622 } 623 append sup1 $s 624 set addor 1 625 } 626 } 627 append sup1 ")" 628 } 629 append sqlcmd " $sup1" 630 631 632 set sup2 {} 633 for {set c 1} {$c < [$tbl cget -cols]} {incr c} { 634 set how [$tbl get 3,$c] 635 if {$how != ""} { 636 if {$how != "Unsorted"} { 637 if {$how == "Ascending"} { 638 set how ASC 639 } else { 640 set how DESC 641 } 642 if {$sup2 == ""} { 643 set sup2 "\nORDER BY " 644 } else { 645 append sup2 "," 646 } 647 set f [$tbl get 1,$c] 648 set t [$tbl get 2,$c] 649 append sup2 "\"${t}\".\"${f}\" $how " 650 } 651 } 652 } 653 654 append sqlcmd " $sup2" 655 656 return [set vqb(qcmd) $sqlcmd] 657 658}; # end proc ::VisualQueryBuilder::computeSQL 659 660 661#---------------------------------------------------------- 662# ::VisualQueryBuilder::deleteObject 663#---------------------------------------------------------- 664# 665proc ::VisualQueryBuilder::deleteObject {} { 666 667 global PgAcVar 668 variable vqb 669 variable hlite 670 variable lbnam 671 672 set cv .pgaw:VisualQuery.pw.f0.frame.c 673 set tbl .pgaw:VisualQuery.pw.f1.frame.tb 674 675 switch $hlite { 676 grid {set c [$tbl tag col HILITEcol] 677 set r [$tbl tag row HILITErow] 678 foreach cl $c {$tbl delete cols $cl 1} 679 foreach rw $r {$tbl delete rows $rw 1} 680 } 681 link {set lnks [$cv find withtag hili] 682 if {$lnks==""} return 683 set taglist [$cv gettags [lindex $lnks 0]] 684 if {$taglist==""} return 685 set lt [lindex $taglist 1] 686 set tagpos [string range $lt 4 end] 687 set vqb(links) [lreplace $vqb(links) $tagpos $tagpos] 688 $cv delete hili 689 drawLinks 690 } 691 tabl {set it [$lbnam itemcget [$lbnam selection get] -data] 692 set tablename [string trim $vqb(tablename$it) \"] 693 694 # First, delete columns in query table 695 # If you delete column 3 (for example) column 4 becomes column 3 696 # and it is missed as c has been incremented to 4. So reverse the loop 697 for {set c [expr [$tbl cget -cols] - 1]} {$c > 0 } {set c [expr $c - 1]} { 698 if {[string trim [$tbl get 2,$c]] == $tablename} { 699 $tbl delete cols $c 1 700 } 701 } 702 703 # Second, find and delete links to the table 704 set tnam [winfo parent $lbnam] 705 set tagpos 0 706 # Reverse the loop 707 # Does the following work? 708 foreach lnk $vqb(links) { 709 if {[lindex $lnk 0]==$tnam || [lindex $lnk 2]==$tnam} { 710 set vqb(links) [lreplace $vqb(links) $tagpos $tagpos] 711 } else { 712 incr tagpos 713 } 714 } 715 $cv delete links 716 drawLinks 717 718 # Finally, delete the table 719 set tid [VisualQueryBuilder::findtid $tnam] 720 $cv delete $tid 721 # delete from vqb(tid) 722 for {set pos 0} {$pos < [llength $vqb(tid)]} {incr pos} { 723 set lst [lindex $vqb(tid) $pos] 724 if {[lindex $lst 0]==$tnam} { 725 set vqb(tid) [lreplace $vqb(tid) $pos $pos] 726 break; 727 } 728 } 729 } 730 }; # end switch 731 732}; # end proc ::VisualQueryBuilder::deleteObject 733 734 735#---------------------------------------------------------- 736# ::VisualQueryBuilder::deselectGrid 737#---------------------------------------------------------- 738# 739proc ::VisualQueryBuilder::deselectGrid {} { 740 741 variable vqb 742 743 set cv .pgaw:VisualQuery.pw.f0.frame.c 744 set tbl .pgaw:VisualQuery.pw.f1.frame.tb 745 746 set c [$tbl tag col HILITEcol] 747 set r [$tbl tag row HILITErow] 748 foreach cl $c {$tbl tag col {} $cl} 749 foreach rw $r {$tbl tag row {} $rw} 750 $tbl selection clear all 751} 752 753 754#---------------------------------------------------------- 755# ::VisualQueryBuilder::deselectLinks 756#---------------------------------------------------------- 757# 758proc ::VisualQueryBuilder::deselectLinks {} { 759 760 variable vqb 761 762 set cv .pgaw:VisualQuery.pw.f0.frame.c 763 set tbl .pgaw:VisualQuery.pw.f1.frame.tb 764 765 set lnks [$cv find withtag hili] 766 if {$lnks==""} return 767 foreach i $lnks { 768 $cv itemconfigure $i -fill black 769 $cv dtag $i hili 770 } 771} 772 773 774#---------------------------------------------------------- 775# ::VisualQueryBuilder::deselectTables 776#---------------------------------------------------------- 777# 778proc ::VisualQueryBuilder::deselectTables {} { 779 780 variable vqb 781 782 set cv .pgaw:VisualQuery.pw.f0.frame.c 783 set tbl .pgaw:VisualQuery.pw.f1.frame.tb 784 785 foreach l $vqb(tid) { 786 set w [lindex $l 0] 787 $w.lb selection clear 0 end 788 } 789} 790 791 792#---------------------------------------------------------- 793# ::VisualQueryBuilder::getTableList 794#---------------------------------------------------------- 795# 796proc ::VisualQueryBuilder::getTableList {} { 797 798 global PgAcVar 799 variable vqb 800 801 set tablelist {} 802 set num 0 803 foreach lst $vqb(tid) { 804 set f [lindex $lst 0] 805 set name [$f.lab cget -text] 806 lappend tablelist $name [winfo x $f] [winfo y $f] t$num 807 incr num 808 } 809 810 return $tablelist 811 812}; # end proc ::VisualQueryBuilder::getTableList 813 814 815#---------------------------------------------------------- 816# ::VisualQueryBuilder::getLinkList 817#---------------------------------------------------------- 818# 819proc ::VisualQueryBuilder::getLinkList {} { 820 821 global PgAcVar 822 variable vqb 823 824 set linklist {} 825 foreach lst $vqb(links) { 826 lappend linklist [lindex $lst 0] [lindex $lst 1] [lindex $lst 2] [lindex $lst 3] 827 } 828 829 return $linklist 830 831}; # end proc ::VisualQueryBuilder::getLinkList {} { 832 833 834#---------------------------------------------------------- 835# ::VisualQueryBuilder::loadVisualLayout 836#---------------------------------------------------------- 837# 838proc ::VisualQueryBuilder::loadVisualLayout {} { 839 840 global PgAcVar tbquery 841 variable vqb 842 843 set tbl .pgaw:VisualQuery.pw.f1.frame.tb 844 845 init 846 foreach {t x y a} $PgAcVar(query,tables) { 847 set vqb(newtablename) $t 848 addNewTable $x $y $a 849 } 850 foreach {t0 f0 t1 f1} $PgAcVar(query,links) { 851 lappend vqb(links) [list $t0 $f0 $t1 $f1] 852 } 853 if {$PgAcVar(query,results)!=""} { 854 set lst $PgAcVar(query,results) 855 $tbl configure -rows [lindex $lst 0] 856 $tbl configure -cols [lindex $lst 1] 857 array set tbquery [lindex $lst 2] 858 drawLinks 859 } 860 861}; # end proc ::VisualQueryBuilder::loadVisualLayout {} { 862 863 864#---------------------------------------------------------- 865# ::VisualQueryBuilder::repaintAll 866#---------------------------------------------------------- 867# 868proc ::VisualQueryBuilder::repaintAll {} { 869 870 global PgAcVar 871 variable vqb 872 873 set cv .pgaw:VisualQuery.pw.f0.frame.c 874 set tbl .pgaw:VisualQuery.pw.f1.frame.tb 875 876 $cv delete all 877 set posx 20 878 879 foreach tn [array names vqb tablename*] { 880 regsub tablename $tn "" it 881 drawTable $it 882 } 883 884 drawLinks 885 #drawResultPanel 886 887 bind .pgaw:VisualQuery <Key-Delete> { 888 VisualQueryBuilder::deleteObject 889 } 890 891}; # end proc ::VisualQueryBuilder::repaintAll 892 893 894#---------------------------------------------------------- 895# ::VisualQueryBuilder::showSQL 896#---------------------------------------------------------- 897# 898proc ::VisualQueryBuilder::showSQL {} { 899 900 global PgAcVar 901 variable vqb 902 903 set sqlcmd [computeSQL] 904 set tl .showSQL 905 toplevel $tl -class Toplevel 906 wm title $tl [intlmsg "Show SQL"] 907 text $tl.txtSQL -height 15 -width 80 -bg white -wrap word 908 $tl.txtSQL insert end $sqlcmd 909 $tl.txtSQL configure -state disabled 910 button $tl.close -text "Close" -command {destroy .showSQL} 911 pack $tl.txtSQL -in $tl -fill both 912 pack $tl.close -in $tl -fill x 913 914}; # end proc ::VisualQueryBuilder::showSQL 915 916 917#------------------------------------------------------------ 918# ::VisualQueryBuilder::saveToQueryBuilder 919#------------------------------------------------------------ 920# 921proc ::VisualQueryBuilder::saveToQueryBuilder {} { 922 923 global PgAcVar tbquery 924 variable vqb 925 926 set tbl .pgaw:VisualQuery.pw.f1.frame.tb 927 928 Window show .pgaw:QueryBuilder 929 $::Queries::Win(qrytxt) delete 1.0 end 930 set vqb(qcmd) [computeSQL] 931 set PgAcVar(query,tables) [getTableList] 932 set PgAcVar(query,links) [getLinkList] 933 set PgAcVar(query,results) [list [$tbl cget -rows] [$tbl cget -cols] [array get tbquery]] 934 $::Queries::Win(qrytxt) insert end $vqb(qcmd) 935 focus .pgaw:QueryBuilder 936 937 return 938 939}; # end proc ::VisualQueryBuilder::saveToQueryBuilder 940 941 942#------------------------------------------------------------ 943# ::VisualQueryBuilder::executeSQL 944#------------------------------------------------------------ 945# 946proc ::VisualQueryBuilder::executeSQL {} { 947 948 global PgAcVar 949 variable vqb 950 951 set vqb(qcmd) [computeSQL] 952 set wn [Tables::getNewWindowName] 953 set PgAcVar(mw,$wn,query) [subst $vqb(qcmd)] 954 set PgAcVar(mw,$wn,updatable) 0 955 set PgAcVar(mw,$wn,isaquery) 1 956 Tables::createWindow 957 Tables::loadLayout $wn nolayoutneeded 958 Tables::selectRecords $wn $PgAcVar(mw,$wn,query) 959 960}; # end proc ::VisualQueryBuilder::executeSQL 961 962 963#------------------------------------------------------------ 964# ::VisualQueryBuilder::tableButton1 965#------------------------------------------------------------ 966# 967proc ::VisualQueryBuilder::tableButton1 {w x y} { 968 969 global PgAcVar 970 variable vqb 971 variable hlite 972 973 set cv .pgaw:VisualQuery.pw.f0.frame.c 974 set tbl .pgaw:VisualQuery.pw.f1.frame.tb 975 976 set r [$tbl index @$x,$y row] 977 set c [$tbl index @$x,$y col] 978 979 # deselect everything else 980 deselectLinks 981 deselectTables 982 set hlite grid 983 984 if {$r==0 && $c>0} { 985 if {[$tbl tag includes HILITEcol $r,$c]} { 986 $tbl tag col {} $c 987 } else { 988 $tbl tag col HILITEcol $c 989 } 990 } elseif {$r>6 && $c==0} { 991 if {[$tbl tag includes HILITErow $r,$c]} { 992 $tbl tag row {} $r 993 } else { 994 $tbl tag row HILITErow $r 995 } 996 } 997 998 if {$r==4 && $c>0} { 999 if {[$tbl get $r,$c] != ""} { 1000 if {[string match Yes [$tbl get $r,$c]]} { 1001 $tbl set $r,$c No 1002 } else { 1003 $tbl set $r,$c Yes 1004 } 1005 } 1006 } 1007 1008 if {$r==3 && $c>0} { 1009 if {[$tbl get $r,$c] != ""} { 1010 if {[string match Unsorted [$tbl get $r,$c]]} { 1011 $tbl set $r,$c Ascending 1012 } elseif {[string match Ascending [$tbl get $r,$c]]} { 1013 $tbl set $r,$c Descending 1014 } elseif {[string match Descending [$tbl get $r,$c]]} { 1015 $tbl set $r,$c Unsorted 1016 } else { 1017 $tbl set $r,$c Unsorted 1018 } 1019 } 1020 } 1021} 1022 1023 1024#------------------------------------------------------------ 1025# ::VisualQueryBuilder::tableButton3 1026#------------------------------------------------------------ 1027# 1028proc ::VisualQueryBuilder::tableButton3 {w x y} { 1029 1030 global PgAcVar 1031 variable vqb 1032 1033 set cv .pgaw:VisualQuery.pw.f0.frame.c 1034 set tbl .pgaw:VisualQuery.pw.f1.frame.tb 1035 1036 #set r [$tbl index @$x,$y row] 1037 #set c [$tbl index @$x,$y col] 1038 1039 if {[$tbl tag cell active] == ""} {return} 1040 if {[$tbl index active col]==0} {return} 1041 if {[$tbl index active row]>6} { 1042 $tbl.pop.casd entryconfigure 1 -state normal 1043 $tbl.pop.casi entryconfigure 1 -state normal 1044 } else { 1045 $tbl.pop.casd entryconfigure 1 -state disabled 1046 $tbl.pop.casi entryconfigure 1 -state disabled 1047 } 1048 1049 tk_popup $tbl.pop [winfo pointerx $w] [winfo pointery $w] 1050} 1051 1052 1053#============================================================ 1054# GUI 1055#============================================================ 1056# 1057proc vTclWindow.pgaw:VisualQuery {base} { 1058 1059 global PgAcVar 1060 variable vqb 1061 1062 if {$base==""} { 1063 set base .pgaw:VisualQuery 1064 } 1065 1066 if {[winfo exists $base]} { 1067 wm deiconify $base; return 1068 } 1069 1070 toplevel $base -class Toplevel 1071 wm focusmodel $base passive 1072 wm geometry $base 759x530+10+13 1073 wm maxsize $base 1280 1024 1074 wm minsize $base 1 1 1075 wm overrideredirect $base 0 1076 wm resizable $base 1 1 1077 wm deiconify $base 1078 wm title $base [intlmsg "Visual query designer"] 1079 1080 bind $base <Key-F1> "Help::load visual_designer" 1081 1082 # frame widget for label and combobox 1083 frame $base.fb \ 1084 -height 75 \ 1085 -width 125 1086 1087 # label and combobox widgets to add a table 1088 Label $base.fb.ltable \ 1089 -borderwidth 0 \ 1090 -text [intlmsg "Add table"] 1091 ComboBox $base.fb.cbtable \ 1092 -background #fefefe \ 1093 -borderwidth 1 \ 1094 -highlightthickness 0 \ 1095 -values [concat [::Database::getPrefObjList Tables] \ 1096 [::Database::getPrefObjList Views]] \ 1097 -editable true \ 1098 -textvariable ::VisualQueryBuilder::vqb(newtablename) \ 1099 -modifycmd {::VisualQueryBuilder::addNewTable} 1100 1101 set ::VisualQueryBuilder::Win(entertable) $base.fb.cbtable 1102 1103 # butoon widgets for toolbar 1104 ButtonBox $base.fb.bbox \ 1105 -orient horizontal \ 1106 -homogeneous 1 \ 1107 -spacing 2 1108 $base.fb.bbox add \ 1109 -borderwidth 1 \ 1110 -image ::icon::imagegallery-22 \ 1111 -helptext [intlmsg "Show SQL"] \ 1112 -command VisualQueryBuilder::showSQL 1113 $base.fb.bbox add \ 1114 -borderwidth 1 \ 1115 -image ::icon::misc-16 \ 1116 -helptext [intlmsg "Execute SQL"] \ 1117 -command VisualQueryBuilder::executeSQL 1118 $base.fb.bbox add \ 1119 -borderwidth 1 \ 1120 -image ::icon::filesave-22 \ 1121 -helptext [intlmsg "Save to query builder"] \ 1122 -command VisualQueryBuilder::saveToQueryBuilder 1123 $base.fb.bbox add \ 1124 -borderwidth 1 \ 1125 -image ::icon::fileprint-22 \ 1126 -helptext [intlmsg "Print"] \ 1127 -command VisualQueryBuilder::print 1128 $base.fb.bbox add \ 1129 -borderwidth 1 \ 1130 -image ::icon::help-22 \ 1131 -helptext [intlmsg "Help"] \ 1132 -command {::Help::load visual_designer} 1133 $base.fb.bbox add \ 1134 -borderwidth 1 \ 1135 -image ::icon::exit-22 \ 1136 -helptext [intlmsg "Close"] \ 1137 -command {Window destroy .pgaw:VisualQuery} 1138 1139 # create paned window to hold canvas and table 1140 set pw1 [PanedWindow $base.pw -side left] 1141 set pane1 [$pw1 add -minsize 100 -weight 2] 1142 set pane2 [$pw1 add -minsize 60 -weight 1] 1143 1144 canvas $pane1.c \ 1145 -width 295 -height 207 \ 1146 -background #CCCCCC \ 1147 -borderwidth 2 \ 1148 -relief ridge \ 1149 -takefocus 0 \ 1150 -yscrollcommand {.pgaw:VisualQuery.pw.f0.frame.sy set} \ 1151 -xscrollcommand {.pgaw:VisualQuery.pw.f0.frame.sx set} \ 1152 -scrollregion {-29.7c -21.0c 29.7c 21.0c}; #scrollregion equivalent to an A2 sheet 1153 1154 scrollbar $pane1.sy -command [list $pane1.c yview] 1155 scrollbar $pane1.sx -command [list $pane1.c xview] -orient horizontal 1156 1157 place $pane1.c -x 0 -y 0 -relheight 1.0 -relwidth 1.0 -height -18 -width -18 -anchor nw 1158 place $pane1.sy -relx 1.0 -y 0 -relheight 1.0 -height -18 -width 18 -anchor ne 1159 place $pane1.sx -x -18 -relx 1.0 -rely 1.0 -relwidth 1.0 -width -18 -anchor se 1160 1161 table $pane2.tb \ 1162 -background white \ 1163 -borderwidth 1 \ 1164 -bordercursor crosshair \ 1165 -colwidth 20 \ 1166 -drawmode fast \ 1167 -relief solid \ 1168 -resizeborders both \ 1169 -selectmode browse \ 1170 -titlecols 1 -titlerows 1 \ 1171 -yscrollcommand {.pgaw:VisualQuery.pw.f1.frame.sy set} \ 1172 -xscrollcommand {.pgaw:VisualQuery.pw.f1.frame.sx set} \ 1173 -variable tbquery 1174 1175 scrollbar $pane2.sy -command [list $pane2.tb yview] 1176 scrollbar $pane2.sx -command [list $pane2.tb xview] -orient horizontal 1177 1178 # Set table properties 1179 $pane2.tb tag config title -bg #CCCCCC -fg #000000 -anchor e 1180 $pane2.tb height 0 -10 1181 $pane2.tb width 0 -78 1182 #$pane2.tb tag configure sel -fg black 1183 $pane2.tb tag configure active -fg black 1184 1185 # set up tags for the various states of the columns 1186 $pane2.tb tag configure HILITEcol -bg darkblue -fg white 1187 $pane2.tb tag configure HILITErow -bg darkblue -fg white 1188 1189 place $pane2.tb -x 0 -y 0 -relheight 1.0 -relwidth 1.0 -height -18 -width -18 -anchor nw 1190 place $pane2.sy -relx 1.0 -y 0 -relheight 1.0 -height -18 -width 18 -anchor ne 1191 place $pane2.sx -x -18 -relx 1.0 -rely 1.0 -relwidth 1.0 -width [expr [$pane2.tb width 0] + -18] -anchor se 1192 1193 # create popup menu 1194 set p $pane2.tb.pop 1195 menu $p -type normal 1196 $p add cascade -label "Delete" -underline 0 -menu $pane2.tb.pop.casd 1197 $p add cascade -label "Insert" -underline 0 -menu $pane2.tb.pop.casi 1198 1199 # create cascade menu 1200 set d $pane2.tb.pop.casd 1201 menu $d -type normal 1202 $d add command -label "Column" -command {.pgaw:VisualQuery.pw.f1.frame.tb delete cols [.pgaw:VisualQuery.pw.f1.frame.tb index active col] 1} 1203 $d add command -label "Row" -command {.pgaw:VisualQuery.pw.f1.frame.tb delete rows [.pgaw:VisualQuery.pw.f1.frame.tb index active row] 1} 1204 1205 # create cascade menu 1206 set i $pane2.tb.pop.casi 1207 menu $i -type normal 1208 $i add command -label "Column" -command {.pgaw:VisualQuery.pw.f1.frame.tb insert cols [.pgaw:VisualQuery.pw.f1.frame.tb index active col] -1} 1209 $i add command -label "Row" -command {.pgaw:VisualQuery.pw.f1.frame.tb insert rows [.pgaw:VisualQuery.pw.f1.frame.tb index active row] -1} 1210 1211 # display widgets 1212 # frame 1213 pack $base.fb \ 1214 -in $base \ 1215 -expand 0 \ 1216 -fill x 1217 # label 1218 pack $base.fb.ltable \ 1219 -in $base.fb \ 1220 -side left 1221 # combobox 1222 pack $base.fb.cbtable \ 1223 -in $base.fb \ 1224 -side left 1225 # toolbar 1226 pack $base.fb.bbox \ 1227 -in $base.fb \ 1228 -side right \ 1229 -expand 0 \ 1230 -fill x 1231 # PanedWindow 1232 pack $pw1 \ 1233 -in $base \ 1234 -expand 1 \ 1235 -fill both 1236 1237 # point to canvas 1238 set cv .pgaw:VisualQuery.pw.f0.frame.c 1239 1240 # some helpful key bindings for canvas 1241 bind $cv <Control-Key-w> [subst {destroy $base}] 1242 bind $cv <Key-Delete> {VisualQueryBuilder::deleteObject} 1243 bind $cv <Button-1> {VisualQueryBuilder::canvasClick %x %y} 1244 1245 #point to table 1246 set tbl .pgaw:VisualQuery.pw.f1.frame.tb 1247 1248 # some helpful key bindings for table 1249 bind $tbl <Button-1> {VisualQueryBuilder::tableButton1 %W %x %y} 1250 bind $tbl <Button-3> {VisualQueryBuilder::tableButton3 %W %x %y} 1251 1252 # Set up events for drop on table 1253 # -dropcmd and -droptypes must be set for DropSite to work 1254 DropSite::register $tbl -dropcmd {VisualQueryBuilder::tableDrop} \ 1255 -droptypes [list LISTBOX_ITEM [list copy [list alt]]] 1256} 1257