Código fuente de escalado de forma
que daba un ejemplo de escalado de imágenes. El escalado de imágenes escrito en VB es realmente muy eficiente, lo que demuestra la importancia del algoritmo. Laviewpbt volvió a ser zyl910 en CSDN y su verdadero nombre parece ser Zhou Yueling.
Estimulante, la eficacia resultante del programa es aún más sorprendente. Si está interesado, puede consultar el enlace del foro proporcionado en mi artículo.
Así que la solución que estoy usando aquí es obtenerlo de ellos. Pero estas personas de alto nivel se preocupan por la eficiencia y hay mucho espacio en el programa para comparar diferentes algoritmos, lo cual se ha probado a lo largo del tiempo. Para las personas que se preocupan más por el uso, es necesario podar el código. Después de una evaluación preliminar, no cambié el contenido del módulo, solo asigné lo que necesitábamos del programa principal.
Entonces, comencemos.
En primer lugar, utilizamos tres módulos y un módulo de clase, por lo que no es necesario reescribir esta parte del código. Agréguelo cuando el programa esté construido. Cabe señalar que si ya tiene un proyecto en curso, es posible que simplemente importar el módulo no funcione. Laviewpbt nos hizo una buena demostración. Todas sus declaraciones de API están en un módulo, por lo que es mejor que su proyecto haga lo mismo. Luego, pegue su declaración API en la parte posterior. Si hay duplicados mientras el programa se está ejecutando, se descubrirá automáticamente y luego podrá detenerlo, comentarlo o eliminarlo. Publiqué el contenido de estos módulos por última vez y recién ahora puedo cargar archivos adjuntos aquí.
Luego, debemos centrarnos en cómo utilizarlo.
Datos privados como CImageDatos privados como CImage
Primero, declara dos variables de clase. Esta es nuestra clase personalizada. en el módulo.
Luego hay dos fragmentos de código, uno para cargar la imagen y otro para cambiar el tamaño de la imagen.
Necesitamos abrir la imagen e inicializar las dos cantidades anteriores. El proceso de inicialización se escribe con form_load.
Establecer DIBData = nueva imagen
Establecer DIBWork = nueva imagen
ScaNum = 1 'Esta es la proporción.
ScaWidth = i. "ancho" Este es el valor de referencia inicial para el ancho del formulario.
Foto 1. Imagen = LoadPicture(App.Path & Path."\Handball Court Map.jpg")
Atenuar DIBTemp como nueva imagen
Si DIBTemp. LoadPictureFromFile(App.Path."\handball cancha map.jpg") = entonces verdadero
Establecer DIBData = DIBTemp
DIBWork. Disposición de recursos
Imagen 1. ancho = DIBData. Ancho
Imagen 1. altura = DIBData. Altura
DIBData. Renderizar imagen 1. Sistema de control de descenso de pendientes
Imagen 1. Actualizar
Otro
MsgBox "Archivo de imagen incorrecto", vbCritical
Finalizará si...
Establecer DIBTemp=None
Establecer DIBTemp=None
p>
Cuando cambie el tamaño del formulario, escribiremos un fragmento de código para cambiar el tamaño de la imagen y se completará la tarea de tamaño de PictureBox.
Cabe señalar que en la siguiente llamada de código, la unidad de medida del tamaño son píxeles y la unidad de medida predeterminada del formulario VB es Tiwp. Es posible que haya muchas variaciones en un píxel de la pantalla. Si crea un programa, la visualización de la imagen es muy fluida, pero muy pequeña. Entonces, felicidades, lo lograste, solo necesitas convertir el tamaño a tiwp en VB.
Multiplica la pantalla.
TwipsPerPixelX
Este código es el siguiente:
Dim W tiene la misma longitud y H tiene la misma longitud
W = DIBData. ancho*escaneo
H = DIBData. altura * valor de escaneo
Si W lt1 entonces W = 1 si H lt1 entonces H = 1
Atenuar DIBTemp como nueva imagen
Atenuar t como monedap>
I. MousePointer = Reloj de arena
t = Utilidad. GetCurrentTime
Set dibtemp = resample (dibdata, w, h, 2)'Elija un algoritmo aquí, interpolación bilineal.
t = GetCurrentTime - t
i. puntero del mouse = vbDefault
i. Caption = "Tiempo de procesamiento:" Formato (t/1000, "##, ###, ##0.000") y "Segundos"
Establecer DIBWork = DIBTemp
Establecer DIBTemp =Ninguno
Datos de imagen. ancho = DIBWork. ancho*pantalla. TwipsPerPixelX
PicData. Alto = DIBAlto de trabajo * pantalla. TwipsPerPixelX
DIBWork. Renderizar PicData. Sistema de control de descenso de pendientes
solm
PicData. Actualízate
Comenté parte del código y todavía tengo tiempo para probar el código original.
Divida este código en un Sub y llámelo en form_reSize. Por supuesto, antes de llamar, primero se debe calcular la tasa de cambio scaNum.
Publique el código del módulo a continuación.
Módulo 1, Módulo de cambio de tamaño de imagen:
Opción explícita
Enumeración pública ResizeModeConst
SMC_Nearest = 0 'Interpolación más cercana
SMC_stretch BLT = 1 'stretch BLT
SMC_BiliNear = 2' Interpolación bilineal
Enumeración final
Pública
p >
Remuestreo de funciones (Img es CImage, NewWidth es Long, NewHeight es Long,
Método opcional ResizeModeConst = SMC_BiliNear) que CImage
La dimensión X tiene la misma longitud, Y misma largo
Dim XX tiene el mismo largo, YY tiene el mismo largo
Dim OldYY tiene el mismo largo
El ancho es el mismo, el alto es el lo mismo
Dim Sa como una matriz segura, SaN como una matriz segura
Dim ImageData() como bytes, NewImageData() como bytes
El paso lento es la misma longitud, la nueva zancada tiene la misma longitud
El desplazamiento de tamaño es largo
La velocidad tenue tiene la misma longitud, SpeedN tiene la misma longitud
Mensaje en pantalla como mensaje nuevo
Si es NewImg. CreateNewImage(NewWidth, NewHeight) = Verdadero Entonces
y Sa
. Elemento = 1
. Tamaño = 1
.Bounds.Elements = Img. Zancada*Img. Altura
. puntero = img.
Puntero
Termina con...
copiar memoria ByVal varptraray(ImageData()), VarPtr(Sa), 4
Usar SaN
. Elemento = 1
. Tamaño = 1
. Límites.Elementos = NewImg. Zancada*NuevaImg. Altura
. puntero = NuevaImg. Puntero
Termina con...
copiar memoria ByVal VarPtrArray(new imagedata()), VarPtr(SaN), 4
Ancho = Img. ancho:alto = Img. altura
zancada = Img. Zancada: Nueva Zancada = NuevaImg. Progreso
ReDim fila lineal (nuevo ancho-1) es tan larga
Seleccionar método de caso
Case ResizeModeConst. SMC_Nearest
OldYY = -1
Para X = 0 a NewWidth - 1
fila lineal(X)=(X * Ancho \ nuevo Ancho) * 3
Entonces
Para Y = 0 a NewHeight - 1
VelocidadN = Y * NewStride
YY = Y *Height\ Nueva altura
Desplazamiento = YY * zancada
Si YY = OldYY entonces
CopyMemory nuevos datos de imagen (SpeedN), nuevos datos de imagen (SpeedN - NewStride), NewStride
Otro
OldYY
Para X = 0 a NewWidth - 1
Velocidad = Flecha lineal desplazada (X)
Nuevos datos de imagen(Velocidad) = Datos de imagen(Velocidad)
Nuevos datos de imagen(Velocidad 1) = Datos de imagen(Velocidad 1)
Nuevos datos de imagen ( velocidad 2) = datos de imagen (velocidad 2)
VelocidadN = VelocidadN 3
Entonces
Terminará si...
Luego
Case ResizeModeConst. SMC_StretchBlt
Img. Renderizar nueva imagen. Hdc,0,0,NuevaImg. Ancho, nuevo. Altura, 0, 0, Img. Ancho,Img. altura
Caso ResizeModeConst.
SMC _Bilinear
Dim PartXX tiene la misma longitud, PartYY tiene la misma longitud
Dim InvertXX es la longitud, InvertYY es la longitud
Dim NewX es la misma longitud, NewY tiene la misma longitud
Dim SpeedP tiene la misma longitud, ColOffset tiene la misma longitud
Dim Pos As Double
ReDim desplazamiento de fila (nuevo ancho -1) tiene la misma longitud
ReDim RowPartXX(nuevo ancho-1) misma longitud
Para X = 0 a NewWidth - 1
Pos = X * (ancho-1)/nuevo ancho
RowOffset(X) = Int(Pos) * 3
RowPartXX(X)=(Pos-Int(Pos))* 2048
Entonces
Para Y = 0 a NewHeight - 1
VelocidadN = Y * NewStride
Pos = Y *(Altura - 1)/ NewHeight
Parte A = ( Pos - Int(Pos)) * 2048
InvertYY = 2048-parte y y
ColOffset = Int(Pos) * Zancada
Para X = 0 a NewWidth - 1
PartXX = RowPartXX(X)
InvertXX = 2048 - PartXX
Velocidad = Desplazamiento de fila de desplazamiento paralelo (X)
VelocidadP = ritmo de velocidad
nuevo ImageData(Velocidad n 2)=((ImageData(Velocidad 2)* invertir xx
ImageData(Speed 5)* PartXX)* InvertYY ( ImageData(SpeedP 2)*
invertir xx ImageData(SpeedP 5)* PartXX)* party y)\ 4194304
nuevo ImageData(Velocidad n 1)=((ImageData(Velocidad 1 )* invertir xx
ImageData(Velocidad 4)* PartXX)* InvertYY (ImageData(VelocidadP 1) *
invertir xx ImageData(SpeedP 4)* PartXX)* fiesta y)\ 4194304
nuevo ImageData(SpeedN)=((ImageData(Speed)* invertir xx ImageData(Speed
3)* PartXX)* InvertYY (ImageData(SpeedP)* InvertXX
ImageData(SpeedP 3)* PartXX)* parte y)\ 4194304
SpeedN = SpeedN 3
Luego
Luego
Finalizar selección
copiar memoria ByVal varptraray(ImageData()), 0 amp, 4
memoria de copia ByVal VarPt
rArray(new imagedata()), 0 amp, 4
Terminará si...
Establecer Resample = NewImg
Finalizar función
Módulo 2, las partes relacionadas con la prueba de tiempo que se pueden ignorar, no hay mucho contenido y también está publicado.
Frecuencia del sistema privado como moneda
Función pública GetCurrentTime() como moneda
Si SystemFrequency = 0, no se inicializará.
Si QueryPerformanceFrequency(frecuencia del sistema) = 0, entonces
"SystemFrequency = ERRORINDEX" no tiene un contador de alta precisión.
Terminará si...
Terminará si...
Si Frecuencia del sistema lt gt Índice de error
Dim CurCount como moneda
Consultar el recuento del circuito contador de rendimiento
GetCurrentTime = CurCount * 1000 @/frecuencia del sistema
Otros
GetCurrentTime = GetTickCount ()
Terminará si...
Finalizar función
Módulo 3, parte de declaración de API, debe resolver los conflictos usted mismo.
Opción explícita
Índice de error Const público Mientras =-1
Const público DIB_RGB_COLORS Mientras = 0
public const bi_rgas long = 0' normal.
Constante pública STRETCH_ANDSCANS Mientras = 1
Constante pública STRETCH_DELETESCANS Mientras = 3
Const pública STRETCH _ HALFTONE Mientras = 4
public Const STRETCH _ o escaneos As Long = 2
Tipo público RECT
Igual longitud en la izquierda
Misma longitud en la parte superior
Misma longitud
La parte inferior tiene la misma longitud
Tipo final
Tipo público POINTAPI
x tiene la misma longitud
Siempre y cuando
Tipo final
Tipo público RGBQUAD
Azul son bytes
Verde son bytes
El rojo son bytes
Alfa como byte
Tipo final
Tipo público LOGPALETTE
palVersion es un número entero
Formulario entero palNumEntries
palvalentry(255) como RGBQUAD
Tipo final
Enlace público con seguridad de tipos
Los elementos son misma longitud
Indefinido
Tipo final
Tipo público SAFEARRAY2D
Dimensiones en forma de número entero
Características de los números enteros
Los elementos tienen la misma longitud
Las cerraduras tienen la misma longitud
Los punteros tienen la misma longitud
Como el límite de SAFEARRAYBOUND (1)
Tipo final
Matrices públicas de tipo seguro
Dimensiones en forma de número entero
Características de los números enteros
Los elementos tienen la misma longitud
Bloquear Misma longitud
Misma longitud que los punteros
Como límite de SAFEARRAYBOUND
Tipo de fin
Tipo público BITMAPINFOHEADER
Tamaño Misma longitud
Mismo ancho y largo
Misma altura que largo
Plano como un número entero
Número de dígitos en forma de número entero
La compresión tiene la misma longitud
Cambiar el tamaño de la imagen a Largo
XPelsPerMeter tiene la misma longitud
YPelsPerMeter tiene la misma longitud
ClrUsed tiene la misma longitud
p>Siempre que importe
Tipo final
Tipo público BITMAPINFO
Encabezado en formato BITMAPINFOHEADER
Paleta (255 ) como RGBQUAD
Tipo final
Tipo público mapa de bits
El tipo tiene la misma longitud
El ancho y la longitud son los mismos
La altura tiene la misma longitud
Ancho, longitud en bytes
Plano como número entero
BitsPixel como número entero
Los bits tienen la misma longitud
Tipo de extremo
'
API relacionada con la operación de memoria
public Declare Sub copy Memory Lib " kernel 32 " Alias " RtlMoveMemory "(lpDst As Any, lpSrc As Any, ByVal ByteLength As Long)
public Declarar memoria Sub zero Lib "kernel 32" alias "R
tlMoveMemory" (Dest As Any, ByVal numBytes As Long)
Público
Declarar la biblioteca subFillMemory "kernel32.dll" alias "RtlFillMemory" (ByRef
Cualquiera Destino, la longitud de ByVal es larga, ByVal se llena con Byte)
API de ontología VB
Pública
Declarar función oleload imagen Lib "olepro 32" (p stream Como Cualquiera, ByVal
lSize es Long, ByVal es Long, riid es Cualquiera, ppvObj es Cualquiera) es
long
Función de declaración pública SafeArrayGetDim Lib "oleaut32 .dll "(ByRef saArray()As Any) es largo
Función de declaración pública VarPtrArray Lib " msvbvm60.dll "Alias" VarPtr" (ByRef Ptr() As Any) es largo
Función API del sistema GDI
Función de declaración pública GetDC Lib " usuario 32 "(ByVal hwnd As Long) es Long
Función de declaración pública CreateCompatibleDC Lib " GDI 32 . dll "(ByVal Hdc As Long)
Público
Declarar función CreateDIBSection Lib "GDI 32 . dll" (ByVal Hdc As Long,
ByRef pBitmapInfo As Any, ByVal un As Long , puntero ByRef As Long, ByVal
El identificador tiene la misma longitud, ByVal Dw tiene la misma longitud) la misma longitud
Función de declaración pública DeleteDC Lib "GDI 32. dll "( ByVal Hdc As Long)
Función de declaración pública lanzada c Lib "usuario 32" (ByVal hwnd es Long, ByVal Hdc es Long) es Long
Función de declaración pública eliminar objeto Lib " GDI 32 . dll "( objeto ByVal ho As Long) es largo
público
Declare la función SetDIBColorTable Lib "GDI 32" (ByVal Hdc es largo, ByVal
un1 tiene la misma longitud, ByVal un2 tiene la misma longitud, pcRGBQuad tiene la misma longitud
Pública
Declare la función GetDIBColorTable Lib "GDI 32" (ByVal Hdc es Long, ByVal
un1 tiene la misma longitud, ByVal un2 La misma longitud, pRGBQuad tiene la misma longitud
Función de declaración pública para seleccionar el objeto Lib "GDI 32. dll" (ByVal Hdc es largo, ByVal hObject es Long) es Long
Público
Declarar la función BitBlt Lib "GDI 32" (ByVal hDestDC es Long, ByVal X es
Long, ByVal Y tiene la misma longitud, ByVal NW tiene la misma longitud, ByVal nHeig
ht tiene la misma longitud,
ByVal hSrcDC es Long, ByVal xSrc es Long, ByVal ySrc es Long, ByVal
La misma longitud
Función de declaración pública SetStretchBltMode Lib " GDI 32 "(ByVal Hdc es Long, ByVal nStretchMode es Long) es Long
Pública
Declarar función StretchBlt Lib "GDI 32" (ByVal Hdc es Long, ByVal X es
Long, ByVal Y tiene la misma longitud, ByVal NW tiene la misma longitud, ByVal nHeight tiene la misma longitud,
ByVal hSrcDC es Long, ByVal xSrc es Long, ByVal ySrc es Long, ByVal
nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long)
Long
Función de declaración pública SetDIBitsToDevice Lib " GDI 32 "(ByVal Hdc
Misma longitud, Bayer p>NumScans es Long, Bits es Any, BitsInfo es BITMAPINFO, ByVal
wUsage tiene la misma longitud)
Función de declaración pública GetTickCount Lib "kernel32 "() es Long
La función de declaración pública QueryPerformanceFrequency Lib " kernel 32 " (la frecuencia LP es moneda) es Long
La función de declaración pública QueryPerformanceCounter Lib " kernel 32 " (lpPerformanceCount es moneda) es Largo
Módulo de clase, CImage; nombre de archivo CImage.cls
Opción explícita
Privado m_Width como ancho de la capa Larga .
Private m_Height as Long 'La altura de la capa.
El tamaño de cada línea de escaneo de m_Stride privado como datos de capa larga.
El m_Hdc privado se utiliza como DC de memoria de la capa larga.
La primera dirección w del m_Pointer privado se utiliza como datos de la capa larga en la memoria.
Manejar el m_handle privado de la sección larga.
M_OldHandle privado como identificador largo del entorno del dispositivo original.
La propiedad pública Obtener ancho() es larga
Ancho = m_width
Propiedad final
La propiedad pública Obtener altura() es larga
Altura = m_height
Propiedad final
La propiedad pública obtiene stride() siempre que
Stride = m_ Stride
Propiedad final
Propiedad pública Obtener Hdc() siempre
Hdc = m_Hdc
Propiedad final
Propiedad pública Obtener Handle() es Long
Handle = m_Handle
Propiedad final
Propiedad pública Get Pointer() es Long
Pointer = m_pointer
Atributo final
Subclase privada _Terminate()
Recurso de eliminación
Conector de terminal
Función pública crear nueva imagen (ByVal Ancho As Long, _ ByVal Height As Long) es un valor booleano
Dim ScreenDC es Long, BmpInfo es BITMAPINFOHEADER
Si el ancho lt= 0 o el alto lt= 0, entonces salga de la función
"DisposeResource" elimina el recurso de memoria original.
Usa BmpInfo
. Número de dígitos = 24
. Altura = -Altura 'Crea un DIB en orden inverso usando el sistema de coordenadas del objeto GDI (la coordenada del punto inicial está en la esquina superior izquierda).
. ancho = ancho
. Plano = 1
. tamaño = 40
m_Stride = ((ancho * 3 3)Y amp; HFFFFFFFC)
. SizeImage = m_Stride * Height
Termina con...
ScreenDC = GetDC(0)' para obtener el DC de la pantalla.
m _ Hdc = CreateCompatibleDC(ScreenDC)
' ReleaseDC 0, ScreenDC 'Libera la pantalla DC.
m_Handle = CreateDIBSection(m_Hdc,BmpInfo,DIB_RGB_COLORS,m_Pointer,0,0)
Si m_Hanle lt gt no espero que este sistema nos permita crear DIB con éxito.
m_OldHandle = SelectObject(m_Hdc, m_Handle)
m_Width = Ancho: m_Height = Alto
CreateNewImage = True
Si... finalizará
Finalizar función
Recurso de subprocesador público()
Si m_Hdc lt gt entonces 0
Seleccione objeto m_Hdc, m_OldHandle
Eliminar DC m_Hdc
Eliminar objeto m_Handle
' M_Width = 0: m_Height = 0 'Restablecer otras propiedades relacionadas con la imagen.
m_Handle = 0: m_OldHandle = 0
m_Pointer = 0: m_Hdc = 0
Terminará si...
Finalizar conector
Función pública Render(ByVal DestDC As Long,_
ByVal DestX es opcional, siempre que_
El ByVal DestY opcional tenga la misma longitud, _
ByVal DestWidth opcional mientras sea largo, _
ByVal DestHeight opcional mientras sea largo, _
ByVal SrcX opcional tiene la misma longitud, _
Opcional Seleccione ByVal SrcY para que tenga la misma longitud, _
Opcional ByVal SrcWidth para que tenga la misma longitud, _
Opcional ByVal SrcHeight) como valor booleano
Si m_Handle = 0, entonces Salir de la función
Si DestWidth = 0, entonces DestWidth = m_Width
Si DestHeight = 0, entonces DestHeight = m_Height
Si SrcX lt0 entonces SrcX = 0 'El origen X, Y no puede ser negativo, pero el destino X, Y sí.
Si SrcY lt0, entonces SrcY = 0
Si SrcWidth = 0, entonces
SrcWidth = m_Width
De lo contrario, SrcWidth lt entonces 0
DestWidth = -DestWidth
SrcWidth = -SrcWidth
Terminará si...
Si SrcHeight = 0, entonces
SrcHeight = m_Height
ElseIf SrcHeight ltthen0
DestHeight = -DestHeight
SrcHeight = -SrcHeight
If. .. Terminará
SetStretchBltMode DestDC, STRETCH_HALFTONE
StretchBlt DestDC, DestX, DestY, DestWidth, DestHeight, m_Hdc, SrcX, SrcY, SrcWidth, SrcHeight, vbSrcCopy
Función final
Función pública de tipo booleano LoadPictureFromFile (cadena de nombre de archivo)
El ancho y el alto son los mismos
Atenúa la imagen estándar a imagen estándar
Ir al identificador de errores en caso de error:
Establecer StdPic = LoadPicture(nombre de archivo)
ancho = ConvertHimetrixToPixels(StdPic. ancho, verdadero)
altura = ConvertHimetrixToPixels(StdPic. Height, False)
Si CreateNewImage(Width, Height) = True, entonces
StdPic. Renderiza m_hdc 0 amperios, 0 amperios, 0 amperios ancho 0 amperios, alto
0 amperios, 0, StdPic. Altura, Imagen estándar.
Ancho, -StdPic. Altura, ByVal 0
Similar al almacenamiento inverso de BMP, por lo que -StdPic. Utilice la altura.
LoadPictureFromFile = True
Terminará si...
Identificación del error:
Finalizar función
Privado La función ConvertHimetrixToPixels (HiMetrix es Long, la dirección horizontal es booleana) es Long
Si es horizontal
ConvertHimetrixToPixels = HiMetrix * 1440/2540/Screen. TwipsPerPixelX
Otro
ConvertHimetrixToPixels = HiMetrix * 1440/2540/Pantalla. TwipsPerPixelY
Terminará si...
Función final
Función privada ConvertPixelsToHimetrix (longitud de píxel, valor booleano en dirección horizontal) long
Si horizontal
ConvertPixelsToHimetrix = píxeles * pantalla. TwipsPerPixelX * 2540 / 1440
Otro
ConvertPixelsToHimetrix = píxeles*pantalla. TwipsPerPixelY * 2540 / 1440
Función Finalizar IfEnd