Controlli - Apri,SalvaConNome,ApriColore-TuttoConAPI




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











( controlliaprisalvaconnomeapricoloretuttoconapi.html )- by Paolo Puglisi - Modifica del 17/12/2023