Listview mit Thumbs

Gerhard Putschalka · 27. März 2011

Hallo,

ich möchte eine Thumbsübersicht anzeigen und daraus einen bestimmten Thumb auswählen.

Frank Abbing's Beispiel Gezeichnete_Bitmap_einbauen_2.prf wäre für die Anzeige sehr geeignet.

Leider kann ich einen Klick auf ein Bild nicht auswerten.

GetControlParas(B#) schien mir sehr geeignet weil ich dabei die Spalte + Zeile auslesen könnte. Leider klappt es nicht. GetControlParas wird nicht ausgelöst.

Mit @GetFocus(listview&) und danach @GetCurSel(listview&) wird statt der richtigen Zeile immer -1 zurückgemeldet.

Die Mausposition (mit @GetFocus(listview&) nützt mir wenig, weil ich im Listview auch blättern kann - ich weiß dann nicht welche Zeile als oberste Zeile angezeigt wird.
Könnte ich vielleicht statt der Thumbs Bitmap-Buttons einsetzen???

Gibt es für mein Problem eine Lösung? (ich verwende Windows 7).

Vielen Dank.

Gerhard.

THFR · 27. März 2011

Hallo Gerhard,
vielleicht hilft dir folgendes weiter:

Code

$P+


Set("ErrorLevel", 1)


$H Windows.ph
$H messages.ph
$H commctrl.ph
$H Structs.ph
DEF PathFileExists(1) ! "shlwapi","PathFileExistsA"


Proc PFExists
parameters file$
return PathFileExists(addr(file$))
endproc


$I Listview_Funktionen.inc
If PFExists("Listview.dll")," "
var lvdll&=usedll("Listview.dll")
Else
MessageBox "Fehler beim Laden der Listview.dll!\nBitte Installation überprüfen.","Information",$40040
End
EndIf
Def ImageList_Create(5) !"comctl32.dll","ImageList_Create"
Def ImageList_Destroy(1) !"comctl32.dll","ImageList_Destroy"
Def ImageList_Add(3) !"comctl32.dll","ImageList_Add"


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Datensicherung
Def ShellExecuteEx(1) !"SHELL32","ShellExecuteExA"
Def @Enablemenuitem(3) !"USER32","EnableMenuItem"
Def GetSystemMenu(2) !"USER32","GetSystemMenu" '
DEF SHBrowseForFolder(1)   ! "Shell32","SHBrowseForFolder"
DEF SHGetPathFromIDList(2) !"Shell32","SHGetPathFromIDListA"
Def @Getdrivetype(1) !"KERNEL32","GetDriveTypeA"
Def SetProgressPos(2)   SendMessage(&(1), $0402, &(2), 0)
Def SetProgressRange(3) SendMessage(&(1), $0401, 0, &(2) | &(3) * $10000)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Statusbar
Def @Createstatuswindow(4) ! "comctl32","CreateStatusWindow"
Def @Createwindowex(12) !"USER32","CreateWindowExA"
Def @Getsyscolor(1) !"USER32","GetSysColor"
Def @Setparent(2) !"USER32","SetParent"
Declare Classname$,Progresshandle&,Hwnd&,Progresszähler&,Positions#
Dim Positions#,16
Long Positions#,0=550
Long Positions#,4=500
Long Positions#,8=-1
'............................................................................
Declare L.a&,L.x&,area&, klasse$
Declare isx&,isy&,xx!,yy!,maxx&,maxy&,rect#,vs#
Declare virtx&,virty&,so!
Dim rect#,16
Dim vs#,512
virtx&=2800
virty&=2800


SubClassProc
   L.x&=~GetKeyState(1) & $8000
   If L.x&
      If ( SubClassMessage(area&, ~WM_VSCROLL) and (&sLParam=0) )
         ~GetWindowRect(area&,rect#)
         maxy&=Long(rect#,12)-Long(rect#,4)+1
         L.x&=&sWParam & $0000ffff
         L.a&=1
         If L.x&=~SB_LINEDOWN
            isy&=8
         ElseIf L.x&=~SB_PAGEDOWN
            isy&=maxy&
         ElseIf L.x&=~SB_LINEUP
            isy&=-8
         ElseIf L.x&=~SB_PAGEUP
            isy&=-maxy&
         ElseIf L.x&=~SB_THUMBTRACK
            so!=yy!
            yy!=&sWParam >> 16
            isy&=-(so!-yy!)
            L.a&=0
         EndIf


         If L.a&
            yy!=yy!+isy&
            If yy!<0
               isy&=(isy&+(0-yy!))
               yy!=0
            EndIf
            If yy!>(virty&-maxy&)
               isy&=isy&-(yy!-(virty&-maxy&))
               yy!=virty&-maxy&
            EndIf
         Endif


         Long vs#,0=28
         Long vs#,4=~SIF_ALL
         Long vs#,12=virty&
         Long vs#,16=maxy&
         Long vs#,20=yy!
         ~SetScrollInfo(area&,~SB_VERT,vs#,1)
         ~ScrollWindow(area&,0,-isy&,0,0)
         ~UpdateWindow(area&)


      ElseIf (SubClassMessage(area&, ~WM_HSCROLL) and (&sLParam=0))
         ~GetWindowRect(area&,rect#)
         maxx&=Long(rect#,8)-Long(rect#,0)+1
         L.x&=&sWParam & $0000ffff
         L.a&=1


         If L.x&=~SB_LINERIGHT
            isx&=8
         ElseIf L.x&=~SB_PAGERIGHT
            isx&=maxx&
         ElseIf L.x&=~SB_LINELEFT
            isx&=-8
         ElseIf L.x&=~SB_PAGELEFT
            isx&=-maxx&
         ElseIf L.x&=~SB_THUMBTRACK
            so!=xx!
            xx!=&sWParam >> 16
            isx&=-(so!-xx!)
            L.a&=0
         EndIf


         If L.a&
            xx!=xx!+isx&
            If xx!<0
               isx&=(isx&+(0-xx!))
               xx!=0
            EndIf
            If xx!>(virtx&-maxx&)
               isx&=isx&-(xx!-(virtx&-maxx&))
               xx!=virtx&-maxx&
            EndIf
         Endif


         Long vs#,0=28
         Long vs#,4=~SIF_ALL
         Long vs#,12=virtx&
         Long vs#,16=maxx&
         Long vs#,20=xx!
         ~SetScrollInfo(area&,~SB_HORZ,vs#,1)
         ~ScrollWindow(area&,-isx&,0,0,0)
         ~UpdateWindow(area&)
      EndIf


   EndIf


   Case %sMessage=~WM_COMMAND: SendMessage(%hwnd,%sMessage,&sWParam,&sLParam)
   Case (SubClassMessage(area&, ~WM_HSCROLL) and (&sLParam<>0)): SendMessage(%hwnd,%sMessage,&sWParam,&sLParam)
   Case (SubClassMessage(area&, ~WM_VSCROLL) and (&sLParam<>0)): SendMessage(%hwnd,%sMessage,&sWParam,&sLParam)
EndProc


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Browser
Proc Browser_S
    Declare Buf#
    Dim Buf#,4
    DEF &BIF_EDITBOX $10
    DEF &BIF_BROWSEFORCOMPUTER $1000
    DEF &BIF_BROWSEFORPRINTER $2000
    DEF &BIF_BROWSEINCLUDEFILES $4000
    DEF &BIF_BROWSEINCLUDEURLS&80
    DEF &BIF_DONTGOBELOWDOMAIN $2
    DEF &BIF_NEWDIALOGSTYLE $40
    DEF &BIF_RETURNFSANCESTORS $8
    DEF &BIF_RETURNONLYFSDIRS &1
    DEF &BIF_SHAREABLE &8000
    DEF &BIF_STATUSTEXT $4
    DEF &BIF_USENEWUI $40
    DEF &BIF_VALIDATE $20
    Declare BrowseStyle&
    BrowseStyle& = &BIF_RETURNONLYFSDIRS+&BIF_STATUSTEXT'+&BIF_USENEWUI'+&BIF_EDITBOX'+&BIF_NEWDIALOGSTYLE'
    Declare Title$
    Title$ = "Bitte Ordner wählen:"
    Declare ReturnBuffer#,pidl&
    Dim ReturnBuffer#,260
    Declare BROWSEINFO#
    Dim BrowseInfo#,32
    Long BROWSEINFO#,0=%hwnd
    Long BROWSEINFO#,4=0
    Long BROWSEINFO#,8=ReturnBuffer#
    Long BROWSEINFO#,12=Addr(Title$)
    Long BROWSEINFO#,16=BrowseStyle&
    Long BROWSEINFO#,20=0
    Long BROWSEINFO#,24=0
    Long BROWSEINFO#,28=0
    pidl& = SHBrowseForFolder(BROWSEINFO#)


    If (SHGetPathFromIDList(pidl&,ReturnBuffer#)<>0)
      Text$=String$(ReturnBuffer#,0)
      Pfad$= Text$+"\"
    EndIf
    Dispose ReturnBuffer#
    Dispose BROWSEINFO#
    Dispose Buf#


    Add_List
EndProc


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Bilder-Liste
Proc Add_List


  ImageList_Destroy(ilist&)
  DestroyWindow(st&)
  DeleteAllItems(listview&)
  ClearList
  ChDir Pfad$
  AddFiles "*.png"
  AddFiles "*.jpg"
  AddFiles "*.bmp"
  AddFiles "*.gif"
'  AddFiles "*.wmf"
'  AddFiles "*.emf"
'  AddFiles "*.ico"
  Anz%= %GetCount+1
  Set("Decimals",0)
  text$="Ordner: "+Pfad$+"... mit " +str$(Anz%)+ " Bild"
  case %GetCount > 0 : text$=text$+"ern"
  @Sendmessage(Status&,$401,0,@Addr(Text$))


  ilist&=ImageList_Create(130,100,33,0,0)


  If Anz%>0
    Dim bereich#,400000
    text$=Chr$(13)
    bytes&=@MoveListToMem(bereich#,text$)
    CsvToListview(listview&,bereich#,bytes&,1)
    Dispose bereich#
    Dim bereich#,400000
    SetImageList(listview&,ilist&)
    SetColumnWidth(listview&,0,132)

    Whileloop GetLines(Listview&)
    GetItemText(listview&,bereich#,0,(&loop-1))
    text$=String$(bereich#,0)
    bild1&=Create("hSizedPic",-1,text$,130,100,1)
    MCls 130, 100 ,rgb(255,255,255)
    StartPaint -1
    DrawPic bild1&, 0, 0; 0
    EndPaint -1
    bild2&=@Create("hPic",0,"&MEMBMP")
    ImageList_Add(ilist&,bild2&,0)
    SetIcon(listview&,(&loop-1),(&loop-1))
    If &loop=1
      bild2&=Create("hPic",-1,text$)
      If (%BmpY > 600) AND (voll%=0)
          bild1&=Create("hSizedPic", -1, text$, 640, 480, 1)
          Else
          bild1&=Create("hPic",-1,text$)
      EndIf
      st& = Create("Bitmap",area&,bild1&,1,1)
    EndIf
    @Sendmessage(Progresshandle&,$0400+2,Progresszähler&,0)
    Progresszähler&=Progresszähler&+1
    Wend

    Else
    MessageBox "Dieser Ordner enthält\nkeine Bilder!","Information",$40040
  EndIf


  @Sendmessage(Progresshandle&,$0400+2,0,0)
  ~RedrawWindow(area&, 0, 0, ~RDW_FRAME | ~RDW_INVALIDATE | ~RDW_ALLCHILDREN | ~RDW_UPDATENOW | ~RDW_INTERNALPAINT)
  Dispose bereich#
EndProc






Declare a&,x&,y&,text$, st&, BildNr&
Declare listview&,z&,ilist&,bild1&,bild2&
declare bereich#,bytes&




Windowstyle 538
Windowtitle "Bildbetrachter für JPG - PNG - BMP - GIF"
Window 1000,640


Cls RGB(0,90,180)


AppendMenuBar 109,"Beenden"
AppendMenuBar 101,"Ordner öffnen"
PopUp "Anzeige"
  AppendMenu 102,"angepasst"
  AppendMenu 103,"100 %"


  CheckMenu 102,1
  CheckMenu 103,0
  var voll%=0


var Status&=@Createstatuswindow($50000920,@Addr(Text$),%Hwnd,1000)
@Sendmessage(Status&,$404,3,Positions#)
Dispose Positions#
Classname$="msctls_progress32"
Progresshandle&=@Createwindowex(0,@Addr(Classname$),0,$40000000,700+3,3,280-6,@Height(Status&)-6,%Hwnd,0,%Hinstance,0)
@Setparent(Progresshandle&,Status&)
@Showwindow(Progresshandle&,1)


Usefont "MS Sans Serif",10,0,0,0,0
SetDialogFont 1


InitMessages(%hwnd)


klasse$="#32770"
text$=""
area&=~CreateWindowEx($20000,addr(klasse$),addr(text$),$50300000,8 ,8 ,670 ,514 ,%hwnd,0,%hinstance,0)
SendMessage(area&,~wm_Hscroll,0,0)
SubClass area&, 1


Listview&=CreateListView(%hwnd,%hinstance,0,GetSysColor(15),-1,$3)
InsertColumn listview&,"Bilder",300,0
ShowListView(listview&,700,8,282,514)


var Pfad$ = @GetDir$("@")
text$="Ordner: "+Pfad$+"... "
@Sendmessage(Status&,$401,0,@Addr(Text$))


var Anz%=0
Browser_S


  
Usermessages $1405


While 1


  waitinput
  Case (%key=2) OR @MenuItem(109):BREAK
  dim bereich#,512
  If %umessage=$1405
    GetItemText(listview&,bereich#,0,str$(&ulParam))
 
    Text$=Translate$(Pfad$+"\\"+String$(bereich#,0),"\","\\")
    DeleteObject bild1&
    DeleteObject bild2&
    bild2&=Create("hPic",-1,text$)
      If (%BmpY > 600) AND (voll%=0)
          bild1&=Create("hSizedPic", -1, text$, 640, 480, 1)
          Else
          bild1&=Create("hPic",-1,text$)
      EndIf
    DestroyWindow(st&)
    st& = Create("Bitmap",area&,bild1&,1,1)
    SetFocus(listview&)
    UpdateListview(listview&)



  Elseif @MenuItem(101)
        Browser_S
  ElseIf @MenuItem(102)
        voll% = 0
        CheckMenu 103,0
        CheckMenu 102,1
        GetItemText(listview&,bereich#,0,BildNr&)
        text$=String$(bereich#,0)
        bild1&=Create("hPic",-1,text$)
        If %BmpY > 600
           case voll%=0:  bild1&=Create("hSizedPic", -1, text$, 640, 480, 1)
        EndIf
        DestroyWindow(st&)
        st& = Create("Bitmap",area&,bild1&,1,1)


  ElseIf @MenuItem(103)
        voll% = 1
        CheckMenu 103,1
        CheckMenu 102,0
        GetItemText(listview&,bereich#,0,BildNr&)
        text$=String$(bereich#,0)
        bild1&=Create("hPic",-1,text$)
        DestroyWindow(st&)
        st& = Create("Bitmap",area&,bild1&,1,1)


  Endif
    ~RedrawWindow(area&, 0, 0, ~RDW_FRAME | ~RDW_INVALIDATE | ~RDW_ALLCHILDREN | ~RDW_UPDATENOW | ~RDW_INTERNALPAINT)
  dispose bereich#
EndWhile
SubClass area&, 0
Dispose bereich#
Dispose rect#
Dispose vs#
ChDir Pfad$
ImageList_Destroy(ilist&)
DestroyWindow(%hwnd)


DeleteObject bild1&
DeleteObject bild2&


freedll lvdll&


End

Alles anzeigen

Hatte ich irgendwann angefangen und nicht beendet. Das Prinzip müsste durchkomen.

Gruß Thomas

Andreas Miethe · 27. März 2011

Haallo Gerhard,

Du könntest auch eine Listbox dafür benutzen, die können auch Bilder anzeigen.

Code

'######################
'Header-Dateien
'######################
$H Windows.ph
$H Messages.ph
'######################


'######################
'Structuren
'######################
STRUCT RECT  = Left&,Top&,Right&,Bottom&
Struct MEASUREITEMSTRUCT  = CtlType&,CtlID&,itemID&,itemWidth&,itemHeight&,itemData&
Struct DRAWITEMSTRUCT = CtlType&,CtlID&,itemID&,itemAction&,itemState&,hwndItem&,hDC&,rcItem!RECT,itemData&


Var OldCB& = 0
Var WindowWidth&  = 800
Var WindowHeight& = 600


'Erstmal ein unsichtbares Fenster anlegen
windowStyle $250
Window 0,0-0,0
CLS ~GetSysColor(~COLOR_BTNFACE)
SubClass %HWnd, 1


'Die Fenster-Prozedur muss für die erste Anzeige umgeleitet werden
Set("FastMode",1)
OldCB& = ~SetWindowlong(%hwnd,~GWL_WNDPROC,ProcAddr("CB",4))


'Fensterstil für die Bildliste
Var flags& = ~WS_CHILD | ~WS_HSCROLL | ~WS_VISIBLE | ~LBS_OWNERDRAWFIXED | ~LBS_MULTICOLUMN | ~LBS_NOINTEGRALHEIGHT | ~LBS_NOTIFY


'Liste  für die Bilder
Var hlist& = ~CreateWindowEx($200,"ListBox","",flags&,0,100,WindowWidth&,WindowHeight&-100,%hwnd,4000,0,0)


'Liste für die Pfade
Var hlist1& = ~CreateWindowEx(0,"ListBox","",~WS_CHILD,0,0,0,0,%hwnd,0,0,0)


'Itemgrösse setzen
~SendMessage(hlist&,~LB_SETCOLUMNWIDTH,168,0)
~SendMessage(hlist&,~LB_SETITEMHEIGHT,0,128)




'Hier die Bilder in die Listen laden
'Die Pfade müssen angepasst werden
Var Img& =Create("hSizedPic", -1,"c:\\Test.bmp", 160,120,0)
Var Img1& =Create("hSizedPic", -1,"c:\\Test1.bmp", 160,120,0)
~SendMessage(hlist&,~LB_ADDSTRING,0,img&)
~SendMessage(hlist1&,~LB_ADDSTRING,0,"C:\\test.bmp")
~SendMessage(hlist&,~LB_ADDSTRING,0,img1&)
~SendMessage(hlist1&,~LB_ADDSTRING,0,"C:\\test1.bmp")


'Fenster positionieren und anzeigen
SetStyle %hwnd,0,$14CF2000
~SetClassLong(%hwnd,~GCL_STYLE,(~GetClassLong(%hwnd,~GCL_STYLE)- ~CS_HREDRAW - ~CS_VREDRAW))
~Movewindow(%hwnd,Int(%maxx/2-WindowWidth&/2),Int(%maxy/2-WindowHeight&/2),WindowWidth&,WindowHeight&,1)
Repaint




'Fenster-Prozedur zurücksetzen
~SetWindowlong(%hwnd,~GWL_WNDPROC,OldCB&)
Set("FastMode",0)




Var Ende& = 0
Var Oldsel& = 0
WhileNot Ende&
  Waitinput
  If %key = 2
    Ende& = 1
  Endif
EndWhile
DeleteObject Img1&
DeleteObject Img&
End


SubClassProc
  If SubClassMessage(%hWnd, ~WM_DRAWITEM)
    Var DW# = New(DRAWITEMSTRUCT)
    DW# = &slParam
    If DW#.CtlType& = ~ODT_LISTBOX
      IF DW#.itemState& & ~ODS_SELECTED    'wenn selektiert
        Var brush& = ~CreateSolidBrush($008080)
      Else
        Var brush& = ~CreateSolidBrush($008080)
      Endif
      ~FillRect(DW#.hdc&,DW#.rcItem,brush&)
      ~SetBkMode(DW#.hdc&,~TRANSPARENT)
      Startpaint DW#.hwndItem&
        DrawPic DW#.itemData&,Long(DW#.RCItem,0)+4,Long(DW#.RCItem,4)+4;0
      EndPaint
    Endif
    Set("WinProc", 0)
  ElseIF SubClassMessage(%hWnd, ~WM_COMMAND)
    If Oldsel& = Getcursel(hlist&)
      Return 0
    Else
      Var tBuffer$ = Space$(~MAX_PATH)
      ~Sendmessage(hList1&,~LB_GETTEXT,~Sendmessage(hList&,~LB_GETCURSEL,0,0),Addr(tBuffer$))
      windowtitle Trim$(tBuffer$)
      Oldsel& = GetCursel(hList&)
    endif
  Endif
EndProc


PROC CB
  '------------------------
  'WindowCallback fürs Hauptfenster
  '------------------------
  PARAMETERS hWnd&, hMsg&, wParam&, lParam&
  IF hMsg& = ~WM_DRAWITEM
    Var DW# = New(DRAWITEMSTRUCT)
    DW# = lParam&
    If DW#.CtlType& = ~ODT_LISTBOX
      IF DW#.itemState& & ~ODS_SELECTED    'wenn selektiert
        Var brush& = ~CreateSolidBrush($008080)
      Else
        Var brush& = ~CreateSolidBrush($008080)
      Endif
      ~FillRect(DW#.hdc&,DW#.rcItem,brush&)
      ~SetBkMode(DW#.hdc&,~TRANSPARENT)
      Startpaint DW#.hwndItem&
        DrawPic DW#.itemData&,Long(DW#.RCItem,0)+4,Long(DW#.RCItem,4)+4;0
      EndPaint
    Endif
  endif
  Return ~DefWindowProc(hWnd&, hMsg&, wParam&, lParam&)
EndProc

Alles anzeigen

Frank A. · 27. März 2011

Funktionieren die in der Listview.dll eingebauten Usermessages denn nicht, Gerhard?

; Usermessages: Messagenummer = Beschreibung = (uwParam, ulParam)
; -------------
; $1400 = Tastendruck im Listview ermitteln = (LvHandle, Tastencode)
; $1401 = Gedrückten Spaltenbutton (linke Maustaste) melden = (LvHandle, Spalte)
; $1402 = Anwender will gerade Spaltenbreite verändern = (LvHandle, Spalte)
; $1403 = Anwender hat Spaltenbreite verändert = (LvHandle, Spalte)
; $1404 = Gedrückten Spaltenbutton (rechte Maustaste) melden = (LvHandle, Spalte)
; $1405 = Linksklick im Listview ermitteln = (Spalte, Zeile) + GetVar(7) liefert (LvHandle)
; $1406 = Rechtsklick im Listview ermitteln = (Spalte, Zeile) + GetVar(7) liefert (LvHandle)
; $1407 = Doppel-Linksklick im Listview ermitteln = (Spalte, Zeile) + GetVar(7) liefert (LvHandle)
; $1408 = Doppel-Rechtsklick im Listview ermitteln = (Spalte, Zeile) + GetVar(7) liefert (LvHandle)

Du kannst solches Messages jederzeit als UserMessages deklarieren, sodass sie WaitInput durchbrechen.

Gerhard Putschalka · 28. März 2011

Hallo,

Vielen Dank für Eure rasche Hilfe.
Werde alles ausprobieren.

Gerhard.

horst_ · 28. März 2011

Hier hast du von mir auch noch was

Zitat

$H messages.ph
$H windows.ph
Def ExtractIcon(3) !"SHELL32","ExtractIconA"
Def GetSysColor(1) !"USER32","GetSysColor"
DECLARE pfad$
pfad$=GETDIR$("@")
DECLARE EE%,list1%,list2%,win1&,anz%,I%,Y%
EE%=0
DECLARE XX&,y&,maus_taste%,itemtexts#,taste#
DECLARE hoch%,breit%,btn&
DECLARE prog$
hoch%=24
breit%=24
DIM itemtexts#,512
DIM taste#, 256
DECLARE iconlist&,anzahlicons&,b_bild&,bild$
iconlist&=CreateImageList(2,addr(anzahlicons&))
Declare lvdll&,listview&,text$,x&,z&,ilist&
$I Listview_Funktionen.inc
DECLARE breite%
breite%=(%MaxX/5)
lvdll&=usedll("Listview.dll")
Def ImageList_Create(5) !"comctl32.dll","ImageList_Create"
Def ImageList_Destroy(1) !"comctl32.dll","ImageList_Destroy"
Def ImageList_Add(3) !"comctl32.dll","ImageList_Add"
'##############################################################
CLS GETSYSCOLOR(15)
'------------------------------------------
CHDIR pfad$+"\\IMAGES" 'Muss angepasst werden !
'------------------------------------------
CLS
Usefont "MS Sans Serif",10,0,0,0,0
SetDialogFont 1

CLEARLIST
list1%=CREATE("SORTEDLISTBOX",%HWND,"",(%maxX+10),0,0,0)
CLEARLIST
list2%=CREATE("LISTBOX",%HWND,"",(%maxX+10),0,0,0)
ADDFILES "*.jpg"
ADDFILES "*.bmp"
ADDFILES "*.rle"
ADDFILES "*.jpeg"
ADDFILES "*.jpe"
ADDFILES "*.gif"
ADDFILES "*.emf"
ADDFILES "*.wmf"
ADDFILES "*.ico"
ADDFILES "*.cur"
MOVELISTTOHANDLE(list1%) 'Die Thumbnail-Darstellung
anz%=GetCount(list1%)
MOVELISTTOHANDLE(list2%) 'Hier stehen die Original-Bilder

DECLARE bild%[anz%],bild$[anz%],normal%[anz%],normal$[anz%],blind$[1000]
DECLARE hIcon&,index%
'############################################
I%=0
blind$[I%]=""
InitMessages(%hwnd)
ilist&=ImageList_Create(breit%,hoch%,33,0,0)
listview&=CreateListView(%hwnd,%hinstance,0,RGB(235,245,255),-1,$30)
InsertColumn listview&,"Mini-Bild",80,2
InsertColumn listview&,"Bild - Bezeichnung",250,0
InsertColumn listview&,"Bild - Maße",200,0

WHILENOT I% = anz%
bild$[I%]=GETSTRING$(list1%,I%)
prog$="CALC.EXE"
hIcon&=ExtractIcon(%hinstance,Addr(Prog$),index%)
Sendmessage(bild%[I%],~BM_SETIMAGE,~IMAGE_ICON,hIcon&)

bild%[I%]=Create("hSizedPic",-1,bild$[I%],breit%,hoch%,0)
ImageList_Add(ilist&,bild%[I%],0)
SetIconColumn(0)
SetItem listview&,blind$[i%]+" "+STR$(I%),LOWER$(bild$[I%])
SetIcon(listview&,I%,I%)
INC I%
ENDWHILE
SetImageList(listview&,ilist&)
ShowListView(listview&,10,50,300,300)
'----------------------------------------------------------------------------
bild$=SELECTSTRING(listview&,-1,"")
BILD_ANZEIGE bild$
WHILENOT EE%
WAITINPUT
XX&=GetSelectedDbClk(itemtexts#,addr(y&))
ForbidScrollMessage(1) 'IMMER setzen !
maus_taste%=GetControlParas(taste#)
ForbidScrollMessage(0) 'IMMER setzen !
'---------------------------------------------------------
IF GETFOCUS(listview&)
I%=GETCURSEL(listview&)
bild$=GETSTRING$(listview&,I%)
BILD_ANZEIGE bild$
ENDIF
'--------------------------------------------
IF ISKEY(27)
CLOSEMESSAGES(%HWND)
DesTroyWindow(win1&)
CHDIR GETDIR$("@")
ImageList_Destroy(ilist&)
freedll lvdll&
END
ENDIF
ENDWHILE
'###############################################################
PROC BILD_ANZEIGE
TEXTCOLOR RGB(0,0,150),-1
UseFont "ARIAL",18,0,1,0,0
PARAMETERS bild$
USEPEN 0,1,GETSYSCOLOR(15)
USEBRUSH 1,GETSYSCOLOR(15)
RECTANGLE 330,0 - 600,310
IF FILEEXISTS(bild$[I%])
DrawText 330,10,bild$[I%]
B_bild&=Create("hSizedPic", -1, bild$[I%],270,230, 1)
DrawPic B_bild&, 330,50,1
DELETEOBJECT B_bild&
ENDIF
ENDPROC

Alles anzeigen

Frank A. · 28. März 2011

Sehr schön, Horst.

Aber ob du es nochmal lernst, Quellcodes nicht zu zitieren [ quote][ /quote], sondern mit Codetags [ code][ /code] zu versehen? Da gehen doch die Einrückungen alle flöten...

horst_ · 28. März 2011

Zitat von Frabbing;848374

Sehr schön, Horst.

Aber ob du es nochmal lernst, Quellcodes nicht zu zitieren [ quote][ /quote], sondern mit Codetags [ code][ /code] zu versehen? Da gehen doch die Einrückungen alle flöten...

Jetzt wo du es sagst - ich habe den Button [#] immer übersehen !
Kannst du mir noch mal verzeihen

Frank A. · 28. März 2011

Mindestens noch einmal.

Gerhard Putschalka · 29. März 2011

Ich möchte, genau wie in Frank's Beispiel Gezeichnete_Bitmap_einbauen_2.prf, eine Übersicht mit mehreren Zeilen und mehreren Bildern pro Seite anzeigen.

Die Information bei Klick auf ein Bild bekomme ich zwar immer in der ersten Spalte richtig (welche Zeile und welche Spalte). Klicke ich in irgendeiner andderen als der ersten Spalte (2., 3. etc.) so wird als Zeile immer -1 zurückgemeldet.
Ich vermute dass das mit den Bildern nicht möglich ist. Bei Texten funktioniert es sehr wohl.

So werde ich bei meiner alten Version bleiben bei der ich, statt ListView oder Listbox, ein oder mehrere Dialogfenster erstelle und die Bilder mit Bildbuttons einfüge.
Das funktioniert sehr gut. Allerdings kann ich dabei nicht scrollen sondern nur von einem zum nächsten/vorigen Dialogfenster blättern (siehe Bild).

Jedenfalls vielen Dank für Eure Lösungen.:smile:

Gerhard.
[Blockierte Grafik: http://s1.postimage.org/1c6ncdz44/Bild1.jpg]

horst_ · 29. März 2011

heathcliff-online
In meinem Code hast du doch alle Bilder als kleine Vorschau und kannst mit Klick darauf das Bild anzeigen. Habe ich dich falsch verstanden ?

[Blockierte Grafik: http://s4.postimage.org/2qigcyrvo/dialog_fenster.jpg]

PS: Im Übrigen kannst die Mini-Bilder nach deinem Empfinden darstellen.
Gib den beiden Declarationen breit% + hoch% andere Werte und die Mini-Bilder werden mit den neuen Maßen gezeigt.

Frank A. · 29. März 2011

Gib nicht so schnell auf, Gerhard. Teste doch mal diesen Abfrage-Code...

Code

UserMessages $1405


While 1


  waitinput
  Case %key=2:BREAK


  If %umessage = $1405
    SetText %hwnd, "Spalte: " + Str$(&uwparam)+", Zeile: " + Str$(&ulparam)
  EndIf


EndWhile

Alles anzeigen

...mit diese Dll-Version:

Gerhard Putschalka · 29. März 2011

Horst Deine Version ist schon ok, aber ich wollte eine Übersicht anzeigen. Auch wenn ich die Bilder größer anzeige muss ich viel scrollen.

Frank. Genauso habe ich die Abfrage ja gemacht. Aber erst mit der aktuellen ListView-Version funktioniert es richtig. Ich bin froh, dass ich nicht aufgeben muss.
Vielen Dank.

Gerhard.

Frank A. · 29. März 2011

Bitteschön.

Es lag daran, dass die Notify-Message NM_CLICK die Item-Informationen nur in der ersten Spalte ermittelt, wenn Icons benutzt werden:

The iItem member of lParam is only valid if the icon
or first-column label has been clicked.

War mir auch neu. Hab es nun anders gelöst.

THFR · 30. März 2011

@ Frank, ich hatte das obrige Beispiel umgestellt (Spaltenbreite) und nun verschwindet bei mir (XP) beim Klick das Icon. Kann man das beheben?

heathcliff-online, du könntest ja auch Franks Scroll-Area einsetzen. Ein kleines unformatiertes Beispiel:

Code

$H windows.ph
$H messages.ph


Def WindowFromPoint(2)!"USER32","WindowFromPoint"
Def GetCursorPos(1) !"USER32","GetCursorPos"
Declare p#,h&
Dim p#,8
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' (w) Frabbing für Paules-PC-Forum:
Declare a_plus&,x_plus&,y_plus&,text$,area_plus&, klasse$,last_plus&
Declare isx_plus&,isy_plus&,xx_plus!,yy_plus!,maxx_plus&,maxy_plus&,rect_plus#,vs_plus#
Declare virtx_plus&,virty_plus&,so_plus!,but1_plus&,but2_plus&,but3_plus&,but4_plus&,but5_plus&
Dim rect_plus#,16
Dim vs_plus#,512


SubClassProc
  x_plus&=~GetKeyState(1) & $8000
  If x_plus&


    If ( SubClassMessage(area_plus&, ~WM_VSCROLL) and (&sLParam=0) )


      ~GetWindowRect(area_plus&,rect_plus#)
      maxy_plus&=Long(rect_plus#,12)-Long(rect_plus#,4)+1
      x_plus&=&sWParam & $0000ffff
      a_plus&=1


      If x_plus&=~SB_LINEDOWN
        isy_plus&=8
      ElseIf x_plus&=~SB_PAGEDOWN
        isy_plus&=maxy_plus&


      ElseIf x_plus&=~SB_LINEUP
        isy_plus&=-8
      ElseIf x_plus&=~SB_PAGEUP
        isy_plus&=-maxy_plus&


      ElseIf x_plus&=~SB_THUMBTRACK
        so_plus!=yy_plus!
        yy_plus!=&sWParam >> 16
        isy_plus&=-(so_plus!-yy_plus!)
        a_plus&=0
      EndIf


      If a_plus&


        yy_plus!=yy_plus!+isy_plus&


        If yy_plus!<0
          isy_plus&=(isy_plus&+(0-yy_plus!))
          yy_plus!=0
        EndIf
        If yy_plus!>(virty_plus&-maxy_plus&)
          isy_plus&=isy_plus&-(yy_plus!-(virty_plus&-maxy_plus&))
          yy_plus!=virty_plus&-maxy_plus&


        EndIf
      Endif


      Long vs_plus#,0=28
      Long vs_plus#,4=~SIF_ALL
      Long vs_plus#,12=virty_plus&


      Long vs_plus#,16=maxy_plus&


      Long vs_plus#,20=yy_plus!
      ~SetScrollInfo(area_plus&,~SB_VERT,vs_plus#,1)
      ~ScrollWindow(area_plus&,0,-isy_plus&,0,0)
      ~UpdateWindow(area_plus&)


    ElseIf (SubClassMessage(area_plus&, ~WM_HSCROLL) and (&sLParam=0))


      ~GetWindowRect(area_plus&,rect_plus#)
      maxx_plus&=Long(rect_plus#,8)-Long(rect_plus#,0)+1
      x_plus&=&sWParam & $0000ffff
      a_plus&=1


      If x_plus&=~SB_LINERIGHT
        isx_plus&=8
      ElseIf x_plus&=~SB_PAGERIGHT
        isx_plus&=maxx_plus&


      ElseIf x_plus&=~SB_LINELEFT
        isx_plus&=-8
      ElseIf x_plus&=~SB_PAGELEFT
        isx_plus&=-maxx_plus&


      ElseIf x_plus&=~SB_THUMBTRACK
        so_plus!=xx_plus!
        xx_plus!=&sWParam >> 16
        isx_plus&=-(so_plus!-xx_plus!)
        a_plus&=0
      EndIf


      If a_plus&


        xx_plus!=xx_plus!+isx_plus&


        If xx_plus!<0
          isx_plus&=(isx_plus&+(0-xx_plus!))
          xx_plus!=0
        EndIf
        If xx_plus!>(virtx_plus&-maxx_plus&)
          isx_plus&=isx_plus&-(xx_plus!-(virtx_plus&-maxx_plus&))
          xx_plus!=virtx_plus&-maxx_plus&


        EndIf
      Endif


      Long vs_plus#,0=28
      Long vs_plus#,4=~SIF_ALL
      Long vs_plus#,12=virtx_plus&


      Long vs_plus#,16=maxx_plus&


      Long vs_plus#,20=xx_plus!
      ~SetScrollInfo(area_plus&,~SB_HORZ,vs_plus#,1)
      ~ScrollWindow(area_plus&,-isx_plus&,0,0,0)
      ~UpdateWindow(area_plus&)


    EndIf


  EndIf
  Case %sMessage=~WM_COMMAND: SendMessage(%hwnd,%sMessage,&sWParam,&sLParam)


  Case (SubClassMessage(area_plus&, ~WM_HSCROLL) and (&sLParam<>0)): SendMessage(%hwnd,%sMessage,&sWParam,&sLParam)
  Case (SubClassMessage(area_plus&, ~WM_VSCROLL) and (&sLParam<>0)): SendMessage(%hwnd,%sMessage,&sWParam,&sLParam)


EndProc


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


Window 800,600


Usefont "MS Sans Serif",10,0,0,0,0
SetDialogFont 1


virtx_plus&=3800 ' kann entsprechend der Bilderspalten angepasst werden
virty_plus&=538


klasse$="#32770"
text$=""
area_plus&=~CreateWindowEx($20000,addr(klasse$),addr(text$),$50300000,0 ,0 ,790 ,544 ,%hwnd,0,%hinstance,0)


~GetWindowRect(area_plus&,rect_plus#)
maxy_plus&=Long(rect_plus#,12)-Long(rect_plus#,4)+1
Long vs_plus#,0=28
Long vs_plus#,4=~SIF_ALL
Long vs_plus#,12=virty_plus&


Long vs_plus#,16=maxy_plus&


Long vs_plus#,20=yy_plus!
~SetScrollInfo(area_plus&,~SB_VERT,vs_plus#,1)
maxx_plus&=Long(rect_plus#,8)-Long(rect_plus#,0)+1
Long vs_plus#,0=28
Long vs_plus#,4=~SIF_ALL
Long vs_plus#,12=virtx_plus&


Long vs_plus#,16=maxx_plus&


Long vs_plus#,20=xx_plus!
~SetScrollInfo(area_plus&,~SB_HORZ,vs_plus#,1)


SubClass area_plus&, 1


Declare b.obj&[], b.text$[],b.lage$[]
Declare x%,y%,Pfad$
Declare pic1&


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Pfad anpassen !!! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Pfad$= "F:\Pressewart-Unterlagen\Pliete-Bilder\Bornholm-2003"


ClearList
ChDir Pfad$
AddFiles "*.png"
AddFiles "*.jpg"
AddFiles "*.bmp"
AddFiles "*.gif"
var  Anz%= %GetCount+1


x%=0
y%=0
WhileLoop anz%
  WindowTitle @ListBoxItem$(&loop-1)
  b.obj&[&loop]=Control("DIALOG","",$54001100,x%, y%, 130, 100,area_plus&,0,%hinstance,$0)
  b.text$[&loop]=Pfad$+"\"+@ListBoxItem$(&loop-1)
  pic1&=@Create("hSizedPic", -1, Pfad$+"\"+@ListBoxItem$(&loop-1), 130, 100, 1)
  Create("Bitmap",b.obj&[&loop], pic1&,0, 0)


  b.lage$[&loop]=@Create("Tooltip",%hwnd,b.obj&[&loop],@ListBoxItem$(&loop-1))
  inc y%,104
  if y%>500
    y%=0
    inc x%,134
  Endif
wend
WindowTitle "Bildanzeige mit Mausklick links"


While 1
  WaitInput


  Case %key=2:Break
  GetCursorPos(p#)
  h&=WindowFromPoint(Long(p#,0),Long(p#,4))


  if %MouseKey=1 
    x%=1
    Whileloop anz% ' Anzahl der Objekte
      if h&=b.obj&[&loop]
        MessageBox("Bild:\n\n"+b.text$[&loop]+"\n\nanzeigen?","",32)
        break
      endif
    wend
  EndIf
EndWhile


SubClass area_plus&, 0


Dispose rect_plus#
Dispose vs_plus#
Dispose p#


DeleteObject pic1&
End

Alles anzeigen

Gruß Thomas

Frank A. · 30. März 2011

Dux: Unter Windows 7 verschwindet da nichts. Ich seh allerdings nicht, was das mit Listviews oder der Listview.dll zu tun hat, da du eine ganz andere Technik verwendest.

Mögliche Ursache: Du erstelltst Controls in einer Schleife, ohne die Handle freizugeben:

pic1&=@Create("hSizedPic", -1, Pfad$+"\"+@ListBoxItem$(&loop-1), 130, 100, 1)
Create("Bitmap",b.obj&[&loop], pic1&,0, 0)

Bei vielen Programmstarts oder auch Ordnern mit vielen Bilder stösst du sicherlich damit mal an ein Limit. Irgendwann sind die Handles ja mal aufgebrauchst...
Boote mal komplett neu und gib dann die Handle in deinem Programm immer wieder frei. Sollte helfen.

P.S.: In deinem oberen Quellcode verschwindest übrigens auch nichts bei mir.

Listview mit Thumbs

Jetzt mitmachen!

Teilen