如何把MAP控件改成能读取JPG格式的控件呀???????(200分)

  • 主题发起人 主题发起人 龙飘渺
  • 开始时间 开始时间

龙飘渺

Unregistered / Unconfirmed
GUEST, unregistred user!
有那位大虾能够把MAP控件改成能够读取JPG格式呀????以下是这个控件的原代码。
我在这里先想大家表示感谢了。:)
unit TCMAP;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ComCtrls, Math;

type

mouseStatus = (mrNone, mrDraging, mrSelecting, mrZoom);
ItemStatus = (IsNone, Planning, Buliding, Using, Abandon, Abnormity, Special,
Alarming, Designing, TestAlarm);


aTPoints = array[0..maxInt div 1024] of TPoint;
PTPoints = ^aTpoints;
TPoints = record
count: Integer;
Points: PTPoints;
end;

TCable = record
coordinate: TPoint;
Distance: Integer;
end;
aTCables = array[0..maxInt div 1024] of TCable;
PTCables = ^aTCables;
TCables = record
count: Integer;
cables: PTcables;
end;

mapPoint = record
mStamp: char;
mType: Integer;
mSerialNo: string;
mName: string;
mStatus: ItemStatus;
mVisible: Boolean;
mTextVisible: Boolean;
mVoltage: Integer;
coordinate: TPoint;
index: Integer;
end;

mapSection = record
mStamp: char;
mType: Integer;
mserialNo: string;
mName: string;
mStatus: ItemStatus;
mVisible: Boolean;
mTextVisible: Boolean;
coordinate: TPoints;
mBrushStyle: TBrushStyle;
mColor: TColor;
index: Integer;
end;

mapCable = record
mStamp: char; // 'C'
mType: Integer; // 中继线光缆、局间中继光缆、局间中继电缆、主干电缆、配线电缆
mSerialNo: string;
mName: string;
mStatus: ItemStatus; //计划建、在建、在用、废弃、异常、特显、告警
mVisible: Boolean;
mTextVisible: Boolean;
mTotalCapacity: Integer;
mUsedCapacity: Integer;
mTotalLength: Integer;
mBreakDistance: Integer;
mCables: tCables;
index: Integer;
end;

mapTerm = record
mStamp: char;
mType: Integer;
mSerialNo: string;
mName: string;
mStatus: ItemStatus;
mVisible: Boolean;
mTextVisible: Boolean;
mTargetSerialNO: string;
coordinate: TPoint;
index: Integer;
end;

mapTester = record
mStamp: char;
mType: Integer;
mSerialNo: string;
mName: string;
mStatus: ItemStatus;
mVisible: Boolean;
mTextVisible: Boolean;
mPortCables: Integer;
mPortFibers: Integer;
mVoltage: Integer;
coordinate: TPoint;
index: Integer;
end;

aMapPoint = array[0..maxInt div 1024] of mapPoint;
aMapCable = array[0..maxInt div 1024] of mapCable;
aMapSection = array[0..maxInt div 1024] of mapSection;
aMapTerm = array[0..maxInt div 1024] of mapTerm;
aMapTester = array[0..maxInt div 1024] of mapTester;

pMapPoint = ^aMapPoint;
pMapCable = ^aMapCable;
pMapSection = ^aMapSection;
pMapTerm = ^aMapTerm;
pMapTester = ^aMapTester;

resPoint = record
count: Integer;
mapP: pMapPoint;
end;

resCable = record
count: Integer;
mapC: pMapCable;
end;

resSection = record
count: Integer;
mapS: pMapSection;
end;

resTerm = record
count: Integer;
mapM: pMapTerm;
end;

resTester = record
count: Integer;
mapT: pMapTester;
end;

TMouseRBEvent = procedure(Sender: TObject; Shift: TShiftState; X,
Y, PopX, PopY: Integer) of object;
TMouseRBUpEvent = procedure(Sender: TObject; Shift: TShiftState; X,
Y: Integer; feature: string) of object;
TMouseClickEvent = procedure(X, Y: Integer; Items: TStrings) of object;

TMap = class(TWinControl)
private
{ Private declarations }
FMouseRBDown: TMouseRBEvent;
FMouseRBMove: TMouseRBEvent;
FMouseRBUp: TMouseRBUpEvent;
FMouseClick: TMouseClickEvent;

FPb: TPaintBox;
FMapPath: string;
FMapType: Integer;
InAlarmItemTimer: Boolean;
InAlarmPointTimer: Boolean;
FAlarmItemsTimer: TTimer;
FAlarmPointTimer: TTimer;
FzoomPB: TPaintBox;

startX, startY, oldx, oldy, dispX, dispY: Integer;
zoombuff, screenBuff, mergeBuff, imageBuffer: TBitmap;
mrStatus: mouseStatus; // 大地图的缩放率
FRatio: Double; // 缩放比率
zoomRect: TRect; // 缩放图红框所包含的区域
zoomerStatus: mouseStatus; // 缩放图鼠标状态
oldzoomx, oldzoomy: Integer; // 缩放图红框原始左上点
FRes: TStrings; // 原始地图资源数据
ItemSelected: Boolean; // 当前是否已经触发了数据元
ItemsRed: TStrings; // 当前的鼠标触发数据元
oldItemsRed: TStrings; // 原来的鼠标触发数据元
alarmItems: TStrings; // 处于警告状态的数据元
alarmColor: TColor;
alarmCore: Integer;
breakPoints: TStrings;
dblClicked: Boolean; // 鼠标是否双击

FUseRightMB: Boolean;
FBackVisible: Boolean; // 背景地图是否可见
FSectionVisible: Boolean; // 轮廓图是否可见
FPointVisible: Boolean; // 点是否可见
FCableVisible: Boolean; // 电(光)缆是否可见
FTermVisible: Boolean; // 终端模块是否可见

firstPaint: Boolean; // 是否第一次画大地图
ivC: resCable; // 存放全部电缆信息
ivS: resSection; // 存放全部轮廓线信息
ivP: resPoint; // 存放全部点信息
ivM: resTerm; // 存放全部终端模块
ivT: resTester; // 存放全部智能机房
InitOK: Boolean; // 初始化是否正确

// function getPointType(index: Integer): string;
function getSectionType(index: Integer): string;
function getCableType(index: Integer): string;
function getTermType(index: Integer): string;
function getTesterType(index: Integer): string;
procedure CalcCableLength;

protected
{ Protected declarations }
procedure pbMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pbMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pbMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure pbClick(x, y: Integer);
procedure pbDblClick(Sender: TObject);
procedure pbPaint(Sender: TObject);
procedure setZoomRatio(newRatio: Double);

procedure Splitter1Moved(Sender: TObject);

procedure DrawAllSections(aCanvas: Tcanvas);
procedure DrawAllCables(aCanvas: Tcanvas);
procedure DrawAllPoints(aCanvas: Tcanvas);
procedure DrawAllTerms(aCanvas: Tcanvas);
procedure DrawAllTesters(aCanvas: Tcanvas);

procedure DrawSection(index: Integer; aCanvas: Tcanvas; Focused: Boolean);
procedure DrawCable(index: Integer; aCanvas: Tcanvas; Focused: Boolean);
procedure DrawPoint(index: Integer; aCanvas: Tcanvas; Focused: Boolean);
procedure DrawTerm(index: Integer; aCanvas: Tcanvas; Focused: Boolean);
procedure DrawTester(index: Integer; aCanvas: Tcanvas; Focused: Boolean);

function GetFocusItems(x, y: Integer): boolean;
procedure DrawFocusItems(aCanvas: Tcanvas);
procedure GenerateMapFront;
function havePoint(pp: TPoint): Boolean;
procedure parseSection(sData: string; var mSection: mapSection);
procedure parseCable(sData: string; var cable: mapCable);
procedure parsePoint(sData: string; var mPoint: mapPoint);
procedure parseTerm(sData: string; var mTerm: mapTerm);
procedure parseTester(sData: string; var mTester: mapTester);
procedure GenerateHint;
procedure setZoomerArea;
procedure parseMapResource;
procedure freeParsedMapResource;
procedure setResource(resource: TStrings);
function ExpressCableColor(mStatus: ItemStatus): TColor;
function getFocusPoint(x, y: Integer): string;
procedure AlarmTimerTick(Sender: TObject);
procedure PointTimerTick(Sender: TObject);
procedure DrawAlarmItems;
procedure parseAlarmPoint;
procedure DrawAlarmPoints;
procedure setZoomer(zoomer: TPaintBox);
procedure pb2Paint(Sender: TObject);
procedure pb2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pb2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure pb2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);

public
{ Public declarations }
constructor Create(Owner: TComponent); override;
destructor Destroy; override;
function InitMap: Boolean;
procedure refreshMap;
procedure saveMapToLocal(filename: string);
procedure loadMapFromLocal(filename: string);
function AddItem(Item: string): Boolean;
function DeleteItem(mType: char; mSerialNo: string): Boolean;
function ModifyItem(mType: char; mSerialNo: string; nowStatus: Integer): Boolean;
procedure centerShowMap(x, y: Integer);
function convertCoordinateToRealPosition(pp: TPoint): TPoint;
function convertRealPositionToCoordinate(pp: TPoint): TPoint;

published
{ Published declarations }
property Align;
property Caption;
property Visible;
property Width;
property Height;
property PopupMenu;
property zoomPB: TPaintBox read FzoomPB write setZoomer;
property Ratio: Double read FRatio write setZoomRatio;
property Resources: TStrings read FRes write setResource;
property mapPath: string read FmapPath write FmapPath;
property mapType: Integer read FMapType write FmapType default 1;
property UseRightMB: Boolean read FUseRightMB write FUseRightMB;
property BackVisible: Boolean read FBackVisible write FBackVisible;
property SectionVisible: Boolean read FSectionVisible write FSectionVisible;
property PointVisible: Boolean read FPointVisible write FPointVisible;
property CableVisible: Boolean read FCableVisible write FCableVisible;
property TermVisible: Boolean read FTermVisible write FTermVisible;

property onDBLClick;
property onMouseRBDown: TMouseRBEvent read FMouseRBDown write FMouseRBDown;
property onMouseRBMove: TMouseRBEvent read FMouseRBmove write FMouseRBMove;
property onMouseRBUp: TMouseRBUpEvent read FMouseRBUp write FMouseRBUp;
property onMouseLBClick: TMouseClickEvent read FMouseClick write FMouseClick;

end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('SW2000', [TMap]);
end;

constructor TMap.Create(Owner: TComponent);
begin
inherited Create(Owner);
if width = 0 then width := 300;
if height = 0 then height := 200;
ControlStyle := ControlStyle + [csOpaque]; //The control completely fills its client rectangle.

FPb := TPaintBox.Create(self);
with FPb do
begin
Parent := Self;
Align := alClient;
OnMouseDown := pbMouseDown;
OnMouseMove := pbMouseMove;
OnMouseUp := pbMouseUp;
OnPaint := pbPaint;
Show;
onDblClick := pbDblClick;
end;
InAlarmItemTimer := False;
InAlarmPointTimer := False;
FRes := TStringList.Create;
end;

destructor TMap.Destroy;
begin
freeParsedMapResource;
if Assigned(FzoomPB) then
with FzoomPB do
begin
OnMouseDown := nil;
OnMouseMove := nil;
OnMouseUp := nil;
OnPaint := nil;
end;
FRes.Free;
FPb.Destroy;
inherited;
end;

