Menyfarve i Visual basic

[Wolverin]

Jeg sitter å lager et program for en kompis, og hele bakgrunnen er et bilde han selv har laget som er hvit i basis, med en del japanske tegn bluret ut i bakgrunnen (ja, det ser faktisk kult ut).

Problemet jeg nå kom opp i er at meny baren i VB kommer i den tradisjonelle grå farven, noe jeg ikke vil ha den i nå. Den skal være hvit, gjerne med en sort markerings strek som viser at det er en meny linje der.

Jeg har lett i mine VB bibler, men der er design noe som er tydelig utelatt, for det står stort sett bare kode eksempler og forklaringer på deklareringer, funksjoner og prosedyrer her.

 

Er det noen som vet hvordan jeg kan endre menu bar farven til hvit, også gjerne med en slik sort strek som markering av hvor det er menu bar??

[aadnk]

Jeg vil råde deg å se på denne artikkelen i EliteVB. Det kan være ganske komplisert, men er dessverre den eneste rette måten å gjøre dette på. Jeg håper det ikke blir for vanskelig å få implimert koden i programmet ditt.

 

Mvh,

aadnk

[Wolverin]

Nei, det ble ikke slik jeg ønsket det da.

Går det i så fall ann å få en link eller noe annet som vil passe seg for å åpne instillinger delen av programmet??

[JonH]

Er det noe slik du er på jakt etter?

[Wolverin]

Nei, var ikke en popup meny jeg jaktet på.

 

Vet noen av dere kanskje hvordan jeg lager og bruker en slik arkiv blad greie?

Slik egenskaper på et hvert ikon på skrivebordet får opp om man velger et?

Slike ark faner ville vært en løsning her.

[GeirGrusom]

Du kan jo lage din egen meny klasse, som faktisk er ganske enkelt.

Bare lage et vindu og legg til en Collection med f.eks. en definert type med feltene ID og Tekst, og tegn den manuelt på paint-event, og en OnClick(ID As Long) f.eks.

[Wolverin]

Det hørtes interessant ut.

Har du et lite eksempel å gi meg.

En kode jeg bare kan klistre inn, til en dummy meny som ikke gjøre noe som helst, men som vil vise meg hvordan det blir seende ut, og litt hvordan koden bygges opp??

[GeirGrusom]

Jeg har skrevet hele saken, den tar relativt mye kode, men fungerer i grunn og bunn.

 

Den har tre filer:

Class CMenu

Class CMenuItem

Form frmMenu

 

Disse filene må du lage i VB.

 

Kopier den følgende koden inn i de filene som er beskrevet

 

Her er koden:

 

frmMenu:

 

Option Explicit

Private Type TEXTMETRIC
       tmHeight As Long
       tmAscent As Long
       tmDescent As Long
       tmInternalLeading As Long
       tmExternalLeading As Long
       tmAveCharWidth As Long
       tmMaxCharWidth As Long
       tmWeight As Long
       tmOverhang As Long
       tmDigitizedAspectX As Long
       tmDigitizedAspectY As Long
       tmFirstChar As Byte
       tmLastChar As Byte
       tmDefaultChar As Byte
       tmBreakChar As Byte
       tmItalic As Byte
       tmUnderlined As Byte
       tmStruckOut As Byte
       tmPitchAndFamily As Byte
       tmCharSet As Byte
End Type

Private Declare Function GetCharWidth32 Lib "gdi32" Alias "GetCharWidth32A" (ByVal hdc As Long, ByVal iFirstChar As Long, ByVal iLastChar As Long, lpBuffer As Long) As Long
Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long


Public OwnerMenu As CMenu
Private hover_index As Long
Public m_height As Single
Public Function GetStringWidth(s As String) As Long
   Dim c As Long, n_c As Long
   Dim out As Long
   Dim X As Long
   For X = 1 To Len(s)
       c = Mid(s, X, 1)
       Call GetCharWidth32(Me.hdc, c, c, n_c)
       out = out + n_c
   Next
   GetStringWidth = out
