Приделать к иконке стрелку (ярлык для)

[Alexanbar]

Есть STDPicture с иконкой. Требуется пририсовать стрелку внизу.

[Antonariy]

Скопировать на PictureBox и подрисовать?

[Alexanbar]

Без контролов. Имеется ввиду, что вторая картинка (стрелка) тоже есть (например, в Imagelist). А первая извлекается из разных файлов. Надо их скомбинировать программно.
Результат будет помещаться в Imagelist для последующего использования в Listview.

[alibek]

У ImageList есть метод Draw.

[Alexanbar]

У ImageList есть метод Draw.

Не пойдёть. Раз требуется hdc, значит нужно куда-то это рисовать. Похоже, это не сильно отличается от DrawIconEx.
Можно, конечно, так:

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

Dim iPic As IPictureDisp
Set iPic = Me.ImageList1.Overlay(1, 2)
Me.ImageList1.ListImages.Add , , iPic
'Me.Picture = iPic
Set ListView1.Icons = Me.ImageList1
Set ListView1.SmallIcons = Me.ImageList1
ListView1.ListItems.Add , , "ssss", 3, 3
ListView1.ListItems.Add , , "ssss2", 3, 3


но тогда в Imagelist будет дополнительно храниться неиспользуемая иконка (без стрелки).
Вот чем бы реализовать аналог метода overlay без Imagelist?

[hCORe]

MemDC?

[Alexanbar]

MemDC?

С чем это едят?

[Kovu]

MemDC?

С чем это едят?

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


Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SetTextColor Lib "gdi32.dll" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
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 TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Dim ndc As Long, nbit As Long, rct As RECT
Private Sub Command1_Click()
ndc = CreateCompatibleDC(Me.hdc)
nbit = CreateCompatibleBitmap(hdc, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY)
SelectObject ndc, nbit
SetBkMode ndc, 1
SetTextColor ndc, vbBlue
TextOut ndc, 100, 0, "Test String", 11
Call Form_Paint
End Sub

Private Sub Form_Paint()
BitBlt hdc, 0, 0, me.width/screen.twipsperpixelx,me.height/screen.twipsperpixely, ndc, 0, 0, vbSrcCopy
End Sub