Großes Fenster

[Gerhard Putschalka]

Wie kann ich ein Fenster, viel höher als der Bildschirm, erstellen und das Fenster beliebig in der Höhe mit einer Scroll-Leiste auf- und abschieben?

Geht das überhaupt?

Ähnlich wie das Fenster Arbeitsplatz bzw. Computer.

Schöne Feiertage.
Gruß
Gerhard.

[Frabbing]

Sowas hatte ich schonmal geschrieben, du findest den Code hier: Area / Scroll / Surface / Flächen - Control

[Gerhard Putschalka]

Hallo Frank,

wie immer erfolgte Deine Antwort sehr prompt!

Und sie beantwortet sehr gut meine Anfrage.

Vielen Dank.
Gerhard.

[Gerhard Putschalka]

Hallo Frank,

Ich möchte eine Prozedur erstellen mit der ich in einem Fenster mithilfe von CreateArea ein JPG-Bild in voller Größe anzeigen kann (mit scrollen).

Grundsätzlich funktioniert es schon.

Da ich bei DrawPic erfolglos ein Neuzeichnen versuchte zeige ich das Bild mit einem

@Create("PicButton",Frame1&,HPic&,1,1,%BmpX,%BmpY)

an.
Nur ruckelt das Bild beim Scrollen.

Da ich meine, dass PicButton nur eine Ausweichlösung ist würde ich DrawPic bevorzugen.
Und möglicherweise würde es mit DrawPic nicht ruckeln.

Das Programm (erstellt mit XProfan11) mit 2 Bildern kann von http://www.gerhard-putschalka.xprofan.com/Test4.zip heruntergeladen werden (Ungef. 5,4MB).

Gruß
Gerhard.

[THFR]

Hallo Gerhard,
Anzeigen: warum nicht mit: @Create("Bitmap", Frame1&, HPic&, 0, 0) ?
Hatte damit bisher keine Probleme.

Gruß Thomas

[Frabbing]

Ja, damit geht es besser. Je einfacher das Control, desto weniger Störungen werden provoziert es. Buttons lösen viele Messages aus, werden oft neu gezeichnet (hovern), usw.

[Gerhard Putschalka]

Hallo Thomas, hallo Frank,

danke. Das funktioniert wesentlich besser.

Viele Grüße
Gerhard.

[Gerhard Putschalka]

Hallo,

Im Prinzip funktioniert es so wie ich möchte.
Leider wird der Schirm zwischen den Bildern immer grau anstatt schwarz zu bleiben.

Ich musste in der Prozedur (Zeile 59/60) das Fenster mit Create erstellen um am Prozedurenende dieses wieder zerstören zu können.
Dabei tritt das Problem auf, dass ich das erstellte Fenster trotz CLS @RGB(0, 0, 0) nicht schwarz setzen kann.

Zum Test muss nur das Programm Test4.prf durch den nachstehenden Code ersetzt werden.

'
' Area-Control
' Beispiel von Detlef Jagolski
'
Set("ErrorLevel",0)

$I AN_AREA.INC

'$I Grossbild.inc
' zeige ein Bild in maximaler Größe an
' Einstiegsprozedur ist:
' Zeige_das_Bild   Parameters Pfad+Name des Bildes
' Return    nichts

'
' Area-Control Beispiel  von Detlef Jagolski
' Beispiel von Detlef Jagolski
'
' Mit Verwendung von an_area.inc von Frabbing für Paules-PC-Forum:
' http://www.paules-pc-forum.de/forum/xprofan/

Proc OnApplicationExit
  SubClass %hwnd, 0
  SubClass Frame1&, 0
EndProc

Proc OnApplicationInit
EndProc

SubClassProc
  SubclassArea
  return
  ' der Teil ist stillgelegt
  If (SubClassMessage(%hwnd, ~WM_SIZE) or SubClassMessage(%hwnd, ~WM_SIZING))
    x&=Width(%hwnd)
    Case x&>800:x&=800  'Darf nicht die maximale Breite überschreiten!
    y&=Height(%hwnd)
    Case y&>800:y&=800  'Darf nicht die maximale Höhe überschreiten!
    SetWindowPos Frame1& = 0,0-x&,y&;0
  EndIf
EndProc

Proc Zeige_das_Bild   ' die Prozedur wird mit der Esc-Taste verlassen
  Parameters Name$
  Declare Wx%,Wy%,Wv%,Ww%,Frame1&,Button1&,appexit%,WndH%
  Wx% = 00
  Wy% = 00
  Wv% = (%MaxX - 0)
  Ww% = (%MaxY - 0)
  
  Set("TrueColor",1)
  WindowStyle 16 + 64
  
  traceon   ' hier ist das Fenster noch schwarz (unverändert vom Aufruf)
  Traceoff
  
