(969)  Anmelden

Deutsch
Quelltexte/ Codesnippets

Farbverlauf Fenster Füllen Hauptfenster

 

KompilierenMarkierenSeparieren
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
 
16.07.2007  ▲
 




Jörg
Sellmeyer
Auch ne sehr schöne Sache!
KompilierenMarkierenSeparieren
 $I profalt.inc

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%,2): let colors%=  2'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 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 verlauf%=16
GradientFill RGB(0,0,255),RGB(255,0,0),verlauf%,0
let lastmenu%=2000

whilenot ende%

    waitinput

    IF @menuitem(1000)

        let ende%=1

    ELSEIF @menuitem(2000)

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

    ELSEIF @menuitem(3000)

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

    ELSEIF @Between(%menuitem,1,512)

        let verlauf% = %menuitem
        windowtitle @add$(titel$,str$(%menuitem))
        case @equ(lastmenu%,2000): GradientFill RGB(0,0,255),RGB(255,0,0),verlauf%,1
        case @equ(lastmenu%,3000): GradientFill RGB(0,0,255),RGB(255,0,0),verlauf%,0
        repaint

    ELSEIF @equ(%key,4)

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

    ENDIF

wend

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




p.specht

Hier als XProfan-11.2a Version. Super, das Teil!
KompilierenMarkierenSeparieren
' GradientFill (C) 1997 T.Hoelzer, restored 2018-05 by J.Sellmeyer
' Converted to XProfan-2.11 Version in 2018-06 by P.Specht/Vienna

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

    ' Anfangsfarbe,Endfarbe,Anzahl Farben,Richtung (0=Vertikal, >0=Horizontal)
    declare r%,g%,b%,reddif%,greendif%,bluedif%,i%,h%
    Set("Truecolor",1)
    Case colors%<2:colors%=2'weniger sieht nicht gut aus
    usepen 5,0,0'Rand unterdrücken
    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 ende%, lastmenu%, verlauf%, titel$
WindowStyle 47
Titel$="Gradientdemo XProf-11 Version of ©1997 T.Hölzer THoelzer@aol.com"
WindowTitle titel$+"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),verlauf%,0
lastmenu%=2000

WHILENOT Ende%

    waitinput

    IF @menuitem(1000)

        Ende%=1

    ELSEIF @menuitem(2000)

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

    ELSEIF @menuitem(3000)

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

    ELSEIF @Between(%menuitem,1,512)

        verlauf% = %menuitem
        Windowtitle titel$+str$(%menuitem)
        case lastmenu%=2000:GradientFill RGB(0,0,255),RGB(255,0,0),verlauf%,1
        case lastmenu%=3000:GradientFill RGB(0,0,255),RGB(255,0,0),verlauf%,0
        repaint

    ELSEIF %key=4

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

    ENDIF

ENDWHILE

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



Zum Quelltext


Thementitel, max. 100 Zeichen.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Beitrag  Schrift  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Themenoptionen

Ungelesen
Abonnieren
Merkliste
Hinweise
Gäste
Löschen
Ständig
Erledigt

5.743 Betrachtungen

Unbenanntvor 0 min.
RudiB.08.04.2022
p.specht18.11.2021
Roland Schäffer18.11.2021
Peter Max Müller18.11.2021
Mehr...

Themeninformationen

Dieses Thema hat 3 Teilnehmer:

p.specht (1x)
Jörg Sellmeyer (1x)
unbekannt (1x)


Admins  |  AGB  |  Anwendungen  |  Autoren  |  Chat  |  Datenschutz  |  Download  |  Eingangshalle  |  Hilfe  |  Händlerportal  |  Impressum  |  Mart  |  Schnittstellen  |  SDK  |  Services  |  Spiele  |  Suche  |  Support

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