📄 class_71702_map.~pas
字号:
unit Class_71702_Map;
interface
uses
SysUtils, Classes, StdCtrls, Contnrs, Controls, ExtCtrls,
Messages, Windows, Math,ADODB,Forms;
type
TGPSData = record
LONG:double;
LONGAt:char;
LAT:double;
LATAt:char;
end;
PMapSet = ^TMapset;
TMapSet = record
FID:Integer;
FLeftTopGPS:TGPSData;
FRightBottenGPS:TGPSData;
FMapBitmpName:String;
FReferenceFrame:Integer;
end;
TFloatPoint = record
FloatX:double;
FloatY:double;
end;
TCls_Image_Map = Class(Timage)
private
FMapSet:TMapSet;
procedure SetMapSet(Value:TMapSet);
function GetScaling():TFloatPoint;
function GetLeftTopGPSAngle:TFloatPoint;
function GetRightBottomGPSAngle:TFloatPoint;
function ChangeGPSFormat(AValue:TGPSData):TFloatPoint;
function GetCoordinateName:string;
protected
public
constructor Create(AMapSet:TMapSet;AOwner: TComponent); // 构造函数
procedure ZoomInMap();
procedure ZoomOutMap();
procedure FullClientMap();
procedure OriginalSizeMap();
published
property Align;
property Anchors;
property AutoSize;
property Center;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property IncrementalDisplay;
property ParentShowHint;
property Picture;
property PopupMenu;
property Proportional;
property ShowHint;
property Stretch;
property Transparent;
property Visible;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnProgress;
property OnStartDock;
property OnStartDrag;
property MapSet: TMapSet read FMapSet write SetMapSet;
property Scaling:TFloatPoint read GetScaling;
property LeftTopGPSAngle:TFloatPoint read GetLeftTopGPSAngle;
property RightBottomGPSAngle:TFloatPoint read GetRightBottomGPSAngle;
property CorrdinateName: String read GetCoordinateName;
end;
TMapSetArr = array of TMapSet;
TCls_MapSet_Operate = Class
private
FADOQuery:TADOQuery;
FMapSetList:TList;
FPMapSet:PMapSet;
FMapCount:integer;
function GetMapCount:integer;
public
procedure AddMapSet(AValue:PMapSet);
procedure DelMapSet(AValue:PMapSet);overload;
procedure DelMapSet(i:integer);overload;
procedure EditMapSet(AValue:PMapSet);overload;
procedure EditMapSet(index:integer;AValue:TMapSet);overload;
function GetAllMapSet():TMapSetArr;
procedure ChangeMapSet(AValue:PMapSet);
procedure AutoSelectMapSet(AGPSData:TFloatPoint);
constructor Create();
function MapItem(i:integer):TMapSet;
destructor Destroy; override;
published
property MapCount:integer read GetMapCount;
end;
procedure Register;
implementation
const ShunDivByZer0 = 0.000000000028;
procedure Register;
begin
RegisterComponents('Additional', [TCls_Image_Map]);
end;
{ TCls_Image_Map }
function TCls_Image_Map.ChangeGPSFormat(AValue:TGPSData): TFloatPoint;
var
tmpFloat:double;
begin
tmpFloat := AValue.LONG / 100.0;
Result.FloatX := Int(tmpFloat) + Frac(tmpFloat) * 100.0 / 60.0;
tmpFloat := AValue.LAT / 100.0;
Result.FloatY := Int(tmpFloat) + Frac(tmpFloat) * 100.0 / 60.0;
end;
constructor TCls_Image_Map.Create(AMapSet:TMapSet;AOwner: TComponent);
begin
inherited Create(AOwner);
FMapSet := AMapSet;
end;
procedure TCls_Image_Map.FullClientMap;
begin
Align := alClient;
Stretch := True;
AutoSize := False;
end;
function TCls_Image_Map.GetCoordinateName: string;
begin
if MapSet.FReferenceFrame = 2 then
Result := '北京54坐标'
else
Result := 'WGS84坐标';
end;
function TCls_Image_Map.GetLeftTopGPSAngle: TFloatPoint;
begin
Result := ChangeGPSFormat(MapSet.FLeftTopGPS);
end;
function TCls_Image_Map.GetRightBottomGPSAngle: TFloatPoint;
begin
Result := ChangeGPSFormat(MapSet.FRightBottenGPS);
end;
function TCls_Image_Map.GetScaling: TFloatPoint;
var
LONGDiff,LATDiff:double;
begin
//计算经度差
LONGDiff := (LeftTopGPSAngle.FloatX - RightBottomGPSAngle.FloatX) * 60 * 60 * 10 + ShunDivByZer0;
//计算纬度差
LATDiff := (LeftTopGPSAngle.FloatY - RightBottomGPSAngle.FloatY) * 60 * 60 * 10 + ShunDivByZer0;
Result.FloatX := ClientWidth / (LONGDiff);
Result.FloatY := ClientHeight / (LATDiff);
end;
procedure TCls_Image_Map.OriginalSizeMap;
begin
Align := alNone;
Stretch := False;
AutoSize := True;
Top := 0;
Left := 0;
end;
procedure TCls_Image_Map.SetMapSet(Value: TMapSet);
begin
FMapSet := Value;
end;
procedure TCls_Image_Map.ZoomInMap;
begin
Align := alNone;
AutoSize := False;
Stretch := True;
Width := Floor(Width * 1.2);
Height := Floor(Height * 1.2);
end;
procedure TCls_Image_Map.ZoomOutMap;
var
tmpWidth,tmpHeight:Integer;
begin
Align := alNone;
AutoSize := False;
Stretch := True;
tmpWidth := Floor(Width / 1.2);
tmpHeight := Floor(Height / 1.2);
if tmpWidth < Parent.ClientWidth then
Width := Parent.ClientWidth
else
Width := tmpWidth;
if tmpHeight < Parent.ClientHeight then
Height := Parent.ClientHeight
else
height := tmpHeight;
end;
{ TCls_MapSet_Operate }
procedure TCls_MapSet_Operate.AddMapSet(AValue:PMapSet);
begin
FMapSetList.Add(AValue);
end;
procedure TCls_MapSet_Operate.AutoSelectMapSet(AGPSData:TFloatPoint);
function FloatIsIn(data1,data2,data3:double):boolean;
begin
Result := False;
if ((data1 > data2) and (data1 < data3))
or ((data1 < data2) and (data1 > data3)) then
Result := True;
end;
var
i,nListCount:integer;
bFindOK:boolean;
pPMapSet:PMapSet;
begin
if not ((FloatIsIn(AGPSData.FloatX, FPMapSet^.FLeftTopGPS.LONG, FPMapSet^.FRightBottenGPS.LONG))
and (FloatIsIn(AGPSData.FloatY, FPMapSet^.FLeftTopGPS.LAT, FPMapSet^.FRightBottenGPS.LAT))) then
begin
try
New(pPMapSet);
bFindOK := False;
i := 0;
nListCount := FMapSetList.Count;
while (i < nListCount) and (not bFindOK) do
begin
pPMapSet := FMapSetList[i];
if (FloatIsIn(AGPSData.FloatX, pPMapSet^.FLeftTopGPS.LONG, pPMapSet^.FRightBottenGPS.LONG))
and (FloatIsIn(AGPSData.FloatY, pPMapSet^.FLeftTopGPS.LAT, pPMapSet^.FRightBottenGPS.LAT)) then
begin
FPMapSet := FMapSetList[i];
bFindOK := True;
end;
Inc(i);
end;
finally
Dispose(pPMapSet);
end;
end;
end;
procedure TCls_MapSet_Operate.ChangeMapSet(AValue:PMapSet);
begin
FPMapSet^ := AValue^;
end;
constructor TCls_MapSet_Operate.Create();
var
DbName:string;
begin
FMapSetList := TList.Create;
FADOQuery := TADOQuery.Create(Nil);
DbName := ExtractFilePath(Application.ExeName) + '\data\DataBase.mdb';
FADOQuery.ConnectionString := Format('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;Persist Security Info=False', [DbName]);
New(FPMapSet);
end;
procedure TCls_MapSet_Operate.DelMapSet(AValue:PMapSet);
var
i,ListCount:integer;
bFindOK:boolean;
PMapSetCurr:PMapSet;
begin
try
New(PMapSetCurr);
i := 0;
ListCount := FMapSetList.Count;
bFindOk := False;
while (i < ListCount) and (not BFindOK) do
begin
PMapSetCurr := FMapSetList[i];
if PMapSetCurr^.FID = AValue^.FID then
begin
FMapSetList.Delete(i);
bFindOk := True;
end;
Inc(i);
end;
finally
Dispose(PMapSetCurr);
end;
end;
procedure TCls_MapSet_Operate.DelMapSet(i: integer);
begin
FMapSetList.Delete(i);
end;
destructor TCls_MapSet_Operate.Destroy;
begin
FMapSetList.Free;
FADOQuery.Free;
Dispose(FPMapSet);
inherited;
end;
procedure TCls_MapSet_Operate.EditMapSet(AValue:PMapSet);
var
i,ListCount:integer;
bFindOK:boolean;
PMapSetCurr:PMapSet;
begin
try
New(PMapSetCurr);
i := 0;
ListCount := FMapSetList.Count;
bFindOk := False;
while (i < ListCount) and (not BFindOK) do
begin
PMapSetCurr := FMapSetList[i];
if PMapSetCurr^.FID = AValue^.FID then
begin
FMapSetList[i] := AValue;
bFindOk := True;
end;
Inc(i);
end;
finally
Dispose(PMapSetCurr);
end;
end;
procedure TCls_MapSet_Operate.EditMapSet(index: integer; AValue: TMapSet);
var
APMapSet:PMapSet;
begin
New(APMapSet);
APMapSet := FMapSetList[index];
APMapSet^.FLeftTopGPS := AValue.FLeftTopGPS;
APMapSet^.FRightBottenGPS := AValue.FRightBottenGPS;
APMapSet^.FMapBitmpName := AValue.FMapBitmpName;
APMapSet^.FReferenceFrame := AValue.FReferenceFrame;
with FADOQuery do
begin
Close;
SQL.Clear;
SQL.Add('Update tblMapsave set [文件名]=:pFileName,[左上经度]=:pLeftLong,[左上纬度]=:pLeftLat,');
SQL.Append('[右下经度]=:pReightLong,[右下纬度]=:pRightLat,[坐标系]=:pCoor where [ID]=:pID');
Parameters.ParamByName('pFileName').Value := AValue.FMapBitmpName;
Parameters.ParamByName('pLeftLong').Value := FloatToStr(AValue.FLeftTopGPS.LONG);
Parameters.ParamByName('pLeftLat').Value := FloatToStr(AValue.FLeftTopGPS.LAT);
Parameters.ParamByName('pReightLong').Value := FloatToStr(AValue.FRightBottenGPS.LONG);
Parameters.ParamByName('pRightLat').Value := FloatToStr(AValue.FRightBottenGPS.LAT);
Parameters.ParamByName('pCoor').Value := AValue.FReferenceFrame;
Parameters.ParamByName('pID').Value := AValue.FID;
ExecSQL;
Close;
end;
end;
function TCls_MapSet_Operate.GetAllMapSet:TMapSetArr;
var
APMapSet:PMapSet;
begin
try
FADOQuery.Close;
FADOQuery.SQL.Clear;
FADOQuery.SQL.Add('Select * From tblMapSave');
FADOQuery.Open;
FMapSetList.Clear;
FADOQuery.First;
New(APMapSet);
while not FADOQuery.Eof do
begin
APMapSet^.FID := FADOQuery.FieldByName('ID').Value;
APMapSet^.FLeftTopGPS.LONG := FADOQuery.FieldByName('左上经度').AsFloat;
APMapSet^.FRightBottenGPS.LONG := FADOQuery.FieldByName('右下经度').AsFloat;
APMapSet^.FLeftTopGPS.LONGAt := 'E';
APMapSet^.FLeftTopGPS.LATAt := 'N';
APMapSet^.FLeftTopGPS.LAT := FADOQuery.FieldByName('左上纬度').AsFloat;
APMapSet^.FRightBottenGPS.LAT := FADOQuery.FieldByName('右下纬度').AsFloat;
APMapSet^.FRightBottenGPS.LONGAt := 'E';
APMapSet^.FRightBottenGPS.LATAt := 'N';
APMapSet^.FMapBitmpName := FADOQuery.FieldByName('文件名').Value;
APMapSet^.FReferenceFrame := FADOQuery.FieldByName('坐标系').Value;
FMapSetList.Add(APMapSet);
New(APMapSet);
FADOQuery.Next;
end;
finally
FADOQuery.Close;
Dispose(APMapSet);
end;
end;
function TCls_MapSet_Operate.GetMapCount: integer;
begin
Result := FMapSetList.Count;
end;
function TCls_MapSet_Operate.MapItem(i: integer): TMapSet;
var
AMapSet: PMapSet;
begin
AMapSet := FMapSetList.Items[i];
Result := AMapSet^;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -