Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
fbcomdlg.bi
| Uploader: |  hansholger |
| Datum/Zeit: | 25.03.2014 17:39:58 |
#include Once "win\commdlg.bi"
' Save und Open Dialog
Type FSaveOpen Extends Object
Declare Property Caption(value As String)
Declare Property Caption As String
Declare Property FileName(value As String)
Declare Property FileName As String
Declare Property Filter(value As String)
Declare Property Filter As String
Declare Property FilterIndex(value As Integer)
Declare Property InitialDir(value As String)
Declare VIRTUAL Function Execute(ByVal hParent As HWND) As Integer
Declare Constructor
Declare Destructor
As String s_Caption
As String s_FileName
As String s_Filter
As String s_InitialDir
As Integer s_FilterIndex
End Type
Constructor FSaveOpen
this.s_InitialDir = CurDir
this.s_Caption = "Open/Save"
this.s_Filter = "All Files, (*.*)"+Chr(0)+"*.*"+Chr(0,0)
this.s_FilterIndex = 1
End Constructor
Destructor FSaveOpen
this.s_InitialDir = ""
End Destructor
Property FSaveOpen.Caption(value As String)
this.s_Caption = value
End Property
Property FSaveOpen.Caption As String
Return this.s_Caption
End Property
Property FSaveOpen.FileName(value As String)
this.s_FileName = value
End Property
Property FSaveOpen.FileName As String
Return this.s_FileName
End Property
Property FSaveOpen.Filter(value As String)
Dim As String sTmp
Dim As Integer i
For i=1 To Len(value)
If (Mid(value,i,1) = Chr(124)) Or (Mid(value,i,1) = Chr(47)) Then
Mid(value,i,1) = Chr(0)
EndIf
Next
value = value + Chr(0,0)
this.s_Filter = value
End Property
Property FSaveOpen.Filter As String
Return this.s_Filter
End Property
Property FSaveOpen.FilterIndex(value As Integer)
this.s_FilterIndex = value
End Property
Property FSaveOpen.InitialDir(value As String)
this.s_InitialDir = value
End Property
Function FSaveOpen.Execute(ByVal hParent As HWND) As Integer
Return 0
End Function
'---------------------------------------------------------------------------------
' Openfile
'---------------------------------------------------------------------------------
Type FOpenFile Extends FSaveOpen
Declare Function Execute(ByVal hParent As HWND) As Integer
End Type
Function FOpenFile.Execute(ByVal hParent As HWND) As Integer
dim ofn as OPENFILENAME
dim szfname As zstring * MAX_PATH+1
Dim szFilter As ZString * 128
Dim szCapt As ZString * 128
szCapt = this.s_Caption
szFilter = this.s_Filter
with ofn
.lStructSize = sizeof( OPENFILENAME )
.hwndOwner = hParent
.hInstance = GetModuleHandle( NULL )
.lpstrFilter = @szFilter
.lpstrCustomFilter = NULL
.nMaxCustFilter = 0
.nFilterIndex = this.s_FilterIndex '"All File|*.*|Basic|*.bas|Include|*.bi"
.lpstrFile = @szfname
.nMaxFile = sizeof(szfname)
.lpstrFileTitle = NULL
.nMaxFileTitle = 0
.lpstrInitialDir = NULL
.lpstrTitle = @szCapt
.Flags = OFN_EXPLORER or OFN_FILEMUSTEXIST or OFN_PATHMUSTEXIST
.nFileOffset = 0
.nFileExtension = 0
.lpstrDefExt = NULL
.lCustData = 0
.lpfnHook = NULL
.lpTemplateName = NULL
end with
if( GetOpenFileName( @ofn ) = FALSE ) then
Function = 0
else
this.s_FileName = szfname
Function = 1
end if
End Function
'---------------------------------------------------------------------------------
' Savefile
'---------------------------------------------------------------------------------
Type FSaveFile Extends FSaveOpen
Declare Function Execute(ByVal hParent As HWND) As Integer
End Type
Function FSaveFile.Execute(ByVal hParent As HWND) As Integer
dim ofn as OPENFILENAME
dim szfname As zstring * MAX_PATH+1
Dim szFilter As ZString * 128
Dim szCapt As ZString * 128
szCapt = this.s_Caption
szFilter = this.s_Filter
with ofn
.lStructSize = sizeof( OPENFILENAME )
.hwndOwner = hParent
.hInstance = GetModuleHandle( NULL )
.lpstrFilter = @szFilter
.lpstrCustomFilter = NULL
.nMaxCustFilter = 0
.nFilterIndex = this.s_FilterIndex
.lpstrFile = @szfname
.nMaxFile = sizeof(szfname)
.lpstrFileTitle = NULL
.nMaxFileTitle = 0
.lpstrInitialDir = NULL
.lpstrTitle = @szCapt
.Flags = OFN_EXPLORER or OFN_PATHMUSTEXIST
.nFileOffset = 0
.nFileExtension = 0
.lpstrDefExt = NULL
.lCustData = 0
.lpfnHook = NULL
.lpTemplateName = NULL
end with
if( GetSaveFileName( @ofn ) = FALSE ) then
Function = 0
else
this.s_FileName = szfname
Function = 1
end if
End Function
'---------------------------------------------------------------------------------
' Color - Dialog
'---------------------------------------------------------------------------------
Function getColor(BYVAL hWnd AS HWND) AS UInteger
Dim ccf AS ChooseColor
Dim i AS Integer
Dim retRGB AS UInteger
DIM iRGB(0 To 15) AS UInteger
FOR i = 0 TO 15
iRGB(i)=0
Next i
retRGB = 0
ccf.lStructSize = LEN(ccf)
ccf.hwndOwner = hWnd
ccf.hInstance = 0
ccf.Flags = 0
ccf.lpCustColors=VARPTR(iRGB(0))
ccf.rgbResult =retRGB
IF ChooseColor(@ccf) THEN
FUNCTION = ccf.rgbResult
EXIT FUNCTION
ELSE
FUNCTION = -1 ' Abbruch
END IF
End Function