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

📄 unitdrawstylemodify.pas

📁 在delphi下基于MapX5.0的GIS程序
💻 PAS
字号:
unit UnitDrawStyleModify;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, ComCtrls, ImgList, MapXLib_TLB, DB,
  Grids, DBGrids;

type
  TFrmDrawStyleModify = class(TForm)
    PanelEditLayerName: TPanel;
    CBoxEditLayerName: TComboBox;
    PanelFeatureType: TPanel;
    CBoxFeatureType: TComboBox;
    PanelDrawType: TPanel;
    ImageList1: TImageList;
    PanelDraw: TPanel;
    PControlDrawModify: TPageControl;
    TabSheet1: TTabSheet;
    GBoxSymbol: TGroupBox;
    LEditSymbolSizes: TLabeledEdit;
    LEditSymbolName: TLabeledEdit;
    LEditSymbolCharacters: TLabeledEdit;
    LEditSymbolColor: TLabeledEdit;
    TabSheet2: TTabSheet;
    GBoxLine: TGroupBox;
    LEditLineColor: TLabeledEdit;
    LEditLineStyle: TLabeledEdit;
    LEditLineWidth: TLabeledEdit;
    LEditLineWidthUnit: TLabeledEdit;
    TabSheet3: TTabSheet;
    GBoxRegion: TGroupBox;
    LEditRegionColor: TLabeledEdit;
    LEditRegionPattern: TLabeledEdit;
    LEditRegionBackColor: TLabeledEdit;
    LEditRegionTransparent: TLabeledEdit;
    LEditRegionBorderStyle: TLabeledEdit;
    LEditRegionBorderColor: TLabeledEdit;
    LEditRegionBorderWidthUnit: TLabeledEdit;
    LEditRegionBorderWidth: TLabeledEdit;
    TabSheet4: TTabSheet;
    GBoxSymbolBackground: TGroupBox;
    RBtnSymbolFontNone: TRadioButton;
    RBtnSymbolFontHalo: TRadioButton;
    RBtnSymbolFontBox: TRadioButton;
    LEditSymbolBackcolor: TLabeledEdit;
    GroupBox1: TGroupBox;
    LEditTextSizes: TLabeledEdit;
    LEditTextName: TLabeledEdit;
    LEditTextColor: TLabeledEdit;
    GBoxTextBackground: TGroupBox;
    RBtnTextFontNone: TRadioButton;
    RBtnTextFontHalo: TRadioButton;
    RBtnTextFontBox: TRadioButton;
    LEditTextBackcolor: TLabeledEdit;
    CBoxLineInterleaved: TCheckBox;
    PanelDrawTypeValue: TPanel;
    BtnModifySymbol: TBitBtn;
    BtnSymbolStyleAdd: TBitBtn;
    LEditTextRotation: TLabeledEdit;
    BitBtn1: TBitBtn;
    TimerInfo: TTimer;
    procedure DrawToolStyleView();
    procedure CBoxEditLayerNameChange(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CBoxFeatureTypeChange(Sender: TObject);
    procedure TabSheet1Show(Sender: TObject);
    procedure TabSheet2Show(Sender: TObject);
    procedure TabSheet3Show(Sender: TObject);
    procedure TabSheet4Show(Sender: TObject);
    procedure BtnSymbolStyleAddClick(Sender: TObject);
    procedure BtnModifySymbolClick(Sender: TObject);
    procedure TimerInfoTimer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmDrawStyleModify: TFrmDrawStyleModify;
  OnShowing: Boolean;

implementation

uses UnitDataModule, UnitMain, UnitModify, UnitCommonModule;

{$R *.dfm}

// 画窗体边框
procedure TFrmDrawStyleModify.WMNCPaint(var Msg: TWMNCPaint);
var
  dc : hDc;
  Pen : hPen;
  OldPen : hPen;
  OldBrush : hBrush;
begin
  inherited;
  dc := GetWindowDC(Handle);
  msg.Result := 1;
  Pen := CreatePen(PS_SOLID, 2, RGB(255, 0, 0));
  OldPen := SelectObject(dc, Pen);
  OldBrush := SelectObject(dc, GetStockObject(NULL_BRUSH));
  if OnShowing and TimerInfo.Enabled then Windows.Rectangle(dc, 0, 0, Width, Height+5);
  if Not TimerInfo.Enabled then Windows.Rectangle(dc, 0, 0, Width, Height);
  if Not OnShowing and TimerInfo.Enabled then Windows.Rectangle(dc, 0, 0, Width, Height-5);
  SelectObject(dc, OldBrush);
  SelectObject(dc, OldPen);
  DeleteObject(Pen);
  ReleaseDC(Handle, Canvas.Handle);
end;

procedure TFrmDrawStyleModify.DrawToolStyleView();
var
  i, j: Integer;
begin
//  绘制工具显示
  j := CBoxEditLayerName.ItemIndex;
  i := CBoxFeatureType.ItemIndex;
  PanelDrawTypeValue.Caption := LayerToFtTypeArr[j+1].FeatureToolArr[i+1];
  if CBoxEditLayerName.Text = '标记' then PanelDrawTypeValue.Caption := '文字';
  if PanelDrawTypeValue.Caption = '符号' then
  begin
//  设置符号的属性
    SetSymbolStyle(CBoxFeatureType.Text);
    PControlDrawModify.Pages[0].Show;
    TabSheet1Show(Self);
  end else
  if PanelDrawTypeValue.Caption = '线' then
  begin
//  设置线的属性
    SetLineStyle(CBoxFeatureType.Text);
    PControlDrawModify.Pages[1].Show;
    TabSheet2Show(Self);
  end else
  if PanelDrawTypeValue.Caption = '区域' then
  begin
//  设置区域的属性
    SetRegionStyle(CBoxFeatureType.Text);
    PControlDrawModify.Pages[2].Show;
    TabSheet3Show(Self);
  end else
  begin
//  设置标注文字的属性
    SetLabelStyle(CBoxFeatureType.Text);
    PControlDrawModify.Pages[3].Show;
    TabSheet4Show(Self);
  end;
  BtnSymbolStyleAdd.Enabled := False;
end;

procedure TFrmDrawStyleModify.CBoxEditLayerNameChange(Sender: TObject);
var
  i, j: Integer;
begin
// 添加类型刷新
  CBoxFeatureType.Items.Clear;
  for i := 1 to LayerToFtTypeArr[CBoxEditLayerName.ItemIndex+1].TypeNum do
    CBoxFeatureType.Items.Add(LayerToFtTypeArr[CBoxEditLayerName.ItemIndex+1].FeatureTypeArr[i]);
  if CBoxEditLayerName.Text = '标记' then
    for j := 1 to CBoxEditLayerName.Items.Count do
    for i := 1 to LayerToFtTypeArr[j].TypeNum do
      CBoxFeatureType.Items.Add(LayerToFtTypeArr[j].FeatureTypeArr[i]);
  CBoxFeatureType.ItemIndex := 0;
  DrawToolStyleView();
end;

procedure TFrmDrawStyleModify.FormShow(Sender: TObject);
var
  i, j: Integer;
begin
  TimerInfo.Enabled := True;
  OnShowing := True;

  CBoxEditLayerName.Clear;
  CBoxFeatureType.Clear;
  for i := 1 to FrmMain.Map1.Layers.Count do
    CBoxEditLayerName.Items.Add(FrmMain.Map1.Layers[i].Name);
  CBoxEditLayerName.ItemIndex := 0;
  for j := 1 to CBoxEditLayerName.Items.Count do
  for i := 1 to LayerToFtTypeArr[j].TypeNum do
    CBoxFeatureType.Items.Add(LayerToFtTypeArr[j].FeatureTypeArr[i]);
  CBoxFeatureType.ItemIndex := 0;
  CBoxEditLayerNameChange(Sender);
  CBoxFeatureTypeChange(Sender);
end;

procedure TFrmDrawStyleModify.CBoxFeatureTypeChange(Sender: TObject);
begin
  DrawToolStyleView();
end;

procedure TFrmDrawStyleModify.TabSheet1Show(Sender: TObject);
var
   SetStyle: Variant;
begin
// 显示字符属性的设置
  With FrmMain do
  begin
    SetStyle:= Map1.Defaultstyle;
    SetStyle.SymbolType:= miSymbolTypeTrueTypeFont;
    LEditSymbolName.Text := SetStyle.SymbolFont.Name;
    LEditSymbolSizes.Text := IntToStr(SetStyle.SymbolFont.Size);
    LEditSymbolCharacters.Text := IntToStr(Map1.DefaultStyle.SymbolCharacter);
    LEditSymbolColor.Text := ColorToString(Map1.DefaultStyle.SymbolFontColor);
    RBtnSymbolFontNone.Checked := True;
    RBtnSymbolFontHalo.Checked := Map1.DefaultStyle.SymbolFontHalo;
    RBtnSymbolFontBox.Checked := Map1.DefaultStyle.SymbolFontOpaque;
    if RBtnSymbolFontNone.Checked then LEditSymbolBackcolor.Enabled := False
      else LEditSymbolBackcolor.Enabled := True;
    LEditSymbolBackcolor.Text := ColorToString(Map1.DefaultStyle.SymbolFontBackColor);
  end;
end;

procedure TFrmDrawStyleModify.TabSheet2Show(Sender: TObject);
begin
// 显示线属性的设置
  With FrmMain do
  begin
    LEditLineStyle.Text := IntToStr(Map1.DefaultStyle.LineStyle);
    LEditLineColor.Text := ColorToString(Map1.DefaultStyle.LineColor);
    LEditLineWidthUnit.Text := IntToStr(Map1.DefaultStyle.LineWidthUnit);
    LEditLineWidth.Text := IntToStr(Map1.DefaultStyle.LineWidth);
    CBoxLineInterleaved.Checked := Map1.DefaultStyle.LineInterleaved;
  end;
end;

procedure TFrmDrawStyleModify.TabSheet3Show(Sender: TObject);
begin
// 显示区域属性的设置
  With FrmMain do
  begin
    LEditRegionPattern.Text := IntToStr(Map1.DefaultStyle.RegionPattern);
    LEditRegionColor.Text := ColorToString(Map1.DefaultStyle.RegionColor);
    LEditRegionBackColor.Text := ColorToString(Map1.DefaultStyle.RegionBackColor);
    if Map1.DefaultStyle.RegionTransparent
      then LEditRegionTransparent.Text := '1'
      else LEditRegionTransparent.Text := '0';
    LEditRegionBorderStyle.Text := IntToStr(Map1.DefaultStyle.RegionBorderStyle);
    LEditRegionBorderColor.Text := ColorToString(Map1.DefaultStyle.RegionBorderColor);
    LEditRegionBorderWidthUnit.Text := IntToStr(Map1.DefaultStyle.RegionBorderWidthUnit);
    LEditRegionBorderWidth.Text := IntToStr(Map1.DefaultStyle.RegionBorderWidth);
  end;
end;

procedure TFrmDrawStyleModify.TabSheet4Show(Sender: TObject);
var
   SetStyle: Variant;
begin
// 显示文字属性的设置
  With FrmMain do
  begin
    SetStyle:= Map1.Defaultstyle.TextFont;
    LEditTextName.Text := SetStyle.Name;
    LEditTextSizes.Text := IntToStr(SetStyle.Size);
    LEditTextColor.Text := ColorToString(Map1.DefaultStyle.TextFontColor);
    LEditTextRotation.Text := IntToStr(Map1.DefaultStyle.TextFontRotation);
    RBtnTextFontNone.Checked := True;
    RBtnTextFontHalo.Checked := Map1.DefaultStyle.TextFontHalo;
    RBtnTextFontBox.Checked := Map1.DefaultStyle.TextFontOpaque;
    if RBtnTextFontNone.Checked then LEditTextBackcolor.Enabled := False
      else LEditTextBackcolor.Enabled := True;
    LEditTextBackcolor.Text := ColorToString(Map1.DefaultStyle.TextFontBackColor);
  end;
end;

procedure TFrmDrawStyleModify.BtnSymbolStyleAddClick(Sender: TObject);
begin
  case PControlDrawModify.ActivePageIndex of
    0: begin
      // 向符号表中添加记录
        if Not DM.ADOQuerySymbolStyle.Active then DM.ADOQuerySymbolStyle.Open;
        if DM.ADOQuerySymbolStyle.Locate('Type', CBoxFeatureType.Text, [loCaseInsensitive])
          then DM.ADOQuerySymbolStyle.Edit
          else DM.ADOQuerySymbolStyle.Append;
        DM.ADOQuerySymbolStyleID.Value := PYConvert(CBoxFeatureType.Text);
        DM.ADOQuerySymbolStyleType.Value := CBoxFeatureType.Text;
        DM.ADOQuerySymbolStyleName.Value  := LEditSymbolName.Text;
        DM.ADOQuerySymbolStyleSizes.Value := StrToInt(LEditSymbolSizes.Text);
        DM.ADOQuerySymbolStyleCharacters.Value := StrToInt(LEditSymbolCharacters.Text);
        DM.ADOQuerySymbolStyleColor.Value := LEditSymbolColor.Text;
        DM.ADOQuerySymbolStyleHalo.Value := RBtnSymbolFontHalo.Checked;
        DM.ADOQuerySymbolStyleBox.Value := RBtnSymbolFontBox.Checked;
        DM.ADOQuerySymbolStyleBackColor.Value := LEditSymbolBackcolor.Text;
        DM.ADOQuerySymbolStyle.Post;
       end;
    1: begin
      // 向线表中添加记录
        if Not DM.ADOQueryLineStyle.Active then DM.ADOQueryLineStyle.Open;
        if DM.ADOQueryLineStyle.Locate('Type', CBoxFeatureType.Text, [loCaseInsensitive])
          then begin DM.ADOQueryLineStyle.Edit; showmessage('') end
          else DM.ADOQueryLineStyle.Append;
        DM.ADOQueryLineStyleID.Value := PYConvert(CBoxFeatureType.Text);
        DM.ADOQueryLineStyleType.Value := CBoxFeatureType.Text;
        DM.ADOQueryLineStyleStyle.Value := StrToInt(LEditLineStyle.Text);
        DM.ADOQueryLineStyleColor.Value := LEditLineColor.Text;
        DM.ADOQueryLineStyleLineWidthUnit.Value := StrToInt(LEditLineWidthUnit.Text);
        DM.ADOQueryLineStyleWidth.Value := StrToInt(LEditLineWidth.Text);
        DM.ADOQueryLineStyleInterleaved.Value := CBoxLineInterleaved.Checked;
        DM.ADOQueryLineStyle.Post;
       end;
    2: begin
      // 向区域表中添加记录
        if Not DM.ADOQueryRegionStyle.Active then DM.ADOQueryRegionStyle.Open;
        if DM.ADOQueryRegionStyle.Locate('Type', CBoxFeatureType.Text, [loCaseInsensitive])
          then begin DM.ADOQueryRegionStyle.Edit; showmessage('') end
          else DM.ADOQueryRegionStyle.Append;
        DM.ADOQueryRegionStyle.Append;
        DM.ADOQueryRegionStyleID.Value := PYConvert(CBoxFeatureType.Text);
        DM.ADOQueryRegionStyleType.Value := CBoxFeatureType.Text;
        DM.ADOQueryRegionStylePattern.Value := StrToInt(LEditRegionPattern.Text);
        DM.ADOQueryRegionStyleColor.Value := LEditRegionColor.Text;
        DM.ADOQueryRegionStyleBackColor.Value := LEditRegionBackColor.Text;
        DM.ADOQueryRegionStyleTransparent.Value := StrToBool(LEditRegionTransparent.Text);
        DM.ADOQueryRegionStyleBorderStyle.Value := StrToInt(LEditRegionBorderStyle.Text);
        DM.ADOQueryRegionStyleBorderColor.Value := LEditRegionBorderColor.Text;
        DM.ADOQueryRegionStyleBorderWidthUnit.Value := StrToInt(LEditRegionBorderWidthUnit.Text);
        DM.ADOQueryRegionStyleBorderWidth.Value := StrToInt(LEditRegionBorderWidth.Text);
        DM.ADOQueryRegionStyle.Post;
       end;
    3: begin
      // 向文字表中添加记录 
        if Not DM.ADOQueryTextStyle.Active then DM.ADOQueryTextStyle.Open;
        if DM.ADOQueryTextStyle.Locate('Type', CBoxFeatureType.Text, [loCaseInsensitive])
          then DM.ADOQueryTextStyle.Edit
          else DM.ADOQueryTextStyle.Append;
        DM.ADOQueryTextStyleID.Value := PYConvert(CBoxFeatureType.Text);
        DM.ADOQueryTextStyleType.Value := CBoxFeatureType.Text;
        DM.ADOQueryTextStyleName.Value  := LEditTextName.Text;
        DM.ADOQueryTextStyleSizes.Value := StrToInt(LEditTextSizes.Text);
        DM.ADOQueryTextStyleColor.Value := LEditTextColor.Text;
        DM.ADOQueryTextStyleRotation.Value := StrToInt(LEditTextRotation.Text);
        DM.ADOQueryTextStyleHalo.Value := RBtnTextFontHalo.Checked;
        DM.ADOQueryTextStyleBox.Value := RBtnTextFontBox.Checked;
        DM.ADOQueryTextStyleBackColor.Value := LEditTextBackcolor.Text;
        DM.ADOQueryTextStyle.Post;
       end;
  end;
  Application.MessageBox('修改成功!', '提示', 0);
  BtnSymbolStyleAdd.Enabled := False;
end;

procedure TFrmDrawStyleModify.BtnModifySymbolClick(Sender: TObject);
begin
  case PControlDrawModify.ActivePageIndex of
    0: begin
         FrmMain.Map1.DefaultStyle.PickSymbol;
         TabSheet1Show(Self);
       end;
    1: begin
         FrmMain.Map1.DefaultStyle.PickLine;
         TabSheet2Show(Self);
       end;
    2: begin
         FrmMain.Map1.DefaultStyle.PickRegion;
         TabSheet3Show(Self);
       end;
    3: begin
         FrmMain.Map1.DefaultStyle.PickText;
         TabSheet4Show(Self);
       end;
  end;
  BtnSymbolStyleAdd.Enabled := True;
end;

procedure TFrmDrawStyleModify.TimerInfoTimer(Sender: TObject);
begin
  if OnShowing then
  begin
    Height := Height + 5;
    if Height > 385 then TimerInfo.Enabled := False;
  end
  else
  begin
    Height := Height - 5;
    if Height < 30 then
    begin
      TimerInfo.Enabled := False;
      Close;
    end;
  end;   
end;

procedure TFrmDrawStyleModify.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  if Height > 30 then
  begin
    CanClose := False;
    OnShowing := False;
    TimerInfo.Enabled := True;
  end;
end;

end.

⌨️ 快捷键说明

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