English
Source / code snippets

Fadetogray

 
- Page 1 -



Andreas
Miethe


a have I yet for this year.

screen eingrauen, How at XP-Abmelde-dialog.
CompileMarkSeparation
 $H Windows.ph
Importdll("GDI32.DLL","")
struct  COLORADJUSTMENT =
caSize%,
caFlag%,
caIlluminantIndex%,
caRedGamma%,
caGreenGamma%,
caBlueGamma%,
caReferenceBlack%,
caReferenceWhite%,
caContrast%,
caBrightness%,
caColorfulness%,
caRedGreenTint%

Proc FadetoGray

    windowstyle $F0
    Var CA# = New(COLORADJUSTMENT)
    Bild anlegen
    Var Pic& = Create("hNewPic",%maxx,%maxy,0)
    Var DC& = ~CreateCompatibleDC(%hdc)
    Ausgangsbild anlegen
    Var Pic1& = Create("hNewPic",%maxx,%maxy,0)
    Var DC1& = ~CreateCompatibleDC(%hdc)
    DC vom Desktop
    Var DC2& = ~CreateDC("DISPLAY",0,0,0)
    Bilder ins DC
    ~SelectObject(DC&,PIC&)
    ~SelectObject(DC1&,PIC1&)
    Vom Desktop ins Ausgangsbild
    dient nur dazu ein Bild zu haben !
    StretchBlt(DC1&,0,0,%maxx,%maxy,DC2&,0,0,%maxx,%maxy,~SRCCOPY | $40000000)
    Window 0,0-%maxx,%maxy
    ColorAdjustment holen
    GetColorAdjustment(%hdc2,CA#)
    Blittmode auf HALFTONE setzen
    SetStretchBltMode(%hdc2,4)
    Full Color auf Werte zwischen -100 und 100

    whileLoop CA#.caColorfulness%,-100,-8

        CA#.caColorfulness% = &Loop  Grautöne
        ColorAdjustment setzen
        SetColorAdjustment(%hdc2,CA#)
        StretchBlt(%hdc2,0,0,%maxx,%maxy,DC1&,0,0,%maxx,%maxy,~SRCCOPY)
        DrawsizedPic Pic&,0,0-%maxx,%maxy;0
        Repaint

    endwhile

    Bilder freigeben
    ~DeleteDC(DC&)
    ~DeleteDC(DC1&)
    ~DeleteDC(DC2&)
    ~DeleteObject(Pic&)
    ~DeleteObject(Pic1&)
    Dispose CA#

EndProc

FadeToGray()
waitinput 10000
s4 href='./../../Function-References/XProfan/end/'>end
 
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/28/09  
 



 
- Page 2 -


overthrows it with you not?
 
12/30/09  
 




Frank
Abbing
Teste the example in my last Posting. functions very beautiful.
with MSDN becomes of Addresse on structure not talked, separate of structure. In such Make must You none Zeiger indicate separate The data the structure directly indicate. In this case is the very simply, because only one LongInt transfer go must. is solely something Bitrechnerei. You can but too byte area#=0,0,128,0 / Long(area#,0) using (ungetestet, but so similar).
 
12/30/09  
 



>> Teste the example in my last Posting. functions very beautiful.

No thatswhy my I Yes, crashes by me just as with yourself Message read of 0 - means no Änderung.
 
12/30/09  
 




Frank
Abbing
by me runs it as his should. After Click places the (black) Bitmap To 50% transparent (sees then gray from because of the weißen Hintergrunds) over the Print-Text. In Shooter and OFrame use I it just as, without Problems.
Perhaps have you got still not whom whole Sourcecode copies had? having your ursprünglichen code namely abgeändert.

 
12/30/09  
 




Andreas
Miethe


by me functions it on these manner.
CompileMarkSeparation
 $H Windows.ph
cls
Print "Alphablend"
Var bm1& = Create("hNewPic",256,256,$80)
Var DC1& = ~CreateCompatibleDC(0)
~SelectObject(DC1&,bm1&)
Var bm2& = Create("hNewPic",256,256,$FFFFFF)
Var DC2& = ~CreateCompatibleDC(0)
Startpaint bm2&
DrawText 100,100,"TEXT"
Endpaint
~SelectObject(DC2&,bm2&)
var bf& = 128 << 16
Waitinput
~AlphaBlend(%hdc,0,0,256,256,dc1&,0,0,256,256,bf&)
bf& = 64 << 16
Waitinput
~AlphaBlend(%hdc,0,0,256,256,dc2&,0,0,256,256,bf&)
waitinput
end
 
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/30/09  
 




Frank
Abbing
You using Yes The same method (only with Bitgeschiebe). there ought to my code with you still too weg, or?
 
12/30/09  
 




Andreas
Miethe


Frabbing, Beitrag=55678, Zeitpunkt=30.12.2009
You using Yes The same method (only with Bitgeschiebe). there ought to my code with you still too weg, or?


The functions by me ! were me go ahead many nobodies and Einsen
 
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/30/09  
 




Frank
Abbing
I see, Yes. ought to too only The engineering on niederem Level demonstrating. my only, weils with David not went. has it well what verschusselt.
 
12/30/09  
 



Yes, Have I what verschusselt - it functions naturally!
 
12/31/09  
 




p.specht

Allererstes Example of Andreas Miethe+ rennoviert:
' $H windows.ph
Importdll("GDI32.DLL","")
struct  COLORADJUSTMENT = \
caSize%, \
caFlag%, \
caIlluminantIndex%, \
caRedGamma%, \
caGreenGamma%, \
caBlueGamma%, \
caReferenceBlack%, \
caReferenceWhite%, \
caContrast%, \
caBrightness%, \
caColorfulness%, \
caRedGreenTint%

Proc FadetoGray

    windowstyle $F0
    Var CA# = New( COLORADJUSTMENT )
    '   Image lay out
    Var Pic& = Create("hNewPic",%maxx,%maxy,0)
    Var DC& = ~CreateCompatibleDC(%hdc)
    '   Ausgangsbild lay out
    Var Pic1& = Create("hNewPic",%maxx,%maxy,0)
    Var DC1& = ~CreateCompatibleDC(%hdc)
    '   DC of Desktop
    Var DC2& = ~CreateDC("DISPLAY",0,0,0)
    '   Images in that DC
    ~SelectObject(DC&,PIC&)
    ~SelectObject(DC1&,PIC1&)
    '   of Desktop in that Ausgangsbild
    '   serves only to a Image to have !
    StretchBlt(DC1&,0,0,%maxx,%maxy,DC2&,0,0,%maxx,%maxy,~SRCCOPY | $40000000)
    Window 0,0-%maxx,%maxy
    '   ColorAdjustment fetch
    GetColorAdjustment(%hdc2,CA#)
    '   Blittmode on HALFTONE settle
    SetStretchBltMode(%hdc2,4)
    '   Full Color on values between -100 and 100

    whileLoop CA#.caColorfulness%,-100,-8

        CA#.caColorfulness% = &Loop'  Grautöne
        '       ColorAdjustment settle
        SetColorAdjustment(%hdc2,CA#)
        StretchBlt(%hdc2,0,0,%maxx,%maxy,DC1&,0,0,%maxx,%maxy,~SRCCOPY)
        DrawsizedPic Pic&,0,0-%maxx,%maxy;0
        Repaint

    endwhile

    '  Images enable
    ~DeleteDC(DC&)
    ~DeleteDC(DC1&)
    ~DeleteDC(DC2&)
    ~DeleteObject(Pic&)
    ~DeleteObject(Pic1&)
    Dispose CA#

ENDPROC

FadeToGray()
waitinput 10000
end

P.s.: Klappt too in Win7-64SP1
 
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
01/22/19  
 




Manfred
Barei
means under Win 10 happens nothing
 
XProfan X2
Zu wenig Wissen ist gefärlich, zu viel auch.(XProfan X4) | Win 10 Pro 64 | Win7 Ultimate 32/64 | AMD FX-8320, 16GB, GeForce GT 630 |
01/23/19  
 



 
- Page 3 -



p.specht

thanks for Info! with Win10 have I unfortunately no experience. Perhaps need one local Admin-status?
greeting
 
XProfan 11
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
01/25/19  
 




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

25.257 Views

Untitledvor 0 min.
RudiB.04/22/21
Stefan8103/15/21
N.Art11/18/20
p.specht10/19/20
More...

Themeninformationen



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