Thanks Tim (and Karen for sending me a copy of WFS)…
Have not yet looked at the WFS code, but based on Tim’s post above…looks like you have to call a “special” drawline, (dang), the OSX version uses the same DrawLine that you use if you were not messing with the pen pattern
Actually I did not send you the WFS… It was Aaron Ballman’s Advanced Graphics for Windows Which has a has classes and modules to use a lot of the GDI+ graphics capabilities that Xojo does not give access to directly.
Again some of this stuff REALLY should be in the Xojo framework as we should really not have to resort to declares or roll our own just to do things like draw patterned lines in a RAD environment these days.
Ok… I took the Cocoa code I already had, and the GDI code that Tim supplied above
and merged them into a single routine
SUB DrawDashedLine(g as graphics,x1 as integer,y1 as integer,x2 as integer,y2 as integer,pattern as integer=0)
Const DashStyleSolid = 0
Const DashStyleDash = 1
Const DashStyleDot = 2
Const DashStyleDashDot = 3
Const DashStyleDashDotDot = 4
//Const DashStyleCustom = 5
If pattern<=DashStyleSolid Or pattern>DashStyleDashDotDot Then
// ** Solid Line is same regardless of Platform ** /
g.drawline x1,y1,x2,y2
Exit Sub
Else
#If TargetCocoa Then
Const sizeOfSingle = 4
// ************************** //
// ** Cocoa Pattern Line ** //
// ************************** //
Dim lengths(-1) As Double
Dim x As Integer
Dim lengthArray As MemoryBlock
Dim offset As Integer = 0
Dim dash As Double
Dim dot As Double
Dim spc As Double
Dim aa_flag As Boolean=g.AntiAlias
Declare Sub CGContextSetLineDash Lib "Cocoa" ( context As Integer, phase As Single, lengths As Ptr, count As UInt32)
x=g.penwidth
dash=x*3
dot=x
spc=dot
g.AntiAlias=False
Select Case pattern
Case DashStyleDot
lengths=Array(dot,spc) ' dotted line [.......]
Case DashStyleDash
lengths=Array(dash,spc) ' dashed line [- - - -]
Case DashStyleDashDot
lengths=Array(dash,spc,dot,spc)
Case DashStyleDashDotDot
lengths=Array(dash,spc,dash,spc,dot,spc,dot,spc)
End Select
//
lengthArray=New MemoryBlock(sizeOfSingle*(1 + UBound(lengths)))
For i As Integer = 0 To UBound(lengths)
lengthArray.SingleValue(offset) = lengths(i)
offset = offset + sizeOfSingle
Next
CGContextSetLineDash g.handle( g.HandleTypeCGContextRef ),0,lengthArray,lengths.Ubound+1
//
g.drawline x1,y1,x2,y2
//
CGContextSetLineDash g.handle( g.HandleTypeCGContextRef ),0,Nil,0 ' solid line
//
g.AntiAlias=aa_flag
#ElseIf TargetWin32 Then
// ************************** //
// ** Windows Pattern Line ** //
// ************************** //
Dim pen As Integer
Dim n As Integer
Dim c As Color
Dim gpx As Integer
Dim mb As New MemoryBlock(4)
Declare Function GdipCreatePen1 Lib "GDIPlus" (c As Integer, width As Single, unit As Integer, ByRef p As Integer) As Integer
Declare Function GdipSetPenDashStyle Lib "GDIPlus" (pen As Integer, style As Integer) As Integer
Declare Function GdipCreateFromHDC Lib "GDIPlus" (hdc As Integer, ByRef g As Integer) As Integer
Declare Function GdipDrawLine Lib "GDIPlus" (g As Integer, pen As Integer, x1 As Single, y1 As Single, x2 As Single, y2 As Single) As Integer
Declare Function GdipDeletePen Lib "GDIPlus" (pen As Integer) As Integer
Declare Function GdipDeleteGraphics Lib "GDIPlus" (g As Integer) As Integer
c = g.ForeColor
mb.Byte(0) = c.blue
mb.Byte(1) = c.green
mb.Byte(2) = c.red
mb.Byte(3) = 255 // alpha = opaque
n = mb.Int32Value(0)
Call GdipCreatePen1(n, g.PenWidth, 2, pen)
Call GdipSetPenDashStyle(pen, pattern)
Call GdipCreateFromHDC(g.handle(Graphics.HandleTypeHDC), gpx)
Call GdipDrawLine(gpx, pen, x1, y1, x2, y2)
Call GdipDeletePen(pen)
Call GdipDeleteGraphics(gpx)
#EndIf
End IfTEST
Dim i As Integer
Dim y As Integer=50
For i=0 To 4
g.ForeColor=&cff0000
g.drawline 0,y,10,y
g.ForeColor=&c000000
g.drawstring Str(i),0,y+g.TextAscent
DrawDashedLine g,10,y,g.width,y,i
y=y+50
Next iNow… this “works”… but not correctly
In WIndows, the lines (in the test are way above the designated “Y” and DO NOT
The short RED line should line up with the beginning of the pattern line, but in Windows it doesn’t
plus the lines do not extend to the same end location as OSX does…
Any ideas as to why?
Is is possible that you need to specify the unit of measure? see here
I haven’t used graphics APIs for a long long time, but this kind of problem rings a bell.
The “2” in
Call GdipCreatePen1(n, g.PenWidth, 2, pen)specifies pixels as the unit of measure. And in my testing, this code matched xojo’s graphics.drawline. (Although I wasn’t testing for that specifically, so I didn’t magnify it to look at the pixel alignment.)
Just retested under magnification, and it looks exactly how I would expect. I drew 2 lines, one in xojo and one in gdi+, offset by one pixel so I could see the overlap.
g.ForeColor= &c000000
g.drawrect 0,0,g.width,g.height
y = 10
g.ForeColor = &c0000FF
g.drawline(0,y,10,y)
g.ForeColor = &cFF0000
DrawDash(g, 10, y+1, g.width,y+1)The blue (xojo) line overlapped the outer rectangle at position 0 and stopped at position 10. The red (gdi+) line overlapped the blue line by one pixel (at position 10) and ended by overlapping the outer rectangle at g.width.
I used the exact code I posted (with the “test code” being in the PAINT event of a Canvas
Running under OSX resulted in expected results
Running REMOTE (from OSX to a WIN7 computer), all the custom lines where more that 100 pixels above where they should be
The line patterns matched… but the Y position was way way off (and yes I have “2” for pixels), and the width is like 80%
I can post the project and screenshots from both later this afternoon
I copied your code into my project and the lines look perfect. Try running directly on the win7 machine, not remote.
here is what I see
will do that later, and let you know
I get a display that matches your Cocoa screenshot.