2002-09-11 18:21

' ======================================= '
'		About QSavePlus
' ======================================= '
	'-- QSavePlus is extends from QSaveDialog ,
	'-- 1) If don't found any extension or found unusual extension in FileName,
	'-- will show Add Extension Confirm Dialog.
	'-- 2) Plus directory and FileName Checking.
	'-- 3) show Confirm Dialog before save exist file.
	'-- This code only test on Win98.

' Author : Suchart Chokphichitchai
' E-mail  : dragon_html@yahoo.com
' My skillfull about English Language is very weak.
' If you don't understand the description,
' or you found bug of this code.
' Please contact me to modify it.

     $TYPECHECK ON
     $ESCAPECHARS ON

' ======================================= '
'		CONST
' ======================================= '
     CONST dot = "."		:CONST Quo$ = CHR$(39)

     CONST false = 0		:CONST true = 1

     CONST mtWarning = 0	:CONST mtConfirmation = 3

     CONST mbYes = 1		:CONST mbNo = 2
     CONST mbOK = 4		:CONST mbCancel = 8

     CONST mrYes = 6		:CONST mrNo = 7
     CONST mrCancel = 2	:CONST mrOK = 1

     FUNCTION delMark$( s AS STRING ) AS STRING
      s=REPLACESUBSTR$(s," ","")
      s=REPLACESUBSTR$(s,"\t","")
      delMark$=REPLACESUBSTR$(s,"*.","")
     END FUNCTION

' ======================================= '
'		OBJECT Extends
' ======================================= '

     TYPE QSaveplus EXTENDS QSAVEDIALOG
