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

📄 mapxstyles.pas

📁 此代码是关于mapgis的在
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit MapXStyles;

interface

uses
  SysUtils, Classes, Graphics, MapXLib_TLB, MapXBase, DB, Dialogs;

const
  STYLE_MAPDEFAULTSTYLE = -1;
  STYLE_LAYERSTYLE      = -2;
  STYLE_TRACKLINGLINE   = -3;
  STYLE_WHOLELINE       = -4;
  STYLE_USER            = 1001;
  
type
  TCustomStyleInfo=class(TBaseStyleInfo)
  private
    FSymbolBitmapSize: Integer;
    FLineStyleCount: Integer;
    FLineStyle: Integer;
    FRegionPattern: Integer;
    FTextFontRotation: Smallint;
    FSymbolCharacter: Smallint;
    FRegionBorderWidth: Smallint;
    FSymbolFontRotation: Smallint;
    FMinVectorSymbolCharacter: Smallint;
    FLineWidth: Smallint;
    FMaxVectorSymbolCharacter: Smallint;
    FSymbolVectorSize: Smallint;
    FRegionBorderColor: TColor;
    FSymbolBitmapColor: TColor;
    FSymbolVectorColor: TColor;
    FTextFontColor: TColor;
    FSymbolFontBackColor: TColor;
    FLineColor: TColor;
    FRegionColor: TColor;
    FRegionBackColor: TColor;
    FTextFontBackColor: TColor;
    FSymbolBitmapName: WideString;
    FRegionTransparent: WordBool;
    FLineSupportsInterleave: WordBool;
    FSymbolFontShadow: WordBool;
    FSupportsBitmapSymbols: WordBool;
    FTextFontHalo: WordBool;
    FTextFontShadow: WordBool;
    FTextFontAllCaps: WordBool;
    FSymbolFontOpaque: WordBool;
    FSymbolBitmapTransparent: WordBool;
    FLineInterleaved: WordBool;
    FTextFontDblSpace: WordBool;
    FSymbolFontHalo: WordBool;
    FSymbolBitmapOverrideColor: WordBool;
    FTextFontOpaque: WordBool;
    FSymbolFontColor: TColor;
    FRegionBorderWidthUnit: StyleUnitConstants;
  public
    constructor Create;override;
    function CreateStyleInterfaceObject:Style; override;
    procedure Assign(AStyle:Style); override;
    procedure ConfigToStyle(AStyle:Style); override;
    property RegionColor: TColor read FRegionColor write FRegionColor;
    property RegionPattern: Integer read FRegionPattern write FRegionPattern;
    property TextFontDblSpace: WordBool read FTextFontDblSpace write FTextFontDblSpace;
    property TextFontShadow: WordBool read FTextFontShadow write FTextFontShadow;
    property TextFontAllCaps: WordBool read FTextFontAllCaps write FTextFontAllCaps;
    property LineColor: TColor read FLineColor write FLineColor;
    property LineStyle: Integer read FLineStyle write FLineStyle;
    property SymbolCharacter: Smallint read FSymbolCharacter write FSymbolCharacter;
    property RegionBackColor: TColor read FRegionBackColor write FRegionBackColor;
    property LineWidth: Smallint read FLineWidth write FLineWidth;
    property SymbolBitmapTransparent: WordBool read FSymbolBitmapTransparent write FSymbolBitmapTransparent;
    property TextFontOpaque: WordBool read FTextFontOpaque write FTextFontOpaque;
    property SymbolFontColor: TColor read FSymbolFontColor write FSymbolFontColor;
    property TextFontHalo: WordBool read FTextFontHalo write FTextFontHalo;
    property SymbolFontHalo: WordBool read FSymbolFontHalo write FSymbolFontHalo;
    property SymbolFontShadow: WordBool read FSymbolFontShadow write FSymbolFontShadow;
    property SymbolBitmapColor: TColor read FSymbolBitmapColor write FSymbolBitmapColor;
    property SymbolBitmapName: WideString read FSymbolBitmapName write FSymbolBitmapName;
    property SymbolBitmapOverrideColor: WordBool read FSymbolBitmapOverrideColor write FSymbolBitmapOverrideColor;
    property SymbolFontBackColor: TColor read FSymbolFontBackColor write FSymbolFontBackColor;
    property SymbolFontOpaque: WordBool read FSymbolFontOpaque write FSymbolFontOpaque;
