mapx折线测量距离时如何把已确定的直线画成实线并且红色(控制线的宽度,颜色),现在只能显示虚线!!(20分)

  • 主题发起人 主题发起人 okgxsh
  • 开始时间 开始时间
O

okgxsh

Unregistered / Unconfirmed
GUEST, unregistred user!
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, MapXLib_TLB;
const
miMDistanceRuler=501;
type
TForm1 = class(TForm)
Map1: TMap;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Memo1: TMemo;
Button5: TButton;
Button6: TButton;
procedure Map1PolyToolUsed(Sender: TObject;
ToolNum: Smallint;
Flags: Integer;
const Points: IDispatch;
bShift, bCtrl: WordBool;
var EnableDefault: WordBool);
procedure Map1MouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Map1MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Map1ToolUsed(Sender: TObject;
ToolNum: Smallint;
X1, Y1, X2,
Y2, Distance:do
uble;
Shift, Ctrl: WordBool;
var EnableDefault: WordBool);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;


var
Form1: TForm1;
mScreenX,mScreeny:single;

//miMDistanceRuler:integer;
mRulerStart:Boolean;
mLongitude, mLatitude,mDistance,mTotalDistance:double;
implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.Map1PolyToolUsed(Sender: TObject;
ToolNum: Smallint;
Flags: Integer;
const Points: IDispatch;
bShift, bCtrl: WordBool;
var EnableDefault: WordBool);
var
ftrsFinds : Features;
Newobj : Feature;
begin

if ToolNum = 501 then
//测距离
case Flags of
miPolyToolbegin
: begin

mRulerStart := true;
mTotalDistance := 0;
end;

miPolyToolInProgress: mTotalDistance :=mTotalDistance + mDistance;
miPolyToolEnd: mRulerStart := false;
end;

end;


procedure TForm1.Map1MouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
begin

mScreenX := X;
mScreenY := Y;
Map1.ConvertCoord(mScreenX, mScreenY, mLongitude, mLatitude, miScreenToMap);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin


Map1.CurrentTool :=miMDistanceRuler;
end;


procedure TForm1.FormCreate(Sender: TObject);

var
unusedParam: OleVariant;
begin

map1.Layers.CreateLayer('temp', EmptyParam,1, EmptyParam, EmptyParam);
Map1.Layers.Item(1).Editable := True;
Map1.Layers.InsertionLayer := Map1.Layers.Item(1);

Map1.CreateCustomTool(1, miToolTypeLine, miSizeCursor, miSizeCursor, miSizeCursor, unusedParam);
Map1.CreateCustomTool(miMDistanceRuler, miToolTypePoly, miLabelCursor, EmptyParam, EmptyParam, EmptyParam);
end;


procedure TForm1.FormDestroy(Sender: TObject);
begin

map1.Layers.Remove ('temp');
end;


procedure TForm1.Map1MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
var
d, m : integer;
mLon, mLat :do
uble;
begin

mScreenX := X;
mScreenY := Y;
Map1.ConvertCoord(mScreenX, mScreenY, mLon, mLat, miScreenToMap);

if (Map1.CurrentTool=miMDistanceRuler) and mRulerStart then

begin

mDistance := Map1.Distance(mLongitude, mLatitude, mLon, mLat);
memo1.Lines.Add(FloatToStrF(mDistance, ffNumber, 10, 3)+' 公里');
memo1.Lines.Add(FloatToStrF(mDistance+mTotalDistance, ffNumber, 10, 3)+' 公里');
end;


end;




procedure TForm1.Button5Click(Sender: TObject);
begin

Map1.CurrentTool :=1;
end;

 
改变线的宽度,颜色
MapX.DefaultStyle.LineWidth:=2;
MapX.DefaultStyle.LineColor:=clRed;
MapX.DefaultStyle.LineStyle:=61;

画折线
Newobj:= MapX.FeatureFactory.CreateLine(Points, MapX.DefaultStyle);
lyrEditLayer.AddFeature(Newobj, EmptyParam);
 
那如何加入到上面的代码中呢??
加入到什末地方??
我实现的是折线测距,可是现在折线都是虚的!
 
老兄:我给你函数了,你自己可以考虑的(呵呵,好像上面代码也是我给你的)

有几个要求你没确定.
1.是不是虚线不画了,直接画实线
2.要不要删除,什么时间删除

我不明白为什么要改成实线
 
改成实线可以解决滚屏时的问题!当鼠标移动的时候是虚线,点击鼠标后变成有颜色的实线
 
问题已经解决! 重新划线
 
接受答案了.
 
后退
顶部