Versions Compared

Key

  • This line was added.
  • This line was removed.
  • Formatting was changed.

保存ダイアログを呼び出すサンプル・アプリケーションを実行するには、このコードをコピーしてフォームに貼り付けてください。フォームは、フルRDMLX使用可能でなくてはなりません。

     *

...


*

...


...

     * COMPONENT:  STD_FORM
*

...


*

...


Function Options(*DIRECT)
Begin_

...

Com Role(*

...

EXTENDS #PRIM_FORM)

...

 CLIENTHEIGHT(686)

...

 CLIENTWIDTH(456)

...

 HEIGHT(713)

...

 LEFT(465)

...

 TOP(108)

...

 WIDTH(464)
Define_

...

Com Class(#PRIM_LABL)

...

 Name(#InitialValuesLbl)

...

 CAPTION('

...

Save dialog Inital values')

...

 DISPLAYPOSITION(5)

...

 HEIGHT(20)

...

 LEFT(8)

...

 PARENT(#COM_OWNER)

...

 TABPOSITION(5)

...

 TABSTOP(False)

...

 TOP(8)

...

 WIDTH(137)
Define_

...

Com Class(#PRIM_LABL)

...

 Name(#InitialSaveFileLbl)

...

 CAPTION('

...

Initial Directory')

...

 DISPLAYPOSITION(4)

...

 HEIGHT(20)

...

 LEFT(24)

...

 PARENT(#COM_OWNER)

...

 TABPOSITION(4)

...

 TABSTOP(False)

...

 TOP(32)

...

 WIDTH(81)
Define_Com Class(#PRIM_EDIT) Name(#InitialDirectory) DISPLAYPOSITION(3) LEFT(112) PARENT(#COM_OWNER) SHOWSELECTION(False) SHOWSELECTIONHILIGHT(False) TABPOSITION(3) TOP(32) WIDTH(289)
Define_Com Class(#PRIM_PHBN) Name(#PHBN_1) CAPTION('Start Save File Dialog') DISPLAYPOSITION(1) LEFT(8) PARENT(#COM_OWNER) TABPOSITION(1) TOP(224) WIDTH(161)
Define_Com Class(#PRIM_APPL.ICommonDialogFileSave) Name(#saveFileDlg) Reference(*DYNAMIC)
Define_Com Class(#PRIM_LABL) Name(#ResultLbl) CAPTION('Save File dialog results') DISPLAYPOSITION(6) HEIGHT(25) LEFT(8) PARENT(#COM_OWNER) TABPOSITION(6) TABSTOP(False) TOP(264) WIDTH(121)
Define_

...

Com Class(#PRIM_GPBX)

...

 Name(#GPBX_1)

...

 DISPLAYPOSITION(7)

...

 HEIGHT(81)

...

 LEFT(32)

...

 PARENT(#COM_OWNER)

...

 TABPOSITION(7)

...

 TABSTOP(False)

...

 TOP(304)

...

 WIDTH(193)
Define_

...

Com Class(#PRIM_RDBN)

...

 Name(#OkButtonPressed)

...

 CAPTION('

...

OK Button pressed')

...

 DISPLAYPOSITION(1)

...

 LEFT(16)

...

 PARENT(#GPBX_1)

...

 TABPOSITION(1)

...

 TOP(16)
Define_

...

Com Class(#PRIM_RDBN)

...

 Name(#CancelButtonPressed)

...

 CAPTION('

...

Cancel Button pressed')

...

 DISPLAYPOSITION(2)

...

 LEFT(16)

...

 PARENT(#GPBX_1)

...

 TABPOSITION(2)

...

 TOP(48)

...

 WIDTH(153)

...

     * Explorer mode has no effect on Save File - it is a Windows problem so it has been disabled in the tests
* DEFINE_COM CLASS(#PRIM_CKBX) NAME(#ExplorerMode) CAPTION('Explorer Mode') DISPLAYPOSITION(8) LEFT(24) PARENT(#COM_OWNER) TABPOSITION(8) TOP(152)
Define_

...

Com Class(#AAsavefil)

...

 Name(#SaveFileDlgForm)
Define_

...

Com Class(#PRIM_EDIT)

...

 Name(#Title)

...

 DISPLAYPOSITION(8)

...

 LEFT(112)

...

 PARENT(#COM_OWNER)

...

 SHOWSELECTION(False)

...

 SHOWSELECTIONHILIGHT(False)

...

 TABPOSITION(8)

...

 TOP(56)

...

 WIDTH(289)
Define_

...

Com Class(#PRIM_LABL)

...

 Name(#TitleLbl)

...

 CAPTION('Title')

...

 DISPLAYPOSITION(9)

...

 HEIGHT(25)

...

 LEFT(24)

...

 PARENT(#COM_OWNER)

...

 TABPOSITION(9)

...

 TABSTOP(False)

...

 TOP(56)

...

 WIDTH(81)
Define_Com Class(#PRIM_CKBX) Name(#overwritePrompt) CAPTION('Overwrite Prompt') DISPLAYPOSITION(10) LEFT(24) PARENT(#COM_OWNER) TABPOSITION(10) TOP(128)
Define_

...

Com Class(#PRIM_LTBX)

...

 Name(#fileLst)

...

 DISPLAYPOSITION(2)

...

 HEIGHT(210)

...

 LEFT(16)

...

 PARENT(#COM_OWNER)

...

 SHOWSELECTION(True)

...

 TABPOSITION(2)

...

 TOP(450)

...

 WIDTH(225)
Define_

...

Com Class(#PRIM_LBCL)

...

 Name(#TRACECOL1)

...

 DISPLAYPOSITION(1)

...

 PARENT(#fileLst)

...

 SOURCE(#STD_TEXT)

...

 WIDTH(10)
Define_

...

Com Class(#PRIM_EDIT)

...

 Name(#File)

...

 DISPLAYPOSITION(11)

...

 LEFT(112)

...

 PARENT(#COM_OWNER)

...

 SHOWSELECTION(False)

...

 SHOWSELECTIONHILIGHT(False)

...

 TABPOSITION(11)

...

 TOP(80)

...

 WIDTH(289)
Define_Com Class(#PRIM_LABL) Name(#FileLb) CAPTION('File') DISPLAYPOSITION(12) HEIGHT(23) LEFT(27) PARENT(#COM_OWNER) TABPOSITION(12) TABSTOP(False) TOP(80) WIDTH(54)

...

     Evtroutine Handling(#com_owner.Initialize)

...

     Set Com(#com_owner)

...

 CAPTION(*component_desc)
Endroutine

...

     Evtroutine Handling(#PHBN_1.Click)
Invoke Method(#sys_appln.CreateFileSaveDialog) RESULT(#SaveFileDLG)
Define Field(#boolRes) Type(*BOOLEAN)
Clr_List Named(#filelst)
#SaveFileDLG.

...

Title :=

...

 #TITLE.Text
#saveFileDLG.

...

InitialDir :=

...

 #INITIALDIRECTORY.Text
#saveFILEDLG.File := #FILE.Text
#saveFileDLG.AddFilter( 'First entry (

...

.nothing)' '

...

.nothing' )

...

     * deliberately make .cpp as .hpp to check overwriting facility later
#saveFileDLG.AddFilter(

...

 'C++

...

 defn files (

...

.cpp)'

...

 '

...

.hpp'

...

 )
#saveFileDLG.AddFilter( 'C++ header files ( ended with

...

 .hpp)' '

...

.hpp' )

...

     * correct the first the initial filter
#saveFileDLG.FilterCaption<2> := 'C++

...

 defn files (corrected to *.cpp & *.c)'
#saveFileDLG.

...

FilterExtension<2> :=

...

 '

...

.cpp;

...

.c'

...

     * add an extra filter
#saveFileDLG.FilterCaption<4> := 'Text Files (*.txt)'
#saveFileDLG.

...

FilterExtension<4> :=

...

 '*.txt'

...

     * select something non-default
#saveFileDLG.FilterIndex := 2

...

     If (#overwriteprompt.

...

ButtonState =

...

 checked)
#saveFILEDLG.

...

OverwritePrompt :=

...

 true
Else
#saveFILEDLG.

...

OverwritePrompt :=

...

 false
Endif

...

     * Explorer mode has no effect on Save File - it is a Windows problem so it has been disabled in the tests
* IF (#Explorermode.ButtonState = checked)
* #saveFILEDLG.ExplorerStyle := true
* ELSE
* #saveFILEDLG.ExplorerStyle := false
* ENDIF
Invoke Method(#saveFileDLG.Show) OKPRESSED(#boolRes) FORMOWNER(#com_self)
If (#BOOLRES)
#OKBUTTONPRESSED.ButtonChecked := true
#CANCELBUTTONPRESSED.ButtonChecked := false
Define Field(#i) Type(*INT)
#i := 1
#std_text := #saveFILEDLG.FileTitle
Add_Entry To_List(#filelst)
Else
#CANCELBUTTONPRESSED.ButtonChecked := true
#okbUTTONPRESSED.ButtonChecked := false
Endif
Endroutine
End_Com