mapxbase.pas

此代码是关于mapgis的在

    Result.Right := pt1.x;
  end;
  if pt1.y < pt2.y then begin
    Result.Top := pt1.y;
    Result.Bottom := pt2.y;
  end else begin
    Result.Top := pt2.y;
    Result.Bottom := pt1.y;
  end;
end;

procedure OffsetGeoRect(var ARect:TAnyRect; const dx, dy: Double);
begin
  ARect.Left:=ARect.Left+dx;
  ARect.Top:=ARect.Top+dy;
  ARect.Right:=ARect.Right+dx;
  ARect.Bottom:=ARect.Bottom+dy;
end;

procedure InflateGeoRect(var ARect:TAnyRect; const dx, dy: Double);
begin
  ARect.Left:=ARect.Left-dx;
  ARect.Top:=ARect.Top-dy;
  ARect.Right:=ARect.Right+dx;
  ARect.Bottom:=ARect.Bottom+dy;
end;

procedure ScaleGeoRect(var ARect:TAnyRect; const sx, sy: Double);
begin
  ARect.Left:=ARect.Left*sx;
  ARect.Top:=ARect.Top*sy;
  ARect.Right:=ARect.Right*sx;
  ARect.Bottom:=ARect.Bottom*sy;
end;

procedure NormalRect(var Rect:TAnyRect);
var
  i: Double;
begin
  with Rect do
  begin
    if Left > Right then
    begin
      i := Left;
      Left := Right;
      Right := i
    end;
    if Top > Bottom then
    begin
      i := Top;
      Top := Bottom;
      Bottom := i
    end;
  end;
end;

procedure NormalLinePoint(var pt1, pt2:TAny2DPoint);
var
  tmp:TAny2DPoint;
begin
  if pt1.X>pt2.X then
  begin
    tmp.X:=pt1.X;
    tmp.Y:=pt1.Y;
    pt1.X:=pt2.X;
    pt1.Y:=pt2.Y;
    pt2.X:=tmp.X;
    pt2.Y:=tmp.Y;
  end;
end;

procedure NormalValue(var v1, v2: Double);
var
  tmp:Double;
begin
  if v1>v2 then
  begin
    tmp:=v1;
    v1:=v2;
    v2:=tmp;
  end;
end;

constructor TObjectMethodList.Create;
begin
  FList:=TList.Create;
end;

destructor TObjectMethodList.Destroy;
begin
  Clear;
  FList.Free;
  inherited Destroy;
end;

function TObjectMethodList.GetItemCount:Integer;
begin
  Result:=FList.Count;
end;

function TObjectMethodList.GetItem(Index:Integer):PObjectMethodInfo;
begin
  Result:=FList.Items[Index];
end;

function TObjectMethodList.Add:PObjectMethodInfo;
begin
  GetMem(Result,SizeOf(TObjectMethodInfo));
  FList.Add(Result);
end;

function TObjectMethodList.Insert(const Index:Integer):PObjectMethodInfo;
var
  P:PObjectMethodInfo;
begin
  GetMem(P,SizeOf(TObjectMethodInfo));
  Result:=P;
  FList.Insert(Index,P);
end;

procedure TObjectMethodList.Delete(const Index:Integer);
begin
  Dispose(PObjectMethodInfo(FList.Items[Index]));
  FList.Delete(Index);
end;

procedure TObjectMethodList.Clear;
var
  i:Integer;
begin
  for i:=0 to FList.Count-1 do
    Dispose(PObjectMethodInfo(FList.Items[i]));
  FList.Clear;
end;

function TObjectMethodList.AddAndInit(const TypeId: Integer; Obj: TObject;
  pProc: Pointer): PObjectMethodInfo;
begin
  Result:=Add;
  Result^.TypeId:=TypeId;
  Result^.Method.Data:=Obj;
  Result^.Method.Code:=pProc;
end;

function TObjectMethodList.InsertAndInit(const Index, TypeId: Integer;
  Obj: TObject; pProc: Pointer): PObjectMethodInfo;
begin
  Result:=Insert(Index);
  Result^.TypeId:=TypeId;
  Result^.Method.Data:=Obj;
  Result^.Method.Code:=pProc;
end;

function TObjectMethodList.IndexOf(Obj: TObject; pProc: Pointer): Integer;
var
  i:Integer;
begin
  Result:=-1;
  for i:=0 to FList.Count-1 do
    if (Items[i].Method.Data=Obj)and(Items[i].Method.Code=pProc) then
    begin
      Result:=i;
      Exit;
    end;
end;

{ TBaseStyleInfo }

constructor TBaseStyleInfo.Create;
begin
  inherited Create;
end;

function TBaseStyleInfo.CreateStyleInterfaceObject: Style;
begin
  Result:=CoStyle.Create;
end;

procedure TBaseStyleInfo.LoadFromStream(Stream: TStream);
begin
  UserId:=ReadInteger(Stream);
  Caption:=ReadString(Stream);
  Script:=ReadString(Stream);
end;

