Sie sind aktuell nicht angemeldet.

Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Ergänzung
Autor: [CrX]Garfield
Datum: 08.03.05 15:46
Sub MakeGradient(ByRef Obj As Object, ByVal FromColor As Long, _ ByVal ToColor As Long, ByVal Direction As Integer) Dim DC As Long = GetDC(Obj.Handle.ToInt32) Static ColorBits As Long Static RgnCnt As Integer Dim NbrPlanes As Long Dim BitsPerPixel As Long Dim AreaHeight As Long Dim AreaWidth As Long Dim prevScaleMode As Integer Dim IntervalX As Long Dim IntervalY As Long Dim I As Integer Dim R As Long Dim R_ColorVal As Long Dim G_ColorVal As Long Dim B_ColorVal As Long Dim FillArea As RECT Dim hBrush As Long Dim ColRed As Integer Dim ColGreen As Integer Dim ColBlue As Integer With Obj If ColorBits = 0 Then BitsPerPixel = GetDeviceCaps(DC, BITSPIXEL) NbrPlanes = GetDeviceCaps(DC, PLANES) ColorBits = (BitsPerPixel * NbrPlanes) Select Case ColorBits Case 32 : RgnCnt = 256 Case 24 : RgnCnt = 256 Case 16 : RgnCnt = 256 Case 15 : RgnCnt = 32 Case 8 : RgnCnt = 64 Case 4 : RgnCnt = 64 Case Else ColorBits = 4 RgnCnt = 64 End Select End If AreaHeight = .Height AreaWidth = .Width R_ColorVal = Int((ColorRed(FromColor) - _ ColorRed(ToColor) + 1) / RgnCnt * 100) G_ColorVal = Int((ColorGreen(FromColor) - _ ColorGreen(ToColor) + 1) / RgnCnt * 100) B_ColorVal = Int((ColorBlue(FromColor) - _ ColorBlue(ToColor) + 1) / RgnCnt * 100) ColRed = ColorRed(ToColor) '* 100 ColGreen = ColorGreen(ToColor) '* 100 ColBlue = ColorBlue(ToColor) '* 100 IntervalY = Int(AreaHeight / RgnCnt * 100) IntervalX = Int(AreaWidth / RgnCnt * 100) With FillArea .Left = 0 .Top = 0 .Right = AreaWidth .Bottom = AreaHeight End With For I = 0 To RgnCnt - 1 hBrush = CreateSolidBrush(RGB(ColRed / 100, ColGreen / 100, ColBlue / 100)) If Direction = 1 Then FillArea.Top = AreaHeight - (I * IntervalY / 100) R = FillRect(DC, FillArea, hBrush) FillArea.Bottom = FillArea.Top Else FillArea.Left = AreaWidth - (I * IntervalX / 100) R = FillRect(DC, FillArea, hBrush) FillArea.Right = FillArea.Left End If R = DeleteObject(hBrush) If I < RgnCnt - 1 Then ColRed = ColRed + R_ColorVal ColGreen = ColGreen + G_ColorVal ColBlue = ColBlue + B_ColorVal End If Next I FillArea.Top = 0 FillArea.Left = 0 hBrush = CreateSolidBrush(RGB(Int(ColRed / 100), _ Int(ColGreen / 100), Int(ColBlue / 100))) R = FillRect(DC, FillArea, hBrush) R = DeleteObject(hBrush) End With End Sub

Farbverlauf	902	[CrX]Garfield	08.03.05 15:46
Ergänzung	587	[CrX]Garfield	08.03.05 15:46
Re: Farbverlauf	542	Maywood	08.03.05 16:08
Re: Farbverlauf	572	FZelle	08.03.05 16:35
Re: Farbverlauf	538	sebastian_der_k...	25.01.06 13:19
Re: Farbverlauf	500	DaveS	25.01.06 13:32

Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden. Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  Gesamtübersicht

Suchen