Qxwlm 发表于 2009-8-29 20:36:56

使用ActiveX EXE多线程加载图片的问题

<p><font face="Verdana">一、做个图片浏览的软件,按缩略图显示图片。思路如下:<br/>1、因为图片比较多,每次显示20个。例如有500个图片,先显示20个,然后通过滚动条来显示其他的图片。<br/>2、每次向下滚动时,就加载20个图片,然后设置成缩略图的大小,并存放在ImageList。这样向上滚动时,就直接从ImageList加载了。<br/>3、如果图片比较大,第一次向向下滚动时,很慢。想使用ActiveX EXE,把所有的图片按缩略图的大小设置后,存入ImageList中。<br/>二、问题:<br/>使用ActiveX EXE,不能传回ImageList中的图片,以便在主程序中调用。<br/>三、代码:<br/>1、ActiveX EXE的代码:<br/>(1)构成:<br/>一个窗体,名称:frmPic,上面有四个控件:<br/>PictureBox-----名称:picTp<br/>FileListBox----名称:FileTP<br/>Image----------名称:imgTp<br/>ImageList------名称:imgLstTp<br/>Timer----------名称:Timer1<br/>一个类模块,名称:clsInstImg<br/>(2)、类模块代码:<br/>Option Explicit<br/>Private WithEvents frmP As frmPic<br/>Public Event clsInstImgOk(img As Object)<br/>'图片的缩略图全部加载到ImageList后发生的事件,引用<br/>'ImageList</font></p>
<p><font face="Verdana"><br/>Private Sub Class_Terminate()<br/>&nbsp;&nbsp;&nbsp;&nbsp; Unload frmP<br/>&nbsp;&nbsp;&nbsp; &nbsp;Set frmP = Nothing<br/>End Sub</font></p>
<p>&nbsp;</p>
<p><font face="Verdana">Private Sub frmP_frmInstOk(img As ImageList)<br/>&nbsp;&nbsp;&nbsp;&nbsp; RaiseEvent clsInstImgOk(img)&nbsp; <br/>End Sub</font></p>
<p>&nbsp;</p>
<p><font face="Verdana">Public Sub InstPicToImg(ByVal strIPath As String)<br/>&nbsp; &nbsp; Set frmP = New frmPic<br/>&nbsp; &nbsp; frmP.Show<br/>&nbsp; &nbsp; frmP.strFrmS = strIPath<br/>&nbsp;&nbsp; &nbsp;frmP.mtmTimeStar<br/>End Sub</font></p>
<p><font face="Verdana"><br/>(3)、窗体代码:</font></p>
<p><font face="Verdana">Option Explicit<br/>Dim intTnum As Integer<br/>Public Event frmInstOk(img as Object)<br/>'图片的缩略图全部加载到ImageList后发生的事件,引用<br/>'窗体frmPic<br/>Public strFrmS As String</font></p>
<p>&nbsp;</p>
<p><font face="Verdana">Private Sub frmInstImg()<br/>&nbsp;&nbsp; Dim strP As String<br/>&nbsp;&nbsp; Dim lst As ListItem<br/>&nbsp;&nbsp; Dim sngG As Single<br/>&nbsp;&nbsp; Dim I As Integer<br/>&nbsp;&nbsp; <br/>&nbsp;&nbsp; <br/>&nbsp;&nbsp; fileTp.Path = strFrmS<br/>&nbsp;&nbsp; For I = 0 To fileTp.ListCount - 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; DoEvents<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Right(fileTp.Path, 1) = "\" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; strP = fileTp.Path &amp; fileTp.List(I)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; strP = fileTp.Path &amp; "\" &amp; fileTp.List(I)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set lst = lvwTp.FindItem(UCase(strP))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Not lst Is Nothing Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; GoTo EndTp<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; On Error GoTo EndTp<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set imgTp.Picture = LoadPicture(strP)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If imgTp.Width &gt;= 600 Or imgTp.Height &gt;= 600 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; picTp.PaintPicture imgTp.Picture, 0, 0,100,100<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '按100×100设置缩略图<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; imgLstTp.ListImages.Add , UCase(strP), picTp.Image<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '把设置好的缩略图加到ImageList中<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>EndTp:<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; picTp.Picture = LoadPicture()<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set picTp.Picture = Nothing<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; imgTp.Picture = LoadPicture()<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set lst = Nothing<br/>&nbsp;&nbsp; Next<br/>&nbsp;&nbsp; RaiseEvent frmInstOk(imgLstTp)</font></p>
<p><font face="Verdana">End Sub</font></p>
<p>&nbsp;</p>
<p><font face="Verdana">Public Sub mtmTimeStar()<br/>&nbsp;&nbsp; Timer1.Enabled = True<br/>End Sub</font></p>
<p>&nbsp;</p>
<p><font face="Verdana">Private Sub Timer1_Timer()<br/>&nbsp;&nbsp; intTnum = intTnum + 1<br/>&nbsp;&nbsp; If intTnum &gt; 3 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Timer1.Enabled = False<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; frmInstImg<br/>&nbsp;&nbsp; End If<br/>End Sub</font></p>
<p>&nbsp;</p>
<p><font face="Verdana">2、主程序:<br/>(1)、构成:<br/>一个窗体,名称:Form1<br/>窗体上两个CommandButton,名称分别为:Command1和Command2<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 一个PictureBox,名称为PicTp<br/>(2)、代码:<br/>Option Explicit<br/>Dim WithEvents clsImg As clsInstImg<br/>Private picClsF As PictureBox</font></p>
<p>&nbsp;</p>
<p><font face="Verdana">Private Sub clsImg_clsInstImgOk(img As Object)<br/>&nbsp;&nbsp; Dim I As Integer<br/>&nbsp;&nbsp; Dim J As Integer<br/>&nbsp;&nbsp; J = img.ListImages.Count<br/>&nbsp;&nbsp; For I = 1 To J<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; picTp.Picture=img.ListImages(I).Picture<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '不能得到ImageList中的Picture。<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '如果从ActiveX EXE中引用PictureBox,无论<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '是PictureBox的Picture属性还是Image属性,<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '都不能得到图片。<br/>&nbsp;&nbsp; Next<br/>&nbsp;&nbsp; MsgBox "Ok"<br/>End Sub</font></p>
<p>&nbsp;</p>
<p><font face="Verdana">Private Sub Command1_Click()<br/>&nbsp;&nbsp; Dim strPF As String<br/>&nbsp;&nbsp; strPF = "F:\VbProg\Pic"<br/>&nbsp;&nbsp; Set clsImg = CreateObject("YsImg.clsInstImg")<br/>&nbsp;&nbsp; clsImg.InstPicToImg strPF<br/>End Sub</font></p>
<p><font face="Verdana">Private Sub Form_Unload(Cancel As Integer)<br/>&nbsp;&nbsp; Set clsImg = Nothing<br/>End Sub</font></p>
<p><font face="Verdana">四、后记:难道使用ActiveX EXE,只能返回String等数据类型<br/>或记录集,而不能返回控件的引用?<br/>请高手给的答复。谢谢。</font></p>
[此贴子已经被作者于2009-8-29 20:39:54编辑过]