procedure TMap.setZoomer(zoomer: TPaintBox);
begin
FzoomPB := Zoomer;
if Assigned(FzoomPB) then
with FzoomPB do
begin
OnMouseDown := pb2MouseDown;
OnMouseMove := pb2MouseMove;
OnMouseUp := pb2MouseUp;
OnPaint := pb2Paint;
Show;
end;
end;

function Min(a, b: integer): integer;
begin
if a < b then
Result := a
else
Result := b;
end;

function Max(a, b: integer): integer;
begin
if a < b then
Result := b
else
Result := a;
end;

procedure TMap.pbMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
// pbMouseDown: 大地图中鼠标按下
begin
if not InitOK then exit;
if dblClicked then
begin
dblClicked := False;
exit;
end;
if mrStatus <> mrNone then Exit;
//if ItemSelected then exit;
oldx := x;
oldy := y;
startX := x;
startY := y;
if Button = mbLeft then
begin
// 鼠标左键按下时首先判断是否点中某个目标
if GetFocusItems(X, Y) then
begin
mrStatus := mrSelecting;
end
else
begin
mrStatus := mrDraging;
screen.Cursor := crHandPoint;
end
end
else if Button = mbRight then
begin
if FUseRightMB then
begin
mrStatus := mrZoom;
FPb.Canvas.Pen.Mode := pmNot;
Screen.Cursor := CrCross;
end
else
begin
if Assigned(FMouseRBDown) then
FMouseRBDown(Sender, shift, Round((dispX + X) / FRatio), Round((dispY + Y) / FRatio), X, Y);
end
end;
end;


procedure TMap.pbMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
// Image1MouseUp: 大地图中鼠标松起
var
t: integer;
ox, oy: Integer;
feature: string;
begin
if not InitOK then exit;
if (Button = mbLeft) and (mrStatus = mrDraging) then
begin
Screen.Cursor := CrDefault;
mrStatus := mrNone;
end
else if (Button = mbLeft) and (mrStatus = mrSelecting) then
begin
mrStatus := mrNone;
if ItemsRed.Count > 0 then
begin
oldItemsRed.Assign(ItemsRed);
GetFocusItems(x, y);
if ItemsRed.Equals(oldItemsRed) then
pbClick(x, y)
else
pbPaint(nil);
end
end
else if (Button = mbRight) and (mrStatus = mrZoom) then
begin
if FUseRightMB then
begin
mrStatus := mrNone;
FPb.Canvas.Pen.Mode := pmCopy;
Screen.Cursor := CrDefault;
t := startx;
startx := Min(startx, x);
x := Max(t, x);
t := startY;
startY := Min(starty, y);
y := max(t, y);

ox := Round(((x + startX) / 2) / FRatio);
oy := Round(((y + starty) / 2) / FRatio);

if (x - startx + y - starty < 10) then
setZoomRatio(FRatio - 0.5)
else if (startx <> x) then
setZoomRatio(FPb.ClientWidth / (x - startx) * FRatio);
ox := Round(ox);
oy := Round(oy);
centerShowMap(ox, oy);
if Assigned(FMouseRBUp) then
FMouseRBUp(Sender, shift, 0, 0, feature); //hawk 9.26
end
else
begin
if Assigned(FMouseRBUp) then
begin
Feature := getFocusPoint(x, y);
FMouseRBUp(Sender, shift, Round((dispX + x) / FRatio), Round((dispY + Y) / FRatio), feature);
end;
end
end;
end;

procedure TMap.pbMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
// pbMouseMove: 大地图中鼠标移动
begin
if not InitOK then exit;
if Assigned(FMouseRBMove) then
FMouseRBMove(Sender, shift, Round((dispX + x) / FRatio), Round((dispY + Y) / FRatio), X, Y);
if mrStatus = mrDraging then
begin
dispX := dispX + oldx - x;
dispY := dispY + oldy - y;
oldx := x;
oldy := y;
pbPaint(self);
end
else if mrStatus = mrZoom then
begin
FPb.Canvas.Brush.Color := clwhite;
FPb.Canvas.DrawFocusRect(Rect(Min(startx, oldx), Min(starty, oldy), Max(startx, oldx), Max(starty, oldy)));
oldx := x; oldy := y;
FPb.Canvas.DrawFocusRect(Rect(Min(startx, oldx), Min(starty, oldy), Max(startx, oldx), Max(starty, oldy)));
end
else if mrStatus = mrNone then
begin
if (oldx = x) and (oldy = y) then exit;
oldItemsRed.Assign(ItemsRed);
ItemSelected := GetFocusItems(x, y);
if not itemSelected then
screen.cursor := crDefault;
if not ItemsRed.Equals(oldItemsRed) then
begin
Application.HideHint;
GenerateMapFront;
GenerateHint;
FPb.canvas.draw(0, 0, mergeBuff);
oldItemsRed.Assign(ItemsRed);
end;
oldx := x;
oldy := y;
end;
end;

procedure TMap.pbClick(x, y: Integer);
// 大地图单击
var
i, j: Integer;
parse: string;
ItemBuff: Tstrings;
begin
if not InitOK then exit;
ItemBuff := TStringList.Create;
if ItemSelected and (ItemsRed.Count > 0) then
begin
for i := 0 to ItemsRed.Count - 1 do
begin
//Application.ProcessMessages;
case ItemsRed[1] of
'P':
begin
parse := ItemsRed;
delete(parse, 1, 2);
j := StrToInt(parse);
ItemBuff.Add('P,' + ivP.mapP[j].mSerialNo + ',' + ivP.mapP[j].mName);
end;
'S':
begin
parse := ItemsRed;
delete(parse, 1, 2);
j := StrToInt(parse);
ItemBuff.Add('S,' + ivS.mapS[j].mSerialNo + ',' + ivS.mapS[j].mName);
end;
'C':
begin
parse := ItemsRed;
delete(parse, 1, 2);
j := StrToInt(parse);
ItemBuff.Add('C,' + ivC.mapC[j].mSerialNo + ',' + ivC.mapC[j].mName);
end;
'M':
begin
parse := ItemsRed;
delete(parse, 1, 2);
j := StrToInt(parse);
ItemBuff.Add('M,' + ivM.mapM[j].mSerialNo + ',' + ivM.mapM[j].mName);
end;
'T':
begin
parse := ItemsRed;
delete(parse, 1, 2);
j := StrToInt(parse);
ItemBuff.Add('T,' + ivT.mapT[j].mSerialNo + ',' + ivT.mapT[j].mName);
end;
end;
end;
end;
if Assigned(FMouseClick) then
FMouseClick(Round((dispX + x) / FRatio), Round((dispY + Y) / FRatio), ItemBuff);
if Assigned(ItemBuff) then
ItemBuff.Free;
end;

procedure TMap.pbDblClick(Sender: TObject);
// 大地图双击
begin
inherited;
if not InitOK then exit;
if Assigned(onDBlClick) then
begin
onDBLClick(Sender);
dblClicked := True;
end;
end;

procedure TMap.pbPaint(Sender: TObject);
// 大地图的显示函数
var
srcRect: Trect;
srcWidth, srcHeight: Integer;
PaintDC: HDC;
SavedIndex: Integer;
begin
if not InitOK then exit;
if dispX + FPb.ClientWidth > Round(ImageBuffer.Width * FRatio) then
dispX := Round(ImageBuffer.Width * FRatio) - FPb.ClientWidth;
if dispY + FPb.ClientHeight > Round(ImageBuffer.Height * FRatio) then
dispY := Round(ImageBuffer.Height * FRatio) - FPb.ClientHeight;
if dispX < 0 then dispX := 0;
if dispY < 0 then dispY := 0;

srcWidth := Round((FPb.ClientWidth - 1) / FRatio);
srcHeight := Round((FPb.ClientHeight - 1) / FRatio);
SrcRect := Rect(Round(dispX / FRatio), Round(dispY / FRatio), Round(dispX / FRatio) + srcWidth, Round(dispY / FRatio) + srcHeight);
screenBuff.width := FPb.ClientWidth;
screenBuff.Height := FPb.ClientHeight;
screenBuff.canvas.Brush.Color := clWhite;
screenBuff.Canvas.FillRect(screenBuff.canvas.clipRect);
PaintDC := FPb.Canvas.Handle;
SavedIndex := SaveDC(PaintDC);

if FBackVisible then
begin
if (abs(FRatio - 1.0) < 0.001) then
begin
screenBuff.Canvas.Draw(-dispx, -dispy, imageBuffer)
end
else
begin
screenBuff.Canvas.CopyRect(FPb.ClientRect, ImageBuffer.Canvas, SrcRect);
end;
end;
GenerateMapFront;
if firstPaint then
begin
FPb.color := clBlack;
FPb.Canvas.FillRect(FPb.canvas.cliprect);
//PaintEffect(6, mergeBuff.canvas, FPb.canvas, 3);
firstPaint := False;
end
else
begin
FPb.canvas.draw(0, 0, mergeBuff);
end;
GenerateHint;
if Assigned(FzoomPB) then pb2Paint(self);
FPb.Canvas.Pen.Color := clTeal;
RestoreDC(PaintDC, SavedIndex);
end;

procedure TMap.pb2Paint(Sender: TObject);
// 缩放图的显示函数
var
RatioW, RatioH: Double;
x1, x2, y1, y2: Integer;
begin
if not InitOK then exit;
if FzoomPB.Width <> FzoomPB.Height then
setZoomerArea;
with FzoomPB.canvas do
begin
pen.color := clGreen;
Brush.color := clGreen;
Brush.Style := bsSolid;
Rectangle(0, 0, 0, FzoomPB.ClientHeight);
Draw(0, 0, zoomBuff);
Pen.width := 1;
Pen.Color := clRed;
end;
RatioW := FzoomPB.Width / ImageBuffer.width / FRatio;
RatioH := FzoomPB.Width / ImageBuffer.Height / FRatio;
x1 := Round(dispX * RatioW);
x2 := x1 + Round(FPb.Width * RatioW);
y1 := Round(dispY * RatioH);
y2 := y1 + Round(FPb.Height * RatioH);
FzoomPB.Canvas.Brush.Style := bsClear;
FzoomPB.Canvas.Rectangle(x1, y1, x2, y2);
zoomRect := Rect(x1, y1, x2, y2);
end;

procedure TMap.pb2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
// 缩放图中鼠标按下事件
begin
if not InitOK then exit;
if not ptInRect(Rect(0, 0, FzoomPB.ClientWidth, FzoomPB.ClientWidth), Point(X, Y)) then
Exit;
if ptInRect(zoomRect, Point(x, y)) then
begin
Screen.Cursor := crHandPoint;
ZoomerStatus := mrDraging;
oldzoomx := x;
oldzoomy := y;
end
else
begin
dispX := Round(X / FzoomPB.clientwidth * imageBuffer.width * FRatio);
dispX := dispX - Round((ImageBuffer.width * FRatio / FzoomPB.clientwidth * (zoomRect.right - zoomRect.left) / 2));
dispY := Round(Y / FzoomPB.clientwidth * imageBuffer.Height * FRatio);
dispY := dispY - Round((ImageBuffer.Height * FRatio / FzoomPB.clientwidth * (zoomRect.Bottom - zoomRect.top) / 2));
pbPaint(self);
end
end;

