(894)  Login

English
Source / code snippets

Farbverlauf Window stuff Mainwindow

 

CompileMarkSeparation
Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Hauptfenster: Fenster mit Farbverlauf füllen

PROC GradientFill

    Parameter: Anfangsfarbe,Endfarbe,Anzahl Farben,Richtung (0= Vertikal, > 0 = Horizontal)
    parameters TopColor&,EndColor&,Colors%,direction%
    declare r%,g%,b%,reddif%,greendif%,bluedif%,i%,h%
    DEF MulDiv(3) @div(@mul(@%(1),@%(2)),@%(3))
    SetTruecolor 1
    Case @lt(colors%,8): let colors%= 8    weniger sieht nicht gut aus, DARF nicht < 2 sein
    usepen 5,0,0 						   Rand unterdrücken
    let RedDif%=@sub(GetRValue(EndColor&),GetRValue(TopColor&))
    let GreenDif%=@sub(GetGValue(EndColor&),GetGValue(TopColor&))
    let BlueDif%=@sub(GetBValue(EndColor&),GetBValue(TopColor&))

    WHILE @lt(i%,colors%)

        let r% = @add(GetRValue(TopColor&), MulDiv(i%, RedDif%, Colors%));
        let g% = @add(GetGValue(TopColor&) , MulDiv (i%, GreenDif%, Colors%));
        let b% = @add(GetBValue(TopColor&) , MulDiv (i%, BlueDif%, Colors%));
        usebrush 1, @rgb(r%,g%,b%)

        IF direction%

            rectangle MulDiv(i%,width(%hwnd),colors%),0 -
            @MulDiv(@add(i%,2),width(%hwnd),colors%),height(%hwnd)

        ELSE

            rectangle 0,MulDiv(i%,Height(%hwnd),colors%) - Width(%hwnd),
            @MulDiv(@add(i%,2),Height(%hwnd),colors%)

        ENDIF

        inc i%

    WEND

ENDPROC

Demoprogramm
 $P+
declare ende%,lastmenu%,verlauf%,titel$
windowstyle 47
let titel$=Gradient - Demo  - © 1997 Thomas Hölzer, Thoelzer@aol.com - Farben:
windowtitle @add$(titel$,16)
window 0,0-640,480
appendmenubar 2,&Vertikal
appendmenubar 3,&Horizontal
popup  &Verlaufsfarben
appendmenu 8,8
appendmenu 16,16
appendmenu 32,32
appendmenu 64,64
appendmenu 128,128
appendmenubar 1,&Beenden
SetTrueColor 1
let verlauf%=16
GradientFill RGB(0,0,255),RGB(255,0,0),verlauf%,0
let lastmenu%=2

whilenot ende%

    waitinput

    IF @menuitem(1)

        let ende%=1

    ELSEIF @menuitem(2)

        GradientFill RGB(0,0,255),RGB(255,0,0),verlauf%,0
        let lastmenu%=2

    ELSEIF @menuitem(3)

        GradientFill RGB(0,0,255),RGB(255,0,0),verlauf%,1
        let lastmenu%=3

    ELSEIF @gt(%menuitem,7)

        let verlauf% = %menuitem
        windowtitle @add$(titel$,str$(%menuitem))

    ELSEIF @equ(%key,4)

        case @equ(lastmenu%,2): GradientFill RGB(0,0,255),RGB(255,0,0),verlauf%,1
        case @equ(lastmenu%,3): GradientFill RGB(0,0,255),RGB(255,0,0),verlauf%,0

    ENDIF

wend

end
 
07/16/07  ▲
 




Jörg
Sellmeyer
too ne very nice thing!
CompileMarkSeparation
 $I profalt.inc

PROC GradientFill

    'Parameter: Anfangsfarbe,Endfarbe,amount colours,direction (0= Vertikal, > 0 = Horizontal)
    parameters TopColor&,EndColor&,Colors%,direction%
    declare r%,g%,b%,reddif%,greendif%,bluedif%,i%,h%
    DEF MulDiv(3) @div(@mul(@%(1),@%(2)),@%(3))
    SetTruecolor 1
    Case @lt(colors%,2): let colors%=  2'less sees not well from, DARF not < 2 his
    usepen 5,0,0'edge suppress
    let RedDif%=@sub(GetRValue(EndColor&),GetRValue(TopColor&))
    let GreenDif%=@sub(GetGValue(EndColor&),GetGValue(TopColor&))
    let BlueDif%=@sub(GetBValue(EndColor&),GetBValue(TopColor&))

    WHILE @lt(i%,colors%)

        let r% = @add(GetRValue(TopColor&), MulDiv(i%, RedDif%, Colors%));
        let g% = @add(GetGValue(TopColor&) , MulDiv (i%, GreenDif%, Colors%));
        let b% = @add(GetBValue(TopColor&) , MulDiv (i%, BlueDif%, Colors%));
        usebrush 1, @rgb(r%,g%,b%)

        IF direction%

            rectangle MulDiv(i%,width(%hwnd),colors%),0 - \
            @MulDiv(@add(i%,2),width(%hwnd),colors%),height(%hwnd)

        ELSE

            rectangle 0,MulDiv(i%,Height(%hwnd),colors%) - Width(%hwnd),\
            @MulDiv(@add(i%,2),Height(%hwnd),colors%)

        ENDIF

        inc i%

    WEND

ENDPROC

'Demoprogramm
' $P+
declare end%,lastmenu%,course%,cover$
windowstyle 47
let cover$="Gradient - demonstration  - © 1997 Thomas Hölzer, Thoelzer@aol.com - colours:"
windowtitle @add$(cover$,"16")
window 0,0-640,480
appendmenubar 2000,"&Vertikal"
appendmenubar 3000,"&Horizontal"
popup  "&Verlaufsfarben"

WhileLoop 2,10

    AppendMenu &Loop,Str $(&Loop)

Wend

WhileLoop 12,128,4

    AppendMenu &Loop,Str $(&Loop)

Wend

appendmenu 256,"256"
appendmenu 512,"512"
'appendmenu 8,"8"
'appendmenu 16,"16"
'appendmenu 32,"32"
'appendmenu 64,"64"
'appendmenu 128,"128"
appendmenubar 1000,"&Beenden"
let course%=16
GradientFill RGB(0,0,255),RGB(255,0,0),course%,0
let lastmenu%=2000

whilenot end%

    waitinput

    IF @menuitem(1000)

        let end%=1

    ELSEIF @menuitem(2000)

        GradientFill RGB(0,0,255),RGB(255,0,0),course%,0
        let lastmenu%=2000

    ELSEIF @menuitem(3000)

        GradientFill RGB(0,0,255),RGB(255,0,0),course%,1
        let lastmenu%=3000

    ELSEIF @Between(%menuitem,1,512)

        let course% = %menuitem
        windowtitle @add$(cover$,st$(%menuitem))
        case @equ(lastmenu%,2000): GradientFill RGB(0,0,255),RGB(255,0,0),course%,1
        case @equ(lastmenu%,3000): GradientFill RGB(0,0,255),RGB(255,0,0),course%,0
        repaint

    ELSEIF @equ(%key,4)

        case @equ(lastmenu%,2000): GradientFill RGB(0,0,255),RGB(255,0,0),course%,1
        case @equ(lastmenu%,3000): GradientFill RGB(0,0,255),RGB(255,0,0),course%,0
        repaint

    ENDIF

wend

end
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
06/03/18  ▲
 




p.specht

here as XProfan-11.2a Version. super, the part!
CompileMarkSeparation
' GradientFill (C) 1997 T.Hoelzer, restored 2018-05 by J.Sellmeyer
' Converted to XProfan-2.11 Version in 2018-06 by P.woodpecker/Vienna

PROC GradientFill :parameters TopColor&,EndColor&,Colors%,direction%

    ' Anfangsfarbe,Endfarbe,amount colours,direction (0=Vertikal, >0=Horizontal)
    declare r%,g%,b%,reddif%,greendif%,bluedif%,i%,h%
    Set("Truecolor",1)
    Case colors%<2:colors%=2'less sees not well from
    usepen 5,0,0'edge suppress
    RedDif%  = GetRValue(EndColor&)-GetRValue(TopColor&)
    GreenDif%= GetGValue(EndColor&)-GetGValue(TopColor&)
    BlueDif% = GetBValue(EndColor&)-GetBValue(TopColor&)

    WHILE i%<colors%

        r% = GetRValue(TopColor&) + MulDiv(i%, RedDif%, Colors%)
        g% = GetGValue(TopColor&) + MulDiv(i%, GreenDif%, Colors%)
        b% = GetBValue(TopColor&) + MulDiv(i%, BlueDif%, Colors%)
        usebrush 1, rgb(r%,g%,b%)

        IF direction%

            rectangle MulDiv(i%,width(%hwnd),colors%),0 - \
            MulDiv(i%+2,width(%hwnd),colors%),height(%hwnd)

        ELSE

            rectangle 0,MulDiv(i%,Height(%hwnd),colors%) - Width(%hwnd),\
            MulDiv(i%+2,Height(%hwnd),colors%)

        ENDIF

        inc i%

    ENDWHILE

ENDPROC

' Hilfsfunktion
:Proc MulDiv :parameters a%,b%,c%:return (a%*b%)\c%:Endproc
' D e m o p r o g r a m m
Declare end%, lastmenu%, course%, cover$
Window Style 47
Titel$="Gradientdemo XProf-11 Version of ©1997 T.Hölzer THoelzer@aol.com"
Window Title cover$+"16"
window 0,0-640,480
appendmenubar 2000,"&Vertikal"
appendmenubar 3000,"&Horizontal"
popup  "&Verlaufsfarben"
:WhileLoop 2,10:AppendMenu &Loop,Str $(&Loop):EndWhile
:WhileLoop 12,128,4:AppendMenu &Loop,Str $(&Loop):EndWhile
appendmenu 256,"256"
appendmenu 512,"512"
'appendmenu 8,"8"
'appendmenu 16,"16"
'appendmenu 32,"32"
'appendmenu 64,"64"
'appendmenu 128,"128"
appendmenubar 1000,"&Beenden"
verlauf%=16
GradientFill RGB(0,0,255),RGB(255,0,0),course%,0
lastmenu%=2000

WHILENOT end%

    waitinput

    IF @menuitem(1000)

        end%=1

    ELSEIF @menuitem(2000)

        GradientFill RGB(0,0,255),RGB(255,0,0),course%,0
        lastmenu%=2000

    ELSEIF @menuitem(3000)

        GradientFill RGB(0,0,255),RGB(255,0,0),course%,1
        lastmenu%=3000

    ELSEIF @Between(%menuitem,1,512)

        course% = %menuitem
        Windowtitle cover$+st$(%menuitem)
        case lastmenu%=2000:GradientFill RGB(0,0,255),RGB(255,0,0),course%,1
        case lastmenu%=3000:GradientFill RGB(0,0,255),RGB(255,0,0),course%,0
        repaint

    ELSEIF %key=4

        case lastmenu%=2000:GradientFill RGB(0,0,255),RGB(255,0,0),course%,1
        case lastmenu%=3000:GradientFill RGB(0,0,255),RGB(255,0,0),course%,0
        repaint

    ENDIF

ENDWHILE

END
 
XProfan 11
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
06/03/18  ▲
 



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

5.730 Views

Untitledvor 0 min.
RudiB.04/08/22
p.specht11/18/21
Roland Schäffer11/18/21
Peter Max Müller11/18/21
More...

Themeninformationen

this Topic has 3 subscriber:

p.specht (1x)
Jörg Sellmeyer (1x)
unbekannt (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