马大哈 发表于 2009-8-30 20:58:36

<p>我的思路是,不要这样直接在两个线程间传递对象,而是传递一些非对象的东西,比如字节数组.</p>
<p>&nbsp;</p>
<p>你既然已经在A EXE中生成了缩略图,则可以用BitBlt从一个DC绘到另一个DC来.</p>
<p>&nbsp;</p>
<p>另外,不知道你试过使用GDI+来生成缩略图没?</p>
<p>&nbsp;</p>
<p>我这里给你贴一个GDI+生成缩略图的代码,经测试,我的机器上生成一个6.03M的BMP的313x271大小的缩略图,耗时0.5秒左右.</p>
<p>&nbsp;</p>
<p>BMP的大小是1255x17115,是一个网页截图.</p>
<p>&nbsp;</p>
<p>如果这代码在台式机的7200转硬盘上使用,应该会更快的吧:</p>
<p>&nbsp;</p>
<div class="msgheader">QUOTE:</div><div class="msgborder"><b>
<p><font face="Verdana">Option Explicit</font></p>
<p><font face="Verdana">Private Type GdiplusStartupInput<br/>&nbsp;&nbsp;&nbsp; GdiplusVersion As Long<br/>&nbsp;&nbsp;&nbsp; DebugEventCallback As Long<br/>&nbsp;&nbsp;&nbsp; SuppressBackgroundThread As Long<br/>&nbsp;&nbsp;&nbsp; SuppressExternalCodecs As Long<br/>End Type</font></p>
<p><font face="Verdana">Private Enum GpStatus 'Status<br/>&nbsp;&nbsp;&nbsp; Ok = 0<br/>&nbsp;&nbsp;&nbsp; GenericError = 1<br/>&nbsp;&nbsp;&nbsp; InvalidParameter = 2<br/>&nbsp;&nbsp;&nbsp; OutOfMemory = 3<br/>&nbsp;&nbsp;&nbsp; ObjectBusy = 4<br/>&nbsp;&nbsp;&nbsp; InsufficientBuffer = 5<br/>&nbsp;&nbsp;&nbsp; NotImplemented = 6<br/>&nbsp;&nbsp;&nbsp; Win32Error = 7<br/>&nbsp;&nbsp;&nbsp; WrongState = 8<br/>&nbsp;&nbsp;&nbsp; Aborted = 9<br/>&nbsp;&nbsp;&nbsp; FileNotFound = 10<br/>&nbsp;&nbsp;&nbsp; ValueOverflow = 11<br/>&nbsp;&nbsp;&nbsp; AccessDenied = 12<br/>&nbsp;&nbsp;&nbsp; UnknownImageFormat = 13<br/>&nbsp;&nbsp;&nbsp; FontFamilyNotFound = 14<br/>&nbsp;&nbsp;&nbsp; FontStyleNotFound = 15<br/>&nbsp;&nbsp;&nbsp; NotTrueTypeFont = 16<br/>&nbsp;&nbsp;&nbsp; UnsupportedGdiplusVersion = 17<br/>&nbsp;&nbsp;&nbsp; GdiplusNotInitialized = 18<br/>&nbsp;&nbsp;&nbsp; PropertyNotFound = 19<br/>&nbsp;&nbsp;&nbsp; PropertyNotSupported = 20<br/>End Enum</font></p>
<p><font face="Verdana">Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As GpStatus<br/>Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As GpStatus<br/>Private Declare Function GdipDrawImageRect Lib "gdiplus" (ByVal graphics As Long, ByVal Image As Long, ByVal X As Single, ByVal Y As Single, ByVal Width As Single, ByVal Height As Single) As GpStatus<br/>Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hDC As Long, graphics As Long) As GpStatus<br/>Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As GpStatus<br/>Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal filename As String, Image As Long) As GpStatus<br/>Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As GpStatus</font></p>
<p><font face="Verdana">Dim gdip_Token As Long<br/>Dim gdip_Image As Long<br/>Dim gdip_Graphics As Long</font></p>
<p><font face="Verdana">'————————————<br/>'– 使用者请保留作者版权<br/>'– 作者:BEAR-BEN<br/>'– QQ:453628001<br/>'————————————</font></p>
<p><font face="Verdana">'————-缩略图函数———<br/>Public Sub ShowTNImg(PBox As Object, ImagePath As String, WidthMax As Long, HeightMax As Long)<br/>&nbsp;&nbsp;&nbsp; If LoadGDIP Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If GdipCreateFromHDC(PBox.hDC, gdip_Graphics) &lt;&gt; 0 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; GdiplusShutdown gdip_Token<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '载入图片到内存中<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; GdipLoadImageFromFile StrConv(ImagePath, vbUnicode), gdip_Image<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '使用GDI+直接从内存中缩略并绘图,GDI+有很好的反锯齿能力<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If GdipDrawImageRect(gdip_Graphics, gdip_Image, 0, 0, WidthMax, HeightMax) &lt;&gt; Ok Then Debug.Print "显示失败。。。"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; DisposeGDIP<br/>End Sub</font></p>
<p><font face="Verdana">Public Function LoadGDIP() As Boolean<br/>&nbsp;&nbsp;&nbsp; Dim GpInput As GdiplusStartupInput<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; GpInput.GdiplusVersion = 1<br/>&nbsp;&nbsp;&nbsp; LoadGDIP = Not (GdiplusStartup(gdip_Token, GpInput) &lt;&gt; 0)<br/>End Function</font></p>
<p><font face="Verdana">Public Sub DisposeGDIP()<br/>&nbsp;&nbsp;&nbsp; GdipDisposeImage gdip_Image<br/>&nbsp;&nbsp;&nbsp; GdipDeleteGraphics gdip_Graphics<br/>&nbsp;&nbsp;&nbsp; GdiplusShutdown gdip_Token<br/>End Sub</font></p></b></div>
<p>&nbsp;</p>
<p>代码出处:</p>
<p>&nbsp;</p>
<p><font face="Verdana"><a href="http://www.tcdongli.com/archives/12">http://www.tcdongli.com/archives/12</a></font></p>
<p>&nbsp;</p>
<p>我作了一些改动.原作多处使用了END,并未将错误返回,我认为这不太好.</p>
<p>&nbsp;</p>
<p>最后祝你好运.</p>
[此贴子已经被作者于2009-8-30 20:59:25编辑过]

