Private Declare SHEmptyRecycleBin Lib “Shell32” Alias
“SHEmptyRecycleBinA” (ByVal HWND As Long, ByVal pszRootPath As String,
ByVal dwFlags As Long) As Long
   
Private Sub Command1_Click()
    SHEmptyRecycleBin Me.HWND, vbNullString, SHERB_NOCONFIRMATION Or
SHERB_NOSOUND ‘清空回收站(未有提示音信和音乐)
End Sub

        Dim r As RECT

Private Declare Function CallWindowProc Lib “user32” Alias “CallWindowProcA” (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const SHERB_NOCONFIRMATION = 1    
‘执行清空操作时不会付给提醒音讯
Private Const SHERB_NOSOUND = 4           
‘实行清空操作时不播放提醒音乐

    bmWidth As Long

‘调用窗口暗中认可的管理进程 
MyBase.WndProc(m) 

感谢 :
 Soyokaze在  里的代码

图片 1图片 2代码

    bmPlanes As Integer

Private Sub Command3_Click() 

        r.Left = PrintInfo.PrintRectLeft

‘子类化出口

    Call GetDIBits(hdc, hBmp, 0, tSize.cy, byBits(0, 0), tBmpInfo,
DIB_RGB_COLORS)

‘安装子类化入口 
Call Init(Me.hWnd) 

    bmBitsPixel As Integer

‘ Owner draw 常量

Private Const BI_RGB = 0&

Private Type POINTAPI

    cy As Long

  运维Visual Basic
6同有的时候候创制一个标准EXE工程。

Private Type BITMAPINFO

  下边包车型大巴例子将演示如何将About参预窗口的系统菜单。

    

 

    

 

    Dim hBmp As Long

Private Const ODA_FOCUS = &H4

    rgbRed As Byte

  子类化本领能够让咱们落到实处部分应用VB在平常尺度下不大概成功的义务,何况通过这么些技能能够特别长远的上学Windows编制程序,成为VB开垦职员中的高手。

Private Const OBJ_PEN = 1

Private Sub Form_Load() 

        

①创立工程

    ‘取得 Bmp 像素位

 Dim P As POINTAPI
 
 Dim s As String
 
 Dim hbr As Long
 
 Dim hpen As Long
 
 
 
 hbr = CreateSolidBrush(GetSysColor(COLOR_BTNFACE)) ‘RGB(231, 231, 231)
 
 SelectObject hdc, hbr
 
 FillRect hdc, rct, hbr
 
 DeleteObject hbr
 
 
 
 ‘画文字时背景为透明状
 
 SetBkMode hdc, TRANSPARENT
 
 ‘得到Button的Caption
 
 s = String$(255, ” “)
 
 GetWindowText hWnd, s, 255
 
 s = Trim$(s)
 
 ‘依据Button的Enabled状态举办重画
 
 If (nState And ODS_DISABLED) = ODS_DISABLED Then
 
 ‘画外围灰框
 
 hbr = CreateSolidBrush(RGB(132, 130, 132))
 
 SelectObject hdc, hbr
 
 FrameRect hdc, rct, hbr
 
 DeleteObject hbr
 
 ‘画内侧3D效果->亮色
 
 hpen = CreatePen(PS_SOLID, 1, RGB(255, 255, 255))
 
 SelectObject hdc, hpen
 
 MoveToEx hdc, rct.Left + 1, rct.Top + 1, P
 
 LineTo hdc, rct.Right – 1, rct.Top + 1
 
 MoveToEx hdc, rct.Left + 1, rct.Top + 1, P
 
 LineTo hdc, rct.Left + 1, rct.Bottom – 1
 
 DeleteObject hpen
 
 ‘画内侧3D效果->暗色
 
 hpen = CreatePen(PS_SOLID, 1, RGB(189, 190, 189))
 
 SelectObject hdc, hpen
 
 MoveToEx hdc, rct.Left + 1, rct.Bottom – 2, P
 
 LineTo hdc, rct.Right – 1, rct.Bottom – 2
 
 MoveToEx hdc, rct.Right – 2, rct.Top + 1, P
 
 LineTo hdc, rct.Right – 2, rct.Bottom – 1
 
 DeleteObject hpen
 
 ‘画阴影文字
 
 rct.Left = rct.Left + 1
 
 rct.Right = rct.Right + 1
 
 rct.Bottom = rct.Bottom + 1
 
 rct.Top = rct.Top + 1
 
 SetTextColor hdc, GetSysColor(COLOR_BTNHIGHLIGHT)
 
 DrawText hdc, s, LenB(StrConv(s, vbFromUnicode)), rct, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER
 
 rct.Left = rct.Left – 1
 
 rct.Right = rct.Right – 1
 
 rct.Bottom = rct.Bottom – 1
 
 rct.Top = rct.Top – 1
 
 SetTextColor hdc, GetSysColor(COLOR_GRAYTEXT)
 
 DrawText hdc, s, LenB(StrConv(s, vbFromUnicode)), rct, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER
 
 Exit Sub
 
 End If
 
 ‘按下Button时重画
 
 If (nState And ODS_SELECTED) = ODS_SELECTED Then
 
 ‘画内部区域颜色
 
 hbr = CreateSolidBrush(RGB(156, 186, 222))
 
 SelectObject hdc, hbr
 
 FillRect hdc, rct, hbr
 
 DeleteObject hbr
 
 ‘画外围灰框
 
 hbr = CreateSolidBrush(RGB(99, 125, 165))
 
 SelectObject hdc, hbr
 
 FrameRect hdc, rct, hbr
 
 DeleteObject hbr
 
 ‘画内侧3D效果->亮色
 
 hpen = CreatePen(PS_SOLID, 1, RGB(123, 158, 206))
 
 SelectObject hdc, hpen
 
 MoveToEx hdc, rct.Left + 1, rct.Top + 1, P
 
 LineTo hdc, rct.Right – 1, rct.Top + 1
 
 MoveToEx hdc, rct.Left + 1, rct.Top + 1, P
 
 LineTo hdc, rct.Left + 1, rct.Bottom – 1
 
 DeleteObject hpen
 
 ‘画内侧3D效果->暗色
 
 hpen = CreatePen(PS_SOLID, 1, RGB(181, 203, 231))
 
 SelectObject hdc, hpen
 
 MoveToEx hdc, rct.Left + 1, rct.Bottom – 2, P
 
 LineTo hdc, rct.Right – 1, rct.Bottom – 2
 
 MoveToEx hdc, rct.Right – 2, rct.Top + 1, P
 
 LineTo hdc, rct.Right – 2, rct.Bottom – 1
 
 DeleteObject hpen
 
 
 
 rct.Left = rct.Left + 1
 
 rct.Right = rct.Right + 1
 
 rct.Bottom = rct.Bottom + 1
 
 rct.Top = rct.Top + 1
 
 SetTextColor hdc, GetSysColor(COLOR_BTNTEXT)
 
 DrawText hdc, s, LenB(StrConv(s, vbFromUnicode)), rct, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER
 
 Exit Sub
 
 End If
 
 ‘Button获得难点时重画
 
 If (nState And ODS_FOCUS) = ODS_FOCUS Then
 
 ‘画内部区域颜色
 
 hbr = CreateSolidBrush(RGB(173, 203, 239))
 
 SelectObject hdc, hbr
 
 FillRect hdc, rct, hbr
 
 DeleteObject hbr
 
 ‘画外围灰框
 
 hbr = CreateSolidBrush(RGB(107, 138, 181))
 
 SelectObject hdc, hbr
 
 FrameRect hdc, rct, hbr
 
 DeleteObject hbr
 
 ‘画内侧3D效果->亮色
 
 hpen = CreatePen(PS_SOLID, 1, RGB(198, 223, 247))
 
 SelectObject hdc, hpen
 
 MoveToEx hdc, rct.Left + 1, rct.Top + 1, P
 
 LineTo hdc, rct.Right – 1, rct.Top + 1
 
 MoveToEx hdc, rct.Left + 1, rct.Top + 1, P
 
 LineTo hdc, rct.Left + 1, rct.Bottom – 1
 
 DeleteObject hpen
 
 ‘画内侧3D效果->暗色
 
 hpen = CreatePen(PS_SOLID, 1, RGB(132, 174, 222))
 
 SelectObject hdc, hpen
 
 MoveToEx hdc, rct.Left + 1, rct.Bottom – 2, P
 
 LineTo hdc, rct.Right – 1, rct.Bottom – 2
 
 MoveToEx hdc, rct.Right – 2, rct.Top + 1, P
 
 LineTo hdc, rct.Right – 2, rct.Bottom – 1
 
 DeleteObject hpen
 
 
 
 SetTextColor hdc, GetSysColor(COLOR_BTNTEXT)
 
 DrawText hdc, s, LenB(StrConv(s, vbFromUnicode)), rct, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER
 
 Else
 
 ‘画外围灰框
 
 hbr = CreateSolidBrush(RGB(132, 130, 132))
 
 SelectObject hdc, hbr
 
 FrameRect hdc, rct, hbr
 
 DeleteObject hbr
 
 ‘画内侧3D效果->亮色
 
 hpen = CreatePen(PS_SOLID, 1, RGB(255, 255, 255))
 
 SelectObject hdc, hpen
 
 MoveToEx hdc, rct.Left + 1, rct.Top + 1, P
 
 LineTo hdc, rct.Right – 1, rct.Top + 1
 
 MoveToEx hdc, rct.Left + 1, rct.Top + 1, P
 
 LineTo hdc, rct.Left + 1, rct.Bottom – 1
 
 DeleteObject hpen
 
 ‘画内侧3D效果->暗色
 
 hpen = CreatePen(PS_SOLID, 1, RGB(189, 190, 189))
 
 SelectObject hdc, hpen
 
 MoveToEx hdc, rct.Left + 1, rct.Bottom – 2, P
 
 LineTo hdc, rct.Right – 1, rct.Bottom – 2
 
 MoveToEx hdc, rct.Right – 2, rct.Top + 1, P
 
 LineTo hdc, rct.Right – 2, rct.Bottom – 1
 
 DeleteObject hpen
 
 ‘画文字
 
 SetTextColor hdc, GetSysColor(COLOR_BTNTEXT)
 
 DrawText hdc, s, LenB(StrConv(s, vbFromUnicode)), rct, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER
 
 End If

Private Sub IPrintView_PrintPage(ByVal hdc As Long, ByVal hAttribDC As
Long, ByVal PrintInfo As XtremeCommandBars.PrintInfo)

 

        DeleteObject lhDC

Private Const ODS_FOCUS = &H10

    biClrUsed As Long

End Sub
④加盟叁个模块并录入代码 
Option Explicit

    ElseIf GetIconInfo(hObject, tIcon) Then

End Class

End Sub

InsertMenu(GetSystemMenu(Me.Handle, False), 0, MF_BYPOSITION Or MF_SEPARATOCRUISER, 2004, “”卡塔尔 ‘插足一条分水岭 

    biWidth As Long

End Sub

Private Const DT_SINGLELINE = &H20

Private Const ODS_CHECKED = &H8

End Type

End Sub 

        Right As Long

Private Declare Function GetSysColor Lib “user32” (ByVal nIndex As Long) As Long

End Sub

Private Const DT_SINGLELINE = &H20

应用处景

Const PS_USERSTYLE = 7

    With tBmpInfo.bmiHeader

①创制工程

End Type

End Sub 

Private Type ICONINFO

Const PS_DOT = 2 ‘ …….

    

Private Declare Function GetWindowLong Lib “user32” Alias “GetWindowLongA” (ByVal hWnd As Long, ByVal nIndex As Long) As Long

    End If

End If 

    lpBI As BITMAPINFO, _

 x As Long
 
 y As Long

            ‘今后把位图装入剪贴板:

Private Sub DrawButton(ByVal hWnd As Long, ByVal hdc As Long, rct As RECT, ByVal nState As Long)

rtf格式和XAML二种输入基本输入源的。

Private Declare Function SetWindowLong Lib “user32” Alias “SetWindowLongA” (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

        Dim tBmpInfo As BITMAPINFO

CtlType As Long

Private Type Size

Const COLOR_MENU = 4

    bmiColors As RGBQUAD

  在FORM1上停放3个Button控件,并将前三个Button的Style属性设置为1-Graphical,因为唯有Style属性设置为Graphical的Button才方可Owner-drawn。

            CloseClipboard

Private Type RECT

        Bottom As Long

MsgBox(“About Context”, vbInformation, “About…”) 

Dim lhDC As Long

Private Const TRANSPARENT = 1

        

  子类化分为三类:实例子类化(instance
subclassing)—从窗口或控件的十足实例截获音讯,这种子类化手艺最广泛;全局子类化(global
subclassing)—能够收获从相像的窗口类创建出来的多个窗口或控件的新闻;超类化(superclassing)—和大局子类化很相通,不相同在于能够利用在新的窗口类地点。

Private Type BITMAP

‘子类化入口

        End If

Private Const ODS_DISABLED = &H4

    lhDC = CreateCompatibleDC(objFrom.hdc)

Private Const ODA_DRAWENTIRE = &H1

    ByVal nStartScan As Long, _

If m.Msg = WM_SYSCOMMAND Then 

Private Sub IPrintView_BeginPrinting(ByVal hdc As Long, ByVal hAttribDC
As Long, ByVal PrintInfo As XtremeCommandBars.PrintInfo)

Private Sub Form_Unload(Cancel As Integer) 

End Type

Private Type DRAWITEMSTRUCT

        .biCompression = BI_RGB

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load 

    nbPerLine = (tSize.cx * 3 + 3) And &HFFFFFFFC

‘ — 引用Win32Api –
‘得到暗中认可的窗口消息管理进程的地址须要的API

        .biBitCount = 24

Private Const DT_VCENTER = &H4

    ‘在内部存款和储蓄器中国建工业总集结团立七个照准大家将在复制对象的DC:

Private Declare Sub CopyMemory Lib “kernel32” Alias “RtlMoveMemory” (Destination As Any, Source As Any, ByVal Length As Long)

End Sub

Const COLOR_BTNTEXT = 18

Private Declare Function StretchDIBits Lib “gdi32” (ByVal hdc As Long,
ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long,
ByVal SrcX As Long, ByVal SrcY As Long, ByVal wSrcWidth As Long, ByVal
wSrcHeight As Long, lpBits As Any, lpBitsInfo As BITMAPINFO, ByVal
wUsage As Long, ByVal dwRop As Long) As Long

CtlID As Long

Private Declare Function GetObject Lib “gdi32” Alias “GetObjectA” (ByVal
hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Private Declare Function FrameRect Lib “user32” (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long

            SetClipboardData CF_BITMAP, lhBMP

hdc As Long

    biClrImportant As Long

Const PS_INSIDEFRAME = 6

        Dim MyPic As Picture                        ‘定义Picture对象

1. 叫作子类化(subclassing)

    xHotspot As Long

图片 3图片 4代码

    bmBits As Long

 Dim di As DRAWITEMSTRUCT
 
 If Msg = WM_DESTROY Then Terminate (hWnd)
 
 ‘管理自画信息
 
 If Msg = WM_DRAWITEM Then
 
 CopyMemory di, ByVal lParam, Len(di)
 
 ‘决断是自画Button
 
 If di.CtlType = ODT_BUTTON Then
 
 DrawButton di.hwndItem, di.hdc, di.rcItem, di.itemState
 
 ‘不回去VB的暗中同意Button绘制进程
 
 SubWndProc = 1
 
 Exit Function
 
 End If
 
 End If
 
 ‘调用暗中同意的窗口处理进程
 
 SubWndProc = CallWindowProc(PrevWndProc, hWnd, Msg, wParam, lParam)

    Dim tIcon As ICONINFO

Private Declare Function CreateSolidBrush Lib “gdi32” (ByVal crColor As Long) As Long

    ByVal wUsage As Long) _

End Sub

    Dim tSize  As Size

Const COLOR_WINDOWFRAME = 6

            OpenClipboard 0

‘ — 模块结束 — ‘

End Sub

Const PS_DASHDOTDOT = 4 ‘ _.._.._

        ‘淹没刚才构造建设的DC:

Const COLOR_BTNFACE = 15

Private Type BITMAPINFOHEADER ’40 bytes

‘卸载子类化 
Call Terminate(Me.hWnd) 

End Type

rcItem As RECT

As Long

Private Const ODS_GRAYED = &H2

    biPlanes As Integer

Const COLOR_INACTIVEBORDER = 11

        Call GetObject(tIcon.hbmMask, LenB(tBMP), tBMP)

Const COLOR_WINDOWTEXT = 8

        ‘建构一张针对就要复制对象的位图:

‘新的窗口信息管理进度,将被插入到私下认可管理进度以前

Dim lhBMP As Long

目录

Option Explicit

End Type

    End If

Const PS_DASH = 1 ‘ ——-

正如代码,达成剪贴板里的图形的PrintView控件输出

‘ Owner draw 动作

Private Const SRCCOPY = &HCC0020 ‘ (DWORD) dest = source

Private Declare Function SelectObject Lib “gdi32” (ByVal hdc As Long, ByVal hObject As Long) As Long

Public Function CopyEntirePicture(ByRef objFrom As Object) As Boolean

Private Const ODA_SELECT = &H2

2.图像输出

Inherits System.Windows.Forms.Form 

Private Declare Function GetIconInfo Lib “user32” (ByVal hIcon As Long,
piconinfo As ICONINFO) As Long

Dim PrevWndProc&

Private Sub GetImageSize(ByVal hObject As Long, tSize As Size)

Private Declare Function FillRect Lib “user32” (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long

Private Const OBJ_FONT = 6

  .NET中动用子类化技巧要比VB6中轻巧,因为微软在.NET中生龙活虎度提供了接口,无需大家再本人SetWindowLong了,咱们做的是Overrides(覆盖)
WndProc进程就可以。
  Overrides Protected Sub WndProc( ByRef
m As Message 卡塔尔国参数m已毕了Windows的信息类型。

Private Const OBJ_BITMAP = 7

Const COLOR_ACTIVECAPTION = 2

        Top As Long

Private Declare Function DeleteObject Lib “gdi32” (ByVal hObject As Long) As Long

End Type

 Call SetWindowLong(hWnd, GWL_WNDPROC, PrevWndProc)

    Dim nbPerLine As Long

Const COLOR_INACTIVECAPTIONTEXT = 19

End Function

Private 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

        r.Right = PrintInfo.PrintRectRight

Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message) 
‘类化窗口–覆盖WndProc进程 

    bmWidthBytes As Long

Else 

    rgbBlue As Byte

  在Visual Basic
6子类化的贯彻中自身将由此大器晚成段代码的实例来介绍这一本事在VB6中的应用。将来众多开荒社区中日常聊起的二个话题就是分界面开荒如何Skin,这种技能有好些个减轻格局,如选择能够贴图的控件或使用第三方支付的换肤ActiveX控件。其实Skin手艺须求处理的是WM_DRAWITEM、WM_MEASUREITEM、WM_NCPAINT新闻,这一个音讯的首要用处正是能够重画控件和窗口的非客户区。想要对那个VB6不可能管理的新闻实行编制程序就务须用到子类化,这个新闻都会被发送到能够自绘的控件的窗口上,因而上面包车型客车例子正是运用窗口子类化来重画Button控件。

    ByVal aHDC As Long, _

  简单的讲,子类化正是创办七个新的窗口音信处理进度,并将其插入到原来的暗许窗口新闻处理进度从前。

        Left As Long

End Type

        .biPlanes = 1

  门到户说,Windows是二个基于音信的种类,消息在Windows的对象期间举办着传递。子类化和Windows的钩子机制存在于音讯系统里头,大家能够运用那几个机制来支配、修改以至丢掉那么些在操作系统或是进度中传递的消息,以求纠正系统的一些表现。子类化本事用来截取窗口或控件之间的音讯,当然是音信在到达目标窗口以前到位的操作。那些被缴械的音信既能保留也可以改正它们的情景,之后就连绵起伏发送到目标地。子类化技能实现了有些正规情况下不可能实现的作用,试想鼠标右键单击TextBox,系统暗许弹出Undo、Cut、Copy、Paste等菜单,大家就能够使用子类化本事来改造这些体系菜单。

Private Const BI_BITFIELDS = 3&

Const COLOR_HIGHLIGHTTEXT = 14

]()

Const COLOR_APPWORKSPACE = 12

    

  创设叁个VB.NET的Windows
Application工程。

            ‘把位图选入大家刚刚建构的DC中,并蕴藏原先在此边的老位图:

hwndItem As Long

    bmiHeader As BITMAPINFOHEADER

Const COLOR_INACTIVECAPTION = 3

      

②录入代码

    biYPelsPerMeter As Long

‘设置叁个新的窗口消息管理进度的地点须要的API

    tSize.cx = tBMP.bmWidth

  • 名字为子类化(subclassing)
  • Visual Basic 6子类化的兑现
  • Visual Basic .NET子类化的落到实处
  • 小结

            无名氏    在    
 里的代码[

3. Visual Basic .NET子类化的贯彻

        r.Top = PrintInfo.PrintRectTop

itemData As Long

End Type

‘ Owner draw 状态

    rgbReserved As Byte

‘GDI相关API函数,重画Button时使用

    hBmp = MyPic.Handle

Const COLOR_HIGHLIGHT = 13

Private Const DT_CENTER = &H1

Private Declare Function CreatePen Lib “gdi32” (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long

    tSize.cy = tBMP.bmHeight

End If 

        .biWidth = tSize.cx

End Sub

    If GetObjectType(hObject) = OBJ_BITMAP Then

Const COLOR_SCROLLBAR = 0

Implements IPrintView

 PrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf SubWndProc)

    Dim tBMP  As BITMAP

Const COLOR_CAPTIONTEXT = 9

Private Const OBJ_PAL = 5

‘内部存款和储蓄器拷贝

    hbmMask As Long

Const COLOR_MENUTEXT = 7

    Call GetImageSize(hBmp, tSize)

Private Declare Function SetBkMode Lib “gdi32” (ByVal hdc As Long, ByVal nBkMode As Long) As Long

    lpBits As Any, _

Command1.Enabled = False 

            ‘它以往属于剪贴板,当剪贴板变化时,Windows将为大家删除它。

③在窗体中录入代码

    biBitCount As Integer

Const COLOR_BTNSHADOW = 16

            lhBMPOld = SelectObject(lhDC, lhBMP)

Public Class Form1 

    bmType As Long

Const PS_NULL = 5

Private Type RECT

‘中间隐去了.NET自动生成的代码 
‘ – 引用Win32Api 
Private Declare Function GetSystemMenu Lib “user32” (ByVal hWnd As IntPtr, ByVal bRevert As Int32) As Int32 
Private Declare Function InsertMenu Lib “user32” Alias “InsertMenuA” (ByVal hMenu As Int32, ByVal nPosition As Int32, ByVal wFlags As Int32, ByVal wIDNewItem As Int32, ByVal lpNewItem As String) As Int32 

            ‘恢复生机DC中的内容:

Private Declare Function LineTo Lib “gdi32” (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Private Sub IPrintView_PreparePrinting(ByVal PrintInfo As
XtremeCommandBars.PrintInfo)

 

    biCompression As Long

End Function

            ‘把objFrom的内容复制到创立的位图里:

图片 5

    End If

Public Sub Terminate(hWnd As Long)

    ByVal nNumScans As Long, _

Const PS_SOLID = 0

        

Private Const DT_CENTER = &H1

        Set MyPic = Clipboard.GetData(vbCFBitmap)

Private Const ODT_BUTTON = 4

Private Declare Function GetObjectType Lib “gdi32” (ByVal hgdiobj As
Long) As Long

Public Sub Init(hWnd As Long)

            EmptyClipboard

Const COLOR_BACKGROUND = 1

Dim lhBMPOld As Long

‘给钦命的窗口语资信息管理进度传递消息需求的API

Private Const DIB_RGB_COLORS = 0

Const PS_STYLE_MASK = &HF

    ByVal hBitmap As Long, _

Const COLOR_BTNHIGHLIGHT = 20

    biXPelsPerMeter As Long

‘GetSystemMenu(Me.Handle, False卡塔尔是收获系统菜单的句柄,第二个参数为True的话无法修正系统菜单,所以要设为False 
InsertMenu(GetSystemMenu(Me.Handle, False), 0, MF_BYPOSITION Or MF_STOdysseyING, 二〇〇一, “About Me(&A卡塔尔(قطر‎”卡塔尔 ‘插手About me菜单在系统菜单中 

    

Private Function SubWndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    

End Type

    If (PrintInfo.CurrentPage = 1) Then

itemState As Long

        r.Bottom = PrintInfo.PrintRectBottom

End Sub 

    PrintInfo.MaxPage = 1

‘WM_DRAWITEM须求管理的布局体

End Sub

 

Private Sub IPrintView_PrepareDC(ByVal hdc As Long, ByVal hAttribDC As
Long, ByVal PrintInfo As XtremeCommandBars.PrintInfo)

 Left As Long
 
 Top As Long
 
 Right As Long
 
 Bottom As Long

    biSizeImage As Long

If m.WParam.ToInt32 = 2002 Then 

    

Const PS_ALTERNATE = 8

        .biHeight = tSize.cy

‘获得钦赐窗口的文本

    cx As Long

Private Declare Function SetTextColor Lib “gdi32” (ByVal hdc As Long, ByVal crColor As Long) As Long

Private Declare Function GetDIBits Lib “gdi32” ( _

2. Visual Basic 6子类化的兑现

    biSize As Long

Private Declare Function GetWindowText Lib “user32” Alias “GetWindowTextA” (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

    biHeight As Long

End If 

            ‘大家在这里边并不是删除建设构造的位图——

 

    Call StretchDIBits(hdc, 0, 0, tSize.cx, tSize.cy, 0, 0, tSize.cx,
tSize.cy, byBits(0, 0), tBmpInfo, DIB_RGB_COLORS, SRCCOPY)

‘通过Enabled属性的支配,来体现重画控件在Unenabled状态时的成效 
If Command1.Enabled Then 

        lhBMP = CreateCompatibleBitmap(objFrom.hdc, objFrom.ScaleWidth
Screen.TwipsPerPixelX, objFrom.ScaleHeight Screen.TwipsPerPixelY)

Const PS_DASHDOT = 3 ‘ _._._._

    yHotspot As Long

Private Const ODS_SELECTED = &H1

    ReDim byBits(nbPerLine – 1, tSize.cy – 1) As Byte

‘色彩常量

    fIcon As Long

Const COLOR_ACTIVEBORDER = 10

    hbmColor As Long

Const COLOR_WINDOW = 5

            SelectObject lhDC, lhBMPOld

End Sub 

Xtreme Command Bars ActiveX
Control中的PrintView,能够通过API绘制大肆图形和文字,Xtreme Command Bars
ActiveX Control的PrintView只扶植

Private Const WM_DESTROY = &H2

    bmHeight As Long

转载:http://laomaspeak.blog.sohu.com/96138422.html

    rgbGreen As Byte

Private Const WM_DRAWITEM = &H2B

CreateMarkupPrintView Creates
an IPrintView object
from the supplied XAML Markup string. 
CreateRichEditPrintView Creates
an IPrintView object
from the supplied RTF string.

‘ – 表明停止 —

        If (lhBMP <> 0) Then

Command1.Enabled = True 

Private Const BI_RLE8 = 1&

Const COLOR_GRAYTEXT = 17

Private Sub IPrintView_EndPrinting(ByVal hdc As Long, ByVal hAttribDC
As Long, ByVal PrintInfo As XtremeCommandBars.PrintInfo)

‘画笔格式

1.图像输入

Const GWL_WNDPROC = (-4&)

    Dim byBits() As Byte

②窗口结构

      

itemAction As Long

            

Private Declare Function MoveToEx Lib “gdi32” (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long

Private Const BI_RLE4 = 2&

4. 小结

End Type

Private Const MF_BYCOMMAND = &H0& 
Private Const MF_BYPOSITION = &H400& 
Private Const MF_STRING = &H0& 
Private Const MF_SEPARATOR = &H800& 
Private Const WM_SYSCOMMAND = &H112 

Private Type RGBQUAD

itemID As Long

End Sub

        .biSize = Len(tBmpInfo.bmiHeader)

    End With

            BitBlt lhDC, 0, 0, objFrom.ScaleWidth
Screen.TwipsPerPixelX, objFrom.ScaleHeight Screen.TwipsPerPixelY,
objFrom.hdc, 0, 0, SRCCOPY

Private Const OBJ_BRUSH = 2

        Call GetObject(hObject, LenB(tBMP), tBMP)

    If (lhDC <> 0) Then