mapxapis.pas

此代码是关于mapgis的在

    Result:=False
  else
    case Ft.type_ of
      miFeatureTypeRegion,
      miFeatureTypeLine:begin
        Result:=True;
      end;
      else begin
        Result:=False;
      end;
    end;
end;

function ShapeCanDeletePoint(Ft:Feature; PartIndex:Integer):Boolean;
begin
  if not Ft.Layer.Editable then
    Result:=False
  else
    case Ft.type_ of
      miFeatureTypeRegion:begin
        Result:=Ft.Parts.Item[PartIndex].Count>3;
      end;
      miFeatureTypeLine:begin
        Result:=Ft.Parts.Item[PartIndex].Count>2;
      end;
      else begin
        Result:=False;
      end;
    end;
end;

function ShapeCanEditPoint(Ft:Feature; PartIndex:Integer):Boolean;
begin
  Result:=Ft.Layer.Editable;
end;

function GetShapePoint(Ft:Feature; const PartIndex, PointIndex:Integer):Point;
begin
  case Ft.type_ of
    miFeatureTypeSymbol,
    miFeatureTypeText:begin
      Result:=Ft.Point;
    end;
    else begin
      Result:=Ft.Parts.Item[PartIndex].Item[PointIndex];
    end;
  end;
end;

function GetFirstShapeInSelction(ASelection:Selection; const ShapeType:Integer):Feature;
var
  i:Integer;
  ft:Feature;
begin
  Result:=nil;
  for i:=1 to ASelection.Count do
  begin
    ft:=ASelection.Item[i];
    if ft.type_=ShapeType then
    begin
      Result:=ft;
      Exit;
    end;
  end; 
end;

procedure AlignLeft(ASelection:Selection);
var
  i:Integer;
  v_x0, v_x:Double;
  ft:Feature;
begin
  if ASelection.Count>1 then
  begin
    v_x0:=ASelection.Item[1].Bounds.XMin;
    for i:=2 to ASelection.Count do
    begin
      ft:=ASelection.Item[i];
      v_x:=ft.Bounds.XMin;
      ft.Offset(v_x0-v_x, 0);
      ft.Update(EmptyParam, EmptyParam);
    end;
  end;
end;

procedure AlignRight(ASelection:Selection);
var
  i:Integer;
  v_x0, v_x:Double;
  ft:Feature;
begin
  if ASelection.Count>1 then
  begin
    v_x0:=ASelection.Item[1].Bounds.XMax;
    for i:=2 to ASelection.Count do
    begin
      ft:=ASelection.Item[i];
      v_x:=ft.Bounds.XMax;
      ft.Offset(v_x0-v_x, 0);
      ft.Update(EmptyParam, EmptyParam);
    end;
  end;
end;

procedure AlignTop(ASelection:Selection);
var
  i:Integer;
  v_y0, v_y:Double;
  ft:Feature;
begin
  if ASelection.Count>1 then
  begin
    v_y0:=ASelection.Item[1].Bounds.YMax;
    for i:=2 to ASelection.Count do
    begin
      ft:=ASelection.Item[i];
      v_y:=ft.Bounds.YMax;
      ft.Offset(0, v_y0-v_y);
      ft.Update(EmptyParam, EmptyParam);
    end;
  end;
end;

procedure AlignBottom(ASelection:Selection);
var
  i:Integer;
  v_y0, v_y:Double;
  ft:Feature;
begin
  if ASelection.Count>1 then
  begin
    v_y0:=ASelection.Item[1].Bounds.YMin;
    for i:=2 to ASelection.Count do
    begin
      ft:=ASelection.Item[i];
      v_y:=ft.Bounds.YMin;
      ft.Offset(0, v_y0-v_y);
      ft.Update(EmptyParam, EmptyParam);
    end;
  end;
end;

procedure AlignCenter_X(ASelection:Selection);
var
  i:Integer;
  v_x0, v_x:Double;
  ft:Feature;
begin
  if ASelection.Count>1 then
  begin
    v_x0:=ASelection.Item[1].CenterX;
    for i:=2 to ASelection.Count do
    begin
      ft:=ASelection.Item[i];
      v_x:=ft.CenterX;
      ft.Offset(v_x0-v_x, 0);
      ft.Update(EmptyParam, EmptyParam);
    end;
  end;
end;

procedure AlignCenter_Y(ASelection:Selection);
var
  i:Integer;
  v_y0, v_y:Double;
  ft:Feature;
begin
  if ASelection.Count>1 then
  begin
    v_y0:=ASelection.Item[1].CenterY;
    for i:=2 to ASelection.Count do
    begin
      ft:=ASelection.Item[i];
      v_y:=ft.CenterY;
      ft.Offset(0, v_y0-v_y);
      ft.Update(EmptyParam, EmptyParam);
    end;
  end;
end;