procedure TBaseStyleInfo.LoadFromField(BlobField: TBlobField);
var
  BlobStream: TStream;
begin
  BlobStream := BlobField.DataSet.CreateBlobStream(BlobField, bmRead);
  try
    LoadFromStream(BlobStream);
  finally
    BlobStream.Free;
  end;
end;

procedure TBaseStyleInfo.SaveToField(BlobField: TBlobField);
var
  BlobStream: TStream;
begin
  BlobStream := BlobField.DataSet.CreateBlobStream(BlobField, bmWrite);
  try
    SaveToStream(BlobStream);
  finally
    BlobStream.Free;
  end;
end;

procedure TBaseStyleInfo.SaveToStream(Stream: TStream);
begin
  WriteInteger(Stream, UserId);
  WriteString(Stream, Caption);
  WriteString(Stream, Script);
end;

constructor TStyleInfoList.Create;
begin
  FList:=TList.Create;
end;

destructor TStyleInfoList.Destroy;
begin
  Clear;
  FList.Free;
  inherited Destroy;
end;

function TStyleInfoList.GetItemCount:Integer;
begin
  Result:=FList.Count;
end;

function TStyleInfoList.GetItem(Index:Integer):TBaseStyleInfo;
begin
  Result:=FList.Items[Index];
end;

procedure TStyleInfoList.Add(Value:TBaseStyleInfo);
begin
  FList.Add(Value);
end;

procedure TStyleInfoList.Insert(const Index:Integer;Value:TBaseStyleInfo);
begin
  FList.Insert(Index,Value);
end;

procedure TStyleInfoList.Delete(const Index:Integer);
begin
  TBaseStyleInfo(FList.Items[Index]).Free;
  FList.Delete(Index);
end;

procedure TStyleInfoList.Clear;
var
  i:Integer;
begin
  for i:=0 to FList.Count-1 do
    TBaseStyleInfo(FList.Items[i]).Free;
  FList.Clear;
end;

function TStyleInfoList.FindByUserID(
  const UserId: Integer): TBaseStyleInfo;
var
  Index:Integer;
begin
  Index:=IndexByUserID(UserId);
  if Index>-1 then
    Result:=FList.Items[Index]
  else
    Result:=nil;
end;

function TStyleInfoList.IndexByUserID(const UserId: Integer): Integer;
var
  i:Integer;
begin
  Result:=-1;
  for i:=0 to FList.Count-1 do
    if Items[i].UserID=UserId then
    begin
      Result:=i;
      Exit;
    end;
end;

procedure TStyleInfoList.LoadFromStream(Stream: TStream);
var
  i:Integer;
  myCount:Integer;
  myClass:TStyleInfoClass;
//  AObj:TBaseStyleInfo;
begin
  Clear;
  myCount:=ReadInteger(Stream);
  for i:=0 to myCount-1 do
  begin
    myClass:=GetStyleInfoClass(ReadString(Stream));
    Add(myClass);
//    AObj.LoadFromStream(Stream);
  end;
end;

procedure TStyleInfoList.SaveToStream(Stream: TStream);
var
  i:Integer;
  AObj:TBaseStyleInfo;
begin
  WriteInteger(Stream, FList.Count);
  for i:=0 to FList.Count-1 do
  begin
    AObj:=Items[i];
    AObj.SaveToStream(Stream);
  end;
end;

procedure TStyleInfoList.Add(AStyleClass: TStyleInfoClass);
var
  AObj:TBaseStyleInfo;
begin
  AObj:=TBaseStyleInfo(AStyleClass.NewInstance);
  AObj.Create;
  Add(AObj);  
end;

procedure TStyleInfoList.Insert(const Index: Integer;
  AStyleClass: TStyleInfoClass);
var
  AObj:TBaseStyleInfo;
begin
  AObj:=TBaseStyleInfo(AStyleClass.NewInstance);
  AObj.Create;
  Insert(Index, AObj);  
end;

constructor TMapPointList.Create;
begin
  FList:=TList.Create;
  FStoreManager:=TStoreManager.Create;
  FStoreManager.OnSaveToStream:=DoSaveToStream;
  FStoreManager.OnLoadFromStream:=DoLoadFromStream;
end;

destructor TMapPointList.Destroy;
begin
  Clear;
  FList.Free;
  FStoreManager.Free;
  inherited Destroy;
end;

function TMapPointList.GetItemCount:Integer;
begin
  Result:=FList.Count;
end;

function TMapPointList.GetItem(Index:Integer):PMapPoint;
begin
  Result:=FList.Items[Index];
end;

procedure TMapPointList.Add(Value:PMapPoint);
begin
 FList.Add(Value);
end;

function TMapPointList.Add:PMapPoint;
begin
  GetMem(Result,SizeOf(TMapPoint));
  Add(Result);
end;

procedure TMapPointList.Insert(const Index:Integer;Value:PMapPoint);
begin
  FList.Insert(Index,Value);
end;

function TMapPointList.Insert(const Index:Integer):PMapPoint;
var
  P:PMapPoint;
begin
  GetMem(P,SizeOf(TMapPoint));
  Result:=P;
  FList.Insert(Index,P);
