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,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,Me.ScaleWidth,Me.ScaleHeight,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,rc.Right - rc.Left,rc.Bottom - rc.Top,ByVal 0
    mf.BackColor = &HF0F0F7 '.Refresh
    Call ReleaseDC(mf.hWnd,hDC1)

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

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

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

 p.Render hDC1,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,vbNullChar)
    Call GetClientRect(hClient,rc)
    hDC1 = GetWindowDC(hClient)
    
    hDC2 = CreateCompatibleDC(hDC1)
    hOld = SelectObject(hDC2,p.Handle)
    BitBlt hDC1,hDC2,vbSrcCopy
    SelectObject hDC2,hOld
    DeleteDC hDC2
    'p.Render hDC1,ByVal 0
    mf.BackColor = &HF0F0F7 '.Refresh
End Sub


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

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

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

版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。

相关推荐


Format[$] ( expr [ , fmt ] ) format 返回变体型 format$ 强制返回为文本 -------------------------------- 数字类型的格式化 --------------------------------     固定格式参数:     General Number 普通数字,如可以用来去掉千位分隔号     format$("100,1
VB6或者ASP 格式化时间为 MM/dd/yyyy 格式,竟然没有好的办法, Format 或者FormatDateTime 竟然结果和系统设置的区域语言的日期和时间格式相关。意思是尽管你用诸如 Format(Now, "MM/dd/yyyy"),如果系统的设置格式区域语言的日期和时间格式分隔符是"-",那他还会显示为 MM-dd-yyyy     只有拼凑: <%response.write
在项目中添加如下代码:新建窗口来显示异常信息。 Namespace My ‘全局错误处理,新的解决方案直接添加本ApplicationEvents.vb 到工程即可 ‘添加后还需要一个From用来显示错误。如果到这步还不会则需要先打好基础啦 ‘======================================================== ‘以下事件
转了这一篇文章,原来一直想用C#做k3的插件开发,vb没有C#用的爽呀,这篇文章写与2011年,看来我以前没有认真去找这个方法呀。 https://blog.csdn.net/chzjxgd/article/details/6176325 金蝶K3 BOS的插件官方是用VB6编写的,如果  能用.Net下的语言工具开发BOS插件是一件很愉快的事情,其中缘由不言而喻,而本文则是个人首创,实现在了用V
Sub 分列() ‘以空格为分隔符,连续空格只算1个。对所选中的单元格进行处理 Dim m As Range, tmpStr As String, s As String Dim x As Integer, y As Integer, subStr As String If MsgBox("确定要分列处理吗?请确定分列的数据会覆盖它后面的单元格!", _
  窗体代码 1 Private Sub Text1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) 2 Dim path As String, hash As String 3 For Each fil
  Imports MySql.Data.MySqlClient Public Class Form1 ‘ GLOBAL DECLARATIONS Dim conString As String = "Server=localhost;Database=net2;Uid=root;Pwd=123456;" Dim con As New MySqlConnection
‘導入命名空間 Imports ADODB Imports Microsoft.Office.Interop   Private Sub A1() Dim Sql As String Dim Cnn As New ADODB.Connection Dim Rs As New ADODB.Recordset Dim S As String   S = "Provider=OraOLEDB.Oracl
Imports System.IO Imports System.Threading Imports System.Diagnostics Public Class Form1 Dim A(254) As String    Function ping(ByVal IP As Integer) As String Dim IPAddress As String IPAddress = "10.0.
VB运行EXE程序,并等待其运行结束 参考:https://blog.csdn.net/useway/article/details/5494084 Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long Pr
今天碰到一个问题,登陆的时候,如果不需要验证手机号为空,则不去验证手机号 因为登陆的时候所有的验证信息都存放在一个数组里 Dim CheckUserInfo() As String ={UserBirthday, SecEmail, UserMob, UserSex, RealNameFirst, RealName, CheckCardID, CheckCardType, Contactemail
在VB6.0中,数据访问接口有三种: 1、ActiveX数据对象(ADO) 2、远程数据对象(RDO) 3、数据访问对象(DAO) 1.使用ADO(ActiveX Data Objec,ActiveX数据对象)连接SQL Server 1)使用ADO控件连接 使用ADO控件的ConnectionString属性就可以连接SQL Server,该属性包含一个由分号分隔的argument=value语
注:大家如果没有VB6.0的安装文件,可自行百度一下下载,一般文件大小在200M左右的均为完整版的软件,可以使用。   特别提示:安装此软件的时候最好退出360杀毒软件(包括360安全卫士,电脑管家等,如果电脑上有这些软件的话),因为现如今的360杀毒软件直接会对VB6.0软件误报,这样的话就可能会在安装过程中被误报阻止而导致安装失败,或者是安装后缺乏很多必须的组件(其它的杀毒软件或安全卫士之类的
Private Sub Form_Load() Call conndb End Sub Private Function conndb() Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset Dim strCn, sql As String Dim db_host As String Dim db_user As String
  PPSM06S70:  Add  moddate  EDITSPRINTJOB:  MAX(TO_CHAR(ETRN.MODDATE, ‘yyyy/mm/dd/HH24:MI AM‘)) ACTUAL_SHIPDATE   4.Test Scenario (1) :Query SQL Test DN:8016578337 SELECT CTRN.TKCTID TRUCK_ID,        
  沒有出現CrystalReportViewer時,須安裝CRforVS_13_0. 新增1個數據集,新增1個數據表,添加二列,列名要和資料庫名一樣. 修改目標Framework 修改app.config, <startup >改成<startup useLegacyV2RuntimeActivationPolicy ="true">  CrystalReport1.rpt增加數據庫專家 在表單
Imports System.Threading Imports System Public Class Form1 Dim th1, th2 As Thread Public Sub Method1() Dim i As Integer For i = 1 To 100 If Me.Label1.BackColor =
Friend Const PROCESS_ALL_ACCESS = &H1F0FFF = 2035711 Friend Const PROCESS_VM_READ = &H10 Friend Const PROCESS_VM_WRITE = &H20 Friend Const PAGE_READONLY = &H2 Friend Const PAGE_READWRITE = &H4 Friend
以下代码随手写的 并没有大量测试 效率也有待提升 如果需要C#的请自行转换 Function SplitBytes(Data As Byte(), Delimiter As Byte()) As List(Of Byte()) Dim i = 0 Dim List As New List(Of Byte()) Dim bytes As New
Imports System.Data.SqlClient Public Class Form1 REM Public conn1 As SqlConnection = New SqlConnection("server=.; Integrated Security=False;Initial Catalog= mydatabase1; User ID= sa;password")