Текущий архив: 2004.05.16;
Скачать: CL | DM;

Вниз

listview   Найти похожие ветки 

← →
alexX   (2004-04-30 08:09) [0]

Вот нарыл код на vb плз помогите перевести в делфи

Option Explicit

Private Const NOERROR = &H0&
Private Const S_OK = &H0&
Private Const S_FALSE = &H1&
Private Const LVM_FIRST = &H1000
Private Const LVM_SETBKIMAGE = (LVM_FIRST + 68)
Private Const LVM_SETTEXTBKCOLOR = (LVM_FIRST + 38)
Private Const LVBKIF_SOURCE_URL = &H2
Private Const LVBKIF_STYLE_TILE = &H10
Private Const CLR_NONE = &HFFFFFFFF
" Bitmaps in list views!
Private Type LVBKIMAGE
  ulFlags As Long
  hbm As Long
  pszImage As String
  cchImageMax As Long
  xOffsetPercent As Long
  yOffsetPercent As Long
End Type

Private Declare Sub CoUninitialize Lib "OLE32.DLL" ()
Private Declare Function CoInitialize Lib "OLE32.DLL" (ByVal pvReserved As Long) As Long
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Sub SetBackground()
Dim sI As String
Dim lHDC As Long
 
 " Set a background image:
 sI = "BACK.GIF"
 
 If (Len(sI) > 0) Then
    If (InStr(sI, "")) = 0 Then
       sI = App.Path & "" & sI
    End If
    On Error Resume Next
    If (Dir(sI) <> "") Then
       If (Err.Number = 0) Then
          " Set the background:
          Dim tLBI As LVBKIMAGE
          tLBI.pszImage = sI & Chr$(0)
          tLBI.cchImageMax = Len(sI) + 1
          tLBI.ulFlags = LVBKIF_SOURCE_URL Or LVBKIF_STYLE_TILE
          SendMessage lvwTest.hwnd, LVM_SETBKIMAGE, 0, tLBI
          " Set the background colour of the ListView to &HFFFFFFFF (-1)
          " so it will be transparent!
          SendMessageLong lvwTest.hwnd, LVM_SETTEXTBKCOLOR, 0, CLR_NONE
       Else
          MsgBox "Error with File "" & sI & "" :" & Err.Description & ".", vbExclamation
       End If
    Else
       MsgBox "File "" & sI & "" not found.", vbExclamation
    End If
 End If

End Sub

Private Sub Form_Load()
  Dim i As Byte
  Dim itmX As ListItem
  Dim lR As Long
  With lvwTest
      "// required for using bitmaps
      lR = CoInitialize(0)
      Debug.Print lR
      If (lR <> NOERROR) And (lR <> S_FALSE) Then
          Debug.Print "CoInitialize failed"
      End If
      .ColumnHeaders.Add , "H1", "Col1"
      .ColumnHeaders.Add , "H2", "Col2"
      .ColumnHeaders.Add , "H3", "Col3"
      .ColumnHeaders.Add , "H4", "Col4"
      Randomize
      For i = 1 To 20
          " Add text
          Set itmX = .ListItems.Add(, "C" & i, "Test Item " & i)
         
          " Col2= Col2 + Item
          itmX.SubItems(1) = "Col2 " & i
          " Col3= Item Number
          itmX.SubItems(2) = i
      Next i
      SetBackground
 End With
End Sub



---

← →
Романов Р.В. ©   (2004-04-30 08:43) [1]

http://delphimaster.net/view/1-1083294683/

---

Страницы: 1 вся ветка

Текущий архив: 2004.05.16;
Скачать: CL | DM;

Наверх

Память: 0.47 MB
Время: 0.043 c