VB6给MDI窗口(父窗口)动态绘制背景的种种方法

VB6就不说了,要快速写一个程序,.NET(C#)可能还更好更强大,但是要说安全,VB6反到强过他们

有时候两者就是一种矛盾,所以越是用户友好,越是易维护和扩展的程序,越容易被破解.

MDI窗口没有refresh方法,没有paint事件,没有hDC,更没有PaintPicture方法.等等,我们先说动态绘制的必要性.

MDI父窗口有个Picture属性,可以加载一幅图像,然而动态绘制可以根据窗口的大小调整背景图片.

不要告诉我,你要做Width * Height张图片,每次都用LoadPicture,那你的程序还真是大系统了...

由于上面所说的MDI窗体的限制,常规的方法是不行了,现在先提供一个笨一点的方法,越笨越实用,也越简单

1.用PictureBox绘制好图片

Public Sub Draw1(mf As MDIForm, sp As StdPicture, p As PictureBox)
    p.ScaleMode = vbPixels
    p.Width = mf.ScaleWidth     '注意单位
    p.Height = mf.ScaleHeight   '注意单位
    p.AutoRedraw = True
    
    p.PaintPicture sp, 0, 0, p.ScaleWidth, p.ScaleHeight
    mf.Picture = p.Picture
    mf.BackColor = vbWhite  'force refresh
End Sub

首先要注意的是PictureBox的容器ScaleMode会对度量有影响,关键后面要赋值背景色,这样会强迫MDI窗体重绘,图片当然覆盖背景色,就实现了

调整PaintPicture的参数可以实现居中,平铺(缩放)等等各种效果

但是限制是需要一个PictureBox控件,该控件放到MDI中会触动Align属性,即使隐藏了,设计的时候也很不雅观,人爱面子树爱皮,程序爱UI

所以,必须加一个PictureBox,往往要加一个Form.能不能把PictureBox封装到类中呢?我觉得应该可以,甚至可以

Private WithEvents m_Draw As PictureBox

只是到现在我还没实现出来.

那么,还有没有其他替代方案呢,当然,PictureBox最重要的属性是Picture,是一个IPictureDisp(StdPicture),而PaintPicture方法就是

对StdPicture的Render方法封装.只是Render方法原图形的度量是按Himetric算的,要经过换算,用Render方法可以直接渲染到DC上

2.待研究的Render方法,常规的Form是没问题,如

Option Explicit

Dim p As StdPicture

Private Sub Form_Load()
    Me.ScaleMode = vbPixels
    'Me.AutoRedraw = True
    Set p = LoadPicture("F:\Codes\VBCode\1.bmp")
End Sub

Private Sub Form_Resize()
    p.Render Me.hDC, 0, 0, Me.ScaleWidth, Me.ScaleHeight, 0, p.Height, p.Width, -p.Height, ByVal 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set p = Nothing
End Sub

但是注意的一点是,MDI窗体没有hDC,那怎么办,对API直接取DC,如:

    hDC1 = GetDC(mf.hWnd)
    Call GetClientRect(mf.hWnd, rc)
    p.Render hDC1, 0, 0, rc.Right - rc.Left, rc.Bottom - rc.Top, 0, p.Height, p.Width, -p.Height, ByVal 0
    mf.BackColor = &HF0F0F7 '.Refresh
    Call ReleaseDC(mf.hWnd, hDC1)

然而,问题来了,提示无效参数,毛啊!用SPY++,发现MDI窗体的客户区其实是VB自己创建的一个子窗口(WS_CHILD),其类名是MDIClient

那么我们修改一下,而且用GetWindowDC代替成对的GetDC,如下

    hClient = FindWindowEx(mf.hWnd, 0, "MDIClient", vbNullChar)
 Call GetClientRect(hClient, rc)
 hDC1 = GetWindowDC(hClient)

 p.Render hDC1, 0, 0, rc.Right - rc.Left, rc.Bottom - rc.Top, 0, p.Height, p.Width, -p.Height, ByVal 0
 mf.BackColor = &HF0F0F7 '.Refresh

问题依旧,没办法了,目前来说,暂时委屈一下吧,难道我们天生就是奴隶?

VB很像一个东西,那就MFC类库,其实都是对Windows API的封装,那么其最终的实现都是API调用,那么就想到另外一招:

3.无敌的内存绘图

Public Sub Draw1(mf As MDIForm, p As StdPicture)
    Dim hClient As Long, hOld As Long
    Dim hDC1 As Long, hDC2 As Long
    Dim rc As RECT
    
    hClient = FindWindowEx(mf.hWnd, 0, "MDIClient", vbNullChar)
    Call GetClientRect(hClient, rc)
    hDC1 = GetWindowDC(hClient)
    
    hDC2 = CreateCompatibleDC(hDC1)
    hOld = SelectObject(hDC2, p.Handle)
    BitBlt hDC1, 0, 0, rc.Right - rc.Left, rc.Bottom - rc.Top, hDC2, 0, 0, vbSrcCopy
    SelectObject hDC2, hOld
    DeleteDC hDC2
    'p.Render hDC1, 0, 0, rc.Right - rc.Left, rc.Bottom - rc.Top, 0, p.Height, p.Width, -p.Height, ByVal 0
    mf.BackColor = &HF0F0F7 '.Refresh
End Sub

调整BitBlt的参数,就跟调整PaintPicture的参数一样简单,说白了PaintPicture最终还是封装了BitBlt,当然你可以使用其他的绘图API,甚至直接操作位图的像素

但是那样的投入就太大了,一开始我还想用C/C++写个动态库,那样可能效率高点,但是牺牲开发效率来换取执行效率,不见得是明智的选择.

这是我研究出最卑鄙无耻下流银剑的方法了.