BMP를 ICO로 변환하기 위해 VB에서 프로그램을 작성하는 방법

BMP와 ICO 간의 상호 변환을 달성하려면 다음 작업을 따르십시오.

먼저 다음 프로젝트 그림 컨트롤을 만듭니다. picImage picMaskbackcolor 속성은 각각 검은색과 흰색입니다. 다른 네 개의 그림 컨트롤은 위에서 아래로, 왼쪽에서 오른쪽으로 키는 기본값입니다. 왼쪽에서 오른쪽으로. form1에 다음 코드를 입력하세요. :Option ExplicitPrivate 선언 함수 BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, _

ByVal Y As Long, ByVal nWidth As Long) Long, ByVal hSrcDC As Long, _

ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long)

개인 선언 함수 CreateCompatibleBitmap Lib "gdi32"(ByVal hdc 길게, _

ByVal nWidth 길게, ByVal nHeight 길게)

Private 선언 함수 CreateCompatibleDC Lib "gdi32"(ByVal hdc As Long) As LongPrivate 선언 함수 SelectObject Lib "gdi32"(ByVal hdc As Long, _

ByVal hObject As Long)

Private 선언 함수 DeleteDC Lib "gdi32"(ByVal hdc As Long) As LongPrivate 선언 함수 DeleteObject Lib "gdi32"(ByVal hObject As Long) LongPrivate 선언 함수 CreateIconIndirect Lib "user32"(icoinfo As ICONINFO) As LongPrivate 선언 함수 OleCreatePictureIndirect Lib "olepro32.dll"(lppictDesc As _

pictDesc, riid As Guid, ByVal fown As Long, ipic As IPicture) As Long

개인 선언 함수 GetIconInfo Lib "user32"(ByVal hIcon As Long, _

icoinfo as ICONINFO) As Long

p>

개인 선언 함수 SetBkColor Lib "gdi32" (ByVal hdc As Long, _

ByVal crColor As Long) 긴

