| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 631 人关注过本帖
标题:[求助]如何将放进框内的图存为"缩略图"格式?
只看楼主 加入收藏
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
结帖率:94.12%
收藏
 问题点数:0 回复次数:2 
[求助]如何将放进框内的图存为"缩略图"格式?

这是在窗体上的两个存放图片的图框,问题是放进图片后,无法达到电脑上资源管理器那样的"缩略图"效果,哪位能出手修改一下?
Dim OpenFileName As String
Private Reg

Private Sub Command1_Click()
On Error Resume Next
CommonDialog1.DialogTitle = "打开文件"
CommonDialog1.Filter = "所有支持的格式" + _
"(*.bmp;*.jpg;*.gif;*.pcx;*.ico)|" + _
"*.bmp;*.jpg;*.gif;*.pcx;*.ico)"
CommonDialog1.ShowOpen
If CommonDialog1.FileName <> "" Then
If Err <> 32755 Then
OpenFileName = CommonDialog1.FileName
Picture1.Picture = LoadPicture(OpenFileName)
End If
End If
Command2.Visible = True '第一框的按钮
Command1.Visible = False
End Sub

Private Sub Command2_Click()
Call Reg.RegWrite("HKLM\SOFTWARE\PIC\Lj", OpenFileName, "REG_SZ")
Command2.Visible = False '第一框的按钮
Command1.Visible = True
End Sub

Private Sub Form_Load()
On Error Resume Next
Set Reg = New IWshShell_Class
If Reg.RegRead("HKLM\SOFTWARE\PIC\Lj") = "" Then
Exit Sub
End If
Picture1.Picture = LoadPicture(Reg.RegRead("HKLM\SOFTWARE\PIC\Lj"))
CommonDialog1.CancelError = True
On Error Resume Next
Set Reg = New IWshShell_Class
If Reg.RegRead("HKLM\SOFTWARE\PIC\Lj1") = "" Then
Exit Sub
End If
Picture2.Picture = LoadPicture(Reg.RegRead("HKLM\SOFTWARE\PIC1\Lj1"))
CommonDialog2.CancelError = True
End Sub

Private Sub Command3_Click()
On Error Resume Next
CommonDialog1.DialogTitle = "打开文件"
CommonDialog1.Filter = "所有支持的格式" + _
"(*.bmp;*.jpg;*.gif;*.pcx;*.ico)|" + _
"*.bmp;*.jpg;*.gif;*.pcx;*.ico)"
CommonDialog1.ShowOpen
If CommonDialog1.FileName <> "" Then
If Err <> 32755 Then
OpenFileName = CommonDialog1.FileName
Picture2.Picture = LoadPicture(OpenFileName)
End If
End If
Command4.Visible = True '第二框的按钮
Command3.Visible = False
End Sub

Private Sub Command4_Click()
Call Reg.RegWrite("HKLM\SOFTWARE\PIC1\Lj1", OpenFileName, "REG_SZ")
Command4.Visible = False '第二框的按钮
Command3.Visible = True
End Sub

nYSuib8H.rar (2.83 KB) [求助]如何将放进框内的图存为"缩略图"格式?



搜索更多相关主题的帖子: 放进 缩略 格式 图存 
2007-09-23 09:53
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 
回复:(jrs123)[求助]如何将放进框内的图存为

下面是可以实现"缩略图"格式的代码,可惜只有一个图框,而且图框尺寸会随窗体变化而变化
Dim OpenFileName As String
Private Reg

Private Sub Command1_Click()
On Error Resume Next

CommonDialog1.DialogTitle = "打开文件"
CommonDialog1.Filter = "所有支持的格式" + _
"(*.bmp;*.jpg;*.gif;*.pcx;*.ico)|" + _
"*.bmp;*.jpg;*.gif;*.pcx;*.ico)"
CommonDialog1.ShowOpen
If CommonDialog1.FileName <> "" Then
If Err <> 32755 Then
OpenFileName = CommonDialog1.FileName
funView OpenFileName
End If
End If
End Sub

Private Sub Command2_Click()
Call Reg.RegWrite("HKLM\SOFTWARE\PIC\Lj", OpenFileName, "REG_SZ")
End Sub

Private Sub Form_Load()
On Error Resume Next
Set Reg = New IWshShell_Class
If Reg.RegRead("HKLM\SOFTWARE\PIC\Lj") = "" Then
Exit Sub
End If
OpenFileName = Reg.RegRead("HKLM\SOFTWARE\PIC\Lj")
funView OpenFileName
CommonDialog1.CancelError = True
End Sub

Private Function funView(FileName As String) '为省代码返回值也不要了,改成Sub也行
Dim W&, H&, G#
Image1.Picture = LoadPicture(OpenFileName)

G = Image1.Width / Image1.Height

If G >= Picture1.Width / Picture1.Height Then
W = Picture1.Width - 200
H = W / G
Else
H = Picture1.Height - 200
W = H * G
End If
Picture1.Cls
Picture1.PaintPicture Image1.Picture, (Picture1.Width - W) / 2, (Picture1.Height - H) / 2, W, H, 0, 0, Image1.Width, Image1.Height
End Function

Private Sub Form_Resize()
If windowsstate = 1 Then
Exit Sub
End If
If Width < 2000 Then Width = 2000
If Height < 1500 Then Height = 1500

With Picture1
.Width = Width - .Left - .Left - 100
.Height = Height - .Top - 600
End With
funView OpenFileName
End Sub
附件如下:

mvFoZgRI.rar (2.82 KB) [求助]如何将放进框内的图存为"缩略图"格式?


2007-09-23 10:04
multiple1902
Rank: 8Rank: 8
等 级:贵宾
威 望:42
帖 子:4881
专家分:671
注 册:2007-2-9
收藏
得分:0 
2007-09-23 10:05
快速回复:[求助]如何将放进框内的图存为"缩略图"格式?
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.018366 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved