Visual Basic

Quote:

I discover also that with this suggestion or with just a picturebox, if it is inside a groupbox, the image/icon will not be show complete, it will be cut after the border.

Public Class FloatingErrorProvider
   Inherits ErrorProvider
   ' Create a storage structure to hold the DummyControls that will
   ' be parented to the form that contains the control be error reported
   ' The ErrorProvider will display the ErrorIcon against these controls 
   ' instead of against the source control if the source control is not 
   ' directly parented to the form.
   Private AnchorControls As New Dictionary(Of Control, DummyControl)

   Private Function GetDummy(ByVal control As Control) As DummyControl
      Dim dummy As DummyControl
      If AnchorControls.ContainsKey(control) Then
         dummy = AnchorControls(control)
      Else
         dummy = New DummyControl            ' a zero sized, non-painting control
         dummy.Parent = control.FindForm     ' parent to the host form
         dummy.SendToBack()                  ' send to bottom of Z-order
         AnchorControls.Add(control, dummy)  ' store a reference to it
      End If
      Return dummy
   End Function

   ''' <summary>
   ''' sets the dummy control location
   ''' </summary>
   Private Sub SetDummyPosition(ByVal dummy As DummyControl, ByVal control As Control)
      Dim errloc As Point
      Dim left As Int32 = control.Location.X
      Dim right As Int32 = left + control.Width
      Dim top As Int32 = control.Location.Y
      Dim bottom As Int32 = top + control.Height
      Dim mid As Int32 = top + (control.Height \ 2)

      Dim align As ErrorIconAlignment = GetIconAlignment(control)
      Select Case align
         Case ErrorIconAlignment.BottomLeft
            errloc = New Point(left, bottom)
         Case ErrorIconAlignment.BottomRight
            errloc = New Point(right, bottom)

         Case ErrorIconAlignment.MiddleLeft
            errloc = New Point(left, mid)

         Case ErrorIconAlignment.MiddleRight
            errloc = New Point(right, mid)

         Case ErrorIconAlignment.TopLeft
            errloc = New Point(left, top)

         Case ErrorIconAlignment.TopRight
            errloc = New Point(right, top)

      End Select
      dummy.Location = control.FindForm.PointToClient(control.Parent.PointToScreen(errloc))
   End Sub

   Public Shadows Sub SetError(ByVal control As Control, ByVal text As String)
      Dim errcontrol As Control
      If NeedsDummy(control) Then
         errcontrol = GetDummy(control)
         SetDummyPosition(DirectCast(errcontrol, DummyControl), control)
      Else
         errcontrol = control
      End If

      MyBase.SetError(errcontrol, text)

   End Sub

   ''' <summary>
   ''' determine if control is parented directly to the form
   ''' </summary>
   Private Function NeedsDummy(ByVal control As Control) As Boolean
      Dim frm As Form = control.FindForm
      Return frm.Handle <> control.Parent.Handle
   End Function

#Region "Method Overrides"
   Public Shadows Sub SetIconAlignment(ByVal control As Control, ByVal alignment As ErrorIconAlignment)
      If NeedsDummy(control) Then
         Dim errcontrol As DummyControl = GetDummy(control)
         MyBase.SetIconAlignment(errcontrol, alignment)
         SetDummyPosition(errcontrol, control)
      Else
         MyBase.SetIconAlignment(control, alignment)
      End If
   End Sub
   Public Shadows Function GetError(ByVal Control As Control) As String
      Dim errcontrol As Control
      If NeedsDummy(Control) Then
         errcontrol = GetDummy(Control)
      Else
         errcontrol = Control
      End If
      Return MyBase.GetError(errcontrol)
   End Function

   Public Shadows Function GetIconAlignment(ByVal control As Control) As ErrorIconAlignment
      Dim errcontrol As Control
      If NeedsDummy(control) Then
         errcontrol = GetDummy(control)
      Else
         errcontrol = control
      End If
      Return MyBase.GetIconAlignment(errcontrol)
   End Function

   Public Shadows Function GetIconPadding(ByVal control As Control) As Int32
      Dim errcontrol As Control
      If NeedsDummy(control) Then
         errcontrol = GetDummy(control)
      Else
         errcontrol = control
      End If
      Return MyBase.GetIconPadding(errcontrol)
   End Function

   Public Shadows Sub SetIconPadding(ByVal control As Control, ByVal padding As Int32)
      Dim errcontrol As Control
      If NeedsDummy(control) Then
         errcontrol = GetDummy(control)
      Else
         errcontrol = control
      End If
      MyBase.SetIconPadding(errcontrol, padding)
   End Sub
