From a184c9fa41913e6a12e23fdf3d5ffa8e2260a23a Mon Sep 17 00:00:00 2001 From: Fabien Bodard Date: Tue, 7 May 2013 15:24:13 +0000 Subject: [PATCH] [GB.MAP] * NEW: A new static layer in the MapView give user control. It have just the zoom control for now. It can be disabled with the property ShowControls. * NEW: A new property Bounds in Map Class give the lat/lon coord at the limits of the drawed map. * NEW: Now shapes are stored directly in the ShapeLayer. It act like a collection. ex: Map!Shape.AddPoint("Home", MapPoint(0.05, 45)) You can access to it with Map!Shape!Home.Data * BUG: Many change in the zoom effect. I hope it is good git-svn-id: svn://localhost/gambas/trunk@5645 867c0c6c-44f3-4631-809d-bfa615b0a4ec --- comp/src/gb.db.form/.project | 2 +- comp/src/gb.map/.info | 28 +++- comp/src/gb.map/.src/Map.class | 15 +- comp/src/gb.map/.src/MapView.class | 93 ++++++++++--- comp/src/gb.map/.src/Shapes/_ShapeItem.class | 8 ++ comp/src/gb.map/.src/Sprite.class | 119 ++++++++++++++++ comp/src/gb.map/.src/Tests/FMain.class | 12 +- comp/src/gb.map/.src/Tests/FMain.form | 1 - comp/src/gb.map/.src/Types/MapBounds.class | 46 ++++++- comp/src/gb.map/.src/_MapLayer.class | 11 +- comp/src/gb.map/.src/_MapShape.class | 136 +++++++++++++++++-- comp/src/gb.map/.src/_MapTile.class | 12 +- comp/src/gb.map/.src/_ViewLayer.class | 127 +++++++++++++++++ comp/src/gb.map/bar.png | Bin 0 -> 180 bytes comp/src/gb.map/cursor.png | Bin 0 -> 601 bytes comp/src/gb.map/minus.png | Bin 0 -> 447 bytes comp/src/gb.map/plus.png | Bin 0 -> 481 bytes comp/src/gb.report/.project | 6 +- comp/src/gb.report/.src/ReportFrame.class | 2 +- comp/src/gb.report/.src/Tests/Report4.report | 3 +- comp/src/gb.report/.src/Tests/Report9.class | 2 + comp/src/gb.report/.src/Tests/Report9.report | 14 ++ 22 files changed, 574 insertions(+), 63 deletions(-) create mode 100644 comp/src/gb.map/.src/Sprite.class create mode 100644 comp/src/gb.map/.src/_ViewLayer.class create mode 100644 comp/src/gb.map/bar.png create mode 100644 comp/src/gb.map/cursor.png create mode 100644 comp/src/gb.map/minus.png create mode 100644 comp/src/gb.map/plus.png create mode 100644 comp/src/gb.report/.src/Tests/Report9.class create mode 100644 comp/src/gb.report/.src/Tests/Report9.report diff --git a/comp/src/gb.db.form/.project b/comp/src/gb.db.form/.project index d519379ff..a16a32426 100644 --- a/comp/src/gb.db.form/.project +++ b/comp/src/gb.db.form/.project @@ -1,7 +1,7 @@ # Gambas Project File 3.0 # Compiled with Gambas 3.4.0 Title=Data bound controls -Startup=FMain2 +Startup=FTest Version=3.4.0 VersionFile=1 Component=gb.image diff --git a/comp/src/gb.map/.info b/comp/src/gb.map/.info index 4b1a26be2..627b174dc 100644 --- a/comp/src/gb.map/.info +++ b/comp/src/gb.map/.info @@ -66,6 +66,10 @@ PixelBox r Rect +Bounds +r +MapBounds + _ShowWithEffect v b @@ -96,7 +100,7 @@ _MapShape (Name)s[(Shape)Shapes;] _get m -_MapLayer +o (Name)s _next m @@ -165,15 +169,11 @@ C _Properties C s -*,Border{Border.*},AllowEffect=true +*,Border{Border.*},AllowEffect=true, ShowControls=true _Group C s View -Map -r -Map - Lock p b @@ -182,10 +182,18 @@ Border p i +Map +r +Map + AllowEffect p b +ShowControls +p +b + :Click : @@ -214,6 +222,14 @@ View_MouseWheel m +_ZoomUp +m + +(X)i(Y)i +_ZoomDown +m + +(X)i(Y)i Map_Refresh m diff --git a/comp/src/gb.map/.src/Map.class b/comp/src/gb.map/.src/Map.class index 2dd642339..bbc47c984 100644 --- a/comp/src/gb.map/.src/Map.class +++ b/comp/src/gb.map/.src/Map.class @@ -8,7 +8,7 @@ Property Height As Integer Property Zoom As Integer Property Center As MapPoint Property Read PixelBox As Rect - +Property Read Bounds As MapBounds Private $iZoom As Integer = 1 Private $mpCenter As New MapPoint Private $iTop As Integer @@ -19,6 +19,7 @@ Private tmrLoad As New Timer As "tmrLoad" Private tmrDraw As New Timer As "tmrDraw" Private $bNeedReload As Boolean Private $PixelBox As New Rect +Private $Bounds As New MapBounds Private $PrevBox As Rect Private $iPrevent As Integer = 256 Private $aLayers As New _MapLayer[] @@ -94,6 +95,10 @@ Private Sub SetBoxes() $PixelBox.Y = ptCenter.Y - ($iHeight / 2) $PixelBox.Right = ptCenter.x + ($iWidth / 2) $PixelBox.Bottom = ptCenter.Y + ($iHeight / 2) + + $Bounds.TopLeft = Geo.PixelToMapPoint(Point($PixelBox.x, $PixelBox.y), $iZoom) + $Bounds.BottomRight = Geo.PixelToMapPoint(Point($PixelBox.Right, $PixelBox.Bottom), $iZoom) + '$PixelBox.Width = $iWidth '$PixelBox.Height = $iHeight ' Print "Largeur/hauteur", $iWidth, $iHeight @@ -199,7 +204,7 @@ Public Function AddShape(Name As String, Optional Shape As Shapes) As _MapShape End -Public Sub _get(Name As String) As _MapLayer +Public Sub _get(Name As String) As Object Return $aLayers[$aLayerNames.Find(Name)] @@ -268,3 +273,9 @@ End ' Private Sub Preload_Write(Value As Boolean) ' ' End + +Private Function Bounds_Read() As MapBounds + + Return $Bounds + +End diff --git a/comp/src/gb.map/.src/MapView.class b/comp/src/gb.map/.src/MapView.class index afba76a69..cecefcf7b 100644 --- a/comp/src/gb.map/.src/MapView.class +++ b/comp/src/gb.map/.src/MapView.class @@ -3,9 +3,17 @@ Export Inherits UserControl -Public Const _Properties As String = "*,Border{Border.*},AllowEffect=true" +Public Const _Properties As String = "*,Border{Border.*},AllowEffect=true, ShowControls=true" Public Const _Group As String = "View" +Property Lock As Boolean +Property Border As Integer +Property Read {Map} As Map +Property AllowEffect As Boolean +Property ShowControls As Boolean + +Private $bShowControls As Boolean = True + Private $hCenter As MapPoint Private $hMap As New Map As "Map" Private $hView As DrawingArea @@ -14,10 +22,7 @@ Private hWatch As New Watcher(Me) As "Watcher" Private $pCurCenterPx As Point Private $iX As Integer Private $iY As Integer -Property Lock As Boolean -Property Border As Integer Private $bLock As Boolean -Property Read {Map} As Map Private $hZoomBuffer As New Image Private $bZoomEffect As Boolean Private $tmrZoom As New Timer As "tmrZoom" @@ -31,8 +36,8 @@ Private $iSpeedX As Integer Private $iSpeedY As Integer Private $fInertia As Float = 0.9 Private $bShowInertia As Boolean -Property AllowEffect As Boolean Private $bAllowEffect As Boolean = True +Private $hViewLayer As New _ViewLayer As "ViewLayer" Private $tX As Integer Private $tY As Integer Event Click @@ -76,6 +81,7 @@ Public Sub View_Draw() Endif $hMap.Draw Raise Draw + If $bShowControls Then $hViewLayer._Draw Else If $iZoomWay = 1 Then @@ -112,33 +118,64 @@ Public Sub View_Draw() '$tmrZoom.Trigger Endif Endif + If $bShowControls Then $hViewLayer._Draw Endif End Public Sub View_MouseWheel() - Dim hpix As Point - - $ZX = Mouse.X - $ZY = Mouse.Y + + Draw.Begin($hZoomBuffer) Draw.FillRect(0, 0, Draw.Width, Draw.Height, Color.Transparent) $hmap.Draw Draw.End + If Mouse.Delta > 0 Then + _ZoomUp(Mouse.X, Mouse.Y) + $hMap.Center = Geo.PixelToMapPoint(Point($hMap.PixelBox.X + Mouse.X, $hMap.PixelBox.Y + Mouse.Y), $hmap.Zoom) + Else + _ZoomDown(Mouse.X, Mouse.Y) + Endif - $hMap.Zoom += Mouse.Delta + $hView.Refresh - hPix = New Point($hMap.PixelBox.X + Mouse.X, $hMap.PixelBox.Y + Mouse.Y) +End + +Public Sub _ZoomUp(X As Integer, Y As Integer) + + $ZX = X + $ZY = Y - If Mouse.Delta > 0 Then $hMap.Center = Geo.PixelToMapPoint(hpix, $hmap.Zoom) 'Mercator.MetersToMapPointFP(Mercator.PixelsToMetersP(hpix, $hMap.Zoom)) - If $bAllowEffect Then - $iZoomWay = Mouse.Delta - If $hmap.Zoom >= 1 And If $hmap.Zoom <= 18 Then $bZoomEffect = True + Draw.Begin($hZoomBuffer) + Draw.FillRect(0, 0, Draw.Width, Draw.Height, Color.Transparent) + $hmap.Draw + Draw.End + If $hmap.Zoom <= 18 Then + $iZoomWay = 1 + $bZoomEffect = True $tmrZoom.Start Endif - $hView.Refresh + Inc $hMap.Zoom + +End + +Public Sub _ZoomDown(X As Integer, Y As Integer) + + $ZX = X + $ZY = Y + + Draw.Begin($hZoomBuffer) + Draw.FillRect(0, 0, Draw.Width, Draw.Height, Color.Transparent) + $hmap.Draw + Draw.End + If $hmap.Zoom > 1 Then + $iZoomWay = -1 + $bZoomEffect = True + $tmrZoom.Start + Endif + Dec $hMap.Zoom End @@ -156,6 +193,8 @@ Public Sub View_MouseDown() $pCurCenterPx = Geo.MapPointToPixel($hmap.Center, $hmap.Zoom) $bShowInertia = False $tmrOnMove.Stop + If $bShowControls Then $hViewLayer._MouseDown() + 'Raise MouseDown End @@ -166,7 +205,8 @@ Public Sub View_MouseUp() If $bAllowEffect Then If Abs($iSpeedx) > 4 Or If Abs($iSpeedY) > 4 Then $tmrOnMove.Start Endif - Raise MouseUp + If $bShowControls Then $hViewLayer._MouseUp() + 'Raise MouseUp End @@ -189,8 +229,8 @@ Public Sub View_MouseMove() Endif $tx = Mouse.X $ty = Mouse.y - - Raise MouseMove + If $bShowControls Then $hViewLayer._MouseMove() + 'Raise MouseMove End @@ -242,7 +282,7 @@ Public Sub tmrZoom_Timer() End Public Sub tmrOnMove_Timer() - + Dim hpix As Point 'Print "triger" hPix = Geo.MapPointToPixel($hmap.Center, $hmap.Zoom) @@ -271,4 +311,17 @@ Private Sub AllowEffect_Write(Value As Boolean) $bAllowEffect = Value If Not $bAllowEffect Then $iZoomWay = 0 + +End + +Private Function ShowControls_Read() As Boolean + + Return $bShowControls + +End + +Private Sub ShowControls_Write(Value As Boolean) + + $bShowControls = Value + End diff --git a/comp/src/gb.map/.src/Shapes/_ShapeItem.class b/comp/src/gb.map/.src/Shapes/_ShapeItem.class index ab4579705..56d870803 100644 --- a/comp/src/gb.map/.src/Shapes/_ShapeItem.class +++ b/comp/src/gb.map/.src/Shapes/_ShapeItem.class @@ -19,3 +19,11 @@ Public Function Contains(hMapPoint As MapPoint) As Boolean End + +' Public Sub Delete() +' +' Dim hParent As _MapShape = Object.Parent(Me) +' +' hParent.Remove(Id) +' +' End diff --git a/comp/src/gb.map/.src/Sprite.class b/comp/src/gb.map/.src/Sprite.class new file mode 100644 index 000000000..48e7c06fe --- /dev/null +++ b/comp/src/gb.map/.src/Sprite.class @@ -0,0 +1,119 @@ +' Gambas class file + +Private $hRect As Rect +Property {Image} As Image +Property X As Integer +Property Y As Integer +Property Height As Integer +Property Width As Integer +Property Read {Rect} As Rect + +Private $hImage As Image + +Public Sub _new(hImage As Image, Optional hRect As Rect) + + $hImage = hImage + + If hRect Then + $hRect = hRect + Else + $hRect = Rect(0, 0, $hImage.Width, $hImage.Height) + Endif + +End + +Public Sub Draw() + + Draw.Image($hImage, $hRect.x, $hRect.Y, $hRect.Width, $hRect.Height) + +End + + + +Private Function Image_Read() As Image + + Return $hImage + +End + +Private Sub Image_Write(Value As Image) + + $hImage = Value + +End + +Public Sub Move(X As Integer, Y As Integer, Optional Width As Integer, Optional Height As Integer) + + $hRect.X = X + $hRect.Y = Y + If Width Then $hRect.Width = Width + If Height Then $hRect.Y = Height + +End + +Public Sub Resize(Width As Integer, Height As Integer) + + + $hRect.Width = Width + $hRect.Height = Height + +End + + + +Private Function X_Read() As Integer + + Return $hRect.X + +End + +Private Sub X_Write(Value As Integer) + + $hRect.X = Value + +End + +Private Function Y_Read() As Integer + + Return $hRect.Y + +End + +Private Sub Y_Write(Value As Integer) + + $hRect.Y = Value + +End + +Private Function Height_Read() As Integer + + Return $hRect.Height + +End + +Private Sub Height_Write(Value As Integer) + + $hRect.Height = Value + +End + +Private Function Width_Read() As Integer + + Return $hRect.Width + +End + +Private Sub Width_Write(Value As Integer) + + $hRect.Width = Value + +End + + + +Private Function Rect_Read() As Rect + + Return $hRect + +End + diff --git a/comp/src/gb.map/.src/Tests/FMain.class b/comp/src/gb.map/.src/Tests/FMain.class index f86aff8cb..b48190d39 100644 --- a/comp/src/gb.map/.src/Tests/FMain.class +++ b/comp/src/gb.map/.src/Tests/FMain.class @@ -34,7 +34,7 @@ Public Sub _new() MapView1.Map.AddShape("NewShape") 'MapView1.Map["NewShape"].Data = LoadShapes() - +'MapView1.ShowControls = False 'Manage the list of layers For Each o In MapView1.Map @@ -64,13 +64,13 @@ Public Sub MapView1_MouseDown() Endif If Mouse.Shift Then - If MapView1.Map["NewShape"].Data.Count = 0 Then + If MapView1.Map["NewShape"].Count = 0 Then hMapPoint.Add([Geo.PixelToMapPoint(point(MapView1.Map.PixelBox.X + Mouse.X, MapView1.Map.PixelBox.Y + Mouse.y), MapView1.Map.Zoom)]) - MapView1.Map["NewShape"].Data.AddPolygon(hMapPoint, "toto") - MapView1.Map["NewShape"].Data[0].Selected = True + MapView1.Map["NewShape"].AddPolygon("mypoly", hMapPoint) + MapView1.Map["NewShape"]["mypoly"].Selected = True Else - MapView1.Map["NewShape"].Data[0].Data[0].Add(Geo.PixelToMapPoint(point(MapView1.Map.PixelBox.X + Mouse.X, MapView1.Map.PixelBox.Y + Mouse.y), MapView1.Map.Zoom)) - MapView1.Map["NewShape"].Data[0].Center = Shapes.GetCenter(MapView1.Map["NewShape"].Data[0].Data[0]) + MapView1.Map["NewShape"]["mypoly"].Data[0].Add(Geo.PixelToMapPoint(point(MapView1.Map.PixelBox.X + Mouse.X, MapView1.Map.PixelBox.Y + Mouse.y), MapView1.Map.Zoom)) + MapView1.Map["NewShape"]["mypoly"].Center = Shapes.GetCenter(MapView1.Map["NewShape"]["mypoly"].Data[0]) Endif 'MapView1.Map["NewShape"].Data.AddPoint(Geo.PixelToMapPoint(point(MapView1.Map.PixelBox.X + Mouse.X, MapView1.Map.PixelBox.Y + Mouse.y), MapView1.Map.Zoom)) diff --git a/comp/src/gb.map/.src/Tests/FMain.form b/comp/src/gb.map/.src/Tests/FMain.form index e81a4f1bb..81b2a3a29 100644 --- a/comp/src/gb.map/.src/Tests/FMain.form +++ b/comp/src/gb.map/.src/Tests/FMain.form @@ -9,7 +9,6 @@ { MapView1 MapView MoveScaled(18,16,16,16) Expand = True - AllowEffect = False } { GridView1 GridView MoveScaled(72,11,25,35) diff --git a/comp/src/gb.map/.src/Types/MapBounds.class b/comp/src/gb.map/.src/Types/MapBounds.class index 3c1cac85a..7e5a4b43c 100644 --- a/comp/src/gb.map/.src/Types/MapBounds.class +++ b/comp/src/gb.map/.src/Types/MapBounds.class @@ -7,8 +7,8 @@ Property Bottom, Lat2, South As Float Private $mpTopLeft As New MapPoint Private $mpBottomRight As New MapPoint -Property Read TopLeft As MapPoint -Property Read BottomRight As MapPoint +Property TopLeft As MapPoint +Property BottomRight As MapPoint Private Function Left_Read() As Float @@ -70,3 +70,45 @@ Private Function BottomRight_Read() As MapPoint Return $mpBottomRight End + +Public Function InBounds(P As MapPoint) As Boolean + + If p.Lon > $mpTopLeft.Lon And If p.Lon < $mpBottomRight.Lon Then + If p.Lat > $mpTopLeft.Lat And If p.Lat < $mpBottomRight.Lat Then + Return True + Endif + Endif + +End + +Public Function Contain(Bound As MapBounds) As Boolean + + If Bound.Lon > $mpTopLeft.Lon And If Bound.Lon2 < $mpBottomRight.Lon Then + If Bound.Lat > $mpTopLeft And If Bound.Lat2 < $mpBottomRight.Lat Then + Return True + Endif + Endif + +End + +Public Function Merge(Bound As MapBounds) As MapBounds + Dim hBound As New MapBounds + hBound.Lon = Min($mpTopLeft.Lon, Bound.Lon) + hBound.Lon2 = Max($mpBottomRight.Lon, Bound.Lon2) + hBound.Lat = Min($mpTopLeft, Bound.Lat) + hBound.Lat2 = Max($mpBottomRight.Lat, Bound.Lat2) + Return hBound + +End + +Private Sub TopLeft_Write(Value As MapPoint) + + $mpTopLeft = Value + +End + +Private Sub BottomRight_Write(Value As MapPoint) + + $mpBottomRight = Value + +End diff --git a/comp/src/gb.map/.src/_MapLayer.class b/comp/src/gb.map/.src/_MapLayer.class index 5d817f0fd..60a3abfec 100644 --- a/comp/src/gb.map/.src/_MapLayer.class +++ b/comp/src/gb.map/.src/_MapLayer.class @@ -5,7 +5,9 @@ Private $bVisible As Boolean = True Property Visible As Boolean Public Copyright As String Public $aStack As New String[] -Property Data As Shapes +Property Opacity As Float +Private $fOpaciy As Float = 1 + Event Refresh @@ -51,13 +53,14 @@ Public Function CountActiveClients() As Integer End +Private Function Opacity_Read() As Float -Private Function Data_Read() As Shapes - + Return $fOpaciy End -Private Sub Data_Write(Value As Shapes) +Private Sub Opacity_Write(Value As Float) + $fOpaciy = Min(1, Max(0, Value)) End diff --git a/comp/src/gb.map/.src/_MapShape.class b/comp/src/gb.map/.src/_MapShape.class index 29ca96d98..3ac932f51 100644 --- a/comp/src/gb.map/.src/_MapShape.class +++ b/comp/src/gb.map/.src/_MapShape.class @@ -1,12 +1,21 @@ ' Gambas class file Inherits _MapLayer -Private $hShapes As New Shapes + +Public Const {Point} As Integer = 1 +Public Const MultiPoint As Integer = 8 +Public Const Polyline As Integer = 3 +Public Const Polygon As Integer = 5 + +Private $hShapes As New _ShapeItem[] Private $himgPoint As Image -Property Data As Shapes +'Property Data As Shapes Property {Color} As Integer Private $icolor As Integer Private $sCurrent As String +Private $colIDShape As New Collection +Property Read Count As Integer + Public Sub _new(Optional hShape As Shapes) $himgPoint = Image.Load("point.png") @@ -17,10 +26,50 @@ Public Sub Load() End -Public Sub AddPoint(Data As MapPoint) +Public Sub AddPoint(Id As String, Data As MapPoint) - $hShapes.AddPoint(Data) + Dim hItem As New _ShapeItem + hItem.Type = Me.Point + hItem.Id = Id + hItem.Center = Data + hItem.Data = Data + $hShapes.Add(hItem) + $colIDShape[Id] = $hShapes.Max +End + +Public Sub AddMultipoint(Id As String, Data As MapPoint[]) + Dim hItem As New _ShapeItem + hItem.MultiPoint = MultiPoint + hItem.Id = Id + hItem.Center = GetCenter(Data) + hItem.Data = Data + $hShapes.Add(hItem) + $colIDShape[Id] = $hShapes.Max +End + +Public Sub AddPolyLine(Id As String, Data As MapPoint[]) + + Dim hItem As New _ShapeItem + hItem.Type = Polyline + hItem.Id = Id + hItem.Center = GetCenter(Data) + hItem.Box = GetDataBox(Data) + hItem.Data = Data + $hShapes.Add(hItem) + $colIDShape[Id] = $hShapes.Max +End + +Public Sub AddPolygon(Id As String, Data As MapPoint[][]) + + Dim hItem As New _ShapeItem + hItem.Type = Polygon + hItem.Id = Id + hItem.Center = GetCenter(Data[0]) + hItem.Box = GetDataBox(Data[0]) + hItem.Data = Data + $hShapes.Add(hItem) + $colIDShape[Id] = $hShapes.Max End Public Sub _Draw() @@ -34,22 +83,22 @@ Public Sub _Draw() If $hShapes.Count = 0 Then Return For i = 0 To $hShapes.Max - iColor = Me.Color + iColor = Color.SetAlpha(Me.Color, 255 * Me.Opacity) If $hShapes[i].Selected Then icolor = Color.White Select Case $hShapes[i].Type - Case Shapes.Point + Case Me.Point pt = Geo.MapPointToPixel($hShapes[i].Data, hMap.zoom) Paint.Brush = Paint.Color(Color.Green) 'Paint.Arc(pt.X - hMap.PixelBox.X, pt.Y - hMap.PixelBox.Y, 5) Paint.DrawImage($himgPoint, pt.X - hMap.PixelBox.X - 16, pt.Y - hMap.PixelBox.Y - 32) - Case Shapes.MultiPoint + Case MultiPoint For j = 0 To $hShapes[i].Data.Max pt = Geo.MapPointToPixel($hShapes[i].Data[j], hMap.zoom) Paint.DrawImage($himgPoint, pt.X - hMap.PixelBox.X - 16, pt.Y - hMap.PixelBox.Y - 32) Next - Case Shapes.Polygon + Case Polygon hPoly = New Integer[] For j = 0 To $hShapes[i].Data[0].Max pt = Geo.MapPointToPixel($hShapes[i].Data[0][j], hMap.zoom) @@ -87,17 +136,12 @@ Public Sub _Draw() End -Private Function Data_Read() As Shapes +Public Function _get(Id As String) As _ShapeItem - Return $hShapes + Return $hShapes[$colIDShape[id]] End -Private Sub Data_Write(Value As Shapes) - - $hShapes = Value - -End Private Function GetMap() As Map @@ -116,3 +160,65 @@ Private Sub Color_Write(Value As Integer) $icolor = Value End + +Static Public Function GetCenter(hPoints As MapPoint[]) As MapPoint + 'Dim PCenter As New FPoint[] + Dim tmpA, A, Gx, Gy As Float + Dim j, k As Integer + 'calcul du centre + 'fp = New FPoint + A = 0 + gx = 0 + Gy = 0 + For k = 0 To hPoints.Max + j = IIf(k + 1 <= hPoints.Max, k + 1, 0) + tmpA = (hPoints[k].Lon * hPoints[j].Lat) - (hPoints[j].Lon * hPoints[k].Lat) + A += tmpA + Gx += tmpA * (hPoints[k].Lon + hPoints[j].Lon) + Gy += tmpA * (hPoints[k].Lat + hPoints[j].Lat) + Next + A = A / 2 + gx = gx / (6 * A) + gy = gy / (6 * A) + + Return MapPoint(GY, GX) + Catch + +End + +Private Function GetDataBox(hMapPoints As MapPoint[]) As RectF + + Dim hPoint As MapPoint + Dim hRectF As New RectF + Dim X, Y, X2, Y2 As Float + X = hMapPoints[0].Lon + Y = hMapPoints[0].Lat + X2 = X + Y2 = Y + For Each hPoint In hMapPoints + X = Min(hPoint.lon, X) + Y = Min(hPoint.lat, Y) + X2 = Max(hPoint.lon, X2) + Y2 = Max(hPoint.lat, Y2) + Next + Return hRectF(X, Y, X2 - X, Y2 - Y) +End + +Private Function Count_Read() As Integer + + Return $hShapes.Count + +End + +Public Sub Remove(Id As String) + + $hShapes.Remove($colIDShape[Id]) + $colIDShape.Remove(Id) + +End + +Public Sub Exist(Id As String) As Boolean + + Return $colIDShape.Exist(id) + +End diff --git a/comp/src/gb.map/.src/_MapTile.class b/comp/src/gb.map/.src/_MapTile.class index ca2b3f299..c0aae25f2 100644 --- a/comp/src/gb.map/.src/_MapTile.class +++ b/comp/src/gb.map/.src/_MapTile.class @@ -79,7 +79,7 @@ Public Sub _Draw() 'Draw.Foreground = Color.Green 'Draw.Text("TileOK", hTile.X * 256 - hMap.PixelBox.X, hTile.Y * 256 - hMap.PixelBox.Y) Case _Tile.Error - Paint.Brush = Paint.Color(Color.SetAlpha(Color.White, 125)) + Paint.Brush = Paint.Color(Color.SetAlpha(Color.White, Min(125, (255 * $fOpacity)))) Paint.Rectangle(hTile.X * 256 - hMap.PixelBox.X, hTile.Y * 256 - hMap.PixelBox.Y, 256, 256) Paint.Fill 'Draw.Image(Picture["icon:/256/cancel"].Image, hTile.X * 256 - hMap.PixelBox.X, hTile.Y * 256 - hMap.PixelBox.Y) @@ -442,3 +442,13 @@ Private Sub Opacity_Write(Value As Float) $fGradStep = $fOpacity / 10 End + +Public Sub _free() + Dim hClient As HttpClient + For Each hClient In $aClients + hClient.Stop + + Next + $aClients.Clear +End + diff --git a/comp/src/gb.map/.src/_ViewLayer.class b/comp/src/gb.map/.src/_ViewLayer.class new file mode 100644 index 000000000..44940dc23 --- /dev/null +++ b/comp/src/gb.map/.src/_ViewLayer.class @@ -0,0 +1,127 @@ +' Gambas class file + +Event foo +Private $colSprite As New Collection +Private $bMouseDown As Boolean +Private $memZoom As Integer +Private $bInCursor As Boolean + +Public Sub _new() + + Dim hMv As MapView = GetMapView() + Dim hPlus As Sprite = New Sprite(Image.Load("plus.png")) + + hPlus.Move(30, 70) + + $colSprite!bar = New Sprite(Image.Load("bar.png")) + $colSprite!bar.Move(hplus.X + (hPlus.Width - $colSprite!bar.Width) / 2, hplus.Rect.Bottom - hplus.Height / 3) + $colSprite!bar.Height = 150 + hplus.height / 3 + + $colSprite!plus = hplus + + $colSprite!minus = New Sprite(Image.Load("minus.png")) + $colSprite!minus.Move($colSprite!plus.X, $colSprite!bar.Rect.Bottom - hPlus.Height / 3) + + $colSprite!cursor = New Sprite(Image.Load("cursor.png")) + $colSprite!cursor.Move($colSprite!plus.X, $colSprite!minus.y - $colSprite!cursor.Height - (150 / 18 * hMv.Map.Zoom)) + $memZoom = hMv.Map.Zoom + +End + +Public Sub _Draw() + + Dim hSpr As Sprite + Dim hMv As MapView = GetMapView() + + If $memZoom <> hMv.Map.Zoom Then + $colSprite!cursor.Move($colSprite!plus.X, $colSprite!minus.y - (150 / 18 * hMv.Map.Zoom)) + $memZoom = hMv.Map.Zoom + Endif + For Each hSpr In $colSprite + + hSpr.Draw + + Next + +End + +Private Function GetMapView() As MapView + + Return Object.Parent(Me) + +End + +Public Sub _MouseMove() + + Dim hMv As MapView = GetMapView() + Dim iMouse As Integer = hMv.Mouse + Dim iZoom As Integer + 'hMv.Mouse = Mouse.Default + If $colSprite!plus.Rect.Contains(Mouse.X, Mouse.Y) Then + hMv.Mouse = Mouse.Pointing + Return + Endif + If $colSprite!cursor.Rect.Contains(Mouse.X, Mouse.Y) Then + hMv.Mouse = Mouse.SizeV + If $bMouseDown Then + $bInCursor = True + + Endif + Return + Endif + If $colSprite!minus.Rect.Contains(Mouse.X, Mouse.Y) Then + hMv.Mouse = Mouse.Pointing + Else + + hMv.Mouse = Mouse.Default + Endif + If $bInCursor Then + $colSprite!cursor.Y = Max($colSprite!plus.Rect.bottom, Min($colSprite!minus.Y - $colSprite!cursor.Height / 2, Mouse.y - $colSprite!cursor.Height / 2)) + iZoom = 18 / 150 * ($colSprite!minus.Y - Mouse.y) + If iZoom <> hMv.Map.Zoom Then + hMv.Map.Zoom = iZoom + $memZoom = iZoom + Endif + hMv.Refresh + Endif + +End + +Public Sub _MouseDown() + + Dim hMv As MapView = GetMapView() + + If Mouse.Left Then + $bMouseDown = True + + If $colSprite!plus.Rect.Contains(Mouse.X, Mouse.Y) Then + hMv._ZoomUp(hMv.ClientW / 2, hMv.ClientH / 2) + hMv.Refresh + hMv.Lock = True + Endif + If $colSprite!minus.Rect.Contains(Mouse.X, Mouse.Y) Then + hMv._ZoomDown(hMv.ClientW / 2, hMv.ClientH / 2) + hMv.Refresh + hMv.Lock = True + Endif + If $colSprite!cursor.Rect.Contains(Mouse.X, Mouse.Y) Then + + hMv.Refresh + hMv.Lock = True + Endif + + Endif + +End + +Public Sub _MouseUp() + + Dim hMv As MapView = GetMapView() + + hMv.Lock = False + $bInCursor = False + $bMouseDown = False + +End + + diff --git a/comp/src/gb.map/bar.png b/comp/src/gb.map/bar.png new file mode 100644 index 0000000000000000000000000000000000000000..381974b30cfdf7314b7f0a321f32ba9929b06259 GIT binary patch literal 180 zcmeAS@N?(olHy`uVBq!ia0vp^>>$j+1|*LJg2?p zUk71ECym(^Ktah8*NBqf{Irtt#G+J&^73-M%)IR4Fn!Zpg2^psMQKeUW}R_-wtX}!}wkEPcYN=HE*lxFXwr$gK*6THyrb(XX`I==} zWEcjyu6yRIR4SW7q3{7foQS|5Y6v9~iMN?dMr4fnNg9m?s?{ni%ks5Or-NFphWUK% zYr$X;>2z95CX;Uf1Ob3Q9L5-X8V-lAKAYqAwG+{qF3U0>3Wd}|wcwBbhxU0F_|$R= z{_k@H(>)2!<6KX?|AqiO0K4sW`+GK!f_k~0s&vsG!2{02GMBrj5e7} z+~sol6Tt2Wb^w^e;qXhZ*L$g|YCx7{06;30x`-2x$1k+$bc(@X;OV;l6@YaLzU_9q zpA|)UQLoqEiK6Hd(SsLi+qO3vjVi5H>l*+Q*l&=-zH1RcFqg}zilRJo97nhY7X-oM ndEV1?{a3%=|9ePl6Os213*_QWODAVZ00000NkvXXu0mjfBk2V% literal 0 HcmV?d00001 diff --git a/comp/src/gb.map/minus.png b/comp/src/gb.map/minus.png new file mode 100644 index 0000000000000000000000000000000000000000..55f9818dcd4242085a45ab90e3dc59d732ece3d5 GIT binary patch literal 447 zcmV;w0YLtVP)aFc!BP^a_t3N zc9(^h=&r};Muvu>o}d^>Hx-jS7p66fR+`WX{oye%10UZo!+T0ZI7C#XY(ST*s>u-` z2QnZRkwTY{lYYPNhhaF>T6dcmW?A-PjJc1Z=owh949|lgc<6LGx4mA^R;sQrOsCU! zp68FiT@~DN9H;Afp6$AB6JdPcSCh%)8fXFU7GMEqMN!y|h?R(l1vr#Y3$R6`{{1({ zUV)+hFW8t;PF2Bs&%wZY+d&jXI{^lR!N&dnH{NElYmV>nju*U_Zm*P*6-xsJkR?fC zj4__px=}Nl&1SM#EMEC(_G|FxXf%2PF5@`9p}_=6)AVgT9uI*fB|rlgz!lI2T;P=7 pk@Y9AtS=x1=D=J;KGdOx={J}VXJ~mJ5-b1!002ovPDHLkV1f`Ux4ZxV literal 0 HcmV?d00001 diff --git a/comp/src/gb.map/plus.png b/comp/src/gb.map/plus.png new file mode 100644 index 0000000000000000000000000000000000000000..cf1079fd2eaa6edfde2c85d5633d9297db5a60db GIT binary patch literal 481 zcmV<70UrK|P)%P-F-gJ_8M6=l} z1pa@IclsJ{s%UL<<&F=T_6n)v6|kJmX79t{&@)YQuh^VSCK|`_2av3Tzk0piYmy|D z(P(rJKS{MyBBCOqQ51dl`~4SS0cl`ZKn1u0T;LKoBQ4V|xMm{;B47$kRdp`M`b@t8 X7$O3`w00000NkvXXu0mjf+bzZk literal 0 HcmV?d00001 diff --git a/comp/src/gb.report/.project b/comp/src/gb.report/.project index 400c341db..f761e31b4 100644 --- a/comp/src/gb.report/.project +++ b/comp/src/gb.report/.project @@ -1,9 +1,9 @@ # Gambas Project File 3.0 -# Compiled with Gambas 3.3.90 +# Compiled with Gambas 3.4.0 Title=Report designer -Startup=Report4 +Startup=Report9 Icon=printer1.png -Version=3.3.90 +Version=3.4.0 VersionFile=1 Component=gb.image Component=gb.gui diff --git a/comp/src/gb.report/.src/ReportFrame.class b/comp/src/gb.report/.src/ReportFrame.class index 4cca38af9..02f54844b 100644 --- a/comp/src/gb.report/.src/ReportFrame.class +++ b/comp/src/gb.report/.src/ReportFrame.class @@ -110,7 +110,7 @@ Public Sub _PaintAfter((Page) As Integer, (X) As Float, (Y) As Float, (hControl) Y1 = (y + hControl.RealTop) X2 = (x + hControl.RealLeft + hControl.RealWidth) Y2 = (y + hControl.RealTop + hControl.RealHeight) - +If Me.Tag = "**" Then Stop If $hBorder.RoundCorner._Active Then fLeftWidth = MTools.UnitsToPixels($hBorder._Left) / 2 paint.LineWidth = fLeftWidth * 2 diff --git a/comp/src/gb.report/.src/Tests/Report4.report b/comp/src/gb.report/.src/Tests/Report4.report index ea4734828..9f88d4b0c 100644 --- a/comp/src/gb.report/.src/Tests/Report4.report +++ b/comp/src/gb.report/.src/Tests/Report4.report @@ -10,7 +10,8 @@ Height = "2cm" Fixed = True Font = Font["Bold,+6"] - Border = ReportBorder["Top:1mm #000000;Bottom:1mm #000000;Left:1mm #000000;Right:1mm #000000"] + Tag = "**" + Border = ReportBorder["Top:1mm #000000;Bottom:1mm #000000;Left:1mm #000000;Right:1mm #000000;TopLeftCorner:6mm;BottomLeftCorner:7mm"] Background = ReportBrush["LinearGradient(0.7,0,0.7,1,[#FFCFBF,#FFFFFF],[0,1])"] Text = ("IMPRESSION DU PLAN COMPTABLE") Alignment = Align.Center diff --git a/comp/src/gb.report/.src/Tests/Report9.class b/comp/src/gb.report/.src/Tests/Report9.class new file mode 100644 index 000000000..0a5fa73ac --- /dev/null +++ b/comp/src/gb.report/.src/Tests/Report9.class @@ -0,0 +1,2 @@ +' Gambas class file + diff --git a/comp/src/gb.report/.src/Tests/Report9.report b/comp/src/gb.report/.src/Tests/Report9.report new file mode 100644 index 000000000..aad8513d5 --- /dev/null +++ b/comp/src/gb.report/.src/Tests/Report9.report @@ -0,0 +1,14 @@ +# Gambas Form File 3.0 + +{ Report Report + #MoveScaled(0,0,64,64) + Index = 0 + Text = ("") + { ReportLabel1 ReportLabel + #MoveScaled(1,3,61,15) + Height = "3cm" + Border = ReportBorder["Top:1mm #000000;Bottom:1mm #000000;Left:1mm #000000;Right:1mm #000000;TopLeftCorner:8mm;BottomLeftCorner:1cm"] + Text = ("ReportLabel1") + } + Index = 0 +}