Description _________________
! NE PAS JUGER L'APPLICATION D'EDITION DE TEXTE !
Ce module de classe vous procure une moyen simple et puissant de gerer un document ouvert dans votre application.
Peu importe que votre application affiche des fichier texte, des images, des pdf, etc... DocInApp peut gerer toute l'interface d'ouverture, enregistrement et fermeture de documents.
DocInApp gere les nouveaux documents, ceux ouverts en lecture seule, les modifications et meme l'accessibilite des bouton d'un menu fichier.
Fonctionnement ______________
La classe est basee sur le controle "Microsoft Common Dialog Control" (COMDLG32.OCX).
Creez un objet pour chaque document que vous ouvrez dans votre application.
Appelez ses methodes lors de tout evenement de creation, ouverture, modification, enregistrement et fermeture.
Ajouter votre code de manipulation de document dans les evenements de la classe.
Exemple _________________
Pour vous donner une idee des possibilites de DocInApp, regardez le contenu du formulaire principale de cet editeur de texte.
Tout est dedans, le reste est gere par DocInApp !
Source / Exemple :
'************************************************************************'
'************************************************************************'
'** **'
'** DOCUMENT IN APPLICATION MANAGEMENT CLASS **'
'** **'
'************************************************************************'
'************************************************************************'
'---------------------------- ATTRIBUTES ----------------------------'
'Author = Santiago Diez (santiago.diez@free.fr)
'Website = http://santiago.diez.free.fr
'Webpage = http://www.vbfrance.com/code.aspx?ID=38402
'Date = 12 JULY 2006 12:47
'Version = 2.0
'---------------------------- COPYRIGHT -----------------------------'
'I worked on that module for me and for you. You are allowed to do the
'following as long as you specify my name and website (please don't
'laught, one day it will be a real website):
'- use the code, partially or totally
'- change the code partially
'If you ever improve the features of that module, fix any bug or find any
'way to make it better, please write to me for feedback.
'--------------------------- DESCRIPTION ----------------------------'
'This class module provides you with a powerfull way to manage the files
'you open in your application.
'Each instance of objDocInApp is able to communicate with the user to
'select a file to open or to save to. It deals with read-only or modified
'documents and prompt the user for any decision to take.
'The class does not actualy open or save documents, each application has
'its own way to read or write them. Your application provide the
'procedures for reading and writing files, all the rest is provided by
'this powerfull tool.
'It's able to:
'- prompt the user to select a file to open
'- prompt the user to save changes before close, exit or open another file
'- prompt the user to select the location to save a file to (or save as)
'- force the user to save as if read-only attributes have been detected
'- display error messages if your own application was not able to create,
'open, reopen or save documents.
'--------------------------- HOW IT WORKS ---------------------------'
'The class is based on the Microsoft Common Dialog Control.
'Create an object for each file you open in your application. Call the
'class methods for the create, open, modify, save and close events and use
'the class events to code creating, opening, saving and closing files.
'-------------- PUBLIC EVENTS, PROPERTIES AND METHODS ---------------'
'Call SetDialog(CommonDialogControl As Control, [DialogOptions As
' dlgOptions])
'Call SetButtons([ArrayOfButtonsReOpen], [ArrayOfButtonsSave],
' [ArrayOfButtonsSaveAs], [ArrayOfButtonsClose],
' [ArrayOfButtonsProperties])
'Call SetLanguage([ReopenWarning], [ModifiedWarning], [ReadOnlyWarning],
' [OpenCaption], [SaveAsCaption], [ReadOnlyCaption],
' [NewError], [OpenError], [SaveError], [CloseError],
' [DocumentDefaultName], [DocumentDefaultExt],
' [DocumentDefaultFilter])
'Property Get Path() As String
'Property Get Name() As String
'Property Get Ext() As String
'Property Get ReadOnly() As String
'Boolean = Request(rType As RequestType, [FileName], [DefaultExt],
' [InitDir], [Filter], [FilterIndex])
'Call Confirm(cType As ConfirmationType)
'Call Modify
'----------------------------- EXAMPLES -----------------------------'
'Say, you want a form that display, modify and save documents.
'First reference COMDLG32.OCX in your project components and add a Common
'Dialog Control (CommonDialog1) to your form.
'First reference COMDLG32.OCX in your project components and add a Common
'Dialog Control (CommonDialog1) to your form. Add buttons to create
'(btn_Create), open (btn_Reopen), reopen (btn_reopen), save (btn_Save),
'save as (btn_SaveAs) and close (btn_Close).
'Then your form code is nothing but that:
'
' Private WithEvents DocInApp As objDocInApp
' Private Sub Form_Load()
' Set DocInApp = New objDocInApp
' Call DocInApp.SetDialogBox(CommonDialog1)
' End Sub
' Private Sub btn_Create_Click()
' Call DocInApp.AskNew
' End Sub
' Private Sub btn_Open_Click()
' Call DocInApp.AskOpen
' End Sub
' Private Sub btn_reopen_Click()
' Call DocInApp.AskReOpen
' End Sub
' Private Sub btn_Save_Click()
' Call DocInApp.AskSave
' End Sub
' Private Sub btn_SaveAs_Click()
' Call DocInApp.AskSave(True)
' End Sub
' Private Sub btn_Close_Click()
' Call DocInApp.AskClose
' End Sub
' Private Sub Form_Unload(Cancel As Integer)
' If Not DocInApp.AskClose Then Cancel = 1
' End Sub
' Private Sub DocInApp_CreateDoc(Title As String)
' 'Write here the way you create a new document (blank, not saved)
' 'Do not consider any user interaction, DocInApp does it for you
' On Error GoTo Err_Unattend
' 'Do not forgot to confirm creation
' DocInApp.ConfirmCreate
' Err_Unattend:
' 'Let DocInApp display the error message
' End Sub
' Private Sub DocInApp_OpenDoc(Path As String, Title As String)
' 'Write here the way you display a file from address "Path"
' 'Do not consider any user interaction, DocInApp does it for you
' On Error GoTo Err_Unattend
' 'Do not forgot to confirm opening
' DocInApp.ConfirmOpen
' Err_Unattend:
' 'Let DocInApp display the error message
' End Sub
' Private Sub DocInApp_SaveDoc(Path As String, Title As String)
' 'Write here the way you save a document to address "Path"
' 'Do not consider any user interaction, DocInApp does it for you
' On Error GoTo Err_Unattend
' 'Do not forgot to confirm save
' DocInApp.ConfirmSave
' Err_Unattend:
' 'Let DocInApp display the error message
' End Sub
' Private Sub DocInApp_CloseDoc()
' 'Write here the way you close a document
' 'Do not consider any user interaction, DocInApp does it for you
' On Error GoTo Err_Unattend
' 'Do not forgot to confirm close
' DocInApp.ConfirmClose
' Err_Unattend:
' 'Let DocInApp display the error message
' End Sub
'------------------------------- BUGS -------------------------------'
'If your application raises an error while creating, opening or reopening
'a document, it is asked to close it.
'If your application raises an error while closing the document, you may
'have a half-created or half-opened document displayed.
'In both cases, an error message is displayed.
'Options "dlgNoReadOnlySelect" only works for save as dialog box. It means
'that "objDocInApp" may return a read-only or right-protected document
'after a "AskOpen" method and without being aware of it. The bug occurs
'when invoquing the "AskSave" method.
'----------------------------- SOURCES ------------------------------'
'MSDN January 2001
'------------------------ REQUIRED LIBRARIES ------------------------'
'msvbvm60.dll, VB6.OLB, VB6FR.DLL (Always required)
'COMDLG32.OCX (Common Dialog Control)
'-------------------- REQUIRED MODULES AND FORMS --------------------'
'None
'----------------------------- OPTIONS ------------------------------'
Option Base 0
Option Compare Text
Option Explicit
'+----------------------------------------------------------------------+'
'+ CONSTANTS +'
'+----------------------------------------------------------------------+'
'+----------------------------------------------------------------------+'
'+ TYPES AND ENUMS +'
'+----------------------------------------------------------------------+'
'Enum: dlgOptions
' Enumeration of the options to setup the open/save file dialog box.
'------------------------------------------------------------------------'
Enum dlgOptions
'(Open/Save) Dialog box will not follow shell links (shortcuts)
dlgNoFollowLinks = cdlOFNNoDereferenceLinks
'(Open/Save) Dialog box will not modify CurDir value
dlgNoChangeCurDir = cdlOFNNoChangeDir
'(Open) Dialog box will not display read-only check box
dlgHideReadOnlyCheckBox = cdlOFNHideReadOnly
'(Open) Dialog box will check read-only check box
dlgCheckReadOnly = cdlOFNReadOnly
'(Open) User will be prompted to create inexistent file
dlgCreatePrompt = cdlOFNCreatePrompt
'(Save) User will be prompted to overwrite existing file
dlgOverWritePrompt = cdlOFNOverwritePrompt
End Enum
'------------------------------------------------------------------------'
'Enum: RequestType
' Enumeration of the request types accessible to application.
'------------------------------------------------------------------------'
Enum RequestType
reqNew
reqOpen
reqReOpen
reqSave
reqSaveAs
reqClose
reqProperties
End Enum
'------------------------------------------------------------------------'
'Enum: ConfirmType
' Enumeration of the events confirmation accessible to application.
'------------------------------------------------------------------------'
Enum ConfirmationType
confNew
confOpen
confSave
confClose
End Enum
'+----------------------------------------------------------------------+'
'+ EVENTS +'
'+----------------------------------------------------------------------+'
' Events are raised to notify the application to actually display or
' close documents or perfom read/write operations on files.
'------------------------------------------------------------------------'
'Event: CreateDoc
' Parameters: None
'------------------------------------------------------------------------'
Event NewDoc()
'------------------------------------------------------------------------'
'Event: OpenDoc
' Parameters: Path: (String) The absolute path to a specific file.
'------------------------------------------------------------------------'
Event OpenDoc(Path As String)
'------------------------------------------------------------------------'
'Event: SaveDoc
' Parameters: Path: (String) The absolute path to a specific file.
'------------------------------------------------------------------------'
Event SaveDoc(Path As String)
'------------------------------------------------------------------------'
'Event: CloseDoc
' Parameters: None
'------------------------------------------------------------------------'
Event CloseDoc()
'+----------------------------------------------------------------------+'
'+ PROPERTIES +'
'+----------------------------------------------------------------------+'
'Common Dialog Control used for dialog boxes (write only).
'------------------------------------------------------------------------'
Private ComDlg As Control
'------------------------------------------------------------------------'
'Buttons of the application managed by the object.
'------------------------------------------------------------------------'
Private btnReopen
Private btnSave
Private btnSaveAs
Private btnClose
Private btnProp
'------------------------------------------------------------------------'
'Status of the document in calling application (write only).
'------------------------------------------------------------------------'
Private Created As Boolean
Private Opened As Boolean
Private Modified As Boolean
Private Saved As Boolean
Private Closed As Boolean
'------------------------------------------------------------------------'
'Document properties in calling application (read only).
'------------------------------------------------------------------------'
Private docPath As String
Private docName As String
Private docExt As String
Private docReadOnly As Boolean
'------------------------------------------------------------------------'
'Next document properties (neither read nor write).
'------------------------------------------------------------------------'
Private newPath As String
Private newName As String
Private newExt As String
Private newReadOnly As Boolean
'------------------------------------------------------------------------'
'Captions and messages of the interface (write only).
'------------------------------------------------------------------------'
Private wrnReopen As String
Private wrnModified As String
Private wrnReadOnly As String
Private captOpen As String
Private captSaveAs As String
Private captReadOnly As String
Private errNew As String
Private errOpen As String
Private errSave As String
Private errClose As String
Private docDefaultName As String
Private docDefaultExt As String
Private docDefaultFilter As String
'------------------------------------------------------------------------'
'Properties accessible to the application.
'------------------------------------------------------------------------'
Property Get Path() As String
Path = docPath
End Property
Property Get Name() As String
Name = docName
End Property
Property Get Ext() As String
Ext = docExt
End Property
Property Get ReadOnly() As String
ReadOnly = docReadOnly
End Property
'+----------------------------------------------------------------------+'
'+ INITIALIZE +'
'+----------------------------------------------------------------------+'
'Sub: Class_Initialize
' Executed when an instance of the class is created.
' Parameters: None
'------------------------------------------------------------------------'
Private Sub Class_Initialize()
'Set default language
SetLanguage _
"If you reopen a file, all changes will be lost." & vbCrLf & _
"Are you sure you want to reopen %0?", _
"The containt of file %0 has been modified." & vbCrLf & _
"Would you like to save changes?", _
"%0 is read-only." & vbCrLf & _
"To save a copy, clic OK and give the document a differen" & _
"t name in the Save as dialog box.", _
"Open", "Save as", "Read-only", _
"Unable to create %0.", _
"Unable to open %0.", _
"Unable to save %0.", _
"Unable to close %0.", _
"New document", "txt", "All files (*.*)|*.*"
End Sub
'------------------------------------------------------------------------'
'Sub: SetDialog
' Set the Common Dialog Control and options used for the open/save file
' dialog boxes.
' Parameters: CommonDialogControl: The reference to a control.
' DialogOptions (Optional): The options to setup the
' open/save file dialog box, see Enum dlgOptions for
' more informations.
'------------------------------------------------------------------------'
Sub SetDialog(CommonDialogControl As Control, Optional DialogOptions As _
dlgOptions)
DialogOptions = dlgOverWritePrompt
On Error Resume Next
Set ComDlg = CommonDialogControl
ComDlg.CancelError = True
ComDlg.Flags = cdlOFNExplorer _
+ cdlOFNFileMustExist _
+ cdlOFNNoReadOnlyReturn _
+ DialogOptions
End Sub
'------------------------------------------------------------------------'
'Sub: SetButtons
' Set the buttons managed by the object. objDocInApp can enable or
' disable controls depending on the document status.
' Parameters: ArrayOfButtonsReOpen (Optional): An array of controls of
' the application that are used to reopen documents
' ArrayOfButtonsSave (Optional): An array of controls of the
' application that are used to save documents
' ArrayOfButtonsSaveAs (Optional): An array of controls of
' the application that are used to save documents as
' ArrayOfButtonsClose (Optional): An array of controls of
' the application that are used to close documents
' ArrayOfButtonsProperties (Optional): An array of controls
' of the application that are used to get documents
' properties
'------------------------------------------------------------------------'
Sub SetButtons(Optional ArrayOfButtonsReOpen, Optional _
ArrayOfButtonsSave, Optional ArrayOfButtonsSaveAs, Optional _
ArrayOfButtonsClose, Optional ArrayOfButtonsProperties)
On Error Resume Next
btnReopen = ArrayOfButtonsReOpen
btnSave = ArrayOfButtonsSave
btnSaveAs = ArrayOfButtonsSaveAs
btnClose = ArrayOfButtonsClose
btnProp = ArrayOfButtonsProperties
End Sub
'------------------------------------------------------------------------'
'Sub: SetLanguage
' Set the messages displayed by the object. To display the name of the
' document in a string, use %0.
' Parameters: ReopenWarning (Optional): The message displayed before a
' document is reopened
' ModifiedWarning (Optional): The message displayed when
' closing a modified not saved document
' ReadOnlyWarning (Optional): The message displayed when
' saving a read-only document
' OpenCaption (Optional): The caption of the "Open" file
' dialog box
' SaveAsCaption (Optional): The caption of the "Save as"
' file dialog box
' ReadOnlyCaption (Optional): The caption of a file that is
' open with read-only attributes
' NewError (Optional): The message displayed when
' application was unable to create a new document
' OpenError (Optional): The message displayed when
' application was unable to open a document
' SaveError (Optional): The message displayed when
' application was unable to save a document
' CloseError (Optional): The message displayed when
' application was unable to close a document
' DocumentDefaultName (Optional): The default name given to
' new document
' DocumentDefaultExt (Optional): The default extension given
' to new document
' DocumentDefaultFilter (Optional): The default filter used
' by the open/save file dialog boxes
'------------------------------------------------------------------------'
Sub SetLanguage(Optional ReopenWarning, Optional ModifiedWarning, _
Optional ReadOnlyWarning, Optional OpenCaption, Optional SaveAsCaption, _
Optional ReadOnlyCaption, Optional NewError, Optional OpenError, _
Optional SaveError, Optional CloseError, Optional DocumentDefaultName, _
Optional DocumentDefaultExt, Optional DocumentDefaultFilter)
If Not IsMissing(ReopenWarning) _
Then wrnReopen = ReopenWarning
If Not IsMissing(ModifiedWarning) _
Then wrnModified = ModifiedWarning
If Not IsMissing(ReadOnlyWarning) _
Then wrnModified = ModifiedWarning
If Not IsMissing(OpenCaption) _
Then captOpen = OpenCaption
If Not IsMissing(SaveAsCaption) _
Then captSaveAs = SaveAsCaption
If Not IsMissing(ReadOnlyCaption) _
Then captReadOnly = ReadOnlyCaption
If Not IsMissing(NewError) _
Then errNew = NewError
If Not IsMissing(OpenError) _
Then errOpen = OpenError
If Not IsMissing(SaveError) _
Then errSave = SaveError
If Not IsMissing(CloseError) _
Then errClose = CloseError
If Not IsMissing(DocumentDefaultName) _
Then docDefaultName = DocumentDefaultName
If Not IsMissing(DocumentDefaultExt) _
Then docDefaultExt = DocumentDefaultExt
If Not IsMissing(DocumentDefaultFilter) _
Then docDefaultFilter = DocumentDefaultFilter
End Sub
'+----------------------------------------------------------------------+'
'+ REQUEST +'
'+----------------------------------------------------------------------+'
'Function: Request
' Perform requested action on the active document. Returns "True" if the
' action was succesfully completed.
' Parameters: rType: Numeric value (Long) indicating the type of action
' to perform. See Enum "RequestType" for values.
' FileName (Optional):
' DefaultExt (Optional):
' InitDir (Optional):
' Filter (Optional):
' FilterIndex (Optional):
'------------------------------------------------------------------------'
Function Request(rType As RequestType, Optional FileName, Optional _
DefaultExt, Optional InitDir, Optional Filter, Optional FilterIndex) As _
Boolean
Dim NextAction As String
Select Case rType
'Case new document
Case reqNew
'Ask to close active document
If AskClose(InitDir, Filter, FilterIndex, DefaultExt) Then
'Ask to make a new document
If AskNew(FileName, DefaultExt) Then
'Complete action "close"
If ActionClose() Then
'Complete action "new"
Request = ActionNew()
End If
End If
End If
'Case open document
Case reqOpen
'Ask to close active document
If AskClose(InitDir, Filter, FilterIndex, DefaultExt) Then
'Ask to select a document
If AskOpen(FileName, InitDir, Filter, FilterIndex) Then
'Complete action "close"
If ActionClose() Then
'Complete action "open"
Request = ActionOpen()
End If
End If
End If
'Case re-open document
Case reqReOpen
'Ask to confirm re-open
If AskReOpen() Then
'Complete action "close"
If ActionClose() Then
'Complete action "open"
Request = ActionOpen()
End If
End If
'Case save document
Case reqSave
'Ask to save document
If AskSave(InitDir, Filter, FilterIndex, DefaultExt) Then
'Complete action "save"
Request = ActionSave()
End If
'Case save document as
Case reqSaveAs
'Ask to save the document as
If AskSaveAs(FileName, InitDir, _
Filter, FilterIndex, DefaultExt) Then
'Complete action "save"
Request = ActionSave()
End If
'Case close document
Case reqClose
'Ask to close active document
If AskClose(InitDir, Filter, FilterIndex, DefaultExt) Then
'Complete action "close"
Request = ActionClose()
End If
Case reqProperties
MsgBox "Not available yet."
End Select
End Function
'+----------------------------------------------------------------------+'
'+ QUESTIONS +'
'+----------------------------------------------------------------------+'
'Function: AskNew
' Prepares new attributes.
' Returns "True".
' Parameters: FileName (Optional): A string expression that specify
' the name of the new document (it is not a path).
' DefaultExt (Optional): A string expression that specify
' the extension of the new document.
'------------------------------------------------------------------------'
Private Function AskNew(Optional FileName, Optional DefaultExt) As Boolean
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
'Set new document path
newPath = ""
'Set new document name
If IsMissing(FileName) _
Then newName = docDefaultName _
Else newName = FSO.GetBaseName(FileName)
'Set document extension
If IsMissing(DefaultExt) _
Then newExt = docDefaultExt _
Else newExt = DefaultExt
'Set document status
newReadOnly = False
'Returns succes
AskNew = True
End Function
'------------------------------------------------------------------------'
'Function: AskOpen
' Prompt the user to select a file to open and store selection in global
' variables "newPath", "newName", "newExt" and "newReadOnly".
' Returns "True" if the user pressed OK, "False" if he pressed Cancel.
' Parameters: FileName (Optional): A string expression that specify the
' filename displayed (and selected) first in the open
' file dialog box. It may include drive, path, pattern
' and qualified network path. In such case it overrides
' InitDir parameter.
' InitDir (Optional): A string expression that specify the
' directory displayed first in the open file dialog box.
' Filter (Optional): A string expression that specify wich
' type of file the user is allowed to select.
' Syntax "Description1|Filter1|Description2|Filter2"
' Parts: Description: A string expression describing the
' type of file.
' Filter: A string expression specifying the
' filename extensions.
' Use the pipe ("|") to separate the description
' and filter values and use the semicolon (";")
' to separate extensions.
' FilterIndex (Optional): A numeric expression specifying
' the default filter
'------------------------------------------------------------------------'
Private Function AskOpen(Optional FileName, Optional InitDir, Optional _
Filter, Optional FilterIndex) As Boolean
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
On Error GoTo Err_UserPressCancel
'Set dialog box caption
ComDlg.DialogTitle = captOpen
'Set dialog box initial directory
If IsMissing(InitDir) _
Then ComDlg.InitDir = "" _
Else ComDlg.InitDir = InitDir
'Set dialog box initial filename
If IsMissing(FileName) _
Then ComDlg.FileName = "" _
Else ComDlg.FileName = FileName
'Set dialog box filter
If IsMissing(Filter) _
Then ComDlg.Filter = docDefaultFilter _
Else ComDlg.Filter = Filter
'Set dialog box filter index
If IsMissing(FilterIndex) _
Then ComDlg.FilterIndex = 1 _
Else ComDlg.FilterIndex = FilterIndex
'Show open file dialog box
ComDlg.ShowOpen
'Store user selection in newVariables
newPath = ComDlg.FileName
newName = ComDlg.FileTitle
newExt = FSO.GetExtensionName(newPath)
newReadOnly = CBool(ComDlg.Flags And cdlOFNReadOnly) _
Or CBool(FSO.GetFile(newPath).Attributes And 1)
'Return success
AskOpen = True
Exit Function
'User pressed cancel
Err_UserPressCancel:
End Function
'------------------------------------------------------------------------'
'Function: AskReOpen
' Prompt the user about risks of losing changes.
' Returns "True" if the user confirms re-opening, "False" if not.
' Parameters: None
'------------------------------------------------------------------------'
Private Function AskReOpen() As Boolean
'Prompt user
Select Case MsgBoxA(wrnReopen, vbQuestion + vbYesNoCancel)
Case vbYes
'Set newVariables to previous value
newPath = docPath
newName = docName
newExt = docExt
newReadOnly = docReadOnly
'Return success
AskReOpen = True
End Select
End Function
'------------------------------------------------------------------------'
'Function: AskSave
' Returns "True" if the document can actually be saved to its current
' path. Otherwise, returns the "AskSavAs" answer.
' Parameters: InitDir (Optional): A string expression that specify the
' directory displayed first in the save file dialog box.
' Used only in case document has no path (new document).
' Filter (Optional): A string expression that specify wich
' type of file the user is allowed to select. Used only
' if document has to be saved as.
' Syntax "Description1|Filter1|Description2|Filter2"
' Parts: Description: A string expression describing the
' type of file.
' Filter: A string expression specifying the
' filename extensions.
' Use the pipe ("|") to separate the description
' and filter values and use the semicolon (";")
' to separate extensions.
' FilterIndex (Optional): A numeric expression specifying
' the default filter
' DefaultExt (Optional): A string expression that specify
' wich extension is added to filename if no extension
' and no filter is specified ("*.*") or if extension
' does not fit filter specifications nor any known file
' type. Used only if document has to be saved as.
'------------------------------------------------------------------------'
Private Function AskSave(Optional InitDir, Optional Filter, Optional _
FilterIndex, Optional DefaultExt) As Boolean
'If document has no path (new document)
If docPath = "" Then
AskSave = AskSaveAs(docName, InitDir, Filter, _
FilterIndex, docExt)
'If document has a path
Else
'If document is read-only
If docReadOnly Then
Call MsgBoxA(wrnReadOnly, vbExclamation)
AskSave = AskSaveAs(docPath, , Filter, _
FilterIndex, docExt)
'Document has a path and is not read-only
Else
newPath = docPath
newName = docName
newExt = docExt
newReadOnly = docReadOnly
'Ready to save
AskSave = True
End If
End If
End Function
'------------------------------------------------------------------------'
'Function: AskSaveAs
' Prompt the user to select a path to save the active document and store
' selection in global variables "newPath", "newName", "newExt" and
' "newReadOnly".
' Returns "True" if the user pressed OK, "False" if he pressed Cancel.
' Parameters: FileName (Optional): A string expression that specify the
' filename displayed (and selected) first in the save
' file dialog box. It may include drive, path, pattern
' and qualified network path. In such case it overrides
' InitDir parameter.
' InitDir (Optional): A string expression that specify the
' directory displayed first in the save file dialog box.
' Filter (Optional): A string expression that specify wich
' type of file the user is allowed to select.
' Syntax "Description1|Filter1|Description2|Filter2"
' Parts: Description: A string expression describing the
' type of file.
' Filter: A string expression specifying the
' filename extensions.
' Use the pipe ("|") to separate the description
' and filter values and use the semicolon (";")
' to separate extensions.
' FilterIndex (Optional): A numeric expression specifying
' the default filter
' DefaultExt (Optional): A string expression that specify
' wich extension is added to filename if no extension
' and no filter is specified ("*.*") or if extension
' does not fit filter specifications nor any known file
' type.
'------------------------------------------------------------------------'
Private Function AskSaveAs(Optional FileName, Optional InitDir, Optional _
Filter, Optional FilterIndex, Optional DefaultExt) As Boolean
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
On Error GoTo Err_UserPressCancel
'If there is an active document
If docName <> "" Then
'Set dialog box caption
ComDlg.DialogTitle = captSaveAs
'Set dialog box initial directory
If IsMissing(InitDir) _
Then ComDlg.InitDir = FSO.GetParentFolder(docPath) _
Else ComDlg.InitDir = InitDir
'Set dialog box initial filename
If IsMissing(FileName) _
Then ComDlg.FileName = docName _
Else ComDlg.FileName = FileName
'Set dialog box filter
If IsMissing(Filter) _
Then ComDlg.Filter = docDefaultFilter _
Else ComDlg.Filter = Filter
'Set dialog box filter index
If IsMissing(FilterIndex) _
Then ComDlg.FilterIndex = 1 _
Else ComDlg.FilterIndex = FilterIndex
'Set dialog box default extension
If IsMissing(DefaultExt) _
Then ComDlg.DefaultExt = docDefaultExt _
Else ComDlg.DefaultExt = DefaultExt
'Show save file dialog box
ComDlg.ShowSave
'Store user selection in newVariables
newPath = ComDlg.FileName
newName = ComDlg.FileTitle
newExt = FSO.GetExtensionName(newPath)
newReadOnly = False
End If
'Return success
AskSaveAs = True
Exit Function
'User pressed cancel
Err_UserPressCancel:
End Function
'------------------------------------------------------------------------'
'Function: AskClose
' Prompt the user to save changes.
' Returns "True" if the user pressed No, "False" if he pressed Cancel.
' If the user chooses Yes, returns "True" only after document was
' succesfully saved.
' Parameters: InitDir (Optional): A string expression that specify the
' directory displayed first in the save file dialog box.
' Used only in case user wants to save changes.
' Filter (Optional): A string expression that specify wich
' type of file the user is allowed to select. Used only
' in case user wants to save changes.
' Syntax "Description1|Filter1|Description2|Filter2"
' Parts: Description: A string expression describing the
' type of file.
' Filter: A string expression specifying the
' filename extensions.
' Use the pipe ("|") to separate the description
' and filter values and use the semicolon (";")
' to separate extensions.
' FilterIndex (Optional): A numeric expression specifying
' the default filter
' DefaultExt (Optional): A string expression that specify
' wich extension is added to filename if no extension
' and no filter is specified ("*.*") or if extension
' does not fit filter specifications nor any known file
' type. Used only in case user wants to save changes.
'------------------------------------------------------------------------'
Private Function AskClose(Optional InitDir, Optional Filter, Optional _
FilterIndex, Optional DefaultExt) As Boolean
'If document was modifified
If Modified Then
'Prompt user
Select Case MsgBoxA(wrnModified, vbExclamation + vbYesNoCancel)
'User wants to save changes
Case vbYes
If AskSave(InitDir, Filter, FilterIndex, DefaultExt) Then
'Close is accepted after document was saved
AskClose = ActionSave()
End If
'User doesn't want to save changes
Case vbNo
'Close is accepted anyway
AskClose = True
End Select
'Document was not modifified
Else
AskClose = True
End If
End Function
'+----------------------------------------------------------------------+'
'+ ACTIONS +'
'+----------------------------------------------------------------------+'
'Function: ActionNew
' Sends an event to the application to create a new document.
' Returns "True" if the application actually created the document.
' Parameters: None
'------------------------------------------------------------------------'
Private Function ActionNew() As Boolean
'Raise the NewDoc event
Created = False
RaiseEvent NewDoc
'If document was created
If Created Then
'Set document properties
docPath = newPath
docName = newName
docExt = newExt
docReadOnly = newReadOnly
Modified = False
'Display document title
Call DisplayTitle
Call EnableButtons(False, True, True, True, False)
'Return succes
ActionNew = True
'If document was not created
Else
Call MsgBoxA(errNew, vbExclamation)
End If
End Function
'------------------------------------------------------------------------'
'Function: ActionOpen
' Sends an event to the application to open a specified document.
' Returns "True" if the application actually opened the document.
' Parameters: None
'------------------------------------------------------------------------'
Private Function ActionOpen() As Boolean
'Raise the OpenDoc event
Opened = False
RaiseEvent OpenDoc(newPath)
'If document was opened
If Opened Then
'Set document properties
docPath = newPath
docName = newName
docExt = newExt
docReadOnly = newReadOnly
Modified = False
'Display document title
Call DisplayTitle
Call EnableButtons(True, True, True, True, True)
'Return succes
ActionOpen = True
'If document was not opened
Else
Call MsgBoxA(errOpen, vbExclamation)
End If
End Function
'------------------------------------------------------------------------'
'Function: ActionSave
' Sends an event to the application to save the active document to a
' specified path.
' Returns "True" if the application actually saved the document.
' Parameters: None
'------------------------------------------------------------------------'
Private Function ActionSave() As Boolean
'If there is an active document
If docName <> "" Then
'Raise the SaveDoc event
Saved = False
RaiseEvent SaveDoc(newPath)
'If document was saved
If Saved Then
'Set document properties
docPath = newPath
docName = newName
docExt = newExt
docReadOnly = False
Modified = False
'Display document title
Call DisplayTitle
Call EnableButtons(True, True, True, True, True)
'Return succes
ActionSave = True
'If document was not saved
Else
Call MsgBoxA(errSave, vbExclamation)
End If
End If
End Function
'------------------------------------------------------------------------'
'Function: ActionClose
' Sends an event to the application to close the active document.
' Returns "True" if the application actually closed the document.
' Parameters: None
'------------------------------------------------------------------------'
Private Function ActionClose() As Boolean
'If there is an active document
If docName <> "" Then
'Raise the SaveDoc event
Closed = False
RaiseEvent CloseDoc
'If document was closed
If Closed Then
'Set document properties
docPath = ""
docName = ""
docExt = ""
docReadOnly = False
Modified = False
'Display document title
Call DisplayTitle
Call EnableButtons(False, False, False, False, False)
'Return succes
ActionClose = True
'If document was not closed
Else
Call MsgBoxA(errClose, vbExclamation)
End If
'There is no active document
Else
ActionClose = True
End If
End Function
'+----------------------------------------------------------------------+'
'+ CONFIRMATIONS +'
'+----------------------------------------------------------------------+'
'Function: Confirm
' Procedure executed by the application to confirm actions requested by
' the object.
' Parameters: cType: Numeric value (Long) indicating the type of
' confirmation sent by the application. See Enum
' "ConfirmationType" for values.
'------------------------------------------------------------------------'
Sub Confirm(cType As ConfirmationType)
Select Case cType
Case confNew
Created = True
Case confOpen
Opened = True
Case confSave
Saved = True
Case confClose
Closed = True
End Select
End Sub
'+----------------------------------------------------------------------+'
'+ MODIFICATIONS +'
'+----------------------------------------------------------------------+'
'Sub: Modify
' Set flag "Modified" to "True".
' Parameters: None
'------------------------------------------------------------------------'
Sub Modify()
If docName <> "" Then Modified = True
End Sub
'+----------------------------------------------------------------------+'
'+ OTHER FUNCTIONS +'
'+----------------------------------------------------------------------+'
'Function: MsgBoxA
' Prompt the user with a message box in which appears the name or path
' of the active document.
' Parameters: Prompt: A string expression specifying the message to
' display, "%0" string will be replaced by the name or
' path of the active document.
' Buttons (Optional): Numeric expression that is the sum of values
' specifying the number and type of buttons to display,
' the icon style to use, the identity of the default
' button, and the modality of the message box. If
' omitted, the default value for buttons is 0.
'------------------------------------------------------------------------'
Private Function MsgBoxA(ByVal Prompt, Buttons As VbMsgBoxStyle)
Prompt = Replace(Prompt, "%0", IIf(docPath = "", docName, docPath))
MsgBoxA = MsgBox(Prompt, Buttons, App.Title)
End Function
'------------------------------------------------------------------------'
'Sub: DisplayTitle
' Modify the text displayed in the application main form title bar.
' Parameters: None
'------------------------------------------------------------------------'
Private Sub DisplayTitle()
Dim Title As String
If docName = "" Then
Title = App.Title
ElseIf docReadOnly Then
Title = docName & " [" & captReadOnly & "] - " & App.Title
Else
Title = docName & " - " & App.Title
End If
On Error Resume Next
ComDlg.Parent.Caption = Title
End Sub
'------------------------------------------------------------------------'
'Sub: EnableButtons
' Set the enabled status of the buttons managed by the object depending
' on the document status.
' Parameters: EnableReOpen: Status of the "Reopen" buttons
' EnableSave: Status of the "Save" buttons
' EnableSaveAs: Status of the "Save as" buttons
' EnableClose: Status of the "Close" buttons
' EnableProperties: Status of the "Properties" buttons
'------------------------------------------------------------------------'
Private Sub EnableButtons(EnableReopen As Boolean, EnableSave As _
Boolean, EnableSaveAs As Boolean, EnableClose As Boolean, EnableProp As _
Boolean)
Call EnableArrayOfButtons(btnReopen, EnableReopen)
Call EnableArrayOfButtons(btnSave, EnableSave)
Call EnableArrayOfButtons(btnSaveAs, EnableSaveAs)
Call EnableArrayOfButtons(btnClose, EnableClose)
Call EnableArrayOfButtons(btnProp, EnableProp)
End Sub
'------------------------------------------------------------------------'
'Sub: EnableArrayOfButtons
' Set the enabled status of an array of buttons.
' Parameters: ArrayOfButtons: An array of controls
' Enabled: Status of the buttons in the array
'------------------------------------------------------------------------'
Private Sub EnableArrayOfButtons(ArrayOfButtons, Enabled As Boolean)
Dim i As Long
On Error Resume Next
For i = LBound(ArrayOfButtons) To UBound(ArrayOfButtons)
ArrayOfButtons(i).Enabled = Enabled
Next
End Sub
Conclusion :
C'est mon premier module de classe. Jusqu'a quelques jours auparavant, les objets me semblaient d'obscures mysteres meme si mon ami Julien me disait toujours : "Tu devrais faire des classes mon petit Santi !"
Je ne revendique pour seule source que la MSDN janvier 2001 que j'ai epluchee en profondeur.
La classe est assez complete et exempte de plantage (je crois) pourtant il reste beaucoup a faire, si vous voulez participer au projet, realisez une des ameliorations suivantes et vous serez inscrits dans les auteurs du module :
- ajouter la method "AskProperties" qui ouvrirait la fenetre Windows de propriete d'un document. Je suppose qu'il faut evoquer quelques API dont je suis loin de comprendre le fonctionnement.
- ajouter une sur-classe "cls_DocsManager" qui implementerait une collection de "cls_DocInApp" et permettrait a votre application de gerer plusieurs documents ouverts simultanement.
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.