(1.086)  Login

English
Source / code snippets

Hyperlinks Messagebox option

 
Andreas Miethe, URL=www.paules-pc-forum.de/forum/special/123967-messagebox-with-option.html#mail754182, ZEITPUNKT=26.12.2009
Messagebox with option
an small Spielerei with of/ one Messagebox and one Hook.
Perhaps kanns Yes someone use.
CompileMarkSeparation
 $H windows.ph
 $H Messages.ph
#############################
Messagebox-Konstanten
DEF &IDOK         1
DEF &IDCANCEL     2
DEF &IDABORT      3
DEF &IDRETRY      4
DEF &IDIGNORE     5
DEF &IDYES        6
DEF &IDNO         7
DEF &IDICON      20
DEF &IDPROMPT $FFFF
DEF &IDSTATIC $CAFE
#############################
Struct CWPSTRUCT = lParam&,wParam&,message&,hwnd&
Struct Rect = left&,top&,right&,bottom&
Declare Hook&,OldProc&
Declare B&,B1&

Proc MB

    Parameters wnd&,msg&,wparam&,lparam&
    Declare Result&

    select msg&

        Caseof ~WM_INITDIALOG

        Var Rect# = New(Rect)
        ~GetWindowRect(wnd&,Rect#)
        ~Movewindow(wnd&,Rect#.left&,rect#.top&,width(wnd&)+12,Height(wnd&)+40,1)
        B& = Create("CheckBox",wnd&,"Diese Message not again anzeigen",0,height(wnd&)-18,width(wnd&),18)
        SendMessage(B&,~WM_SETFONT,~GetStockObject(~ANSI_VAR_FONT),1)
        SendMessage(~GetDlgItem(wnd&,&IDICON),~STM_SETIMAGE,~IMAGE_ICON,~LoadIcon(%hInstance,"EIMER"))
        Result& = 1

        Caseof ~WM_COMMAND

        If lparam& = b&

            If Getcheck(B&)

                B1& = 1

            Endif

        Endif

        Caseof ~WM_NCDESTROY

        ~UnhookWindowsHookEx(Hook&)
        Result& = 1

    Endselect

    Result& = ~CallWindowProc(OldProc&,wnd&,msg&,wparam&,lparam&)
    Return Result&

Endproc

Proc SetHook

    Parameters nCode&, wParam&, lParam&

    Select nCode&

        Caseof ~HC_ACTION

        Var pw# = New(CWPSTRUCT)
        pw# = lparam&

        If pw#.message& = ~WM_INITDIALOG

            OldProc& = ~SetWindowlong(pw#.hwnd&,~GWL_WNDPROC,ProcAddr("MB",4))

        Endif

    EndSelect

    Return ~CallNextHookEx(Hook&, nCode&, wParam&, lParam&)

ENDPROC

Proc PRF_Messagebox

    Set("Fastmode",1)
    Parameters  body$, title$, flags&
    Declare Result&
    Flags& = Flags& | ~MB_ICONQUESTION
    Hook& = ~SetWindowsHookEx(~WH_CALLWNDPROC, ProcAddr("SetHook",3), 0,~GetCurrentThreadId())
    Result& = MessageBox(title$,body$, flags&)
    Set("Fastmode",0)
    Return Result&

ENDPROC

cls
Print PRF_Messagebox("Titel","Wirklich delete ? ",~MB_YESNO)
Print IF(B1&=1,"Nicht again anzeigen","wieder anzeigen")
Waitinput

greeting
Andreas


too very beautiful with Hyperlinks:  [...] 

Andreas Miethe, Beitrag=55999, Zeitpunkt=06.02.2010
Per Hook goes a crowd
CompileMarkSeparation
 $H windows.ph
 $H Messages.ph
Struct CWPSTRUCT = lParam&,wParam&,message&,hwnd&
Struct Rect = left&,top&,right&,bottom&
#############################
Messagebox-Konstanten
DEF &IDOK         1
DEF &IDCANCEL     2
DEF &IDABORT      3
DEF &IDRETRY      4
DEF &IDIGNORE     5
DEF &IDYES        6
DEF &IDNO         7
DEF &IDHELP       9
DEF &IDTRYAGAIN  10
DEF &IDCONTINUE  11
DEF &IDICON      20
DEF &IDPROMPT $FFFF
DEF &IDSTATIC $CAFE
#############################

Proc MB

    Parameters wnd&,msg&,wparam&,lparam&
    Declare Result&,W&,H&,b&
    Result& = ~CallWindowProc(OldProc&,wnd&,msg&,wparam&,lparam&)

    select msg&

        Caseof ~WM_INITDIALOG

        Var SRect# = New(Rect)
        ~GetWindowRect(wnd&,SRect#)
        dialog vergrössern and Center
        W& = SRect#.right& - SRect#.left&
        H& = SRect#.bottom& -SRect#.top& + 40
        ~Movewindow(wnd&,((%maxx/2)-(W&/2)),((%maxy/2)-(H&/2)),W&,H&,1)
        positions the Controls 40 Pixel to untern verchieben
        ~Getwindowrect(~GetDlgItem(wnd&,&IDSTATIC),SRect#)
        ~Mapwindowpoints(0,wnd&,SRect#,2)
        ~Movewindow(~GetDlgItem(wnd&,&IDSTATIC),0,SRect#.Top&+40,SRect#.Right&,SRect#.Bottom&,1)

        Whileloop 1,11

            If ~IsWindow(~GetDlgItem(wnd&,&Loop))

                ~Getwindowrect(~GetDlgItem(wnd&,&Loop),SRect#)
                ~Mapwindowpoints(0,wnd&,SRect#,2)
                ~Setwindowpos(~GetDlgItem(wnd&,&Loop),0,SRect#.Left&,SRect#.Top&+40,0,0,~SWP_NOSIZE | ~SWP_NOZORDER)

            Endif

        Endwhile

        position of PROMPT fetch
        ~Getwindowrect(~GetDlgItem(wnd&,&IDPROMPT),SRect#)
        ~Mapwindowpoints(0,wnd&,SRect#,2)
        LINKS under PROMPT lay out
        Link& = Control("SysLink","<a>Besuch my Homepage</a>",$50000000,SRect#.Left&,SRect#.Bottom&+10,width(wnd&),18,wnd&,4000,0,0)
        SendMessage(Link&,~WM_SETFONT,~GetStockObject(~ANSI_VAR_FONT),1)
        Mail& = Control("SysLink","<a>Schick me Mail</a>",$50000000,SRect#.Left&,SRect#.Bottom&+30,width(wnd&),18,wnd&,4001,0,0)
        SendMessage(Mail&,~WM_SETFONT,~GetStockObject(~ANSI_VAR_FONT),1)
        Dispose SRect#
        Result& = 1

        Caseof ~WM_NOTIFY

        Link inquire

        If (Long(lparam&,8) = -2) and (Long(lParam&,0) = LINK&)

            ShellExec("https://www.ampsoft.eu","open",~SW_SHOWNORMAL)

        endif

        If (Long(lparam&,8) = -2) and (Long(lParam&,0) = Mail&)

            ShellExec("Mailto://","open",~SW_SHOWNORMAL)

        endif

        Result& = 1

        Caseof ~WM_NCDESTROY

        ~UnhookWindowsHookEx(Hook&)
        Result& = 1

    Endselect

    Return Result&

Endproc

Proc SetHook

    Parameters nCode&, wParam&, lParam&

    Select nCode&

        Caseof ~HC_ACTION

        Var pw# = New(CWPSTRUCT)
        pw# = lparam&

        If pw#.message& = ~WM_INITDIALOG

            OldProc& = ~SetWindowlong(pw#.hwnd&,~GWL_WNDPROC,ProcAddr("MB",4))
            Dispose pw#

        Endif

    EndSelect

    Return ~CallNextHookEx(Hook&, nCode&, wParam&, lParam&)

ENDPROC

Proc PRF_Messagebox

    Set("Fastmode",1)
    Parameters  body$, title$, flags&
    Declare Result&
    Hook& = ~SetWindowsHookEx(~WH_CALLWNDPROC, ProcAddr("SetHook",3), 0,~GetCurrentThreadId())
    Result& = MessageBox(title$,body$, flags&)
    Set("Fastmode",0)
    Return Result&

ENDPROC

here GEHTS go
Declare Hook&,OldProc&
Declare LINK&,Mail&
cls
Print PRF_Messagebox("Eine question...","Wirklich delete ?",~MB_YESNOCANCEL | ~MB_DEFBUTTON2 | ~MB_ICONQUESTION | ~MB_APPLMODAL)
Waitinput
 
12/27/09  ▲
 



EndProcedure in the code changed in ENDPROC.


4 kB
Hochgeladen:12/27/09
Downloadcounter: 92
Download
 
12/27/09  ▲
 




Dietmar
Horn
Have I already to hours same in the XProfan-manager and of my Quellcodeammlung gebunkert, so a such "Perle" the general public not verlorengeht ...
 
Multimedia für Jugendliche und junge Erwachsene - MMJ Hoyerswerda e.V.  [...] 

Windows 95 bis Windows 7
Profan² 6.6 bis XProfan X2 mit XPSE

Das große XProfan-Lehrbuch:  [...] 
12/27/09  ▲
 




H.Brill
iF: EndProcedure in the code changed in ENDPROC.

Programmierste stereo -> PureBasic + XProfan ?
hopefully comes there not sometime time one Mischmasch
out, whom none More compilieren can.
 
Benutze XPROFAN X3 + FREEPROFAN
Wir sind die XProfaner.
Sie werden von uns assimiliert.
Widerstand ist zwecklos!
Wir werden alle ihre Funktionen und Algorithmen den unseren hinzufügen.

Was die Borg können, können wir schon lange.
12/27/09  ▲
 




Andreas
Miethe

H.Brill, Beitrag=55597, Zeitpunkt=27.12.2009
iF: EndProcedure in the code changed in ENDPROC.

Programmierste stereo -> PureBasic + XProfan ?


stereo ???

Delphi,Java,C,VB etc.usf.

there must one already pay attention, that one not confusion comes
 
Gruss
Andreas
________ ________ ________ ________ _
Profan 3.3 - XProfanX2
Win 95,98,ME,2000,XP,Vista - Win 7 32 / 64 Bit
ASUS X93S - Intel Core I7-NVIDIA GForce 540M 8GB Arbeitsspeicher
Homepage :  [...] 
12/27/09  ▲
 




Jörg
Sellmeyer
H.Brill, Beitrag=55597, Zeitpunkt=27.12.2009
iF: EndProcedure in the code changed in ENDPROC.

Programmierste stereo -> PureBasic + XProfan ?
hopefully comes there not sometime time one Mischmasch
out, whom none More compilieren reading can.


there's iF but already long arrived
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
12/27/09  ▲
 




Andreas
Miethe

here another bunteres example with Timer for automatisches close.
CompileMarkSeparation
 $H Windows.ph
 $H Messages.ph
#############################
Messagebox-Konstanten
DEF &IDOK         1
DEF &IDCANCEL     2
DEF &IDABORT      3
DEF &IDRETRY      4
DEF &IDIGNORE     5
DEF &IDYES        6
DEF &IDNO         7
DEF &IDICON      20
DEF &IDPROMPT $FFFF
DEF &IDSTATIC $CAFE
#############################
Struct CWPSTRUCT = lParam&,wParam&,message&,hwnd&
Struct Rect = left&,top&,right&,bottom&
Struct PAINTSTRUCT = hdc&,fErase&,rcPaint!Rect,fRestore&,fIncUpdate&,rgbReserved#(32)

Proc Disablexptheme

    Var Ux& = ImportDll("UxTheme.dll","")
    Parameters Wnd&
    Declare Word#
    Dim Word#,2

    If UX&

        Setwindowtheme(Wnd&, Word#, Word#)

    Endif

    Dispose Word#
    FreeDll UX&

Endproc

Proc ShadowProc

    Parameters wnd&,lparam&

    If (~GetDlgCtrlID(wnd&) >= &IDOK) AND (~GetDlgCtrlID(wnd&) <= &IDNO)

        Disablexptheme(wnd&)
        Declare x&,y&,w&,h&,Brush&,Pen&,OldBrush&,OldPen&
        Var Rect# = New(Rect)
        Brush& = ~GetStockObject(~BLACK_BRUSH)
        Pen&   = ~GetStockObject(~NULL_PEN)
        ~GetClientRect(wnd&,Rect#)
        ~MapWindowpoints(wnd&,~GetParent(wnd&),Rect#,2)
        x& = Rect#.left&+6
        y& = Rect#.top&+6
        w& = x&+(Rect#.right&-Rect#.left&)
        h& = y&+(Rect#.bottom&-Rect#.top&)
        OldBrush& = ~SelectObject(lParam&,Brush&)
        OldPen&   = ~SelectObject(lParam&,Pen&)
        ~Rectangle(lParam&,x&,y&,w&,h&)
        ~SelectObject(lParam&,OldBrush&)
        ~SelectObject(lParam&,OldPen&)
        ~DeleteObject(Brush&)
        ~DeleteObject(Pen&)

    EndIf

    Return 1

EndProc

Proc MB

    Parameters wnd&,msg&,wparam&,lparam&
    Declare Result&,W&,H&

    select msg&

        Caseof ~WM_INITDIALOG

        Var DC& = ~GetDC(wnd&)
        Var Rect# = New(Rect)
        Var icon& = SendMessage(~GetDlgItem(wnd&,&IDICON),~STM_GETICON,0,0)
        ~GetWindowRect(wnd&,Rect#)
        Dialog vergrössern und zentrieren
        W& = Rect#.right& - Rect#.left& + 20
        H& = Rect#.bottom& -Rect#.top& + 30
        ~Movewindow(wnd&,((%maxx/2)-(W&/2)),((%maxy/2)-(H&/2)),W&,H&,1)
        Static-Control, auf dem die Buttons liegen, anpassen
        ~GetClientRect(~GetDlgItem(wnd&,&IDSTATIC),Rect#)
        ~MapWindowpoints(~GetDlgItem(wnd&,&IDSTATIC),wnd&,Rect#,2)
        ~Movewindow(~GetDlgItem(wnd&,&IDSTATIC),Rect#.left&,Rect#.top&,w&,44,1)
        Dispose Rect#
        Bitmap für Hintergrund anlegen
        Pic& = Create("hNewPic",w&,h&,$FFFFFF)
        Farbverlauf ins Bitmap
        Startpaint Pic&
        GradientRect(%hdc,0,0,w&,h&,$8000,$FF,0)
        ~DrawiconEx(%hdc,20,20,Icon&,32,32,0,0,$3)

        If D&

            TextColor $FFFF,$FF
            Drawtext width(wnd&)-24,Height(wnd&)-20,Format$("%3.0f",D&)

        Endif

        EndPaint
        Brush& = ~CreatePatternBrush(Pic&)
        Bitmap für Static anlegen
        ein Static-Control ist erst ab Vista vorhanden !
        Pic1& = Create("hNewPic",w&,44,$0)
        Farbverlauf ins Bitmap
        Startpaint Pic1&
        GradientRect(%hdc,0,0,w&/2,44,$FF,$8000,0)
        GradientRect(%hdc,w&/2,0,w&,44,$8000,$FF,0)
        EndPaint
        Brush1& = ~CreatePatternBrush(Pic1&)
        B& = Create("CheckBox",wnd&,"Diese Meldung nicht wieder anzeigen",0,height(wnd&)-20,width(wnd&),18)
        Disablexptheme(B&)
        SendMessage(B&,~WM_SETFONT,~GetStockObject(~ANSI_VAR_FONT),1)
        ShowWindow(~GetDlgItem(wnd&,&IDICON),0)
        Result& = 1

        Caseof ~WM_PAINT

        Var ps# = New(PAINTSTRUCT)
        ~BeginPaint(wnd&,ps#)
        ~EnumChildWindows(wnd&,ProcAddr("ShadowProc",2),ps#.hdc&)
        ~EndPaint(wnd&,ps#)
        Dispose ps#

        Caseof ~WM_CTLCOLORSTATIC

        If lParam& = ~GetDlgItem(wnd&,&IDSTATIC)

            Return Brush1&

        else

            ~SetTextColor(wParam&,$FFFF)
            ~SetBkMode(wparam&,~Transparent)
            Return ~GetStockObject(~NULL_BRUSH)

        Endif

        Caseof ~WM_CTLCOLORDLG

        ~SetBkMode(wparam&,~Transparent)
        Return Brush&

        Caseof ~WM_CTLCOLORBTN

        ~SetBkMode(wparam&,~Transparent)
        Return ~GetStockObject(~NULL_BRUSH)

        Caseof ~WM_TIMER

        Dec D&
        Startpaint wnd&
        TextColor $FFFF,$FF
        Drawtext width(wnd&)-24,Height(wnd&)-20,Space$(10)
        Drawtext width(wnd&)-24,Height(wnd&)-20,Format$("%3.0f",D&)
        Endpaint

        If D& = 0

            sendmessage(wnd&,~wm_close,0,0)

        endif

        Return 0

        Caseof ~WM_COMMAND

        If lparam& = b&

            If Getcheck(B&)

                B1& = 1

            Endif

        Endif

        Result& = 1

        Caseof ~WM_NCDESTROY

        ~Killtimer(wnd&,1)
        ~DeleteObject(Brush&)
        ~DeleteObject(Pic&)
        ~DeleteObject(Brush1&)
        ~DeleteObject(Pic1&)
        ~UnhookWindowsHookEx(Hook&)
        Result& = 1

    Endselect

    Result& = ~CallWindowProc(OldProc&,wnd&,msg&,wparam&,lparam&)
    Return Result&

Endproc

Proc SetHook

    Parameters nCode&, wParam&, lParam&

    Select nCode&

        Caseof ~HC_ACTION

        Var pw# = New(CWPSTRUCT)
        pw# = lparam&

        If pw#.message& = ~WM_INITDIALOG

            If D& : ~Settimer(pw#.hwnd&,1,1000,0):Endif

                OldProc& = ~SetWindowlong(pw#.hwnd&,~GWL_WNDPROC,ProcAddr("MB",4))
                Dispose pw#

            Endif

        EndSelect

        Return ~CallNextHookEx(Hook&, nCode&, wParam&, lParam&)

    EndProc

    Proc PRF_Messagebox

        Set("Fastmode",1)
        Parameters  body$, title$, flags&
        Declare Result&
        Flags& = Flags& | ~MB_ICONQUESTION
        Hook& = ~SetWindowsHookEx(~WH_CALLWNDPROC, ProcAddr("SetHook",3), 0,~GetCurrentThreadId())
        Result& = MessageBox(title$,body$, flags&)
        Set("Fastmode",0)
        Return Result&

    EndProc

    Proc GradientRect

        Parameters DC&,x%,y%,w%,h%,Color1&,Color2&,HV&
        Declare GradRect#,Trivertex#
        Dim GradRect#,8
        Dim Trivertex#,32
        Long Gradrect#,0 = 0,1
        Long Trivertex#,0 =x%,y%
        word Trivertex#,8=GETRVALUE(Color1&) << 8,GETGVALUE(Color1&) << 8,GETBVALUE(Color1&) << 8,0
        Long Trivertex#,16=w%,h%
        word Trivertex#,24=GETRVALUE(Color2&) << 8,GETGVALUE(Color2&) << 8,GETBVALUE(Color2&) << 8,0
        External("Msimg32.dll","GradientFill",DC&,Trivertex#,2,Gradrect#,1,HV&)
        Dispose Trivertex#
        Dispose Gradrect#

    EndProc

    Hier gehts los
    Declare Hook&,OldProc&
    Declare B&,B1&
    Declare X&,T&,Brush&,Pic&,Brush1&,Pic1&
    Declare D&
    TIMER auf 15 Sekunden setzen
    D& = 15
    Wenn D& = 0, dann kein Timer
    Nach 15 Sekunden verschwindet die Box automatisch
    cls
    Print PRF_Messagebox("Eine Frage...","Wirklich löschen ?",~MB_YESNOCANCEL | ~MB_ICONQUESTION)
    Print IF(
>B1&=1,"Nicht again anzeigen","wieder anzeigen") Waitinput

8 kB
Kurzbeschreibung: VISTA
Hochgeladen:12/27/09
Downloadcounter: 122
Download
6 kB
Kurzbeschreibung: XP
Hochgeladen:12/27/09
Downloadcounter: 112
Download
 
Gruss
Andreas
________ ________ ________ ________ _
Profan 3.3 - XProfanX2
Win 95,98,ME,2000,XP,Vista - Win 7 32 / 64 Bit
ASUS X93S - Intel Core I7-NVIDIA GForce 540M 8GB Arbeitsspeicher
Homepage :  [...] 
12/27/09  ▲
 




Jörg
Sellmeyer
Very beautiful! by me becomes though, instead of the Textes in the Checkbox, only one schwarzer beam displayed.
is really your ~DeleteObject() something other as the profane or could one too simply DeleteObject h& use?
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
12/27/09  ▲
 




Andreas
Miethe

Jörg Sellmeyer, Beitrag=55605, Zeitpunkt=27.12.2009
Very beautiful! by me becomes though, instead of the Textes in the Checkbox, only one schwarzer beam displayed.
is really your ~DeleteObject() something other as the profane or could one too simply DeleteObject h& use?


Related to the black beam understand I do not, I habs Yes extra XP tested and fotografiert.

~DeleteObject() or profanes DeleteObject is well the same.
 
Gruss
Andreas
________ ________ ________ ________ _
Profan 3.3 - XProfanX2
Win 95,98,ME,2000,XP,Vista - Win 7 32 / 64 Bit
ASUS X93S - Intel Core I7-NVIDIA GForce 540M 8GB Arbeitsspeicher
Homepage :  [...] 
12/27/09  ▲
 



H.Brill, Beitrag=55597, Zeitpunkt=27.12.2009
iF: EndProcedure in the code changed in ENDPROC.

Programmierste stereo -> PureBasic + XProfan ?


So I Have no PB and custom too keins in order to know, that EndProcedure well one ENDPROC had go should. ^^
 
12/27/09  ▲
 




Frank
Abbing
whom black beam can I confirm.
 
12/27/09  ▲
 




Jörg
Sellmeyer
so sees the then from:


mb.jpg  
10 kB
Hochgeladen:12/27/09
Downloadcounter: 146
Download
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
12/27/09  ▲
 



12
►

Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

no Systemprofil laid out. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Please register circa a Posting To verfassen.
 

Topic-Options

Unreaded
subscribe
Remember-List
Notes
guests
Delete
Permanent
Done

12.586 Views

Untitledvor 0 min.
Member 862464105/13/24
Uwe Lang12/17/18
Andre Rohland02/08/18
Alibre11/27/17
More...

Themeninformationen

this Topic has 9 subscriber:

Jörg Sellmeyer (5x)
Andreas Miethe (4x)
iF (4x)
Paul Glatz (2x)
Dieter Zornow (1x)
Rolf Koch (1x)
Frank Abbing (1x)
Dietmar Horn (1x)
H.Brill (1x)


Admins  |  AGB  |  Applications  |  Authors  |  Chat  |  Privacy Policy  |  Download  |  Entrance  |  Help  |  Merchantportal  |  Imprint  |  Mart  |  Interfaces  |  SDK  |  Services  |  Games  |  Search  |  Support

One proposition all XProfan, The there's!


My XProfan
Private Messages
Own Storage Forum
Topics-Remember-List
Own Posts
Own Topics
Clipboard
Log off
 Deutsch English Français Español Italia
Translations

Privacy Policy


we use Cookies only as Session-Cookies because of the technical necessity and with us there no Cookies of Drittanbietern.

If you here on our Website click or navigate, stimmst You ours registration of Information in our Cookies on XProfan.Net To.

further Information To our Cookies and moreover, How You The control above keep, find You in ours nachfolgenden Datenschutzerklärung.

all rightDatenschutzerklärung
i want none Cookie