(Dica) Caixas de Diálogos do Sistema


	Fórum
	Visual Basic

Responder

Voltar

Autor

Assunto: (Dica) Caixas de Diálogos do Sistema

CODER_EXPERT

GOIÂNIA
GO - BRASIL

ENUNCIADA !

Postada em 29/08/2008 03:24 hs

* Configurar Página (Impressora)

**************************************************************

Option Explicit

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type PAGESETUPDLG
    lStructSize As Long
    hwndOwner As Long
    hDevMode As Long
    hDevNames As Long
    flags As Long
    ptPaperSize As POINTAPI
    rtMinMargin As RECT
    rtMargin As RECT
    hInstance As Long
    lCustData As Long
    lpfnPageSetupHook As Long
    lpfnPagePaintHook As Long
    lpPageSetupTemplateName As String
    hPageSetupTemplate As Long
End Type

Private Declare Function PAGESETUPDLG Lib "comdlg32.dll" Alias "PageSetupDlgA" (pPagesetupdlg As PAGESETUPDLG) As Long

Private Function ShowPageSetupDlg() As Long
    Dim m_PSD As PAGESETUPDLG

    m_PSD.lStructSize = Len(m_PSD)
    m_PSD.hwndOwner = Me.hWnd
    m_PSD.hInstance = App.hInstance
    m_PSD.flags = 0

    If PAGESETUPDLG(m_PSD) Then
        ShowPageSetupDlg = 0
    Else
        ShowPageSetupDlg = -1
    End If
End Function

Excelent Code

CODER_EXPERT

GOIÂNIA
GO - BRASIL

ENUNCIADA !

Postada em 29/08/2008 03:29 hs

* Janela Sobre do Windows

******************************************************************

Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hWnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long

Private Sub Form_Load()
ShellAbout Me.hWnd, App.Title, "Criado por Coder_Expert", ByVal 0&
End Sub

Excelent Code

CODER_EXPERT

GOIÂNIA
GO - BRASIL

ENUNCIADA !

Postada em 29/08/2008 03:33 hs

* Caixa de Diálogo de Dano de aplicativo do Windows

********************************************************************

Private Declare Sub FatalAppExit Lib "kernel32" Alias "FatalAppExitA" (ByVal uAction As Long, ByVal lpMessageText As String)

Private Sub Form_Load()
FatalAppExit 0, "Ocorreu um erro fatal e este programa será fechado"
End Sub

Excelent Code

CODER_EXPERT

GOIÂNIA
GO - BRASIL

ENUNCIADA !

Postada em 29/08/2008 03:49 hs

* Caracter (*) como PasswordChar no InputBox

***************************************************

'No form

Option Explicit

Private Declare Function SetTimer& Lib "user32" _
  (ByVal hwnd&, ByVal nIDEvent&, ByVal uElapse&, ByVal _
   lpTimerFunc&)

Private Sub Form_Load()
  Dim ret As String
  SetTimer hwnd, NV_INPUTBOX, 10, AddressOf TimerProc
  ret = InputBox("Enter Password")

  MsgBox ret
End Sub

'No módulo

Private Declare Function FindWindow Lib "user32" Alias _
   "FindWindowA" (ByVal lpClassName As String, _
   ByVal lpWindowName As String) As Long

Private Declare Function FindWindowEx Lib "user32" Alias _
  "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
   ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Private Declare Function SendMessage Lib "user32" Alias _
    "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, lParam As Any) As Long

Private Declare Function KillTimer& Lib "user32" _
  (ByVal hwnd&, ByVal nIDEvent&)

Const EM_SETPASSWORDCHAR = &HCC
Public Const NV_INPUTBOX As Long = &H5000&

Public Sub TimerProc(ByVal hwnd&, ByVal uMsg&, _
   ByVal idEvent&, ByVal dwTime&)

    Dim EditHwnd As Long
    EditHwnd = FindWindowEx(FindWindow("#32770", App.Title), 0, "Edit", "")

    Call SendMessage(EditHwnd, EM_SETPASSWORDCHAR, Asc("*"), 0)
    KillTimer hwnd, idEvent
End Sub

Excelent Code

Página(s): 2/2 « ANTERIOR

Seu Nome:
Seu eMail:		ALTERAR PARA MODO HTML
Mensagem: [:)] = [:P] = [:(] = [;)] = HTML DESLIGADO

VOLTAR