gesucht wird ein Pen für Rahmen eines Sechseck
Verfasst: 29.02.2008 19:35
Für mein Sechseck hätte ich gerne einen Rahmen so wie ihn DrawEdge zeichnet. In meinem Beispielcode habe ich einen Pen mit Farbverlauf. Trotz Suchen finde ich einfach nix wie ich den Pen so gestalten kann wie den Rahmen von DrawEdge.
Sehr wahrscheinlich verstehe ich nur das MSDN Chinesisch nicht, besonders die Sache mit dem Userstyle.
Kann mir einer auf die Sprünge helfen, den Weg weisen, Licht ins ApiZimmer bringen ?
Sehr wahrscheinlich verstehe ich nur das MSDN Chinesisch nicht, besonders die Sache mit dem Userstyle.
Kann mir einer auf die Sprünge helfen, den Weg weisen, Licht ins ApiZimmer bringen ?
Code: Alles auswählen
;ImageGadget als Sechseck
Procedure Api_Farbverlauf(dc,br,hh,farbe0,farbe1,xyz,flag=1)
;http://msdn2.microsoft.com/en-us/library/ms532338(VS.85).aspx
;flag=0 = #GRADIENT_FILL_RECT_H
;flag=1 = #GRADIENT_FILL_RECT_V
;da RGB Farben 24 Bit Werte sind und
;laut MSDN 16 Bit Werte gebraucht werden
;muß jeder Wert um 8 Bit verschoben werden, darum << 8
Dim t_vertex.TRIVERTEX(3)
;t_vertex(0)\x + y ist eh immer null
t_vertex(0)\Red = Red(farbe0) <<8
t_vertex(0)\Green = Green(farbe0)<<8
t_vertex(0)\Blue = Blue(farbe0) <<8
t_vertex(1)\x = br
t_vertex(1)\y = hh + xyz ;xyz verschiebt den Übergang
t_vertex(1)\Red = Red(farbe1) <<8
t_vertex(1)\Green = Green(farbe1)<<8
t_vertex(1)\Blue = Blue(farbe1) <<8
g_rect.GRADIENT_RECT
g_rect\UpperLeft = 0
g_rect\LowerRight = 1
Gradientfill_(dc, @t_vertex(), 2, @g_rect, 1, flag)
EndProcedure
Procedure myFarbenImage(pbnr,br,hh,farbe1,farbe2,xyz=0)
id=CreateImage(pbnr,br,hh)
dc=StartDrawing(ImageOutput(pbnr))
Api_Farbverlauf(dc,br,hh,farbe1,farbe2,xyz,1)
StopDrawing()
ProcedureReturn id
EndProcedure
Procedure ImageGadgetSechseck(pbnr,br,hh,txt$,sp,ze)
id98=myFarbenImage(98,br,hh,#Red+#Blue,#Yellow)
id99=myFarbenImage(99,br,hh,#Green+#Blue,#Green)
id=CreateImage(pbnr,br,hh)
dc=StartDrawing(ImageOutput(pbnr))
nopa=6 ;number of points in array
Dim p.point(nopa-1) ;weil ab null
p(0)\x=br/4
p(0)\y=0
p(1)\x=br-br/4
p(1)\y=0
p(2)\x=br
p(2)\y=hh/2
p(3)\x=br-br/4
p(3)\y=hh
p(4)\x=br/4
p(4)\y=hh
p(5)\x=0
p(5)\y=hh/2
;Rahmen
lb.LOGBRUSH
lb\lbStyle = #BS_PATTERN
lb\lbHatch = id98
penbreite = 4
pen = ExtCreatePen_(#PS_GEOMETRIC,penbreite,@lb,0,0)
;innen ausfüllen
brush=CreatePatternBrush_(id99)
SelectObject_(dc,brush)
SelectObject_(dc,pen)
Polygon_(dc,p(),nopa)
DeleteObject_(pen)
DeleteObject_(brush)
DrawingMode(1)
DrawText(sp,ze,txt$)
SetRect_(r.RECT,0,0,TextWidth(txt$)+5,TextHeight(txt$)+5)
OffsetRect_(r,sp-2,ze-2)
DrawEdge_(dc,r,#EDGE_BUMP,#BF_RECT)
StopDrawing()
igID=ImageGadget(pbnr,20,20,0,0,ImageID(pbnr))
rgn = CreatePolygonRgn_(p(), nopa, #WINDING)
SetWindowRgn_(igID,rgn, #True)
EndProcedure
hwnd=OpenWindow(0, 0, 0, 640, 480, "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CreateGadgetList(hwnd)
ImageGadgetSechseck(0,80,80,"Bremer",15,30)
Repeat: event = WaitWindowEvent()
Until event = #PB_Event_CloseWindow
End
;Beispiel für Werte für ein Trapez
nopa=4 ;number of points in array
Dim p.point(nopa-1) ;weil ab null
p(0)\x=br/3
p(0)\y=0
p(1)\x=br-br/3
p(1)\y=0
p(2)\x=br
p(2)\y=hh
p(3)\x=0
p(3)\y=hh