⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 stretchrectangle.vb

📁 Programming the .NET Compact Framework with vb 源代码
💻 VB
字号:
' StretchRectangle.vb - StretchRectangle object draw
' and moves a stretchable rectangle.
'
' Code from _Programming the .NET Compact Framework with C#_
' and _Programming the .NET Compact Framework with VB_
' (c) Copyright 2002-2003 Paul Yao and David Durant. 
' All rights reserved.

Imports System
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Runtime.InteropServices

Namespace DrawRectangles
   '/ <summary>
   '/ Summary description for StretchRectangle.
   '/ </summary>
   Public Class StretchRectangle
      ' Declarations needed to draw stretchable rectangle.
      <DllImport("coredll.dll")> _
      Public Shared Function GetDC(ByVal hWnd As IntPtr) As IntPtr
         End Function

      <DllImport("coredll.dll")> _
      Public Shared Function _
         DrawFocusRect(ByVal hDC As IntPtr, _
            ByRef lprc As RECT) As Integer
      End Function
      <DllImport("coredll.dll")> _
      Public Shared Function _
         ReleaseDC(ByVal hWnd As IntPtr, _
            ByVal hDC As IntPtr) As Integer
      End Function
      <DllImport("coredll.dll")> _
      Public Shared Function GetFocus() As IntPtr
      End Function
      <DllImport("coredll.dll")> _
      Public Shared Function _
         SetFocus(ByVal hWnd As IntPtr) As IntPtr
      End Function

      Public Structure RECT
         Public left As Integer
         Public top As Integer
         Public right As Integer
         Public bottom As Integer
      End Structure


      Private m_rect As RECT
      Private m_ptAnchor As Point = New Point(0, 0)
      Private m_ctrl As Control
      Private m_bStretching As Boolean = False
      Public Sub New()
      End Sub
      Public Sub Init(ByVal x As Integer, ByVal y As Integer, _
         ByVal ctrl As Control)
         m_ptAnchor.X = x
         m_ptAnchor.Y = y
         m_ctrl = ctrl

         m_rect.left = x
         m_rect.top = y
         m_rect.right = x
         m_rect.bottom = y

         m_bStretching = True
      End Sub

      Public Sub Move(ByVal x As Integer, ByVal y As Integer)
         If Not m_bStretching Then
            Return
         End If

         ' Remember window with focus.
         Dim hwndFocus As IntPtr = GetFocus()

         ' Set focus to target window
         m_ctrl.Focus()
         Dim hwnd As IntPtr = GetFocus()

         ' Get a DC from GDI
         Dim hdc As IntPtr = GetDC(hwnd)

         ' Eraw previous rectangle.
         DrawFocusRect(hdc, m_rect)

         If x <> -1 And y <> -1 Then
            If x > m_ptAnchor.X Then
               m_rect.left = m_ptAnchor.X
               m_rect.right = x
            Else
               m_rect.left = x
               m_rect.right = m_ptAnchor.X
            End If

            If y > m_ptAnchor.Y Then
               m_rect.top = m_ptAnchor.Y
               m_rect.bottom = y
            Else
               m_rect.top = y
               m_rect.bottom = m_ptAnchor.Y
            End If

            ' Expand rectangle to match how final rectangle.
            m_rect.right = m_rect.right + 1
            m_rect.bottom = m_rect.bottom + 1

            ' Draw new rectangle.
            DrawFocusRect(hdc, m_rect)
         End If

         ' Clean up.
         ReleaseDC(hwnd, hdc)

         SetFocus(hwndFocus)
      End Sub

      Public Sub Done()
         Move(-1, -1)
         m_bStretching = False
      End Sub
   End Class
End Namespace

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -