Code: Alles auswählen
Enumeration
#sbg_Rot
#sbg_Gruen
#sbg_Blau
#str_Rot
#str_Gruen
#str_Blau
#txt_Rot
#txt_Gruen
#txt_Blau
EndEnumeration
Enumeration
#img_R
#img_G
#img_B
EndEnumeration
Procedure Verlauf(Image, Start, Stop, VonR, VonG, VonB, BisR, BisG, BisB)
; Differenzen der einzelnen Farbkomponenten berechnen
dy = Stop - Start
dr.f = (BisR - VonR) / dy
dg.f = (BisG - VonG) / dy
db.f = (BisB - VonB) / dy
ar.f = VonR
ag.f = VonG
ab.f = VonB
StartDrawing(ImageOutput(Image))
For i = Start To Stop
Plot(0, i, RGB(Int(ar), Int(ag), Int(ab)))
ar + dr
ag + dg
ab + db
Next
StopDrawing()
EndProcedure
Procedure wc(hwnd, msg, wParam, lParam)
Static Farbe, RBrush, GBrush, BBrush, Pfeil, VBarHoch
Ergebnis = #PB_ProcessPureBasicEvents
Select msg
Case #WM_CREATE
Pfeil = GetSystemMetrics_(#SM_CYVSCROLL) ; Höhe des Scrollbarpfeils besorgen
VBarHoch = GadgetHeight(#sbg_Rot)
;Für jedes Scrollbargadget ein Image
CreateImage(#img_R, 1, VBarHoch)
CreateImage(#img_G, 1, VBarHoch)
CreateImage(#img_B, 1, VBarHoch)
; Verlauf fängt immer nach der Zeile an, die nach dem oberen Pfeil kommt, damit die Position der Farbn stimmen
Verlauf(#img_R, Pfeil, VBarHoch - Pfeil, 0, 0, 0, 255, 0, 0)
Verlauf(#img_G, Pfeil, VBarHoch - Pfeil, 0, 0, 0, 0, 255, 0)
Verlauf(#img_B, Pfeil, VBarHoch - Pfeil, 0, 0, 0, 0, 0, 255)
;Für jedes Scrollbargadget ein Brush, der den jeweiligen Verlauf enthält
RBrush = CreatePatternBrush_(ImageID(#img_R))
GBrush = CreatePatternBrush_(ImageID(#img_G))
BBrush = CreatePatternBrush_(ImageID(#img_B))
Case #WM_VSCROLL
rv = GetGadgetState(#sbg_Rot)
gv = GetGadgetState(#sbg_Gruen)
bv = GetGadgetState(#sbg_Blau)
If lParam = GadgetID(#sbg_Rot)
SetGadgetText(#str_Rot, Str(rv))
ElseIf lParam = GadgetID(#sbg_Gruen)
SetGadgetText(#str_Gruen, Str(gv))
ElseIf lParam = GadgetID(#sbg_Blau)
SetGadgetText(#str_Blau, Str(bv))
EndIf
; Farbverläufe neu erzeugen
Verlauf(#img_R, Pfeil, VBarHoch - Pfeil, 0, gv, bv, 255, gv, bv)
Verlauf(#img_G, Pfeil, VBarHoch - Pfeil, rv, 0, bv, rv, 255, bv)
Verlauf(#img_B, Pfeil, VBarHoch - Pfeil, rv, gv, 0, rv, gv, 255)
;Alte Brushes löschen
DeleteObject_(RBrush)
DeleteObject_(GBrush)
DeleteObject_(BBrush)
;Neue Brushes erzeugen
RBrush = CreatePatternBrush_(ImageID(#img_R))
GBrush = CreatePatternBrush_(ImageID(#img_G))
BBrush = CreatePatternBrush_(ImageID(#img_B))
;Fenster für ungültig erklären, damit gewählte Farbe angezeigt wird
InvalidateRect_(hwnd, 0, #False)
Farbe = RGB(GetGadgetState(#sbg_Rot), GetGadgetState(#sbg_Gruen), GetGadgetState(#sbg_Blau))
Case #WM_PAINT
hdc = BeginPaint_(hwnd, @ps.PAINTSTRUCT)
ABrush = SelectObject_(hdc, CreateSolidBrush_(Farbe))
Rectangle_(hdc, 180, 10, 790, 590)
DeleteObject_(SelectObject_(hdc, ABrush))
EndPaint_(hwnd, @ps)
Ergebnis = 0
Case #WM_CTLCOLORSCROLLBAR
;Hintergrund der Scrollbars setzen (Mit zurückgegebenen Brush wird der Hintergrund gezeichnet)
;Es ist auch möglich, mit hilfe des in wParam zurückgegebenen Devicekontextes direkt in den Hintergrund zu malen
;dann muss aber GetStockObject_(#NULL_BRUSH) zurückgegeben werden damit kein übermalen stattfindet
;und der Hintergrund muß immer vorher gelöscht werden damit alles richtig funktioniert.
;
;Überprüfen ob als letztes erzeugtes Scrollgadget existiert, da sonst im Debug - Mode Fehlermeldung
If IsGadget(#sbg_Blau)
Select lParam
Case GadgetID(#sbg_Rot)
Ergebnis = RBrush
Case GadgetID(#sbg_Gruen)
Ergebnis = GBrush
Case GadgetID(#sbg_Blau)
Ergebnis = BBrush
Default
Ergebnis = 0
EndSelect
EndIf
Case #WM_DESTROY
;Am Ende die Brushes wieder löschen
DeleteObject_(RBrush)
DeleteObject_(GBrush)
DeleteObject_(BBrush)
EndSelect
ProcedureReturn Ergebnis
EndProcedure
hwnd = OpenWindow(0, 0, 0, 800, 600, "Farbschauer", #PB_Window_SystemMenu)
SetWindowCallback(@wc(), 0)
CreateGadgetList(hwnd)
ScrollBarGadget(#sbg_Rot, 25, 10, 25, 560, 0, 264, 10, #PB_ScrollBar_Vertical)
ScrollBarGadget(#sbg_Gruen, 75, 10, 25, 560, 0, 264, 10, #PB_ScrollBar_Vertical)
ScrollBarGadget(#sbg_Blau, 125, 10, 25, 560, 0, 264, 10, #PB_ScrollBar_Vertical)
StringGadget(#str_Rot, 15, 575, 45, 20, "0")
StringGadget(#str_Gruen, 65, 575, 45, 20, "0")
StringGadget(#str_Blau, 115, 575, 45, 20, "0")
;Damit Images und Brushes korrekt initialisiert werden, #WM_CREATE funktioniert unter PB ja leider nicht automatisch
SendMessage_(hwnd, #WM_CREATE, 0, 0)
Repeat
Nachr = WaitWindowEvent()
Until Nachr = #PB_Event_CloseWindow