C
citybug_ch
Unregistered / Unconfirmed
GUEST, unregistred user!
线程源代码:
unit DrawShipTrack;
interface
uses
Classes,MapXLib_TLB,Variants,Activex,MapCommfunc,SysUtils,Dialogs, ShowTrack;
type
pTrackInfo=^TTrackInfo;
TTrackInfo=Record
TerminalNo: string;
ShipName: string;
Speed:do
uble;
Direct:do
uble;
MapX:do
uble;
Mapy:do
uble;
sDateTime: String;
end;
TDrawShipTrack = class(TThread)
private
{ Private declarations }
fArrayTrackInfo: Array of pTrackInfo;
fMap: TMap;
fArrayCount: integer;
CurrentList: integer;
m_PolygonID: integer;
m_PointID: integer;
destructor Destroy;
protected
procedure Execute;
override;
procedure WriteLog(msg: string);
public
fCommand: String;
procedure setMainForm;
constructor Create(Map: TMap;
Command: string;
ArrayTrackInfo: pointer;
ArrayCount: integer);
procedure DrawLine(TerminalNo: String;
ShipName: String;
Speed:do
uble;
Direct:do
uble;
Lang:do
uble;
Lat:do
uble;
sDateTime: string);
procedure DelPoint(TerminalNo: String;
ShipName: String;
Speed:do
uble;
Direct:do
uble;
Lang:do
uble;
Lat:do
uble;
sDateTime: string);
end;
implementation
uses Main;
{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure TDrawShipTrack.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end;
}
{ TDrawShipTrack }
constructor TDrawShipTrack.Create(Map: TMap;
Command: string;
ArrayTrackInfoointer;
ArrayCount: integer) ;
begin
fCommand:=Command;
fMap:=Map;
fArrayCount:=ArrayCount;
SetLength(fArrayTrackInfo,fArrayCount);
fArrayTrackInfo:=ArrayTrackInfo;
inherited Create(False);
end;
procedure TDrawShipTrack.Execute;
var
i: integer;
TerminalNo: String;
ShipName: string;
Speed:do
uble;
Direct:do
uble;
Lang:do
uble;
Lat:do
uble;
sDateTime: String;
begin
{ Place thread code here }
FreeOnTerminate:=True;
CurrentList:=0;
while not Terminateddo
begin
try
if fCommand='PLAY' then
begin
TerminalNo:=fArrayTrackInfo[CurrentList]^.TerminalNo ;
ShipName:=fArrayTrackInfo[CurrentList]^.ShipName ;
Speed:=fArrayTrackInfo[CurrentList]^.Speed;
Direct:=fArrayTrackInfo[CurrentList]^.Direct;
Lang:=fArrayTrackInfo[CurrentList]^.MapX;
Lat:=fArrayTrackInfo[CurrentList]^.Mapy;
sDateTime:=fArrayTrackInfo[CurrentList]^.sDateTime;
DrawLine(TerminalNo,ShipName,Speed,Direct,Lang,Lat,sDateTime);
CurrentList:=CurrentList + 1;
Synchronize(setMainForm);
end;
if fCommand='GO' then
begin
if CurrentList<fArrayCount then
begin
CurrentList:=CurrentList + 1;
TerminalNo:=fArrayTrackInfo[CurrentList]^.TerminalNo ;
ShipName:=fArrayTrackInfo[CurrentList]^.ShipName ;
Speed:=fArrayTrackInfo[CurrentList]^.Speed;
Direct:=fArrayTrackInfo[CurrentList]^.Direct;
Lang:=fArrayTrackInfo[CurrentList]^.MapX;
Lat:=fArrayTrackInfo[CurrentList]^.Mapy;
sDateTime:=fArrayTrackInfo[CurrentList]^.sDateTime;
DrawLine(TerminalNo,ShipName,Speed,Direct,Lang,Lat,sDateTime);
Synchronize(setMainForm);
Suspend;
end;
end;
if fCommand='BACK' then
begin
if CurrentList>1 then
begin
CurrentList:=CurrentList - 1;
TerminalNo:=fArrayTrackInfo[CurrentList]^.TerminalNo ;
ShipName:=fArrayTrackInfo[CurrentList]^.ShipName ;
Speed:=fArrayTrackInfo[CurrentList]^.Speed;
Direct:=fArrayTrackInfo[CurrentList]^.Direct;
Lang:=fArrayTrackInfo[CurrentList]^.MapX;
Lat:=fArrayTrackInfo[CurrentList]^.Mapy;
sDateTime:=fArrayTrackInfo[CurrentList]^.sDateTime;
DelPoint(TerminalNo,ShipName,Speed,Direct,Lang,Lat,sDateTime);
Synchronize(setMainForm);
Suspend;
end;
end;
sleep(1000);
if CurrentList=fArrayCount then
begin
Synchronize(setMainForm);
Terminate;
end;
if Terminated then
exit;
except on e:exceptiondo
writelog('Excute 中错误 ' + e.Message);
//showmessage('程序运行时发生错误:' + e.Message);
end;
end;
end;
procedure TDrawShipTrack.setMainForm ;
begin
frmMain.TrackBar.Position:=trunc((CurrentList*10/fArrayCount) + 0.5);
if CurrentList=fArrayCount then
begin
frmMain.btnPlay.Enabled :=True;
frmMain.btnPause.Enabled :=False;
frmMain.btnContiue.Enabled :=False;
frmMain.btnGO.Enabled :=False;
frmMain.btnBack.Enabled :=False;
frmMain.btnStop.Enabled :=False;
end;
frmMain.ShipTrackList.Items[CurrentList-1].Selected :=True;
frmMain.ShipTrackList.Items[CurrentList-1].MakeVisible(True);
end;
procedure TDrawShipTrack.DrawLine(TerminalNo: String;
ShipName: String;
Speed:do
uble;
Direct:do
uble;
Lang:do
uble;
Lat:do
uble;
sDateTime: string);
var
m_points: CMapxPoints;
m_Point: CMapxPoint;
m_Polygon: Variant;
m_Layer: CMapxLayer;
m_PointStyle: CMapxStyle;
m_LineStyle: CMapxStyle;
m_NewSymbol: Variant;
m_NewLine: Variant;
m_LineFeature: Variant;
m_PointFeature: Variant;
unusedVt: OleVariant;
begin
try
//判断折线图元在不在
if m_PolygonID=0 then
begin
CoInitialize(nil);
m_Point:=CoPoint.Create ;
m_Point.Set_(Lang,Lat);
m_PointStyle:=fMap.Layers.Item['TrackLayer'].Style.Clone ;
m_PointStyle.SymbolType:=miSymbolTypeBitmap;
m_PointStyle.SymbolBitmapSize:=32;
m_PointStyle.SymbolBitmapName:='POLI1-32.BMP';
m_PointStyle.SymbolBitmapTransparent :=True;
m_NewSymbol:=fMap.FeatureFactory.CreateSymbol(m_point,m_PointStyle);
m_PointFeature:=fMap.Layers.Item['TrackLayer'].AddFeature(m_NewSymbol,EmptyParam);
m_PointID:=m_PointFeature.FeatureID;
m_points:=CoPoints.Create ;
m_points.AddXY(Lang,Lat, EmptyParam);
m_points.AddXY(Lang,Lat, EmptyParam);
m_LineStyle:=fMap.Layers.Item['TrackLayer'].Style.Clone;
m_LineStyle.LineWidth :=2;
m_LineStyle.LineColor :=miColorRed;
m_LineStyle.LineStyle :=miLineTypeSimple;
m_NewLine:=fMap.FeatureFactory.CreateLine(M_Points,m_LineStyle);
m_LineFeature:=fMap.Layers.Item['TrackLayer'].AddFeature(m_NewLine,EmptyParam);
m_PolygonID:=m_LineFeature.FeatureID;
end
else
begin
m_PointFeature:=fMap.Layers.Item['TrackLayer'].GetFeatureByID(m_PointID);
m_PointFeature.Point.Set(Lang, Lat);
m_PointFeature.Update;
m_LineFeature:=fMap.Layers.Item['TrackLayer'].GetFeatureByID(m_PolygonID);
m_LineFeature.Parts.Item[1].AddXY(Lang, Lat);
m_LineStyle:=fMap.Layers.Item['TrackLayer'].Style.Clone ;
m_LineStyle.LineStyle := miLineTypeSimple;
m_LineStyle.LineColor := miColorRed;
m_LineStyle.LineWidth :=2;
m_LineFeature.Style:=m_LineStyle;
m_LineFeature.Update;
end;
fMap.Title.Caption:=ShipName + '(' + sDateTime + ',方向:' + FloatToStr(Direct) + ',时速:' + FloatToStr(Speed) + '公里)';
except on e:exceptiondo
writelog('DrawLine 中错误 ' + e.Message);
//showmessage('程序运行时发生错误:' + e.Message );
end;
end;
procedure TDrawShipTrack.DelPoint(TerminalNo: String;
ShipName: String;
Speed:do
uble;
Direct:do
uble;
Lang:do
uble;
Lat:do
uble;
sDateTime: string);
var
m_pointFeature: Variant;
m_LineFeature: Variant;
m_LineStyle: CMapxStyle;
begin
try
m_PointFeature:=fMap.Layers.Item['TrackLayer'].GetFeatureByID(m_PointID);
m_PointFeature.Point.Set(Lang,Lat);
m_PointFeature.Update;
m_LineFeature:=fMap.Layers.Item['TrackLayer'].GetFeatureByID(m_PolygonID);
m_LineFeature.Parts.Item[1].Remove(m_LineFeature.Parts.item[1].count);
m_LineStyle:=fMap.Layers.Item['TrackLayer'].Style.Clone;
m_LineStyle.LineStyle := miLineTypeSimple;
m_LineStyle.LineColor := miColorRed;
m_LineStyle.LineWidth :=2;
m_LineFeature.Style:=m_LineStyle;
m_LineFeature.Update;
fMap.Title.Caption:=ShipName + '(' + sDateTime + ',方向:' + FloatToStr(Direct) + ',时速:' + FloatToStr(Speed) + '公里)';
except on e:exceptiondo
writelog('DelPoint 中错误 ' + e.Message);
//showmessage('程序运行时发生错误:' + e.Message);
end;
end;
destructor TDrawShipTrack.Destroy;
begin
try
CoUninitialize();
fMap:=nil;
fArrayTrackInfo:=nil;
inherited destroy;
except on e:exceptiondo
writelog('Destroy 中错误 ' + e.Message);
end;
end;
procedure TDrawShipTrack.WriteLog(msg: string);
var
sFile: textFile;
begin
Assignfile(sfile,'login.txt');
Append(sFile);
writeln(sfile,msg);
closefile(sFile);
end;
end.
线程执行完成后,主程序关闭时,发生读取内存错误.如果主程序中不启动此线程,则在关闭主程序时不会发生读取内存的错误.
请各位帮我看看时什么原因造成的
unit DrawShipTrack;
interface
uses
Classes,MapXLib_TLB,Variants,Activex,MapCommfunc,SysUtils,Dialogs, ShowTrack;
type
pTrackInfo=^TTrackInfo;
TTrackInfo=Record
TerminalNo: string;
ShipName: string;
Speed:do
uble;
Direct:do
uble;
MapX:do
uble;
Mapy:do
uble;
sDateTime: String;
end;
TDrawShipTrack = class(TThread)
private
{ Private declarations }
fArrayTrackInfo: Array of pTrackInfo;
fMap: TMap;
fArrayCount: integer;
CurrentList: integer;
m_PolygonID: integer;
m_PointID: integer;
destructor Destroy;
protected
procedure Execute;
override;
procedure WriteLog(msg: string);
public
fCommand: String;
procedure setMainForm;
constructor Create(Map: TMap;
Command: string;
ArrayTrackInfo: pointer;
ArrayCount: integer);
procedure DrawLine(TerminalNo: String;
ShipName: String;
Speed:do
uble;
Direct:do
uble;
Lang:do
uble;
Lat:do
uble;
sDateTime: string);
procedure DelPoint(TerminalNo: String;
ShipName: String;
Speed:do
uble;
Direct:do
uble;
Lang:do
uble;
Lat:do
uble;
sDateTime: string);
end;
implementation
uses Main;
{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure TDrawShipTrack.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end;
}
{ TDrawShipTrack }
constructor TDrawShipTrack.Create(Map: TMap;
Command: string;
ArrayTrackInfoointer;
ArrayCount: integer) ;
begin
fCommand:=Command;
fMap:=Map;
fArrayCount:=ArrayCount;
SetLength(fArrayTrackInfo,fArrayCount);
fArrayTrackInfo:=ArrayTrackInfo;
inherited Create(False);
end;
procedure TDrawShipTrack.Execute;
var
i: integer;
TerminalNo: String;
ShipName: string;
Speed:do
uble;
Direct:do
uble;
Lang:do
uble;
Lat:do
uble;
sDateTime: String;
begin
{ Place thread code here }
FreeOnTerminate:=True;
CurrentList:=0;
while not Terminateddo
begin
try
if fCommand='PLAY' then
begin
TerminalNo:=fArrayTrackInfo[CurrentList]^.TerminalNo ;
ShipName:=fArrayTrackInfo[CurrentList]^.ShipName ;
Speed:=fArrayTrackInfo[CurrentList]^.Speed;
Direct:=fArrayTrackInfo[CurrentList]^.Direct;
Lang:=fArrayTrackInfo[CurrentList]^.MapX;
Lat:=fArrayTrackInfo[CurrentList]^.Mapy;
sDateTime:=fArrayTrackInfo[CurrentList]^.sDateTime;
DrawLine(TerminalNo,ShipName,Speed,Direct,Lang,Lat,sDateTime);
CurrentList:=CurrentList + 1;
Synchronize(setMainForm);
end;
if fCommand='GO' then
begin
if CurrentList<fArrayCount then
begin
CurrentList:=CurrentList + 1;
TerminalNo:=fArrayTrackInfo[CurrentList]^.TerminalNo ;
ShipName:=fArrayTrackInfo[CurrentList]^.ShipName ;
Speed:=fArrayTrackInfo[CurrentList]^.Speed;
Direct:=fArrayTrackInfo[CurrentList]^.Direct;
Lang:=fArrayTrackInfo[CurrentList]^.MapX;
Lat:=fArrayTrackInfo[CurrentList]^.Mapy;
sDateTime:=fArrayTrackInfo[CurrentList]^.sDateTime;
DrawLine(TerminalNo,ShipName,Speed,Direct,Lang,Lat,sDateTime);
Synchronize(setMainForm);
Suspend;
end;
end;
if fCommand='BACK' then
begin
if CurrentList>1 then
begin
CurrentList:=CurrentList - 1;
TerminalNo:=fArrayTrackInfo[CurrentList]^.TerminalNo ;
ShipName:=fArrayTrackInfo[CurrentList]^.ShipName ;
Speed:=fArrayTrackInfo[CurrentList]^.Speed;
Direct:=fArrayTrackInfo[CurrentList]^.Direct;
Lang:=fArrayTrackInfo[CurrentList]^.MapX;
Lat:=fArrayTrackInfo[CurrentList]^.Mapy;
sDateTime:=fArrayTrackInfo[CurrentList]^.sDateTime;
DelPoint(TerminalNo,ShipName,Speed,Direct,Lang,Lat,sDateTime);
Synchronize(setMainForm);
Suspend;
end;
end;
sleep(1000);
if CurrentList=fArrayCount then
begin
Synchronize(setMainForm);
Terminate;
end;
if Terminated then
exit;
except on e:exceptiondo
writelog('Excute 中错误 ' + e.Message);
//showmessage('程序运行时发生错误:' + e.Message);
end;
end;
end;
procedure TDrawShipTrack.setMainForm ;
begin
frmMain.TrackBar.Position:=trunc((CurrentList*10/fArrayCount) + 0.5);
if CurrentList=fArrayCount then
begin
frmMain.btnPlay.Enabled :=True;
frmMain.btnPause.Enabled :=False;
frmMain.btnContiue.Enabled :=False;
frmMain.btnGO.Enabled :=False;
frmMain.btnBack.Enabled :=False;
frmMain.btnStop.Enabled :=False;
end;
frmMain.ShipTrackList.Items[CurrentList-1].Selected :=True;
frmMain.ShipTrackList.Items[CurrentList-1].MakeVisible(True);
end;
procedure TDrawShipTrack.DrawLine(TerminalNo: String;
ShipName: String;
Speed:do
uble;
Direct:do
uble;
Lang:do
uble;
Lat:do
uble;
sDateTime: string);
var
m_points: CMapxPoints;
m_Point: CMapxPoint;
m_Polygon: Variant;
m_Layer: CMapxLayer;
m_PointStyle: CMapxStyle;
m_LineStyle: CMapxStyle;
m_NewSymbol: Variant;
m_NewLine: Variant;
m_LineFeature: Variant;
m_PointFeature: Variant;
unusedVt: OleVariant;
begin
try
//判断折线图元在不在
if m_PolygonID=0 then
begin
CoInitialize(nil);
m_Point:=CoPoint.Create ;
m_Point.Set_(Lang,Lat);
m_PointStyle:=fMap.Layers.Item['TrackLayer'].Style.Clone ;
m_PointStyle.SymbolType:=miSymbolTypeBitmap;
m_PointStyle.SymbolBitmapSize:=32;
m_PointStyle.SymbolBitmapName:='POLI1-32.BMP';
m_PointStyle.SymbolBitmapTransparent :=True;
m_NewSymbol:=fMap.FeatureFactory.CreateSymbol(m_point,m_PointStyle);
m_PointFeature:=fMap.Layers.Item['TrackLayer'].AddFeature(m_NewSymbol,EmptyParam);
m_PointID:=m_PointFeature.FeatureID;
m_points:=CoPoints.Create ;
m_points.AddXY(Lang,Lat, EmptyParam);
m_points.AddXY(Lang,Lat, EmptyParam);
m_LineStyle:=fMap.Layers.Item['TrackLayer'].Style.Clone;
m_LineStyle.LineWidth :=2;
m_LineStyle.LineColor :=miColorRed;
m_LineStyle.LineStyle :=miLineTypeSimple;
m_NewLine:=fMap.FeatureFactory.CreateLine(M_Points,m_LineStyle);
m_LineFeature:=fMap.Layers.Item['TrackLayer'].AddFeature(m_NewLine,EmptyParam);
m_PolygonID:=m_LineFeature.FeatureID;
end
else
begin
m_PointFeature:=fMap.Layers.Item['TrackLayer'].GetFeatureByID(m_PointID);
m_PointFeature.Point.Set(Lang, Lat);
m_PointFeature.Update;
m_LineFeature:=fMap.Layers.Item['TrackLayer'].GetFeatureByID(m_PolygonID);
m_LineFeature.Parts.Item[1].AddXY(Lang, Lat);
m_LineStyle:=fMap.Layers.Item['TrackLayer'].Style.Clone ;
m_LineStyle.LineStyle := miLineTypeSimple;
m_LineStyle.LineColor := miColorRed;
m_LineStyle.LineWidth :=2;
m_LineFeature.Style:=m_LineStyle;
m_LineFeature.Update;
end;
fMap.Title.Caption:=ShipName + '(' + sDateTime + ',方向:' + FloatToStr(Direct) + ',时速:' + FloatToStr(Speed) + '公里)';
except on e:exceptiondo
writelog('DrawLine 中错误 ' + e.Message);
//showmessage('程序运行时发生错误:' + e.Message );
end;
end;
procedure TDrawShipTrack.DelPoint(TerminalNo: String;
ShipName: String;
Speed:do
uble;
Direct:do
uble;
Lang:do
uble;
Lat:do
uble;
sDateTime: string);
var
m_pointFeature: Variant;
m_LineFeature: Variant;
m_LineStyle: CMapxStyle;
begin
try
m_PointFeature:=fMap.Layers.Item['TrackLayer'].GetFeatureByID(m_PointID);
m_PointFeature.Point.Set(Lang,Lat);
m_PointFeature.Update;
m_LineFeature:=fMap.Layers.Item['TrackLayer'].GetFeatureByID(m_PolygonID);
m_LineFeature.Parts.Item[1].Remove(m_LineFeature.Parts.item[1].count);
m_LineStyle:=fMap.Layers.Item['TrackLayer'].Style.Clone;
m_LineStyle.LineStyle := miLineTypeSimple;
m_LineStyle.LineColor := miColorRed;
m_LineStyle.LineWidth :=2;
m_LineFeature.Style:=m_LineStyle;
m_LineFeature.Update;
fMap.Title.Caption:=ShipName + '(' + sDateTime + ',方向:' + FloatToStr(Direct) + ',时速:' + FloatToStr(Speed) + '公里)';
except on e:exceptiondo
writelog('DelPoint 中错误 ' + e.Message);
//showmessage('程序运行时发生错误:' + e.Message);
end;
end;
destructor TDrawShipTrack.Destroy;
begin
try
CoUninitialize();
fMap:=nil;
fArrayTrackInfo:=nil;
inherited destroy;
except on e:exceptiondo
writelog('Destroy 中错误 ' + e.Message);
end;
end;
procedure TDrawShipTrack.WriteLog(msg: string);
var
sFile: textFile;
begin
Assignfile(sfile,'login.txt');
Append(sFile);
writeln(sfile,msg);
closefile(sFile);
end;
end.
线程执行完成后,主程序关闭时,发生读取内存错误.如果主程序中不启动此线程,则在关闭主程序时不会发生读取内存的错误.
请各位帮我看看时什么原因造成的