(456)  Registro

Español
Fuente/ Codesnippets

Farbverlauf Ventana Füllen Ventana principal

 

KompilierenMarcaSeparación
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 muy schöne Sache!
KompilierenMarcaSeparación
 $I profalt.inc

PROC GradientFill

    'Parámetro: Anfangsfarbe,Endfarbe,Anzahl Farben,Richtung (0= Vertikal, > 0 = Horizontal)
    parámetros TopColor&,EndColor&,Colors%,direction%
    declarar 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 no bien de, DARF no < 2 ser
    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+
declarar 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))
        caso @equ(lastmenu%,2000): GradientFill RGB(0,0,255),RGB(255,0,0),verlauf%,1
        caso @equ(lastmenu%,3000): GradientFill RGB(0,0,255),RGB(255,0,0),verlauf%,0
        repaint

    ELSEIF @equ(%key,4)

        caso @equ(lastmenu%,2000): GradientFill RGB(0,0,255),RGB(255,0,0),verlauf%,1
        caso @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 como XProfan-11.2a Versión. Super, el Teil!
KompilierenMarcaSeparación
' GradientFill (C) 1997 T.Hoelzer, restored 2018-05 by J.Sellmeyer
' Converted to XProfan-2.11 Versión en 2018-06 by P.Pájaro carpintero/Vienna

PROC GradientFill :parámetros TopColor&,EndColor&,Colors%,direction%

    ' Anfangsfarbe,Endfarbe,Anzahl Farben,Richtung (0=Vertikal, >0=Horizontal)
    declarar r%,g%,b%,reddif%,greendif%,bluedif%,i%,h%
    Conjunto("Truecolor",1)
    Case colors%<2:colors%=2'weniger sieht no bien de
    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 :parámetros a%,b%,c%:volver (a%*b%)\c%:ENDPROC
' D e m o p r o g r a m m
Declarar ende%, lastmenu%, verlauf%, titel$
Ventana de Estilo 47
Titel$="Gradientdemo XProf-11 Versión of ©1997 T.Hölzer THoelzer@aol.com"
Título de la ventana 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)
        caso lastmenu%=2000:GradientFill RGB(0,0,255),RGB(255,0,0),verlauf%,1
        caso lastmenu%=3000:GradientFill RGB(0,0,255),RGB(255,0,0),verlauf%,0
        repaint

    ELSEIF %key=4

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

    ENDIF

ENDWHILE

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



Zum Quelltext


Título del Tema, max. 100 Signo.
 

Systemprofile:

Kein Systemprofil creado. [anlegen]

XProfan:

 Contribución  Font  Smilies  ▼ 

Bitte registro en una Contribución a verfassen.
 

Tema opciones

Unreaded
subscribe
Remember-List
Notes
guests
Delete
Constantemente
Hecho

5.777 Views

Untitledvor 0 min.
RudiB.08.04.2022
p.specht18.11.2021
Roland Schäffer18.11.2021
Peter Max Müller18.11.2021
Más...

Themeninformationen

Dieses Thema ha 3 subscriber:

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


Admins  |  AGB  |  Applications  |  Autores  |  Chat  |  Política de Privacidad  |  Descargar  |  Entrance  |  Ayuda  |  Merchantportal  |  Pie de imprenta  |  Mart  |  Interfaces  |  SDK  |  Services  |  Juegos  |  Búsqueda  |  Support

Ein Projekt aller XProfan, el lo son!


Mi XProfan
Privado Noticias
Eigenes Ablageforum
Temas-Merkliste
Eigene Beiträge
Eigene Temas
Zwischenablage
Cancelar
 Deutsch English Français Español Italia
Traducciones

Política de Privacidad


Wir uso Cookies sólo como Session-Cookies wegen el technischen Notwendigkeit y en uns hay no Cookies de Drittanbietern.

Wenn du hier en unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung de Informationen en unseren Cookies en XProfan.Net a.

Weitere Informationen a unseren Cookies y dazu, como du el Kontrolle darüber behältst, findest du en unserer nachfolgenden Datenschutzerklärung.

einverstandenDatenschutzerklärung
Yo möchte no Cookie