From 09b187598cce0f23e4e8d5587e193ceca26c6afd Mon Sep 17 00:00:00 2001 From: Bruce Momjian Date: Sun, 1 Mar 1998 21:13:30 +0000 Subject: [PATCH] Install new 0.81 pgaccess release. --- src/bin/pgaccess/README.pga | 6 +- src/bin/pgaccess/forms.html | 104 +++++ src/bin/pgaccess/index.html | 124 +++++ src/bin/pgaccess/maillist.html | 43 ++ src/bin/pgaccess/pga-rad.html | 198 ++++++++ src/bin/pgaccess/pgaccess.tcl | 819 ++++++++++++++++++++++++++++++++- src/bin/pgaccess/qbtclet.html | 45 ++ 7 files changed, 1321 insertions(+), 18 deletions(-) create mode 100644 src/bin/pgaccess/forms.html create mode 100644 src/bin/pgaccess/index.html create mode 100644 src/bin/pgaccess/maillist.html create mode 100644 src/bin/pgaccess/pga-rad.html create mode 100644 src/bin/pgaccess/qbtclet.html diff --git a/src/bin/pgaccess/README.pga b/src/bin/pgaccess/README.pga index 4eb30de2d0..3f798fc9b3 100644 --- a/src/bin/pgaccess/README.pga +++ b/src/bin/pgaccess/README.pga @@ -24,7 +24,7 @@ PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. -PGACCESS 0.76 , 12 January 1998 +PGACCESS 0.81 1 March 1998 ================================ I dedicate this program to my little 4 year daughter Ana-Maria and my wife for their understanding. I hope they will forgive me for spending so many @@ -126,7 +126,9 @@ Reports - table previews, sample postscript print Forms -- open user defined forms, form design module not yet available +- open user defined forms +- form design module available +- query widget qlowing access to a recordset Scripts - define, modify and call user defined scripts diff --git a/src/bin/pgaccess/forms.html b/src/bin/pgaccess/forms.html new file mode 100644 index 0000000000..12fc3f0e8a --- /dev/null +++ b/src/bin/pgaccess/forms.html @@ -0,0 +1,104 @@ + + + + + + + + +

FORMS

+ +

+

+ +

This version (0.81) of PgAccess introduce the visual form builder.

+ +

For the moment, it has only some basic widgets : labels, entries, buttons +, listboxes , checkboxes and radiobuttons.

+ +

Also there is a query widget that allows you yo have access to a query +results.

+ +

In a manner very similar with Visual Tcl or Visual Basic, the user must +select a widget from the toolbar and drags on the canvas the rectangle +that would define the widget. It can also specify some attributes in a +separate window. Renaming, resizing items are possible modifying parameters +in attribute window. Do not forget to press Enter in the edit field after +changing a value in order to be accepted.

+ +

You can also move items by dragging them or delete them by pressing +Del key.

+ +

In attribute window, there are some fields named Command +and Variable.

+ +

The field Command have meaning +only for Button widgets and holds the command that will be invoked when +the button is pressed.

+ +

The field Variable have meaning +only for EditField , Label widgets and checkboxes and it is the name of +the global variable that will hold the value for that widget. For checkboxes +the values are 1 or 0.

+ +

In order to make a simple test, put an entry field and set it's variable +to v1 and a button who's command is "set v1 whisky". Press +the button "Test form" and click on the button. In that entry +should appear whisky.
+Another test is defining in Script module a script called "My first +script" having the following commands:
+tk_messageBox -title Warning -message "This is my +first message!"
+and then define a button who's command is execute_script +"My first script".

+ +

Database manipulation

+ +

Let's presume that our form have the internal name mf (my +form). He wil be referred inside the Tcl/Tk source as .mf
+If you want to close the form in run-time you have to issue the +command destroy .mf

+ +

Also, any widget will have the name prefixed by .mf      We +will have .mf.button1 or .mf.listbox1 .

+ +

We can name the query widget qry for example. The complete +name will be .mf.qry then.
+The Command property of the query widget must contain the +SQL command that will be executed.
+When the form will be in run-time, automatically you will have acces to +the following methods :

+ +

.mf.qry:execute - opens the connection and execute the query +(returns nothing)
+.mf.qry:nrecords - returns the number of records in the selected +query
+.mf.qry:fields - returns a list of the fields in the result set
+.mf.qry:movefirst - move the cursor to the first record in the +recordset
+.mf.qry:movelast , .mf.qry:movenext , .mf.qry:moveprevious - moves +the cursor
+.mf.qry:updatecontrols - update the variables inside the designed +form that have a particular name (I'll explain later)
+.mf.qry:close - close the connection (if +you don't close the query result, you will loose memory)

+ +

If you want to bound some controls to the fields of the recordset, you +will have to name their associate variable like that :

+ +

.mf.qry.salary to get the "salary" field , or .mf.qry.name +to get the "name" field.

+ +

It's simple, isn't it ? It's just like a new widget that have some properties +and methods that can be accesed.
+Also, the name convention is just like in Tcl/Tk.

+ +

+

+ +

Please feel free to send me your oppinion at teo@flex.ro on forms +designing and usage.
+

+ + + diff --git a/src/bin/pgaccess/index.html b/src/bin/pgaccess/index.html new file mode 100644 index 0000000000..9456d4543e --- /dev/null +++ b/src/bin/pgaccess/index.html @@ -0,0 +1,124 @@ + + + + PgAccess - a Tcl/Tk PostgreSQL interface + + + + + +

PgAccess - a database management tool for PostgreSQL

+ +

+

+ +

This program is protected by the following copyright +

+ +
  • Download the last version of Pgaccess +(press shift and click this link).
    • + +

    Latest version of PgAccess is 0.81 , 1 March 1998 !

    + +
    + + + +
    +


    +PgAccess can now design Forms, +Reports and Scripts

    +
    + +

    I think that there were some problems loading libpgtcl library.
    +I invite you to read a special section concerning +libpgtcl

    + +

    What does PgAccess now!

    + +

    Here are some images from PgAccess windows : Main +window , table builder , table(query) +view , visual query builder .

    + +

    Tables
    +- opening tables for viewing, max 200 records (changed by preferences menu) +
    +- column resizing, dragging the vertical grid line (better in table space +rather than in the table header)
    +- text wrap in cells - layout saved for every table
    +- import/export to external files (SDF,CSV)
    +- filter capabilities (enter filter like (price>3.14)
    +- sort order capabilities (enter manually the sort field(s))
    +- editing in place
    +- improved table generator assistant
    +- improved field editing
    +Queries
    +- define , edit and stores "user defined queries"
    +- store queries as views
    +- execution of queries
    +- viewing of select type queries result
    +- query deleting and renaming
    +- NEW !!! Visual query +builder with drag & drop capabilities. For any of you who had installed +the Tcl/Tk plugin for Netscape Navigator, you can see it at work clicking +here
    +Sequences
    +- defines sequences, delete them and inspect them
    +Functions
    +- define, inspect and delete functions in SQL language
    +Reports
    +    - design and display simple reports from tables
    +- fields and labels, font changing, style and size
    +- saves and loads report description from database
    +- show report previews, sample postscript output file
    +Forms
    +    - open user defined forms
    +- form design module available
    +- query widget available, controls bound to query results
    +- click here for a description of forms and how +they can be used
    +Scripts
    +    - define, modify and call user defined scripts
    +Here is a special section concerning forms and scripts +.

    + +

    On the TODO list!
    +- table design (add new fields, renaming, etc.)
    +
    + 

    + +

    If you have any comment, suggestion for improvements, please feel free +to e-mail to : teo@flex.ro 
    +

    + +

    Mailing list for PgAccess Here +you will find how to subscribe to this mailing list.

    + +

    +

    + +

    More information about libgtcl

    + +

    Also, you will need the PostgreSQL to Tcl interface library, lined as +a Tcl/Tk 'load'-able module. It is called libpgtcl and the source is located +in the PostgreSQL directory /src/interfaces/libpgtcl. Specifically, you +will need a libpgtcl library that is 'load'-able from Tcl/Tk. This is technically +different from an ordinary PostgreSQL loadable object file, because libpgtcl +is a collection of object files. Under Linux, this is called libpgtcl.so. +
    +You can download from here a version already +compiled for Linux i386 systems. Just copy libpgtcl.so into your system +library director (/usr/lib) and go for it. One of the solutions is to remove +from the source the line containing load libpgtcl.so and to load +pgaccess.tcl not with wish, but with pgwish (or wishpg) that wish that +was linked with libpgtcl library!

    + +

    If you have installed RedHat 5.0, you should get the last distribution +kit of postgreSQL and compile it from scratch. RedHat 5.0 is using some +new versions of libraries and you have to compile and install again at +least libpq and libpgtcl libraries.

    + +

    However, the application should work without problems!

    + + + diff --git a/src/bin/pgaccess/maillist.html b/src/bin/pgaccess/maillist.html new file mode 100644 index 0000000000..4e0ce850c9 --- /dev/null +++ b/src/bin/pgaccess/maillist.html @@ -0,0 +1,43 @@ + + + + + + + + +

    The mailing list for PgAccess is :       pgsql-interfaces@postgresql.org

    + +

    If you have some questions regarding PgAccess you should mail to this +address. I will also answer to messages addresed directly to me but it +would be better to post your messages here because it might be possible +to get an answer quickly from another user of PgAccess.

    + +

    +

    + +

    To subscribe please send a mail message to :

    + +

         pgsql-interfaces-request@postgresql.org + 

    + +

    having a single line in the body message :      subscribe

    + +

    In a couple of minutes , if everything is ok, you must receive something +like that :

    + +

    +

    + +

    Welcome to the pgsql-interfaces mailing list!

    + +

    Please save this message for future reference. Thank you.

    + +

    If you ever want to remove yourself from this mailing list, you +can send mail to <Majordomo@hub.org> with the following command in +the body of your email message:

    + +

    unsubscribe pgsql-interfaces yourname@yourdomain

    + + + diff --git a/src/bin/pgaccess/pga-rad.html b/src/bin/pgaccess/pga-rad.html new file mode 100644 index 0000000000..af4160b0c7 --- /dev/null +++ b/src/bin/pgaccess/pga-rad.html @@ -0,0 +1,198 @@ + + + + + + + + +

    PgAccess - Scripts and Forms +

    + +

    Beginning with 0.70 version, I have introduced in PgAccess two new modules +for operating with scripts and forms.

    + +

       This would give to PgAccess the power of creating +application directly into PgAccess, defining new modules, procedures, forms +and possibly making it a rapid development tool for PostgreSQL. The "scripts" +and "forms" modules are using two new tables called pga_forms +and pga_scripts. PgAccess take care of creating them if user is opening +a new database and grant ALL permissions on them to PUBLIC.
    +   Both scripts and forms are containing in fact sources +of code written in Tcl/Tk and when the user has choose to "open" +one of them, either by double-clicking in the main window or pressing the +"Open" button PgAccess is searching for them in pga_forms or +pga_scripts table, get the code and simply "eval" it !
    +   Of course, when Designing a script, a simple text editor +is opened and text is saved as is in pga_scripts table. When "designing" +a form, a "form editor" that would be very similar with "Visual +Tcl" would be invoked.

    + +

       This mechanism and the extremely versatile scripting +mode of Tcl/Tk would give PgAccess a great power for creating end user +application using PosgreSQL. The most important thing is that the user +could call procedures and functions that I have used for building up PgAccess +!

    + +

    Forms

    + +

       Forms are special Tcl/Tk source code that is used +for creating windows and placing widgets inside it. When Tcl/Tk is "eval" +them, a new window appears, with buttons as defined that could call "user +defined scripts", "user defined procedures" or "internal +PgAccess procedures".
    +   For the moment, 0.70 version of PgAccess does not have +a module for designing forms. It is intended to make an interface to the +most powerful program of designing applications under Tcl/Tk , Visual Tcl +, so it could handle forms designed to be used inside PgAccess.
    +   Forms can hold all the widgets allowed in Tcl/Tk , buttons, +check-boxes, radio-buttons, list-boxes, frames, canvases, etc. With these +forms, you can control your application so PgAccess would become just a +"shell", a startup point for you applications.

    + +

    Scripts

    + +

       Scripts are normal Tcl/Tk code that is interpreted +by Tcl/Tk. You can define your own procedures inside a script called "Library" +for example. You can call your procedures from within another script, from +another procedure.
    +   The most important thing is that you have total access +to the PgAccess's core of functions and procedures used by me in building +PgAccess as an application. Just write open_table +"Your sample table" and you'll see the result.
    +   If you are writing a script called "Autoexec" +then it will be executed every time the database is opened. You can put +inside different commands that you want to be executed such as : running +scripts that would define your own procedures such as execute_script +"My own procedure library" or open a form with +open_form "Main window with menu buttons" +, and so on.

    + +

    +

    + +

    Examples :

    + +

    We would like to give you some examples for using forms and scripts. +First of all, get your PgAccess 0.70 version NOW !

    + +

      Define your first +form. Remember, the form design module hasn't arrived yet :-( , so you +will have to define your first form using an action query :
    +1. Click on Query tab and press "New" button
    +2. Enter "Generate my first form" in Query name field
    +3. Copy and paste from your browser window into query definition area the +next text :
    +
    +insert into pga_forms values('My first form',' set base .pga_win_1; +if {[winfo exists $base]} { wm deiconify $base; return }; toplevel $base +-class Toplevel; wm focusmodel $base passive; wm geometry $base 395x389+325+188; +wm maxsize $base 1009 738; wm minsize $base 1 1; wm overrideredirect $base +0; wm resizable $base 1 1; wm deiconify $base; wm title $base "User +defined Form No.1"; button $base.b1 -command {execute_script "My +first script"} -text "My first button" ; button $base.bexit +-command {destroy [focus]} -padx 9 -pady 3 -text Exit ; place $base.bexit +-x 340 -y 355 -anchor nw -bordermode ignore ; place $base.b1 -x 10 -y 10 +-anchor nw;');

    + +

    4. Press "Save query definition button" and then "Close"
    +5. In the mai window, select by clicking the query "Generate my first +form" and press "Open" button.

    + +

    Your query must have been executed without errors! If you will check +now the "Forms" tab, you will find there your first form. Press +"Open" button and enjoy it! For the moment, if you will press +"My first button" you will get an error message. Of course : +we haven't yet defined our first script !

    + +

      Defining our first +script :
    +1. Click on Scripts tab and pres "New" button
    +2. Enter "My first script" in script's name field
    +3. Enter the body as the script the following statements :
    +
    +MsgBox "Warning" "PgAccess unleashed!"
    +open_table pga_scripts
    +
    +    4. Press "Save" button then "Cancel"

    + +

    It's now the time to define our first library script. I am defining +not because I need it. I could write directly in "My first script" +the instructions for creating that warning window but I only wanted to +show you how you can mix PgAccess script execution with Tcl/Tk code and +so on.

    + +

      Define our first +library that will contain your "user defined" Tcl/Tk procedures +and functions :
    +1. Click on Scripts tab and pres "New" button
    +2. Enter "My first library" in script's name field
    +3. Enter the body of the script the following statements :
    +
    +proc MsgBox {title msg} {
    +      tk_messageBox -title $title -message +$msg
    +}
    +
    +    4. Press "Save" button then "Cancel"

    + +

      Define +our first autoexec script that will contain commands that will be executed +when opening database :
    +1. Click on Scripts tab and pres "New" button
    +2. Enter "Autoexec" in script's name field
    +3. Enter the body of the script the following statements :
    +
    +execute_script "My first library"
    +open_form "My first form"
    +
    +    4. Press "Save" button then "Cancel"

    + +

    Everything is OK now! You will have to exit PgAccess and enter it again +opening the same database ! Voila , your first form will pop-up on the +screen, a message box is displayed and after clicking Ok button the table +pga_scripts will be opened in table viewer revealing what's inside ! With +this occasion I have shown how you could open in table view mode a "pga_..." +system table that is hidden by PgAccess in main view mode!

    + +

    I am stopping here, asking you to try this new features and sending +me as more feed-backs as you can! What do you think about this new features +? How would you like to be developed PgAccess in future ? In this +moment, I am working in recoding the main part of PgAccess in order to +give to the user more "system" functions that would help him +creating new applications very easy.
    +
    +Remember : I'm waiting your messages at teo@flex.ro +

    + +

    +

    + +

    You will also have the ability of hiding the main window of PgAccess +at the beginning of "Autoexec" script execution and showing it +before destroying "My first form". For this example, delete the +previously defined "My first form" and create it with another +action query with this code :
    +
    +insert into pga_forms values('My first form',' set base .pga_win_1; +if {[winfo exists $base]} { wm deiconify $base; return }; toplevel $base +-class Toplevel; wm focusmodel $base passive; wm geometry $base 395x389+325+188; +wm maxsize $base 1009 738; wm minsize $base 1 1; wm overrideredirect $base +0; wm resizable $base 1 1; wm deiconify $base; wm title $base "User +defined Form No.1"; button $base.b1 -command {execute_script "My +first script"} -text "My first button" ; button $base.bexit +-command {Window show .dw ; destroy [focus]} -padx 9 -pady 3 -text Exit +; place $base.bexit -x 340 -y 355 -anchor nw -bordermode ignore ; place +$base.b1 -x 10 -y 10 -anchor nw;');
    +
    +    This new one is just showing main window (.dw) before destroying the +"user defined window" .
    +Also make "Autoexec" script to show like this :
    +
    +execute_script "My first library"
    +Window hide .dw
    +open_form "My first form"
    +

    + + + diff --git a/src/bin/pgaccess/pgaccess.tcl b/src/bin/pgaccess/pgaccess.tcl index 3dddf5ad9e..3dfef34bae 100644 --- a/src/bin/pgaccess/pgaccess.tcl +++ b/src/bin/pgaccess/pgaccess.tcl @@ -164,6 +164,7 @@ set tablename $objname switch $activetab { Queries {open_query design} Scripts {design_script $objname} + Forms {fd_load_form $objname design} Reports { Window show .rb tkwait visibility .rb @@ -261,6 +262,13 @@ switch $activetab { Window show .rb ; tkwait visibility .rb ; rb_init ; set rbvar(reportname) {} ; set rbvar(justpreview) 0 focus .rb.e2 } + Forms { + Window show .fd + Window show .fdtb + Window show .fdmenu + Window show .fda + fd_init + } Scripts { design_script {} } @@ -317,7 +325,7 @@ if {$activetab=="Sequences"} return; if {$activetab=="Functions"} return; set temp [get_dwlb_Selection] if {$temp==""} { - tk_messageBox -title Warning -message "Please select first an object!" + tk_messageBox -title Warning -message "Please select an object first !" return; } set oldobjname $temp @@ -326,21 +334,25 @@ Window show .rf proc {cmd_Reports} {} { global dbc +cursor_watch .dw catch { pg_select $dbc "select * from pga_reports order by reportname" rec { .dw.lb insert end "$rec(reportname)" } } +cursor_arrow .dw } proc {cmd_Scripts} {} { global dbc +cursor_watch .dw .dw.lb delete 0 end catch { pg_select $dbc "select * from pga_scripts order by scriptname" rec { .dw.lb insert end $rec(scriptname) } } +cursor_arrow .dw } proc {cmd_Sequences} {} { @@ -502,6 +514,371 @@ global dbc # } } +proc {fd_change_coord} {} { +global fdvar fdobj +set i $fdvar(moveitemobj) +set c $fdobj($i,c) +set c [list $fdvar(c_left) $fdvar(c_top) [expr $fdvar(c_left)+$fdvar(c_width)] [expr $fdvar(c_top)+$fdvar(c_height)]] +set fdobj($i,c) $c +.fd.c delete o$i +fd_draw_object $i +fd_draw_hookers $i +} + +proc {fd_delete_object} {} { +global fdvar +set i $fdvar(moveitemobj) +.fd.c delete o$i +.fd.c delete hook +set j [lsearch $fdvar(objlist) $i] +set fdvar(objlist) [lreplace $fdvar(objlist) $j $j] +} + +proc {fd_draw_hook} {x y} { +.fd.c create rectangle [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2] -fill black -tags hook +} + +proc {fd_draw_hookers} {i} { +global fdobj +foreach {x1 y1 x2 y2} $fdobj($i,c) {} +.fd.c delete hook +fd_draw_hook $x1 $y1 +fd_draw_hook $x1 $y2 +fd_draw_hook $x2 $y1 +fd_draw_hook $x2 $y2 +} + +proc {fd_draw_object} {i} { +global fdvar fdobj +set c $fdobj($i,c) +foreach {x1 y1 x2 y2} $c {} +.fd.c delete o$i +switch $fdobj($i,t) { + button { + fd_draw_rectangle $x1 $y1 $x2 $y2 raised #a0a0a0 o$i + .fd.c create text [expr ($x1+$x2)/2] [expr ($y1+$y2)/2] -text $fdobj($i,l) -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -tags o$i + } + entry { + fd_draw_rectangle $x1 $y1 $x2 $y2 sunken white o$i + } + label { + .fd.c create text $x1 $y1 -text $fdobj($i,l) -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -anchor nw -tags o$i + } + checkbox { + fd_draw_rectangle [expr $x1+2] [expr $y1+5] [expr $x1+12] [expr $y1+15] raised #a0a0a0 o$i + .fd.c create text [expr $x1+20] [expr $y1+3] -text $fdobj($i,l) -anchor nw -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -tags o$i + } + radio { + .fd.c create oval [expr $x1+4] [expr $y1+5] [expr $x1+14] [expr $y1+15] -fill white -tags o$i + .fd.c create text [expr $x1+24] [expr $y1+3] -text $fdobj($i,l) -anchor nw -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -tags o$i + } + query { + .fd.c create oval $x1 $y1 [expr $x1+20] [expr $y1+20] -fill white -tags o$i + .fd.c create text [expr $x1+5] [expr $y1+4] -text Q -anchor nw -font -Adobe-Helvetica-Bold-R-Normal-*-*-120-*-*-*-*-* -tags o$i + } + listbox { + fd_draw_rectangle $x1 $y1 [expr $x2-12] $y2 sunken white o$i + fd_draw_rectangle [expr $x2-11] $y1 $x2 $y2 sunken gray o$i + .fd.c create line [expr $x2-5] $y1 $x2 [expr $y1+10] -fill #808080 -tags o$i + .fd.c create line [expr $x2-10] [expr $y1+9] $x2 [expr $y1+9] -fill #808080 -tags o$i + .fd.c create line [expr $x2-10] [expr $y1+9] [expr $x2-5] $y1 -fill white -tags o$i + .fd.c create line [expr $x2-5] $y2 $x2 [expr $y2-10] -fill #808080 -tags o$i + .fd.c create line [expr $x2-10] [expr $y2-9] $x2 [expr $y2-9] -fill white -tags o$i + .fd.c create line [expr $x2-10] [expr $y2-9] [expr $x2-5] $y2 -fill white -tags o$i + } +} +.fd.c raise hook +} + +proc {fd_draw_rectangle} {x1 y1 x2 y2 relief color tag} { +if {$relief=="raised"} { + set c1 white + set c2 #606060 +} else { + set c1 #606060 + set c2 white +} +if {$color != "none"} { + .fd.c create rectangle $x1 $y1 $x2 $y2 -outline "" -fill $color -tags $tag +} +.fd.c create line $x1 $y1 $x2 $y1 -fill $c1 -tags $tag +.fd.c create line $x1 $y1 $x1 $y2 -fill $c1 -tags $tag +.fd.c create line $x1 $y2 $x2 $y2 -fill $c2 -tags $tag +.fd.c create line $x2 $y1 $x2 [expr 1+$y2] -fill $c2 -tags $tag +} + +proc {fd_init} {} { +global fdvar fdobj +catch {unset fdvar} +catch {unset fdobj} +catch {.fd.c delete all} +set fdvar(forminame) {udf0} +set fdvar(formname) "New form" +set fdvar(objnum) 0 +set fdvar(objlist) {} +set fdvar(oper) none +set fdvar(tool) point +} + +proc {fd_item_click} {x y} { +global fdvar fdobj +set fdvar(oper) none +set fdvar(moveitemobj) {} +set il [.fd.c find overlapping $x $y $x $y] +if {[llength $il]==0} return +set tl [.fd.c gettags [lindex $il 0]] +set i [lsearch -glob $tl o*] +if {$i==-1} return +set objnum [string range [lindex $tl $i] 1 end] +set fdvar(moveitemobj) $objnum +set fdvar(moveitemx) $x +set fdvar(moveitemy) $y +set fdvar(oper) move +fd_show_attributes $objnum +fd_draw_hookers $objnum +} + +proc {fd_load_form} {name mode} { +global fdvar fdobj dbc +fd_init +set fdvar(formname) $name +if {$mode=="design"} { + Window show .fd + Window show .fdmenu + Window show .fda + Window show .fdtb +} +#set fid [open "$name.form" r] +#set info [gets $fid] +#close $fid +set res [pg_exec $dbc "select * from pga_forms where formname='$fdvar(formname)'"] +set info [lindex [pg_result $res -getTuple 0] 1] +pg_result $res -clear +set fdvar(forminame) [lindex $info 0] +set fdvar(objnum) [lindex $info 1] +set fdvar(objlist) [lindex $info 2] +set fdvar(geometry) [lindex $info 3] +set j 0 +foreach objinfo [lrange $info 4 end] { + foreach {t n c x l v} $objinfo {} + set i [lindex $fdvar(objlist) $j] + set fdobj($i,t) $t + set fdobj($i,n) $n + set fdobj($i,c) $c + set fdobj($i,l) $l + set fdobj($i,x) $x + set fdobj($i,v) $v + if {$mode=="design"} {fd_draw_object $i} + incr j +} +} + +proc {fd_mouse_down} {x y} { +global fdvar +set x [expr 3*int($x/3)] +set y [expr 3*int($y/3)] +set fdvar(xstart) $x +set fdvar(ystart) $y +if {$fdvar(tool)=="point"} { + fd_item_click $x $y + return +} +set fdvar(oper) draw +} + +proc {fd_mouse_move} {x y} { +global fdvar +#set fdvar(msg) "x=$x y=$y" +set x [expr 3*int($x/3)] +set y [expr 3*int($y/3)] +set oper "" +catch {set oper $fdvar(oper)} +if {$oper=="draw"} { + catch {.fd.c delete curdraw} + .fd.c create rectangle $fdvar(xstart) $fdvar(ystart) $x $y -tags curdraw + return +} +if {$oper=="move"} { + set dx [expr $x-$fdvar(moveitemx)] + set dy [expr $y-$fdvar(moveitemy)] + .fd.c move o$fdvar(moveitemobj) $dx $dy + .fd.c move hook $dx $dy + set fdvar(moveitemx) $x + set fdvar(moveitemy) $y +} +} + +proc {fd_mouse_up} {x y} { +global fdvar fdobj +set x [expr 3*int($x/3)] +set y [expr 3*int($y/3)] +if {$fdvar(oper)=="move"} { + set fdvar(moveitem) {} + set fdvar(oper) none + set oc $fdobj($fdvar(moveitemobj),c) + set dx [expr $x - $fdvar(xstart)] + set dy [expr $y - $fdvar(ystart)] + set newcoord [list [expr $dx+[lindex $oc 0]] [expr $dy+[lindex $oc 1]] [expr $dx+[lindex $oc 2]] [expr $dy+[lindex $oc 3]]] + set fdobj($fdvar(moveitemobj),c) $newcoord + fd_show_attributes $fdvar(moveitemobj) + fd_draw_hookers $fdvar(moveitemobj) + return +} +if {$fdvar(oper)!="draw"} return +set fdvar(oper) none +.fd.c delete curdraw +incr fdvar(objnum) +set i $fdvar(objnum) +lappend fdvar(objlist) $i +# t=type , c=coords , n=name , l=label +set fdobj($i,t) $fdvar(tool) +set fdobj($i,c) [list $fdvar(xstart) $fdvar(ystart) $x $y] +set fdobj($i,n) $fdvar(tool)$i +set fdobj($i,l) $fdvar(tool)$i +set fdobj($i,x) {} +set fdobj($i,v) {} +fd_draw_object $i +fd_show_attributes $i +set fdvar(moveitemobj) $i +fd_draw_hookers $i +set fdvar(tool) point +} + +proc {fd_save_form} {name} { +global fdvar fdobj dbc +if {[tk_messageBox -title Warning -message "Do you want to save the form into the database ?" -type yesno -default yes]=="no"} {return 1} +if {[string length $fdvar(forminame)]==0} { + tk_messageBox -title Warning -message "Forms need an internal name, only literals, low case" + return 0 +} +if {[string length $fdvar(formname)]==0} { + tk_messageBox -title Warning -message "Form must have a name" + return 0 +} +#set fid [open "$name.form" w] +set info [list $fdvar(forminame) $fdvar(objnum) $fdvar(objlist) [wm geometry .fd]] +foreach i $fdvar(objlist) { + lappend info [list $fdobj($i,t) $fdobj($i,n) $fdobj($i,c) $fdobj($i,x) $fdobj($i,l) $fdobj($i,v)] +} +#puts $fid $info +#close $fid +set res [pg_exec $dbc "delete from pga_forms where formname='$fdvar(formname)'"] +pg_result $res -clear +set res [pg_exec $dbc "insert into pga_forms values ('$fdvar(formname)','$info')"] +pg_result $res -clear +cmd_Forms +return 1 +} + +proc {fd_set_command} {} { +global fdobj fdvar +set i $fdvar(moveitemobj) +set fdobj($i,x) $fdvar(c_cmd) +} + +proc {fd_set_name} {} { +global fdvar fdobj +set i $fdvar(moveitemobj) +foreach k $fdvar(objlist) { + if {($fdobj($k,n)==$fdvar(c_name)) && ($i!=$k)} { + tk_messageBox -title Warning -message "There is another object (a $fdobj($k,t)) with the same name. Please change it!" + return + } +} +set fdobj($i,n) $fdvar(c_name) +fd_show_attributes $i +} + +proc {fd_set_text} {} { +global fdvar fdobj +set fdobj($fdvar(moveitemobj),l) $fdvar(c_text) +fd_draw_object $fdvar(moveitemobj) +} + +proc {fd_show_attributes} {i} { +global fdvar fdobj +set fdvar(c_info) "$fdobj($i,t) .$fdvar(forminame).$fdobj($i,n)" +set fdvar(c_name) $fdobj($i,n) +set c $fdobj($i,c) +set fdvar(c_top) [lindex $c 1] +set fdvar(c_left) [lindex $c 0] +set fdvar(c_width) [expr [lindex $c 2]-[lindex $c 0]] +set fdvar(c_height) [expr [lindex $c 3]-[lindex $c 1]] +set fdvar(c_cmd) {} +catch {set fdvar(c_cmd) $fdobj($i,x)} +set fdvar(c_var) {} +catch {set fdvar(c_var) $fdobj($i,v)} +set fdvar(c_text) {} +catch {set fdvar(c_text) $fdobj($i,l)} +} + +proc {fd_test} {} { +global fdvar fdobj dbc datasets +set base .$fdvar(forminame) +if {[winfo exists $base]} { + wm deiconify $base; return +} +toplevel $base -class Toplevel +wm focusmodel $base passive +wm geometry $base $fdvar(geometry) +wm maxsize $base 785 570 +wm minsize $base 1 1 +wm overrideredirect $base 0 +wm resizable $base 1 1 +wm deiconify $base +wm title $base $fdvar(formname) +foreach item $fdvar(objlist) { +set coord $fdobj($item,c) +set name $fdobj($item,n) +set wh "-width [expr 3+[lindex $coord 2]-[lindex $coord 0]] -height [expr 3+[lindex $coord 3]-[lindex $coord 1]]" +set visual 1 +switch $fdobj($item,t) { + button { + set cmd {} + catch {set cmd $fdobj($item,x)} + button $base.$name -borderwidth 1 -padx 0 -pady 0 -text "$fdobj($item,l)" -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -command [subst {$cmd}] + } + checkbox { + checkbutton $base.$name -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -text "$fdobj($item,l)" -variable "$fdobj($item,v)" -borderwidth 1 + set wh {} + } + query { set visual 0 + set procbody "proc $base.$name:execute {} {global dbc datasets ; set datasets($base.$name) \[pg_exec \$dbc \"$fdobj($item,x)\"\] ; set ceva \[$base.$name:fields\]}" + eval $procbody +# tk_messageBox -message $procbody + set procbody "proc $base.$name:nrecords {} {global datasets ; return \[pg_result \$datasets($base.$name) -numTuples\]}" + eval $procbody +# tk_messageBox -message $procbody + set procbody "proc $base.$name:close {} {global datasets ; pg_result \$datasets($base.$name) -clear}" + eval $procbody +# tk_messageBox -message $procbody + set procbody "proc $base.$name:fields {} {global datasets ; set fl {} ; foreach fd \[pg_result \$datasets($base.$name) -lAttributes\] {lappend fl \[lindex \$fd 0\]} ; set datasets($base.$name,fields) \$fl ; return \$fl}" +# tk_messageBox -message $procbody + eval $procbody + eval "proc $base.$name:movefirst {} {global datasets ; set datasets($base.$name,recno) 0}" + eval "proc $base.$name:movenext {} {global datasets ; incr datasets($base.$name,recno)}" + eval "proc $base.$name:moveprevious {} {global datasets ; incr datasets($base.$name,recno) -1 ; if {\$datasets($base.$name,recno)==-1} {$base.$name:movefirst}}" + eval "proc $base.$name:movelast {} {global datasets ; set datasets($base.$name,recno) \[expr \[$base.$name:nrecords\] -1\]}" + eval "proc $base.$name:updatecontrols {} {global datasets ; set i 0 ; foreach fld \$datasets($base.$name,fields) {catch {upvar $base.$name.\$fld dbvar ; set dbvar \[lindex \[pg_result \$datasets($base.$name) -getTuple \$datasets($base.$name,recno)\] \$i\]} ; incr i}}" + } + radio { + radiobutton $base.$name -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -text "$fdobj($item,l)" -variable "$fdobj($item,v)" -borderwidth 1 + set wh {} + } + entry { + set var {} ; catch {set var $fdobj($item,v)} + entry $base.$name -bo 1 -ba white -selectborderwidth 0 -highlightthickness 0 + if {$var!=""} {$base.$name configure -textvar $var} + } + label {set wh {} ; label $base.$name -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -anchor nw -padx 0 -pady 0 -text $fdobj($item,l)} + listbox {listbox $base.$name -borderwidth 1 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*} +} +if $visual {eval [subst "place $base.$name -x [expr [lindex $coord 0]-1] -y [expr [lindex $coord 1]-1] -anchor nw $wh -bordermode ignore"]} +} +} + + + proc {get_dwlb_Selection} {} { set temp [.dw.lb curselection] if {$temp==""} return ""; @@ -554,6 +931,9 @@ if {$retval} { } } + + + proc {mw_canvas_click} {x y} { global mw msg if {![mw_exit_edit]} return @@ -1069,13 +1449,8 @@ if {[catch {set newdbc [pg_connect $newdbname -host $newhost -port $newpport]} m } proc {open_form} {formname} { -global dbc - -set frmsrc {} -pg_select $dbc "select * from pga_forms where formname='$formname'" rec { - set frmsrc $rec(formsource) -} -eval $frmsrc + fd_load_form $formname run + fd_test } proc {open_function} {objname} { @@ -1960,12 +2335,6 @@ sql_exec noquiet "delete from pga_reports where reportname='$rbvar(reportname)'" sql_exec noquiet "insert into pga_reports (reportname,reportsource,reportbody) values ('$rbvar(reportname)','$rbvar(tablename)','$prog')" } -proc {main} {argc argv} { -global dbc -set dbc [pg_connect ultex] -rb_init -} - proc {save_pref} {} { global pref catch { @@ -2043,7 +2412,7 @@ place $w -x 7 place .dw.lmask -x 80 -y [expr 86+25*[lsearch -exact $tablist $curtab]] set activetab $curtab # Tabs where button Design is enabled -if {[lsearch {Scripts Queries Reports} $activetab]!=-1} { +if {[lsearch {Scripts Queries Reports Forms} $activetab]!=-1} { .dw.btndesign configure -state normal } .dw.lb delete 0 end @@ -2190,7 +2559,7 @@ proc vTclWindow.about {base} { label $base.l2 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -relief groove -text {A Tcl/Tk interface to PostgreSQL by Constantin Teodorescu} - label $base.l3 -borderwidth 0 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -relief sunken -text {vers 0.76} + label $base.l3 -borderwidth 0 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -relief sunken -text {vers 0.81} label $base.l4 -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -relief groove -text {You will always get the latest version at: http://www.flex.ro/pgaccess @@ -3642,6 +4011,424 @@ proc vTclWindow.tiw {base} { place $base.fr11.lif -x 10 -y 70 -width 178 -height 68 -anchor nw -bordermode ignore } +proc vTclWindow.fd {base} { + if {$base == ""} { + set base .fd + } + if {[winfo exists $base]} { + wm deiconify $base; return + } + ################### + # CREATING WIDGETS + ################### + toplevel $base -class Toplevel + wm focusmodel $base passive + wm geometry $base 377x315+185+234 + wm maxsize $base 785 570 + wm minsize $base 1 1 + wm overrideredirect $base 0 + wm resizable $base 1 1 + wm deiconify $base + wm title $base "Form design" + bind $base { + fd_delete_object + } + canvas $base.c \ + -background #828282 -height 207 -highlightthickness 0 -relief ridge \ + -selectborderwidth 0 -width 295 + bind $base.c { + fd_mouse_down %x %y + } + bind $base.c { + fd_mouse_up %x %y + } + bind $base.c { + fd_mouse_move %x %y + } + ################### + # SETTING GEOMETRY + ################### + pack $base.c \ + -in .fd -anchor center -expand 1 -fill both -side top +} + +proc vTclWindow.fda {base} { + if {$base == ""} { + set base .fda + } + if {[winfo exists $base]} { + wm deiconify $base; return + } + ################### + # CREATING WIDGETS + ################### + toplevel $base -class Toplevel + wm focusmodel $base passive + wm geometry $base 225x197+589+29 + wm maxsize $base 785 570 + wm minsize $base 1 1 + wm overrideredirect $base 0 + wm resizable $base 1 1 + wm deiconify $base + wm title $base "Attributes" + label $base.l1 \ + -anchor nw -borderwidth 0 \ + -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \ + -justify left -text Name -width 8 + entry $base.e1 \ + -background #fefefe -borderwidth 1 -highlightthickness 0 \ + -selectborderwidth 0 -textvariable fdvar(c_name) + bind $base.e1 { + fd_set_name + } + label $base.l2 \ + -anchor nw -borderwidth 0 \ + -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \ + -justify left -text Top -width 8 + entry $base.e2 \ + -background #fefefe -borderwidth 1 -highlightthickness 0 \ + -selectborderwidth 0 -textvariable fdvar(c_top) + bind $base.e2 { + fd_change_coord + } + label $base.l3 \ + -anchor w -borderwidth 0 \ + -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -text Left \ + -width 8 + entry $base.e3 \ + -background #fefefe -borderwidth 1 -highlightthickness 0 \ + -selectborderwidth 0 -textvariable fdvar(c_left) + bind $base.e3 { + fd_change_coord + } + label $base.l4 \ + -anchor w -borderwidth 0 \ + -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -text Width \ + -width 8 + entry $base.e4 \ + -background #fefefe -borderwidth 1 -highlightthickness 0 \ + -selectborderwidth 0 -textvariable fdvar(c_width) + bind $base.e4 { + fd_change_coord + } + label $base.l5 \ + -anchor w -borderwidth 0 \ + -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 0 \ + -text Height -width 8 + entry $base.e5 \ + -background #fefefe -borderwidth 1 -highlightthickness 0 \ + -selectborderwidth 0 -textvariable fdvar(c_height) + bind $base.e5 { + fd_change_coord + } + label $base.l6 \ + -borderwidth 0 \ + -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 0 \ + -text Command + entry $base.e6 \ + -background #fefefe -borderwidth 1 -highlightthickness 0 \ + -selectborderwidth 0 -textvariable fdvar(c_cmd) + bind $base.e6 { + fd_set_command + } + button $base.bcmd \ + -borderwidth 1 \ + -command {Window show .fdcmd +.fdcmd.f.txt delete 1.0 end +.fdcmd.f.txt insert end $fdvar(c_cmd)} \ + -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 3 \ + -pady 3 -text ... -width 1 + label $base.l7 \ + -anchor w -borderwidth 0 \ + -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \ + -text Variable -width 8 + entry $base.e7 \ + -background #fefefe -borderwidth 1 -highlightthickness 0 \ + -selectborderwidth 0 -textvariable fdvar(c_var) + bind $base.e7 { + set fdobj($fdvar(moveitemobj),v) $fdvar(c_var) + } + label $base.l8 \ + -anchor w -borderwidth 0 \ + -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -text Text \ + -width 8 + entry $base.e8 \ + -background #fefefe -borderwidth 1 -highlightthickness 0 \ + -selectborderwidth 0 -textvariable fdvar(c_text) + bind $base.e8 { + fd_set_text + } + label $base.l0 \ + -borderwidth 1 -relief raised -text {checkbox .udf0.checkbox17} \ + -textvariable fdvar(c_info) -width 28 + ################### + # SETTING GEOMETRY + ################### + grid $base.l1 \ + -in .fda -column 0 -row 1 -columnspan 1 -rowspan 1 + grid $base.e1 \ + -in .fda -column 1 -row 1 -columnspan 1 -rowspan 1 -pady 2 + grid $base.l2 \ + -in .fda -column 0 -row 2 -columnspan 1 -rowspan 1 + grid $base.e2 \ + -in .fda -column 1 -row 2 -columnspan 1 -rowspan 1 + grid $base.l3 \ + -in .fda -column 0 -row 3 -columnspan 1 -rowspan 1 + grid $base.e3 \ + -in .fda -column 1 -row 3 -columnspan 1 -rowspan 1 -pady 2 + grid $base.l4 \ + -in .fda -column 0 -row 4 -columnspan 1 -rowspan 1 + grid $base.e4 \ + -in .fda -column 1 -row 4 -columnspan 1 -rowspan 1 + grid $base.l5 \ + -in .fda -column 0 -row 5 -columnspan 1 -rowspan 1 + grid $base.e5 \ + -in .fda -column 1 -row 5 -columnspan 1 -rowspan 1 -pady 2 + grid $base.l6 \ + -in .fda -column 0 -row 6 -columnspan 1 -rowspan 1 + grid $base.e6 \ + -in .fda -column 1 -row 6 -columnspan 1 -rowspan 1 + grid $base.bcmd \ + -in .fda -column 2 -row 6 -columnspan 1 -rowspan 1 + grid $base.l7 \ + -in .fda -column 0 -row 7 -columnspan 1 -rowspan 1 + grid $base.e7 \ + -in .fda -column 1 -row 7 -columnspan 1 -rowspan 1 + grid $base.l8 \ + -in .fda -column 0 -row 8 -columnspan 1 -rowspan 1 + grid $base.e8 \ + -in .fda -column 1 -row 8 -columnspan 1 -rowspan 1 -pady 2 + grid $base.l0 \ + -in .fda -column 0 -row 0 -columnspan 2 -rowspan 1 +} + +proc vTclWindow.fdcmd {base} { + if {$base == ""} { + set base .fdcmd + } + if {[winfo exists $base]} { + wm deiconify $base; return + } + ################### + # CREATING WIDGETS + ################### + toplevel $base -class Toplevel + wm focusmodel $base passive + wm geometry $base 282x274+616+367 + wm maxsize $base 785 570 + wm minsize $base 1 19 + wm overrideredirect $base 0 + wm resizable $base 1 1 + wm title $base "Command" + frame $base.f \ + -borderwidth 2 -height 75 -relief groove -width 125 + scrollbar $base.f.sb \ + -borderwidth 1 -command {.fdcmd.f.txt yview} -orient vert -width 12 + text $base.f.txt \ + -font -*-Clean-Medium-R-Normal--*-130-*-*-*-*-*-* -height 1 \ + -width 115 -yscrollcommand {.fdcmd.f.sb set} + frame $base.fb \ + -height 75 -width 125 + button $base.fb.b1 \ + -borderwidth 1 \ + -command {set fdvar(c_cmd) [.fdcmd.f.txt get 1.0 "end - 1 chars"] +Window hide .fdcmd +fd_set_command} \ + -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 \ + -pady 3 -text Ok -width 5 + button $base.fb.b2 \ + -borderwidth 1 -command {Window hide .fdcmd} \ + -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 \ + -pady 3 -text Cancel + ################### + # SETTING GEOMETRY + ################### + pack $base.f \ + -in .fdcmd -anchor center -expand 1 -fill both -side top + pack $base.f.sb \ + -in .fdcmd.f -anchor e -expand 1 -fill y -side right + pack $base.f.txt \ + -in .fdcmd.f -anchor center -expand 1 -fill both -side top + pack $base.fb \ + -in .fdcmd -anchor center -expand 0 -fill none -side top + pack $base.fb.b1 \ + -in .fdcmd.fb -anchor center -expand 0 -fill none -side left + pack $base.fb.b2 \ + -in .fdcmd.fb -anchor center -expand 0 -fill none -side top +} + +proc vTclWindow.fdmenu {base} { + if {$base == ""} { + set base .fdmenu + } + if {[winfo exists $base]} { + wm deiconify $base; return + } + ################### + # CREATING WIDGETS + ################### + toplevel $base -class Toplevel + wm focusmodel $base passive + wm geometry $base 288x70+193+129 + wm maxsize $base 785 570 + wm minsize $base 1 1 + wm overrideredirect $base 0 + wm resizable $base 0 0 + wm deiconify $base + wm title $base "Commands" + button $base.but17 \ + -borderwidth 1 \ + -command {if {[tk_messageBox -title Warning -message "Delete all objects ?" -type yesno -default no]=="no"} return +fd_init} \ + -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 \ + -pady 3 -text {Delete all} + button $base.but18 \ + -borderwidth 1 -command {set fdvar(geometry) [wm geometry .fd] ; fd_test } \ + -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 \ + -pady 3 -text {Test form} + button $base.but19 \ + -borderwidth 1 -command {destroy .$fdvar(forminame)} \ + -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 \ + -pady 3 -text {Close test form} + button $base.bex \ + -borderwidth 1 \ + -command {if {[fd_save_form $fdvar(formname)]==1} { +catch {Window destroy .fd} +catch {Window destroy .fdtb} +catch {Window destroy .fdmenu} +catch {Window destroy .fda} +catch {Window destroy .fdcmd} +catch {Window destroy .$fdvar(forminame)} +}} \ + -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* -padx 9 \ + -pady 3 -text Close + button $base.bload \ + -borderwidth 1 -command {fd_load_form nimic design} \ + -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -padx 9 \ + -pady 3 -text {Load from database} + button $base.button17 \ + -borderwidth 1 -command {fd_save_form nimic} \ + -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -padx 9 \ + -pady 3 -text Save + label $base.l1 \ + -borderwidth 0 \ + -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* \ + -text {Form name} + entry $base.e1 \ + -background #fefefe -borderwidth 1 -highlightthickness 0 \ + -selectborderwidth 0 -textvariable fdvar(formname) + label $base.l2 \ + -borderwidth 0 \ + -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* \ + -text {Form's window internal name} + entry $base.e2 \ + -background #fefefe -borderwidth 1 -highlightthickness 0 \ + -selectborderwidth 0 -textvariable fdvar(forminame) + ################### + # SETTING GEOMETRY + ################### + place $base.but17 \ + -x 5 -y 80 -width 62 -height 24 -anchor nw -bordermode ignore + place $base.but18 \ + -x 5 -y 45 -width 62 -height 24 -anchor nw -bordermode ignore + place $base.but19 \ + -x 70 -y 45 -width 94 -height 24 -anchor nw -bordermode ignore + place $base.bex \ + -x 230 -y 45 -height 24 -anchor nw -bordermode ignore + place $base.bload \ + -x 75 -y 80 -width 114 -height 23 -anchor nw -bordermode ignore + place $base.button17 \ + -x 165 -y 45 -width 44 -height 24 -anchor nw -bordermode ignore + place $base.l1 \ + -x 5 -y 5 -anchor nw -bordermode ignore + place $base.e1 \ + -x 75 -y 5 -width 193 -height 17 -anchor nw -bordermode ignore + place $base.l2 \ + -x 5 -y 25 -anchor nw -bordermode ignore + place $base.e2 \ + -x 175 -y 25 -width 60 -height 17 -anchor nw -bordermode ignore +} + +proc vTclWindow.fdtb {base} { + if {$base == ""} { + set base .fdtb + } + if {[winfo exists $base]} { + wm deiconify $base; return + } + ################### + # CREATING WIDGETS + ################### + toplevel $base -class Toplevel + wm focusmodel $base passive + wm geometry $base 90x152+65+180 + wm maxsize $base 785 570 + wm minsize $base 1 1 + wm overrideredirect $base 0 + wm resizable $base 1 1 + wm deiconify $base + wm title $base "Toolbar" + radiobutton $base.rb1 \ + -anchor w -borderwidth 1 \ + -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \ + -highlightthickness 0 -text Point -value point -variable fdvar(tool) \ + -width 9 + radiobutton $base.rb2 \ + -anchor w -borderwidth 1 \ + -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \ + -foreground #000000 -highlightthickness 0 -selectcolor #0000ee \ + -text Label -value label -variable fdvar(tool) -width 9 + radiobutton $base.rb3 \ + -anchor w -borderwidth 1 \ + -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \ + -highlightthickness 0 -text Entry -value entry -variable fdvar(tool) \ + -width 9 + radiobutton $base.rb4 \ + -anchor w -borderwidth 1 \ + -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \ + -highlightthickness 0 -text Button -value button \ + -variable fdvar(tool) -width 9 + radiobutton $base.rb5 \ + -anchor w -borderwidth 1 \ + -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-* \ + -highlightthickness 0 -text {List box} -value listbox \ + -variable fdvar(tool) -width 9 + radiobutton $base.rb6 \ + -anchor w -borderwidth 1 \ + -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* \ + -highlightthickness 0 -text {Check box} -value checkbox \ + -variable fdvar(tool) -width 9 + radiobutton $base.rb7 \ + -anchor w -borderwidth 1 \ + -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* \ + -highlightthickness 0 -text {Radio btn} -value radio \ + -variable fdvar(tool) -width 9 + radiobutton $base.rb8 \ + -anchor w -borderwidth 1 \ + -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* \ + -highlightthickness 0 -text Query -value query -variable fdvar(tool) \ + -width 9 + ################### + # SETTING GEOMETRY + ################### + grid $base.rb1 \ + -in .fdtb -column 0 -row 0 -columnspan 1 -rowspan 1 + grid $base.rb2 \ + -in .fdtb -column 0 -row 1 -columnspan 1 -rowspan 1 + grid $base.rb3 \ + -in .fdtb -column 0 -row 2 -columnspan 1 -rowspan 1 + grid $base.rb4 \ + -in .fdtb -column 0 -row 3 -columnspan 1 -rowspan 1 + grid $base.rb5 \ + -in .fdtb -column 0 -row 4 -columnspan 1 -rowspan 1 + grid $base.rb6 \ + -in .fdtb -column 0 -row 5 -columnspan 1 -rowspan 1 + grid $base.rb7 \ + -in .fdtb -column 0 -row 6 -columnspan 1 -rowspan 1 + grid $base.rb8 \ + -in .fdtb -column 0 -row 7 -columnspan 1 -rowspan 1 +} + Window show . Window show .dw diff --git a/src/bin/pgaccess/qbtclet.html b/src/bin/pgaccess/qbtclet.html new file mode 100644 index 0000000000..b990c0f15c --- /dev/null +++ b/src/bin/pgaccess/qbtclet.html @@ -0,0 +1,45 @@ + + + Visual Query Builder in Tcl/Tk + +

    Visual Query Builder

    +
    +This visual query builder is included in +PgAccess, a visual interface to + PostgreSQL written entirely in +vTcl , (Visual Tcl). + + +

    + + + +

    + +
    + + +Visual Query Designer demo
    +Click here to download the source +created by Constantin Teodorescu with vTcl (visual Tcl), teo@flex.ro +
    +Facitilies
    + - drag and drop selection of fields
    + - drag and drop fields from a table to another do create links
    + - move table position by dragging
    + - point and click any link or table then press delete to delete them
    + - modify sort order by clicking on (unsorted)
    + - enter filter conditions as criteria (>2000 , ='item')
    + - easy panning of table and result panels
    + - show SQL command
    +
    +If you want to use it for your database, modify ql_read_struct in order to read + your table structure. +
    +Feel free to use, modify or copy this software for non-commercial purposes.
    +In any other case, please contact me. +
    +FLEX Consulting Braila, ROMANIA is able to deliver high end interfaces +and any other commercial products written in Tcl/Tk just like that you have seen. + +