Question

我目前正在用Visual Basic 6.0编程，只是为了好玩。我遇到了一个令人讨厌的问题，如果我尝试在运行时上完全缩放图片，那么它就会模糊并且无法阅读图片上的文字。如果我在设计时对其进行缩放，那么它的缩放效果就很好。

图片为24位位图文件类型，使用.gif或.jpeg也可以得到相同的结果。据我所知，VB6不处理PNG。无论如何，PictureBox都不会。

运行时绘图的代码：（正确的宽高比）

Picture1.PaintPicture map, 0, 0, 700, 547

谁能告诉我为什么会这样或者我做错了吗？

我意识到VB6已过时且不受支持，但是正如我所说的，我正在将其用于一个有趣的项目。

设计时间质量：

运行时质量：

VS2017（C＃）中的运行时质量：

Answer 1

这里是您可以使用的UserControl实现，而不是使用StretchBlt以获得更好质量的PictureBox控件：

VERSION 5.00
Begin VB.UserControl ImageBox 
   ClientHeight    =   648
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   720
   ClipControls    =   0   'False
   ForwardFocus    =   -1  'True
   ScaleHeight     =   54
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   60
   Begin VB.PictureBox picBuffer 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   372
      Left            =   120
      ScaleHeight     =   31
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   36
      TabIndex        =   0
      Top             =   120
      Visible         =   0   'False
      Width           =   432
   End
End
Attribute VB_Name = "ImageBox"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'###############################################################################
'#
'# ImageBox
'#
'###############################################################################

Option Explicit

'###############################################################################
'### Constants #################################################################
'###############################################################################

Private Const STRETCH_ANDSCANS = 1
Private Const STRETCH_DELETESCANS = 3
Private Const STRETCH_HALFTONE = 4
Private Const STRETCH_ORSCANS = 2
Private Const SRCCOPY = &HCC0020

'###############################################################################
'### APIs ######################################################################
'###############################################################################

Private 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
Private Declare Function SetStretchBltMode Lib "gdi32" (ByVal hdc As Long, _
                                                      ByVal nStretchMode As Long) _
                                                      As Long

'###############################################################################
'### Data ######################################################################
'###############################################################################

'###############################################################################
'### Events ####################################################################
'###############################################################################

Event Click()
Event DblClick()
Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

'###############################################################################
'### Public Methods ############################################################
'###############################################################################

'*******************************************************************************
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
   BackColor = UserControl.BackColor
End Property
Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
   UserControl.BackColor() = New_BackColor
   PropertyChanged "BackColor"
End Property

'*******************************************************************************
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
   Enabled = UserControl.Enabled
End Property
Public Property Let Enabled(ByVal New_Enabled As Boolean)
   UserControl.Enabled() = New_Enabled
   PropertyChanged "Enabled"
End Property

'*******************************************************************************
Public Property Get BorderStyle() As Integer
Attribute BorderStyle.VB_Description = "Returns/sets the border style for an object."
   BorderStyle = UserControl.BorderStyle
End Property
Public Property Let BorderStyle(ByVal New_BorderStyle As Integer)
   UserControl.BorderStyle() = New_BorderStyle
   PropertyChanged "BorderStyle"
End Property

'*******************************************************************************
Public Sub Refresh()
Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
   Call UserControl.Refresh
End Sub

'*******************************************************************************
Public Property Get Picture() As Picture
   Set Picture = picBuffer.Picture
End Property
Public Property Set Picture(ByVal New_Picture As Picture)
   Set picBuffer.Picture = New_Picture
   PropertyChanged "Picture"
   Me.Refresh
End Property

'###############################################################################
'### GUI Events ################################################################
'###############################################################################

'*******************************************************************************
Private Sub UserControl_Click()
   RaiseEvent Click
End Sub

'*******************************************************************************
Private Sub UserControl_DblClick()
   RaiseEvent DblClick
End Sub

'*******************************************************************************
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
   RaiseEvent MouseDown(Button, Shift, x, y)
End Sub

'*******************************************************************************
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
   RaiseEvent MouseMove(Button, Shift, x, y)
End Sub

'*******************************************************************************
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
   RaiseEvent MouseUp(Button, Shift, x, y)
End Sub

'*******************************************************************************
Private Sub UserControl_Paint()

   Dim lSave As Long

   'set the stretchblit mode (saving the previous value)
   lSave = SetStretchBltMode(UserControl.hdc, STRETCH_HALFTONE)

   'perform blit
   Call StretchBlt(UserControl.hdc, 0, 0, UserControl.ScaleWidth, _
                     UserControl.ScaleHeight, picBuffer.hdc, 0, 0, _
                     picBuffer.ScaleWidth, picBuffer.ScaleHeight, SRCCOPY)

   'restore previous mode
   Call SetStretchBltMode(UserControl.hdc, lSave)

End Sub

'###############################################################################
'### UserControl Events ########################################################
'###############################################################################

'*******************************************************************************
' Initialize Properties for User Control
'*******************************************************************************
Private Sub UserControl_InitProperties()

   'Set any defaults that should be saved from design-time to run-time here
   UserControl.Enabled = True

End Sub

'*******************************************************************************
' Load property values from storage
'*******************************************************************************
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

   'Set any values that were saved from design-time to run-time
   UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
   UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
   UserControl.BackStyle = PropBag.ReadProperty("BackStyle", 1)
   UserControl.BorderStyle = PropBag.ReadProperty("BorderStyle", 0)
   Set Picture = PropBag.ReadProperty("Picture", Nothing)

End Sub

'*******************************************************************************
' Write property values to storage
'*******************************************************************************
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

   'Store any values that should be saved from design-time to run-time here
   Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
   Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
   Call PropBag.WriteProperty("BackStyle", UserControl.BackStyle, 1)
   Call PropBag.WriteProperty("BorderStyle", UserControl.BorderStyle, 0)
   Call PropBag.WriteProperty("Picture", Picture, Nothing)

End Sub

'*******************************************************************************
' Terminate fires when the form unloads.
'*******************************************************************************
Private Sub UserControl_Terminate()
   '
End Sub

'###############################################################################
'### Private Methods ###########################################################
'###############################################################################


'###############################################################################
'###############################################################################
'###############################################################################

在VB6中PictureBox的缩放比例惊人

1 个答案: