关于LoadPicture函数的问题

2004-01-14 03:47:56 563 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

保姆级避坑指南：在Ubuntu 22.04上成功复现VMamba模型（附完整环境依赖清单）本文提供了在Ubuntu 22.04上复现VMamba模型的详细指南，包括环境准备、CUDA与PyTorch的精确匹配、依赖安装的疑难杂症解决以及完整环境清单。特别针对Linux系统下的环境复现问题，提供了实用的避坑技巧和验证方法，帮助开发者高效完成VMamba模型的部署。阅读详情

我想把gif的图型文件加载到VB中来用LoadPicture函数即可，但是加载进来的图片大小不是很理想，我想问的是
1、能不能通过VB代码来调整要加载的gif图片大小？
2、如果第1种想法行不通的话，还有没有其它的函数能实现我想要的这种功能？

...全文

超级超级细的CLIP官方模型解读及代码逐行讲解本文详细解析了OpenAI开源的CLIP模型代码架构。文章首先介绍模型概念，包括训练时通过对称损失计算图像-文本相似度，预测时通过余弦相似度匹配最佳文本。随后重点解析各模块代码实现：LayerNorm改进、QuickGELU激活函数、Transformer编码器结构、ViT图像编码器的特征提取过程、文本编码器的掩码机制和特征投影。最后阐述CLIP整体架构如何整合视觉和文本编码器，并详细说明了特征归一化和相似度计算的关键实现。全文通过代码级解读帮助读者深入理解CLIP模型的实现细节。阅读详情

emit

VB基础类 7,788 成员 197,583 内容

+ 关注 + 加入社区

切换为时间正序

kmzs 2004-01-15

打赏
举报

往上画不就行了

yassee 2004-01-15

打赏
举报

感谢楼主，感谢AresChen(AresChen) ，我刚好要用！

jiaojianmeng 2004-01-15

打赏
举报

放大缩小翻转 BitMap图

来源:cww

一般来说我们会使用PaintPicture来完成，而这个方法和StretchBlt的使用很类似，在
此提出两种不同的方式来达放大缩小翻转图形，使用API的DrawBitMap只能使用BitMap图
，而没有API的PaintPicture则无此限制，但DrawBitMap在处理大的图形时，可能较快
些吧。

StretchBlt 其定义如下：
Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, _
ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal hSrcdc As Long, ByVal xSrc As Long, ByVal ySrc As Long, _
ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, _
ByVal dwRop As Long) As Long

hdc 待绘图的hDc
x, y 待绘图目标的起点座标
nWidth, nHeight 绘图的长宽(by Pixels)
hSrcDc 来源Dc
xSrc, ySrc 来源图的起点座标
nSrcWidth, nSrcHeight 来源图的长宽
dwRop 绘图的方式

由以上的叁数，我们知道事实上可以取来源图的一部份(方形区域)来缩放，而目的绘图
区呢，它可以指定从某个起始座标开始画(不一定 (0,0) )，而nWidth与nHeight控制图
的缩放，例如说nWidth = CLng(1.5 * nSrcWidth), nHeight = CLng(nSrcHeight * 1.5)
那代表比原图放大1.5倍，如果nWidth = -1 * nSrcWidth 表该图会左右相反，而
nHeight = -1 * nSrcHeight 时则会有上正颠倒的图出现。以下提供一个副程式，该副
程式简化了StretchBlt，允许我们画一个图於Form/PictureBox的左上角，并可以放大
缩小或翻转。

DrawBitMap(Dst As Object, ByVal xRate As Double, _
ByVal yRate As Double, ByVal FileName As String)

该副程式中
hDst 是待绘图的物件(可以为Form或PictureBox)
xRate 宽度缩放比例
rRate 长度缩放比例
FileName 图形档名

'以下在.Bas
Option Explicit
Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, _
ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, _
ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Const SRCCOPY = &HCC0020

Public Sub DrawBitMap(Dst As Object, ByVal xRate As Double, _
ByVal yRate As Double, ByVal FileName As String)
Dim dstWidth As Long, dstHeight As Long
Dim srcWidth As Long, srcHeight As Long
Dim x As Long, y As Long
Dim pic As StdPicture
Dim hDc5 As Long, i As Long

Set pic = LoadPicture(FileName) '读取图形档

hDc5 = CreateCompatibleDC(0) '建立Memory DC
i = SelectObject(hDc5, pic.Handle) '在该memoryDC上放上bitmap图

srcHeight = Dst.ScaleY(pic.Height, vbHimetric, vbPixels)
srcWidth = Dst.ScaleX(pic.Width, vbHimetric, vbPixels)

dstHeight = CLng(srcHeight * yRate)
If dstHeight < 0 Then
y = -1 * dstHeight
Else
y = 0
End If
dstWidth = CLng(srcWidth * xRate)
If dstWidth < 0 Then
x = -1 * dstWidth
Else
x = 0
End If
Call StretchBlt(Dst.hdc, x, y, dstWidth, dstHeight, hDc5, 0, 0, srcWidth, srcHeight, SRCCOPY)
Call DeleteDC(hDc5)
End Sub

Public Sub DrawPicture(Dst As Object, ByVal xRate As Double, _
ByVal yRate As Double, ByVal FileName As String)
Dim dstWidth As Long, dstHeight As Long
Dim srcWidth As Long, srcHeight As Long
Dim x As Long, y As Long
Dim pic As StdPicture
Dim i As Long

Set pic = LoadPicture(FileName) '读取图形档

srcHeight = Dst.ScaleY(pic.Height, vbHimetric, vbPixels)
srcWidth = Dst.ScaleX(pic.Width, vbHimetric, vbPixels)

dstHeight = CLng(srcHeight * yRate)
If dstHeight < 0 Then
y = -1 * dstHeight
Else
y = 0
End If
dstWidth = CLng(srcWidth * xRate)
If dstWidth < 0 Then
x = -1 * dstWidth
Else
x = 0
End If
Dst.ScaleMode = 3
Dst.PaintPicture pic, x, y, dstWidth, dstHeight, 0, 0, srcWidth, srcHeight

End Sub

'以下在Form需两个command button一个PictureBox
Private Sub Command1_Click()
Call DrawBitMap(Me, 1.5, -1.5, "c:\windows\circles.bmp") '放大1.5倍并上下翻转
End Sub

Private Sub Command2_Click()
Call DrawBitMap(Picture1, 1.5, -1.5, "c:\windows\client.ico") '放大1.5倍并上下翻转
End Sub

busisoft 2004-01-14

打赏
举报

如果要想图片适应控件的大小可以用image，picturebox只能适应图片的大小

flyingscv 2004-01-14

打赏
举报

stretch一般用于适用原始大小，不太使用很正常:)

你用paintpicture不就行了

AresChen 2004-01-14

打赏
举报

stretch=true对于image控件来讲只能作到将图片按照image的高宽比例去画，所以很容易造成失真，需要在必要是重新调整image的高宽比例，程序如下，在一个form上放上一个image，取名为image1，在放一副图片，并设置stretch为true。
Private Sub Form_resize()
Dim r As Single

With Image1
.Top = 0
.Left = 0
.Width = Me.Width
.Height = Me.Height

r = .Picture.Height / .Picture.Width
If .Height / .Width - r > 0.001 Then
.Height = .Width * r
Else
.Width = .Height / r
End If
End With
End Sub
然后你可以进一步扩展，比如窗体大于图片的时候，不对图片进行放大等，还有就是对top和left在调整一下，以及在考虑进去form的border的宽度，可以简单实现一个图形浏览的程序，当然效率和可以查看的种类是无法和acdsee相比的。

emit 2004-01-14

打赏
举报

用stretch=true效果不好，不过jiaojianmeng提到了用API函数，可我不会用啊

flyingscv 2004-01-14

打赏
举报

stretch=true

emit 2004-01-14

打赏
举报

TO SoHo_Andy(冰):是这样的，我在窗体上放一个Image控件，这个Image控件能随窗体的大小而自动调整,而Image里的gif格式的图片却只能保持它原来的大小，不能随窗体的大小变动而自由缩放,我想要的是它能自由缩放这样的效果

jiaojianmeng 2004-01-14

打赏
举报

api函数StretchBlt就可以实现放缩功能
picturebox 的paintpicture 也可以！

SoHo_Andy 2004-01-14

打赏
举报

“图片大小不是很理想”

此话怎讲？怎样算理想？

”我想要的这种功能“

你要什么功能？

关于LoadPicture函数的问题

相关推荐