End Function
Public Sub Draw()
   Dim dy As Single
   Dim X As Long
   Dim s As String
   Dim it As CMenuItem
   If OwnerMenu.Count = 0 Then Exit Sub
   Cls
   Line (0, 0)-(18, Me.ScaleHeight), vbButtonFace, BF
   For X = 1 To OwnerMenu.Count
       Set it = OwnerMenu.Item(X)
       s = it.text
       If s = "-" Then
           Line (24, dy + (m_height / 2))-(Me.ScaleWidth - 2, dy + (m_height / 2)), vbButtonFace
           dy = dy + m_height
       Else

           If hover_index = X Then
               Line (0, dy)-(Me.ScaleWidth - 1, dy + m_height), RGB(172, 172, 210), BF
               Line (0, dy)-(Me.ScaleWidth - 1, dy + m_height), RGB(0, 0, 192), B
               
               'Me.ForeColor = vbHighlightText
           Else
               Me.ForeColor = it.ForeColor
           End If
           If Not it.Picture Is Nothing Then
               PaintPicture it.Picture, 1, dy   '((it.Picture.Height / 15) / 2)
           End If
           
           TextOut Me.hdc, 24, dy, s, Len(s)
           If hover_index = X Then
               
           End If
           
           dy = dy + m_height
       End If
   Next
End Sub

Private Sub Form_Deactivate()
   Unload Me
End Sub

Private Sub Form_Load()
   'Sett noen parameter
   Dim tm As TEXTMETRIC
   'Hent informasjon om fonten
   Call GetTextMetrics(Me.hdc, tm)
   'Ignorer data;)
   m_height = 20
   ' Tegn
   Draw
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, y As Single)
   'Skjul formen, siden brukeren har valgt noe
   Me.Hide
   'Få CMenu til å fyre av et event
   OwnerMenu.PerformClick y, m_height
   'Slett formen
   Unload Me
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
   Dim index As Long
   index = (y - m_height / 2) / m_height
   hover_index = index + 1
   If hover_index < 1 Or hover_index > OwnerMenu.Count Then hover_index = -1
   Draw
End Sub

Private Sub Form_Paint()
   'Blir ikke brukt nå Form.AutoRedraw er på
   Draw
End Sub

 

CMenu:

 

Option Explicit

' Class Menu
' Inneholder grunnklassen for meny saken
Private Type POINTAPI
       X As Long
       y As Long
End Type

'GetCursorPos blir brukt av ShowMenu
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'm_col inneholder alle meny valgene
Private m_col As Collection
Private m_item_height As Single
'Event ItemClick blir sendt når brukeren velger en verdi
Public Event ItemClick(ID As Long)
Private Sub Class_Initialize()
   Set m_col = New Collection
   m_item_height = 24
End Sub
Private Function CreateID() As Long
   'Leter etter en ID som ikke er brukt fra før
   Dim X As Long
   Dim nID As Long
   Dim t As CMenuItem
   For X = 1 To m_col.Count
       Set t = m_col(X)
       If t.ID = nID Then
           nID = nID + 1
           X = 0
       End If
   Next
   CreateID = nID
End Function
Public Function GetIndex(ID As Long) As Long
   Dim X As Long
   Dim t As CMenuItem
   For X = 1 To m_col.Count
       Set t = m_col(X)
       If t.ID = ID Then
           GetIndex = X
           Exit Function
       End If
   Next
End Function
Public Property Get ItemText(ID As Long) As String
   Dim t As CMenuItem
   Set t = m_col(GetIndex(ID))
   ItemText = t.text
End Property
Public Property Let ItemText(ID As Long, value As String)
   m_col(GetIndex(ID)).text = value
End Property
Public Property Get ItemTextByIndex(index As Long) As String
   ItemTextByIndex = m_col(index).text
End Property
Public Function AddItem(text As String, Optional ID As Long = -1, Optional Picture As IPictureDisp = Nothing) As Long
   Dim t As New CMenuItem
   t.text = text
   If ID = -1 Then t.ID = CreateID() Else t.ID = ID
   Set t.Picture = Picture
   AddItem = t.ID
   m_col.Add t
End Function
Public Sub PerformClick(y As Single, item_height As Single)
   Dim sel As Long
   Dim index As Long
   Dim t As CMenuItem
   index = (y - item_height / 2) / item_height
   sel = index + 1
   If sel > m_col.Count Or sel < 1 Then Exit Sub
   Set t = m_col(sel)
   If t.text = "-" Then Exit Sub
   RaiseEvent ItemClick(t.ID)
End Sub
Public Property Get Item(index As Long) As CMenuItem
   Set Item = m_col(index)
End Property
Public Property Set Item(index As Long, value As CMenuItem)
   Set m_col(index) = value
End Property
Public Property Get Count() As Long
   If m_col Is Nothing Then Exit Property
   Count = m_col.Count
End Property
Public Sub ShowMenu(Optional X As Long = -1, Optional y As Long = -1)
   'Viser menyen der musepekeren er
   Dim nX As Single, nY As Single
   Dim frmShow As New frmMenu
   Dim p As POINTAPI
   Call GetCursorPos(p)
   frmShow.m_height = m_item_height
   Set frmShow.OwnerMenu = Me
   
   If X = -1 Then nX = p.X * Screen.TwipsPerPixelX Else nX = X
   If y = -1 Then nY = p.y * Screen.TwipsPerPixelX Else nY = y
   frmShow.Move nX, nY, 128 * Screen.TwipsPerPixelX, ((m_col.Count - 1) * m_item_height) * Screen.TwipsPerPixelY
   frmShow.Show
   frmShow.Draw
End Sub

 

CMenuItem:

 

Option Explicit

'CMenuItem
'Bare en data klasse, siden strukturer (type) ikke kan bli brukt i "outbound functions"

Private m_text As String
Private m_ID As Long
Private m_ForeColor As OLE_COLOR
Private m_Picture As IPictureDisp   'Peker til bilde
Public Property Get text() As String
   text = m_text
End Property
Public Property Let text(value As String)
   m_text = value
End Property
Public Property Get ID() As Long
   ID = m_ID
End Property
Public Property Let ID(value As Long)
   m_ID = value
End Property
Public Property Get ForeColor() As OLE_COLOR
   ForeColor = m_ForeColor
End Property
Public Property Let ForeColor(value As OLE_COLOR)
   m_ForeColor = value
End Property
Public Property Get Picture() As IPictureDisp
   Set Picture = m_Picture
End Property
Public Property Set Picture(value As IPictureDisp)
   Set m_Picture = value
End Property
' Statisk funksjon for å lage en CMenuItem med kun en linje.
' Set [item] = CMenuItem.CreateItem(blablablablabla)
Public Static Function CreateItem(text As String, Optional ForeColor As OLE_COLOR = vbButtonFace, Optional ID As Long = -1) As CMenuItem
   Dim out As New CMenuItem
   out.text = text
   out.ID = ID
   out.ForeColor = ForeColor
   Set CreateItem = out
End Function

 

CMenu har en Collection som inneholder CMenuItem

CMenuItem forteller tekst, farge, og ID på hvert menyvalg,

er teksten i et menyvalg "-" blir det til en skillelinje

 

Du bruker hele saken ved at du i formen du skal bruke den deklarer den med WithEvents, dvs. "Friend WithEvents mnuContext As CMenu"

 

Deretter når prosjektet starter, må du sette den til et nytt objekt, det gjøres slik:

"Set mnuContext = New CMenu"

 

CMenu.AddItem legger til et menyvalg.

 

Du kan legge til bilder ved å lage en ImageList og bruke bilder fra den ved å gjøre slik:

mnuContext.AddItem "Tekst av et sklag", , ImageList.ListImages(index)

 

Jeg har ikke så mye å gjøre når ingen andre er hjemme

[Wolverin]

Kjempe greier.

Skal kopiere ned koden, og forflytte den på diskett over på bærbar pcen jeg har visual basic installert på,så skal jeg få testet dette.

 

Håper du blir alene hjemme flere ganger, viser seg jo å være en lønnsom sak det Hehe..