Code: Alles auswählen
EnableExplicit
Enumeration
#Window_0
EndEnumeration
Enumeration
#Image_0
#Tree_0
#Combo_0
#Button_0
#Text_0
#Spin_0
#ImageID_0
EndEnumeration
Global gfOldImageProc
Procedure Win_ColorsInit (hDC, pColorLine, pLineWidth, pLineType, pColorFill, pFillMode, *hPen, *hBrush)
; E: hDC Windows DC
; pColorLine LinienFarbe
; pLineType #PS_SOLID/#PS_DASH/#PS_DOT/#PS_DASHDOT/#PS_DASHDOTDOT | #PS_ENDCAP_ROUND/#PS_ENDCAP_SQUARE/#PS_ENDCAP_FLAT | #PS_JOIN_ROUND/#PS_JOIN_BEVEL/#PS_JOIN_MITER
; pColorFill Füllfarbe
; pFillMode #ALTERNATE / #WINDING
; A: hPen Windows Pen
; hBrush Windows Brush
Protected tLBrush.LOGBRUSH
tLBrush\lbStyle = #BS_SOLID
tLBrush\lbColor = pColorFill
tLBrush\lbHatch = 0
Protected hPen = ExtCreatePen_(pLineType|#PS_GEOMETRIC,pLineWidth,@tLBrush,0,#Null)
SetPolyFillMode_(hDC,pFillMode)
Protected hBrush = CreateSolidBrush_(pColorFill)
PokeI (*hPen,hPen)
PokeI (*hBrush,hBrush)
hPen = SelectObject_(hDC,hPen)
DeleteObject_(hPen)
hBrush = SelectObject_(hDC,hBrush)
DeleteObject_(hBrush)
EndProcedure
Procedure Win_ColorsDel (hPen,hBrush)
DeleteObject_(hPen)
DeleteObject_(hBrush)
EndProcedure
Procedure Win_Polygon (hDC, iAnz.i, Array iX.i(1), Array iY.i(1))
Protected *tPoints.POINT = AllocateMemory(iAnz*SizeOf(POINT)), *tP
Protected i.i
*tP = *tPoints
For i = 0 To iAnz-1 Step 1
*tPoints\x = iX(i)
*tPoints\y = iY(i)
*tPoints + SizeOf(POINT)
Next i
Polygon_(hDC,*tP,iAnz)
FreeMemory(*tP)
EndProcedure
Procedure Win_PolyBezier (hDC, iAnz.i, Array iX.i(1), Array iY.i(1))
Protected *tPoints.POINT = AllocateMemory(iAnz*SizeOf(POINT))
Protected i.i
For i = 0 To iAnz-1 Step 1
*tPoints\x = iX(i)
*tPoints\y = iY(i)
*tPoints + SizeOf(POINT)
Next i
PolyBezier_(hDC,*tPoints,iAnz)
FreeMemory(*tPoints)
EndProcedure
Procedure Win_PolyLine (hDC, iAnz.i, Array iX.i(1), Array iY.i(1))
Protected i.i
MoveToEx_(hDC,iX(0),iY(0),#Null)
For i = 1 To iAnz-1 Step 1
LineTo_(hDC,iX(i),iY(i))
Next i
EndProcedure
Procedure Win_BezierTangente ( iPos.i, iAnz.i, Array iX.i(1), Array iY.i(1) ,*piTX, *piTY)
If iPos = 0
Protected iTX.i = iX(1)-iX(0), iTY.i = iY(1)-iY(0)
If iTX = 0 And iTY = 0
iTX.i = iX(2)-iX(0)
iTY.i = iY(2)-iY(0)
If iTX = 0 And iTY = 0
iTX.i = iX(3)-iX(0)
iTY.i = iY(3)-iY(0)
EndIf
EndIf
Else
iTX.i = iX(iAnz-1)-iX(iAnz-2)
iTY.i = iY(iAnz-1)-iY(iAnz-2)
If iTX = 0 And iTY = 0
iTX.i = iX(iAnz-1)-iX(iAnz-3)
iTY.i = iY(iAnz-1)-iY(iAnz-3)
If iTX = 0 And iTY = 0
iTX.i = iX(iAnz-1)-iX(iAnz-4)
iTY.i = iY(iAnz-1)-iY(iAnz-4)
EndIf
EndIf
EndIf
PokeI(*piTX,iTX)
PokeI(*piTY,iTY)
EndProcedure
Procedure Win_DrawPfeil (hDC, iTyp, iAnz.i, Array iX(1), Array iY(1), iBreite.i, iColor.i)
Protected hPen,hBrush
Win_ColorsInit (hDC, iColor, iBreite, iTyp|#PS_ENDCAP_FLAT|#PS_JOIN_ROUND, iColor, #WINDING, @hPen, @hBrush)
Win_PolyLine (hDC, iAnz, iX(), iY())
Win_ColorsDel(hPen,hBrush)
Protected iTX.i, iTY.i, iNX.i, iNY.i, iL.i
Win_BezierTangente ( 1, iAnz, iX(), iY() ,@iTX, @iTY)
iNX = -iTY
iNY = iTX
iL = Int(Sqr(iTX*iTX+iTY*iTY))
Protected Dim iXS.i(4)
Protected Dim iYS.i(4)
iXS(0) = iX(iAnz-1)
iYS(0) = iY(iAnz-1)
iXS(1) = iXS(0) + (2*iBreite*iNX)/iL
iYS(1) = iYS(0) + (2*iBreite*iNY)/iL
iXS(2) = iXS(0) + (4*iBreite*iTX)/iL
iYS(2) = iYS(0) + (4*iBreite*iTY)/iL
iXS(3) = iXS(0) - (2*iBreite*iNX)/iL
iYS(3) = iYS(0) - (2*iBreite*iNY)/iL
Win_ColorsInit (hDC, iColor, 2, #PS_GEOMETRIC|#PS_SOLID|#PS_ENDCAP_FLAT|#PS_JOIN_BEVEL, iColor, #WINDING, @hPen, @hBrush)
Win_Polygon (hDC, 4, iXS(), iYS())
Win_ColorsDel(hPen,hBrush)
EndProcedure
Procedure Draw (iAnz.i, Array iX.i(1), Array iY.i(1) )
Protected iTyp = GetGadgetState(#Combo_0)
If iTyp = -1
iTyp = #PS_SOLID
Else
iTyp = GetGadgetItemData(#Combo_0,iTyp)
EndIf
Protected hDC = StartDrawing(ImageOutput(#ImageID_0))
Box(0,0,GadgetWidth(#Image_0),GadgetHeight(#Image_0),RGB(50,50,50))
If iAnz > 1
Win_DrawPfeil (hDC, iTyp, iAnz, iX(), iY(), GetGadgetState(#Spin_0), RGB(250,250,250))
EndIf
StopDrawing()
SetGadgetState(#Image_0,ImageID(#ImageID_0))
EndProcedure
Procedure Win_CallBackImage(hWnd, Msg, wParam, lParam)
Protected iResult.i = 0
Protected iMausX.i= lParam & $FFFF
Protected iMausY.i= lParam>>16 & $FFFF
Static Dim siX.i(4)
Static Dim siY.i(4)
Static siDraw.i = 0
Select Msg
Case #WM_LBUTTONDOWN
If iMausX > 0 And iMausY > 0 And iMausX < GadgetWidth(#Image_0) And iMausY < GadgetHeight(#Image_0)
siX(0) = iMausX
siY(0) = iMausY
siDraw = 1
EndIf
Case #WM_LBUTTONUP
If iMausX > 0 And iMausY > 0 And iMausX < GadgetWidth(#Image_0) And iMausY < GadgetHeight(#Image_0)
siX(1) = iMausX
siY(1) = iMausY
siDraw = 0
If siX(1)<>siX(0) Or siY(1)<>siY(0)
Draw(2,siX(),siY())
EndIf
EndIf
Case #WM_MOUSEMOVE
If siDraw <> 0 And iMausX > 0 And iMausY > 0 And iMausX < GadgetWidth(#Image_0) And iMausY < GadgetHeight(#Image_0)
siX(1) = iMausX
siY(1) = iMausY
If siX(1)<>siX(0) Or siY(1)<>siY(0)
Draw(2,siX(),siY())
EndIf
EndIf
Default
iResult = CallWindowProc_(gfOldImageProc, hWnd, Msg, wParam, lParam)
EndSelect
ProcedureReturn iResult
EndProcedure
Procedure.i Open_WindowMain()
If OpenWindow(#Window_0, 50, 50, 750, 750, "Test", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
ImageGadget(#Image_0, 145, 5, 600, 600, #ImageID_0)
TreeGadget(#Tree_0, 0, 5, 130, 600)
ComboBoxGadget(#Combo_0, 0, 610, 130, 20)
AddGadgetItem(#Combo_0,0,"durchgehend")
SetGadgetItemData(#Combo_0,0,#PS_SOLID)
AddGadgetItem(#Combo_0,1,"gestrichelt")
SetGadgetItemData(#Combo_0,1,#PS_DASH)
AddGadgetItem(#Combo_0,2,"gepunkted")
SetGadgetItemData(#Combo_0,2,#PS_DOT)
AddGadgetItem(#Combo_0,3,"Strich-Punkt")
SetGadgetItemData(#Combo_0,3,#PS_DASHDOT)
AddGadgetItem(#Combo_0,4,"Strich-Punkt-Punkt")
SetGadgetItemData(#Combo_0,4,#PS_DASHDOTDOT)
SetGadgetState(#Combo_0,0)
ButtonGadget(#Button_0, 625, 720, 120, 30, "Beenden")
TextGadget (#Text_0,145,610,100,30,"Liniendicke :")
SpinGadget(#Spin_0,250,610,50,20,1,20,#PB_Spin_Numeric)
SetGadgetState(#Spin_0,2)
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure Main()
If CreateImage(#ImageID_0,600,600) = 0
MessageRequester("Achtung!","Kann Image nicht erstellen")
End
EndIf
If Open_WindowMain() = 0
MessageRequester("Achtung!","Kann Fenster nicht öffnen")
End
EndIf
gfOldImageProc = SetWindowLongPtr_(GadgetID(#Image_0), #GWL_WNDPROC, @Win_CallBackImage())
StartDrawing(ImageOutput(#ImageID_0))
Box(0,0,GadgetWidth(#Image_0),GadgetHeight(#Image_0),RGB(50,50,50))
StopDrawing()
SetGadgetState(#Image_0,ImageID(#ImageID_0))
Repeat
Protected iEvent.i = WaitWindowEvent()
Select iEvent
Case #PB_Event_Gadget
Select EventGadget()
Case #Button_0
iEvent = #PB_Event_CloseWindow
EndSelect
EndSelect
Until iEvent = #PB_Event_CloseWindow
CloseWindow(#Window_0)
EndProcedure
Main()