#End Region

   ''' <summary>
   ''' A non-painting, zero sized control to post an Error against
   ''' </summary>
   Private Class DummyControl
      Inherits Control
      Public Sub New()
         Size = Size.Empty
         Visible = True
      End Sub
      Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)
         'don't paint anything
      End Sub
   End Class
End Class

991176515 wrote:

<layer>how to zoom a big image with VB?

991176515 wrote:

I want it to be completed within 100 milliseconds

Bastard Programmer from Hell
If you can't read my code, try converting it here[^]

991176515 wrote:

I need to zoom a big image smoothly.It can be achieved only when scaling time in about 70 milliseconds or less.

991176515 wrote:

But i have had a try with the GDI+,it taked about 1500-3000 milliseconds to zoom the whole picture and 200-300 millseconds to the visible part(it's size is about 1300 * 960).

Bastard Programmer from Hell
If you can't read my code, try converting it here[^]

Member 10409199 wrote:

Public Class Countries
    Dim enterCountry(ARRAY_UPPERBOUND) As WorldCountries

    Private Sub Countries_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim enterCountry(ARRAY_UPPERBOUND) As WorldCountries
...

Member 10386526 wrote:

Thanks for nothing

Member 10386526 wrote:

Thanks for nothing

' ref: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633499%28v=vs.85%29.aspx
Private Declare Function FindWindow Lib "user32" _
   Alias "FindWindowA" _
   (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
   
' this is a special case of FindWindow
Private Declare Function FindWindowByCaption Lib "user32" _
   Alias "FindWindowA" _
   (ByVal thismustbezero As Long, _
    ByVal lpWindowName As String) As Long
    
' ref: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633500%28v=vs.85%29.aspx
Private Declare Function FindWindowEx Lib "user32" _
    Alias "FindWindowExA" _
    (ByVal parentHandle As Long, _
     ByVal childAfter As Long, _
     ByVal lclassName As String, _
     ByVal windowTitle As String) As Long
   
' ref: http://msdn.microsoft.com/en-us/library/windows/desktop/ms644950%28v=vs.85%29.aspx
Private Declare Function SendMessage Lib "user32.dll" _
    Alias "SendMessageA" _
    (ByVal hWnd As Long, _
     ByVal msg As Long, _
     ByVal wParam As Long, _
     ByVal lParam As Long) As Long

' WM_Paste will be sent to the window to tell it to paste from the clipboard
Private Const WM_Paste As Long = &H302

Sub Test()
    ' using notepad just as an example external application
    
    Dim res As Double
    res = Shell("notepad.exe", vbNormalFocus)
    
    ' get the handle to the notepad application window
    Dim hWndNotepad As Long
    hWndNotepad = FindWindowByCaption(0, "Untitled - Notepad")
    
    ' Typically, the window you want to paste to is a child window
    ' to the main window.  In the the case of Notepad, the child window has
    ' the class name "Edit".
    Dim hwndEdit As Long
    hwndEdit = FindWindowEx(hWndNotepad, 0, "Edit", "")
    
    ' copy something to the clipboard
    Range("Sheet1!A1").Formula = "This was copied from my excel spreadsheet"
    Range("Sheet1!A1").Copy
    
    ' now that we have the handle to the notpad edit window,
    ' send it a the WM_Paste message
    Dim res2 As Long
    res2 = SendMessage(hwndEdit, WM_Paste, 0, 0)

End Sub