개인 선언 함수 CreateBitmap Lib "gdi32" ( ByVal nWidth는 길이만큼, ByVal nHeight는 _

길이만큼, ByVal nPlanes는 L만큼

ong, ByVal nBitCount As Long, lpBits As Long

Private Type ICONINFO

fIcon As Long

xHotspot As Long

yHotspot의 길이

hBMMask의 길이

hBMColor의 길이

End TypePrivate 유형 Guid

Data1의 길이

정수형 Data2

정수형 Data3

Data4(7) 바이트형

End TypePrivate 유형 pictDesc

cbSizeofStruct As Long

긴 picType

hImage 긴

xExt 긴

yExt 긴

End TypeConst PICTYPE_BITMAP = 1

Const PICTYPE_ICON = 3

Guid로 iGuid를 흐리게

hdcMono를 흐리게

bmpMono를 흐리게

bmpMonoTemp를 흐리게

Const stdW = 32

Const stdH = 32

Dim mresult

Private Sub Form_Load()

hdcMono = CreateCompatibleDC(hdc)

bmpMono = CreateCompatibleBitmap(hdcMono, stdW, stdH)

bmpMonoTemp = SelectObject(hdcMono, bmpMono)

iGuid 사용

.Data1 = &H20400

.Data4(0) = &HC0

.Data4(7) = &H46

다음으로 끝남

End Sub

Private Sub command1_Click()

오류 시 다음 재개

긴 mtransp 길이

picImage.BackColor = Picture1. BackColor

mtransp = Picture1.Point(0, 0)

CreateTransparent Picture1, picImage, mtransp

CreateMask_viaMemoryDC picImage, picMask

mresult = BitBlt(Picture2.hdc, 0, 0, stdW, stdH, picMask.hdc, 0, 0, vbSrcAnd)

mresult = BitBlt(Picture2.hdc, 0, 0, stdW, stdH, picImage. hdc, 0, 0, vbSrcInvert)

BuildIcon Picture2

SavePicture Picture2.Picture, App.Path & "/F

rombmp.ico"

Sub 종료

Private Sub command2_Click()

오류 발생 시 다음 재개

Dim i, j

어두운 p, q

Picture4.Picture = Picture3.Image

p = Picture4.Point(0, 0)

q = 나. BackColor

For i = 0에서 stdW로

For j = 0에서 stdH로

If Picture4.Point(i, j) = p Then

Picture4.PSet (i, j), q

End If

다음 j

다음 i

SavePicture Picture4. Picture, App.Path & "/Fromico.bmp"

End Sub

개인 함수 CreateMask_viaMemoryDC(Pic1 As PictureBox, Pic2 As PictureBox) As Boolean

On 오류 GoTo errHandler

CreateMask_viaMemoryDC = False

Dim dx는 길게, dy는 길게

dim hdcMono2는 길게, bmpMono2는 길게, bmpMonoTemp2는 길게

dx = Pic1.ScaleWidth

dy = Pic1.ScaleHeight

hdcMono2 = CreateCompatibleDC(0)

hdcMono2 = 0이면

GoTo errHandler

End If

bmpMono2 = CreateCompatibleBitmap(hdcMono2, dx, dy)

bmpMonoTemp2 = SelectObject(hdcMono2, bmpMono2)

mresult = BitBlt(hdcMono2, 0, 0, dx, dy, Pic1.hdc, 0, 0, vbSrcCopy)

mresult = BitBlt(Pic2.hdc, 0, 0, dx, dy, hdcMono2, 0, 0, vbSrcCopy)

SelectObject 호출(hdcMono2, bmpMonoTemp2)

DeleteDC(hdcMono2) 호출

DeleteObject(bmpMono2) 호출

CreateMask_viaMemoryDC = True

함수 종료

errHandler:

MsgBox "MakeMask_viaMemoryDC"

함수 종료

Private Sub ExtractIconComposite(inPic As PictureBox)

오류 발생 시 다음 재개

Dim ipic As IPicture

Dim icoinf

o ICONINFO로

어두운 pDesc ​​​​pictDesc로

어두운 hDCWork

어두운 hBMOldWork

어두운 hNewBM

Dim hBMOldMono

GetIconInfo inPic.Picture, icoinfo

hDCWork = CreateCompatibleDC(0)

hNewBM = CreateCompatibleBitmap(inPic.hdc, stdW, stdH)

hBMOldWork = SelectObject(hDCWork, hNewBM)

hBMOldMono = SelectObject(hdcMono, icoinfo.hBMMask)

BitBlt hDCWork, 0, 0, stdW, stdH, hdcMono, 0 , 0 , vbSrcCopy

SelectObject hdcMono, hBMOldMono

SelectObject hDCWork, hBMOldWork

pDesc ​​포함

.cbSizeofStruct = Len(pDesc)< /p >

.picType = PICTYPE_BITMAP

.hImage = hNewBM

끝내기

OleCreatePictureIndirect pDesc, iGuid, 1, ipic

picMask = ipic

ipic = 없음 설정

pDesc.hImage = icoinfo.hBMColor

OleCreatePictureIndirect pDesc, iGuid, 1, ipic

picImage = ipic

DeleteObject icoinfo.hBMMask

DeleteDC hDCWork

hBMOldWork = 없음 설정

hBMOldMono = 없음 설정

End Sub

Private Sub BuildIcon(inPic As PictureBox)

오류 발생 시 다음 재개

Dim hOldMonoBM

Dim hDCWork

Dim hBMOldWork

Dim hBMWork

Dim ipic As IPicture

Dim pDesc ​​​​As pictDesc

Dim icoinfo ICONINFO로

BitBlt hdcMono, 0, 0, stdW, stdH, picMask.hdc, 0, 0, vbSrcCopy

SelectObject hdcMono, bmpMonoTemp

hDCWork = CreateCompatibleDC(0)

inPic 사용

hBMWork = CreateCompatibleBitmap(inPic.hdc, stdW, stdH)

끝내기

hBMOldWork = SelectObject(hDCWork, HB

MWork)

BitBlt hDCWork, 0, 0, stdW, stdH, picImage.hdc, 0, 0, vbSrcCopy

SelectObject hDCWork, hBMOldWork

icoinfo 사용

.fIcon = 1

.xHotspot = 16

.yHotspot = 16

.hBMMask = bmpMono

.hBMColor = hBMWork

끝내기

pDesc로

.cbSizeofStruct = Len(pDesc)

.picType = PICTYPE_ICON

.hImage = CreateIconIndirect(icoinfo)

끝내기

OleCreatePictureIndirect pDesc, iGuid, 1, ipic

inPic.Picture = LoadPicture()

inPic = ipic

bmpMonoTemp = SelectObject(hdcMono, bmpMono)

DeleteObject icoinfo.hBMMask

DeleteDC hDCWork

hBMOldWork = 없음 설정

End Sub

Sub CreateTransparent(inpicSrc As PictureBox, inpicDest As PictureBox, _

inTrasparentColor As Long)

오류 발생 시 다음 재개

mMaskDC를 길게 어둡게

mMaskBmp를 길게 어둡게

mTempMaskBMP를 길게 어둡게

mMonoBMP를 길게 어둡게

길게 mMonoDC를 어둡게

길게 mTempMonoBMP를 어둡게

mSrcHDC를 길게 어둡게, mDestHDC를 길게 어둡게

w를 길게, h만큼 어둡게 긴

w = inpicSrc.ScaleWidth

h = inpicSrc.ScaleHeight

mSrcHDC = inpicSrc.hdc

mDestHDC = inpicDest.hdc

mresult = SetBkColor&(mSrcHDC, inTrasparentColor)

mresult = SetBkColor&(mDestHDC, inTrasparentColor)

mMaskDC = CreateCompatibleDC(mDestHDC)

mMaskBmp = CreateCompatibleBitmap(mDestHDC, w, h)

mTempMaskBMP = SelectObject(mMaskDC, mMaskBmp)

mMonoDC = CreateCompatibleDC(mDestHDC)

mMonoBMP

= CreateBitmap(w, h, 1, 1, 0)

mTempMonoBMP = SelectObject(mMonoDC, mMonoBMP)

mresult = BitBlt(mMonoDC, 0, 0, w, h, mSrcHDC , 0, 0, vbSrcCopy)

mresult = BitBlt(mMaskDC, 0, 0, w, h, mMonoDC, 0, 0, vbSrcCopy)

mMonoBMP = SelectObject(mMonoDC, mTempMonoBMP )

mresult = 삭제오브젝트(mMonoBMP)

mresult = 삭제DC(mMonoDC)

mresult = BitBlt(mDestHDC, 0, 0, w, h, mSrcHDC, 0, 0, vbSrcInvert)

mresult = BitBlt(mDestHDC, 0, 0, w, h, mMaskDC, 0, 0, vbSrcAnd)

BitBlt mDestHDC, 0, 0, w , h, mSrcHDC, 0, 0, vbSrcInvert

inpicDest.Picture = inpicDest.Image

mMaskBmp = SelectObject(mMaskDC, mTempMaskBMP)

mresult = DeleteObject( mMaskBmp)

mresult = DeleteDC(mMaskDC)

End Sub

Private Sub Form_QueryUnload(정수로 취소, 정수로 UnloadMode)

SelectObject bmpMono, bmpMonoTemp

DeleteObject bmpMono

DeleteDC hdcMono

End Sub