end;

procedure TMapPointList.Delete(const Index:Integer);
begin
  Dispose(PMapPoint(FList.Items[Index]));
  FList.Delete(Index);
end;

procedure TMapPointList.Clear;
var
  i:Integer;
begin
  for i:=0 to FList.Count-1 do
    Dispose(PMapPoint(FList.Items[i]));
  FList.Clear;
end;

procedure TMapPointList.LoadFromPoints(Pts: CMapXPoints);
var
  i:Integer;
begin
  Self.Clear;
  for i:=1 to Pts.Count do
    AddXY(Pts.Item[i].x, Pts.Item[i].y);
end;

procedure TMapPointList.ConfigPoints(Pts: CMapXPoints; bClear: Boolean);
var
  i:Integer;
begin
  if bClear then Pts.RemoveAll;
  for i:=0 to FList.Count-1 do
    Pts.AddXY(Items[i].x, Items[i].y, EmptyParam);
end;

function TMapPointList.CreatePointsInterfaceObject: CMapXPoints;
var
  Pts:Points;
begin
  Pts:=CoPoints.Create;
  ConfigPoints(Pts, True);
  Result:=Pts;
end;

procedure TMapPointList.Assign(Source: TMapPointList);
var
  i:Integer;
  aItem:PMapPoint;
begin
  Self.Clear;
  for i:=0 to Source.ItemCount-1 do
  begin
    aItem:=Add;
    aItem.x:=Source.Items[i].x;
    aItem.y:=Source.Items[i].y;
  end;
end;

function TMapPointList.AddXY(const x, y: Double): PMapPoint;
begin
  Result:=Add;
  Result.x:=x;
  Result.y:=y;
end;

constructor TMapPartList.Create;
begin
  FList:=TList.Create;
  FStoreManager:=TStoreManager.Create;
  FStoreManager.OnSaveToStream:=DoSaveToStream;
  FStoreManager.OnLoadFromStream:=DoLoadFromStream;
end;

destructor TMapPartList.Destroy;
begin
  Clear;
  FList.Free;
  FStoreManager.Free;
  inherited Destroy;
end;

function TMapPartList.GetItemCount:Integer;
begin
  Result:=FList.Count;
end;

function TMapPartList.GetItem(Index:Integer):TMapPointList;
begin
  Result:=FList.Items[Index];
end;

procedure TMapPartList.Add(Value:TMapPointList);
begin
 FList.Add(Value);
end;

function TMapPartList.Add:TMapPointList;
begin
 Result:=TMapPointList.Create;
 Add(Result);
end;

procedure TMapPartList.Insert(const Index:Integer;Value:TMapPointList);
begin
  FList.Insert(Index,Value);
end;

function TMapPartList.Insert(const Index:Integer):TMapPointList;
begin
  Result:=TMapPointList.Create;
  FList.Insert(Index,Result);
end;

procedure TMapPartList.Delete(const Index:Integer);
begin
  TMapPointList(FList.Items[Index]).Free;
  FList.Delete(Index);
end;

procedure TMapPartList.Clear;
var
  i:Integer;
begin
  for i:=0 to FList.Count-1 do
    TMapPointList(FList.Items[i]).Free;
  FList.Clear;
end;

procedure TBaseStyleInfo.SaveToParam(AParam:TParam; DataType: TDataType);
var
  AStream:TMemoryStream;
begin
  AStream:=TMemoryStream.Create;
  try
    SaveToStream(AStream);
    AParam.LoadFromStream(AStream, DataType);
  finally
    AStream.Free;
  end;
end;

procedure TBaseStyleInfo.SaveToParameter(AParam:TParameter; DataType: TDataType);
var
  AStream:TMemoryStream;
begin
  AStream:=TMemoryStream.Create;
  try
    SaveToStream(AStream);
    AParam.LoadFromStream(AStream, DataType);
  finally
    AStream.Free;
  end;
end;

{ TBaseMapTool }

function TBaseMapTool.Cancel: Boolean;
begin
end;

constructor TBaseMapTool.Create(aCollection: TToolList);
begin
  inherited Create;
  FCollection:=aCollection;
  FGlyph := TBitmap.Create;
  FGlyph.OnChange := GlyphChanged;
end;

destructor TBaseMapTool.Destroy;
begin
  FGlyph.Free;
  inherited Destroy;
end;

procedure TBaseMapTool.EndTheTool;
begin
  if Assigned(FOnTurnTool) then
    FOnTurnTool(Self);
end;

procedure TBaseMapTool.GlyphChanged(Sender: TObject);
begin
end;

function TBaseMapTool.IsLocalCurrentTool: Boolean;
begin
  Result:=IsMapXCurrentTool;
  if Result and (FCollection<>nil) then
    Result:=FCollection.CurrentToolObject=Self;
end;

function TBaseMapTool.IsMapXCurrentTool: Boolean;
begin
  Result:=MapX.CurrentTool=ToolId;
end;

procedure TBaseMapTool.SetCursorIcon(Value: string);
begin