XProfan

Kompilieren Markieren Separieren

« Dieser Beitrag wurde als Lösung gekennzeichnet. »

Jörg
Sellmeyer

Repariert...

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

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

    parameters dlg&,msg&,wparam&,lparam&
    case Status%:return 1'-----Ansicht muss nur einmal angepasst werden
    casenot msg&=~WM_NOTIFY:return 1

    if long(lparam&,8)=-603'---Bei  Init existieren DefView und LV noch nicht!

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

    endif

    return 1
    endproc---------------------------------------------------------------------------------

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

        parameters Pfad$,Titel$,Name$
        declare ofn#,Result$,Result&
        declare DefView&,Status%'------Variablen per Hook
        Name$=Name$+"\z*.bmp;*.jpe;*.jpeg;*.jpg;*.gifzz"'--Filter (bei Bedarf anpassen)
        dim ofn#,88+256'---------------Struktur (Win2000/NT/XP) + Puffer
        clear ofn#
        long ofn#,0=88'----------------Grösse Struktur per GetOpenFileName (76 per Win9x)
        long ofn#,4=%hwnd'-------------übergeordnetes Fenster
        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$=string$(ofn#,88)
        casenot Result&:Result$=\
        procaddr("OpenFileHook",-4)
        dispose ofn#
        return Result$

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

    print 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

Hallo

Ich Frage einfach nochmal.????

Danke

Gruss

Pedro

Windows XP Home
Xprofan 10

Hm was ist hiermit? [...]

Für das Schönmachen bist aber Du zuständig.

Hier ich habs mal zusammengeballert da ichs auch interessant fand:
Kompilieren Markieren Separieren

 {$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#
    Return fle$

Endproc

Wenn Dir BMP dann doch nicht reicht dann ist es einfach mit der neuen GDI-Unit andere Bildformate zu unterstützen.

filedlghook.exe	629 kB

Hochgeladen:	20.04.2006

Downloadcounter:
		Download

Hab den Code grad nochmal vereinfacht...

Hier eine Variante per alle Bildformate mittels GDI-Unit.
Kompilieren Markieren Separieren

 {$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/return/'>Return fle$

Endproc

RGH

... und wer es ganz ohne Programmieren haben möchte, wählt im ganz normalemn Loadfile$-Dialog die Miniaturansicht* und schön werden alle von Create(hPic,...) unterstützten Formate als Vorschaubild angezeigt. Das geht zumindest unter Windows 2000 und XP.

* Im Dialog oben rechts das Icon anklicken und die entsprechende Ansicht auswählen. Das funktioniert leider nicht bei Win98 oder Win95. Wie es unter WinME aussieht, weiß ich nicht, da ich es nie benutzt habe.

Saluto
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

Hallo Roland
>>* Im Dialog oben rechts das Icon anklicken und die entsprechende Ansicht auswählen. Das funktioniert leider nicht bei Win98 oder Win95. Wie es unter WinME aussieht, weiß ich nicht, da ich es nie benutzt habe. <<

Kann Dich beruhigen: Unter ...ME klappt es auch

21.04.2006 ▲

RGH

Horst Horn

Kann Dich beruhigen: Unter ...ME klappt es auch

Ok, dann war Bill Gates also so freundlich, das Problem per uns zu lösen und ich muß mich in dieser Sache nicht weiter bemühen.

Saluto
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 Markieren Separieren

Uwe Pascal Niemeier

Hallo Leute!

Seit Win2000 wurde die OpenFileName-Struktur um 3 optionale Parameter ergänzt (siehe MSDN). Wird die Grösse der Struktur entsprechend erweitert (die drei LongInts am Ende müssen Null sein) sollte es klappen.
Hier eine Demo, um einen Dialog per Hook in der Miniatur-Ansicht zu öffnen (zwecks Bild-Auswahl):

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

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

    parameters dlg&,msg&,wparam&,lparam&
    case Status%:return 1-----Ansicht muss nur einmal angepasst werden
    casenot msg&=~WM_NOTIFY:return 1

    if long(lparam&,8)=-603---Bei  Init existieren DefView und LV noch nicht!

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

    endif

    return 1
    endproc---------------------------------------------------------------------------------

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

        parameters Pfad$,Titel$,Name$
        declare ofn#,Result$,Result&
        declare DefView&,Status%------Variablen per Hook
        Name$=Name$+z*.bmp;*.jpe;*.jpeg;*.jpg;*.gifzz--Filter (bei Bedarf anpassen)
        dim ofn#,88+256---------------Struktur (Win2000/NT/XP) + Puffer
        clear ofn#
        long ofn#,0=88----------------Grösse Struktur per GetOpenFileName (76 per Win9x)
        long ofn#,4=%hwnd-------------übergeordnetes Fenster
        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$=string$(ofn#,88)
        casenot Result&:Result$=
        procaddr(OpenFileHook,-4)
        dispose ofn#
        return Result$

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

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

HTH
Pascal

02.06.2006 ▲