procedure TMap.pb2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
// 缩放图中鼠标移动事件
var
x1, y1: Integer;
begin
if not InitOK then exit;
if zoomerStatus <> mrDraging then exit;
if not ptInRect(Rect(0, 0, FzoomPB.ClientWidth, FzoomPB.ClientWidth), Point(X, Y)) then
Exit;
x1 := zoomRect.Left + x - oldzoomx;
y1 := zoomRect.Top + y - oldzoomy;
if zoomRect.Right + x - oldzoomx > FzoomPB.Width then
x1 := FzoomPB.Width - (zoomRect.Right - zoomRect.Left);
if zoomRect.Bottom + y - oldzoomy > FzoomPB.Width then
y1 := FzoomPB.Width - (zoomRect.bottom - zoomRect.Top);
if x1 < 0 then x1 := 0;
if y1 < 0 then y1 := 0;
dispX := Round(X1 / FzoomPB.clientwidth * imageBuffer.width * FRatio);
dispY := Round(Y1 / FzoomPB.clientwidth * imageBuffer.Height * FRatio);
pbPaint(self);
oldzoomx := x;
oldzoomy := y;
end;

procedure TMap.pb2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
// 缩放图中鼠标松起事件
begin
if not InitOK then exit;
zoomerStatus := mrNone;
Screen.Cursor := crDefault;
end;

procedure TMap.setZoomerArea;
begin
if not InitOK then exit;
if not Assigned(FzoomPB) then exit;
if FzoomPB.Width < 100 then FzoomPB.Width := 100;
FzoomPB.Height := FzoomPB.Width;
zoomBuff.Width := FzoomPB.Width;
zoomBuff.Height := FzoomPB.Height;
zoomBuff.Canvas.CopyRect(Rect(0, 0, FzoomPB.ClientWidth, FzoomPB.ClientWidth), ImageBuffer.Canvas, ImageBuffer.Canvas.cliprect);
end;

procedure TMap.Splitter1Moved(Sender: TObject);
// 分隔栏移动位置,需重新计算缩放图数据
begin
setZoomerArea;
end;

procedure TMap.setZoomRatio(newRatio: Double);
// setZoomRatio: 设定大地图放大倍率
begin
if newRatio > 5.0 then newRatio := 5.0;
if newRatio < 0.2 then newRatio := 0.2;
if FRatio = 0 then FRatio := 1;
DispX := Round(dispX / FRatio * newRatio);
DispY := Round(dispY / FRatio * newRatio);
FRatio := newRatio;
// pbPaint(self);
end;

function TMap.getFocusPoint(x, y: Integer): string;
// GetFocusItems: 取得当前鼠标所在位置(x,y)的点信息
var
i, j: Integer;
parse: string;
begin
result := '';
if not InitOK then exit;
if not FPointVisible then exit;

if ivP.Count > 0 then
for i := 0 to ItemsRed.count - 1 do
if ItemsRed[1] = 'P' then
begin
//Application.ProcessMessages;
parse := ItemsRed;
delete(parse, 1, 2);
j := StrToInt(parse);
if ivp.mapp[j].mStatus = Designing then continue;
Result := 'P,' + IntToStr(ivP.mapP[j].mType) + ',' + ivP.mapP[j].mSerialNo;
Break;
end;
end;

function TMap.GetFocusItems(x, y: Integer): boolean;
// GetFocusItems: 取得当前鼠标所在位置(x,y)的数据元
// 如果取到则返回 True
var
i, j, x1, y1, x2, y2, nx1, nx2, ny1, ny2, offx, offy: Integer;
h, l: Integer;
t: Double;
ptar: array[0..3] of tpoint;
rg: Integer;
confirmed: Boolean;
begin
Result := False;
if not InitOK then exit;
ItemsRed.Clear;
// 计算区域轮廓线
if ivS.Count > 0 then
for i := 0 to ivS.count - 1 do
begin

end;

// 计算电缆
if ivC.Count > 0 then
for i := 0 to ivC.count - 1 do
begin
//Application.ProcessMessages;
if not FCableVisible then continue;
if not ivC.mapC.mVisible then continue;
// 共有 count-1 条折线
// 分别计算每段折线并计算是否在折线区域内
confirmed := False;
for j := 0 to ivC.mapC.mCables.count - 2 do
begin
//Application.ProcessMessages;
x1 := ivC.mapC.mcables.cables[j].coordinate.x;
y1 := ivC.mapC.mcables.cables[j].coordinate.y;
x2 := ivC.mapC.mcables.cables[j + 1].coordinate.x;
y2 := ivC.mapC.mcables.cables[j + 1].coordinate.y;
nx1 := Round(x1 * FRatio) - dispX;
ny1 := Round(y1 * FRatio) - dispY;
nx2 := Round(x2 * FRatio) - dispX;
ny2 := Round(y2 * FRatio) - dispY;
offx := nx2 - nx1;
offy := ny2 - ny1;
t := sqrt(offx * offx + offy * offy);
if t = 0 then
begin
h := 0;
l := 0;
end
else
begin
h := Round(4 * offx / t * FRatio);
l := Round(4 * offy / t * FRatio);
end;
// 如果起点处有点元素,则将起点稍微偏离点元素
if (j = 0) and havePoint(Point(x1, y1)) then
begin
nx1 := nx1 + h * 2;
ny1 := ny1 + l * 2;
end;
// 如果终点处有点元素,则将终点稍微偏离点元素
if (j = ivC.mapC.mCables.count - 2) and havePoint(Point(x2, y2)) then
begin
nx2 := nx2 - h * 2;
ny2 := ny2 - l * 2;
end;
ptar[0] := point(nx1 - l, ny1 + h);
ptar[1] := point(nx2 - l, ny2 + h);
ptar[2] := point(nx2 + l, ny2 - h);
ptar[3] := point(nx1 + l, ny1 - h);
rg := createpolygonrgn(ptar, 4, winding);
if ptinregion(rg, x, y) then
begin
confirmed := True;
Result := True;
ItemsRed.Add(Format('C,%d', ));
end;
deleteobject(rg);
if confirmed then Break;
end;
end;

// 计算点
if ivP.Count > 0 then
begin
for i := 0 to ivP.count - 1 do
begin
//Application.ProcessMessages;
if not FPointVisible then continue;
if not ivP.mapP.mVisible then continue;
nx1 := Round(ivP.mapP.coordinate.X * FRatio) - dispX;
ny1 := Round(ivP.mapP.coordinate.Y * FRatio) - dispY;
nx1 := nx1 - x;
ny1 := ny1 - y;
if sqrt(nx1 * nx1 + ny1 * ny1) < 6 * FRatio then
begin
Result := True;
ItemsRed.Add(Format('P,%d', ));
end;
end;
end;

// 计算终端模块
if ivM.Count > 0 then
begin
for i := 0 to ivM.count - 1 do
begin
//Application.ProcessMessages;
if not FTermVisible then continue;
if not ivM.mapM.mVisible then continue;
nx1 := Round(ivM.mapM.coordinate.X * FRatio) - dispX;
ny1 := Round(ivM.mapM.coordinate.Y * FRatio) - dispY;
nx1 := nx1 - x;
ny1 := ny1 - y;
if sqrt(nx1 * nx1 + ny1 * ny1) < 6 * FRatio then
begin
Result := True;
ItemsRed.Add(Format('M,%d', ));
end;
end;
end;

// 计算智能机房
if ivT.Count > 0 then
begin
for i := 0 to ivT.count - 1 do
begin
//Application.ProcessMessages;
if not ivT.mapT.mVisible then continue;
nx1 := Round(ivT.mapT.coordinate.X * FRatio) - dispX;
ny1 := Round(ivT.mapT.coordinate.Y * FRatio) - dispY;
nx1 := nx1 - x;
ny1 := ny1 - y;
if sqrt(nx1 * nx1 + ny1 * ny1) < 6 * FRatio then
begin
Result := True;
ItemsRed.Add(Format('T,%d', ));
end;
end;
end;

if ItemsRed.Count > 0 then
screen.Cursor := crHandPoint;
end;

procedure TMap.DrawFocusItems(aCanvas: TCanvas);
//DrawFocusItems: 画出大地图中当前鼠标所在地方的数据元(取得焦点的)
var
i: Integer;
ivStr: string;
ivFlag: char;
index: Integer;
begin
if not InitOK then exit;
if ItemsRed.count = 0 then exit;
try
for i := 0 to ItemsRed.count - 1 do
begin
//Application.ProcessMessages;
if (not Assigned(ItemsRed)) or (ItemsRed.Count <= i) then
Break;
ivStr := ItemsRed;
ivFlag := ivStr[1];
delete(ivStr, 1, 2);
index := strToint(ivStr);
case ivFlag of
'S': //Section, 地区轮廓线
DrawSection(index, mergeBuff.Canvas, True);
'C': //Cable,电缆
DrawCable(index, mergeBuff.Canvas, True);
'P': // Point, 地点
DrawPoint(index, mergeBuff.Canvas, True);
'M': // Term, 终端模块
DrawTerm(index, mergeBuff.Canvas, True);
'T': // Tester, 测试模块
DrawTester(index, mergeBuff.Canvas, True);
end;
end;
except
end;
end;

procedure TMap.DrawTerm(index: Integer; aCanvas: Tcanvas; Focused: Boolean);
// 画终端模块
var
i, x1, y1, offset, d: Integer;
ptar: array[0..3] of Tpoint;
begin
if not InitOK then exit;
if not FTermVisible then exit;
i := Index;
if not ivM.mapM.mVisible then exit;
if ivM.mapM.mStatus = Designing then
d := 2
else
d := 6;

x1 := Round(ivM.mapM.coordinate.X * FRatio) - dispX;
y1 := Round(ivM.mapM.coordinate.Y * FRatio) - dispY;
offset := Round(d * FRatio);

pTar[0] := Point(x1 + offset, y1);
pTar[1] := Point(x1, y1 + offset + Round(d / 3 * FRatio));
pTar[2] := Point(x1 - offset, y1);
pTar[3] := Point(x1, y1 - offset - Round(d / 3 * FRatio));
// 如未聚焦则画一蓝色圆环,否则画一红色的圆
if not Focused then
begin
aCanvas.Pen.Width := 2;
if ivM.mapM.mStatus = Alarming then
aCanvas.Pen.Color := alarmColor
else
aCanvas.Pen.Color := clFuchsia;
aCanvas.Pen.width := Round(2 * FRatio);
aCanvas.Brush.Style := bsClear;
aCanvas.Brush.Color := clFuchsia;
aCanvas.Polygon([Ptar[0], ptar[1], ptar[2], ptar[3], ptar[0]]);
end
else
begin
aCanvas.Brush.Style := bsClear;
aCanvas.Brush.Color := clRed;
aCanvas.Pen.width := Round(2 * FRatio);
if aCanvas.Pen.Width < 2 then
aCanvas.Pen.Width := 2;
aCanvas.Pen.Color := clRed;
aCanvas.Polygon([Ptar[0], ptar[1], ptar[2], ptar[3], ptar[0]]);
aCanvas.Pen.Color := clWhite;
end;
if ivM.mapM.mTextVisible then
begin
aCanvas.Brush.Style := bsClear;
aCanvas.Pen.width := 1;
x1 := x1 - Round(20 * FRatio);
y1 := y1 + Round(25 * FRatio);
aCanvas.Font.Size := Round(12 * FRatio);
if not Focused then
aCanvas.Font.Color := clBlack
else
aCanvas.Font.Color := clRed;
aCanvas.TextOut(x1, y1, ivM.mapM.mName);
end;
end;

procedure TMap.DrawTester(index: Integer; aCanvas: Tcanvas; Focused: Boolean);
// 画测试模块
var
i, nx1, ny1, nx2, ny2, d: Integer;
begin
if not InitOK then exit;
i := Index;
//if ivT.mapT.mStatus<>Alarming then exit;
d := 6;
nx1 := Round((ivT.mapT.coordinate.X - d) * FRatio) - dispX;
ny1 := Round((ivT.mapT.coordinate.Y - d) * FRatio) - dispY;
nx2 := Round((ivT.mapT.coordinate.X + d) * FRatio) - dispX;
ny2 := Round((ivT.mapT.coordinate.Y + d) * FRatio) - dispY;
// 画一红色的

