mapxbase.pas

此代码是关于mapgis的在

  Value:=Trim(Value);
  if Value<>'' then
  begin
    FCursorType:=miCustomCursor;
    FCursorIcon := Value;
  end;
end;

procedure TBaseMapTool.SetGlyph(const Value: TBitmap);
begin
  FGlyph.Assign(Value);
end;

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

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

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

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

procedure TToolList.Add(Value:TBaseMapTool);
begin
  FList.Add(Value);
end;

procedure TToolList.Insert(const Index:Integer;Value:TBaseMapTool);
begin
  FList.Insert(Index,Value);
end;

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

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

function TToolList.GetNewToolId: Integer;
var
  i:Integer;
  aItem:TBaseMapTool;
begin
  Result:=0;
  for i:=0 to ItemCount-1 do
  begin
    aItem:=Items[i];
    if (aItem.IsUserMapTool)and(aItem.ToolId>Result) then
      Result:=aItem.ToolId;
  end;
  Result:=Result+1;
end;

procedure TToolList.SetCurrentTool(const ToolId: Integer);
var
  Index:Integer;
begin
  Index:=IndexByToolId(ToolId);
  if Index=-1 then
  begin
    ShowMessage('该工具不存在！');
    Exit;
  end;
  SetCurrentTool(Items[Index]);
end;

function TToolList.FindByToolId(const ToolId: Integer): TBaseMapTool;
var
  Index:Integer;
begin
  Index:=IndexByToolId(ToolId);
  if Index>-1 then
    Result:=Items[Index]
  else
    Result:=nil;
end;

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

function TToolList.FindByClassName(const ClassName: string): TBaseMapTool;
var
  Index:Integer;
begin
  Index:=IndexByClassName(ClassName);
  if Index>-1 then
    Result:=Items[Index]
  else
    Result:=nil;
end;

function TToolList.IndexByClassName(const ClassName: string): Integer;
var
  i:Integer;
begin
  Result:=-1;
  for i:=0 to FList.Count-1 do
    if CompareText(Items[i].ClassName,ClassName)=0 then
    begin
      Result:=i;
      Exit;
    end;
end;

procedure TToolList.SetCurrentTool(const ClassName: string);
var
  Index:Integer;
begin
  Index:=IndexByClassName(ClassName);
  if Index=-1 then
  begin
    ShowMessage('该工具不存在！');
    Exit;
  end;
  SetCurrentTool(Items[Index]);
end;

{ TMapField }

procedure TMapField.LoadFromStream(Stream: TStream);
begin
  FieldName:=ReadString(Stream);
  FieldType:=TMapFieldType(ReadInteger(Stream));
  Length:=ReadInteger(Stream);
  Prec:=ReadInteger(Stream);
  Scale:=ReadInteger(Stream);
end;

procedure TMapField.SaveToStream(Stream: TStream);
begin
  WriteString(Stream, FieldName);
  WriteInteger(Stream, Ord(FieldType));
  WriteInteger(Stream, Length);
  WriteInteger(Stream, Prec);
  WriteInteger(Stream, Scale);
end;

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

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

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

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

procedure TMapFieldList.Add(Value:TMapField);
begin
  FList.Add(Value);
end;

function TMapFieldList.Add:TMapField;
begin
  Result:=TMapField.Create;
  Add(Result);
end;

procedure TMapFieldList.Insert(const Index:Integer;Value:TMapField);
begin
  FList.Insert(Index,Value);
end;

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

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

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

function TMapFieldList.AddAndInit(const FieldName: string;
  const FieldType: TMapFieldType; const Length, Prec,
  Scale: Integer): TMapField;
begin
  Result:=Add;
  Result.FieldName:=FieldName;
  Result.FieldType:=FieldType;
  Result.Length:=Length;
  Result.Prec:=Prec;
  Result.Scale:=Scale;
end;

function TMapFieldList.InsertAndInit(const Index: Integer;
  const FieldName: string; const FieldType: TMapFieldType; const Length,
  Prec, Scale: Integer): TMapField;
begin
  Result:=Insert(Index);
  Result.FieldName:=FieldName;
  Result.FieldType:=FieldType;
  Result.Length:=Length;
  Result.Prec:=Prec;
  Result.Scale:=Scale;
end;

procedure TMapFieldList.LoadFromStream(Stream: TStream);
var
  i:Integer;
  myCount:Integer;
  AObj:TMapField;
begin
  Clear;
  myCount:=ReadInteger(Stream);
  for i:=0 to myCount-1 do
  begin
    AObj:=Add;
    AObj.LoadFromStream(Stream);
  end;
end;

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

procedure TToolList.SetCurrentTool(aToolObj: TBaseMapTool);
begin
  FCurrentToolObject:=aToolObj;
  with FCurrentToolObject, MapX do
  begin
    CurrentTool:=ToolId;
    MousePointer:=CursorType;
    if (CursorType=miCustomCursor)and(CursorIcon<>'') then
      MouseIcon:=WideString(CursorIcon);
  end;
  if Assigned(FAfterSetCurrentTool) then
    FAfterSetCurrentTool(Self, FCurrentToolObject);
end;

procedure TMapPointList.DoLoadFromStream(Sender: TObject; Stream: TStream);
var
  i:Integer;
  myCount:Integer;
  aItem:PMapPoint;
begin
  Clear;
  myCount:=ReadLongword(Stream);
  for i:=1 to myCount do
  begin
    aItem:=Add;
    aItem^.x:=ReadDouble(Stream);
    aItem^.y:=ReadDouble(Stream);
  end;
end;

procedure TMapPointList.DoSaveToStream(Sender: TObject; Stream: TStream);
var
  i:Integer;
  aItem:PMapPoint;
begin
  WriteLongword(Stream, ItemCount);
  for i:=0 to ItemCount-1 do
  begin
    aItem:=Items[i];
    WriteDouble(Stream, aItem^.x);
    WriteDouble(Stream, aItem^.y);
  end;
end;

function TMapFieldList.IndexOf(const AName: string): Integer;
var
  i:Integer;
begin
  Result:=-1;
  for i:=0 to FList.Count-1 do
    if AnsiCompareText(Items[i].FieldName, AName)=0 then
    begin
      Result:=i;
      Exit;
    end;
end;

constructor TMapRowValueList.Create;
begin
  inherited Create;
  FList:=TList.Create;
end;

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

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

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

procedure TMapRowValueList.Add(Value:TMapRowValue);
begin
 FList.Add(Value);
end;

function TMapRowValueList.Add:TMapRowValue;
begin
 Result:=TMapRowValue.Create;
 Add(Result);
end;

procedure TMapRowValueList.Insert(const Index:Integer;Value:TMapRowValue);
begin
  FList.Insert(Index,Value);
end;

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

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

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

procedure TMapRowValueList.LoadFromFile(const FileName:string);
var
  Stream:TMemoryStream;
begin
  Stream:=TMemoryStream.Create;
  try
    Stream.LoadFromFile(FileName);
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TMapRowValueList.SaveToFile(const FileName:string);
var
  Stream:TMemoryStream;
begin
  Stream:=TMemoryStream.Create;
  try
    SaveToStream(Stream);
    Stream.SaveToFile(FileName);
  finally
    Stream.Free;
  end;
end;

procedure TMapRowValueList.LoadFromStream(Stream:TStream);
var
  AObj:TMapRowValue;
begin
  Clear;
  Stream.Position:=0;
  while Stream.Position<Stream.Size do
  begin
    AObj:=Add;
    AObj.LoadFromStream(Stream);
  end;
end;

procedure TMapRowValueList.SaveToStream(Stream:TStream);
var
  i:Integer;
  AObj:TMapRowValue;
begin
  Stream.Size:=0;
  Stream.Position:=0;
  for i:=0 to FList.Count-1 do
  begin
    AObj:=Items[i];
    AObj.SaveToStream(Stream);
  end;
end;


{ TMapRowValue }

constructor TMapRowValue.Create;
begin
  inherited Create;
  FFieldInfo:=TMapField.Create;
end;

destructor TMapRowValue.Destroy;
begin
  FFieldInfo.Free;
  inherited;
end;

procedure TMapRowValue.LoadFromStream(Stream: TStream);
begin
  //请在此处写代码
end;

procedure TMapRowValue.SaveToStream(Stream: TStream);
begin
  //请在此处写代码
end;

procedure TMapPartList.DoLoadFromStream(Sender: TObject; Stream: TStream);
var
  i:Integer;
  myCount:Integer;
  aItem:TMapPointList;
begin
  Clear;
  myCount:=ReadLongword(Stream);
  for i:=1 to myCount do
  begin
    aItem:=Add;
    aItem.DoLoadFromStream(aItem, Stream);
  end;
end;

procedure TMapPartList.DoSaveToStream(Sender: TObject; Stream: TStream);
var
  i:Integer;
  aItem:TMapPointList;
begin
  WriteLongword(Stream, ItemCount);
  for i:=0 to ItemCount-1 do
  begin
    aItem:=Items[i];
    aItem.DoSaveToStream(aItem, Stream);
  end;
end;

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

procedure TMapPartList.ConfigParts(Prts:CMapXParts; bClear: Boolean);
var
  i:Integer;
  Pts:CMapXPoints;
begin
  if bClear then Prts.RemoveAll;
  for i:=0 to FList.Count-1 do
  begin
    Pts:=CoPoints.Create;
    Items[i].ConfigPoints(Pts, True);
    Prts.Add(Pts);
  end;
end;

function TMapPartList.CreatePartsInterfaceObject: CMapXParts;
var
  Prts:CMapXParts;
begin
  Prts:=CoParts.Create;
  ConfigParts(Prts, True);
  Result:=Prts;
end;

procedure TMapPartList.LoadFromParts(Prts:CMapXParts);
var
  i:Integer;
  aItem:TMapPointList;
begin
  Self.Clear;
  for i:=1 to Prts.Count do
  begin
    aItem:=Add;
    aItem.LoadFromPoints(Prts.Item[i]);
  end;
end;

function TMapFieldList.FieldByName(const AName: string): TMapField;
begin
  Result:=FindItem(AName);
  if Result = nil then
    raise Exception.CreateFmt(SFieldNotFound, [AName]);
end;

function TMapFieldList.FindItem(const AName: string): TMapField;
var
  Index:Integer;
begin
  Index:=IndexOf(AName);
  if Index<>-1 then
    Result:=FList.Items[Index]
  else
    Result:=nil;
end;

initialization
  if StyleClasses=nil then
    StyleClasses:=TList.Create;

finalization
  if StyleClasses<>nil then
  begin
    StyleClasses.Free;
    StyleClasses:=nil;
    DebugLog.Add('DB500TS-C', ['MapXBase: StyleClasses.Free']);
  end;

end.