⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 class_71702_map.pas

📁 自己编写的在Delphi下进行图像开发的空间可以向
💻 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 + -