aCanvas.Brush.Style := bsSolid;
if ivT.mapT.mStatus <> Alarming then
aCanvas.Brush.Color := clWhite
else
aCanvas.Brush.Color := AlarmColor;
aCanvas.Pen.Width := Round(3 * FRatio);
if ivT.mapT.mStatus <> Alarming then
aCanvas.Pen.Color := clBlue
else
aCanvas.Pen.Color := AlarmColor;
aCanvas.Ellipse(nX1, nY1, nX2, nY2);

{ if (ivT.mapT.mTextVisible) and (not FBackVisible) then
begin
aCanvas.Brush.Style := bsClear;
aCanvas.Pen.width := 1;
nx1 := nx1 - Round(20 * FRatio);
ny1 := ny1 - Round(25 * FRatio); .
aCanvas.Font.Size := Round(12 * FRatio);
if not Focused then
aCanvas.Font.Color := clBlack
else
aCanvas.Font.Color := clRed;
aCanvas.TextOut(nx1, ny1, ivT.mapT.mName);
end;}

end;


{
procedure TMap.DrawPoint(index: Integer; aCanvas:TCanvas; Focused: Boolean);
// DrawPoint 画电子地图的地点,形式画圆
// 特征字符为'P' (Point)
// 参数 index 表示所画点在点库(ivP)中的位置
// aCanvas 表示目的canvas
// Focused 表明此点目前是否聚焦(即是否需要特别显示)
var i,nx1, ny1, nx2, ny2, d: Integer;
begin
if NOT InitOK then exit;
if not FPointVisible then exit;
i := Index;
if not ivP.mapP.mVisible then exit;
if ivP.mapP.mStatus=Designing then d:= 2
else d:= 6;
nx1 := Round((ivP.mapP.coordinate.X-d)*FRatio)-dispX;
ny1 := Round((ivP.mapP.coordinate.Y-d)*FRatio)-dispY;
nx2 := Round((ivP.mapP.coordinate.X+d)*FRatio)-dispX;
ny2 := Round((ivP.mapP.coordinate.Y+d)*FRatio)-dispY;
// 如未聚焦则画一蓝色圆环,否则画一红色的圆
if not Focused then begin
aCanvas.Brush.Style:=bsClear;
aCanvas.Brush.Color := clWhite;
aCanvas.Pen.width := Round(3*FRatio);
if aCanvas.Pen.Width<2 then
aCanvas.Pen.Width := 2;
if ivP.mapP.mStatus=Alarming then
aCanvas.Pen.Color := alarmColor
else
aCanvas.Pen.Color := clBlue;
aCanvas.Ellipse(nX1,nY1,nX2,nY2);
end
else begin
aCanvas.Brush.Style:=bsClear;
aCanvas.Brush.Color := clRed;
aCanvas.Pen.width := Round(3*FRatio);
if aCanvas.Pen.Width<2 then
aCanvas.Pen.Width := 2;
aCanvas.Pen.Color := clRed;
aCanvas.Ellipse(nX1,nY1,nX2,nY2);
aCanvas.Pen.Color := clWhite;
end;
if ivP.mapP.mTextVisible and (not FbackVisible) then begin
aCanvas.Brush.Style:=bsClear;
aCanvas.Pen.width := 1;
nx1 := nx1 - Round(20*FRatio);
ny1 := ny1 - Round(25*FRatio);
aCanvas.Font.Size := Round(12*FRatio);
if not Focused then
aCanvas.Font.Color := clBlack
else
aCanvas.Font.Color := clRed;
aCanvas.TextOut(nx1, ny1, ivP.mapP.mName);
end;
end;
}

procedure TMap.DrawPoint(index: Integer; aCanvas: TCanvas; Focused: Boolean);
// DrawPoint 画电子地图的地点,形式画圆
// 特征字符为'P' (Point)
// 参数 index 表示所画点在点库(ivP)中的位置
// aCanvas 表示目的canvas
// Focused 表明此点目前是否聚焦(即是否需要特别显示)
var
i, nx1, ny1, nx2, ny2, d: Integer;
begin
if not InitOK then exit;
if not FPointVisible then exit;
i := Index;
if not ivP.mapP.mVisible then exit;
if ivP.mapP.mStatus = Designing then
d := 2
else
d := 6;
nx1 := Round((ivP.mapP.coordinate.X - d) * FRatio) - dispX;
ny1 := Round((ivP.mapP.coordinate.Y - d) * FRatio) - dispY;
nx2 := Round((ivP.mapP.coordinate.X + d) * FRatio) - dispX;
ny2 := Round((ivP.mapP.coordinate.Y + d) * FRatio) - dispY;
// 如未聚焦则画一蓝色圆环,否则画一红色的圆
if not Focused then
begin
case ivP.mapP.mType of
5:
begin
aCanvas.Brush.Style := bsSolid;
aCanvas.Brush.Color := clRed;
aCanvas.Pen.Width := 2;
aCanvas.Pen.Color := clRed;
aCanvas.Ellipse(nX1, nY1, nX2, nY2);
end;
3:
begin // 行政村, 实心圆
aCanvas.Brush.Style := bsSolid;
aCanvas.Brush.Color := clBlue;
aCanvas.Pen.width := Round(3 * FRatio);
if aCanvas.Pen.Width < 2 then
aCanvas.Pen.Width := 2;
if ivP.mapP.mStatus = Alarming then
aCanvas.Pen.Color := alarmColor
else
aCanvas.Pen.Color := clBlue;
aCanvas.Ellipse(nX1, nY1, nX2, nY2);
end;
4:
begin // 自然村, 空心圆
aCanvas.Brush.Style := bsClear;
aCanvas.Brush.Color := clWhite;
aCanvas.Pen.width := Round(3 * FRatio);
if aCanvas.Pen.Width < 2 then
aCanvas.Pen.Width := 2;
if ivP.mapP.mStatus = Alarming then
aCanvas.Pen.Color := alarmColor
else
aCanvas.Pen.Color := clBlue;
aCanvas.Ellipse(nX1, nY1, nX2, nY2);
end;
1:
begin // 县, 实心五星
nx1 := Round(ivP.mapP.coordinate.X * FRatio) - dispX;
ny1 := Round(ivP.mapP.coordinate.Y * FRatio) - dispY;
aCanvas.Pen.Style := psSolid;
aCanvas.Pen.Color := clRed;
aCanvas.Brush.Style := bsSolid;
aCanvas.Brush.Color := clRed;
aCanvas.Polygon(
[Point(nX1, nY1 - Round(15 * Ratio)),
Point(nX1 + Round(6 * Ratio), nY1 + Round(12 * Ratio)),
Point(nX1 - Round(12 * Ratio), nY1 - Round(6 * Ratio)),
Point(nX1 + Round(12 * Ratio), nY1 - Round(6 * Ratio)),
Point(nX1 - Round(6 * Ratio), nY1 + Round(12 * Ratio))]);
aCanvas.Pen.Style := psClear;
aCanvas.Ellipse(
nx1 - Round(6 * Ratio),
nY1 - Round(6 * Ratio),
nX1 + Round(6 * Ratio),
nY1 + Round(6 * Ratio));
aCanvas.Pen.Style := psSolid;
end;
2:
begin // 乡, 空心圆
aCanvas.Brush.Style := bsClear;
aCanvas.Brush.Color := clWhite;
aCanvas.Pen.Width := 2;
aCanvas.Pen.Color := clBlue;
nx1 := nx1 - Round(3 * Ratio);
ny1 := ny1 - Round(3 * Ratio);
nx2 := nx2 + Round(3 * Ratio);
ny2 := ny2 + Round(3 * Ratio);
aCanvas.Ellipse(nX1, nY1, nX2, nY2);
d := 5;
nx1 := Round((ivP.mapP.coordinate.X - d) * FRatio) - dispX;
ny1 := Round((ivP.mapP.coordinate.Y - d) * FRatio) - dispY;
nx2 := Round((ivP.mapP.coordinate.X + d) * FRatio) - dispX;
ny2 := Round((ivP.mapP.coordinate.Y + d) * FRatio) - dispY;
aCanvas.Ellipse(nX1, nY1, nX2, nY2);
{
nx1 := Round(ivP.mapP.coordinate.X*FRatio)-dispX;
ny1 := Round(ivP.mapP.coordinate.Y*FRatio)-dispY;
aCanvas.Pen.Style:=psSolid;
aCanvas.Pen.Color := clRed;
aCanvas.Brush.Style:=bsSolid;
aCanvas.Brush.Color := clRed;
aCanvas.PolyLine(
[Point(nX1,nY1-Round(15*Ratio)),
Point(nX1+Round(6*Ratio), nY1+Round(12*Ratio)),
Point(nX1-Round(12*Ratio),nY1-Round(6*Ratio)),
Point(nX1+Round(12*Ratio),nY1-Round(6*Ratio)),
Point(nX1-Round(6*Ratio), nY1+Round(12*Ratio)),
Point(nX1,nY1-Round(15*Ratio))]);
}
end;
end;
end
else // 如果获得焦点
begin
case ivP.mapP.mType of
5:
begin
aCanvas.Brush.Style := bsSolid;
aCanvas.Brush.Color := clRed;
aCanvas.Pen.Width := 2;
aCanvas.Pen.Color := clRed;
aCanvas.Ellipse(nX1, nY1, nX2, nY2);
end;
3:
begin // 行政村, 实心圆
aCanvas.Brush.Style := bsSolid;
aCanvas.Brush.Color := clBlue;
aCanvas.Pen.width := Round(3 * FRatio);
if aCanvas.Pen.Width < 2 then
aCanvas.Pen.Width := 2;
aCanvas.Pen.Color := clYellow;
aCanvas.Ellipse(nX1, nY1, nX2, nY2);
aCanvas.Pen.Color := clWhite;
end;
4:
begin // 自然村, 空心圆
aCanvas.Brush.Style := bsClear;
aCanvas.Brush.Color := clRed;
aCanvas.Pen.width := Round(3 * FRatio);
if aCanvas.Pen.Width < 2 then
aCanvas.Pen.Width := 2;
aCanvas.Pen.Color := clYellow;
aCanvas.Ellipse(nX1, nY1, nX2, nY2);
aCanvas.Pen.Color := clWhite;
end;
1:
begin // 县, 实心五星
nx1 := Round(ivP.mapP.coordinate.X * FRatio) - dispX;
ny1 := Round(ivP.mapP.coordinate.Y * FRatio) - dispY;
aCanvas.Pen.Style := psSolid;
aCanvas.Pen.Color := clYellow;
aCanvas.Brush.Style := bsSolid;
aCanvas.Brush.Color := clRed;
aCanvas.Polygon(
[Point(nX1, nY1 - Round(15 * Ratio)),
Point(nX1 + Round(6 * Ratio), nY1 + Round(12 * Ratio)),
Point(nX1 - Round(12 * Ratio), nY1 - Round(6 * Ratio)),
Point(nX1 + Round(12 * Ratio), nY1 - Round(6 * Ratio)),
Point(nX1 - Round(6 * Ratio), nY1 + Round(12 * Ratio))]);
aCanvas.Pen.Style := psClear;
aCanvas.Ellipse(
nx1 - Round(6 * Ratio),
nY1 - Round(6 * Ratio),
nX1 + Round(6 * Ratio),
nY1 + Round(6 * Ratio));
aCanvas.Pen.Style := psSolid;
end;
2:
begin // 乡, 空心五星
{
nx1 := Round(ivP.mapP.coordinate.X*FRatio)-dispX;
ny1 := Round(ivP.mapP.coordinate.Y*FRatio)-dispY;
aCanvas.Pen.Style:=psSolid;
aCanvas.Pen.Color := clYellow;
aCanvas.Brush.Style:=bsSolid;
aCanvas.Brush.Color := clRed;
aCanvas.PolyLine(
[Point(nX1,nY1-Round(15*Ratio)),
Point(nX1+Round(6*Ratio), nY1+Round(12*Ratio)),
Point(nX1-Round(12*Ratio),nY1-Round(6*Ratio)),
Point(nX1+Round(12*Ratio),nY1-Round(6*Ratio)),
Point(nX1-Round(6*Ratio), nY1+Round(12*Ratio)),
Point(nX1,nY1-Round(15*Ratio))]);
}
aCanvas.Brush.Style := bsClear;
aCanvas.Brush.Color := clRed;
aCanvas.Pen.Width := 2;
aCanvas.Pen.Color := clYellow;
nx1 := nx1 - Round(3 * Ratio);
ny1 := ny1 - Round(3 * Ratio);
nx2 := nx2 + Round(3 * Ratio);
ny2 := ny2 + Round(3 * Ratio);
aCanvas.Ellipse(nX1, nY1, nX2, nY2);
d := 5;
nx1 := Round((ivP.mapP.coordinate.X - d) * FRatio) - dispX;
ny1 := Round((ivP.mapP.coordinate.Y - d) * FRatio) - dispY;
nx2 := Round((ivP.mapP.coordinate.X + d) * FRatio) - dispX;
ny2 := Round((ivP.mapP.coordinate.Y + d) * FRatio) - dispY;
aCanvas.Ellipse(nX1, nY1, nX2, nY2);
end;
end;
end;
if (ivP.mapP.mTextVisible) and (not FBackVisible) then
begin
aCanvas.Brush.Style := bsClear;
aCanvas.Pen.width := 1;
nx1 := nx1 - Round(20 * FRatio);
ny1 := ny1 - Round(25 * FRatio);
aCanvas.Font.Size := Round(12 * FRatio);
if not Focused then
aCanvas.Font.Color := clBlack
else
aCanvas.Font.Color := clRed;
aCanvas.TextOut(nx1, ny1, ivP.mapP.mName);
end;
end;

procedure TMap.DrawCable(index: Integer; aCanvas: TCanvas; Focused: Boolean);
// DrawCable 画电子地图的电缆,形式为画线
// 特征字符为'C' (Cable)
// 参数 index 表示所画电缆在电缆线库(ivC)中的位置
// aCanvas 表示目的canvas
// Focused 表明此线目前是否聚焦(即是否需要特别显示)

var
i, j, x1, y1, x2, y2, nx1, nx2, ny1, ny2, offx, offy: Integer;
h, l: Integer;
t: Double;
ptar: array[0..3] of tpoint;

begin
if not InitOK then exit;
i := Index;
// 当告警时一定要显示告警电缆
if not (ivC.mapC.mStatus in [Alarming, TestAlarm]) then
begin
if not FCableVisible then exit;
if not ivC.mapC.mVisible then exit;
end;
if (alarmColor = clRed) and (ivC.mapC.mStatus = TestAlarm) then
alarmColor := clBlue;
// 共有 mcable.mCables.count-1 条折线
// 分别画每一段线段
for j := 0 to ivC.mapC.mCables.count - 2 do
begin
x1 := ivC.mapC.mcables.cables[j].coordinate.x;
y1 := ivC.mapC.mcables.cables[j].coordinate.y;
x2 := ivC.mapC.mcables.cables[j + 1].coordinate.x;
y2 := ivC.mapC.mcables.cables[j + 1].coordinate.y;

nx1 := Round(x1 * FRatio) - dispX;
ny1 := Round(y1 * FRatio) - dispY;
nx2 := Round(x2 * FRatio) - dispX;
ny2 := Round(y2 * FRatio) - dispY;
offx := nx2 - nx1;
offy := ny2 - ny1;

t := sqrt(offx * offx + offy * offy);
if t = 0 then
begin
h := 0;
l := 0;
end
else
begin
h := Round(4 * offx / t * FRatio / 2);
l := Round(4 * offy / t * FRatio / 2);
end; //hawk 9.26

// 如果起点处有点元素,则将起点稍微偏离点元素
if (j = 0) and havePoint(Point(x1, y1)) then
begin
nx1 := nx1 + h * 3;
ny1 := ny1 + l * 3;
end;
// 如果终点处有点元素,则将终点稍微偏离点元素
if (j = ivC.mapC.mCables.count - 2) and havePoint(Point(x2, y2)) then
begin
nx2 := nx2 - h * 3;
ny2 := ny2 - l * 3;
end;

ptar[0] := point(nx1 - l, ny1 + h);
ptar[1] := point(nx2 - l, ny2 + h);
ptar[2] := point(nx2 + l, ny2 - h);
ptar[3] := point(nx1 + l, ny1 - h);

with aCanvas do
begin
if not focused then
begin
Pen.Width := Round(4 * FRatio);
if Pen.Width < 2 then
Pen.Width := 2;
Pen.Style := psDot;
Pen.Mode := pmCopy;
if (ivC.mapC.mType = 1) or (ivC.mapC.mType = 2) then
Pen.color := clBlue;
Pen.color := ExpressCableColor(ivC.mapC.mStatus);
moveTo(nx1, ny1);
lineTo(nx2, ny2);
end
else
begin
Pen.Color := clRed;
Brush.Color := clYellow;
Brush.Style := bsSolid;
Pen.Style := psSolid;
Pen.Mode := pmCopy;
Pen.Width := 2;
PolyGon([ptar[0], ptar[1], ptar[2], ptar[3], ptar[0]]);
Pen.Color := clYellow;
moveTo(nx1, ny1);
lineTo(nx2, ny2);
end;
end;
end;
if alarmColor = clBlue then
alarmColor := clRed;
end;

procedure TMap.DrawSection(index: Integer; aCanvas: TCanvas; Focused: Boolean);
// DrawCable 画电子地图的电缆,形式为画线
// 特征字符为'C' (Cable)
// 参数 index 表示所画轮廓线在轮廓线库(ivS)中的位置
// aCanvas 表示目的canvas
// Focused 表明此轮廓线目前是否聚焦(即是否需要特别显示)
var
i, j, k, minX, minY, maxX, maxY: Integer;
//contour: Integer;
pp: PTPoints;
begin
if not InitOK then exit;
if not FSectionVisible then exit;
i := Index;
//x1 := aCanvas.ClipRect.left;
//y1 := aCanvas.ClipRect.Top;
//x2 := aCanvas.ClipRect.Right;
//y2 := aCanvas.ClipRect.Bottom;
//minx, minY, maxX, maxY 用来计算区域的中点
minX := maxInt; minY := maxInt; maxX := 0; maxY := 0;
// pp 用来暂存点数据
pp := AllocMem(sizeof(TPoint) * ivS.mapS.coordinate.count);
for k := 0 to ivS.mapS.coordinate.count - 1 do
with ivS.mapS.coordinate do
begin
//Application.ProcessMessages;
minX := min(Points[k].X, minX);
maxX := max(Points[k].X, maxX);
minY := min(Points[k].Y, minY);
maxY := max(Points[k].Y, maxY);
pp[k].X := Round(Points[k].X * FRatio) - dispX;
pp[k].Y := Round(Points[k].Y * FRatio) - dispY;
end;

aCanvas.Brush.Color := ivS.mapS.mColor;
aCanvas.Pen.Color := ivS.mapS.mColor;
aCanvas.Pen.width := 2;
aCanvas.Pen.color := ExpressCableColor(ivS.mapS.mStatus);
// 如果状态为设计中则只画线
if ivS.mapS.mStatus = Designing then
begin
for j := 0 to ivS.mapS.Coordinate.Count - 2 do
begin
//Application.ProcessMessages;
aCanvas.MoveTo(pp[j].X, pp[j].Y);
aCanvas.LineTo(pp[j + 1].X, pp[j + 1].Y);
end
end
else
begin
if not FBackVisible then
begin
//aCanvas.Pen.Style := psClear;
aCanvas.Brush.Style := bsSolid;
aCanvas.PolyGon(slice(pp^, ivS.mapS.Coordinate.Count));
//aCanvas.Pen.Style := psSolid;
end
else
begin
//aCanvas.Brush.Style := ivS.mapS.mBrushStyle;
aCanvas.Brush.Style := bsClear;
aCanvas.PolyGon(slice(pp^, ivS.mapS.Coordinate.Count));
end;
end;
//contour := createpolygonrgn(pp^, ivS.mapS.Coordinate.Count, winding);
//selectobject(aCanvas.handle, contour);
//aCanvas.FillRect(aCanvas.ClipRect);
//deleteobject(contour);
//contour := createRectrgn(x1, y1, x2, y2);
//selectobject(aCanvas.handle, contour);
//deleteobject(contour);
{
if (ivS.mapS.mTextVisible) and (ivS.mapS.mStatus<>Designing) then begin
aCanvas.Brush.Style:=bsClear;
aCanvas.Brush.color := clYellow;
aCanvas.Font.Size := Round(20*FRatio);
acanvas.Font.Color := clBlack;
x1 := Round(((maxX-minX)/3+minX)*FRatio)-dispX;
y1 := Round(((maxY-minY)/3+minY)*FRatio)-dispY;
aCanvas.TextOut(x1, y1, ivS.mapS.mName);
end;
}
FreeMem(pp);
end;

procedure TMap.DrawAllSections(aCanvas: Tcanvas);
var
i: Integer;
begin
if not InitOK then exit;
if not FSectionVisible then exit;
if ivS.Count = 0 then exit;
for i := 0 to ivS.Count - 1 do
begin
//Application.ProcessMessages;
DrawSection(i, aCanvas, False);
end;
end;

procedure TMap.DrawAllCables(aCanvas: Tcanvas);
var
i: Integer;
begin
if not InitOK then exit;
if not FCableVisible then exit;
if ivC.Count = 0 then exit;
for i := 0 to ivC.Count - 1 do
begin
//Application.ProcessMessages;
DrawCable(i, aCanvas, False);
end;
end;

procedure TMap.DrawAllPoints(aCanvas: Tcanvas);
var
i: Integer;
begin
if not InitOK then exit;
if not FPointVisible then exit;
if ivP.Count = 0 then exit;
for i := 0 to ivP.Count - 1 do
begin
//Application.ProcessMessages;
DrawPoint(i, aCanvas, False);
end;
end;

procedure TMap.DrawAllTerms(aCanvas: Tcanvas);
var
i: Integer;
begin
if not InitOK then exit;
if not FTermVisible then exit;
if ivM.Count = 0 then exit;
for i := 0 to ivM.Count - 1 do
begin
//Application.ProcessMessages;
DrawTerm(i, aCanvas, False);
end;
end;

procedure TMap.DrawAllTesters(aCanvas: Tcanvas);
var
i: Integer;
begin
for i := 0 to ivT.Count - 1 do
begin
//Application.ProcessMessages;
DrawTester(i, aCanvas, False);
end;
end;

function TMap.havePoint(pp: TPoint): Boolean;
// 判断在pp处是否有点(mapPoint), 画图时用
var
i: Integer;
begin
Result := False;
if not InitOK then exit;
if ivP.Count = 0 then exit;
for i := 0 to ivP.Count - 1 do
begin
//Application.ProcessMessages;
if not ivP.mapP.mVisible then continue;
if (pp.x = ivP.mapP.coordinate.X) and
(pp.y = ivP.mapP.coordinate.Y) then
begin
Result := True;
Break;
end;
end;
end;

procedure TMap.GenerateMapFront;
// 生成地图附加数据元影象
begin
if not InitOK then exit;
MergeBuff.Assign(screenBuff);
DrawAllSections(mergeBuff.Canvas);
DrawAllCables(mergeBuff.Canvas);
DrawAllPoints(mergeBuff.Canvas);
DrawAllTerms(mergeBuff.Canvas);
DrawAllTesters(mergeBuff.Canvas);
DrawFocusItems(mergeBuff.Canvas);
end;

procedure TMap.parseSection(sData: string; var mSection: mapSection);
var
ivPos: Integer;
x, y: Integer;
begin
// 轮廓线类型
ivPos := pos(',', sData);
mSection.mType := StrToInt(Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 轮廓线编号
ivPos := pos(',', sData);
mSection.mSerialNo := (Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 轮廓线名称
ivPos := pos(',', sData);
mSection.mName := (Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 轮廓线状态
ivPos := pos(',', sData);
mSection.mStatus := ItemStatus(StrToInt(Copy(sData, 1, ivPos - 1)));
Delete(sData, 1, ivPos);

// 外观可见性
ivPos := pos(',', sData);
if StrToInt(Copy(sData, 1, ivPos - 1)) > 0 then
mSection.mVisible := True
else
mSection.mVisible := False;
Delete(sData, 1, ivPos);

// 文字可见性
ivPos := pos(',', sData);
if StrToInt(Copy(sData, 1, ivPos - 1)) > 0 then
mSection.mTextVisible := True
else
mSection.mTextVisible := False;
Delete(sData, 1, ivPos);

// 数据元主要特性
ivPos := pos(',', sData);
mSection.mColor := StrToInt(Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 轮廓坐标
// 程序初始化时或动态开辟内存时已经初始化了数据
// 现在将 count 赋0值主要是应付动态增加或件小的情况
if mSection.coordinate.Points <> nil then
FreeMem(mSection.coordinate.Points);
mSection.coordinate.Points := nil;
mSection.coordinate.count := 0;
while sdata <> '' do
begin
ivPos := pos(',', sData);
x := strtoint(Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);
ivPos := pos(',', sData);
if ivPos = 0 then
begin
y := strtoint(sData);
sData := '';
end
else
begin
y := strtoint(Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);
end;
Inc(mSection.coordinate.count);
ReAllocMem(mSection.Coordinate.Points,
mSection.coordinate.count * sizeof(TPoint));
with mSection.Coordinate do
Points[count - 1] := Point(x, y);
end;
end;

procedure TMap.parseCable(sData: string; var cable: mapCable);
var
vdistance: Integer;
ivPos: Integer;
i, x, y: Integer;
totalDis: Double;
begin
// 电缆类型
ivPos := pos(',', sData);
Cable.mType := StrToInt(Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 电缆编号
ivPos := pos(',', sData);
Cable.mSerialNo := (Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 电缆名称
ivPos := pos(',', sData);
Cable.mName := (Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 电缆状态
ivPos := pos(',', sData);
Cable.mStatus := ItemStatus(StrToInt(Copy(sData, 1, ivPos - 1)));
Delete(sData, 1, ivPos);

// 外观可见性
ivPos := pos(',', sData);
if StrToInt(Copy(sData, 1, ivPos - 1)) > 0 then
Cable.mVisible := True
else
Cable.mVisible := False;
Delete(sData, 1, ivPos);

// 文字可见性
ivPos := pos(',', sData);
if StrToInt(Copy(sData, 1, ivPos - 1)) > 0 then
Cable.mTextVisible := True
else
Cable.mTextVisible := False;
Delete(sData, 1, ivPos);

// 电缆总容量
ivPos := pos(',', sData);
Cable.mTotalCapacity := StrToInt(Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 电缆已用容量
ivPos := pos(',', sData);
Cable.mUsedCapacity := StrToInt(Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 电缆长度
ivPos := pos(',', sData);
Cable.mTotalLength := StrToInt(Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 告警距离
ivPos := pos(',', sData);
Cable.mBreakDistance := StrToInt(Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 轮廓坐标
if Cable.mCables.cables <> nil then
FreeMem(Cable.mCables.cables);
Cable.mCables.cables := nil;
Cable.mCables.count := 0;
while sdata <> '' do
begin
ivPos := pos(',', sData);
x := strtoint(Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

ivPos := pos(',', sData);
y := strtoint(Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

ivPos := pos(',', sData);
if ivPos = 0 then
begin
sData := '';
vdistance := 0;
end
else
begin
vdistance := strtoint(Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);
end;
Inc(Cable.mCables.count);
ReAllocMem(Cable.mCables.cables,
Cable.mCables.count * sizeof(Tcable));
with Cable.mCables do
begin
cables[count - 1].coordinate := Point(x, y);
cables[count - 1].distance := vdistance;
end;
end;
// 如果折线总长度为0,表示要用总长度来根据比例分配
vdistance := 0;
for i := 0 to Cable.mCables.count - 2 do
vdistance := vdistance + Cable.mCables.cables.distance;
if vdistance <> 0 then
exit
// totalDis 为电缆点间距离(非实际距离)
else
begin
totalDis := 0;
for i := 0 to Cable.mCables.count - 2 do
with Cable.mCables do
begin
x := cables.coordinate.x - cables[i + 1].coordinate.x;
y := cables.coordinate.y - cables[i + 1].coordinate.y;
totalDis := totalDis + sqrt(x * x + y * y);
end;
for i := 0 to Cable.mCables.count - 2 do
with Cable.mCables do
begin
x := cables.coordinate.x - cables[i + 1].coordinate.x;
y := cables.coordinate.y - cables[i + 1].coordinate.y;
cables.distance := Round(Cable.mTotalLength * sqrt(x * x + y * y) / TotalDis);
end;
end;
end;

procedure TMap.parsePoint(sData: string; var mPoint: mapPoint);
var
ivPos: Integer;
begin
// 地区类型
ivPos := pos(',', sData);
mPoint.mType := StrToInt(Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 地区编号
ivPos := pos(',', sData);
mPoint.mSerialNo := (Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 地区名称
ivPos := pos(',', sData);
mPoint.mName := (Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 地区状态
ivPos := pos(',', sData);
mPoint.mStatus := ItemStatus(StrToInt(Copy(sData, 1, ivPos - 1)));
Delete(sData, 1, ivPos);

// 外观可见性
ivPos := pos(',', sData);
if StrToInt(Copy(sData, 1, ivPos - 1)) > 0 then
mPoint.mVisible := True
else
mPoint.mVisible := False;
Delete(sData, 1, ivPos);

// 文字可见性
ivPos := pos(',', sData);
if StrToInt(Copy(sData, 1, ivPos - 1)) > 0 then
mPoint.mTextVisible := True
else
mpoint.mTextVisible := False;
Delete(sData, 1, ivPos);

// 数据元主要特性
ivPos := pos(',', sData);
mPoint.mVoltage := StrToInt(Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 地区坐标
ivPos := pos(',', sData);
mPoint.coordinate.X := strtoint(Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);
mPoint.coordinate.y := strtoint(sData);
end;

procedure TMap.parseTerm(sData: string; var mTerm: mapTerm);
var
ivPos: Integer;
begin
// 终端类型
ivPos := pos(',', sData);
mTerm.mType := StrToInt(Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 终端编号
ivPos := pos(',', sData);
mTerm.mSerialNo := (Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 终端名称
ivPos := pos(',', sData);
mTerm.mName := (Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 终端状态
ivPos := pos(',', sData);
mTerm.mStatus := ItemStatus(StrToInt(Copy(sData, 1, ivPos - 1)));
Delete(sData, 1, ivPos);

// 外观可见性
ivPos := pos(',', sData);
if StrToInt(Copy(sData, 1, ivPos - 1)) > 0 then
mTerm.mVisible := True
else
mTerm.mVisible := False;
Delete(sData, 1, ivPos);

// 文字可见性
ivPos := pos(',', sData);
if StrToInt(Copy(sData, 1, ivPos - 1)) > 0 then
mTerm.mTextVisible := True
else
mTerm.mTextVisible := False;
Delete(sData, 1, ivPos);

// 数据元主要特性:监控电缆号
ivPos := pos(',', sData);
mTerm.mTargetSerialNo := Copy(sData, 1, ivPos - 1);
Delete(sData, 1, ivPos);

// 监控模块坐标
ivPos := pos(',', sData);
mTerm.coordinate.X := strtoint(Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);
mTerm.coordinate.y := strtoint(sData);
end;

procedure TMap.parseTester(sData: string; var mTester: mapTester);
var
ivPos: Integer;
begin
// 智能机房类型
ivPos := pos(',', sData);
mTester.mType := StrToInt(Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 编号
ivPos := pos(',', sData);
mTester.mSerialNo := (Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 名称
ivPos := pos(',', sData);
mTester.mName := (Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 状态
ivPos := pos(',', sData);
mTester.mStatus := ItemStatus(StrToInt(Copy(sData, 1, ivPos - 1)));
Delete(sData, 1, ivPos);

// 外观可见性
ivPos := pos(',', sData);
if StrToInt(Copy(sData, 1, ivPos - 1)) > 0 then
mTester.mVisible := True
else
mTester.mVisible := False;
Delete(sData, 1, ivPos);

// 文字可见性
ivPos := pos(',', sData);
if StrToInt(Copy(sData, 1, ivPos - 1)) > 0 then
mTester.mTextVisible := True
else
mTester.mTextVisible := False;
Delete(sData, 1, ivPos);

// 电缆端口数
ivPos := pos(',', sData);
mTester.mPortCables := StrToInt(Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 光缆端口数
ivPos := pos(',', sData);
mTester.mPortFibers := StrToInt(Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 电压
ivPos := pos(',', sData);
mTester.mVoltage := StrToInt(Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);

// 地区坐标
ivPos := pos(',', sData);
mTester.coordinate.X := strtoint(Copy(sData, 1, ivPos - 1));
Delete(sData, 1, ivPos);
mTester.coordinate.y := strtoint(sData);
end;

function GetDistance(x1, y1, x2, y2: Integer): Integer;
begin
Result := Trunc(Sqrt(Sqr(x1 - x2) + Sqr(y1 - y2)));
end;

procedure TMap.CalcCableLength;
var
i, j, x1, y1, x2, y2: Integer;
TotalDis: Integer;
begin
for i := 0 to ivC.count - 1 do
begin
//Application.ProcessMessages;
if ivC.mapC.mCables.count < 2 then
Continue;
TotalDis := 0;
for j := 0 to ivC.mapC.mCables.count - 2 do
begin
x1 := ivC.mapC.mcables.cables[j].coordinate.x;
y1 := ivC.mapC.mcables.cables[j].coordinate.y;
x2 := ivC.mapC.mcables.cables[j + 1].coordinate.x;
y2 := ivC.mapC.mcables.cables[j + 1].coordinate.y;
ivC.mapC.mCables.cables[j].Distance := GetDistance(x1, y1, x2, y2);
TotalDis := TotalDis + ivC.mapC.mCables.cables[j].Distance;
end;
for j := 0 to ivC.mapC.mCables.count - 2 do
begin
if TotalDis <> 0 then
ivC.mapC.mCables.cables[j].Distance := ivC.mapC.mTotalLength * ivC.mapC.mCables.cables[j].Distance div TotalDis;
end;
end;
end;

procedure TMap.parseAlarmPoint;
var
i, j, k, x1, y1, x2, y2, offx, offy: Integer;
breakDis: Integer;
breakID: Integer;
foundBreak: Boolean;
BreakX, breakY: Integer;
t: Double;
ivStr: string;
begin
foundBreak := False;
BreakID := 0;
BreakDis := 0;

for k := 0 to AlarmItems.Count - 1 do
begin
if AlarmItems[k][1] <> 'C' then continue;
ivStr := AlarmItems[k];
delete(ivStr, 1, 2);
i := StrToInt(ivStr);
if (ivC.mapC.mStatus in [Alarming, TestAlarm]) and (ivC.mapC.mBreakDistance > 0) then
begin
if ivC.mapC.mStatus = Designing then showmessage('');
if (ivC.mapC.mType = 1) or (ivC.mapC.mType = 2) then
BreakDis := ivC.mapC.mTotalLength div 2
else
BreakDis := ivC.mapC.mBreakDistance;
j := 0;
foundBreak := False;
while j < ivC.mapC.mCables.count - 1 do
begin
if BreakDis - ivC.mapC.mCables.cables[j].Distance < 0 then
begin
BreakID := j;
foundBreak := True;
break;
end
else
begin
BreakDis := BreakDis - ivC.mapC.mCables.cables[j].Distance;
inc(j);
end;
end;
if not foundBreak then
begin
j := ivC.mapC.mCables.count - 2;
BreakDis := ivC.mapC.mCables.cables[j].Distance;
BreakID := j;
foundBreak := True;
end;
end;
if (foundBreak) then
begin
x1 := ivC.mapC.mcables.cables[BreakID].coordinate.x;
y1 := ivC.mapC.mcables.cables[BreakID].coordinate.y;
x2 := ivC.mapC.mcables.cables[BreakID + 1].coordinate.x;
y2 := ivC.mapC.mcables.cables[BreakID + 1].coordinate.y;

offx := x2 - x1;
offy := y2 - y1;
if ivC.mapC.mCables.cables[BreakID].Distance = 0 then
t := 0
else
t := BreakDis / ivC.mapC.mCables.cables[BreakID].Distance;
BreakX := Round(offX * t) + x1;
BreakY := Round(offY * t) + y1;
// cheer wind 1999.10.29
if ivC.mapC.mBreakDistance < ivC.mapC.mTotalLength + 50 then
begin
case ivC.mapC.mStatus of
Alarming:
BreakPoints.Add(Format('%d,%d,%d', [BreakX, breakY, 1])); // 真正告警
TestAlarm:
BreakPoints.Add(Format('%d,%d,%d', [BreakX, breakY, 0])); // 模拟显示
end;
end;
end;
end;
end;

procedure TMap.GenerateHint;
var
mHint: string;
i, j: Integer;
head, parse: string;
begin
if not InitOK then exit;
mhint := '';
if ItemSelected and (ItemsRed.Count > 0) then
for i := 0 to ItemsRed.Count - 1 do
case ItemsRed[1] of
'P':
begin
parse := ItemsRed;
delete(parse, 1, 2);
j := StrToInt(parse);
//head := getPointType(ivP.mapP[j].mType) + ',名称:';
head := '';
if i = ItemsRed.Count - 1 then
mHint := mHint + Head + ivP.mapP[j].mName
else
mHint := mHint + Head + ivP.mapP[j].mName + Chr(13) + Chr(10)
end;
'S':
begin
parse := ItemsRed;
delete(parse, 1, 2);
j := StrToInt(parse);
head := getSectionType(ivS.mapS[j].mType) + ',名称:';
if i = ItemsRed.Count - 1 then
mHint := mHint + Head + ivS.mapS[j].mName
else
mHint := mHint + Head + ivS.mapS[j].mName + Chr(13) + Chr(10)
end;
'C':
begin
parse := ItemsRed;
delete(parse, 1, 2);
j := StrToInt(parse);
parse := '';
head := getCableType(ivC.mapC[j].mType) + ',名称:';
if (ivC.mapC[j].MStatus in [alarming, TestAlarm]) then
if (ivC.mapC[j].MType > 2) then
begin
if ivC.mapC[j].mBreakDistance < ivC.mapC[j].mTotalLength + 50 then
parse := Format('断点距离:%d米', [ivC.mapC[j].mBreakDistance])
else
parse := '发生断路告警';
end
else
parse := '发生异常';

if i = ItemsRed.Count - 1 then
mHint := mHint + Head + ivC.mapC[j].mName +
Format(' 总长度:%d米 ' + parse, [ivC.mapC[j].mTotalLength])
else
mHint := mHint + Head + ivC.mapC[j].mName +
Format(' 总长度:%d米 ' + parse, [ivC.mapC[j].mTotalLength]) +
Chr(13) + Chr(10)
end;
'M':
begin
parse := ItemsRed;
delete(parse, 1, 2);
j := StrToInt(parse);
head := getTermType(ivM.mapM[j].mType) + ',名称:';
if i = ItemsRed.Count - 1 then
mHint := mHint + Head + ivM.mapM[j].mName
else
mHint := mHint + Head + ivM.mapM[j].mName + Chr(13) + Chr(10)
end;
'T':
begin
parse := ItemsRed;
delete(parse, 1, 2);
j := StrToInt(parse);
parse := '';
head := getTesterType(ivT.mapT[j].mType) + ',名称:';
//if ivT.mapT[j].MStatus = alarming then
// parse := Format(' 电压异常:%d伏', [ivT.mapT[j].mVoltage]);
if i = ItemsRed.Count - 1 then
mHint := mHint + Head + ivT.mapT[j].mName + parse
else
mHint := mHint + Head + ivT.mapT[j].mName + parse + Chr(13) + Chr(10)
end;
end;

if mHint <> '' then
begin
Fpb.Hint := mHint;
Fpb.showHint := True;
Application.HintPause := 0;
Application.HintHidePause := 20000;
end
else
Fpb.showHint := False;
end;

{function TMap.getPointType(index: Integer): string;
begin
case index of
1: Result := '县';
2: Result := '乡';
3: Result := '行政村';
4: Result := '自然村';
end;
Result := '';
end;}

function TMap.getSectionType(index: Integer): string;
begin
case index of
1: Result := '县';
2: Result := '乡';
3: Result := '行政村';
end;
end;

function TMap.getCableType(index: Integer): string;
begin
case index of
1: Result := '中继线光缆';
2: Result := '局间中继光缆';
3: Result := '局间中继电缆';
4: Result := '主干电缆';
5: Result := '配线电缆';
end;
end;

function TMap.getTermType(index: Integer): string;
begin
Result := '终端模块';
end;

function TMap.getTesterType(index: Integer): string;
begin
Result := '智能机房';
end;

function TMap.InitMap: Boolean;
begin
freeParsedMapResource;

ImageBuffer := TBitMap.Create; // imageBuffer 存放原始地图
screenBuff := TBitMap.create; // screebBuff 存放当前显示地图
zoombuff := TBitMap.create; // zoomBuff 存放缩放图
mergeBuff := TBitMap.create; // mergeBuff 为临时作图中转缓冲区


ItemsRed := TStringList.Create;
oldItemsRed := TStringList.Create;
alarmItems := TStringList.Create;
BreakPoints := TStringList.Create;

if FileExists(mapPath) then
ImageBuffer.LoadFromFile(mapPath)
else
begin
Imagebuffer.Width := 1000;
Imagebuffer.Height := 1000;
end;

alarmColor := clLime;
alarmCore := 0;
if (FRatio < 0.0001) then
setZoomRatio(1);
randomize;
ItemSelected := False;
firstPaint := False;

mrStatus := mrNone;
zoomerStatus := mrNone;
dblClicked := False;

if Assigned(FZoomPB) then
begin
FzoomPB.Height := FzoomPB.Width;
zoomBuff.Width := FzoomPB.Width;
zoomBuff.Height := FzoomPB.Height;
zoomBuff.Canvas.CopyRect(Rect(0, 0, FzoomPB.ClientWidth, FzoomPB.ClientWidth), ImageBuffer.Canvas, ImageBuffer.Canvas.cliprect);
end;

FAlarmItemsTimer := TTimer.Create(self);
FAlarmItemsTimer.Interval := 500;
FAlarmItemsTimer.Enabled := False;
FAlarmItemsTimer.OnTimer := AlarmTimerTick;
FAlarmItemsTimer.Enabled := True;

FAlarmPointTimer := TTimer.Create(self);
FAlarmPointTimer.Interval := 100;
FAlarmPointTimer.Enabled := False;
FAlarmPointTimer.OnTimer := PointTimerTick;
FAlarmPointTimer.Enabled := True;

parseMapResource;
// 如果在设计时期则不显示地图
if csDesigning in ComponentState then
begin
Result := False;
InitOK := False;
end
else
begin
Result := True;
InitOK := True;
end;
end;

procedure TMap.parseMapResource;
//parseMapResource: 初始化地图数据,生成附加数据
var
i: integer;
ivStr: string;
ivFlag: char;
cc, cs, cp, cm, ct: Integer;
begin
if not Assigned(FRes) then exit;
cc := 0; cp := 0; cs := 0; cm := 0; ct := 0;
if FRes.count > 0 then
for i := 0 to FRes.count - 1 do
begin
ivStr := FRes;
ivFlag := ivStr[1];
delete(ivStr, 1, 2);
case ivFlag of
'S': inc(cs);
'C': inc(cc);
'P': inc(cp);
'M': inc(cm);
'T': inc(ct);
end;
end;
ivP.count := cp; ivS.Count := cs; ivC.Count := cc;
ivM.Count := cm; ivT.Count := ct;

cc := 0; cp := 0; cs := 0; cm := 0; ct := 0;
ivs.mapS := AllocMem(ivS.count * sizeof(mapSection));
ivc.mapC := AllocMem(ivC.count * sizeof(mapCable));
ivp.mapP := AllocMem(ivP.count * sizeof(mapPoint));
ivM.mapM := AllocMem(ivM.count * sizeof(mapTerm));
ivT.mapT := AllocMem(ivT.count * sizeof(mapTester));

if FRes.count > 0 then
for i := 0 to FRes.count - 1 do
begin
//Application.ProcessMessages;
ivStr := FRes;
ivFlag := ivStr[1];
delete(ivStr, 1, 2);
case ivFlag of
'S': //Section, 地区轮廓线, 生成随机颜色以及填充方式
begin
inc(cs);
// 生成颜色信息及填充模式
//ivs.mapS[cs-1].mColor := RGB(random(156)+100,random(156)+100,random(156)+100);
ivs.mapS[cs - 1].mBrushStyle := TBrushStyle(random(6) + 2);
// 解析轮廓线数据
parseSection(ivStr, ivS.mapS[cs - 1]);
ivS.mapS[cs - 1].index := i;
if ivS.mapS[cs - 1].mStatus = alarming then
alarmItems.Add('S,' + IntToStr(cs - 1));
end;
'C':
begin
inc(cc);
parseCable(ivStr, ivC.mapC[cc - 1]);
ivC.mapC[cc - 1].index := i;
if ivC.mapC[cc - 1].mStatus in [alarming, TestAlarm] then
alarmItems.Add('C,' + IntToStr(cc - 1));
end;
'P':
begin
inc(cp);
parsePoint(ivStr, ivP.mapP[cp - 1]);
ivP.mapP[cp - 1].index := i;
if ivP.mapP[cp - 1].mStatus = alarming then
alarmItems.Add('P,' + IntToStr(cp - 1));
end;
'M':
begin
inc(cm);
parseTerm(ivStr, ivM.mapM[cm - 1]);
ivM.mapM[cm - 1].index := i;
if ivM.mapM[cm - 1].mStatus = alarming then
alarmItems.Add('M,' + IntToStr(cm - 1));
end;
'T':
begin
inc(ct);
parseTester(ivStr, ivT.mapT[ct - 1]);
ivT.mapT[ct - 1].index := i;
if ivT.mapT[ct - 1].mStatus = alarming then
alarmItems.Add('T,' + IntToStr(ct - 1));
end;
end;
end;
CalcCableLength;
parseAlarmPoint;
end;

procedure TMap.freeParsedMapResource;
// 释放在解析原始地图数据(FRes)时所占用的内存资源
var
i: Integer;
begin
// 释放点数据
if ivP.count > 0 then
begin
FreeMem(ivP.mapP);
ivP.count := 0;
end;

// 释放轮廓线数据
if ivS.count > 0 then
begin
for i := 0 to ivS.count - 1 do
FreeMem(ivS.mapS.coordinate.Points);
FreeMem(ivS.mapS);
ivS.Count := 0;
end;

// 释放电缆数据
if ivC.count > 0 then
begin
for i := 0 to ivC.count - 1 do
FreeMem(ivC.mapC.mCables.Cables);
FreeMem(ivC.mapC);
ivC.count := 0;
end;

// 释放终端模块数据
if ivM.count > 0 then
begin
FreeMem(ivM.mapM);
ivM.count := 0;
end;

// 释放终端模块数据
if ivT.count > 0 then
begin
FreeMem(ivT.mapT);
ivT.count := 0;
end;

if Assigned(zoomBuff) then zoomBuff.Free;
if Assigned(screenBuff) then screenBuff.Free;
if Assigned(mergeBuff) then mergeBuff.Free;
if Assigned(ImageBuffer) then ImageBuffer.Free;
if Assigned(ItemsRed) then ItemsRed.Free;
if Assigned(oldItemsRed) then oldItemsRed.Free;
if Assigned(alarmItems) then alarmItems.Free;
if Assigned(BreakPoints) then BreakPoints.Free;
if Assigned(FAlarmItemsTimer) then
begin
FAlarmItemsTimer.Enabled := False;
while InAlarmItemTimer do sleep(1);
sleep(1);
FAlarmItemsTimer.Free;
FAlarmItemsTimer := nil;
end;
if Assigned(FAlarmpointTimer) then
begin
FAlarmPointTimer.Enabled := False;
while InAlarmPointTimer do sleep(1);
sleep(1);
FAlarmPointTimer.Free;
FAlarmPointTimer := nil;
end;
end;


procedure TMap.refreshMap;
begin
InitMap;
pbPaint(nil);
end;

procedure TMap.saveMapToLocal(filename: string);
begin
FRes.SaveToFile(filename);
end;

procedure TMap.loadMapFromLocal(filename: string);
begin
FRes.loadFromFile(filename);
InitMap;
end;

function TMap.AddItem(Item: string): Boolean;
// 增加一个数据元
begin
Result := False;
if not InitOK then exit;
FRes.Add(Item);
result := InitMap;
pbPaint(nil);
end;

function TMap.DeleteItem(mType: char; mSerialNo: string): Boolean;
var
i: Integer;
ivFlag: char;
ivStr, ivSerial: string;
ivPos: Integer;
begin
Result := False;
if not InitOK then exit;
if FRes.count = 0 then exit;
for i := 0 to FRes.count - 1 do
begin
//Application.ProcessMessages;
ivStr := FRes;
ivFlag := ivStr[1];
ivPos := pos(',', ivStr);
Delete(ivStr, 1, ivPos);
ivPos := pos(',', ivStr);
Delete(ivStr, 1, ivPos);
ivPos := pos(',', ivStr);
ivSerial := Copy(ivStr, 1, ivPos - 1);
if (ivFlag = mType) and (ivSerial = mSerialNo) then
begin
FRes.Delete(i);
Break;
end;
end;
Result := InitMap;
//pbPaint (NIL);
end;

function TMap.ModifyItem(mType: char; mSerialNo: string; nowStatus: Integer): Boolean;
var
i, j: Integer;
ivFlag: char;
ivStr, ivSerial: string;
ivPos, ivPos1: Integer;
begin
Result := False;
if not InitOK then exit;
if FRes.count = 0 then exit;
for i := 0 to FRes.count - 1 do
begin
//Application.ProcessMessages;
ivStr := FRes;
ivFlag := ivStr[1];
ivPos := pos(',', ivStr);
Delete(ivStr, 1, ivPos);
ivPos := pos(',', ivStr);
Delete(ivStr, 1, ivPos);
ivPos := pos(',', ivStr);
ivSerial := Copy(ivStr, 1, ivPos - 1);
if (ivFlag = mType) and (ivSerial = mSerialNo) then
begin
ivStr := FRes;
for j := 1 to 4 do
begin
ivPos := pos(',', ivStr);
Delete(ivStr, 1, ivPos);
end;
ivPos1 := pos(ivStr, FRes) - 1;
ivPos := pos(',', ivStr);
Delete(ivStr, 1, ivPos - 1);
ivStr := copy(FRes, 1, ivPos1) + IntToStr(nowStatus) + ivStr;
FRes := ivStr;
Break;
end;
end;
Result := InitMap;
pbPaint(nil);
end;

procedure TMap.centerShowMap(x, y: Integer);
begin
if not InitOK then exit;
dispX := Round(X * FRatio) - (FPb.ClientWidth div 2);
dispY := Round(Y * FRatio) - (FPb.ClientHeight div 2);
pbPaint(nil);
end;

procedure TMap.setResource(resource: TStrings);
begin
if resource <> nil then
begin
FRes.Clear;
FRes.Assign(resource);
RefreshMap;
end;
end;

function TMap.convertCoordinateToRealPosition(pp: TPoint): TPoint;
begin
result.X := Round((pp.X + dispX) / FRatio);
result.Y := Round((pp.Y + dispY) / FRatio);
end;

function TMap.convertRealPositionToCoordinate(pp: TPoint): TPoint;
begin
Result.X := Round(PP.X * FRatio) - DispX;
Result.Y := Round(PP.Y * FRatio) - DispY;
end;

function TMap.ExpressCableColor(mStatus: ItemStatus): TColor;
begin
case mStatus of
Planning: Result := clBlack;
Buliding: Result := clGreen;
Using: Result := clLime;
Abandon: Result := clPurple;
Abnormity: Result := clRed;
Special: Result := clYellow;
Alarming, TestAlarm: Result := alarmColor;
Designing: Result := clRed;
// TestAlarm : Result := clBlue;//alarmColor;
else
Result := clTeal;
end;
end;

procedure TMap.AlarmTimerTick(Sender: TObject);
begin
InAlarmItemTimer := True;
FAlarmItemsTimer.Enabled := False;
DrawAlarmItems;
FAlarmItemsTimer.Enabled := True;
InAlarmItemTimer := False;
end;

procedure TMap.PointTimerTick(Sender: TObject);
begin
InAlarmPointTimer := True;
FAlarmPointTimer.Enabled := False;
DrawAlarmPoints;
FAlarmPointTimer.Enabled := True;
InAlarmPointTimer := False;
end;

procedure TMap.DrawAlarmPoints;
// 画电缆告警断点
var
i, x1, y1, x2, y2, offx, offy: Integer;
radius: Integer;
triangleLen: Integer;
BreakX, breakY: Integer;
ivStr: string;
ptar: array[0..3] of tpoint;
ivPos, mAlter: Integer;
mAlterColor: TColor;
begin
Radius := Round(20 * FRatio);
triangleLen := Round(6 * Ratio);
alarmCore := alarmCore - Round(2 * FRatio);
if alarmCore < 0 then alarmCore := Radius - triangleLen - 1;
with FPb.Canvas do
for i := 0 to BreakPoints.Count - 1 do
begin
ivStr := BreakPoints;
ivPos := pos(',', ivStr);
BreakX := StrToInt(Copy(ivStr, 1, ivPos - 1));
Delete(ivStr, 1, ivPos);
ivPos := pos(',', ivStr);
BreakY := StrToInt(Copy(ivStr, 1, ivPos - 1));
Delete(ivStr, 1, ivPos);
mAlter := StrToInt(ivStr); // 判断是否为模拟告警
mAlterColor := clRed;
case mAlter of
0:
mAlterColor := clBlue;
1:
mAlterColor := clRed;
end;
BreakX := Round(BreakX * FRatio) - dispX;
BreakY := Round(BreakY * FRatio) - dispY;

offy := Round(triangleLen * tan(Pi / 6));
offx := triangleLen;

x1 := BreakX - Radius;
y1 := BreakY - Radius;
x2 := BreakX + Radius;
y2 := BreakY + Radius;
Pen.Color := mAlterColor;
Brush.Style := bsClear;
Brush.Color := clWhite;
Pen.width := 2;
Ellipse(X1, Y1, X2, Y2);

Brush.Style := bsSolid;
Pen.Width := 2;
Pen.Color := mAlterColor;
Pen.Style := psSolid;
Brush.Color := mAlterColor;
Brush.Style := bsSolid;

ptar[0] := Point(alarmCore + BreakX, BreakY);
ptar[1] := Point(alarmCore + offx + BreakX, BreakY + offY);
ptar[2] := Point(alarmCore + offx + BreakX, BreakY - offY);
PolyGon([ptar[0], ptar[1], ptar[2], ptar[0]]);

ptar[0] := Point(-alarmCore + BreakX, BreakY);
ptar[1] := Point(-alarmCore - offx + BreakX, BreakY + offY);
ptar[2] := Point(-alarmCore - offx + BreakX, BreakY - offY);
PolyGon([ptar[0], ptar[1], ptar[2], ptar[0]]);

ptar[0] := Point(BreakX, alarmCore + BreakY);
ptar[1] := Point(offY + BreakX, alarmCore + offx + BreakY);
ptar[2] := Point(-offY + BreakX, alarmCore + offx + BreakY);
PolyGon([ptar[0], ptar[1], ptar[2], ptar[0]]);

ptar[0] := Point(BreakX, -alarmCore + BreakY);
ptar[1] := Point(offY + BreakX, -alarmCore - offx + BreakY);
ptar[2] := Point(-offY + BreakX, -alarmCore - offx + BreakY);
PolyGon([ptar[0], ptar[1], ptar[2], ptar[0]]);
end;
end;

procedure TMap.DrawAlarmItems;
var
i: Integer;
ivStr: string;
ivFlag: char;
index: Integer;
begin
if not InitOK then exit;
if not Assigned(AlarmItems) then exit;
if AlarmItems.count = 0 then exit;
if alarmColor = clRed then
alarmColor := clLime
else
alarmColor := clRed;
for i := 0 to alarmItems.count - 1 do
begin
ivStr := alarmItems;
ivFlag := ivStr[1];
delete(ivStr, 1, 2);
index := strToint(ivStr);
case ivFlag of
'S': //Section, 地区轮廓线
DrawSection(index, Fpb.Canvas, False);
'C': //Cable,电缆
DrawCable(index, Fpb.Canvas, False);
'P': // Point, 地点
DrawPoint(index, Fpb.Canvas, False);
'M': // Term, 终端模块
DrawTerm(index, Fpb.Canvas, False);
'T': // Tester, 测试模块
DrawTester(index, Fpb.Canvas, False);
end;
end;
end;
end.
 
后退
顶部