;+ ; NAME: ; FSC_FILESELECT ; ; PURPOSE: ; ; The purpose of this compound widget is to provide a means ; by which the user can type or select a file name. The ; program is written as an "object widget", meaning that ; the guts of the program is an object of class FSC_FILESELECT. ; This is meant to be an example of the obvious advantages of ; writing compound widget programs as objects. ; ; AUTHOR: ; ; FANNING SOFTWARE CONSULTING ; David Fanning, Ph.D. ; 1645 Sheely Drive ; Fort Collins, CO 80526 USA ; Phone: 970-221-0438 ; E-mail: david@idlcoyote.com ; Coyote's Guide to IDL Programming: http://www.idlcoyote.com/ ; ; CATEGORY: ; ; General programming. ; ; CALLING SEQUENCE: ; ; filenameID = FSC_FileSelect(parent) ; ; INPUT PARAMETERS: ; ; parent -- The parent widget ID of the compound widget. Required. ; ; INPUT KEYWORDS: ; ; Event_Pro -- The event handler procedure for this compound widget.By default: "". ; Event_Func -- The event handler function for this compound widget. By default: "". ; ; If neither EVENT_PRO or EVENT_FUNC is defined, program events are handled internally by the compound widget. ; ; DirectoryName -- The initial name of the directory. By defaut: current directory. ; Filename -- The initial file name in the filename text widget. ; Filter -- The file filter. By default: "*". ; Frame -- Set this keyword for a frame around the compound widget. ; LabelFont -- The font for the label widget. By default: "". ; LabelName -- The text on the label widgt. By default: "Filename: ". ; LabelSize -- The X screen size of the label widget. By default: 0. ; MustExist -- A flag that indicates selected files must exist. By default: 0. ; NoMaxSize -- A flag to prohibit automatic text widget sizing. By default: 0. ; ; If this keyword is not set, the compound widget will automatically resize itself to ; the largest widget in its parent base widget. It will do this by changing the size of ; the text widgets holding the file and directory names. ; ; Read -- Set this keyword to have file selection for reading a file. By default: 1. ; SelectDirectory -- The default directory for file selection. In other words, this is the ; default directory for DIALOG_PICKFILE, which is accessed via the BROWSE buttons. ; SelectFont -- The font for the "Browse" button. By default: "". ; SelectTitle -- The title bar text on the file selection dialog. By default: "Select a File...". ; TextFont -- The font for the filename text widget. By default: "". ; UValue -- User value for any purpose. ; Write -- Set this keyword to open a file for writing. By default: 0. ; XSize -- The X size of the text widget holding the filename. By default: StrLen(filename) * 1.5 > 40. ; ; OUTPUT KEYWORDS: ; ; ObjectRef -- Assign this keyword to an output variable that will hold the internal object reference. ; With the object reference you can call object methods to easily change many properties of ; the compound widget. ; ; COMMON BLOCKS: ; ; None. ; ; EVENT STRUCTURE: ; ; All events are handled internally unless either the Event_Pro or Event_Func ; keywords are used to assign an event handler to the compound widget. All events ; generated by the text widgets are passed to the assigned event handler. ; ; event = { CW_FILESELECT, $ ; The name of the event structure. ; ID: 0L, $ ; The ID of the compound widget's top-level base. ; TOP: 0L, $ ; The widget ID of the top-level base of the hierarchy. ; HANDLER: 0L, $ ; The event handler ID. Filled out by IDL. ; Basename: "", $ ; The base filename without directory specifiers. ; Filename: "", $ ; The fully qualified filename. ; Directory: "", $ ; The name of the current file directory. ; } ; ; EXAMPLE: ; ; An example program is provided at the end of the FSC_FILESELECT code. To run it, ; type these commands: ; ; IDL> .Compile fsc_fileselect ; IDL> Example ; ; Or, if you want to obtain the object reference, type this: ; ; IDL> Example, theObject ; ; Now you can call the object's methods. For example: ; ; IDL theObject->SetProperty, XSize=150 ; ; GETTING and SETTING VALUES: ; ; So as not to disrupt the accepted paradigm in using compound widgets, you ; can use the return value of the FSC_FILESELECT function with WIDGET_CONTROL to ; get and set the "value" of the widget. ; ; Widget_Control, filenameID, Set_Value='C:\RSI\IDL52\DATA\cyclone.dat' ; ; The program will automatically separate the file name portion of the value ; from the directory portion and put things in the correct text widgets. ; ; Similarly, you can get the "value" of the widget: ; ; Widget_Control, filenameID, Get_Value=theValue ; Print, theValue ; ; C:\RSI\IDL52\DATA\cyclone.dat ; ; The return value is the fully qualified file path to the file. ; ; USING OBJECT METHODS to CHANGE PROGRAM PROPERTIES: ; ; If you obtain the object reference, you have a great deal more control ; over the properties of the compound widget. You obtain the object reference ; by calling the function like this: ; ; filenameID = FSC_FILESELECT(parent, ObjectRef=theObject) ; ; OBJECT PROCEDURE METHODS: ; ; GetProperty -- This method allows various properties of the widget to be ; returned via output keywords. The keywords that are available are: ; ; DirectoryName -- The current directory. ; Event_Func -- The name of the event handler function for this compound widget. ; Event_Pro -- The name of the event handler procedure for this compound widget. ; Filename -- The current base filename. ; Filter -- The current file filter. ; LabelName -- The text on the label widget. ; LabelSize -- The X screen size of the label widget. ; MustExist -- A flag that indicates selected files must exist to be selected. ; Parent -- The parent widget of the compound widget. ; Read=read -- The file selection for reading flag. ; SelectTitle -- The title bar text on the file selection dialog. ; TLB -- The top-level base of the compound widget. ; UValue -- The user value of the compound widget. ; Write -- The file selection for writing flag. ; XSize -- The X size of the text widget holding the filename. ; ; LabelSize -- This method makes sure that the directory name and file name labels ; are the same size. Normally, this procedure is called internally. No parameters. ; ; MatchSize -- This method resizes the compound widget so that it is as long as the ; the longest widget in the parent base widget. This is done automatically upon ; realization unless the NOMAXSIZE keyword is set. The method aids in writing ; resizeable widget programs. ; ; SetProperty -- This method allows various properties of the widget to be ; set via input keywords. The keywords that are available are: ; ; DirectoryName -- The current directory. ; Event_Func -- The name of the event handler function for this compound widget. ; Event_Pro -- The name of the event handler procedure for this compound widget. ; Filename -- The current base filename. ; Filter -- The current file filter. ; LabelName -- The text on the label widget. ; LabelSize -- The X screen size of the label widget. ; MustExist -- A flag that indicates selected files must exist to be selected. ; Read -- The file selection for reading flag. ; SelectTitle -- The title bar text on the file selection dialog. ; UValue -- The user value of the compound widget. ; Write -- The file selection for writing flag. ; XSize -- The X size of the text widget holding the filename. ; ; TextSelect - Allows you to create a selection in filename text widget. See the ; documentation for the SET_TEXT_SELECT keyword to Widget_Control. ; ; selection -- A two-element array containing the starting position and selection length. ; ; OBJECT FUNCTION METHODS: ; ; GetFileName -- Returns the fully qualified filename. No parameters. ; ; GetTLB -- Returns the top-level base ID of the compound widget. No Parameters. ; ; Inspect_DirectoryName -- Inspects the directory name for correctness. Requires one positional parameter. ; ; directoryName -- The name of the directory from the directory text widget. ; textSelection -- The current text selection position. ; ; At the moment all this does is remove any blank characters from either ; end of the directory name and makes sure the last character of the directory ; name does not end in a subdirectory specifier (except for VMS). ; ; Inspect_Filename -- Inspects the file name for correctness. Requires one positional parameter. ; ; filename -- The name of the file from the filename text widget. ; textSelection -- The current text selection position. ; ; At the moment all this does is remove any blank characters from either ; end of the file name ; ; MODIFICATION HISTORY: ; ; Written by: David W. Fanning, 21 NOV 1999. ; Fixed bug in File Name selection button. 18 MAR 2000. DWF. ; Fixed an error in which directory the Browse buttons should start ; searching. 29 SEP 2000. DWF. ; Previously returned events only for typing in text widgets. Now ; Browse button events are also returned. 29 SEP 2000. DWF. ; Fixed a bug in setting the file filter. 29 SEP 2000. DWF. ; Removed the Directory Browse button 10 AUG 2002. DWF. ; Added cgErrorMsg to error handling. 10 AUG 2002. DWF. ; Changed the ability to specify a file filter as a string array, instead ; of just as a scalar string. This required the use of a pointer, which ; meant that I had to remove the FILTER field from the CW_FILESELECT ; event structure to avoid likely memory leakage. This is a dangerous ; change because it means programs that relied on this (I expect there ; are very, very few) will break and it goes against my philosopy of ; keeping my programs backward compatible. Let me know if you have ; problems. In testing, I discoved no problems in my own code. 31 OCT 2002. DWF. ; Fixed a problem with DIALOG_PICKFILE that sometimes allowed users to change ; directories without selecting a file. 3 Nov 2002. DWF. ; Fixed a problem with widget resizing with the help of Bob Portman that had plagued ; me from the beginning. Thanks, Bob! 5 August 2003. DWF ; Added TEXTSELECT method. 5 Aug 2003. DWF. ; Had to add FORWARD_FUNCTION statement to get error handler compiled when using ; DIRECTORY keyword. 24 Nov 2003. DWF. ; Fixed a problem with too many events going to an event handler specified with ; the EVENT_PRO or EVENT_FUNC keyword from the text widget. Now only Carriage ; Return events are passed on to the user-specified event handler. 8 July 2004. DWF. ; Replace all "\" characters with "/" characters in directory names. 8 Januay 2006. DWF. ; Set the default fonts to be the current widget font, rather than the default widget font. 4 Oct 2008. DWF. ;- ; ;******************************************************************************************; ; Copyright (c) 2008, by Fanning Software Consulting, Inc. ; ; All rights reserved. ; ; ; ; Redistribution and use in source and binary forms, with or without ; ; modification, are permitted provided that the following conditions are met: ; ; ; ; * Redistributions of source code must retain the above copyright ; ; notice, this list of conditions and the following disclaimer. ; ; * Redistributions in binary form must reproduce the above copyright ; ; notice, this list of conditions and the following disclaimer in the ; ; documentation and/or other materials provided with the distribution. ; ; * Neither the name of Fanning Software Consulting, Inc. nor the names of its ; ; contributors may be used to endorse or promote products derived from this ; ; software without specific prior written permission. ; ; ; ; THIS SOFTWARE IS PROVIDED BY FANNING SOFTWARE CONSULTING, INC. ''AS IS'' AND ANY ; ; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES ; ; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT ; ; SHALL FANNING SOFTWARE CONSULTING, INC. BE LIABLE FOR ANY DIRECT, INDIRECT, ; ; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED ; ; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; ; ; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ; ; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ; ; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ; ; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ; ;******************************************************************************************; FUNCTION FSC_Fileselect_WidgetFont, DEFAULT=default ; Build a small widget to determine the current ; and default widget fonts. base = Widget_Base(MAP=0) button = Widget_Button(base, Value='TEST') ; Checking before realization gives default font. defaultFont = Widget_Info(button, /FONTNAME) ; Checking after realization gives current font. Widget_Control, base, /REALIZE currentFont = Widget_Info(button, /FONTNAME) ; Clean up. Widget_Control, base, /DESTROY IF Keyword_Set(default) THEN $ RETURN, defaultFont ELSE $ RETURN, currentFont END ;----------------------------------------------------------------------------------------------------------------------------- PRO FSC_FileSelect::Directory_Events, event ; This method handles any typing in the directory name text widget. Catch, theError IF theError NE 0 THEN BEGIN ok = cgErrorMsg(/Traceback) RETURN ENDIF ; Don't deal with selection events. IF event.type EQ 3 THEN RETURN ; Inspect the directory name and set it. Widget_Control, self.dirtextID, Get_Value=dirname dirname = dirname[0] textSelection = Widget_Info(self.dirtextID, /Text_Select) dirname = self->Inspect_DirectoryName(dirname, textSelection[0]) ; See notes in INIT method. ;;;dirname = StrJoin( StrSplit(dirname, '\\', /Regex, /Extract, /Preserve_Null), '/') self.directoryname = dirname END ;----------------------------------------------------------------------------------------------------------------------------- PRO FSC_FileSelect::Filename_Events, event ; This method handles any typing in the file name text widget. Catch, theError IF theError NE 0 THEN BEGIN ok = cgErrorMsg(/Traceback) RETURN ENDIF ; Don't deal with selection events. IF event.type EQ 3 THEN RETURN ; Inspect the file name and set it. Widget_Control, self.filetextID, Get_Value=filename filename = filename[0] textSelection = Widget_Info(self.filetextID, /Text_Select) filename = self->Inspect_Filename(filename, textSelection[0]) ; See notes in INIT method. ;;;filename = StrJoin( StrSplit(filename, '\\', /Regex, /Extract, /Preserve_Null), '/') self.filename = filename END ;----------------------------------------------------------------------------------------------------------------------------- FUNCTION FSC_FileSelect::GetFilename ; This method returns the fully-qualified filename. Checks to be ; sure the last character in the directory name is not a directory ; specifier. Catch, theError IF theError NE 0 THEN BEGIN ok = cgErrorMsg() RETURN, -1 ENDIF ; Get the correct directory separator. CASE StrUpCase(!Version.OS_Family) OF 'MACOS' : sep = ':' ; Macintoshes 'VMS' : sep = ']' ; VMS machines ELSE : sep = '/' ; Unix machines ENDCASE IF StrUpCase(!Version.OS_Family) NE "VMS" THEN BEGIN length = StrLen(self.directoryName) WHILE StrMid(self.directoryName, length-1, 1) EQ sep DO BEGIN self.directoryName = StrMid(self.directoryName, 0, length-1) Widget_Control, self.dirTextID, Set_Value=self.directoryName length = StrLen(self.directoryName) ENDWHILE ENDIF filename = Filepath(Root_Dir=self.directoryName, self.filename) ; See notes in INIT method. ;;filename = StrJoin( StrSplit(filename, '\\', /Regex, /Extract, /Preserve_Null), '/') RETURN, filename END ;------------------------------------------------------------------------------- FUNCTION FSC_FileSelect::GetNoMaxSize RETURN, self.nomaxsize END ;----------------------------------------------------------------------------------------------------------------------------- PRO FSC_FileSelect::GetProperty, $ DirectoryName=dirname, $ ; The current directory. Event_Func=event_func, $ ; The name of the event handler function for this compound widget. Event_Pro=event_pro, $ ; The name of the event handler procedure for this compound widget. Filename=filename, $ ; The current filename. Filter=filter, $ ; The current file filter. LabelName=labelname, $ ; The text on the label widget. LabelSize=labelsize, $ ; The X screen size of the label widget. MustExist=mustexist, $ ; A flag that indicates selected files must exist to be selected. Parent=parent, $ ; The parent widget of the compound widget. Read=read, $ ; The file selection for reading flag. SelectTitle=selecttitle, $ ; The title bar text on the file selection dialog. TLB=tlb, $ ; The top-level base of the compound widget. UValue=uvalue, $ ; The user value of the compound widget. Write=write, $ ; The file selection for writing flag. XSize=xsize ; The X size of the text widget holding the filename. Catch, theError IF theError NE 0 THEN BEGIN ok = cgErrorMsg() RETURN ENDIF dirname = self.directoryname event_pro = self.event_pro event_func = self.event_func filename = self.filename filter = *self.filter labelname = self.labelname labelsize = self.labelsize mustexist = self.mustexist parent=self.parent read = self.read selecttitle = self.selecttitle tlb = self.tlb uvalue = *self.uvalue wirte = self.write xsize = self.xsize END ;----------------------------------------------------------------------------------------------------------------------------- FUNCTION FSC_FileSelect::GetTLB RETURN, self.tlb END ;----------------------------------------------------------------------------------------------------------------------------- FUNCTION FSC_FileSelect::Inspect_DirectoryName, dirname, textSelection ; This method removes leading and trailing blank characters ; in the directory name. Catch, theError IF theError NE 0 THEN BEGIN ok = cgErrorMsg() RETURN, -1 ENDIF thisDir = StrTrim(dirname, 2) IF StrLen(thisDir) NE StrLen(dirname) THEN $ textSelection = textSelection-( StrLen(dirname) - StrLen(thisDir) ) Widget_Control, Set_Value=thisDir, self.dirtextID, Set_Text_Select=[textSelection, 0] RETURN, thisDir END ;----------------------------------------------------------------------------------------------------------------------------- FUNCTION FSC_FileSelect::Inspect_Filename, filename, textSelection ; This method removes leading and trailing blank characters ; in the filename. Catch, theError IF theError NE 0 THEN BEGIN Catch, /Cancel ok = cgErrorMsg() RETURN, -1 ENDIF thisFile = StrTrim(filename, 2) IF StrLen(thisFile) NE StrLen(filename) THEN $ textSelection = textSelection-( StrLen(filename) - StrLen(thisFile) ) Widget_Control, Set_Value=thisFile, self.filetextID, Set_Text_Select=[textSelection, 0] RETURN, thisFile END ;----------------------------------------------------------------------------------------------------------------------------- PRO FSC_FileSelect::LabelSize ; This method ensures the directory and filename labels are the same size. Catch, theError IF theError NE 0 THEN BEGIN ok = cgErrorMsg() RETURN ENDIF fgeo = Widget_Info(self.filelabelID, /Geometry) dgeo = Widget_Info(self.dirlabelID, /Geometry) bestSize = fgeo.scr_xsize > dgeo.scr_xsize Widget_Control, self.fileLabelID, Scr_XSize=bestSize Widget_Control, self.dirLabelID, Scr_XSize=bestSize END ;------------------------------------------------------------------------------- PRO FSC_FileSelect::MatchSize ; This method makes the compound widget the same size as the largest ; widget in the parent base widget. It does this by adjusting ; the text widget sizes. Catch, theError IF theError NE 0 THEN BEGIN ok = cgErrorMsg() RETURN ENDIF ; Get the geometries of the filename widgets. tgeo = Widget_Info(self.tlb, /Geometry) fgeo = Widget_Info(self.filetextID, /Geometry) bbgeo = Widget_Info(self.filebaseID, /Geometry) lbgeo = Widget_Info(Widget_Info(self.dirbaseID, /Parent), /Geometry) rbgeo = Widget_Info(Widget_Info(self.filebrowseID, /Parent), /Geometry) ; Add the bits and bobs together. fspacing = tgeo.space fpadding = 2*tgeo.xpad + 2*lbgeo.xpad ffixedsize = ( bbgeo.scr_xsize - 2*bbgeo.margin - (fgeo.scr_xsize) + $ rbgeo.scr_xsize - 2*rbgeo.margin ) ; Get the geometries of the directory name widgets. fgeo = Widget_Info(self.dirtextID, /Geometry) bbgeo = Widget_Info(self.dirbaseID, /Geometry) ; Add the bits and bobs together. dspacing = tgeo.space dpadding = 2*tgeo.xpad + 2*lbgeo.xpad dfixedsize = ( bbgeo.scr_xsize - 2*bbgeo.margin - (fgeo.scr_xsize) + $ rbgeo.scr_xsize - 2*rbgeo.margin ) ; Go find all the children and find the biggest one of them. thisSize = 0 childID = Widget_Info(self.parent, /Child) geom = Widget_Info(childID, /Geometry) testSize = geom.scr_xsize - 2*geom.margin thisSize = thisSize > testSize WHILE childID NE 0 DO BEGIN childID = Widget_Info(childID, /Sibling) IF childID GT 0 THEN BEGIN geom = Widget_Info(childID, /Geometry) testSize = geom.scr_xsize - 2*geom.margin thisSize = thisSize > testSize ENDIF ENDWHILE ; Resize the widgets ftextsize = thisSize - (fspacing + fpadding + ffixedsize) Widget_Control, self.filetextID, Scr_XSize=ftextsize dtextsize = thisSize - (dspacing + dpadding + dfixedsize) Widget_Control, self.dirtextID, Scr_XSize=dtextsize END ;------------------------------------------------------------------------------- FUNCTION FSC_FileSelect_RStrPos, Expr, SubStr, Pos ON_ERROR, 2 N = N_PARAMS() if (n lt 2) then message, 'Incorrect number of arguments.' ; Is expr an array or a scalar? In either case, make a result ; that matches. if (size(expr, /n_dimensions) eq 0) then result = 0 $ else result = make_array(dimension=size(expr,/dimensions), /INT) RSubStr = STRING(REVERSE(BYTE(SubStr))) ; Reverse the substring for i = 0, n_elements(expr) - 1 do begin Len = STRLEN(Expr[i]) IF (N_ELEMENTS(Pos) EQ 0) THEN Start=0 ELSE Start = Len - Pos RString = STRING(REVERSE(BYTE(Expr[i]))) ; Reverse the string SubPos = STRPOS(RString, RSubStr, Start) IF SubPos NE -1 THEN SubPos = Len - SubPos - STRLEN(SubStr) result[i] = SubPos endfor RETURN, result END ;------------------------------------------------------------------------- PRO FSC_FileSelect::Select_File, event Catch, theError IF theError NE 0 THEN BEGIN ok = cgErrorMsg() RETURN ENDIF ; Use the file selection dialog to obtain a filename. currentFilename = self.filename self.filename = "" filename = Dialog_Pickfile( File=currentFilename, $ Filter=*self.filter, $ Path=self.directoryname, $ Get_Path=thePath, $ Must_Exist=self.mustexist, $ Read=self.read, $ Title=self.selecttitle, $ Write=self.write ) IF filename EQ "" THEN BEGIN self.filename = currentFilename RETURN ENDIF ; Remove the directory from the name. index = StrLen(thePath) theFilename = StrMid(filename, index) ; Strip the last directory separator. length = StrLen(thePath) thePath = StrMid(thePath, 0, length-1) ; Inspect the file name to make sure it is valid. textSelection = Widget_Info(self.filetextID, /Text_Select) filename = self->Inspect_Filename(filename, textSelection[0]) ; Update the display. self->SetProperty, Filename=theFilename, DirectoryName=thePath END ;----------------------------------------------------------------------------------------------------------------------------- PRO FSC_FileSelect::SetFilename, theName ; This method separates the filename into directory and filename ; and adds them to the interface. Catch, theError IF theError NE 0 THEN BEGIN ok = cgErrorMsg() RETURN ENDIF ; Change back slashes to forward slashes. ;;theName = StrJoin( StrSplit(theName, '\\', /Regex, /Extract, /Preserve_Null), '/') ; Get the correct directory separator. CASE StrUpCase(!Version.OS_Family) OF 'MACOS' : sep = ':' ; Macintoshes 'VMS' : sep = ']' ; VMS machines ELSE : sep = '/' ; Unix machines ENDCASE index = FSC_FileSelect_RStrPos(theName, sep) IF index EQ -1 THEN BEGIN self->SetProperty, Filename=theName self.filename = theName ENDIF ELSE BEGIN directoryName = StrMid(theName, 0, index) filename = StrMid(theName, index+1) self->SetProperty, Filename=filename, Directory=directoryName self.filename = filename self.directoryName = directoryName ENDELSE END ;------------------------------------------------------------------------------- PRO FSC_FileSelect::SetProperty, $ DirectoryName=dirname, $ ; The initial name of the directory. By defaut: current directory. Event_Func=event_func, $ ; The event handler function for this compound widget. Event_Pro=event_pro, $ ; The event handler procedure for this compound widget. Filename=filename, $ ; The initial file name in the filename text widget. Filter=filter, $ ; The file filter. LabelName=labelname, $ ; The text on the label widgt. LabelSize=labelsize, $ ; The X screen size of the label widget. MustExist=mustexist, $ ; A flag that indicates selected files must exist. Read=read, $ ; Set this keyword to have file selection for reading a file. SelectTitle=selecttitle, $ ; The title bar text on the file selection dialog. UValue=uvalue, $ ; User value for any purpose. Write=write, $ ; Set this keyword to open a file for writing. XSize=xsize ; The X size of the text widget holding the filename. Catch, theError IF theError NE 0 THEN BEGIN ok = cgErrorMsg() RETURN ENDIF IF N_Elements(dirname) NE 0 THEN BEGIN ;;dirname = StrJoin( StrSplit(dirname, '\\', /Regex, /Extract, /Preserve_Null), '/') self.directoryname = dirname Widget_Control, self.dirtextID, Set_Value=dirname ENDIF IF N_Elements(event_pro) NE 0 THEN BEGIN self.event_pro = event_pro Widget_Control, self.tlb, Event_Pro=event_pro ENDIF IF N_Elements(event_func) NE 0 THEN BEGIN self.event_func = event_func Widget_Control, self.tlb, Event_Func=event_func ENDIF IF N_Elements(filename) NE 0 THEN BEGIN self.filename = filename strlength = StrLen(filename) Widget_Control, self.filetextID, Set_Value=filename ENDIF IF N_Elements(labelname) NE 0 THEN BEGIN self.labelname = labelname Widget_Control, self.filelabelID, Set_Value=labelname ENDIF IF N_Elements(labelsize) NE 0 THEN BEGIN Widget_Control, self.filelabelID, Scr_XSize=labelsize ENDIF IF N_Elements(filter) NE 0 THEN *self.filter = filter IF N_Elements(mustexist) NE 0 THEN self.mustexist = mustexist IF N_Elements(read) NE 0 THEN self.read = read IF N_Elements(selecttitle) NE 0 THEN self.selecttitle = selecttitle IF N_Elements(uvalue) NE 0 THEN *self.uvalue = uvalue IF N_Elements(write) NE 0 THEN self.write = write IF N_Elements(xsize) NE 0 THEN BEGIN Widget_Control, self.filetextID, XSize=xsize Widget_Control, self.dirtextID, XSize=xsize ENDIF END ;----------------------------------------------------------------------------------------------------------------------------- PRO FSC_FileSelect::TextSelect, selection Catch, theError IF theError NE 0 THEN BEGIN ok = cgErrorMsg() RETURN ENDIF IF N_Elements(selection) NE 2 THEN Message, 'Text selection array is not a two-element array: [beginSelection, selectionLength]' Widget_Control, self.fileTextID, Set_Text_Select=selection END ;----------------------------------------------------------------------------------------------------------------------------- PRO FSC_FileSelect::CLEANUP Ptr_Free, self.uvalue Ptr_Free, self.filter END ;----------------------------------------------------------------------------------------------------------------------------- FUNCTION FSC_FileSelect::INIT, $ parent, $ ; The parent widget ID of the compound widget. DirectoryName=dirname, $ ; The initial name of the directory. By defaut: current directory. Event_Pro=event_pro, $ ; The event handler procedure for this compound widget.By default: "". Event_Func=event_func, $ ; The event handler function for this compound widget. By default: "". Filename=filename, $ ; The initial file name in the filename text widget. Filter=filter, $ ; The file filter. By default: "*". Frame=frame, $ ; Set this keyword for a frame around the compound widget. LabelFont=labelfont, $ ; The font for the label widget. By default: "". LabelName=labelname, $ ; The text on the label widgt. By default: "Filename: ". LabelSize=labelsize, $ ; The X screen size of the label widget. By default: 0. MustExist=mustexist, $ ; A flag that indicates selected files must exist. By default: 0. NoMaxSize=nomaxsize, $ ; A flag to prohibit automatica text widget sizing. By default: 0. Read=read, $ ; Set this keyword to have file selection for reading a file. By default: 1. Scr_XSize=scr_xsize, $ ; The X screen size of the compound widget. By default: 0 SelectFont=selectfont, $ ; The font for the "Browse" button. By default: "". Selectdir=selectdir, $ ; The inital directory for file and directory selections. SelectTitle=selecttitle, $ ; The title bar text on the file selection dialog. By default: "Select a File...". TextFont=textfont, $ ; The font for the filename text widget. By default: "". UValue=uvalue, $ ; User value for any purpose. Write=write, $ ; Set this keyword to open a file for writing. By default: 0. XSize=xsize ; The X size of the text widget holding the filename. By default: StrLen(filename) * 1.5 > 40. Catch, theError ;theError = 0 IF theError NE 0 THEN BEGIN Catch, /Cancel ok = cgErrorMsg() RETURN, 0 ENDIF ; Populate self object. self.parent = parent self.directoryname = dirname self.event_pro = event_pro self.event_func = event_func self.filename = filename self.filter = Ptr_New(filter) self.frame = frame self.labelfont = labelfont self.labelname = labelname self.labelsize = labelsize self.mustexist = mustexist self.nomaxsize = nomaxsize self.read = read self.selectdir = selectdir self.selectfont = selectfont self.selecttitle = selecttitle self.textfont = textfont self.uvalue = Ptr_New(uvalue) self.write = write self.xsize = xsize ; Build widgets. self.tlb = Widget_Base( self.parent, $ Event_Func = self.event_func, $ Event_Pro = self.event_pro, $ Frame = self.frame, $ Func_Get_Value='FSC_FileSelect_Get_Value', $ Pro_Set_Value='FSC_FileSelect_Set_Value', $ Row = 1, $ Base_Align_Center=1, $ UValue=*self.uvalue ) ; Put the self object in the first child of the TLB. leftbase = Widget_Base(self.tlb, Row=2, UValue=self) self.dirbaseID = Widget_Base(leftbase, Row=1) self.dirlabelID = Widget_Label( self.dirbaseID, $ Font=self.labelfont, $ Scr_XSize=self.labelsize, $ Value='Directory: ' ) self.dirtextID = Widget_Text( self.dirbaseID, $ All_Events=1, $ Editable=1, $ Event_Func='FSC_FileSelect_Event_Handler', $ Font=self.textfont, $ UValue={method:'Directory_Events', object:self}, $ Value=self.directoryname, $ XSize=self.xsize, $ YSize=1 ) self.filebaseID = Widget_Base(leftbase, Row=1) self.filelabelID = Widget_Label( self.filebaseID, $ Font=self.labelfont, $ Kill_Notify='FSC_FileSelect_Kill_Notify', $ Notify_Realize='FSC_FileSelect_Notify_Realize', $ Scr_XSize=self.labelsize, $ UValue=self, $ Value=self.labelname ) self.filetextID = Widget_Text( self.filebaseID, $ All_Events=1, $ Editable=1, $ Event_Func='FSC_FileSelect_Event_Handler', $ Font=self.textfont, $ UValue={method:'Filename_Events', object:self}, $ Value=self.filename, $ XSize=self.xsize, $ YSize=1 ) rightbase = Widget_Base(self.tlb, Row=1, Base_Align_Center=1) self.filebrowseID = Widget_Button( rightbase, $ Event_Func='FSC_FileSelect_Event_Handler', $ UValue={method:'Select_File', object:self}, $ Value='Browse') RETURN, 1 END ;----------------------------------------------------------------------------------------------------------------------------- PRO FSC_FileSelect__Define objectClass = { FSC_FileSelect, $ ; The object class FSC_FILESELECT. parent: 0L, $ ; The ID of the parent widget. tlb: 0L, $ ; The ID of the top-level base widget for the compound widget. filebaseID: 0L, $ ; The ID of the filename base widget. dirbaseID: 0L, $ ; The ID of the directory base widget. filelabelID: 0L, $ ; The ID of the filename label widget. dirlabelID: 0L, $ ; The ID of the directory label widget. filetextID: 0L, $ ; The ID of the filename text widget. dirtextID: 0L, $ ; The ID of the directory text widget. filebrowseID: 0L, $ ; The ID of the file browse button widget. dirbrowseID: 0L, $ ; Unused currently. Left here for compatibility reasons.. event_pro: "", $ ; The user-defined name of the event procedure for the widget. event_func: "", $ ; The user-defined name of the event function for the widget. filename: "", $ ; The current contents of the filename text widget. directoryname: "", $ ; The current contents of the directory text widget. frame: 0L, $ ; A flag to indicate a frame around the compound widget. filter: Ptr_New(), $ ; The current file filter used in file selection. labelfont: "", $ ; The font for the label widgets. labelname: "", $ ; The VALUE of the file name label widget. labelsize: 0L, $ ; The X screen size fo the label widgets. mustexist: 0L, $ ; If this field is 1, the user can only select files that exist. nomaxsize: 0L, $ ; This widget sizes itself to the largest widget in the base, unless this is set. read: 0L, $ ; Set this keyword to select a file for reading. selectdir: "", $ ; The inital directory used for file selection. selectfont: "", $ ; The font used for the Browse buttons. selecttitle: "", $ ; The text on the Dialog_Pickfile widget. textfont: "", $ ; The font used in the text widgets. uvalue: Ptr_New(), $ ; The user's user value. Unused by the program. write: 0L, $ ; Set this keyword to select a file for writing. xsize: 0L $ ; The X size of the text widgets. } END ;----------------------------------------------------------------------------------------------------------------------------- PRO FSC_FileSelect_Set_Value, id, filename ; This function sets the filename of the widget, using the ; traditional "Widget_Control, fieldID, Set_Value=filename" syntax. ; The directory will be stripped off the filename, if required. firstChild = Widget_Info(id, /Child) Widget_Control, firstChild, Get_UValue=self self->SetFilename,filename END ;----------------------------------------------------------------------------------------------------------------------------- FUNCTION FSC_FileSelect_Get_Value, id ; This function returns the filename of the widget, using the ; traditional "Widget_Control, fieldID, Get_Value=filename" syntax. firstChild = Widget_Info(id, /Child) Widget_Control, firstChild, Get_UValue=self RETURN, self->GetFilename() END ;----------------------------------------------------------------------------------------------------------------------------- PRO CW_FileSelect__Define ; The event structure definition. This is the event structure returned by the compound widget. eventStructure = { CW_FileSelect, $ ; The name of the event structure. ID: 0L, $ ; The ID of the top-level base of the compound widget. TOP: 0L, $ ; The ID of the top-level base. HANDLER: 0L, $ ; The ID of the event handler widget. Filename: "", $ ; The fully qualified file name. Basename: "", $ ; The base file name without directory attached. Directory: "" } ; The file directory. END ;----------------------------------------------------------------------------------------------------------------------------- FUNCTION FSC_FileSelect_Event_Handler, event ; The main event handler for the compound widget. It reacts ; to "messages" in the UValues of widgets that generate events. ; The messages indicate which object method to call. A message ; consists of an object method and the self object reference. Widget_Control, event.ID, Get_UValue=theMessage Call_Method, theMessage.method, theMessage.object, event ; Events will be sent only if there is an assigned event handler. self = theMessage.object self->GetProperty, Filename=filename, DirectoryName=directory, $ Event_Pro=event_pro, Event_Func=event_func IF event_pro NE "" OR event_func NE "" THEN BEGIN pseudoevent = {CW_FileSelect, self->GetTLB(), event.top, 0L, $ Filepath(Root_Dir=directory, filename), filename, directory} ; Don't return events from text widgets, unless the user has typed ; a cariage return. eventName = Tag_Names(event, /Structure_Name) IF eventName NE "" THEN BEGIN IF StrMid(eventName, 0, 11) EQ 'WIDGET_TEXT' THEN BEGIN IF (eventName EQ 'WIDGET_TEXT_CH') THEN BEGIN IF (event.ch EQ 10) THEN RETURN, pseudoevent ELSE RETURN, 0 ENDIF ELSE RETURN, 0 ENDIF ENDIF RETURN, pseudoevent ENDIF ELSE RETURN, 0 END ;----------------------------------------------------------------------------------------------------------------------------- PRO FSC_FileSelect_Notify_Realize, labelID ; When the compound widget is realized, make sure sizes are correct. Widget_Control, labelID, Get_UValue=self IF self->GetNoMaxSize() THEN RETURN self->Matchsize END ;----------------------------------------------------------------------------------------------------------------------------- PRO FSC_FileSelect_Kill_Notify, labelID ; When the compound widget dies, destroy the self object. Widget_Control, labelID, Get_UValue=self Obj_Destroy, self END ;----------------------------------------------------------------------------------------------------------------------------- FUNCTION FSC_FileSelect, $ parent, $ ; The parent widget ID of the compound widget. Event_Pro=event_pro, $ ; The event handler procedure for this compound widget.By default: "". Event_Func=event_func, $ ; The event handler function for this compound widget. By default: "". DirectoryName=dirname, $ ; The initial name of the directory. By defaut: current directory. Filename=filename, $ ; The initial file name in the filename text widget. Filter=filter, $ ; The file filter. By default: "*". Frame=frame, $ ; Set this keyword for a frame around the compound widget. LabelFont=labelfont, $ ; The font for the label widget. By default: "". LabelName=labelname, $ ; The text on the label widgt. By default: "Filename: ". LabelSize=labelsize, $ ; The X screen size of the label widget. By default: 0. MustExist=mustexist, $ ; A flag that indicates selected files must exist. By default: 0. NoMaxSize=nomaxsize, $ ; A flag to prohibit automatica text widget sizing. By default: 0. ObjectRef=objectref, $ ; An output keyword containing the object reference. Read=read, $ ; Set this keyword to have file selection for reading a file. By default: 1. SelectDirectory=selectdir, $ ; The default directory for file selection. SelectFont=selectfont, $ ; The font for the "Browse" button. By default: "". SelectTitle=selecttitle, $ ; The title bar text on the file selection dialog. By default: "Select a File...". TextFont=textfont, $ ; The font for the filename text widget. By default: "". UValue=uvalue, $ ; User value for any purpose. Write=write, $ ; Set this keyword to open a file for writing. By default: 0. XSize=xsize ; The X size of the text widget holding the filename. By default: StrLen(filename) * 1.5 > 40. Catch, theError ;theError = 0 IF theError NE 0 THEN BEGIN ok = cgErrorMsg() RETURN, 0 ENDIF ; Need a parent parameter. IF N_Elements(parent) EQ 0 THEN BEGIN ok = Dialog_Message('FSC_FILESELECT: A parent parameter is required.') RETURN, -1 ENDIF ; Check keyword arguments. IF N_Elements(dirname) EQ 0 THEN CD, Current=dirname ; 4 Oct 2008. I don't know why this line is here, but it prevents Windows ; computers from starting Dialog_Pickfile in the correct directory, since it ; thinks the directory is not "formatted correctly". This is used throughout ; the code, so I have just commented all the instances out, rather than remove ; them. Search for "StrJoin". ;dirname = StrJoin( StrSplit(dirname, '\\', /Regex, /Extract, /Preserve_Null), '/') IF N_Elements(event_pro) EQ 0 THEN event_pro = "" IF N_Elements(event_func) EQ 0 THEN event_func = "" IF N_Elements(filename) EQ 0 THEN filename = "" IF N_Elements(filter) EQ 0 THEN filter = '*' IF N_Elements(Frame) EQ 0 THEN Frame = 0 IF N_Elements(labelfont) EQ 0 THEN labelfont = FSC_Fileselect_WidgetFont() IF N_Elements(labelname) EQ 0 THEN labelname = "Filename: " IF N_Elements(labelsize) EQ 0 THEN labelsize = 0 IF N_Elements(mustexist) EQ 0 THEN mustexist = 0 IF N_Elements(nomaxsize) EQ 0 THEN nomaxsize = 0 IF N_Elements(read) EQ 0 THEN read = 0 IF N_Elements(selectdir) EQ 0 THEN selectdir = dirname IF N_Elements(selectfont) EQ 0 THEN selectfont = FSC_Fileselect_WidgetFont() IF Keyword_Set(read) EQ 0 AND Keyword_Set(write) EQ 0 AND $ N_Elements(selecttitle) EQ 0 THEN selecttitle = "Select a File..." ELSE selecttitle = "" IF N_Elements(textfont) EQ 0 THEN textfont = FSC_Fileselect_WidgetFont() IF N_Elements(uvalue) EQ 0 THEN uvalue = "" IF N_Elements(write) EQ 0 THEN write = 0 IF N_Elements(xsize) EQ 0 THEN xsize = Long(StrLen(dirname) * 1.20 > 40) ; Create the underlying structure. objectref = Obj_New('FSC_FileSelect', $ parent, $ DirectoryName=dirname, $ Event_Pro=event_pro, $ Event_Func=event_func, $ Filename=filename, $ Filter=filter, $ Frame=frame, $ LabelFont=labelfont, $ LabelName=labelname, $ LabelSize=labelsize, $ MustExist=mustexist, $ NoMaxSize=nomaxsize, $ Read=read, $ Scr_XSize=scr_xsize, $ SelectFont=selectfont, $ SelectTitle=selecttitle, $ Selectdir=selectdir, $ TextFont=textfont, $ UValue=uvalue, $ Write=write, $ XSize=xsize ) ; Return the ID of the top-level base of the compound widget. RETURN, objectref->GetTLB() END ;----------------------------------------------------------------------------------------------------------------------------- PRO Example_Set_Size, event Widget_Control, event.top, Get_UValue=theObject theObject->MatchSize END ;----------------------------------------------------------------------------------------------------------------------------- PRO Example_Set_Filter, event Widget_Control, event.top, Get_UValue=theObject theObject->SetProperty, Filter='*.pro', Filename='cyclone.pro' END ;----------------------------------------------------------------------------------------------------------------------------- PRO Example_Set_Filename, event Widget_Control, event.top, Get_UValue=theObject filename = Filepath(Subdir=['examples', 'data'], 'worldelv.dat') theObject->SetFilename, filename END ;----------------------------------------------------------------------------------------------------------------------------- PRO Example_Shrink, event Widget_Control, event.top, Get_UValue=theObject theObject->SetProperty, XSize=40 END ;----------------------------------------------------------------------------------------------------------------------------- PRO Example_Print_Filename, event Widget_Control, event.top, Get_UValue=theObject Print, theObject->GetFilename() END ;----------------------------------------------------------------------------------------------------------------------------- PRO Example_Quit, event Widget_Control, event.top, /Destroy END ;----------------------------------------------------------------------------------------------------------------------------- PRO Example, theObject tlb = Widget_Base(Title='Exercise FSC_FILESELECT...', Column=1) button = Widget_Button(tlb, Value='Make Compound Widget As Big As Me', $ Event_Pro='Example_Set_Size', Scr_XSize=500) button = Widget_Button(tlb, Value='Set Filename to worldelv.data in Data Directory', $ Event_Pro='Example_Set_Filename') button = Widget_Button(tlb, Value='Print Filename', $ Event_Pro='Example_Print_Filename') button = Widget_Button(tlb, Value="Shrink the Text Fields", $ Event_Pro='Example_Shrink') CD, Current=thisDir filenameID = FSC_FileSelect(tlb, Directory=thisDir, Filename='fileselect.pro', $ /NoMaxSize, ObjectRef=theObject) button = Widget_Button(tlb, Value='Quit', Event_Pro='Example_Quit') Widget_Control, tlb, /Realize, Set_UValue=theObject XManager, 'example', tlb, /No_Block END ;-----------------------------------------------------------------------------------------------------------------------------