Api # Private Type ChooseColor
lStructSize As Long hwndOwner As Long hInstance As Long rgbResult As Long lpCustColors As String flags As Long lCustData As Long lpfnHook As Long lpTemplateName As String End Type Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long Private Sub Command1_Click() Dim ofn As OPENFILENAME ofn.lStructSize = Len(ofn) ofn.hwndOwner = Form1.hWnd ofn.hInstance = App.hInstance ofn.lpstrFilter = "Text Files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "Rich Text Files (*.rtf)" + Chr$(0) + "*.rtf" + Chr$(0) ofn.lpstrFile = Space$(254) ofn.nMaxFile = 255 ofn.lpstrFileTitle = Space$(254) ofn.nMaxFileTitle = 255 ofn.lpstrInitialDir = "c:\" ofn.lpstrTitle = "Seleziona un file da aprire" ofn.flags = 0 Dim a a = GetOpenFileName(ofn) If (a) Then MsgBox "File aperto: " + Trim$(ofn.lpstrFile) Else MsgBox "Hai premuto Annulla" End If End Sub Private Sub Command2_Click() Dim cc As ChooseColor Dim CustColor(16) As Long cc.lStructSize = Len(cc) cc.hwndOwner = Form1.hWnd cc.hInstance = App.hInstance cc.flags = 0 'NOTE: We can't pass an array of pointers so ' we fake this passing a string of chars: In this 'example we set all custom colors to 0, or black. cc.lpCustColors = String$(16 * 4, 0) Dim a Dim x Dim c1 Dim c2 Dim c3 Dim c4 a = ChooseColor(cc) Cls If (a) Then MsgBox "Colore selezionato:" & Str$(cc.rgbResult) 'Create the custom color array based on 'the colors passed back from the String For x = 1 To Len(cc.lpCustColors) Step 4 c1 = Asc(Mid$(cc.lpCustColors, x, 1)) c2 = Asc(Mid$(cc.lpCustColors, x + 1, 1)) c3 = Asc(Mid$(cc.lpCustColors, x + 2, 1)) c4 = Asc(Mid$(cc.lpCustColors, x + 3, 1)) CustColor(x / 4) = (c1) + (c2 * 256) + _ (c3 * 65536) + (c4 * 16777216) Label1 = "Custom Color " & Int(x / 4) & " = " & CustColor(x / 4) Next x Else MsgBox "Hai premuto Annulla" End If End Sub Private Sub Command3_Click() Dim ofn As OPENFILENAME Dim a ofn.lStructSize = Len(ofn) ofn.hwndOwner = Me.hWnd ofn.hInstance = App.hInstance ofn.lpstrFilter = "File Icona (*.ICO)" & Chr$(0) & "*.ICO" & Chr$(0) ofn.lpstrFile = Space$(254) ofn.nMaxFile = 255 ofn.lpstrFileTitle = Space$(254) ofn.nMaxFileTitle = 255 ofn.lpstrInitialDir = "c:\" ofn.lpstrTitle = "Salva con nome" ofn.flags = 6 ofn.lpstrDefExt = ".ico" a = GetSaveFileName(ofn) If (a) Then MsgBox "File da salvare: " + Trim$(ofn.lpstrFile) Else MsgBox "Hai premuto Annulla" End If End Sub |