//    property SymbolFont: IFontDisp readonly dispid 12 read FSymbolFont write SetSymbolFont;
    property SupportsBitmapSymbols: WordBool read FSupportsBitmapSymbols write FSupportsBitmapSymbols;
    property SymbolBitmapSize: Integer read FSymbolBitmapSize write FSymbolBitmapSize;
//    property LineWidthUnit: StyleUnitConstants dispid 45;
    property MinVectorSymbolCharacter: Smallint read FMinVectorSymbolCharacter write FMinVectorSymbolCharacter;
    property SymbolVectorSize: Smallint read FSymbolVectorSize write FSymbolVectorSize;
    property RegionTransparent: WordBool read FRegionTransparent write FRegionTransparent;
    property LineStyleCount: Integer read FLineStyleCount write FLineStyleCount;
    property LineInterleaved: WordBool read FLineInterleaved write FLineInterleaved;
//    property SymbolType: SymbolTypeConstants dispid 37;
    property SymbolFontRotation: Smallint read FSymbolFontRotation write FSymbolFontRotation;
    property MaxVectorSymbolCharacter: Smallint read FMaxVectorSymbolCharacter write FMaxVectorSymbolCharacter;
//    property RegionBorderStyle: PenStyleConstants dispid 8;
    property RegionBorderColor: TColor read FRegionBorderColor write FRegionBorderColor;
