lixuebao09
路人甲
路人甲
  • 注册日期2005-03-08
  • 发帖数19
  • QQ
  • 铜币184枚
  • 威望0点
  • 贡献值0点
  • 银元0个
20楼#
发布于:2005-06-01 12:42
Deg2XY函数是什么啊,有没有具体的代码?
举报 回复(0) 喜欢(0)     评分
wangjh
论坛版主
论坛版主
  • 注册日期2003-08-22
  • 发帖数994
  • QQ55359982
  • 铜币2579枚
  • 威望0点
  • 贡献值0点
  • 银元0个
21楼#
发布于:2005-06-03 14:20
<P>'经纬度BL换算到高斯平面直角坐标XY(高斯投影正算)<BR>Private Function Deg2XY(ByRef F2 As Double, ByRef E2 As Double, _<BR>                ByRef s2 As Double, ByRef t2 As Double) As Boolean<BR>                'A2 输入中央子午线,以度.分秒形式输入,如115度30分则输入115.30; 起算数据L0<BR>                'F2 以度小数形式输入经度值, L<BR>                'E2 以度小数形式输入纬度值,B<BR>                'S2 计算结果,横坐标Y,,请特别注意,这里生成的是高斯坐标<BR>                'T2 计算结果,纵坐标X<BR>                '投影带号计算 n=[L/6]+1   如:兰州测得经度103.XXXX,故n=[103.X/6]+1=17+1=18<BR>                '中央经线经度 L0 = n*6-3 = [L/6]*6+3<BR>                <BR>    'ByRef A2 As Double,<BR>    Dim A2 As Double<BR>    Dim B2 As Double<BR>    'Dim G2 As Double<BR>    Dim H2 As Double<BR>    Dim i2 As Double<BR>    Dim J2 As Double<BR>    Dim K2 As Double<BR>    Dim l2 As Double<BR>    Dim M2 As Double<BR>    Dim n2 As Double<BR>    Dim O2 As Double<BR>    Dim P2 As Double<BR>    Dim Q2 As Double<BR>    Dim R2 As Double<BR>    Dim NN As Integer '投影代号<BR>'    A2 = CInt(F2 / 6) * 6 - 3<BR>    <BR>'    B2 = Int(A2) + (Int(A2 * 100) - Int(A2) * 100) / 60 + (A2 * 10000 - Int(A2 * 100) * 100) / 3600<BR>    '把L0化成度(A2)<BR>    NN = CInt(F2 / 6) + 1 '投影代号n=[L/6]+1 '<BR>    B2 = NN * 6 - 3 '中央经线<BR>    'G2 = F2 - B2 ' L -L0<BR>    'H2 = G2 / 57.2957795130823 '化作弧度<BR>    H2 = (F2 - B2) / 57.2957795130823 '将经差的单位化为弧度<BR>    i2 = Tan(E2 / 57.2957795130823) 'Tan (B)<BR>    J2 = Cos(E2 / 57.2957795130823) ' Cos (B)<BR>    K2 = 0.006738525415 * J2 * J2<BR>    l2 = i2 * i2<BR>    M2 = 1 + K2<BR>    n2 = 6399698.9018 / Sqr(M2)<BR>    O2 = H2 * H2 * J2 * J2<BR>    P2 = i2 * J2<BR>    Q2 = P2 * P2<BR>    R2 = (32005.78006 + Q2 * (133.92133 + Q2 * 0.7031))<BR>    s2 = ((((l2 - 18) * l2 - (58 * l2 - 14) * K2 + 5) * O2 / 20 + M2 - l2) * O2 / 6 + 1) * n2 * (H2 * J2)<BR>    <BR>    '计算结果,横坐标Y,这里生成的是高斯坐标<BR>    s2 = s2 + NN * 1000000 + 500000 '18500000 '在计算的基础上加上了“带号”(18)和“东移”(500KM)<BR>    '计算结果,纵坐标X<BR>    t2 = 6367558.49686 * E2 / 57.29577951308 - P2 * J2 * R2 + ((((l2 - 58) * l2 + 61) * _<BR>        O2 / 30 + (4 * K2 + 5) * M2 - l2) * O2 / 12 + 1) * n2 * i2 * O2 / 2<BR>    <BR>    Deg2XY = True<BR>End Function</P>
网 站: www.52xoo.com (3S,信息融合,数字图像处理,模式识别与人工智能等专业电子书、学术文章及源代码共享) E-mail: Jianhong72@163.com QQ: 88128745 (55359982用了近10年,最近被盗了,郁闷!!!)
举报 回复(0) 喜欢(0)     评分
lixuebao09
路人甲
路人甲
  • 注册日期2005-03-08
  • 发帖数19
  • QQ
  • 铜币184枚
  • 威望0点
  • 贡献值0点
  • 银元0个
22楼#
发布于:2005-06-04 09:38
谢谢老大
举报 回复(0) 喜欢(0)     评分
fair
路人甲
路人甲
  • 注册日期2005-06-07
  • 发帖数8
  • QQ
  • 铜币126枚
  • 威望0点
  • 贡献值0点
  • 银元0个
23楼#
发布于:2005-06-07 21:03
<img src="images/post/smile/dvbbs/em02.gif" />
举报 回复(0) 喜欢(0)     评分
wfoegl
路人甲
路人甲
  • 注册日期2004-12-31
  • 发帖数360
  • QQ
  • 铜币4枚
  • 威望0点
  • 贡献值0点
  • 银元0个
24楼#
发布于:2005-06-08 09:00
<img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" />
举报 回复(0) 喜欢(0)     评分
gyhcly
路人甲
路人甲
  • 注册日期2005-06-09
  • 发帖数10
  • QQ
  • 铜币125枚
  • 威望0点
  • 贡献值0点
  • 银元0个
25楼#
发布于:2005-06-15 23:31
<P>版主,菜菜的问一下,为什么回放的时候所有的点都显示在TEMPLATE层上?</P>
<P>怎么实现只显示一个点的移动呢?而且回放结束以后,所有的点信息仍然保存在TEMPLATE层上,怎么清空呢?</P>
举报 回复(0) 喜欢(0)     评分
wangjh
论坛版主
论坛版主
  • 注册日期2003-08-22
  • 发帖数994
  • QQ55359982
  • 铜币2579枚
  • 威望0点
  • 贡献值0点
  • 银元0个
26楼#
发布于:2005-06-16 19:23
<DIV class=quote><B>以下是引用<I>gyhcly</I>在2005-6-15 23:31:59的发言:</B><BR>
<P>版主,菜菜的问一下,为什么回放的时候所有的点都显示在TEMPLATE层上?</P>
<P>怎么实现只显示一个点的移动呢?而且回放结束以后,所有的点信息仍然保存在TEMPLATE层上,怎么清空呢?</P></DIV>
<P>可以修改playNMEA函数,删除前面的图元
<P>Public Sub playNMEA(sArray As Variant)<BR>    '读取存有GPS信息的回放文件<BR>    Dim rmc As GPRMC<BR>    Dim Utils As New CParseUtils<BR>    Dim Sentence As Integer<BR>    <BR>    Dim mapDest As MapXLib.Map<BR>    Dim mobileObj As New MapXLib.Feature<BR>    Dim mobileFtr As New MapXLib.Feature<BR>    Dim lnFeat As New MapXLib.Feature<BR>    Dim FeatFact As MapXLib.FeatureFactory<BR>    <BR>    Dim GPSPoints As New MapXLib.Points, aPoint As New MapXLib.Point<BR>    Dim NewStyle As New Style<BR>    <BR>    Dim GPSLayerID As Integer<BR>    Dim intReg As Integer<BR>    Dim DD_X As Double, DD_Y As Double<BR>    Dim BJ_X As Double, BJ_Y As Double<BR>    <BR>    Dim yy As String, mm1 As String, dd As String   '年、月、日<BR>    Dim hh As String, mm2 As String, ss As String   '时、分、秒<BR>    <BR>    <FONT color=#ff3300>Dim ftrID As Long<BR></FONT>    <BR>    intReg = 0.00012<BR>    <BR>    Set mapDest = frmGPS_Disp.mapMain  '这里是用于显示地图的表单及控件名<BR>    <BR>    GPSLayerID = 1 'mapDest.Layers.Count<BR>    ftrID = 1
<P>    If mapDest.Layers.Count > 1 Then<BR>        Set mapDest.Layers.AnimationLayer = mapDest.Layers(GPSLayerID)<BR>    Else<BR>        MsgBox "没有地图,请先打开地图!"<BR>        Exit Sub<BR>    End If<BR>    <BR>    mobileFtr.Attach mapDest<BR>    mobileFtr.Type = miFeatureTypeSymbol<BR>        <BR>    With NewStyle<BR>        .SymbolFont.Name = "Mapinfo symbols"<BR>        .SymbolCharacter = 50 ';H40 '塔符号0X40,圆形符号0X2F<BR>        .SymbolFont.Size = 10 ' 设置符号大小<BR>        .SymbolFontRotation = 0<BR>        .SymbolFontShadow = False<BR>        .SymbolFontHalo = False<BR>        .SymbolFontColor = 255  ' 定义为红色...<BR>        .SymbolFontBackColor = miColorWhite<BR>    End With<BR>    mobileFtr.Style = NewStyle<BR>    <BR>    mobileFtr.Point.Set 0, 0<BR>    Set mobileObj = mapDest.Layers(GPSLayerID).AddFeature(mobileFtr)<BR>    <BR>    For Sentence = 0 To sCnt - 1<BR>        If Utils.Parse(sArray(Sentence), 1) = "$GPRMC" Then<BR>        Set rmc = New GPRMC<BR>                DoEvents<BR>                With rmc<BR>                    .Sentence = sArray(Sentence)<BR>                  If Not Val(.Longitude) = 0 Then<BR>                    DD_X = DM2DD(.Longitude)<BR>                    DD_Y = DM2DD(.Latitude)<BR>                    frmGPS_Disp.lblX.Caption = "X: " ; Format(DM2DD(.Longitude), "000.0000") ; " " ; .LonHemis<BR>                    frmGPS_Disp.lblY.Caption = "Y: " ; Format(DM2DD(.Latitude), "  00.0000") ; " " ; .LatHemis<BR>                    <BR>                    If bDispType = 1 Then 'bDispType为显示类型,1--单点显示<BR>                        <FONT color=#ff0000>mapDest.Layers.Item("GPSLayer").DeleteFeature ftrID '清除以前的图元<BR></FONT>                    End If<BR>                    <BR>                    If mapDest.NumericCoordSys.Units = miUnitDegree Then '度<BR>                        mobileFtr.Point.Set DD_X, DD_Y<BR>                    Else '米 BJ54坐标系<BR>                        '经纬度BL换算到高斯平面直角坐标XY(高斯投影正算)<BR>                        Deg2XY DD_X, DD_Y, BJ_X, BJ_Y<BR>                        mobileFtr.Point.Set BJ_X, BJ_Y<BR>                    End If<BR>                    <BR>                    Set mobileObj = mapDest.Layers(GPSLayerID).AddFeature(mobileFtr)<BR>                    ftrID = mobileObj.FeatureID<BR>                    <BR>                    'mapDest.Layers(GPSLayerID).Refresh<BR>                    <BR>                    If mobileFtr.Point.X > mapDest.Bounds.XMax - intReg Or _<BR>                       mobileFtr.Point.X < mapDest.Bounds.XMin + intReg Or _<BR>                       mobileFtr.Point.Y > mapDest.Bounds.YMax - intReg Or _<BR>                       mobileFtr.Point.Y < mapDest.Bounds.YMin + intReg Then<BR>                       <BR>                       mapDest.CenterX = mobileFtr.Point.X<BR>                       mapDest.CenterY = mobileFtr.Point.Y<BR>                    End If<BR>                    frmGPS_Disp.lblSpeed.Caption = "速度: " ; Val(.Speed) ; " Km/h"<BR>                    '日期的格式转换: 250503 -> 03/05/25<BR>                    dd = Mid$(.UTDate, 1, 2)<BR>                    mm1 = Mid$(.UTDate, 3, 2)<BR>                    yy = Mid$(.UTDate, 5, 2)<BR>                    frmGPS_Disp.lblDate.Caption = "日期: " ; Format(yy + mm1 + dd, "00/00/00")<BR>                   'UTC时间转换为北京时间<BR>                    hh = Mid$(.UTC, 1, 2) + 8<BR>                    mm2 = Mid$(.UTC, 3, 2)<BR>                    ss = Mid$(.UTC, 5, 2)<BR>                    frmGPS_Disp.lblUTC.Caption = "时间: " ; Format(hh + mm2 + ss, "00:00:00")<BR>                  Else<BR>                    MsgBox "接收卫星太少,不能定位!"<BR>                    <BR>                    frmGPS_Disp.lblX.Caption = "X: "<BR>                    frmGPS_Disp.lblY.Caption = "Y: "<BR>                    frmGPS_Disp.lblSpeed.Caption = "速度: "<BR>                    frmGPS_Disp.lblDate.Caption = "日期: "<BR>                    frmGPS_Disp.lblUTC.Caption = "时间: "<BR>                    <BR>                    Exit Sub<BR>                  End If<BR>                End With<BR>        End If<BR>    Next Sentence<BR>    <BR>    Set mapDest = Nothing<BR>    Set mobileObj = Nothing<BR>    Set mobileFtr = Nothing<BR>    Set lnFeat = Nothing<BR>    Set FeatFact = Nothing<BR>    Set GPSPoints = Nothing<BR>    Set NewStyle = Nothing<BR>End Sub
<P>本程序中,指定了一个名为“<FONT color=#ff0000>GPSLayer</FONT>”临时图层,用于显示GPS点</P>
网 站: www.52xoo.com (3S,信息融合,数字图像处理,模式识别与人工智能等专业电子书、学术文章及源代码共享) E-mail: Jianhong72@163.com QQ: 88128745 (55359982用了近10年,最近被盗了,郁闷!!!)
举报 回复(0) 喜欢(0)     评分
gyhcly
路人甲
路人甲
  • 注册日期2005-06-09
  • 发帖数10
  • QQ
  • 铜币125枚
  • 威望0点
  • 贡献值0点
  • 银元0个
27楼#
发布于:2005-06-16 22:22
太感谢版主了,谢谢谢谢谢谢
举报 回复(0) 喜欢(0)     评分
gyhcly
路人甲
路人甲
  • 注册日期2005-06-09
  • 发帖数10
  • QQ
  • 铜币125枚
  • 威望0点
  • 贡献值0点
  • 银元0个
28楼#
发布于:2005-06-17 00:25
<P>版主,还要麻烦你一下,请问,怎样实现程序里的时间和电脑的时钟同步呢?</P>
<P>回放的速度太快了。。。还没看清除就结束了。。。</P>
<P>请问应该在哪加一个时间控制语句?可不可以根据数据里的时间同步显示呢?</P>
举报 回复(0) 喜欢(0)     评分
cxb003
路人甲
路人甲
  • 注册日期2004-11-23
  • 发帖数12
  • QQ
  • 铜币142枚
  • 威望0点
  • 贡献值0点
  • 银元0个
29楼#
发布于:2005-07-26 10:37
版主就是大好人
举报 回复(0) 喜欢(0)     评分
游客

返回顶部