procedure OffestShapes(ASelection:Selection; const dx, dy:Double);
var
  i:Integer;
  ft:Feature;
begin
  for i:=1 to ASelection.Count do
  begin
    ft:=ASelection.Item[i];
    ft.Offset(dx, dy);
    ft.Update(EmptyParam, EmptyParam);
  end;
end;

function AddCopyFeature(ToLayer:Layer; Ft:Feature; ds:CMapXDataSet;
  const bAddData:Boolean):Feature;
var
  i:Integer;
  rvs:RowValues;
  newrvs:RowValues;
begin
  if ds<>nil then
    rvs:=ds.RowValues[ft]
  else
    rvs:=nil;
  if rvs=nil then
    Result:=ToLayer.AddFeature(ft, EmptyParam)
  else
  begin
    newrvs:=CreateRowValuesFromStruct(ds.Fields, ToLayer.DataSets.Item[1]);
    for i:=1 to ds.Fields.Count do
      newrvs.Item[i].Value:=rvs.Item[i].Value;
    Result:=ToLayer.AddFeature(ft, newrvs);
  end;
end;

function PickStyle(mstyle:OleVariant; const pm:TPickMethod):Boolean;
begin
  case pm of
    pmSymbol  : Result:=mstyle.PickSymbol;
    pmLine    : Result:=mstyle.PickLine;
    pmRegion  : Result:=mstyle.PickRegion;
    pmText    : Result:=mstyle.PickText;
    else        Result:=False;
  end;
end;

function EditMapStyle(MapX:TMapXObject; const pm:TPickMethod;
  const bEffectAllLayers, bEffectAllFeatures:Boolean):Boolean;
var
  i:Integer;
  Lyr:Layer;
  mstyle: OleVariant;
begin
  mstyle:=MapX.DefaultStyle.Clone;
  Result:=PickStyle(mstyle, pm);
  if bEffectAllLayers then
    for i:=1 to MapX.Layers.Count do
    begin
      Lyr:=MapX.Layers.Item[i];
      Lyr.Style:=Style(IDispatch(mstyle));
      Lyr.OverrideStyle:=bEffectAllFeatures;
    end;
end;

function EditLayerStyle(Lyr:Layer; const pm:TPickMethod;
  const bEffectAllFeatures:Boolean):Boolean;
var
  mstyle: OleVariant;
begin
  mstyle:=Lyr.Style.Clone;
  Result:=PickStyle(mstyle, pm);
  Lyr.Style:=Style(IDispatch(mstyle));
  Lyr.OverrideStyle:=bEffectAllFeatures;
end;

function GetFeaturePickMethod(ft:Feature):TPickMethod;
begin
  case ft.type_ of
    miFeatureTypeRegion     : Result:=pmRegion;
    miFeatureTypeLine       : Result:=pmLine;
    miFeatureTypeSymbol,
    miFeatureTypeMultipoint : Result:=pmSymbol;
    miFeatureTypeText       : Result:=pmText;
    else                      Result:=pmUnknown;
  end;
end;

function EditFeatureStyle(ft:Feature):Boolean;
var
  pm:TPickMethod;
  mstyle: OleVariant;
begin
  ft.Layer.OverrideStyle:=False;
  mstyle:=ft.Style.Clone;
  pm:=GetFeaturePickMethod(ft);
  Result:=PickStyle(mstyle, pm);
  if Result then
  begin
    ft.Style:=Style(IDispatch(mstyle));
    ft.Update(EmptyParam, EmptyParam);
  end;
end;

procedure LoadSymbolBitmap(const SourceFile, SymbolPath:string);
var
  DestFile:string;
begin
  DestFile:=GetFilePath_GradientLine(SymbolPath)+ExtractFileName(SourceFile);
  if FileExists(SourceFile) then CopyFile(PChar(SourceFile), PChar(DestFile), False);
end;

procedure LoadSymbolBitmaps(Files:TStrings; SymbolPath:string);
var
  i:Integer;
  SourceFile:string;
  DestFile:string;
begin
  if not DirectoryExists(SymbolPath) then
    raise Exception.Create('路径 '+SymbolPath+' 不存在！');
  for i:=0 to Files.Count-1 do
  begin
    SourceFile:=Files.Strings[i];
    DestFile:=GetFilePath_GradientLine(SymbolPath)+ExtractFileName(SourceFile);
    if FileExists(SourceFile) then CopyFile(PChar(SourceFile), PChar(DestFile), False);
  end;
end;

procedure LoadSymbolBitmaps(UserPath:string; const ForceCopy:Boolean);
var
  SymbolPath:string;
  hFindFile:Cardinal;
  sCurDir:String[255];
  FindData:TWin32FindData;
  ShortFileName:string;
  SourceFileName, DestFileName:string;
  ErrorDir: string;
begin
  UserPath:=CheckPath(UserPath);
  SymbolPath:=CheckPath(GetMapXBitmapPath);
  if (not DirectoryExists(UserPath)) or
     (not DirectoryExists(SymbolPath)) then Exit;
  {保存当前目录并设置目标路径为当前目录}
  sCurDir:=GetCurrentDir;
  ChDir(UserPath);
  try
    {查找目标路径下所有文件}
    hFindFile:=FindFirstFile('*.bmp',FindData);
    if hFindFile <> INVALID_HANDLE_VALUE then
    begin
      {分析该目录并完成删除多余文件或目录的任务}
      repeat
        {取得目标文件名}
        ShortFileName:=FindData.cFileName;
        {如果为上层路径，则Continue}
        if (ShortFileName='.') or (ShortFileName='..') then
          Continue;
        DestFileName:=SymbolPath+ShortFileName;
        if ForceCopy then
        begin
          SourceFileName:=UserPath+ShortFileName;
          CopyFile(PChar(SourceFileName), PChar(DestFileName), False);
        end
        else if not FileExists(DestFileName) then
        begin
          SourceFileName:=UserPath+ShortFileName;
          CopyFile(PChar(SourceFileName), PChar(DestFileName), True);
        end;
      until FindNextFile(hFindFile, FindData)=False;
      Windows.FindClose(hFindFile);
      {删除目标目录多余的文件}
    end;
  finally
    {回到原来的目录下}
    ChDir(sCurDir);
  end;
end;

function SymbolBitmapExists(SymbolPath, SymbolName:string):Boolean;
var
  DestFile:string;
begin
  DestFile:=GetFilePath_GradientLine(SymbolPath)+SymbolName;
  Result:=FileExists(DestFile);
end;

procedure ConfigLineStyleFromRegionStyle(ToStyle, FromStyle:Style);
begin
  ToStyle.LineColor:=FromStyle.RegionBorderColor;
  ToStyle.LineStyle:=FromStyle.RegionBorderStyle;
  ToStyle.LineWidth:=FromStyle.RegionBorderWidth;
  ToStyle.LineWidthUnit:=FromStyle.RegionBorderWidthUnit;
end;

procedure ConfigRegionStyleFromLineStyle(ToStyle, FromStyle:Style);
begin
  ToStyle.RegionBorderColor:=FromStyle.LineColor;
  ToStyle.RegionBorderStyle:=FromStyle.LineStyle;
  ToStyle.RegionBorderWidth:=FromStyle.LineWidth;
  ToStyle.RegionBorderWidthUnit:=FromStyle.LineWidthUnit;
end;

function GetMapXPath:string;
var
  Reg: TRegistry;
begin
  Reg:=Tregistry.Create;
  try
    Reg.RootKey :=HKEY_LOCAL_MACHINE;
    if Reg.OpenKey ('SOFTWARE\Mapinfo\MapX\5.0', False) then
      Result:=Reg.ReadString('ProgramDir')
    else
      Result:='';
    Reg.CloseKey;
  finally
    Reg.Destroy;
  end;
end;

function GetMapXBitmapPath:string;
begin
  Result:=GetMapXPath;
  if Result<>'' then
    Result:=CheckPath(Result)+'CUSTSYMB';
end;

function GetGeoDictionaryFile:string;
var
  Reg: TRegistry;
begin
  Reg:=Tregistry.Create;
  try
    Reg.RootKey :=HKEY_LOCAL_MACHINE;
    if Reg.OpenKey ('SOFTWARE\Mapinfo\MapX\5.0', False) then
      Result:=Reg.ReadString('GeoDictionary')
    else
      Result:='';
    Reg.CloseKey;
  finally
    Reg.Destroy;
  end;
end;

function SetGeoDictionaryFile(const FileName:string):Boolean;
var
  Reg: TRegistry;
begin
  Result:=False;
  Reg:=Tregistry.Create;
  try
    Reg.RootKey :=HKEY_LOCAL_MACHINE;
    if Reg.OpenKey ('SOFTWARE\Mapinfo\MapX\5.0', True) then
    begin
      Reg.WriteString('GeoDictionary', FileName);
      Result:=True;
    end;
    Reg.CloseKey;
  finally
    Reg.Destroy;
  end;
end;

function GetGeoDictionaryFileSearchPath(List:TStrings):Boolean;
var
  Reg:TRegistry;
  aStr:string;
begin
  Result:=False;
  Reg:=Tregistry.Create;
  try
    Reg.RootKey :=HKEY_LOCAL_MACHINE;
    if Reg.OpenKey ('SOFTWARE\Mapinfo\MapX\5.0', False) then
    begin
      aStr:=Reg.ReadString('SearchPaths');
      Result:=True;
    end;
    Reg.CloseKey;
  finally
    Reg.Destroy;
  end;
  if Result then
    Trans2(aStr, ';', List);
end;