 |
Option Explicit
Private Declare Function ImageList_Draw Lib "comctl32.dll" ( _
ByVal hIml As Long, ByVal nIndex As Long, ByVal hDCDest _
As Long, ByVal xDest As Long, ByVal yDest As Long, _
ByVal idlFlags As Long) As Long
Const ILD_MASK = &H10
Const ILD_TRANSPARENT = &H1
Const ILD_SELECTED = &H4
Const ILD_FOCUS = &H4
Const ILD_NORMAL = &H0
Const ILD_BLEND = &H1
Const ILD_BLEND25 = &H2
Const ILD_BLEND50 = &H4
Const ILD_IMAGE = &H20
Const ILD_OVERLAYMASK = &HF00
Dim Selected%
Private Sub Form_Load()
With ImageList1
.ImageHeight = 32
.ImageWidth = 32
.UseMaskColor = True
.MaskColor = RGB(255, 0, 128)
.ListImages.Clear
End With
Image1.Picture = LoadPicture(App.Path & "\Back.jpg")
Picture3.Picture = Image1.Picture
Call ReloadImageList
End Sub
Private Sub Form_Paint()
Call DisplayImageList
End Sub
Private Sub Form_Unload(Cancel As Integer)
ImageList1.ListImages.Clear
End Sub
Private Sub Command1_Click()
Call ReloadImageList
End Sub
Private Sub Command2_Click()
If ImageList1.ListImages.Count = 0 Then Exit Sub
ImageList1.ListImages.Remove (Selected + 1)
If Selected = ImageList1.ListImages.Count Then
Selected = Selected - 1
If Selected < 0 Then Selected = 0
End If
Call DisplayImageList
End Sub
Private Sub Command3_Click()
Static InsCnt%
InsCnt = InsCnt + 1
If ImageList1.ListImages.Count = 10 Then Exit Sub
ImageList1.ListImages.Add (Selected + 1), "Insert " & _
CStr(InsCnt), Image2.Picture
Call DisplayImageList
End Sub
Private Sub Picture2_Click(Index As Integer)
ImageList1.BackColor = RGB(255, 255, 255)
Call SetImage(CLng(Index))
Selected = Index
End Sub
Private Sub Picture2_DblClick(Index As Integer)
Call Label1_Click(Index)
End Sub
Private Sub Text1_LostFocus()
With Text1
.Visible = False
ImageList1.ListImages(CInt(.Tag) + 1).Key = .Text
Label1(.Tag).Caption = .Text
End With
End Sub
Private Sub Check1_Click()
Call SetImage(CLng(Selected))
End Sub
Private Sub Label1_Click(Index As Integer)
With Text1
If .Visible Then
ImageList1.ListImages(CInt(.Tag) + 1).Key = .Text
Label1(.Tag).Caption = .Text
End If
.Text = Label1(Index).Caption
.Top = Label1(Index).Top
.Left = Label1(Index).Left
.Visible = True
.SelStart = 0
.SelLength = Len(.Text)
.SetFocus
.Tag = Index
End With
End Sub
Private Sub SetImage(x&)
Dim TPX%, TPY%
With ImageList1
If .ListImages.Count = 0 Then Exit Sub
TPX = Screen.TwipsPerPixelX
TPY = Screen.TwipsPerPixelY
Picture2(x).Picture = LoadPicture("")
Picture3.AutoRedraw = True
If Selected <> -1 And x <> Selected Then
.ListImages(Selected + 1).Draw Picture2(Selected).hDC, _
0, 0, imlNormal
Label1(Selected).BackColor = RGB(255, 255, 255)
Label1(Selected).ForeColor = RGB(0, 0, 0)
End If
.ListImages(x + 1).Draw Picture2(x).hDC, 0, 0, imlSelected
Label7.Caption = .ListImages(x + 1).Key
Label1(x).BackColor = RGB(128, 0, 0)
Label1(x).ForeColor = RGB(255, 255, 255)
If Check1.Value = vbUnchecked Then
.ListImages(x + 1).Draw Picture3.hDC, 5 * TPY, 5 * TPX, _
imlNormal
.ListImages(x + 1).Draw Picture3.hDC, 5 * TPY, 42 * TPX, _
imlTransparent
.ListImages(x + 1).Draw Picture3.hDC, 5 * TPY, 79 * TPX, _
imlSelected
.ListImages(x + 1).Draw Picture3.hDC, 5 * TPY, 116 * TPX, _
imlFocus
Call ImageList_Draw(.hImageList, x, Picture3.hDC, 5&, 153&, _
ILD_MASK)
Else
Picture3.Picture = Image1.Picture
Call ImageList_Draw(.hImageList, x, Picture3.hDC, 5&, 5&, _
ILD_NORMAL Or ILD_TRANSPARENT)
Call ImageList_Draw(.hImageList, x, Picture3.hDC, 5&, 42&, _
ILD_TRANSPARENT)
Call ImageList_Draw(.hImageList, x, Picture3.hDC, 5&, 79&, _
ILD_SELECTED Or ILD_TRANSPARENT)
Call ImageList_Draw(.hImageList, x, Picture3.hDC, 5&, 116&, _
ILD_FOCUS Or ILD_TRANSPARENT)
Call ImageList_Draw(.hImageList, x, Picture3.hDC, 5&, 153&, _
ILD_MASK Or ILD_TRANSPARENT)
End If
Picture3.Refresh
Picture3.AutoRedraw = False
End With
End Sub
Private Sub DisplayImageList()
Dim x%
For x = 0 To 9
Picture2(x).AutoRedraw = True
Next x
For x = 1 To 10
If x <= ImageList1.ListImages.Count Then
Picture2(x - 1).Visible = True
ImageList1.ListImages(x).Draw Picture2(x - 1).hDC, _
0, 0, imlNormal
Label1(x - 1).Caption = ImageList1.ListImages(x).Key
Label1(x - 1).Visible = True
Else
Picture2(x - 1).Visible = False
Label1(x - 1).Visible = False
End If
Next x
For x = 0 To 9
Picture2(x).Refresh
Picture2(x).AutoRedraw = False
Next x
Call SetImage(CLng(Selected))
End Sub
Private Sub ReloadImageList()
Dim x%, aa$
ImageList1.ListImages.Clear
For x = 0 To 9
aa = "Bild" & Chr$(x + 65) & ".bmp"
ImageList1.ListImages.Add , aa, LoadPicture(App.Path & _
"\" & aa)
Next x
Call DisplayImageList
End Sub
|