Private:
      saveDialogRet AS INTEGER
      goOut AS INTEGER

      FUNCTION item( i AS INTEGER ) AS STRING
		' Result example '
		'-- item(1)="*.*"
		'-- item(2)="*.js"
		'-- item(3)="*.php3;*.php"
       Result = FIELD$( QSaveplus.Filter, "|", i*2 )
      END FUNCTION
      FUNCTION itemCount AS INTEGER
		' Result example ' ( value of number of all item )
		'-- itemCount = 7
       Result = TALLY(QSaveplus.Filter,"|")\2
      END FUNCTION
      FUNCTION extCount( i AS INTEGER ) AS INTEGER
			' Result example ' ( value of number of extension in one item)
			'-- extCount(1) = 1 [ *.* ]
			'-- extCount(2) = 1 [ *.js ]
			'-- extCount(3) = 2 [ *.php3;*.php ]
       Result = TALLY( QSaveplus.item( i ), "*." )
      END FUNCTION
      FUNCTION ext( t AS INTEGER, i AS INTEGER ) AS STRING
       DIM e AS STRING
			' Result example '
			'-- ext(3,1) = "php3"
			'-- ext(3,2) = "php"
       e = FIELD$( QSaveplus.item( t ), ";", i )
       Result = delMark$( e )
      END FUNCTION
      FUNCTION Exten$ AS STRING
				' Result example '
				'-- if FilterIndex = 4
				'--   Exten$ = "pl"
				'-- if FilterIndex = 2
				'--   Exten$ = "js"
       Result = QSaveplus.ext( QSaveplus.FilterIndex, 1 )
      END FUNCTION
      FUNCTION DirExist AS INTEGER
       DIM fileDir$ AS STRING
       DIM BslPos AS INTEGER
				' Result example '
				'-- if dir of FileName is exist.
				'-- DirExist=1
				'-- if dir of FileName is not exist.
				'-- DirExist=0
       BslPos = RINSTR(QSaveplus.Filename,"\\")
       fileDir$ = DELETE$(QSaveplus.Filename, BslPos+1, LEN(QSaveplus.Filename)-BslPos)
						'ShowMessage "DirName="+fileDir$
       Result = DIREXISTS(fileDir$)
      END FUNCTION
      FUNCTION NoExten AS INTEGER
       DIM FileLC$ AS STRING
       DIM EachExt$ AS STRING
       DIM FoundExt AS INTEGER
       DIM cou AS INTEGER
					' Result example '
					'-- if FilterIndex = 2
					'--   if not found extension (Ex. c:\abc )
					'--   or if found unusual extension. (Ex. c:\abc.ss)
					'--     NoExten=1
					'--   but if found usual extension. (Ex c:\abc.js)
					'--     NoExten=0
       FoundExt=False
       FileLC$ = LCASE$(QSaveplus.FileName)
       FOR cou = 1 TO QSaveplus.ExtCount( QSaveplus.FilterIndex ) '-- EXTCOUNT
        EachExt$ = dot+LCASE$( QSaveplus.Ext( QSaveplus.FilterIndex, cou ) ) '-- EXT
									'  ShowMessage "right str= "+Right$(FileLC$,LEN(EachExt$))+_
									'  "\r\extension"+str$(cou)+"= "+EachExt$
        IF RIGHT$(FileLC$,LEN(EachExt$)) = EachExt$ THEN
         FoundExt = True
         EXIT FOR
        END IF
       NEXT
       IF FoundExt = False THEN
        Result = True
       ELSE
        Result = False
       END IF
      END FUNCTION
      FUNCTION PlusExt AS STRING
					' Result example '
					'-- if FilterIndex=2
					'--   if FileName="c:\abc."
					'--     add only "js"
					'--   if FileName="c:\abc"
					'--     add ".js"
       IF RIGHT$(QSaveplus.Filename,1) = dot THEN
        Result = QSaveplus.Filename+QSavePlus.Exten$
       ELSE
        Result = QSaveplus.Filename+dot+QSavePlus.Exten$
       END IF
      END FUNCTION
      FUNCTION Validname AS INTEGER
				' Result example '
				'-- if found ">" in FileName
				'--  Validname=0
       IF INSTR(QSaveplus.Filename,">") <> 0 THEN
        Result = False
       ELSE
        Result = True
       END IF
      END FUNCTION
      SUB goOutTrue
				'-- go out the loop. by set goOut=1
       QSavePlus.goOut = True
      END SUB
      SUB FileExistDlg
			'-- if FileName is exist, show Confirm Dialog.
       IF FILEEXISTS(QSaveplus.Filename) THEN
				'-- FileName is exist.
        IF MESSAGEDLG(Quo$+QSaveplus.FileName+Quo$+_
         " already exists.\r\nDo you want to replace it?",_
         mtConfirmation, mbYes OR mbNo, 0) = mrYes THEN
					'-- if select Yes
         QSavePlus.goOutTrue
        END IF
       ELSE
				'-- FileName is not exist.
        QSavePlus.goOutTrue
       END IF '-- if not cancel
      END SUB
Public:
      FUNCTION Execute2 AS INTEGER
       DIM mrValue AS INTEGER
       QSavePlus.goOut = False
       DO
			'-- Execute and keep value in saveDialogRet.
        QSavePlus.saveDialogRet = QSaveplus.EXECUTE

        IF QSavePlus.saveDialogRet = False THEN '-- Click Cancel button.
         QSavePlus.goOutTrue
        ELSE '-- Click Save button.
         IF QSavePlus.Validname = True THEN '-- FileName is valid.
          IF QSavePlus.dirExist = False THEN ' === Directory of FileName is not exist. === '
           MESSAGEDLG(QSaveplus.Filename+_
            "\r\nPath does not exist."+_
            "\r\nPlease verify the correct path was given.",_
            mtWarning, mbOK, 0)
           QSaveplus.Filename=CURDIR$+"\\*."+QSavePlus.Exten$
          ELSEIF QSavePlus.NoExten = True THEN ' === No extension or False extension. === '
           IF QSaveplus.FilterIndex = 1 THEN '-- FilterIndex is "All Files"
            QSavePlus.FileExistDlg
           ELSE '-- FilterIndex is not "All Files", Select add extension or not.
            mrValue=MESSAGEDLG(QSaveplus.FileName+_
             "\r\nThere is no file extension in the file name."+_
             "\r\nDo you want to add '"+QSavePlus.Exten$+"' extension automatically?",_
             mtConfirmation, mbYes OR mbNo OR mbCancel, 0)
            IF (mrValue = mrYes) OR (mrValue = mrNo) THEN
             IF mrValue = mrYes THEN
              QSaveplus.Filename = QSavePlus.PlusExt
             END IF
             QSavePlus.FileExistDlg
            END IF
           END IF
          ELSE ' === Found usual extension of Filter. === '
           QSavePlus.FileExistDlg
          END IF
         ELSE '-- FileName is invalid.
          MESSAGEDLG(QSaveplus.Filename+_
           "\r\nThe above file name is invalid.",_
           mtWarning, mbOK, 0)
         END IF
        END IF '-- saveDialogRet
       LOOP UNTIL QSavePlus.goOut = True
       Result = QSavePlus.saveDialogRet
      END FUNCTION
     END TYPE
' - - - - - - - - - - - - - - - - - - - - End QSavePlus - - - - - - - - - - - - - - - - - - - - '


' ======================================= '
'		EXAMPLE
' ======================================= '

     DECLARE SUB formClick
     CREATE form AS QFORM
      CREATE R AS QRICHEDIT
       Text="abc\r\n123"
      END CREATE
      Center
      OnClick = formClick
     END CREATE

     CREATE saveDlg AS QSaveplus
      Filter =	_
       "All Files (*.*)"					+	"|*.*|"+_
       "JavaScript (*.js)"				+	"|*.js|"+_
       "PHP (*.php3,*.php)"			+	"|*.php3;*.php|"+_
       "Perl (*.pl,*.pm,*.cgi)"			+	"|*.pl;*.pm;*.cgi|"+_
       "Rapid-Q BASIC (*.rq,*.bas)"	+	"|*.rq;*.bas|"+_
       "Html (*.html,*.htm)"				+	"|*.html;*.htm|"+_
       "Text (*.txt)"						+	"|*.txt|"
		'-- it can change to other extension.

'  Compatible Filter. '
' 1)  [ Filter 1 ]  must be only [ All Files |*.*| ]
' Ex:
'		" Javascript |*.js|" ...Not OK
'		" All Files |*.*|"  ...OK
'		" All Files |*.*| Javascript |*.js|"  ...OK
' 2) It must not have blank-ascii or tab-ascii at end of extension.
' Ex:
'		" All Files |*.* |	" ...Not OK
'		" All Files |*.*	|	" ...Not OK
'		" All Files |	 *.*|"  ...OK
'		" All Files |*.*|"  ...OK
'		" All Files |*.*| PHP |*.php3;*.php   |"  ...Not OK
'		" All Files |*.*| PHP |*.php3   ;*.php|"  ...Not OK
'		" All Files |*.*| PHP |   *.php3;   *.php|"  ...OK
' 3) Positions of |-ascii only must be last of each text.
' Ex:
'		" All Files |*.*"  ...Not OK ( Don't have |-ascii at end of *.* )
'		"| All Files |*.*|"  ...Not OK ( Have |-ascii at begin of " All Files" )
'		"| All Files |*.*"  ...Not OK ( Don't have |-ascii at end of *.* , and Have |-ascii at begin of " All Files" )
'		" All Files |*.*|"  ...OK
'		" All Files |*.*| JavaScript |*.js"  ...Not OK ( Don't have |-ascii at end of *.js )
'		"| All Files |*.*| JavaScript |*.js|"  ...Not OK ( Have |-ascii at begin of " All Files" )
'		"| All Files |*.*| JavaScript |*.js"  ...Not OK ( Don't have |-ascii at end of *.js , and Have |-ascii at begin of " All Files" )
'		" All Files |*.*| JavaScript |*.js|"  ...OK
     END CREATE


     SUB formClick
      IF saveDlg.Execute2 = 1 THEN
       SHOWMESSAGE "Save File.. "+saveDlg.FileName
		'-- when you sure that all code is not dangerous.
		'-- and you want to save file really, delete ' of below line
		' r.savetofile( saveDlg.FileName )
      ELSE
       SHOWMESSAGE "No Save"
      END IF
     END SUB

     form.SHOWMODAL

2002-09-11 18:21