' anstelle von Window habe ich ein Fenster mit Create erstellt um am Ende der Prozedur dieses Fenster
' wieder zerstören zu können (DestroyWindow(%Hwnd) beendet das Hauptprogramm!!)
'  Window Wx%,Wy% - Wv%,Ww%
  WndH% = @Create("Window",%Hwnd,"",Wx%,Wy%,Wv%,Ww%)

  Cls @RGB(0, 0, 0)  ' hier sollte das eben erstellte Fenster schwarz werden. Ist aber hellgrau.
  traceon
  Traceoff
   
  ~SetClassLong(WndH%, ~GCL_STYLE, (~GetClassLong(%hwnd, ~GCL_STYLE)- ~CS_HREDRAW - ~CS_VREDRAW))
 
  UseFont "MS Sans Serif",13,0,0,0,0
  SetDialogFont 1
 
  OnApplicationInit

  HPic& = @Create("hPic",-1,Name$)

  ' erstelle Area in der Größe des Bildes
  Frame1& = CreateArea(%BmpX,%BmpY,$20000,$50300000,0,0,Width(WndH%),Height(WndH%),WndH%)
  
  @Create("Bitmap", Frame1&, HPic&, 0, 0)
  SubClass WndH%, 1
  SubClass Frame1&, 1

  SetWindowPos WndH% = Wx%,Wy% - Wv%,Ww%;0
  WhileNot appexit%
    WaitInput
    If %key = 2
      DeleteObject HPic&
      appexit%=1
    ElseIf (%ScanKey = $1B)   ' Esc
      DeleteObject HPic&
      appexit%=1
    
    EndIf
  EndWhile
  OnApplicationExit
  DestroyWindow(WndH%)
  Return
EndProc

' ==============
' Programm Start
' ==============

Declare HPic&
Set("TrueColor",1)
Window 0,0 - %MaxX,%MaxY
Cls @RGB(0, 0, 0)

Zeige_das_Bild "0003.jpg"
'messagebox("Zwischen","",0)
Zeige_das_Bild "0002.jpg"
End

Beim Test sind 2 Traceon+Traceoff eingebaut. Diese zeigen, dass das durch Create Window erstellte neue Fenster nicht schwarz gesetzt wird.

Gibt es dafür eine Lösung?

Schönen Feiertag.

Gruß
Gerhard.

[Frabbing]

Das kann ich grad mit meinem Netbook nicht testen (löst Bluescreen aus).
Du musst eben dafür sorgen, dass der Hintergrund schwarz gehalten wird. So z.B.:

~SetClassLong(%hwnd, ~GCL_STYLE, (~GetClassLong(%hwnd, ~GCL_STYLE)- ~CS_HREDRAW - ~CS_VREDRAW))

Ausdokumentieren, weil dadurch das Hintergrund-Löschen vor dem Neuzeichnen unterbunden wird.

Def CreateSolidBrush(1) !"gdi32","CreateSolidBrush"
~SetClassLong(?_area_plus&, ~GCL_HBRBACKGROUND, CreateSolidBrush(0))

Der Area einen anderen Hintergrund-Brush verpassen.

ElseIf (SubClassMessage(&sWnd, ~WM_ERASEBKGND))
  ~SelectObject(&sWParam, ~GetClassLong(&sWnd, ~GCL_HBRBACKGROUND))
  ~BitBlt(&sWParam, 0, 0, ?_virtx_plus&, ?_virty_plus&, &sWParam, 0, 0, ~BLACKNESS)
  Set("WinProc", 0)

Im Area-Subclassing einfügen, um den Brush beim Löschen zusätzlich schwarz zu zeichnen.

XProfans Subclassing eignet sich leider nicht wirklich für solche Dinge. Beispielsweise scheint es keine Möglichkeit zu geben, mit einem Returnwert in die originalen Windowsprozedur zu gehen. Das setzen aber einige Messages vorraus.
Musst halt mal bischen rumfummeln, wie gesagt, dein Code erzeugt bei mir auf dem kleinen Netbook einen Totalabsturz. Meine Democodes nicht.

[Gerhard Putschalka]

Hallo Frank,
auf meinem Notebook mit W7 funktioniert mein Testprogramm problemlos. Auf einem anderen Notebook und auf einem Tower, beide mit XP, erscheint auch der BlueScreen.

Da die Bildanzeige im endgültigen Programm auch (noch andere) Fehler zeigt werde ich versuchen einen anderen Weg zu finden.

Vorerst vielen Dank.
Gerhard.

[THFR]

Hallo Gerhard,
ich habe hier noch einen, warum auch immer, unvolledetes Beispiel mit Franks Sroll-Arera und Listview.dll. Vielleicht kanst du daraus einige Anregungen ziehen.

$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

Gruß Thomas

PS.: Grund war sicher, weil mir zu langsam, gelegentlicher Abbruch und unvollständiger Bildneuaufbau, wenn das vorherige gescrollt wurde (läßt sich sicher einfach beheben).

[Frabbing]

Auf einem anderen Notebook und auf einem Tower, beide mit XP, erscheint auch der BlueScreen.

Wie gesagt, bei mir ebenfalls.
Die Area-Democodes hingegen sind niemals abgestürzt. Da ist bei dir irgendwo der Wurm drin.

[Gerhard Putschalka]

Hallo Frank,

ich versuche jetzt einen anderen Weg. Dein Beispiel Grosse_Bitmap-Icons.prf schien mir dazu geeignet.

Zwar kann ich ein Bild 3008x2000 einfügen jedoch gelang es mir nur mit dem hor. Scoll-Balken das Bild in der Breite ganz anzuzeigen. Leider gibt es keinen vertikalen Scoll-Balken um das Bild auch in der Höhe zu verschieben.
Meine Frage: geht das überhaupt? Wenn ja: wie kann ich die Zeilenhöhe (für dieses Beispiel) auf 2000 einstellen?

Es wäre schön wenn das möglich wäre.

Von http://www.gerhard-putschalka.xprofan.com/test1.zip kannst Du meinen Versuch herunterladen.

Vielen Dank (für meine Lästigkeit).

Gerhard

[Frabbing]

Nein, Gerhard. Ich glaube nicht, dass sich das Listview vertikal so steuern lässt. Du kannst bei BuildListview mehrere Zeilen erzeugen und bekommst dann den Scroller, aber wirklich vernünftig scrollen ist nicht.
Habe aber noch einen Code bei mir gefunden, der dir evt. weiterhilft:

declare cf1&,cf2&
def cf1(2) !"kernel32","GetProcAddress"
def cf2(1) !"kernel32","GetModuleHandleA"
cf1&=cf1(cf2("user32.dll"),"InvalidateRect")
cf2&=cf1(cf2("user32.dll"),"UpdateWindow")

var hpic&=create("hpic",-1,"background.bmp")
var hpic.szx&=%bmpx
var hpic.szy&=%bmpy
windowstyle 312 | 8 | 16 | 512
var hdlg&=(create("window",(%hwnd),"picscrolldlg",(((%maxx/2)-(%maxx/3))),(((%maxy/2)-(%maxy/3))),(%maxx/1.5),(%maxy/1.5)))
var hdlg.hscrolly&=create("vscroll",hdlg&,"",width(hdlg&)-20,0,20,height(hdlg&)-20)
var hdlg.hscrollx&=create("hscroll",hdlg&,"",0,height(hdlg&)-20,width(hdlg&)-20,20)
var hblindstatic&=create("text",hdlg&,"",width(hdlg&)-20,height(hdlg&)-20,20,20)
subclass hdlg.hscrollx&, 1
subclass hdlg.hscrolly&, 1
subclass hdlg&, 1
usermessages $0010
while 1
  hpic.paint(hpic&,hdlg&,hdlg.hscrollx&,hdlg.hscrolly&,hpic.szx&,hpic.szy&)
  call(cf1&,hblindstatic&,0,0)
  call(cf2&,hblindstatic&)
  waitinput
  if %umessage=$0010
    break
  endif
endwhile
deleteobject hpic&
destroywindow(hdlg&)
end

proc hpic.paint
  parameters hpic2&,hdlg&,hscrlx&,hscrly&,picszx&,picszy&
  var x&=0-getscrollpos(hscrlx&)/100*(picszx&-width(hdlg&)+20)
  var y&=0-getscrollpos(hscrly&)/100*(picszy&-height(hdlg&)+20)
  startpaint hdlg&
  copypic hpic2&, 0,0 - (width(hdlg&)-20)-x&,(height(hdlg&)-20)-y& > x&,y&;0
  endpaint
  call(cf1&,hscrlx&,0,0)
  call(cf2&,hscrlx&)
  call(cf1&,hscrly&,0,0)
  call(cf2&,hscrly&)
endproc

subclassproc
  if ((%smessage=227) or (%smessage=$000f))
    hpic.paint(hpic&,hdlg&,hdlg.hscrollx&,hdlg.hscrolly&,hpic.szx&,hpic.szy&)
    call(cf1&,hblindstatic&,0,0)
    call(cf2&,hblindstatic&)
  endif
endproc

Müsste das sein, was du suchst. Quelle leider unbekannt, dürfte umgewandelter Xps-Codes ein. Schau ihn dir einfach an.

[THFR]

Und wie wär's mit einem WebControl "HTMLWin"

' Arbeitspfad im Interpretermodus , in der *. exe dann $ProgDir
Var old_file$ = GetDir$("@")'$ProgDir'

WindowStyle 16 + 64
Window %maxX,%maxY
AddHotKey 7001, 13, 0

var a$="mshtml: <b>Bild 0003.jpg</b><div style='font-size:12; '>und weiter mit Enter</div><img src='"+old_file$+"\0003.jpg'/>"
var h& = @create("htmlWin",%hWnd,a$,4,0,0,%maxX-4,%maxY-4)
While 0=0
waitInput
case MenuItem(7001) : Break
EndWhile
DestroyWindow(h&)

a$="mshtml: <b>Bild 0002.jpg</b><div style='font-size:12; '>und weiter mit Enter</div><img src='"+old_file$+"\0002.jpg'/>"
h& =@create("htmlWin",%hWnd,a$,4,0,0,%maxX-4,%maxY-4)

While 0=0
waitInput
case MenuItem(7001) : Break
EndWhile
DestroyWindow(h&)

end

Gruß Thomas