Deutsch
Quelltexte/ Codesnippets

Bild Hook Loadfile Preview Vorschau

 
- Seite 1 -



Pedro
Santos
Hallo Roland

Wird es in XProfan10 bei Loadfile das bmps Preview dabei sein?

Gruss

Pedro
 
Windows XP Home
Xprofan 10
02.04.2006  
 



« 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 für 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 für GetOpenFileName (76 für 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
20.04.2006  
 



Hm was ist hiermit? [...] 
 
20.04.2006  
 



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

Hier ich habs mal zusammengeballert da ichs auch interessant fand:
KompilierenMarkierenSeparieren
 {$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.

629 kB
Hochgeladen:20.04.2006
Ladeanzahl119
Herunterladen
 
20.04.2006  
 



Hab den Code grad nochmal vereinfacht...
 
20.04.2006  
 



Hier eine Variante für alle Bildformate mittels GDI-Unit.
KompilierenMarkierenSeparieren
 {$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#
    Return fle$

Endproc

 
20.04.2006  
 




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.

Gruß
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
20.04.2006  
 



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 für uns zu lösen und ich muß mich in dieser Sache nicht weiter bemühen.

Gruß
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  
 



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 für 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 für GetOpenFileName (76 für 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  
 




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 für 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 für GetOpenFileName (76 für 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  
 



Zum Quelltext


Thementitel, max. 100 Zeichen.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Beitrag  Schrift  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Themenoptionen

7.225 Betrachtungen

Unbenanntvor 0 min.
Pedro Miguel17.05.2019
Sascha Haak13.01.2019
AndreasS26.12.2018
Uwe Starke11.12.2018
Mehr...

Themeninformationen



AGB  |  Chat  |  Datenschutz  |  Download  |  Eingangshalle  |  Hilfe  |  Impressum  |  Mart  |  Support  |  Suche

Ein Projekt aller XProfaner, die es gibt!


Mein XProfan
Private Nachrichten
Eigenes Ablageforum
Themen-Merkliste
Eigene Beiträge
Eigene Themen
Zwischenablage
Abmelden
 Deutsch English Français Español Italia
Übersetzungen

Datenschutz


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.


einverstandenDatenschutzerklärung
Ich möchte keinen Cookie