I have a combobox that's being populated from the SQL-SERVER with a list of names. What I'm trying to do is, let the user click on the drop down and show all names without scrolling down.
assuming the font of combo is the same as the forms one
Option Explicit
Private Declare Function MoveWindow Lib "user32" _
(ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, ByVal updt As Long) As Long
Private Sub Form_Load()
Dim I As Long
Me.ScaleMode = vbPixels
With Combo1
MoveWindow .hWnd, .Left, .Top, .Width, .Height + (Me.TextHeight("W") * 11), 0 'why 11 and not 10? i realy don't know right now
End With
For I = 1 To 20
Combo1.AddItem "Item " & I
Next I
End Sub
Related
I'm loading a UserControl, ucRegisterItem into a listbox called MainGrid.
The ucRegisterItem has a unique ID that I need to be able to retrieve when the item is clicked on inside of MainGrid.
With the code below, when instances of ucRegisterItem are loaded, I can click on each item once and retrieve the ID - but if i click on it again, nothing happens. I can add a new ucRegisterItem and get that ID, but again, just once.
I'm not sure what I'm doing wrong.
Here's the UC ucRegisterItem code:
Public theOID As Integer
Public Event OIDSelected(ByVal OID As Integer)
Public Sub New(ByVal OID As Integer, ByVal Seat As Integer, ByVal Item As String, ByVal Qty As Double, ByVal Price As Double, ByVal SalesTax As Double, ByVal Total As Double, ByVal Optional Notes As String = "")
' This call is required by the designer.
InitializeComponent()
' Add any initialization after the InitializeComponent() call.
theOID = OID
theSeat.Text = theOID 'Seat
theProdName.Text = Item
theQty.Text = Qty
thePrice.Text = FormatCurrency(Price, 2)
theTax.Text = FormatCurrency(SalesTax, 2)
theTotal.Text = FormatCurrency(Total, 2)
If Notes = "" Then
ItemInfo.Children.Remove(ItemNotes)
Else
ActualNotes.Text = Notes
End If
End Sub
Private Sub whatever_Selected(sender As Object, e As RoutedEventArgs) Handles whatever.Selected
RaiseEvent OIDSelected(theOID)
End Sub
End Class
And here's where I'm loading it into my ListBox:
Public Sub AddListItem(ByVal OID As Integer, ByVal Seat As Integer, ByVal Item As String, ByVal Qty As Double, ByVal Price As Double, ByVal SalesTax As Double, ByVal Total As Double, ByVal Optional Notes As String = "")
Dim newItem As New ucRegisterItem(OID, Seat, Item, Qty, Price, SalesTax, Total, Notes)
newItem.Name = "item" & OID
MainGrid.Items.Add(newItem)
MainGrid.SelectedIndex = MainGrid.Items.Count - 1
MainGrid.ScrollIntoView(MainGrid.SelectedItem)
AddHandler newItem.OIDSelected, AddressOf ShoutItOut
End Sub
Public Sub ShoutItOut(sender As Object)
'Setting the value of this mug.
selectedVal = CInt(sender)
MsgBox("Value: " & sender.ToString)
End Sub
I added the MsgBox to see what it would send. I get the MsgBox to display once, but not on the second click or any click after on that specific item.
Any help would be appreciated!
Thank you!
Ostas has it right. You're subscribed to 'Selected' not 'Clicked' so change your event handler to a MouseUp or Click event.
I want to resize a custom window, so windowstyle=none.
For that I do not want to use some Open-Sourelib.
So I found this article via google.
After I changed the code a bit, since i want to use a button instead of a rectangle for resizing the code looks like this:
Private bottomResize As Boolean = False
Private initBtmY As Double
Private Sub BottomResizeRect_MouseEnter _
(ByVal sender As Object, ByVal e As _
System.Windows.Input.MouseEventArgs) _
Handles btResizeAndFold.MouseEnter
bottomResize = False
'Console.WriteLine("Mouse Enter called")
End Sub
Dim boing As Boolean = False
Private Sub BottomResizeRect_MouseLeftButtonDown _
(ByVal sender As Object, ByVal e As _
System.Windows.Input.MouseButtonEventArgs) _
Handles btResizeAndFold.PreviewMouseLeftButtonDown
bottomResize = True
boing = True
'Console.WriteLine("Mouse left down called")
'Get the initial Y coordinate
'cursor location on our window
initBtmY = e.GetPosition(Me).Y
End Sub
Private Sub BottomResizeRect_MouseLeftButtonUp _
(ByVal sender As Object,
ByVal e As System.Windows.Input.MouseButtonEventArgs) _
Handles btResizeAndFold.PreviewMouseLeftButtonUp
'Console.WriteLine("Mouse left up called")
bottomResize = False
btResizeAndFold.ReleaseMouseCapture()
End Sub
Private Sub BottomResizeRect_MouseMove _
(ByVal sender As Object, ByVal e As _
System.Windows.Input.MouseEventArgs) _
Handles btResizeAndFold.PreviewMouseMove
'Get the new Y coordinate cursor location
Dim newBtmY As Double = e.GetPosition(Me).Y
'Get the change between the initial and
'new cursor location
Dim diff As Double = initBtmY - newBtmY
'Minimum window height
Dim minHeight As Integer = 200
Dim differnceConstant = 5
If bottomResize = True And (diff > differnceConstant Or diff < (differnceConstant * -1)) Then
'Let our rectangle capture the mouse
btResizeAndFold.CaptureMouse()
Dim newHeight = e.GetPosition(Me).Y - diff
If newHeight > minHeight Then
Me.Height = newHeight
End If
End If
End Sub
The problem now is, that if i try to resize my window by pressing the left mouse button and then drag the mouse, the increase/decrease of the height of my window is not synchonosly to the movement of my mouse cursor, so the question is: how to make the movement of the mouse sychronos to growth of the window
Instead of Button you could use Thumb, which provide with DragDelta Event that suits your requirement:
https://wpf.2000things.com/2012/12/19/715-using-the-thumb-control-to-drag-objects-on-a-canvas/
That way you dont need to capture the mouse(you shouldnt've put the CaptureMouse in the PreivewMouseMove anyway, it will do that a lot).
And just set the height as the current height + the delta Y.
I would like to transparent red color form background of visual basic 6 program.
I use this code to make the background of the form transparent:
Option Explicit
Private Const GWL_EXSTYLE As Long = (-20)
Private Const LWA_COLORKEY As Long = &H1
Private Const LWA_Defaut As Long = &H2
Private Const WS_EX_LAYERED As Long = &H80000
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" _
(ByVal hWnd As Long, ByVal crKey As Long, ByVal bDefaut As Byte, _
ByVal dwFlags As Long) As Long
Private Sub Form_Load()
Me.BackColor = RGB(254,0,0)
Transparency Me.hWnd, Me.BackColor, 255
End Sub
Private Sub Transparency(ByVal hWnd As Long, ByVal lngTransparentColor As Long, _
ByVal bytTransparency As Byte)
Dim lngwindowstyle As Long
lngwindowstyle = GetWindowLong(hWnd, GWL_EXSTYLE)
If (lngwindowstyle And WS_EX_LAYERED) <> WS_EX_LAYERED Then
SetWindowLong hWnd, GWL_EXSTYLE, lngwindowstyle Or WS_EX_LAYERED
End If
SetLayeredWindowAttributes hWnd, lngTransparentColor, bytTransparency, _
LWA_COLORKEY Or LWA_Defaut
End Sub
But as you can see in the picture the red noise remains :
How can I remove this noise?
I saved the picture with .png extension and use AlphaImageControl.ocx to show it.
The red noise is removed but a red line under form remains :
As the commenters already said, your "red" isn't always the same red. The line under the form remains, if you look closely you can see it: the red lines are fading from red to black. So even if your left pixel is 254,0,0 the next ones are not. I recommend using a blank/real transparent background, png offers you that :)
Here is my code and I am able to add the text by defining some font properties but I want to add this using Font dialog.Can anyone help me regarding this issue.
Public Class Form1
Dim pic_font As New Font("Arial Black", 40, FontStyle.Regular, GraphicsUnit.Pixel)
Dim bm As Bitmap = New Bitmap(100, 100)
Dim strText As String = "Diver Dude"
Dim szText As New SizeF
Dim ptText As New Point(125, 125)
Dim ptsText() As PointF
Dim MovingOffset As PointF
Dim ptsTextPen As Pen = New Pen(Color.LightSteelBlue, 1)
Dim MouseMoving As Boolean
Dim MouseOver As Boolean
Public Sub New()
MyBase.New()
'This call is required by the Windows Form Designer.
InitializeComponent()
'Add any initialization after the InitializeComponent() call
Me.SetStyle(ControlStyles.AllPaintingInWmPaint, True)
Me.SetStyle(ControlStyles.DoubleBuffer, True)
End Sub
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
PictureBox1.Hide()
bm = Image.FromFile(Application.StartupPath & "\DivePic.bmp")
szText = Me.CreateGraphics.MeasureString(strText, pic_font)
SetptsText()
ptsTextPen.DashStyle = DashStyle.Dot
End Sub
Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
'Check if the pointer is over the Text
If IsMouseOverText(e.X - 10, e.Y - 10) Then
MouseMoving = True
'Determine the upper left corner point from where the mouse was clicked
MovingOffset.X = e.X - ptText.X
MovingOffset.Y = e.Y - ptText.Y
Else
MouseMoving = False
End If
End Sub
Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
'Check if the pointer is over the Text
If IsMouseOverText(e.X - 10, e.Y - 10) Then
If Not MouseOver Then
MouseOver = True
Me.Refresh()
End If
Else
If MouseOver Then
MouseOver = False
Me.Refresh()
End If
End If
If e.Button = Windows.Forms.MouseButtons.Left And MouseMoving Then
ptText.X = CInt(e.X - MovingOffset.X)
ptText.Y = CInt(e.Y - MovingOffset.Y)
Me.Refresh()
End If
End Sub
Private Sub Form1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp
MouseMoving = False
Me.Refresh()
End Sub
Public Function IsMouseOverText(ByVal X As Integer, ByVal Y As Integer) As Boolean
'Make a Graphics Path from the rotated ptsText.
Using gp As New GraphicsPath()
gp.AddPolygon(ptsText)
'Convert to Region.
Using TextRegion As New Region(gp)
'Is the point inside the region.
Return TextRegion.IsVisible(X, Y)
End Using
End Using
End Function
Dim tbm As Bitmap
Private Sub Form1_Paint(ByVal sender As Object, _
ByVal e As System.Windows.Forms.PaintEventArgs) _
Handles MyBase.Paint
tbm = CType(bm.Clone, Bitmap)
Dim g As Graphics = Graphics.FromImage(tbm)
Dim mx As Matrix = New Matrix
Dim gpathText As New GraphicsPath
Dim br As SolidBrush = New SolidBrush(Color.FromArgb(tbarTrans.Value, _
KryptonColorButton1.SelectedColor))
SetptsText()
'Smooth the Text
g.SmoothingMode = SmoothingMode.AntiAlias
'Make the GraphicsPath for the Text
Dim emsize As Single = Me.CreateGraphics.DpiY * pic_font.SizeInPoints / 72
gpathText.AddString(strText, pic_font.FontFamily, CInt(pic_font.Style), _
emsize, New RectangleF(ptText.X, ptText.Y, szText.Width, szText.Height), _
StringFormat.GenericDefault)
'Draw a copy of the image to the Graphics Object canvas
g.DrawImage(CType(bm.Clone, Bitmap), 0, 0)
'Rotate the Matrix at the center point
mx.RotateAt(tbarRotate.Value, _
New Point(ptText.X + (szText.Width / 2), ptText.Y + (szText.Height / 2)))
'Get the points for the rotated text bounds
mx.TransformPoints(ptsText)
'Transform the Graphics Object with the Matrix
g.Transform = mx
'Draw the Rotated Text
If chkAddOutline.Checked Then
Using pn As Pen = New Pen(Color.FromArgb(tbarTrans.Value, KryptonColorButton2.SelectedColor), 1)
g.DrawPath(pn, gpathText)
End Using
Else
g.FillPath(br, gpathText)
End If
If CheckBox2.Checked = True Then
Dim p As New Pen(Color.FromArgb(tbarTrans.Value, KryptonColorButton2.SelectedColor), 1)
'draw te hollow outlined text
g.DrawPath(p, gpathText)
'clear the path
gpathText.Reset()
Else
g.FillPath(br, gpathText)
End If
'Draw the box if the mouse is over the Text
If MouseOver Then
g.ResetTransform()
g.DrawPolygon(ptsTextPen, ptsText)
End If
'Draw the whole thing to the form
e.Graphics.DrawImage(tbm, 10, 10)
'tbm.Dispose()
g.Dispose()
mx.Dispose()
br.Dispose()
gpathText.Dispose()
End Sub
Private Sub TrackBar_Scroll(ByVal sender As System.Object, ByVal e As System.EventArgs) _
Handles tbarRotate.Scroll, tbarTrans.Scroll
lblRotate.Text = tbarRotate.Value
lblOpacity.Text = tbarTrans.Value
Me.Refresh()
End Sub
Sub SetptsText()
'Create a point array of the Text Rectangle
ptsText = New PointF() { _
ptText, _
New Point(CInt(ptText.X + szText.Width), ptText.Y), _
New Point(CInt(ptText.X + szText.Width), CInt(ptText.Y + szText.Height)), _
New Point(ptText.X, CInt(ptText.Y + szText.Height)) _
}
End Sub
Private Sub chkAddOutline_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkAddOutline.CheckedChanged
Me.Refresh()
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
If FontDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
End If
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
If OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
PictureBox1.Image = Image.FromFile(OpenFileDialog1.FileName)
bm = Image.FromFile(OpenFileDialog1.FileName)
szText = Me.CreateGraphics.MeasureString(strText, pic_font)
SetptsText()
ptsTextPen.DashStyle = DashStyle.Dot
End If
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
If SaveFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
tbm.Save(SaveFileDialog1.FileName)
End If
End Sub
End Class
What do you mean.If you mean open a font dialog and select a font from it,here is the code.
' You need Import System.Drawing before your class
' In your class vars section
Dim fd As New FontDialog
'later in your code
' This should be in the code where you call the font dialog
If(fd.ShowDialog() == DialogResults.Ok)
pic_font = fd.Font
End If
Ok, so I have these functions I'm tring to use via my vba code.
It's probably the as it would have been with vbs as well.
Here's the function(s)
'declarations for working with Ini files
Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias _
"GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, _
ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias _
"GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, _
ByVal lpFileName As String) As Long
'// INI CONTROLLING PROCEDURES
'reads an Ini string
Public Function ReadIni(Filename As String, Section As String, Key As String) As String
Dim RetVal As String * 255, v As Long
v = GetPrivateProfileString(Section, Key, "", RetVal, 255, Filename)
ReadIni = Left(RetVal, v + 0)
End Function
'reads an Ini section
Public Function ReadIniSection(Filename As String, Section As String) As String
Dim RetVal As String * 255, v As Long
v = GetPrivateProfileSection(Section, RetVal, 255, Filename)
ReadIniSection = Left(RetVal, v + 0)
End Function
How can I use this to create a function that basically allows me to specify only the section I want to look in, and then find each ini string within that section and put it into an array and return that Array so I can do a loop with it?
Edit: I see that ReadIniSection returns all of the keys in a huge string.
Meaning, I need to split it up.
ReadIniSection returns something that looks like this:
"Fornavn=FORNAVN[]Etternavn=ETTERNAVN" etc etc. The[] in the middle there isn't brackets, it's a square. Probably some character it doesn't recognize. So I guess I should run it through a split command that takes the value between a = and the square.
See if this helps - splitting on nullchar \0:
Private Sub ListIniSectionLines()
Dim S As String: S = ReadIniSection("c:\windows\win.ini", "MAIL")
Dim vLines As Variant: vLines = Split(S, Chr$(0))
Dim vLine As Variant
For Each vLine In vLines
Debug.Print vLine
Next vLine
End Sub