Qxwlm 发表于 2009-8-31 21:44:37

<p>谢谢老马!!</p>
<p>两者结合:</p>
<p>1、在ActiveX EXE和主程序中,不使用VB的LoadPicture,而使用GDI+加载图片,</p>
<p>2、在ActiveX EXE把生成的缩略图,使用BitBlt,从picTp.Hdc,传递到主程序的imgLstTp的DC中(此步仅仅是个想法,还没有动手验证)。</p>
<p>再次谢谢!!</p>

马大哈 发表于 2009-9-2 21:36:40

<p>不对不对.......你可以直接将你EXE中的HDC传进去......我之前没仔细看这代码,汗了.</p>
<p>&nbsp;</p>
<p>注意看那代码中的这一句:</p>
<p>&nbsp;</p>
<p>GdipCreateFromHDC(PBox.hDC, gdip_Graphics)</p>
<p>&nbsp;</p>
<p>这里的HDC就可以从EXE中传入A EXE中......我汗- -!</p>

Qxwlm 发表于 2009-9-10 10:17:32

<p>谢谢老马再次补充。</p>
<p>1、使用GDI+确实很快,并且支持的图片格式很多:*bmp;*.dib;*.rle;*.jpg;*.jpeg;*.jiff;*.jpe;*.tiff;*.tif;*.gif;*.png;*.wmf;*.emf。</p>
<p>&nbsp;&nbsp;&nbsp;&nbsp; 网上的代码中*.wmf;*.emf没有使用GDI+,我发现可以使用,并且有些格式的WMF文件,LoadPicture()不能读取,GDI+还能读取。</p>
<p>2、对于*.ico;*.cur则LoadPicture()。</p>
<p>&nbsp;</p>
页: [1]
查看完整版本: 使用ActiveX EXE多线程加载图片的问题