Помогите с API

[BOO]

Подскажите как называется API от вечающие за:
определение места на диске: общее и занятое
есть ли аналог функции Point

как с помощью функции BITBLT переносить не сплошную картинку а прозрачную в некоторых местах: у Image нет свойства HDC и я, разумеется,не знаю как его узнать а PictureBOX добавляет к картинке BackGround

Да кстати есть APi которые позволяет делать форму прозрачной по картинке????

[Demonx]

На счёт места на диске используй FileSystemObject.

[SSecurity]

А если тебе надо прозрачность .... то тут велком в Image ... там она поддерживается

[Amed]

SSecurity ну нельзя ж так прямо посылать человека в ImageBox

Option Explicit

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetTextColor Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long
Private Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function CreateHalftonePalette Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, lColorRef As Long) As Long

'Raster Operation Codes
Private Const DSna = &H220326 '0x00220326

Public Sub PaintTransparentDC(ByVal hdcDest As Long, _
ByVal xDest As Long, _
ByVal yDest As Long, _
ByVal Width As Long, _
ByVal Height As Long, _
ByVal hdcSrc As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal clrMask As OLE_COLOR, _
Optional ByVal hPal As Long = 0)
Dim hdcMask As Long
Dim hdcColor As Long
Dim hbmMask As Long
Dim hbmColor As Long
Dim hbmColorOld As Long
Dim hbmMaskOld As Long
Dim hPalOld As Long
Dim hdcScreen As Long
Dim hdcScnBuffer As Long
Dim hbmScnBuffer As Long
Dim hbmScnBufferOld As Long
Dim hPalBufferOld As Long
Dim lMaskColor As Long

Dim m_hpalHalftone As Long
hdcScreen = GetDC(0&)
m_hpalHalftone = CreateHalftonePalette(hdcScreen)
If hPal = 0 Then
hPal = m_hpalHalftone
End If
OleTranslateColor clrMask, hPal, lMaskColor

hbmScnBuffer = CreateCompatibleBitmap(hdcScreen, Width, Height)
hdcScnBuffer = CreateCompatibleDC(hdcScreen)
hbmScnBufferOld = SelectObject(hdcScnBuffer, hbmScnBuffer)
hPalBufferOld = SelectPalette(hdcScnBuffer, hPal, True)
RealizePalette hdcScnBuffer
BitBlt hdcScnBuffer, 0, 0, Width, Height, hdcDest, xDest, yDest, vbSrcCopy

hbmColor = CreateCompatibleBitmap(hdcScreen, Width, Height)
hbmMask = CreateBitmap(Width, Height, 1, 1, ByVal 0&)
hdcColor = CreateCompatibleDC(hdcScreen)
hbmColorOld = SelectObject(hdcColor, hbmColor)
hPalOld = SelectPalette(hdcColor, hPal, True)
RealizePalette hdcColor
SetBkColor hdcColor, GetBkColor(hdcSrc)
SetTextColor hdcColor, GetTextColor(hdcSrc)
BitBlt hdcColor, 0, 0, Width, Height, hdcSrc, xSrc, ySrc, vbSrcCopy
hdcMask = CreateCompatibleDC(hdcScreen)
hbmMaskOld = SelectObject(hdcMask, hbmMask)

SetBkColor hdcColor, lMaskColor
SetTextColor hdcColor, vbWhite
BitBlt hdcMask, 0, 0, Width, Height, hdcColor, 0, 0, vbSrcCopy
SetTextColor hdcColor, vbBlack
SetBkColor hdcColor, vbWhite
BitBlt hdcColor, 0, 0, Width, Height, hdcMask, 0, 0, DSna
BitBlt hdcScnBuffer, 0, 0, Width, Height, hdcMask, 0, 0, vbSrcAnd
BitBlt hdcScnBuffer, 0, 0, Width, Height, hdcColor, 0, 0, vbSrcPaint
BitBlt hdcDest, xDest, yDest, Width, Height, hdcScnBuffer, 0, 0, vbSrcCopy
DeleteObject SelectObject(hdcColor, hbmColorOld)
SelectPalette hdcColor, hPalOld, True
RealizePalette hdcColor
DeleteDC hdcColor
DeleteObject SelectObject(hdcScnBuffer, hbmScnBufferOld)
SelectPalette hdcScnBuffer, hPalBufferOld, True
RealizePalette hdcScnBuffer
DeleteDC hdcScnBuffer

DeleteObject SelectObject(hdcMask, hbmMaskOld)
DeleteDC hdcMask
ReleaseDC 0&, hdcScreen
DeleteObject m_hpalHalftone
End Sub

Private Sub Picture1_Click()
Picture1.ScaleMode = vbPixels
PaintTransparentDC Me.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture1.hdc, 0, 0, vbWhite
End Sub

Все белые точки в изображении должны стать прозрачными...[/b][/list]

[SSecurity]

И уж так явно ... порекомендовав написать стока кода тоже не надо ))

[Dagobert]

2 функции к первому пункту:

Код: Выделить всё

Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long

- правда, похоже она ограничена 2 ГБайтами.

Код: Выделить всё

Declare Function GetPixel Lib "gdi32" Alias "GetPixel" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Есть ещё функция:

Код: Выделить всё

Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" (ByVal lpRootPathName As String, lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As Currency, lpTotalNumberOfFreeBytes As Currency) As Long

Но её я не изучал.
И последний номер нашего хит парада.

Код: Выделить всё

Declare Function SHGetDiskFreeSpace Lib "shell32" Alias "SHGetDiskFreeSpaceA" (ByVal pszVolume As String, pqwFreeCaller As Currency, pqwTot As Currency, pqwFree As Currency) As Long

Но она работает только с W2K, и W98 или с остальными при наличии Internet Explorer 4.0

[Naked]

Amed зачем столько мороки с кодом?
вот, самый хороший вариант
Private Declare Function GdiTransparentBlt Lib "gdi32" (ByVal hdcDest As Long, ByVal nXOriginDest As Long, ByVal nYOriginDest As Long, ByVal nWidthDest As Long, ByVal hHeightDest As Long, ByVal hdcSrc As Long, ByVal nXOriginSrc As Long, ByVal nYOriginSrc As Long, ByVal nWidthSrc As Long, ByVal nHeightSrc As Long, ByVal crTransparent As Long) As Long

Private Sub Form_Click()
GdiTransparentBlt hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, vbWhite
End Sub

[GSerg]

Блин, двухгодичная тема... Некрофилия процветает, эх...

Ну ладно, чё ж делать
Напоминаю тогда, что TransparentBlt на 9х/ME содержит ошибку, приводящую к исчерпанию ресурсов системы, а про GdiTransparentBlt MSDN вобще ничего не знает

[Naked]

Это MSDN незнает, а в Gdi такая функция есть, можешь проверить