SoftBumpBox
Verfasst: 30.09.2010 19:23
Hallo,
ich habe aus meinen alten Code diese kleien Routine extrahiert.
Sie basiert auf C++-Code den ich im codeproject gefunden hatte und erzeugt eine SoftbumBox.
Ganz nützlich als Buttons oder so.
Uploaded with ImageShack.us
Der Code:
ich habe aus meinen alten Code diese kleien Routine extrahiert.
Sie basiert auf C++-Code den ich im codeproject gefunden hatte und erzeugt eine SoftbumBox.
Ganz nützlich als Buttons oder so.
Uploaded with ImageShack.us
Der Code:
Code: Alles auswählen
; A Simple Softbump-Image
EnableExplicit
Procedure.f Min(i1.f, i2.f)
If i1 < i2 : ProcedureReturn i2 : EndIf
ProcedureReturn i1
EndProcedure
Procedure.f Max(i1.f, i2.f)
If i1 > i2 : ProcedureReturn i2 : EndIf
ProcedureReturn i1
EndProcedure
;==============================================================================
; Procedure Name ....: DrawSoftBumpBox()
; Description .......: Draws a Box with soft Gradient. Left/top is color1 and
; Right/bottom colo2 so it looks very soft. Also you can
; change the granularity to make it look more .... rough?
;
; Syntax ............: DrawSoftBumpBox(x,y,width,height,color1, color2, granularity=10)
; Parameter(s) ......: x,y - Position
; widtz,height - dimension
; color1 - flooding from left/top
; color2 - flooding from riight/bottom
; granularity - to distort the 'calculated' gradient a bit
; Return value(s) ...: Nothing
;
; Author(s) .........: Michael 'neotoma' Taupitz
; Creation Date .....:
; Version ...........: 0.0.0.1
; Last Update .......:
; Remarks ...........:
;==============================================================================
Procedure DrawSoftBumpBox(x,y,width,height,color1, color2, granularity=10)
Protected k.f, idx, i,j,h
; make internal gradient-array
Protected sRed.f = Red(color1) , r.f = (Red (color1) - Red (color2))/255
Protected sGreen.f = Green(color1) , g.f = (Green(color1) - Green(color2))/255
Protected sBlue.f = Blue(color1) , b.f = (Blue (color1) - Blue (color2))/255
Protected Dim dmy.i(255)
For i = 0 To 255
dmy(i) = RGB( Min(Max(sRed-i*r,255),0), Min(Max(sGreen-i*g,255),0), Min(Max(sBlue-i*b,255),0) )
Next
For i = 0 To height
h = ((255*i)/height)-127
For j = 0 To width
k.f=((255*(width-j))/width)-127
k.f=(((h*(h*h))/127)/127)+((((k*(k*k))/127))/127)
k.f=((k*(127-granularity))/127)+127;
k = Min( Max(k, ( 255-granularity)), granularity)
idx = Max(k+Random(granularity*2)-granularity,255);
Plot(x+(width-j),y+i, dmy(idx))
Next
Next
EndProcedure
Macro DrawSoftBumpBox_Syscolor(_x,_y,_w,_h)
DrawSoftBumpBox(10,10,180,80, GetSysColor_(#COLOR_BTNHIGHLIGHT),GetSysColor_(#COLOR_BTNSHADOW))
EndMacro
; TEST
Define Event
Define color1= #White
Define color2= #Red
Define ig = CreateImage(#PB_Any,200,100)
;DrawSoftBumpBox_Syscolor(10,10,180,80);, #White,#Red)
Macro RedrawImage()
StartDrawing(ImageOutput(ig))
DrawSoftBumpBox(10,10,180,80, color1,color2,GetGadgetState(4))
StopDrawing()
SetGadgetState(0, ImageID(ig))
SetGadgetText(3,"Granularity: "+Str(GetGadgetState(4)))
EndMacro
If OpenWindow(0, 0, 0, 220, 190, "ImageGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ImageGadget(0, 10, 10, 100, 100, ImageID(ig)) ; Imagegadget Standard
ButtonGadget(1, 10,120,70,20,"Color 1")
ButtonGadget(2, 140,120,70,20,"Color 2")
TextGadget(3, 10, 145, 200, 20,"Granularity")
ScrollBarGadget(4, 10, 165, 200, 10, 0, 110, 10)
SetGadgetState(4,10)
RedrawImage()
Repeat
Event= WaitWindowEvent()
If Event = #PB_Event_Gadget
If EventGadget() = 1
color1 = ColorRequester(color1)
RedrawImage()
EndIf
If EventGadget() = 2
color2 = ColorRequester(color2)
RedrawImage()
EndIf
If EventGadget() = 4
RedrawImage()
EndIf
EndIf
Until Event = #PB_Event_CloseWindow
EndIf
Vielleicht weiss jemand eine elegantere Lösung, bzw. wär es sinnvoll diese Abfrage in eine Procedure auszulagern ? 
