VB.NET-Tipp 0017: InfoDialog
von Herfried Wagner
Beschreibung
Anzeigen und Manipulieren des systemeigenen Info-Dialogs über die API-Funktion ShellAbout, dabei wird die Verwendung von Delegatfunktionen mit dem AddressOf-Operator in Bezug auf Callback-Prozeduren demonstriert.
Schwierigkeitsgrad: | Framework-Version(en): .NET Framework 1.0, .NET Framework 1.1, .NET Framework 2.0, .NET Framework 3.0, .NET Framework 3.5 | .NET-Version(en): Visual Basic 2002, Visual Basic 2003, Visual Basic 2005, Visual Basic 2008 | Download: |
' Dieser Quellcode stammt von http://www.activevb.de ' und kann frei verwendet werden. Für eventuelle Schäden ' wird nicht gehaftet. ' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum. ' Ansonsten viel Spaß und Erfolg mit diesem Source! ' Projektversion: Visual Studio 2002/2003 ' Option Strict: An ' Option Explicit: An ' ' Referenzen: ' - System ' - System.Data ' - System.Drawing ' - System.Windows.Forms ' - System.XML ' ' Imports: ' - Microsoft.VisualBasic ' - System ' - System.Collections ' - System.Data ' - System.Drawing ' - System.Diagnostics ' - System.Windows.Forms ' ' ############################################################################## ' ################################# FMain.vb ################################### ' ############################################################################## Option Explicit On Option Strict On Public Class FMain Inherits System.Windows.Forms.Form #Region " Event handlers " Private Sub btnShellAbout_Click( _ ByVal sender As System.Object, _ ByVal e As System.EventArgs) _ Handles btnShellAbout.Click ShellAbout( _ Me.Handle.ToInt32, _ "SampleApp#MyApp", _ "This is an application.", _ Me.Icon.Handle.ToInt32 _ ) End Sub Private Sub btnShellAboutEx_Click( _ ByVal sender As System.Object, _ ByVal e As System.EventArgs) _ Handles btnShellAboutEx.Click ShellAboutEx( _ Me.Handle.ToInt32, _ Me.Icon.Handle.ToInt32, _ "About SampleApp", _ "SampleApp", _ "HirfSoft Corp.", _ "Version 4.5 (Build 1286)", _ "Copyright © 1999-2001 HirfSoft Corp.", _ "Written by Herfried K. Wagner", _ "Edition: " & "Professional", _ "Licensed to: " & ControlChars.Tab & _ "Pink Panther", _ "Serial Number:" & ControlChars.Tab & _ "A23766BD-34AD-22PD", _ , _ , _ "Close" _ ) End Sub #End Region End Class ' ############################################################################## ' ################################ modMain.vb ################################## ' ############################################################################## Option Explicit On Option Strict On Public Module modMain ' ' Haupteinstiegspunkt der Anwendung. ' <STAThread()> _ Public Sub Main() Dim frmMain As New FMain() frmMain.ShowDialog() End Sub End Module ' ############################################################################## ' ############################ modShellAboutEx.vb ############################## ' ############################################################################## ' ' Note: This application was built for ' demonstration purpose only. ' Sometimes when this sample runs on a slow ' machine you will see the original captions ' of the labels in the about dialog. ' A better approach would be to install ' a dialog hook to change the properties of the ' controls on the about window before it is shown. ' ' Dieses Beispiel funktioniert nur unter ' Windows 2000 und Windows Millennium und Windows XP ' fehlerferi, da die Anzahl der Steuerelemente im ' Info-Dialog der verschiedenen Windows-Versionen ' variiert. Daher wäre eine zusätzliche Abfrage ' der Windows-Version erforderlich, auf die aber ' in diesem Beispiel verzichtet wurde. Das Problem ' eines fehlenden STATIC-Controls unter Windows ' 2000 wurde über einen Check des Klassennamens ' der "letzten" Controls behoben. ' ' Der "schöneren" Programmierung zuliebe sollte ' man ausserdem den Inhalt in eine eigene ' Klasse mit entsprechenden Eigenschaften und ' Methoden packen. ' Option Explicit On Option Strict On Module modShellAboutEx #Region " Delegate declarations " Private Delegate Sub TimerFuncDelegate( _ ByVal lngWndID As Integer, _ ByVal msg As Integer, _ ByVal lngEventID As Integer, _ ByVal lngSysTime As Integer) Private Delegate Function _ EnumChildProcDelegate( _ ByVal hWnd As Integer, _ ByVal lParam As Integer) As Integer #End Region #Region " API declarations " Private Declare Function EnumChildWindows _ Lib "user32.dll" (ByVal hwndParent As Integer, _ ByVal lpEnumFunc As EnumChildProcDelegate, _ ByVal lParam As Integer) As Integer Private Declare Function GetClassName _ Lib "user32.dll" Alias "GetClassNameA" _ (ByVal hwnd As Integer, ByVal lpClassName As String, _ ByVal nMaxCount As Integer) As Integer Private Declare Function GetWindowText _ Lib "user32.dll" Alias "GetWindowTextA" _ (ByVal hwnd As Integer, _ ByVal lpString As String, _ ByVal cch As Integer) As Integer Private Declare Function SetWindowText _ Lib "user32.dll" Alias "SetWindowTextA" _ (ByVal hwnd As Integer, ByVal lpString As String) _ As Integer Private Declare Function FindWindow _ Lib "user32.dll" Alias "FindWindowA" _ (ByVal lpClassName As String, _ ByVal lpWindowName As String) _ As Integer Private Declare Function CreateFont _ Lib "gdi32.dll" Alias "CreateFontA" _ (ByVal h As Integer, ByVal W As Integer, _ ByVal E As Integer, _ ByVal O As Integer, _ ByVal W As Integer, _ ByVal I As Integer, _ ByVal u As Integer, _ ByVal s As Integer, _ ByVal C As Integer, _ ByVal OP As Integer, _ ByVal CP As Integer, _ ByVal Q As Integer, _ ByVal PAF As Integer, _ ByVal F As String) As Integer Private Declare Function SendMessage _ Lib "user32.dll" Alias "SendMessageA" _ (ByVal hwnd As Integer, _ ByVal wMsg As Integer, _ ByVal wParam As Integer, _ ByRef lParam As Integer) _ As Integer Private Declare Function DeleteObject _ Lib "gdi32.dll" (ByVal hObject As Integer) As Integer Private Const FW_BOLD As Integer = 700 Private Const WM_SETFONT As Integer = &H30 Public Declare Function ShellAbout _ Lib "shell32.dll" Alias "ShellAboutA" _ (ByVal hWnd As Integer, _ ByVal szApp As String, _ ByVal szOtherStuff As String, _ ByVal hIcon As Integer) As Integer #End Region #Region " Control related stuff " ' Index of the static control in the about dialog. Private m_intIndex As Integer ' I don't know if the controls are enumerated ' in the same order on other versions than Win2K and WinMe. Private Const STATIC_MS As Integer = 2 Private Const STATIC_VERSION As Integer = 3 Private Const STATIC_COPYRIGHT As Integer = 4 Private Const STATIC_AUTHOR As Integer = 5 Private Const STATIC_LICENSE As Integer = 6 Private Const STATIC_LICENSEDFOR As Integer = 7 Private Const STATIC_ORGANIZATION As Integer = 8 Private Const STATIC_REALMEM As Integer = 10 Private Const STATIC_MEMSIZE As Integer = 11 Private Const DEFPUSHBUTTON_OK As Integer = 12 #End Region #Region " Timer API support " ' Stuff used for the API timer. Private Declare Function SetTimer _ Lib "user32.dll" (ByVal hWnd As Integer, _ ByVal nIDEvent As Integer, _ ByVal uElapse As Integer, _ ByVal lpTimetFunc As TimerFuncDelegate) _ As Integer Private Declare Function KillTimer _ Lib "user32.dll" (ByVal hWnd As Integer, _ ByVal nIDEvent As Integer) _ As Integer #End Region #Region " Module-level variables " ' Variables needed to store the new captions. Private m_strWndTitle As String Private m_strAppTitle As String Private m_strCorporation As String Private m_strVersion As String Private m_strCopyright As String Private m_strAuthor As String Private m_strLicense As String Private m_strLicensedFor As String Private m_strOrganization As String Private m_strRealMem As String Private m_strMemSize As String Private m_strCaptionOK As String Private m_hFont As Integer ' Handle to the font object. Private m_hwndTimer As Integer Private m_intTimerID As Integer Public Const OriginalText As String = "%" ' If this constant is passed to our function, ' the original caption will be used. Private Const m_conTimerID As Integer = 12345 #End Region #Region " Timer related functions " Private Sub TimerFunc(ByVal intWndID As Integer, _ ByVal msg As Integer, _ ByVal intEventID As Integer, _ ByVal intSysTime As Integer) DeleteTimer() FireTimer() End Sub Public Sub DeleteTimer() If m_intTimerID <> 0 Then _ KillTimer(m_hwndTimer, m_conTimerID) End Sub Public Sub CreateTimer(ByVal hWnd As Integer) m_intTimerID = SetTimer(hWnd, m_conTimerID, _ 1, AddressOf TimerFunc) m_hwndTimer = hWnd End Sub ' ' We need a timer which runs in an other thread ' because when calling the ShellAbout function the ' application will be blocked until the dialog is ' closed. That's why we set a timer which fires ' some milliseconds after we call ShellAbout. ' Then we wait until the dialog is shown in order to ' replace the original captions/font. ' Private Sub FireTimer() Dim hWnd As Integer ' Wait until dialog window exists. Do hWnd = FindWindow(Nothing, "ABOUTDIALOG") System.Windows.Forms.Application.DoEvents() Loop While hWnd = 0 ' Change the caption. Call SetWindowText(hWnd, m_strWndTitle) ' Get all child windows in the about dialog and ' change their captions. Call EnumChildWindows(hWnd, AddressOf EnumChildProc, 0) End Sub #End Region #Region " Control manipulation functions " Public Function EnumChildProc(ByVal hWnd As Integer, _ ByVal lParam As Integer) As Integer m_intIndex = m_intIndex + 1 ' Increment counter for control index. ' Modify current control. Dim s As String Dim b As Boolean Select Case m_intIndex Case STATIC_MS s = m_strCorporation m_hFont = CreateFont(13, 0, 1, 0, FW_BOLD, _ 0, 0, 0, 0, 0, 0, 2, 0, "Times New Roman") SendMessage(hWnd, WM_SETFONT, m_hFont, 0) b = True Case STATIC_VERSION s = m_strVersion : b = True Case STATIC_COPYRIGHT s = m_strCopyright b = True Case STATIC_AUTHOR s = m_strAuthor b = True Case STATIC_LICENSE s = m_strLicense b = True Case STATIC_LICENSEDFOR s = m_strLicensedFor b = True Case STATIC_ORGANIZATION s = m_strOrganization b = True Case STATIC_REALMEM s = m_strRealMem b = True Case STATIC_MEMSIZE s = m_strMemSize b = True Case Is >= DEFPUSHBUTTON_OK s = Space(7) Call GetClassName(hWnd, s, 7) If Left(UCase(s), 6) = "BUTTON" Then s = m_strCaptionOK b = True End If End Select ' If we shouldn't use the original caption ' then set the new text. If b And s <> OriginalText Then SetWindowText(hWnd, s) ' Continue enumerating. Return 1 End Function ' ' A little helper function that returns the window text. ' Private Function GetWndText(ByVal hWnd As Integer) As String Dim s As String = Space(256) Dim n As Integer = GetWindowText(hWnd, s, Len(s)) GetWndText = Left(s, n) End Function #End Region #Region " ShellAboutEx main function " ' ' Our implementation of AboutBox, AboutBoxEx ;-) ' ' WinXP: strLicense parameter must not contain a vbTab. ' Public Function ShellAboutEx(ByRef hwndParent As Integer, _ ByVal hIcon As Integer, _ ByRef strWndTitle As String, _ ByRef strAppTitle As String, _ ByRef strCorporation As String, _ ByRef strVersion As String, _ ByRef strCopyright As String, _ ByRef strAuthor As String, _ ByRef strLicense As String, _ ByRef strLicensedFor As String, _ ByRef strOrganization As String, _ Optional ByRef strRealMem As String _ = OriginalText, _ Optional ByRef strMemSize As String _ = OriginalText, _ Optional ByRef strCaptionOK As String _ = OriginalText) As Integer m_strWndTitle = strWndTitle m_strAppTitle = strAppTitle m_strCorporation = strCorporation & " " & strAppTitle m_strVersion = strVersion m_strCopyright = strCopyright m_strAuthor = strAuthor m_strLicense = strLicense m_strLicensedFor = strLicensedFor m_strOrganization = strOrganization m_strRealMem = strRealMem m_strMemSize = strMemSize m_strCaptionOK = strCaptionOK m_intIndex = 0 CreateTimer(hwndParent) ShellAboutEx = ShellAbout(hwndParent, "ABOUTDIALOG#", Nothing, hIcon) DeleteObject(m_hFont) End Function #End Region End Module
Ihre Meinung
Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.
Archivierte Nutzerkommentare
Klicken Sie diesen Text an, wenn Sie die 2 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.
Kommentar von Florian am 25.04.2004 um 14:22
Ach ja, Lassen sie mir ruhig eine Mail zukommen... Ich Schicke ihnen dann "Sobald es geht" Eine zurück und auch noch mit einem Anhang den sie mit Visual Basic.NET öffnen können mit. Inkl. Code
:-P :-P :-P :-P :-P :-P :-P :-P :-P :-P :-P :-P :-P :-P :-P
Kommentar von Florian am 25.04.2004 um 14:16
Also bei mir Funktioniert das ganze viel einfacher!
Vielleicht ein Tipp?
Wenn sie wissen wie man Fenster verknüpft ist das SUPEREINFACH!
Bombadieren Sie nich jetzt Bitte nicht mit fragen aber ich denke mir: Warum Kompliziert wenn es auch einfach geht?