//    property TextFont: IFontDisp readonly dispid 11;
    property TextFontColor: TColor read FTextFontColor write FTextFontColor;
    property TextFontBackColor: TColor read FTextFontBackColor write FTextFontBackColor;
    property RegionBorderWidthUnit: StyleUnitConstants read FRegionBorderWidthUnit write FRegionBorderWidthUnit;
    property SymbolVectorColor: TColor read FSymbolVectorColor write FSymbolVectorColor;
    property LineSupportsInterleave: WordBool read FLineSupportsInterleave write FLineSupportsInterleave;
    property RegionBorderWidth: Smallint read FRegionBorderWidth write FRegionBorderWidth;
    property TextFontRotation: Smallint read FTextFontRotation write FTextFontRotation;   
  end;
  
  TSymbolVectorSytleInfo=class(TBaseStyleInfo)
  private
    FSize: Integer;
    FColor: TColor;
    FSymbolCharacter:Smallint;
    FFontName: string;
  public
    constructor Create;override;
    function CreateStyleInterfaceObject:Style; override;
    procedure LoadFromStream(Stream:TStream); override;
    procedure SaveToStream(Stream:TStream); override;
    procedure Assign(AStyle:Style); override;
    procedure ConfigToStyle(AStyle:Style); override;
    property FontName:string read FFontName write FFontName;
    property SymbolCharacter:Smallint read FSymbolCharacter write FSymbolCharacter;
    property Size:Integer read FSize write FSize;
    property Color:TColor read FColor write FColor;
  end;

  TFontBackgroundStyle=(fbgNone, fbgHalo, fbgBox);
  
  TFontStyleInfo=class(TBaseStyleInfo)
  private
    FSize: Integer;
    FRotation: Smallint;
    FColor: TColor;
    FBackColor: TColor;
    FName: string;
    FBgStyle: TFontBackgroundStyle;
  public
    constructor Create;override;
    function CreateStyleInterfaceObject:Style; override;
    procedure Assign(AStyle:Style); override;
    procedure AssignFromFont(AFont:TFont);
    procedure ConfigToStyle(AStyle:Style); override;
    procedure ConfigToFont(AFont:TFont);
    procedure LoadFromStream(Stream:TStream); override;
    procedure SaveToStream(Stream:TStream); override;
    property Name:string read FName write FName;
    property Size:Integer read FSize write FSize;
    property Color:TColor read FColor write FColor;
    property BgStyle:TFontBackgroundStyle read FBgStyle write FBgStyle; 
    property BackColor:TColor read FBackColor write FBackColor;
    property Rotation:Smallint read FRotation write FRotation;
  end;

  TSymbolBitmapStyleInfo=class(TBaseStyleInfo)
  private
    FBitmapTransparent: Boolean;
    FBitmapSize: Integer;
    FBitmapName: string;
    FBitmapColor: TColor;
    FBitmapOverrideColor: Boolean;
  public
    constructor Create;override;
    function CreateStyleInterfaceObject:Style; override;
    procedure Assign(AStyle:Style); override;
    procedure ConfigToStyle(AStyle:Style); override;
    procedure LoadFromStream(Stream:TStream); override;
    procedure SaveToStream(Stream:TStream); override;
    property BitmapName:string read FBitmapName write FBitmapName;
    property BitmapSize:Integer read FBitmapSize write FBitmapSize;
    property BitmapTransparent:Boolean read FBitmapTransparent write FBitmapTransparent;
    property BitmapColor:TColor read FBitmapColor write FBitmapColor;
    property BitmapOverrideColor:Boolean read FBitmapOverrideColor write FBitmapOverrideColor;
  end;

  TSymbolFontStyleInfo=class(TFontStyleInfo)
  private
    FSymbolCharacter: Smallint;
  public
    constructor Create;override;
    function CreateStyleInterfaceObject:Style; override;
    procedure Assign(AStyle:Style); override;
    procedure ConfigToStyle(AStyle:Style); override;
    procedure LoadFromStream(Stream:TStream); override;
    procedure SaveToStream(Stream:TStream); override;
    property SymbolCharacter:Smallint read FSymbolCharacter write FSymbolCharacter;
  end;

  TLineStyleInfo=class(TBaseStyleInfo)
  private
    FLineColor: TColor;
    FLineWidth: Integer;
    FLineStyle: Integer;
    FLineWidthUnit: Integer;
    FLineInterleaved: Boolean;
  public
    constructor Create;override;
    function CreateStyleInterfaceObject:Style; override;
    procedure Assign(AStyle:Style); override;
    procedure ConfigToStyle(AStyle:Style); override;
    procedure LoadFromStream(Stream:TStream); override;
    procedure SaveToStream(Stream:TStream); override;
    property LineColor:TColor read FLineColor write FLineColor;
    property LineStyle:Integer read FLineStyle write FLineStyle;
    property LineWidth:Integer read FLineWidth write FLineWidth;
    property LineWidthUnit:Integer read FLineWidthUnit write FLineWidthUnit;
    property LineInterleaved:Boolean read FLineInterleaved write FLineInterleaved;
  end;

  TRegionStyleInfo=class(TBaseStyleInfo)
  private
    FRegionTransparent: Boolean;
    FRegionBorderWidthUnit: LongWord;
    FRegionPattern: LongWord;
    FRegionBorderStyle: LongWord;
    FRegionBorderWidth: Smallint;
    FRegionColor: TColor;
    FRegionBackColor: TColor;
    FRegionBorderColor: TColor;
  public
    constructor Create;override;
    function CreateStyleInterfaceObject:Style; override;
    procedure Assign(AStyle:Style); override;
    procedure ConfigToStyle(AStyle:Style); override;
    procedure LoadFromStream(Stream:TStream); override;
    procedure SaveToStream(Stream:TStream); override;
    property RegionColor:TColor read FRegionColor write FRegionColor;
    property RegionPattern:LongWord read FRegionPattern write FRegionPattern;
    property RegionBackColor:TColor read FRegionBackColor write FRegionBackColor;
    property RegionTransparent:Boolean read FRegionTransparent write FRegionTransparent;
    property RegionBorderStyle:LongWord read FRegionBorderStyle write FRegionBorderStyle;
    property RegionBorderColor:TColor read FRegionBorderColor write FRegionBorderColor;
    property RegionBorderWidthUnit:LongWord read FRegionBorderWidthUnit write FRegionBorderWidthUnit;
    property RegionBorderWidth:Smallint read FRegionBorderWidth write FRegionBorderWidth; 
  end;
  
procedure RegisterSystemStyles(AStyleList:TStyleInfoList);

implementation

uses
  StreamIOAPIs, OleCtrls;

procedure RegisterSystemStyles(AStyleList:TStyleInfoList);
var
  AStyle:TLineStyleInfo;
begin
  AStyle:=TLineStyleInfo.Create;
  with AStyle do
  begin
    UserId:=STYLE_TRACKLINGLINE;
    LineColor:=clRed;
  end;
  AStyleList.Add(AStyle);

  AStyle:=TLineStyleInfo.Create;
  with AStyle do
  begin
    UserId:=STYLE_WHOLELINE;
    LineColor:=clGreen;
  end;

  AStyleList.Add(AStyle);
end;

{ TCustomStyleInfo }

procedure TCustomStyleInfo.Assign(AStyle: Style);
begin
  inherited;

end;

procedure TCustomStyleInfo.ConfigToStyle(AStyle: Style);
begin
  inherited;

end;

constructor TCustomStyleInfo.Create;
var
  mstyle:Style;
begin
  inherited;
  mstyle:=CoStyle.Create;
  Assign(mstyle);
  mstyle:=nil;
end;

function TCustomStyleInfo.CreateStyleInterfaceObject: Style;
begin
  Result:=inherited CreateStyleInterfaceObject;
  ConfigToStyle(Result);
end;

{ TSymbolVectorSytleInfo }

procedure TSymbolVectorSytleInfo.Assign(AStyle: Style);
var
  OleFont: Variant;
begin
  inherited;
  OleFont:= AStyle.SymbolFont;
  FFontName := OleFont.Name;
  FSymbolCharacter:=AStyle.SymbolCharacter;
  FSize:=OleFont.Size;
  FColor:=AStyle.SymbolVectorColor;
end;

procedure TSymbolVectorSytleInfo.ConfigToStyle(AStyle: Style);
var
  OleFont: Variant;
begin
  inherited;
  AStyle.SymbolType := miSymbolTypeVector;
  OleFont:= AStyle.SymbolFont;
  OleFont.Name:=FFontName;
  AStyle.SymbolCharacter:=FSymbolCharacter;
  OleFont.Size:=FSize;
  AStyle.SymbolVectorColor:=FColor;
end;

constructor TSymbolVectorSytleInfo.Create;
begin
  inherited Create;
  FSize:=20;
  FColor:=clRed;
end;

function TSymbolVectorSytleInfo.CreateStyleInterfaceObject: Style;
begin
  Result:=inherited CreateStyleInterfaceObject;
  ConfigToStyle(Result);
end;

procedure TSymbolVectorSytleInfo.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  FontName:=ReadString(Stream);
  SymbolCharacter:=ReadSmallint(Stream);
  Size:=ReadInteger(Stream);
  Color:=ReadInteger(Stream);
end;

procedure TSymbolVectorSytleInfo.SaveToStream(Stream: TStream);
begin
  inherited SaveToStream(Stream);
  WriteString(Stream, FontName);
  WriteSmallint(Stream, SymbolCharacter);
  WriteInteger(Stream, Size);
  WriteInteger(Stream, Color);
end;

{ TFontStyleInfo }

procedure TFontStyleInfo.Assign(AStyle: Style);
var
  OleFont: Variant;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -