Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Grygonos's scratchpad

by Grygonos (Chaplain)
on Jun 01, 2004 at 23:42 UTC ( #358833=scratchpad: print w/ replies, xml ) Need Help??

This is the main sub. it calls selectClient
sub main { #Database login information my %login = (dsn =>'dbi:ODBC:driver=SQL Server;server=X;databa +se=dbname', id =>'login', password=>'password', attrib =>{RaiseError=>1, PrintError=>1, AutoCommit=>0}); #Connect to the database my $dbh = DBI->connect($login{'dsn'}, $login{'id'}, $login{'password'}, $login{'attrib'}); my $mw = MainWindow->new(-borderwidth=>10); my $client = selectClient($dbh,$mw); $dbh->disconnect(); }
sub selectClient { my ($dbh,$mw) = @_; my $client = undef; my @validClients = (); $mw->configure(-title=>'Duplicates'); #Create the Tk::BrowseEntry widget and bind its value to $client my $clients = $mw->BrowseEntry(-variable=>\$client, -label=>'Choose a Client'); my $button = $mw->Button(-text=>'Submit', -width=>20); $button->configure(-command=>[\&validate,\@validClients,\$client,$ +mw,$dbh,$button,$clients]); #Prepare statement to retrieve clients my $sth = $dbh->prepare(q{SELECT ClientCode FROM Clients WITH (NOLOCK)}); + $sth->execute(); #Grab each Client while(my $rec = $sth->fetchrow_hashref('NAME_lc')) + { #add it to the list of clients push @validClients,$rec->{'clientcode'}; #add it to the clients listbox $clients->insert('end',$rec->{'clientcode'}); } #Pack the widgets $clients->pack(-pady=>5); $button->pack(-pady=>5); MainLoop(); return $client; }
The callback for submit calls validate. Which then in turn packForget's the two widgets and drops a button menu on the mainwindow when it succeeds.
sub validate { my ($valid,$client,$mw,$dbh,$button,$browse) = @_; if(!$$client) { errorDisplay($mw,"You must select a client!"); } else { my $isValid = 0; foreach(@{$valid}) { if($_ eq $$client) { $isValid = 1; last; } } errorDisplay($mw,"Invalid Selection. Please use the drop-down +!") if !$isValid ; if($isValid) { $button->packForget(); $browse->packForget(); #gui start ... coming up... guiStart($client,$dbh,$mw); } } return; }

Now... gui start... this is what reformats the MainWindow and drops the buttons on it so that the user can choose what they want to do.

Now what happens here is I create all the widgets that will be used in the button callbacks and pass them into the callbacks ... so the callbacks themselves aren't creating and destroying widgets on the fly (thus consuming more memory (at least in Task Managers opinion on Win32)

sub guiStart { my ($client,$dbh,$mw) = @_; $mw->configure(-title=>"Duplicates: ".$$client, -borderwidth=>30); #Create the dialog box to be passed around my $dlg = $mw->DialogBox(-title=>'Default', -buttons =>['1','0'], -borderwidth=>5); #DialogBox to be used for errors my $err = $mw->DialogBox(-title=>'Error!', -borderwidth=>5); my $list_12_12 = $dlg->Scrolled('Listbox', -scrollbars=>'oe os', -background=>'black', -foreground=>'white', -height =>12, -width =>12); my $list_20_40 = $dlg->Scrolled('Listbox', -scrollbars=>'oe os', -background=>'black', -foreground=>'white', -height =>20, -width =>40); my $label = $dlg->Label(-text=>'default'); my $errLabel = $err->Label(-text=>'default')->pack(); #30 width LabEntry widget my $labE_one = $dlg->LabEntry(-labelPack =>[qw{-side left -anch +or w}], -background =>'white'); #26 width LabEntry widget my $labE_two = $dlg->LabEntry(-labelPack =>[qw{-side left -anch +or w}], -background =>'white'); my @buttons = ({'List Available Data' => [\&listData,$client, $dbh, $dlg, $list_12_12]} +, {'Remove Data' => [\&removeData,$client, $dbh, $dlg, $list_12_12 +, $label, $err, $errLabel]} +, {'Add Data' => [\&addData,$client, $dbh, $dlg, $list_20_40, $label, $labE_one, $labE_two, $err, $errLabel]}, {'Identify Duplicates' => [\&identifyDuplicates,$cl +ient, $db +h, $dl +g, $er +r, $er +rLabel]}, {'Exit Application' => sub{$mw->destroy()}}); for my $i (0..$#buttons) { for(keys(%{$buttons[$i]})) { $mw->Button(-text =>$_, -width =>20, -command=>$buttons[$i]->{$_})->pack(); } } $mw->deiconify(); return; }
now for the callbacks....

this one is &listData

sub listData { my ($client,$dbh,$dlg,$list) = @_; #retrieve a list of tapeID numbers for a client my @tapes = getTapes($client,$dbh); #Create a DialogBox $dlg->configure(-title=>"Tapes for ".$$client); $dlg->Subwidget('B_1')->configure(-text=>'OK'); $dlg->Subwidget('B_0')->packForget(); #attempt to configure it with noticably larger values as to sh +ow the change. $list->configure(-height=>40,-width=>40); #Populate the scrolled listbox with tape numbers $list->insert('end',$_) for @tapes; $list->pack(); + #Show the dialog $dlg->Show(); initDialog($dlg); initList($list); return; }
ok ... I forgot something.. initDialog and initList subs looks like this ...
sub initDialog { my $dlg = shift; #Configure the dialog's title $dlg->configure(-title=>'default'); for ('B_0','B_1') { #Set button text to default $dlg->Subwidget($_)->configure(-text=>'default') ; #Unpack the widget (safety net) $dlg->Subwidget($_)->packForget(); } #Repack the widgets $dlg->Subwidget('B_0')->pack(-side =>'right', -expand=>1); $dlg->Subwidget('B_1')->pack(-side =>'left', -expand=>1); return; } sub initList { my $list = shift; #Remove the list from the packing order $list->packForget(); #Remove all elements from the list $list->delete('end') for(0..$list->size); $list->configure(-height=>1,-width=>1); #Unbind the double click binding $list->bind('<Double-1>',''); return; }

those are called at the end of the callback to clean up the messes made on the widget and the main window.

Ok next callback.. jsut for example sake.
sub removeData { my ($client,$dbh,$dlg,$list,$label,$err) = @_; #Get a list of tapeID values for a client my @tapes = getTapes($client,$dbh); #Create a DialogBox $dlg->configure(-title=>"Delete tape for: ".$$client); + #small values just to test; $list->configure(-height=>5,-width=>5); #Configure the button text $dlg->Subwidget('B_1')->configure(-text=>'Delete'); $dlg->Subwidget('B_0')->configure(-text=>'Cancel'); #Insert the tape numbers $list->insert('end',$_) for @tapes; + $list->pack(); #Show the remove dialog and save the return value my $show_value = $dlg->Show(); #If the user chose Delete and selected an item from the listbox if($show_value && ($list->curselection())) { #Retrieve the item selected my $num = $list->get($list->curselection()); #reinit the listbox initList($list); #Reconfigure the dialog title $dlg->configure(-title=>'Delete Confirmation!'); #Reconfigure the dialog button text $dlg->Subwidget('B_1')->configure(-text=>'Yes'); $dlg->Subwidget('B_0')->configure(-text=>'No'); #Configure and pack the label $label->configure(-text=>"Tape:".$num." will be deleted. Are +you sure?"); $label->pack(); #On Yes if($dlg->Show()) { #Attempt a tape delete and store the success value in $suc +cess my $success = deleteTape($client,\$num,$dbh); #Reconfigure the title of the dialog $dlg->configure(-title=>'Removal Status'); #Reconfigure the label's text based on the value of $succe +ss $label->configure(-text=>($success? 'Tape removed successf +ully!': 'Error during removal, + tape not removed!')); #Remove the 2nd button $dlg->Subwidget('B_0')->packForget(); #Reconfigure the text on the 1st button $dlg->Subwidget('B_1')->configure(-text=>'OK'); #Show the dialog $dlg->Show(); } } #If the user chose Delete and did not select and item from the lis +tbox elsif($show_value && !$list->curselection()) { #reinit the listbox initList($list); #Configure and pack the label $label->configure(-text=>'Select a tape number!'); $label->pack(); #Reconfigure the title of the dialog $dlg->configure(-title=>'Error!'); #Remove the 2nd button $dlg->Subwidget('B_0')->packForget(); #Reconfigure the text on the 1st button $dlg->Subwidget('B_1')->configure(-text=>'OK'); #Show the dialog $dlg->Show(); } #If the user clicks Cancel else { #reinit the listbox initList($list); #Make a new label $label->configure(-text=>'Data Removal Aborted Successfully.') +; $label->pack(); #Reconfigure the title of the dialog $dlg->configure(-title=>'Abort!'); #Remove the 2nd button $dlg->Subwidget('B_0')->packForget(); #Reconfigure the text on the 1st button $dlg->Subwidget('B_1')->configure(-text=>'OK'); #Show the dialog $dlg->Show(); } initLabel($label); initDialog($dlg); return; }
You'll notice I created two listboxes to solve the problem... the two callbacks I listed both use $list_12_12...but you can see I'm trying to modify them just for sake of doing it... I think it might be something with dialogs.. packing them.. finishing.. and then attempting to repack and configure them... Ok now ... anyone know whats wrong?
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (6)
As of 2014-11-27 17:52 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (186 votes), past polls