給出了壹個圖像縮放的例子。用VB寫的圖像縮放其實效率很高，證明了算法的重要性。Laviewpbt又在CSDN上被zyl910了，真名好像是周躍玲。
刺激，由此產生的程序效率更是驚人。感興趣的可以看看我文章裏給的論壇鏈接。
因此，我在這裏使用的解決方案是從他們那裏獲取。但是這些高層關心的是效率，程序中有很大的空間來比較不同的算法，這是經過時間檢驗的。對於更關心使用的人來說，代碼需要刪減。粗略篩選後，我沒有改動模塊內容，只是從主程序中撥出了我們需要的內容。
那麽，我們開始吧。
首先，我們使用三個模塊和壹個類模塊，這部分代碼不用重寫。在程序構建時添加它。應該註意的是，如果您已經有壹個正在進行的項目，那麽簡單的導入模塊可能無法工作。Laviewpbt給我們做了很好的示範。他的API聲明都在壹個模塊中，所以妳的項目最好也這樣做。然後，把他的API聲明貼在後面。如果程序運行時有重復，會自動發現，然後妳可以停止它，註釋掉它或者刪除它。這幾個模塊的內容我是最後貼上來的，現在才可以在這裏上傳附件。
那麽，就要把重點放在如何使用上。
私有數據作為CImage私有數據作為CImage
首先，聲明兩個類變量。這是我們的定制課。在模塊中。
然後兩段代碼，壹段加載圖片，壹段改變圖片大小。
我們需要打開圖片，初始化以上兩個量。初始化過程用form_load編寫。
設置DIBData =新圖像
設置DIBWork =新圖像
ScaNum = 1 '這是比率。
ScaWidth =我。“寬度”這是表單寬度的初始參考值。
圖片1。圖片= LoadPicture(App。路徑與路徑。”\手球場地圖。jpg”)
Dim DIBTemp作為新圖像
如果DIBTemp。LoadPictureFromFile(App。路徑與路徑。”\手球場地圖。jpg") =那麽真
設置DIBData = DIBTemp
DIBWork。處置資源
圖片1。寬度= DIBData。寬度
圖片1。高度= DIBData。高度
DIBData。渲染圖片1。陡坡緩降控制系統
圖片1。恢復精神
其他
MsgBox“錯誤的圖像文件”，vbCritical
如果…就會結束
設置DIBTemp =無
當窗體的大小發生變化時，我們會寫壹段代碼來改變圖片的大小，PictureBox大小的任務就完成了。
需要註意的是，下面的代碼調用，大小的度量單位是像素，vb窗體的默認度量單位是Tiwp。顯示器上的壹個像素中可能有許多twip。如果做壹個程序，圖像顯示很流暢，但是很小。然後，恭喜妳，妳成功了，只需要在VB中把大小轉換成tiwp。
乘以屏幕。TwipsPerPixelX
這段代碼如下:
Dim W壹樣長，H壹樣長
W = DIBData。寬度*掃描
H = DIBData。高度*掃描值
如果W & lt1那麽W = 1如果H & lt1那麽H = 1
Dim DIBTemp作為新圖像
Dim t作為貨幣
我。MousePointer =沙漏
t =效用。GetCurrentTime
Set dibtemp = resample (dibdata，w，h，2)'這裏選擇壹個算法，雙線性插值。
t = GetCurrentTime - t
我。鼠標指針= vbDefault
我。Caption = "處理時間:" &；格式(t / 1000，" ##，###，# # 0.000 ")& amp；"秒"
設置DIBWork = DIBTemp
設置DIBTemp =無
PicData。寬度= DIBWork。寬度*屏幕。TwipsPerPixelX
PicData。高度= DIBWork高度*屏幕。TwipsPerPixelX
DIBWork。渲染PicData。陡坡緩降控制系統
索爾姆
PicData。恢復精神
部分代碼被我註釋掉了，原代碼還有時間測試內容。
將這段代碼分成壹個Sub，然後在form_reSize中調用它。當然，在調用之前，首先要計算變化率scaNum。
張貼下面的模塊代碼。
模塊1，圖像調整大小模塊:
選項顯式
公共枚舉ResizeModeConst
SMC_Nearest = 0 '最近插值
SMC _ stretch BLT = 1 ' stretch BLT
SMC_BiliNear = 2 '雙線性插值
結束枚舉
公共
函數重采樣(Img為CImage，NewWidth為Long，NewHeight為Long，
可選方法ResizeModeConst = SMC_BiliNear)作為CImage
尺寸X壹樣長，Y壹樣長
暗淡XX壹樣長，YY壹樣長
Dim OldYY壹樣長
寬度壹樣長，高度壹樣長
Dim Sa作為安全陣列，SaN作為安全陣列
Dim ImageData()作為字節，NewImageData()作為字節
暗淡的步幅壹樣長，新的步幅壹樣長
尺寸偏移為長
Dim速度壹樣長，SpeedN壹樣長
將消息顯示為新消息
如果NewImg。CreateNewImage(NewWidth，NewHeight) = True Then
與Sa
。Element = 1
。尺寸= 1
. Bounds.Elements = Img。Stride * Img。高度
。指針= Img。指針
以…結尾
copy memory ByVal varptraray(ImageData())，VarPtr(Sa)，4
使用SaN
。Element = 1
。尺寸= 1
. Bounds.Elements = NewImg。Stride * NewImg。高度
。指針= NewImg。指針
以…結尾
copy memory ByVal VarPtrArray(new imagedata())，VarPtr(SaN)，4
寬度= Img。寬度:高度= Img。高度
步幅= Img。Stride: NewStride = NewImg。進展
ReDim linear row(new width-1)壹樣長
選擇案例方法
Case ResizeModeConst。SMC _最近
OldYY = -1
對於X = 0到NewWidth - 1
linear row(X)=(X * Width \ new Width)* 3
然後
對於Y = 0到NewHeight - 1
SpeedN = Y * NewStride
YY = Y *高度\新高度
偏移= YY *步幅
如果YY = OldYY那麽
CopyMemory新圖像數據(SpeedN)，新圖像數據(SpeedN - NewStride)，NewStride
其他
舊YY
對於X = 0到NewWidth - 1
速度=偏移量+線性箭頭(X)
新圖像數據(速度)=圖像數據(速度)
新圖像數據(速度+ 1) =圖像數據(速度+ 1)
新圖像數據(速度+ 2) =圖像數據(速度+ 2)
SpeedN = SpeedN + 3
然後
如果…就會結束
然後
Case ResizeModeConst。SMC_StretchBlt
Img。渲染NewImg。Hdc，0，0，NewImg。寬度，新的。身高，0，0，Img。寬度，Img。高度
Case ResizeModeConst。SMC _雙線性
Dim PartXX壹樣長，PartYY壹樣長
Dim InvertXX為長，InvertYY為長
Dim NewX壹樣長，NewY壹樣長
Dim SpeedP壹樣長，ColOffset壹樣長
Dim Pos As Double
ReDim row offset(new width-1)壹樣長
ReDim RowPartXX(new width-1)壹樣長
對於X = 0到NewWidth - 1
Pos = X *(寬度- 1) /新寬度
RowOffset(X) = Int(Pos) * 3
RowPartXX(X)=(Pos-Int(Pos))* 2048
然後
對於Y = 0到NewHeight - 1
SpeedN = Y * NewStride
Pos = Y *(高度- 1) /新高度
甲方= (Pos - Int(Pos)) * 2048
InvertYY = 2048-party y y
ColOffset = Int(Pos) * Stride
對於X = 0到NewWidth - 1
PartXX = RowPartXX(X)
InvertXX = 2048 - PartXX
速度=並行偏移+行偏移(X)
SpeedP =速度+步幅
new ImageData(Speed n+2)=((ImageData(Speed+2)* invert xx+
ImageData(Speed+5)* PartXX)* InvertYY+(ImageData(SpeedP+2)*
invert xx+ImageData(SpeedP+5)* PartXX)* party y)\ 4194304
new ImageData(Speed n+1)=((ImageData(Speed+1)* invert xx+
ImageData(Speed+4)* PartXX)* InvertYY+(ImageData(SpeedP+1)*
invert xx+ImageData(SpeedP+4)* PartXX)* party y)\ 4194304
new ImageData(SpeedN)=((ImageData(Speed)* invert xx+ImageData(Speed+
3)* PartXX)* InvertYY+(ImageData(SpeedP)* InvertXX+
ImageData(SpeedP+3)* PartXX)* party y)\ 4194304
SpeedN = SpeedN + 3
然後
然後
結束選擇
copy memory ByVal varptraray(ImageData())，0 & amp, 4
copy memory ByVal VarPtrArray(new imagedata())，0 & amp, 4
如果…就會結束
Set Resample = NewImg
結束功能
模塊2，與時間測試相關的可以忽略的部分，內容不多，也貼出來了。
私有系統頻率作為貨幣
作為貨幣的公共函數GetCurrentTime()
如果SystemFrequency = 0，則不會初始化。
如果QueryPerformanceFrequency(system frequency)= 0，則
“SystemFrequency = ERRORINDEX”沒有高精度計數器。
如果…就會結束
如果…就會結束
If系統頻率& lt& gt錯誤索引
Dim CurCount作為貨幣
查詢性能計數器電路計數
GetCurrentTime = CurCount * 1000 @/system frequency
其他
GetCurrentTime = GetTickCount()
如果…就會結束
結束功能
模塊3，API聲明部分，需要自己解決沖突問題。
選項顯式
public Const error index As Long =-1
public Const DIB _ RGB _ COLORS As Long = 0
public const bi _ rgas long = 0 ' normal。
公共常量STRETCH_ANDSCANS As Long = 1
公共常量STRETCH_DELETESCANS As Long = 3
public Const STRETCH _ HALFTONE As Long = 4
public Const STRETCH _ or scans As Long = 2
公共類型RECT
左等長
頂端壹樣長
壹樣長
底部壹樣長
結束類型
公共類型POINTAPI
x壹樣長
只要
結束類型
公共類型RGBQUAD
藍色為字節
綠色如字節
紅色為字節
阿爾法作為字節
結束類型
公共類型LOGPALETTE
palVersion為整數
整數形式的palNumEntries
作為RGBQUAD的palvalentry(255)
結束類型
公共類型安全綁定
元素壹樣長
無限期
結束類型
公共類型SAFEARRAY2D
整數形式的維度
作為整數的特征
元素壹樣長
鎖壹樣長
指針壹樣長
作為SAFEARRAYBOUND的界限(1)
結束類型
公共類型安全數組
整數形式的維度
作為整數的特征
元素壹樣長
鎖壹樣長
指針壹樣長
作為SAFEARRAYBOUND的邊界
結束類型
公共類型BITMAPINFOHEADER
尺寸壹樣長
寬度和長度壹樣
高度壹樣長
平面作為整數
整數形式的位數
壓縮壹樣長
將圖像大小調整為Long
XPelsPerMeter壹樣長
YPelsPerMeter壹樣長
ClrUsed壹樣長
只要重要
結束類型
公共類型BITMAPINFO
BITMAPINFOHEADER格式的標頭
調色板(255)作為RGBQUAD
結束類型
公共類型位圖
類型壹樣長
寬度和長度壹樣
高度壹樣長
寬度字節長度
平面作為整數
BitsPixel作為整數
位壹樣長
結束類型
'
內存操作相關API
public Declare Sub copy memory Lib " kernel 32 " Alias " RtlMoveMemory "(lpDst As Any，lpSrc As Any，ByVal ByteLength As Long)
public Declare Sub zero memory Lib“kernel 32”別名“RtlMoveMemory”(Dest As Any，ByVal numBytes As Long)
公共
聲明子FillMemory庫“kernel32.dll”別名“RtlFillMemory”(ByRef
任意目的地，ByVal長度為Long，ByVal填充為Byte)
VB本體API
公共
聲明函數oleload picture Lib“olepro 32”(p stream As Any，ByVal
lSize為Long，ByVal為Long，riid為Any，ppvObj為Any)為
長的
公共聲明函數SafeArrayGetDim Lib " oleaut32 . dll "(ByRef saArray()As Any)為Long
公共聲明函數VarPtrArray Lib " msvbvm60.dll "別名" VarPtr" (ByRef Ptr() As Any)為Long
GDI系統API函數
公共聲明函數GetDC Lib " user 32 "(ByVal hwnd As Long)為Long
公共聲明函數CreateCompatibleDC Lib " GDI 32 . dll "(ByVal Hdc As Long)
公共
聲明函數CreateDIBSection Lib“GDI 32 . dll”(ByVal Hdc As Long，
ByRef pBitmapInfo As Any，ByVal un As Long，ByRef指針As Long，ByVal
手柄壹樣長，ByVal Dw壹樣長)壹樣長
公共聲明函數DeleteDC Lib " GDI 32 . dll "(ByVal Hdc As Long)
公共聲明函數released c Lib“user 32”(ByVal hwnd為Long，ByVal Hdc為Long)為Long
公共聲明函數delete object Lib " GDI 32 . dll "(ByVal ho object As Long)為Long
公共
聲明函數SetDIBColorTable Lib“GDI 32”(ByVal Hdc為Long，ByVal
un1壹樣長，ByVal un2壹樣長，pcRGBQuad壹樣長
公共
聲明函數GetDIBColorTable Lib“GDI 32”(ByVal Hdc為Long，ByVal
un1壹樣長，ByVal un2壹樣長，pRGBQuad壹樣長
公共聲明函數select object Lib“GDI 32 . dll”(ByVal Hdc為Long，ByVal hObject為Long)為Long
公共
聲明函數BitBlt Lib“GDI 32”(ByVal hDestDC為Long，ByVal X為
Long，ByVal Y壹樣長，ByVal NW壹樣長，ByVal nHeight壹樣長，
ByVal hSrcDC為Long，ByVal xSrc為Long，ByVal ySrc為Long，ByVal
壹樣長
公共聲明函數SetStretchBltMode Lib " GDI 32 "(ByVal Hdc為Long，ByVal nStretchMode為Long)為Long
公共
聲明函數StretchBlt Lib“GDI 32”(ByVal Hdc為Long，ByVal X為
Long，ByVal Y壹樣長，ByVal NW壹樣長，ByVal nHeight壹樣長，
ByVal hSrcDC為Long，ByVal xSrc為Long，ByVal ySrc為Long，ByVal
nSrcWidth As Long，ByVal nSrcHeight As Long，ByVal dwRop As Long)
長的
公共聲明函數SetDIBitsToDevice Lib " GDI 32 "(ByVal Hdc
壹樣長，拜爾X壹樣長，拜爾Y壹樣長，拜爾dx壹樣長，拜爾dy
長，ByVal SrcX長，ByVal SrcY長，ByVal Scan長，
NumScans為Long，Bits為Any，BitsInfo為BITMAPINFO，ByVal
wUsage壹樣長)壹樣長
公共聲明函數GetTickCount Lib "kernel32 "()為Long
公共聲明函數QueryPerformanceFrequency Lib " kernel 32 "(LP frequency為貨幣)為Long
公共聲明函數QueryPerformanceCounter Lib " kernel 32 "(lpPerformanceCount為貨幣)為Long
類模塊，CImage；文件名CImage.cls
選項顯式
私有m_Width作為Long層的寬度。
私有m_Height作為Long '層的高度。
私有m_Stride的每個掃描線的大小作為長層數據。
私有m_Hdc作為Long層的內存DC
私有m_Pointer的第壹個地址w作為內存中的Long' layer數據。
作為long' dibsection的私有m _ handle的句柄。
Private m_OldHandle作為原始設備環境的Long句柄。
公共屬性Get Width()為Long
寬度= m _寬度
結束屬性
公共屬性獲取高度()為Long
高度= m _高度
結束屬性
公共財產得到大步()壹樣長
步幅= m _步幅
結束屬性
公共屬性Get Hdc() As Long
Hdc = m_Hdc
結束屬性
公共屬性Get Handle()為Long
句柄= m_Handle
結束屬性
公共屬性Get指針()為Long
指針= m _指針
結束屬性
私有子類_Terminate()
處置資源
末端接頭
Public函數create new image(ByVal Width As Long，_ ByVal Height As Long)為布爾值
Dim ScreenDC為Long，BmpInfo為BITMAPINFOHEADER
如果寬度& lt= 0或高度& lt= 0，然後退出功能
“DisposeResource”刪除原始內存資源。
使用BmpInfo
。位數= 24
。Height = -Height '用GDI對象的坐標系建立壹個逆序的DIB(起點坐標在左上角)。
。寬度=寬度
。平面= 1
。尺寸= 40
m_Stride =((寬度* 3+3)And & amp；HFFFFFFFC)
。SizeImage = m_Stride * Height
以…結尾
ScreenDC = GetDC(0)'來獲取屏幕DC。
m _ Hdc = CreateCompatibleDC(ScreenDC)
' ReleaseDC 0，ScreenDC '釋放屏幕DC。
m _ Handle = CreateDIBSection(m _ Hdc，BmpInfo，DIB_RGB_COLORS，m_Pointer，0，0)
如果m _ Handle & lt& gt我不希望這個系統能讓我們成功地創建DIB。
m_OldHandle = SelectObject(m_Hdc，m_Handle)
m_Width =寬度:m_Height =高度
CreateNewImage = True
如果…就會結束
結束功能
公共子處理器資源()
如果m _ Hdc & lt& gt那麽0
選擇對象m_Hdc，m_OldHandle
刪除DC m_Hdc
刪除對象m_Handle
' M_Width = 0: m_Height = 0 '重置其他與圖像相關的屬性。
m_Handle = 0: m_OldHandle = 0
m_Pointer = 0: m_Hdc = 0
如果…就會結束
末端接頭
公共函數Render(ByVal DestDC As Long，_
可選ByVal DestX，只要，_
可選的ByVal DestY壹樣長，_
可選ByVal DestWidth As Long，_
可選ByVal DestHeight As Long，_
可選ByVal SrcX壹樣長，_
可選ByVal SrcY壹樣長，_
可選ByVal SrcWidth壹樣長，_
可選ByVal SrcHeight)作為布爾值
如果m_Handle = 0，則退出功能
如果DestWidth = 0，則DestWidth = m_Width
如果DestHeight = 0，則DestHeight = m _ Height
如果SrcX & lt0那麽SrcX = 0 '源X，Y不能為負，但目的地X，Y可以。
如果SrcY & lt0，則SrcY = 0
如果SrcWidth = 0，則
SrcWidth = m_Width
ElseIf SrcWidth & lt那麽0
DestWidth = -DestWidth
SrcWidth = -SrcWidth
如果…就會結束
如果SrcHeight = 0，則
SrcHeight = m_Height
ElseIf SrcHeight & lt那麽0
DestHeight = -DestHeight
SrcHeight = -SrcHeight
如果…就會結束
SetStretchBltMode DestDC，STRETCH_HALFTONE
StretchBlt DestDC，DestX，DestY，DestWidth，DestHeight，m_Hdc，SrcX，SrcY，SrcWidth，SrcHeight，vbSrcCopy
結束功能
Boolean類型的公共函數LoadPictureFromFile(文件名為字符串)
寬度壹樣長，高度壹樣長
將標準圖片調暗為標準圖片
出錯時轉到錯誤句柄:
設置StdPic = LoadPicture(文件名)
width = ConvertHimetrixToPixels(StdPic。寬度，真)
height = ConvertHimetrixToPixels(StdPic。高度，假)
如果CreateNewImage(Width，Height) = True，則
StdPic。渲染m _ Hdc+0 & amp；，0 & amp，0 & amp寬度+0 & amp；，高度+
0 & amp，0，StdPic。身高，StdPic。寬度，-StdPic。高度，ByVal 0
類似於BMP的反向存儲，so -StdPic。用身高。
LoadPictureFromFile = True
如果…就會結束
錯誤句柄:
結束功能
私有函數ConvertHimetrixToPixels(HiMetrix為Long，水平方向為Boolean)為Long
如果水平的話
ConvertHimetrixToPixels = HiMetrix * 1440/2540/Screen。TwipsPerPixelX
其他
ConvertHimetrixToPixels = HiMetrix * 1440/2540/Screen。TwipsPerPixelY
如果…就會結束
結束功能
私有函數ConvertPixelsToHimetrix(像素長，水平方向為布爾值)長
如果水平的話
ConvertPixelsToHimetrix =像素*屏幕。TwipsPerPixelX * 2540 / 1440
其他
ConvertPixelsToHimetrix =像素*屏幕。TwipsPerPixelY * 2540 / 1440
結束IfEnd函數