XProfan

Kompilieren Marca Separación

« Dieser Contribución wurde como Solución gekennzeichnet. »

Jörg
Sellmeyer

Repariert...

window 10,10-700,500
 $H Messages.ph
 $H Windows.ph

proc OpenFileHook'-------------------------------OpenFileHook----------------------------

    parámetros dlg&,msg&,wparam&,lparam&
    caso Status%:volver 1'-----Ansicht muss sólo una vez adaptado voluntad
    casenot msg&=~WM_NOTIFY:volver 1

    if long(lparam&,8)=-603'---En  Init existieren DefView y LV todavía no!

        Status%=1
        DefView&=~FindWindowEx(~GetParent(dlg&),0,"SHELLDLL_DefView","")
        sendmessage(DefView&,~WM_COMMAND,$702D,0)'--Undokumentierte Message

    endif

    volver 1
    ENDPROC---------------------------------------------------------------------------------

    proc LoadPicDialog'------------------------------LoadPicDialog---------------------------

        parámetros Pfad$,Titel$,Name$
        declarar ofn#,Result$,Result&
        declarar DefView&,Status%'------Variables para Hook
        Name$=Name$+"\z*.bmp;*.jpe;*.jpeg;*.jpg;*.gifzz"'--Filter (en Bedarf adaptar)
        dim ofn#,88+256'---------------Struktur (Win2000/NT/XP) + Puffer
        clear ofn#
        long ofn#,0=88'----------------Grösse Struktur para GetOpenFileName (76 para Win9x)
        long ofn#,4=%hwnd'-------------übergeordnetes Ventana
        long ofn#,12=addr(Name$)'------Filter/Typ
        long ofn#,28=ofn#+88'----------Beginn Puffer
        long ofn#,32=255'--------------Puffergrösse
        long ofn#,44=addr(Pfad$)'------Anfangspfad
        long ofn#,48=addr(Titel$)'-----Titel
        long ofn#,52=$880024'----------Flags
        long ofn#,68=procaddr(OpenFileHook,4)
        Result&=external("COMDLG32","GetOpenFileNameA",ofn#)
        Result$=cadena$(ofn#,88)
        casenot Result&:Result$=\
        procaddr("OpenFileHook",-4)
        disponer ofn#
        volver Result$

    ENDPROC'---------------------------------------------------------------------------------

    imprimir LoadPicDialog("","Bitte Bild wählen","Bild")
    waitkey

XProfan X4
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

01.07.2018 ▲

Pedro
Santos

¡Hola

Yo Cuestión simplemente otra vez.????

Gracias

Gruss

Pedro

Windows XP Home
Xprofan 10

Hm qué es hiermit? [...]

Für el Schönmachen bist aber Usted zuständig.

Hier Yo habs veces zusammengeballert como ego auch interessant fand:
Kompilieren Marca Separación

 {$cleq}
seterrorlevel -1
set(Fastmode,1)
Def GetOpenFileName(1) ! COMDLG32, GetOpenFileNameA
Def CommDlgExtendedError(0) ! COMDLG32, CommDlgExtendedError
Def Mm(3) !KERNEL32, RtlMoveMemory
declare h&,dc&,xx&,yy&,bwidth&,__mem#,preview.lastImg$
dim __mem#,12//(long)hwnd, id, code
clear __mem#
bwidth&=external(USER32,GetSystemMetrics,7)// borderwidth
print Multiloadfile()
dispose __mem#
waitkey
end

proc hook

    parameters _hWnd&,_Msg&,_wparam&,_lparam&

    if _msg&==272//init

        h&=external(USER32,GetParent,_hWnd&)
        dc&=external(USER32,GetDC,h&)
        xx&=width(h&)
        yy&=height(h&)
        external(USER32,SetWindowPos,h&,0,0,0,xx&+bwidth&+220,yy&+bwidth&,20)
        _wparam&=createblackframe(h&,,xx&+10,0,1,yy&)

    elseif _msg&==2//kill

    elseif _msg&==78//notify -602

        declare l&
        l&=addr(__mem#)
        mm(l&,_lparam&,12)

        if long(__mem#,8)==-602

            preview getfname(1125,h&)

        endif

    endif

    return _msg&

endproc

proc preview

    parameters fle$
    case instr(*,fle$) : return

    if fileexists(fle$)

        fle$=lower$(fle$)

        if right$(fle$,4)==.bmp

            if (preview.lastImg$<>fle$)

                preview.lastImg$=fle$
                startpaint h&
                loadsizedbmp fle$,xx&+20,5 - 190,(yy&-15-%cycaption);0
                endpaint

            endif

        endif

        settext h&,Öffnen von q+fle$+q

    elseif direxists(fle$)

        settext h&,Öffnen von q+fle$+q

    endif

endproc

proc getfname

    parameters msg&,h&
    declare s$
    s$=space$(260)
    sendmessage(h&,msg&,260,addr(s$))
    return trim$(s$)

endproc

Proc Multiloadfile

    Parameters title$,fmask$,drive$
    Declare mem#,fle$
    Dim mem#,8100
    fmask$=Bitmap-Dateien (*.bmp)z*.bmpzz
    Clear mem#
    Long mem#,0=76
    Long mem#,4=Getactivewindow()
    Long mem#,8=%Hinstance
    Long mem#,12=Addr(fmask$)
    Long mem#,28=mem#+100
    Long mem#,32=8000
    Long mem#,44=Addr(drive$)
    Long mem#,48=Addr(title$)
    Long mem#,52=( 4 | 2 | 32 | 524288 )
    Long mem#,68=procaddr(hook,4)
    Getopenfilename(mem#)

    if Commdlgextendederror()

        Dispose mem#
        return 0

    endif

    fle$=String$(mem#,100)
    Dispose mem#
    Volver fle$

ENDPROC

Wenn Usted BMP entonces doch no reicht entonces lo simplemente con el neuen GDI-Unit otro Bildformate a unterstützen.

filedlghook.exe	629 kB

Hochgeladen:	20.04.2006

Ladeanzahl:
		Descargar

Hab el código grad otra vez vereinfacht...

Hier una Variante para todos Bildformate mittels GDI-Unit.
Kompilieren Marca Separación

 {$cleq}
 $I gdi.inc
seterrorlevel -1
set(Fastmode,1)
Def GetOpenFileName(1) ! COMDLG32, GetOpenFileNameA
Def CommDlgExtendedError(0) ! COMDLG32, CommDlgExtendedError
Def Mm(3) !KERNEL32, RtlMoveMemory
declare h&,dc&,xx&,yy&,bwidth&,__mem#,preview.lastImg$
declare gdiLoadableExtensions$
gdiLoadableExtensions$:=.bmp.dib.rle.jpg.jpeg.jpe.jfif.exif.gif.png.tiff.tif.wmf.emf.ico.
dim __mem#,12//(long)hwnd, id, code
clear __mem#
cls
bwidth&:=external(USER32,GetSystemMetrics,7)// borderwidth
gdi.init
print Multiloadfile()
gdi.kill
dispose __mem#
waitkey
end

proc hook

    parameters _hWnd&,_Msg&,_wparam&,_lparam&

    if _msg&==272//init

        h&:=external(USER32,GetParent,_hWnd&)
        dc&:=external(USER32,GetDC,h&)
        xx&:=width(h&)
        yy&:=height(h&)
        external(USER32,SetWindowPos,h&,0,0,0,xx&+bwidth&+220,yy&+bwidth&,20)
        _wparam&:=createblackframe(h&,,xx&+10,0,1,yy&)

    elseif _msg&==2//kill

    elseif _msg&==78//notify -602

        declare l&
        l&:=addr(__mem#)
        mm(l&,_lparam&,12)

        if long(__mem#,8)==-602

            preview getfname(1125,h&)

        endif

    endif

    return _msg&

endproc

proc preview

    parameters fle$
    case instr(*,fle$) : return

    if fileexists(fle$)

        fle$:=lower$(fle$)

        if instr(.+right$(fle$,3)+.,gdiLoadableExtensions$)

            if (preview.lastImg$<>fle$)

                preview.lastImg$:=fle$
                declare pic&
                pic&:=gdi.loadimage(fle$)
                preview.bg
                gdi.startpaint dc&
                gdi.drawsizedimage pic&,xx&+21,6,188,(yy&-17-%cycaption)
                gdi.endpaint
                gdi.deleteimage pic&

            endif

        endif

        settext h&,Öffnen von q+fle$+q

    elseif direxists(fle$)

        settext h&,Öffnen von q+fle$+q

    endif

endproc

proc preview.bg

    startpaint h&
    usepen 0,0,0
    usebrush 1,$00FFFFFF
    rectangle xx&+20,5 - xx&+210,yy&-10-%cycaption
    endpaint

endproc

proc getfname

    parameters msg&,h&
    declare s$
    s$:=space$(260)
    sendmessage(h&,msg&,260,addr(s$))
    return trim$(s$)

endproc

Proc Multiloadfile

    Parameters title$,fmask$,drive$
    Declare mem#,fle$
    Dim mem#,8100
    fmask$=Bild-Dateien (*+translate$(.+trim$(translate$(gdiLoadableExtensions$,., )), ,;*.)+)z*+translate$(.+trim$(translate$(gdiLoadableExtensions$,., )), ,;*.)+zz
    Clear mem#
    Long mem#,0=76
    Long mem#,4=Getactivewindow()
    Long mem#,8=%Hinstance
    Long mem#,12=Addr(fmask$)
    Long mem#,28=mem#+100
    Long mem#,32=8000
    Long mem#,44=Addr(drive$)
    Long mem#,48=Addr(title$)
    Long mem#,52=( 4 | 2 | 32 | 524288 )
    Long mem#,68=procaddr(hook,4)
    Getopenfilename(mem#)

    if Commdlgextendederror()

        Dispose mem#
        return 0

    endif

    fle$=String$(mem#,100)
    Dispose mem#
    ./../function-references/XProfan/volver/'>Volver fle$

ENDPROC

RGH

... y wer lo bastante sin Programmieren haben möchte, wählt en el bastante normalemn Loadfile$-Diálogo el Miniaturansicht* y schön voluntad todos de Crear(hPic,...) unterstützten Formate como Vorschaubild adecuado. Es zumindest bajo Windows 2000 y XP.

* Im Diálogo oben rechts el Icon anklicken y el entsprechende Ansicht auswählen. Das funktioniert por desgracia, no en Win98 oder Win95. Como lo bajo WinME aussieht, weiß Yo no, como Yo nie benutzt habe.

Saludo
Roland

Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4

Hola Roland
>>* Im Diálogo oben rechts el Icon anklicken y el entsprechende Ansicht auswählen. Das funktioniert por desgracia, no en Win98 oder Win95. Como lo bajo WinME aussieht, weiß Yo no, como Yo nie benutzt habe. <<

Kann Usted beruhigen: Bajo ...ME klappt lo auch

21.04.2006 ▲

RGH

Horst Horn

Kann Usted beruhigen: Bajo ...ME klappt lo auch

Ok, entonces war Bill Gates also así freundlich, el problema para uns a lösen y yo muß mich en dieser Sache no más bemühen.

Saludo
Roland

Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4

22.04.2006 ▲

Kompilieren Marca Separación

Uwe Pascal Niemeier

¡Hola Personas!

Seit Win2000 wurde el OpenFileName-Struktur en 3 optionale Parámetro ergänzt (siehe MSDN). Wird el Grösse el Struktur entsprechend erweitert (el drei LongInts al Ende necesario Null ser) debería lo klappen.
Hier una Demo, en una Diálogo por Hook en el Miniatur-Ansicht a abierto (zwecks Bild-Auswahl):

window 10,10-700,500
 $H Messages.ph
 $H Windows.ph

proc OpenFileHook-------------------------------OpenFileHook----------------------------

    parámetros dlg&,msg&,wparam&,lparam&
    caso Status%:volver 1-----Ansicht muss sólo una vez adaptado voluntad
    casenot msg&=~WM_NOTIFY:volver 1

    if long(lparam&,8)=-603---En  Init existieren DefView y LV todavía no!

        Status%=1
        DefView&=~FindWindowEx(~GetParent(dlg&),0,SHELLDLL_DefView,)
        sendmessage(DefView&,~WM_COMMAND,$702D,0)--Undokumentierte Message

    endif

    volver 1
    ENDPROC---------------------------------------------------------------------------------

    proc LoadPicDialog------------------------------LoadPicDialog---------------------------

        parámetros Pfad$,Titel$,Name$
        declarar ofn#,Result$,Result&
        declarar DefView&,Status%------Variables para Hook
        Name$=Name$+z*.bmp;*.jpe;*.jpeg;*.jpg;*.gifzz--Filter (en Bedarf adaptar)
        dim ofn#,88+256---------------Struktur (Win2000/NT/XP) + Puffer
        clear ofn#
        long ofn#,0=88----------------Grösse Struktur para GetOpenFileName (76 para Win9x)
        long ofn#,4=%hwnd-------------übergeordnetes Ventana
        long ofn#,12=addr(Name$)------Filter/Typ
        long ofn#,28=ofn#+88----------Beginn Puffer
        long ofn#,32=255--------------Puffergrösse
        long ofn#,44=addr(Pfad$)------Anfangspfad
        long ofn#,48=addr(Titel$)-----Titel
        long ofn#,52=$880024----------Flags
        long ofn#,68=procaddr(OpenFileHook,4)
        Result&=external(COMDLG32,GetOpenFileNameA,ofn#)
        Result$=cadena$(ofn#,88)
        casenot Result&:Result$=
        procaddr(OpenFileHook,-4)
        disponer ofn#
        volver Result$

    ENDPROC'---------------------------------------------------------------------------------

    imprimir LoadPicDialog(,Bitte Bild wählen,Bild)
    waitkey

HTH
Pascal

02.06.2006 ▲