XProfan

- Seite 3 -

Uwe
''Pascal''
Niemeier

Hi Leute!

Man kann sich den Aufruf von IrfanView sparen, wenn man bei den Styles der Overlays einen Chroma-Filter setzt:

<div style='filter:Chroma(color=#FFFFFF); position:absolute;...usw...

Vielleicht klappen sogar die dynamischen Filter; gäbe 'ne Menge netter Effekte...

BTW: Wie sieht das eigentlich mit JS in lokal gespeicherten HTML-Seiten aus?
Kann man das per Sicherheitseinstellung im IE abwürgen?

SeeYou
Pascal

04.05.2011 ▲

Stephan
Lührsen

Hallo Profaner,
nochmals vielen Dank. Das "Grundgerüst" übertrifft alle meine Erwartungen. Ich werde es jetzt in meinem Proggi integrieren und entsprechend anpassen. Checkboxen, Scroll-Funktionen und alles andere was ich mir gewünscht habe. Einfach genial.

Noch zum Code. IrfanView ist ein Programm, welches von Endnutzer separat installiert werden müßte. Mein Gedanke ist das BatchProgramm pvw32con zu benutzen. Es ist nur 244kb groß und kann in einem Rutsch ein ganzen Verzeichnis in GIF umwandeln. Ich habe noch nicht herausgefunden wie die transparente Farbe zu deklarieren ist. Der Chroma-Filter scheint nicht mit jedem Browser zu funzen.

Grüße aus dem schönen Friesland

Stephan Lührsen

www.L-PROG.de
Software und Homepages zu erschwinglichen Preisen

04.05.2011 ▲

Stephan
Lührsen

Ja - ich nochmal. Die Erstellung der transparenten GIF's geht nur mir der PVW32.dll, welche ebenfalls FREEWARE ist und das GIF-Format 89a unterstützt. Nur dieses kennt transparente Hintergundfarben. Als Zwischenlösung geht auch eine Umwandlung mit PVW32CON (PNG/JPG nach GIF) und danach eine weitere Umwandlung von GIF 87a in GIF 89a via geotrans. geotrans ist ebenfalls FREEWARE und nur 35kb groß.

Downloads unter: [...]

(pvw32.dll)
bzw: [...]

(geotrans)

Gruß Stephan

www.L-PROG.de
Software und Homepages zu erschwinglichen Preisen

04.05.2011 ▲

Hey!

"filter:Chroma" nach Uwes Tip ist imho doch insofern besser da das Programm ja immer IE als anzeigendes Control verwendet und es doch damit imho garnicht relevant ist ob "filter:Chroma" in anderen Browsern funktioniert.

Oder ich übersehe was. ^^

05.05.2011 ▲

Thomas
Freier

Ich denke nein, und daher Stephans Einwand : kein reines XProfan. Aber @Create("HTMLWin", H, S, N, X, Y, DX, DY) geht ohne IE auch nicht.
Und mit "filter:Croma" geht es recht flott.
Und Pascals Frage nach JS würde ich mit nein beantworten, denn bei meinen alten Vereinsseiten mit JS kommt der Sicherheitshinweis, dass das Ausführen von Skripts aus Sicherheitsgründen eingeschränkt ist und bei der hier erstellten Grid.html auch. Aber nicht , wenn sie vom Programm verwendet wird. Da wird JS ohne Aufhebung der Beschränkung ausgeführt.
Interessant wäre auch noch Zoom. Der für eine PDF gültige Befehl geht nicht und für dieses Control kann ich nichts finden. Pascal du ???
Und Stephan, bei deiner Bildgröße würde ich bei einem Vieleck eine MCls aus den x_min,y_min - x1_max,y1_max Werten (vorher in Schleifen ermitteln) erzeugen damit das Vieleck in den Sichtbereich gescrollt werden kann und nicht wie hier im Beispiel die Bildgröße als Basis fürs MCls nehmen .

Gruß Thomas
Windows XP SP2, XProfan X2

05.05.2011 ▲

Hab's mal mit "pagezoom" probiert. Leider werden die Scrollbalken einbezogen, so dass es nur mit Zoom +-50% noch ansehbar bleibt.
Eine markierte Zeile sollte nach Befehlsabarbeitung demarkiert werden. Andernfalls wird das Hintergrundbild bei Klick ins LV entfernt.

'URL: https://xprofan.com/intl/de/forum/grafiken-mit-overlay-funktionen-an-abwaehlbar/#bottom
'{$cleq}
 $H Windows.ph
 $H commctrl.ph
 $H ocx3a.ph
 $I ocx3a.inc
def $appName "GMOF"
Var dataStorageDir$ = $appDataDir+$appName+"\\"
mkDir dataStorageDir$
'
ocxInit()
var GrundBild$ = @LoadFile$("Grundbild wählen:","Bilder|*.jpg;*.png")
case (Grundbild$="") or (fileExists(grundBild$)=0) : end
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~Grundbildgröße für Linien/-zug
struct HIT=x&,y&,Flags&,Item&,SubItem&
Declare Gbildx%,Gbildy%,bmp&,Hit#,Item%,Status%
dim Hit#,HIT
bmp&=@Create("hPic",-1,Grundbild$)
Gbildx%=%BmpX
Gbildy%=%BmpY
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
windowStyle 1 | 2 | 8 | 16 | 512
window 1000,500
Var Font&=@Create("Font","Verdana",16,0,0,0,0)
SETDIALOGFONT Font&
var Titel$ = "x;1;40;y;1;40;Obj-x;1;60;Obj-y;1;60;LEnd-x;1;60;LEnd-x;1;60;Objekt;0;100"
var LV&   = Create("GridBox", %hwnd, Titel$, 0, 580, 10, 400, 190)
'
var irfanExeFile$=substr$(readini$("HKEY_0","Applications\\i_view32.exe\\shell\\open\\command\\",""),2,"\q")
case irfanExeFile$="" : irfanExeFile$="C:\\Programme\\IrfanView\\i_view32.exe"
'
AddString(LV&, "200|100|200|200|0|0|Kreis")
AddString(LV&, "100|20|80|80|0|0|nEck")
AddString(LV&, "600|200|100|200|0|0|Kreis")
' ACHTUNG !! Linien und Linienzug: MCls = Bildgröße und liegt damit auf x=0px, y=0px
' Werte für Linienzug in LEnd-x (LEnd-y) durch ; getrennt
AddString(LV&, "0|0|100|360|300|40|Linie")
AddString(LV&, "0|0|10|20|100;120;230|40;80;100|Linie")
var scroll&=@Create("HScroll",%hwnd,"",580,230,100,20)
var scrollpos&=CreateText(%hwnd,"100%",700,230,40,20)
var scroll!=50
SetScrollPos scroll&,scroll!
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Bilder erstellen und als GIF speichern
' Größe = Grundbild, Pos. und Größe X und Y vorgeben
Declare i%,x%,y%,xx%,yy%,Obj$,Text$

WhileLoop @GetCount(LV&)

    x%=val(substr$(@GetString$(LV&,(&loop-1)),3,"|"))
    y%=val(substr$(@GetString$(LV&,(&loop-1)),4,"|"))
    Obj$=trim$(substr$(@GetString$(LV&,(&loop-1)),7,"|"))

    If Obj$="Linie"

        xx%=val(substr$(@GetString$(LV&,(&loop-1)),5,"|"))
        yy%=val(substr$((substr$(@GetString$(LV&,(&loop-1)),6,"|")),1,";"))
        MCls Gbildx%, Gbildy%
        StartPaint -1
        Line x%, y% - xx%,yy%
        i%=2

        While 1

            text$=(substr$((substr$(@GetString$(LV&,(&loop-1)),5,"|")),i%,";"))
            text$=text$+(substr$((substr$(@GetString$(LV&,(&loop-1)),6,"|")),i%,";"))
            case trim$(text$)="" : Break
            x%=xx%
            y%=yy%
            xx%=val(substr$((substr$(@GetString$(LV&,(&loop-1)),5,"|")),i%,";"))
            yy%=val(substr$((substr$(@GetString$(LV&,(&loop-1)),6,"|")),i%,";"))
            Line x%, y% - xx%,yy%
            inc i%

        wend

        EndPaint -1

    Else

        MCls x%, y%
        StartPaint -1
        case Obj$="nEck" : Rectangle 0,0 - x%, y%
        case Obj$="Kreis" : Ellipse 0,0 - x%, y%
        EndPaint -1

    EndIf

    bmp&=@Create("hPic",0,"&MEMBMP")
    Obj$="B"+str$(&loop)+".png"
    SavePic dataStorageDir$+Obj$, bmp&
    '    Obj$="B"+str$(&loop)
    '    winExecWait(  irfanExeFile$+" "+dataStorageDir$+Obj$+ \
    '    ".png /transpcolor=(255,255,255) /convert="+dataStorageDir$+Obj$+".gif" ,1)

EndWhile

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~3. html erzeugen
assign #2,dataStorageDir$+"Grid.html"
rewrite #2
Print #2,"<HTML>"
Print #2,"<HEAD>"
Print #2,"<TITLE>Script</TITLE>"
Print #2,"<style>"
Print #2,"body{align:left},img,div{margin:0;padding:0;border:0;cursor:default;text-align:center}"
Print #2,"div{font-family:Verdana;font-size:10px;font-weight:normal;COLOR:#6f95c7;padding:0px 0px 0px 0px;}"
Print #2,"</style>"
Print #2,"<script type='text/javascript'>"
Print #2,"<!--"
Print #2,"var evalCode = '';"
Print #2,"function evalNow(){return eval(evalCode)};"
Print #2,"function setImgVis(i,state){document.getElementsByTagName('div')[i].style.visibility=state==1?'visible':'hidden'}"
Print #2,"function scrollToImg(i){window.scrollTo(parseInt(document.getElementsByTagName('div')[i].style.left)+parseInt(document.getElementsByTagName('div')[i].offsetWidth)*0.5-290,parseInt(document.getElementsByTagName('div')[i].style.top)+parseInt(document.getElementsByTagName('div')[i].offsetHeight)*0.5-200)}"
Print #2,"function pagezoom(i){ document.body.style.zoom=i;}"
Print #2,"-->"
Print #2,"</script>"
Print #2,"</HEAD>"
Print #2,"<body onselectstart='return false' oncontextmenu='return false'>"
Print #2,"<div style='height:527px;width:764px;background-image:url("+fNam2URI(GrundBild$)+")'></div>"
Declare x$,y$,xx$,yy$

WhileLoop @GetCount(LV&)

    x$=(substr$(@GetString$(LV&,(&loop-1)),1,"|"))
    y$=(substr$(@GetString$(LV&,(&loop-1)),2,"|"))
    xx$=(substr$(@GetString$(LV&,(&loop-1)),3,"|"))
    yy$=(substr$(@GetString$(LV&,(&loop-1)),4,"|"))
    Obj$=trim$(substr$(@GetString$(LV&,(&loop-1)),7,"|"))
    '~~~~~~~~

    If Obj$="Linie"

        xx$=str$(Gbildx%)
        yy$=str$(Gbildy%)

    EndIf

    '~~~~~~~~~~~
    Obj$=""+dataStorageDir$+"B"+trim$(str$(&loop))+".png"
    Print #2,"<div style='filter:Chroma(color=#FFFFFF); position:absolute; left:"+x$+"px; top:"+y$+ \
    "px;width:"+xx$+"px;height:"+yy$+"px;background-image:url("+fNam2URI(Obj$)+");visibility:hidden'>Objekt"+str$(&loop)+"</div>"

EndWhile

Print #2,"</body>"
Print #2,"</html>"
Close #2
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
var File$=dataStorageDir$+"Grid.html"
declare WebControl&
var WebObject&=ocxCreate(File$,%hwnd,0,0,565,430,$50000000+$200000+$100000,addr(WebControl&))
var Document&=ocxGet(WebObject&,"Document")
var Script&=ocxGet(Document&,"Script")
SetFocus(LV&)
userMessages 16
sendmessage(lv&,$1036,0,$20+$1+$4)
showWindow(lv&,0)
showWindow(lv&,1)

while 1

    waitinput
    case %umessage=16:break

    If (%wmnotify*%notifycode)=-12

        ~GetCursorPos(Hit#)
        ~ScreenToClient(lv&,Hit#)
        Item%=sendmessage(lv&,~LVM_HITTEST,0,Hit#)
        doJS("setImgVis("+str$(item%+1)+","+str$(testBit(sendMessage(lv&,~LVM_GETITEMSTATE,item%,~LVIS_STATEIMAGEMASK),13))+")")

    endif

    If getFocus(LV&) and (GetCurSel(LV&)>-1)

        doJS("scrollToImg("+str$(GetCurSel(LV&)+1)+")")
        LvDeSelect LV&,GetCurSel(LV&)

    EndIf

    If getFocus(Scroll&)

        @Set("Decimals",2)
        scroll!=1.0 + ((@GetScrollPos(scroll&)-50)/100)
        doJS("pagezoom("+str$(scroll!)+")")
        @Set("Decimals",0)
        SetText scrollPos&,str$((@GetScrollPos(scroll&)+50))+"%"

    EndIf

endwhile

ocxRelease(Script&,Document&,WebObject&)
DeleteObject Font&
DeleteObject bmp&
destroywindow(WebControl&)
ocxDeInit()

proc fNam2URI

    parameters s$
    return "file:///"+translate$(translate$(s$,"\\","/"),"//","/")

endProc

proc doJS

    parameters s$
    ocxPut(Script&,"evalCode",s$)
    ocxMethod(Script&,"evalNow")

endProc

proc LvDeSelect'deselectieren

    parameters Lv&,Item&
    Declare s#
    dim s#,1024
    long s#,12=0
    long s#,16=~LVIS_SELECTED | ~LVIS_FOCUSED
    sendmessage(Lv&,~LVM_SETITEMSTATE,Item&,s#)
    dispose s#

endproc

Uwe
''Pascal''
Niemeier

Hi Leute!

Das mit dem Zoom war vom Prinzip schon richtig, nur muß es ausschließlich auf die Bilder angewendet werden. In Profan+ocx sähe das ganz grob so aus:

proc Zoom'---------------------------------------------Zoom

    parameters Faktor!'-- 1.0 = Normal
    var Collection&=ocxMethod(Document&,"getElementsByTagName","DIV")
    declare Element&,Style&

    whileloop 0,9999

        Element&=ocxMethod(Collection&,"item",&loop,0)
        casenot Element&:break
        Style&=ocxGet(Element&,"style")
        ocxPut(Style&,"zoom",Faktor!)
        ocxRelease(Style&,Element&)

    endwhile

    ocxRelease(Collection&)

endproc'---------------------------------------------------

Das läßt sich auch nach JS umsetzten, aber da bin ich nicht so firm drin...

HTH
Pascal

- Seite 4 -

Stephan
Lührsen

Die Zoom-Funktion von Pascal läuft bei mir super. Kann man die Position der scrollbalken abfragen? Ich brache die Position, damit ich nach einem Kartenwechsel auf die vorherige Kooordinate springen kann. D.h. Ich habe eine Hintergrundkarte in 1:5Mio und zeige Hannover. Dann soll bei einem Wechsel auf eine 1:2Mio wieder Hannover angezeigt werden. Und (ich weiß ich verlange viel) ein Darken / Brighten des Hintergundes (NICHT DIE OBJEKTE).

Damit ihr mal seht um was es geht. Hier eine Idee des Aufbau zum geplanten Programm.

Grüße aus Friesland

exams_bs.jpg	115 kB

Kurzbeschreibung:	Proggi-Layout

Hochgeladen:	06.05.2011

Ladeanzahl:
		Herunterladen

www.L-PROG.de
Software und Homepages zu erschwinglichen Preisen

Hierin sind zwar nicht alle Probleme geklärt aber einfach mal mit Uwes Zoom und Uwes Chroma und ohne IrfanView :

'{$cleq}
'{$runtime c:\xprofan11\}
 $H commctrl.ph
 $H Windows.ph
 $H ocx3a.ph
 $I ocx3a.inc
def $appName "GMOF"
Var dataStorageDir$ = $appDataDir+$appName+"\\"
mkDir dataStorageDir$
'
ocxInit()
var GrundBild$ = @LoadFile$("Grundbild wählen:","Bilder|*.jpg;*.png")
case (Grundbild$="") or (fileExists(grundBild$)=0) : end
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~Grundbildgröße für Linien/-zug
struct HIT=x&,y&,Flags&,Item&,SubItem&
Declare Gbildx%,Gbildy%,bmp&,Hit#,Item%,Status%,s$
dim Hit#,HIT
bmp&=@Create("hPic",-1,Grundbild$)
Gbildx%=%BmpX
Gbildy%=%BmpY
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
windowStyle 1 | 2 | 8 | 16 | 512
window 1000,500
Var Font&=@Create("Font","Verdana",16,0,0,0,0)
SETDIALOGFONT Font&
var Titel$ = "x;1;40;y;1;40;Obj-x;1;60;Obj-y;1;60;LEnd-x;1;60;LEnd-x;1;60;Objekt;0;100"
var LV&   = Create("GridBox", %hwnd, Titel$, 0, 580, 10, 400, 190)
'
var zoomFac!=1.0
var zoomBut&=create("Button",%hWnd,"Zoom",580,210,80,20)
'
'var irfanExeFile$=substr$(readini$("HKEY_0","Applications\\i_view32.exe\\shell\\open\\command\\",""),2,"\q")
'case irfanExeFile$="" : irfanExeFile$="C:\\Programme\\IrfanView\\i_view32.exe"
'
AddString(LV&, "200|100|200|200|0|0|Kreis")
AddString(LV&, "100|20|80|80|0|0|nEck")
AddString(LV&, "400|200|100|200|0|0|Kreis")
' ACHTUNG !! Linien und Linienzug: MCls = Bildgröße und liegt damit auf x=0px, y=0px
' Werte für Linienzug in LEnd-x (LEnd-y) durch ; getrennt
AddString(LV&, "0|0|100|360|300|40|Linie")
AddString(LV&, "0|0|10|20|100;120;230|40;80;100|Linie")
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Bilder erstellen und als GIF speichern
' Größe = Grundbild, Pos. und Größe X und Y vorgeben
Declare i%,x%,y%,xx%,yy%,Obj$,Text$

WhileLoop @GetCount(LV&)

    x%=val(substr$(@GetString$(LV&,(&loop-1)),3,"|"))
    y%=val(substr$(@GetString$(LV&,(&loop-1)),4,"|"))
    Obj$=trim$(substr$(@GetString$(LV&,(&loop-1)),7,"|"))

    If Obj$="Linie"

        xx%=val(substr$(@GetString$(LV&,(&loop-1)),5,"|"))
        yy%=val(substr$((substr$(@GetString$(LV&,(&loop-1)),6,"|")),1,";"))
        MCls Gbildx%, Gbildy%
        StartPaint -1
        Line x%, y% - xx%,yy%
        i%=2

        While 1

            text$=(substr$((substr$(@GetString$(LV&,(&loop-1)),5,"|")),i%,";"))
            text$=text$+(substr$((substr$(@GetString$(LV&,(&loop-1)),6,"|")),i%,";"))
            case trim$(text$)="" : Break
            x%=xx%
            y%=yy%
            xx%=val(substr$((substr$(@GetString$(LV&,(&loop-1)),5,"|")),i%,";"))
            yy%=val(substr$((substr$(@GetString$(LV&,(&loop-1)),6,"|")),i%,";"))
            Line x%, y% - xx%,yy%
            inc i%

        wend

        EndPaint -1

    Else

        MCls x%, y%
        StartPaint -1
        case Obj$="nEck" : Rectangle 0,0 - x%, y%
        case Obj$="Kreis" : Ellipse 0,0 - x%, y%
        EndPaint -1

    EndIf

    bmp&=@Create("hPic",0,"&MEMBMP")
    Obj$="B"+str$(&loop)+".png"
    SavePic dataStorageDir$+Obj$, bmp&
    Obj$="B"+str$(&loop)
    'winExecWait(  irfanExeFile$+" "+dataStorageDir$+Obj$+ \
    '".png /transpcolor=(255,255,255) /convert="+dataStorageDir$+Obj$+".gif" ,1)

EndWhile

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~3. html erzeugen
assign #2,dataStorageDir$+"Grid.html"
rewrite #2
Print #2,"<HTML>"
Print #2,"<HEAD>"
Print #2,"<TITLE>Script</TITLE>"
Print #2,"<style>"
Print #2,"body,p,img,div{margin:0;padding:0;border:0;cursor:default;text-align:center}"
Print #2,"div{font-family:Verdana;font-size:10px;font-weight:normal;COLOR:#6f95c7;padding:0;filter:Chroma(color=#FFFFFF)}"
Print #2,"</style>"
Print #2,"<script type='text/javascript'>"
Print #2,"<!--"
Print #2,"var evalCode = '';"
Print #2,"function evalNow(){return eval(evalCode)};"
Print #2,"function setImgVis(i,state){document.getElementsByTagName('div')[i].style.visibility=state==1?'visible':'hidden'}"
Print #2,"function scrollToImg(i){window.scrollTo(parseInt(document.getElementsByTagName('div')[i].style.left)+parseInt(document.getElementsByTagName('div')[i].offsetWidth)*0.5-290,parseInt(document.getElementsByTagName('div')[i].style.top)+parseInt(document.getElementsByTagName('div')[i].offsetHeight)*0.5-200)}"
Print #2,"-->"
Print #2,"</script>"
Print #2,"</HEAD>"
Print #2,"<body onselectstart='return false' oncontextmenu='return false'>"
Print #2,"<div style='height:527px;width:764px;background-image:url("+fNam2URI(GrundBild$)+")'></div>"
Declare x$,y$,xx$,yy$

WhileLoop @GetCount(LV&)

    x$=(substr$(@GetString$(LV&,(&loop-1)),1,"|"))
    y$=(substr$(@GetString$(LV&,(&loop-1)),2,"|"))
    xx$=(substr$(@GetString$(LV&,(&loop-1)),3,"|"))
    yy$=(substr$(@GetString$(LV&,(&loop-1)),4,"|"))
    Obj$=trim$(substr$(@GetString$(LV&,(&loop-1)),7,"|"))
    '~~~~~~~~

    If Obj$="Linie"

        xx$=str$(Gbildx%)
        yy$=str$(Gbildy%)

    EndIf

    '~~~~~~~~~~~
    Obj$=""+dataStorageDir$+"B"+trim$(str$(&loop))+".gif"
    Print #2,"<div style='position:absolute; left:"+x$+"px; top:"+y$+ \
    "px;width:"+xx$+"px;height:"+yy$+"px;background-image:url("+fNam2URI(Obj$)+");visibility:hidden'>Objekt"+str$(&loop)+"</div>"

EndWhile

Print #2,"</body>"
Print #2,"</html>"
Close #2
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
var File$=dataStorageDir$+"Grid.html"
declare WebControl&
var WebObject&=ocxCreate(File$,%hwnd,0,0,565,430,$50000000+$200000+$100000,addr(WebControl&))
var Document&=ocxGet(WebObject&,"Document")
var Script&=ocxGet(Document&,"Script")
SetFocus(LV&)
userMessages 16
sendmessage(lv&,$1036,0,$20+$1+$4)

while 1

    waitinput
    case %umessage=16:break

    If (%wmnotify*%notifycode)=-12

        ~GetCursorPos(Hit#)
        ~ScreenToClient(lv&,Hit#)
        Item%=sendmessage(lv&,~LVM_HITTEST,0,Hit#)

        if item%>-1

            doJS("setImgVis("+str$(item%+1)+","+str$(testBit(sendMessage(lv&,~LVM_GETITEMSTATE,item%,~LVIS_STATEIMAGEMASK),13))+")")

        endIf

    endif

    if getFocus(LV&) and (GetCurSel(LV&)>-1)

        if testBit(sendMessage(lv&,~LVM_GETITEMSTATE,GetCurSel(LV&),~LVIS_STATEIMAGEMASK),13)

            doJS("scrollToImg("+str$(GetCurSel(LV&)+1)+")")

        endif

    endif

    if clicked(zoomBut&)

        s$=input$("Zoomfaktor","Zoomfaktor",str$(zoomFac!))

        if (s$="") or (val(s$)<0.1)

        else

            zoomFac!=val(s$)
            htmlBox.zoomDivs(val(s$))
            showWindow(webControl&,0)
            showWindow(webControl&,1)

        endif

    endif

endwhile

DeleteObject Font&
DeleteObject bmp&
destroywindow(WebControl&)
ocxRelease(Script&,Document&,WebObject&)
ocxDeInit()

proc fNam2URI

    parameters s$
    return "file:///"+translate$(translate$(s$,"\\","/"),"//","/")

endProc

proc doJS

    parameters s$
    ocxPut(Script&,"evalCode",s$)
    ocxMethod(Script&,"evalNow")

endProc

proc htmlBox.zoomDivs'---------------------------------------------Zoom

    parameters Faktor!'-- 1.0 = Normal
    var Collection&=ocxMethod(Document&,"getElementsByTagName","DIV")
    declare Element&,Style&

    whileloop 0,9999

        Element&=ocxMethod(Collection&,"item",&loop,0)
        casenot Element&:break
        Style&=ocxGet(Element&,"style")
        ocxPut(Style&,"zoom",Faktor!)
        ocxRelease(Style&,Element&)

    endwhile

    ocxRelease(Collection&)

endproc'---------------------------------------------------

Thomas
Freier

Das mit dem Aufhellen ist wohl so in diese Richtung gemeint:

'URL: https://xprofan.com/intl/de/forum/grafiken-mit-overlay-funktionen-an-abwaehlbar/#bottom
'{$cleq}
 $H Windows.ph
 $H commctrl.ph
 $H ocx3a.ph
 $I ocx3a.inc
def $appName "GMOF"
Var dataStorageDir$ = $appDataDir+$appName+"\\"
mkDir dataStorageDir$
'
ocxInit()
var GrundBild$ = @LoadFile$("Grundbild wählen:","Bilder|*.jpg;*.png")
case (Grundbild$="") or (fileExists(grundBild$)=0) : end
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~Grundbildgröße für Linien/-zug
struct HIT=x&,y&,Flags&,Item&,SubItem&
Declare Gbildx%,Gbildy%,bmp&,Hit#,Item%,Status%
dim Hit#,HIT
bmp&=@Create("hPic",-1,Grundbild$)
Gbildx%=%BmpX
Gbildy%=%BmpY
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
windowStyle 1 | 2 | 8 | 16 | 512
window 1000,500
Var Font&=@Create("Font","Verdana",16,0,0,0,0)
SETDIALOGFONT Font&
var Titel$ = "x;1;40;y;1;40;Obj-x;1;60;Obj-y;1;60;LEnd-x;1;60;LEnd-x;1;60;Objekt;0;100"
var LV&   = Create("GridBox", %hwnd, Titel$, 0, 580, 10, 400, 190)
'
'
AddString(LV&, "200|100|200|200|0|0|Kreis")
AddString(LV&, "100|20|80|80|0|0|nEck")
AddString(LV&, "600|200|100|200|0|0|Kreis")
' ACHTUNG !! Linien und Linienzug: MCls = Bildgröße und liegt damit auf x=0px, y=0px
' Werte für Linienzug in LEnd-x (LEnd-y) durch ; getrennt
AddString(LV&, "0|0|100|360|300|40|Linie")
AddString(LV&, "0|0|10|20|100;120;230|40;80;100|Linie")
var scroll&=@Create("HScroll",%hwnd,"",580,230,100,20)
var scrollpos&=CreateText(%hwnd,"100%",700,230,40,20)
var scroll!=50'ist Position
var scroll.o!=1.00'alte Position
SetScrollPos scroll&,scroll!
var Out&=CreateButton(%hwnd,"Gamma 2.00",580,280,100,20)
var In&=CreateButton(%hwnd,"Gamma 1.00",700,280,100,20)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Bilder erstellen und als GIF speichern
' Größe = Grundbild, Pos. und Größe X und Y vorgeben
Declare i%,x%,y%,xx%,yy%,Obj$,Text$

WhileLoop @GetCount(LV&)

    x%=val(substr$(@GetString$(LV&,(&loop-1)),3,"|"))
    y%=val(substr$(@GetString$(LV&,(&loop-1)),4,"|"))
    Obj$=trim$(substr$(@GetString$(LV&,(&loop-1)),7,"|"))

    If Obj$="Linie"

        xx%=val(substr$(@GetString$(LV&,(&loop-1)),5,"|"))
        yy%=val(substr$((substr$(@GetString$(LV&,(&loop-1)),6,"|")),1,";"))
        MCls Gbildx%,Gbildy%
        StartPaint -1
        Line x%, y% - xx%,yy%
        i%=2

        While 1

            text$=(substr$((substr$(@GetString$(LV&,(&loop-1)),5,"|")),i%,";"))
            text$=text$+(substr$((substr$(@GetString$(LV&,(&loop-1)),6,"|")),i%,";"))
            case trim$(text$)="" : Break
            x%=xx%
            y%=yy%
            xx%=val(substr$((substr$(@GetString$(LV&,(&loop-1)),5,"|")),i%,";"))
            yy%=val(substr$((substr$(@GetString$(LV&,(&loop-1)),6,"|")),i%,";"))
            Line x%, y% - xx%,yy%
            inc i%

        wend

        EndPaint -1

    Else

        MCls x%, y%
        StartPaint -1
        case Obj$="nEck" : Rectangle 0,0 - x%, y%
        case Obj$="Kreis" : Ellipse 0,0 - x%, y%
        EndPaint -1

    EndIf

    bmp&=@Create("hPic",0,"&MEMBMP")
    Obj$="B"+str$(&loop)+".png"
    SavePic dataStorageDir$+Obj$, bmp&

EndWhile

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~3. html erzeugen
assign #2,dataStorageDir$+"Grid.html"
rewrite #2
Print #2,"<HTML>"
Print #2,"<HEAD>"
Print #2,"<TITLE>Script</TITLE>"
Print #2,"<style>"
Print #2,"body{align:left},img,div{margin:0;padding:0;border:0;cursor:default;text-align:center}"
Print #2,"div{font-family:Verdana;font-size:10px;font-weight:normal;COLOR:#6f95c7;padding:0px 0px 0px 0px;}"
Print #2,"</style>"
Print #2,"<script type='text/javascript'>"
Print #2,"<!--"
Print #2,"var evalCode = '';"
Print #2,"function evalNow(){return eval(evalCode)};"
Print #2,"function setImgVis(i,state){document.getElementsByTagName('div')[i].style.visibility=state==1?'visible':'hidden'}"
Print #2,"function scrollToImg(i){window.scrollTo(parseInt(document.getElementsByTagName('div')[i].style.left)+parseInt(document.getElementsByTagName('div')[i].offsetWidth)*0.5-290,parseInt(document.getElementsByTagName('div')[i].style.top)+parseInt(document.getElementsByTagName('div')[i].offsetHeight)*0.5-200)}"
Print #2,"function pagezoom(i){ document.body.style.zoom=i;}"
Print #2,"var oc=100;"
Print #2,"function fadeOut() {"
Print #2,"image.style.filter='Alpha(opacity='+oc+', finishopacity=0, style=4)'"
Print #2,"if(oc!=60) setTimeout('oc--;fadeOut()',40);}"
Print #2,"var occ=60;"
Print #2,"function fadeIn() {"
Print #2,"image.style.filter='Alpha(opacity='+occ+', finishopacity=100, style=4)'"
Print #2,"if(occ!=100) setTimeout('occ++;fadeIn()',40);}"
Print #2,"function getScrollXY(i) {"
Print #2,"var scrOfX = 0, scrOfY = 0;"
Print #2," {"
Print #2,"        scrOfY = document.body.scrollTop;"
Print #2,"        scrOfX = document.body.scrollLeft;"
Print #2,"    }"
Print #2,"document.body.scrollTop = scrOfY*i;"
Print #2,"document.body.scrollLeft = scrOfX*i;"
Print #2,"}"
Print #2,"-->"
Print #2,"</script>"
Print #2,"</HEAD>"
Print #2,"<body onselectstart='return false' oncontextmenu='return false'>"
Print #2,"<div id='image' style='width:220;filter:Alpha(opacity=100,finishopacity=100,style=4);height:"+str$(Gbildy%)+"px;width:"+str$(Gbildx%)+"px;background-image:url("+fNam2URI(GrundBild$)+")'></div>"
Declare x$,y$,xx$,yy$
'Print #2,"alert(scrOfX+ '-' + scrOfY + ' ist eine Zahl!'); "

WhileLoop @GetCount(LV&)

    x$=(substr$(@GetString$(LV&,(&loop-1)),1,"|"))
    y$=(substr$(@GetString$(LV&,(&loop-1)),2,"|"))
    xx$=(substr$(@GetString$(LV&,(&loop-1)),3,"|"))
    yy$=(substr$(@GetString$(LV&,(&loop-1)),4,"|"))
    Obj$=trim$(substr$(@GetString$(LV&,(&loop-1)),7,"|"))
    '~~~~~~~~

    If Obj$="Linie"

        xx$=str$(Gbildx%)
        yy$=str$(Gbildy%)

    EndIf

    '~~~~~~~~~~~
    Obj$=""+dataStorageDir$+"B"+trim$(str$(&loop))+".png"
    Print #2,"<div style='filter:Chroma(color=#FFFFFF); position:absolute; left:"+x$+"px; top:"+y$+ \
    "px;width:"+xx$+"px;height:"+yy$+"px;background-image:url("+fNam2URI(Obj$)+");visibility:hidden'>Objekt"+str$(&loop)+"</div>"

EndWhile

Print #2,"</body>"
Print #2,"</html>"
Close #2
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
var File$=dataStorageDir$+"Grid.html"
declare WebControl&,    Collection&
WebObject&=ocxCreate(File$,%hwnd,0,0,565,430,$50000000+$200000+$100000,addr(WebControl&))
var Document&=ocxGet(WebObject&,"Document")
var Script&=ocxGet(Document&,"Script")
SetFocus(LV&)
userMessages 16
sendmessage(lv&,$1036,0,$20+$1+$4)
showWindow(lv&,0)
showWindow(lv&,1)
doJS("fadeOut()")
doJS("fadeIn()")

while 1

    waitinput
    case %umessage=16:break

    If getFocus(Out&)

        doJS("fadeOut()")

    ElseIf getFocus(In&)

        doJS("fadeIn()")

    ElseIf (%wmnotify*%notifycode)=-12

        ~GetCursorPos(Hit#)
        ~ScreenToClient(lv&,Hit#)
        Item%=sendmessage(lv&,~LVM_HITTEST,0,Hit#)
        doJS("setImgVis("+str$(item%+1)+","+str$(testBit(sendMessage(lv&,~LVM_GETITEMSTATE,item%,~LVIS_STATEIMAGEMASK),13))+")")

    ElseIf getFocus(LV&) and (GetCurSel(LV&)>-1)

        doJS("scrollToImg("+str$(GetCurSel(LV&)+1)+")")
        LvDeSelect LV&,GetCurSel(LV&)

    ElseIf getFocus(Scroll&)

        @Set("Decimals",2)
        scroll!=1.0 + ((@GetScrollPos(scroll&)-50)/100)
        doJS("pagezoom("+str$(scroll!)+")")
        '     Zoom scroll!
        '    scroll!= neuer Faktor
        '    scroll.o! = vorheriger Faktor
        '    kleine Korrektur je nach Zoom-Richtung ggf. erforderlich
        case scroll!>scroll.o! : doJS("getScrollXY("+str$(1.01 + scroll! - scroll.o!)+")")
        case scroll!<scroll.o! : doJS("getScrollXY("+str$(0.99 + scroll! - scroll.o!)+")")
        scroll.o!=scroll!
        Collection&=ocxMethod(Document&,"getElementsByTagName","DIV")
        ocxRelease(Collection&)
        @Set("Decimals",0)
        SetText scrollPos&,str$((@GetScrollPos(scroll&)+50))+"%"

    EndIf

endwhile

ocxRelease(Script&,Document&,WebObject&)
DeleteObject Font&
DeleteObject bmp&
destroywindow(WebControl&)
ocxDeInit()

proc fNam2URI

    parameters s$
    return "file:///"+translate$(translate$(s$,"\\","/"),"//","/")

endProc

proc doJS

    parameters s$
    ocxPut(Script&,"evalCode",s$)
    ocxMethod(Script&,"evalNow")

endProc

proc LvDeSelect'deselectieren

    parameters Lv&,Item&
    Declare s#
    dim s#,1024
    long s#,12=0
    long s#,16=~LVIS_SELECTED | ~LVIS_FOCUSED
    sendmessage(Lv&,~LVM_SETITEMSTATE,Item&,s#)
    dispose s#

endproc

proc Zoom'---------------------------------------------Zoom

    parameters Faktor!'-- 1.0 = Normal
    var Collection&=ocxMethod(Document&,"getElementsByTagName","DIV")
    declare Element&,Style&

    whileloop 0,9999

        Element&=ocxMethod(Collection&,"item",&loop,0)
        casenot Element&:break
        Style&=ocxGet(Element&,"style")
        ocxPut(Style&,"zoom",Faktor!)
        ocxRelease(Style&,Element&)

    endwhile

    ocxRelease(Collection&)

endproc'---------------------------------------------------

Aber zufrieden bin ich damit nicht.
Bei Pascals Zoom bleiben im Beispiel die Objekte Kreis und nEck nicht in den vorgegebenen Koordinaten. MCls muß dann immer die Größe des Grundbildes haben.

Gruß Thomas
Windows XP SP2, XProfan X2

Uwe
''Pascal''
Niemeier

Hi Thomas!

Stimmt! Hatte ich nicht bemerkt

Eine mögliche Lösung: Alle Bilder bekommen den Stil position:absolute und die Overlays werden vom Hauptbild eingeschlossen:

<div id='Hauptbild' style=' position:absolute; ...weitere Angaben...>
<div style='position:absolute; ...weitere Angaben...>Objekt1</div>
<div style='position:absolute; ...weitere Angaben...>Objekt2</div>
<div style='position:absolute; ...weitere Angaben...>Objekt3</div>
<div style='position:absolute; ...weitere Angaben...>Objekt4</div>
<div style='position:absolute; ...weitere Angaben...>Objekt5</div>
</div>

(Zitat aus SelfHTML: absolute = absolute Positionierung, gemessen am Rand des nächsthöheren Vorfahrenelements, das nicht die Normaleinstellung position:static aufweist.)
Dann
function pagezoom(i){ document.getElementById('HauptBild').style.zoom=i;}
oder

proc Zoom'---------------------------------------------Zoom

    parameters Faktor!
    var Element&=ocxMethod(Document&,"getElementById","Hauptbild")
    var Style&=ocxGet(Element&,"style")
    ocxPut(Style&,"zoom",Faktor!)
    ocxRelease(Style&,Element&)

endproc'---------------------------------------------------

darauf anwenden.

HTH
Pascal

07.05.2011 ▲

Thomas
Freier

Ich habe eine Hintergrundkarte in 1:5Mio und zeige Hannover. Dann soll bei einem Wechsel auf eine 1:2Mio wieder Hannover angezeigt werden.

Das sollte möglich sein.
JS mit lesen der Scrollposition und nach Zoom neue Scrollposition setzen:

Print #2,"function getScrollXY(i) {"
Print #2,"var scrOfX = 0, scrOfY = 0;"
Print #2," {"
Print #2,"        scrOfY = document.body.scrollTop;"
Print #2,"        scrOfX = document.body.scrollLeft;"
Print #2,"    }"
Print #2,"document.body.scrollTop = scrOfY*i;"
Print #2,"document.body.scrollLeft = scrOfX*i;"
Print #2,"}"

Ausgeführt, nachdem Zoom gewählt wurde.