In fast jedem Programm werden ActiveX-Controls verwendet, die andere VBler erstellt haben. Klar, dass da mit der Zeit der Wunsch nach einem eigenen Control größer und größer wird. Deshalb zeigt Ihnen dieser Workshop, wie Sie sich Ihre eigene Komponente erstellen können und zwar in Form eines Buttons, wie wir ihn aus der Standardkollektion kennen. Starten Sie dazu einfach ein neues Projekt und zwar ein ActiveX-Steuerelement: Fügen Sie dem Projekt noch ein Standard-Modul und ein Form hinzu. Nennen Sie das Projekt AxButton, das Modul basAxButton, das Form frmAbout und das UserControl Button. So, das einzige Steuerelement, das wir in diesem Projekt benötigen ist ein Standard-CommandButton, den setzen Sie auf das Formular und geben ihm die Überschrift "Schließen". Das war's, der Rest ist reine Schreibarbeit. Für alle Zeichenroutinen verwenden wir API-Funktionen und Konstanten, um uns das Leben nicht unnötig zu erschweren Wechseln Sie nun in das Modul und fügen Sie folgenden Code ein: ' für die Textausgabe Public Declare Function DrawText Lib "user32" _ Alias "DrawTextA" ( _ ByVal hdc As Long, _ ByVal lpStr As String, _ ByVal nCount As Long, _ lpRect As RECT, _ ByVal wFormat As Long) As Long ' für das Fokus-Rechteck Public Declare Function DrawFocusRect Lib "user32" ( _ ByVal hdc As Long, _ lpRect As RECT) As Long ' für den Rahmen Public Declare Function DrawEdge Lib "user32" ( _ ByVal hdc As Long, _ qrc As RECT, _ ByVal edge As Long, _ ByVal grfFlags As Long) As Long ' für die CheckMouse-Prozedur Public Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long Public Declare Function ReleaseCapture Lib "user32" () As Long ' für DrawText, DrawEdge, DrawFocusRect Public Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type ' für DrawEdge Private Const BDR_RAISEDOUTER As Long = &H1 Private Const BDR_RAISEDINNER As Long = &H4 Private Const BDR_SUNKENINNER As Long = &H8 Private Const BDR_SUNKENOUTER As Long = &H2 ' für DrawEdge Public Const EDGE_RAISED As Long = (BDR_RAISEDOUTER Or BDR_RAISEDINNER) Public Const EDGE_SUNKEN As Long = (BDR_SUNKENOUTER Or BDR_SUNKENINNER) ' für DrawText Public Const DT_WORDBREAK As Long = &H10 Public Const DT_SINGLELINE As Long = &H20 Public Const DT_VCENTER As Long = &H4 Public Const DT_LEFT As Long = &H0 Public Const DT_CENTER As Long = &H1 Public Const DT_RIGHT As Long = &H2 Wie Sie sehen, reichen diese API-Deklarationen bereits aus, um einen netten, gut aussehenden Button zu zeichnen. Gehen Sie nun in den Form-Codeteil und füllen Sie die Command1_Click-Prozedur mit diesem Code: Unload Me ' schließt das Fenster Das war's. Nun können wir uns dem Start widmen: unserem Button. Doppelklicken Sie im Projektfenster auf das Steuerelement und reduzieren Sie seine Größe auf ca. 700 * 1500 Twips (oder wollen Sie nach einem Doppelklick im Komponentenfenster ein riesiges Ungetüm auf ihrem Form platziert haben?) Des weiteren stellen Sie bitte folgende UserControl-Eigenschaften ein: AutoRedraw auf True (ansonsten würde der Button andauernd flackern) und ScaleMode auf Pixel (erleichtert den Umgang mit den API-Funktionen, da die API-Zeichenroutinen Pixelargumente übergeben haben wollen und wir uns so unnötiges Umrechnen ersparen). Für diesen Button haben wir uns folgende Features überlegt:
Das UserControl Gehen Sie nun in den Codeteil des UserControls. Dort finden Sie im Moment nur das Option Explicit., aber das werden wir ab jetzt ändern... Ereignisse oder auch Events werden wie folgt deklariert: Public Event [Eventname] ([Parameter1, Parameter2, ...]) Für unsere drei Ereignisse setzen wir somit also folgenden Code im Allgemein-Teil ein: Public Event Click() ' wird ausgelöst, wenn auf den Button geklickt wird Public Event MouseEnter() ' wird ausgelöst, wenn die Maus den Button "betritt" Public Event MouseLeave() ' wird ausgelöst, wenn die Maus den Button verlässt Für einen kurzen Zwischentest können Sie bereits das UserControl schließen (einfach Doppelklick auf Button (Button.ctl) im Projektfenster und dann auf den Schließen-Button in der Menüleiste). Fügen Sie nun ein weiteres Standard-Projekt hinzu und erstellen Sie somit eine Projektgruppe (speichern zwischendurch nicht vergessen). Im Komponentenfenster sollten Sie bereits das UserControl-Icon sehen: Wenn das Symbol deaktiviert erscheint, wiederholen Sie den Schließvorgang des UserControls. Platzieren Sie nun den Button auf dem Testform und machen Sie einen Doppelklick auf ihn. Wie Sie sehen, sind die drei Ereignisse bereits in der Ereignisliste: Ok; wechseln Sie nun wieder in den UserControl-Codeteil. Dort definieren wir nun unsere Speichervariablen für die Eigenschaftswerte und alle anderen Variablen, die wir noch brauchen werden. ' die Speicherstruktur: in ihr werden alle Eigenschaftsänderungen gespeichert Private Type ctrlAxButton mForeColor As OLE_COLOR ' wird als OLE_COLOR deklariert, wird im Eigenschaftsfenster ' eine Farbpalette zur Auswahl angeboten mBackColor As OLE_COLOR mAlignment As axBtnAlignment ' Verweis auf die Alignment-Enumeration mPicture As StdPicture mCaption As String mFont As Font End Type ' Auswahlmöglichkeiten der Ausrichtung (Caption und Picture) Public Enum axBtnAlignment abLinks = 0 abZentriert = 1 abRechts = 2 End Enum Dim UC As ctrlAxButton ' Verweis auf die Speicherstruktur Dim ButtonPressed As Boolean ' Variable für den Zustand des Buttons (gedrückt/nicht gedrückt) Dim MouseIn As Boolean ' Variable für das Verhalten der Maus Dim lFlag As Long ' Flag-Variable Dim oldState As Boolean ' alter MouseIn-Status Dim HaveFocus As Boolean ' Variable für den Focus Dim dRect As RECT ' Verweis auf Rect-Struktur Dim PWIP As Single ' PictureWidthInPixels: StdPicture-Variablen-Maße in Pixel Dim PicX As Single ' PictureX: linke Ausrichtung des Bildes Private Const FRD As Long = 4 ' FocusRectDistance: Entfernung des Fokusrects vom Rand Private Const TD As Long = 5 ' TextDistance: Entfernung des Textes vom Rand So, nun wenden wir uns dem "richtigen" Code zu, also Denk- und Schreibarbeit... Public Sub ShowAboutBox() ' Info-Box anzeigen frmAbout.Show vbModal End Sub Wichtig: nach Eingabe dieser Sub unter Extras --> Prozedurattribute den Subnamen auswählen und unter Weitere... --> Prozedur-ID AboutBox auswählen. Nun folgt eine Hilfsprozedur, die uns den aktuellen Mausstatus zurückgibt (MouseIn/MouseOut): Private Sub CheckMouse(ByVal X As Single, ByVal Y As Single) ' Hier wird überprüft, ob sich die Maus innerhalb des ' Controls befindet oder eben nicht With UserControl If X < 0 Or Y < 0 Or X > .ScaleWidth Or Y > .ScaleHeight Then If Not ButtonPressed Then ReleaseCapture MouseIn = False ' außerhalb Else If Not ButtonPressed Then SetCapture .hWnd MouseIn = True ' innerhalb End If End With End Sub Info: diese Prozedur ist eine Abwandlung des folgenden Tipps: Eigenschaften des UserControls So, nun hätten wir alle Hilfsprozeduren und kommen zu den Eigenschaften, die immer nach diesem Schema aufgebaut sind: [Public/Private] Property Get PropertyName() As Type PropertyName = Speichervariable/Objekt(-eigenschaft) End Property [Public/Private] Property Let/Set PropertyName(Byval vNewValue As Type) [Set] Speichervariable/Objekt(-eigenschaft) = vNewValue PropertyChanged "PropertyName" [weiterer Code, zB. neu zeichnen: Call Redraw] End Property Diese Syntax wenden wir nun auf alle gewünschten Eigenschaften an. Ich nenne es hier einmal: Verwalten der Eigenschaften, Teil 1. Public Property Get Font() As Font Set Font = UC.mFont End Property Public Property Set Font(ByVal vNew As Font) Set UC.mFont = vNew PropertyChanged "Font" Call Redraw End Property Public Property Get ForeColor() As OLE_COLOR ForeColor = UC.mForeColor End Property Public Property Let ForeColor(ByVal vNew As OLE_COLOR) UC.mForeColor = vNew PropertyChanged "ForeColor" Call Redraw End Property Public Property Get BackColor() As OLE_COLOR BackColor = UC.mBackColor End Property Public Property Let BackColor(ByVal vNew As OLE_COLOR) UC.mBackColor = vNew PropertyChanged "BackColor" Call Redraw End Property Public Property Get Alignment() As axBtnAlignment Alignment = UC.mAlignment End Property Public Property Let Alignment(ByVal vNew As axBtnAlignment) UC.mAlignment = vNew PropertyChanged "Alignment" Call Redraw End Property Public Property Get Picture() As StdPicture Set Picture = UC.mPicture End Property Public Property Set Picture(ByVal vNew As StdPicture) Set UC.mPicture = vNew PropertyChanged "Picture" Call Redraw End Property Public Property Get Caption() As String Caption = UC.mCaption End Property Public Property Let Caption(ByVal vNew As String) UC.mCaption = vNew PropertyChanged "Caption" Call Redraw End Property So, das hätten wir. Nun werden wir uns daran machen, die Ereignisse des Usercontrols auszuwerten und "weiterzuverarbeiten". Hier haben wir z.B. das Usercontrol_Click-Ereignis und da unser Button ja auch ein Click-Event besitzt, werden wir das gleich "weiterleiten" und zwar mit RaiseEvent, so wie alle Ereignisse ausgelöst werden. Private Sub UserControl_Click() RaiseEvent Click ' Click-Ereignis auslösen End Sub Um unseren Button auch im gedrückten Zustand erscheinen zu lassen, müssen wir auch das MouseDown und MouseUp-Ereignis auswerten. Weiter wollen wir ja, dass der User weiß, wann die Maus den Button betritt und wann sie ihn wieder verlässt: Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, _ X As Single, Y As Single) ButtonPressed = True ' Button gedrückt Call Redraw ' neu zeichnen End Sub Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, _ X As Single, Y As Single) Call CheckMouse(X, Y) ' Maus überprüfen If oldState <> MouseIn Then ' wenn alter gemerkter Status ungleich dem aktuellen ist ... Call Redraw ' neu zeichnen If MouseIn = True Then RaiseEvent MouseEnter ' MouseEnter-Event auslösen Else RaiseEvent MouseLeave ' MouseLeave-Event auslösen End If End If oldState = MouseIn ' alten Status setzen End Sub Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, _ X As Single, Y As Single) ButtonPressed = False ' Button losgelassen Call Redraw ' neu zeichnen End Sub Aber was wird hier gemacht? Ganz einfach: im MouseDown-Event wird gemerkt, dass der Button gedrückt ist, mit der Variable ButtonPressed eben. Und im MouseUp-Event, dass er wieder losgelassen wurde - auch kein Problem (natürlich müssen wir auch den Button sofort danach neu zeichnen, denn ansonsten wäre er ja noch im gedrückten Zustand gezeichnet). Aber was passiert im MouseMove-Event? Zuerst wird überprüft, ob sich die Maus innerhalb des Objekts befindet oder nicht. Dann wird der aktuelle Zustand mit dem des vorherigen verglichen. Ist er anders, also z.B. der alte Zustand "außerhalb" und der Neue "innerhalb", so ist klar, dass die Maus das Objekt betreten hat, also lösen wir das MouseEnter-Event aus. Ist hingegen der alte Zustand "innerhalb" und der Neue "außerhalb", so verlässt die Maus das Objekt - also MouseLeave. Und zu guter Letzt wird der alte Zustand mit dem Neuen gleichgesetzt und das Ganze beginnt wieder von vorne... Aber nun genug von der Maus: wenn der Button den Fokus erhält, so soll ja auch ein Fokusrahmen angezeigt werden. Also brauchen wir wieder 2 Ereignisse (GotFocus und LostFocus) des Usercontrols, um den aktuellen Zustand des Fokus zu erfahren: Private Sub UserControl_GotFocus() HaveFocus = True ' merken, dass Usercontrol Fokus erhalten hat Call Redraw End Sub Private Sub UserControl_LostFocus() HaveFocus = False ' merken, dass Usercontrol Fokus verloren hat Call Redraw End Sub Bis jetzt alles klar? Gut, dann gehen wir weiter zum nächsten großen Schritt: Verwalten der Eigenschaften, Teil 2: Wird unser Control auf die Form gesetzt, so sollen ja bereits Standard-Werte eingetragen sein (für OLE_COLOR ist der VB-Standardwert Schwarz und das sieht bei BackColor nicht schön aus...) Und dazu verwenden wir das Ereignis InitProperties des Usercontrols: Private Sub UserControl_InitProperties() ForeColor = vbBlack BackColor = vbButtonFace Alignment = abZentriert Set Picture = Nothing Caption = Extender.Name ' Extender ist das Usercontrol als Objekt auf dem Form; so gibt ' Extender.Name den UserControl-Namen zurück, der auf dem Form verwendet wird Set Font = Parent.Font End Sub Ok, setzen wir nun unseren Button auf das Form sehen wir, dass bereits die Eigenschaften mit Werten gefüllt sind Private Sub Redraw() End Sub Sieht doch gut aus, oder? Würden Sie aber nun das Projekt starten, würden alle Eigenschaften verloren gehen, da sich VB die Werte nicht merkt (-en will). Deshalb benötigen wir auch hier wieder eine Prozedur. Nein, sogar zwei: um die Eigenschaften zu speichern und sie wieder auszulesen und zuzuweisen. Stellen Sie sich PropBag wie eine Eigenschaftstasche vor, in der Sie die Werte zwischenspeichern... Syntax ReadProperty: Function ReadProperty(Name As String, [DefaultValue]) Syntax WriteProperty: Sub WriteProperty(Name As String, Value, [DefaultValue]) Name ist der Wert, den wir in den einzelnen Eigenschaften unter PropertyChanged zugewiesen haben und Value dann der "echte" Wert. Default ist bekanntlich der Standardwert, so wie wir ihn im InitProperties-Event zugewiesen haben. ' auslesen und zuweisen (ReadProperties) Private Sub UserControl_ReadProperties(PropBag As PropertyBag) With PropBag ForeColor = .ReadProperty("ForeColor", vbBlack) BackColor = .ReadProperty("BackColor", vbButtonFace) Alignment = .ReadProperty("Alignment", abZentriert) Set Picture = .ReadProperty("Picture", Nothing) Caption = .ReadProperty("Caption", Extender.Name) Set Font = .ReadProperty("Font", Parent.Font) End With End Sub ' zwischenspeichern (WriteProperties) Private Sub UserControl_WriteProperties(PropBag As PropertyBag) With PropBag .WriteProperty "ForeColor", ForeColor, vbBlack .WriteProperty "BackColor", BackColor, vbButtonFace .WriteProperty "Alignment", Alignment, abZentriert .WriteProperty "Picture", Picture, Nothing .WriteProperty "Caption", Caption, Extender.Name .WriteProperty "Font", Font, Parent.Font End With End Sub Was noch wichtig wäre: wenn das UserControl resized wird (also seine Größe ändert), dann soll auch neu gezeichnet werden: Private Sub UserControl_Resize() ' wenn das UserControl seine Größe ändert Call Redraw End Sub Button zeichnen So, und nun kommen wir zu unserer Hauptprozedur: dem Redraw. Für weitere Infos sehen Sie sich bitte einfach die im Code eingefügten Kommentare an. Private Sub Redraw() ' Usercontrol-Zeichenfläche wird gelöscht UserControl.Cls ' Hintergrundfarbe wird zugewiesen UserControl.BackColor = UC.mBackColor ' nun folgt die Überprüfung, ' welcher Rahmen angezeigt werden soll If ButtonPressed And MouseIn Then ' dieser, wenn der Button gedrückt ist und sich die Maus ' innerhalb diesem befindet lFlag = EDGE_SUNKEN Else ' ansonsten dieser lFlag = EDGE_RAISED End If ' nun folgen speziellere Zeichenroutinen: ' wie man es vom Original CommandButton gewöhnt ist, ' wird, wenn der Button den Fokus hat, ein schwarzer ' Rahmen um diesen gezeichnet, so auch hier: If HaveFocus Then ' hier erfolgt die Zuweisung für DrawEdge, ' das den Rahmen zeichnet With dRect .Top = 1 .Left = 1 .Bottom = ScaleHeight - 1 .Right = ScaleWidth - 1 End With ' schwarzen Rahmen zeichnen: vbBlack zeigt die Farbe ' an, B, dass es ein ungefülltes Rechteck sein soll UserControl.Line (0, 0)-(ScaleWidth - 1, ScaleHeight - 1), _ vbBlack, B Else ' hier erfolgt die Zuweisung für DrawEdge, ' das den Rahmen zeichnet With dRect .Top = 0 .Left = 0 .Bottom = ScaleHeight .Right = ScaleWidth End With End If If lFlag = EDGE_RAISED Then ' wenn der Button in ungedrücktem Zustand ' gezeichnet werden soll Call DrawEdge(UserControl.hDC, dRect, lFlag, &HF&) Else ' ansonsten zeichnen nur den Buttonschatten wie den ' schwarzen Rahmen innerhalb (Nachbildung des CommandButtons) UserControl.Line (1, 1)-(ScaleWidth - 2, ScaleHeight - 2), _ vbButtonShadow, B End If ' Hier wird überprüft, ob der Button als gedrückt dargestellt wird; ' wenn ja, dann soll auch die Beschriftung um je 1 Pixel nach rechts ' und 1 Pixel nach unten verschoben werden ' (MouseDown-Effekt) lFlag = CLng(IIf(ButtonPressed And MouseIn, 1, 0)) ' TD ist die Entfernung des Textes zum "echten" Rand des ' UserControls und kann über die Konstante oben im ' Deklarationsteil geändert werden With dRect ' hier erfolgt wieder eine Zuweisung, diesmal für DrawText .Top = TD + lFlag .Left = TD + lFlag .Right = ScaleWidth - TD + lFlag .Bottom = ScaleHeight - TD + lFlag End With ' Wenn ein Bild zugewiesen wurde ' (Wenn Bild Ist Nicht Nichts, Dann ...) If Not UC.mPicture Is Nothing Then _ PWIP = ScaleX(UC.mPicture.Width, vbHimetric, vbPixels) ' In der folgenden Select-Abfrage wird überprüft, wo die ' Beschriftung und das Bild gezeichnet werden sollen: ' Links, Mitte, Rechts (die Ausrichtung kann über Alignment ' bestimmt werden). lFlag setzt das Attribut für DrawText ' und PicX für das Bild. Während DrawText bereits Konstanten ' für die Ausrichtung bereitstellt, muss beim Bild ein wenig ' mit rechnen nachgeholfen werden Select Case UC.mAlignment Case 0 PicX = dRect.Left + lFlag lFlag = DT_LEFT Case 1 PicX = (ScaleWidth - PWIP) / 2 + lFlag lFlag = DT_CENTER Case 2 PicX = dRect.Right - PWIP + lFlag lFlag = DT_RIGHT End Select ' Hier noch zuweisen, dass die Beschriftung ' vertikal zentriert ausgerichtet werden soll lFlag = lFlag + DT_SINGLELINE + DT_VCENTER ' Schriftfarbe zuweisen UserControl.ForeColor = UC.mForeColor ' Text zeichnen Call DrawText(UserControl.hDC, UC.mCaption, Len(UC.mCaption), _ dRect, lFlag) ' Wenn ein Bild zugewiesen ist, wird es wie die ' Beschriftung ausgerichtet gezeichnet If Not UC.mPicture Is Nothing Then _ UserControl.PaintPicture UC.mPicture, PicX, FRD + 1 + _ CLng(IIf(ButtonPressed And MouseIn, 1, 0)) ' und noch etwas Spezielles: wenn der Button den Fokus ' hat, dann wird noch ein Fokusrahmen gezeichnet ' FRD ist die Entfernung des FocusRects zum "echten" Rand ' des UserControls und kann über die Konstante ' oben im Deklarationsteil geändert werden If HaveFocus Then With dRect .Top = FRD .Left = FRD .Right = ScaleWidth - FRD .Bottom = ScaleHeight - FRD End With Call DrawFocusRect(UserControl.hDC, dRect) End If End Sub So, nun schließen Sie das Usercontrol wieder und setzen Sie unseren tollen Button auf das Testform. Na, sieht doch super aus, oder? Sollten Sie jetzt Probleme haben wenn Sie Ihr Projekt ausführen lassen wollen, dann stimmt Ihre Starteinstellung noch nicht. Klicken Sie mit der rechten Maustaste im Projektexplorer auf das auszuführende Projekt und wählen dann "Als Starteinstellung festlegen" aus. Jetzt dürfte einer Ausführung nichts mehr im Weg stehen. Dieser Workshop wurde bereits 34.510 mal aufgerufen.
Anzeige
![]() ![]() ![]() (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
vb@rchiv CD Vol.6 ![]() ![]() Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats ![]() Dieter Otter PopUp-Menü wird nicht angezeigt :-( In diesem Tipp verraten wir Ihnen, wie Sie Probleme mit PopUp-Menüs umgehen können, wenn diese unter bestimmten Umständen einfach nicht angezeigt werden. Neu! sevCoolbar 3.0 ![]() Professionelle Toolbars im modernen Design! Mit sevCoolbar erstellen Sie in wenigen Minuten ansprechende und moderne Toolbars und passen diese optimal an das Layout Ihrer Anwendung an (inkl. große Symbolbibliothek) - für VB und MS-Access |
|||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |