analysefrm.~pas

Delphi + MapX程序框架(地图)源码程序

unit AnalyseFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, CheckLst, ExtCtrls, ComCtrls, MapX, MapXLib_TLB;

type
  TfrmAnalyse = class(TForm)
    Panel1: TPanel;
    GroupBox1: TGroupBox;
    CheckListBox1: TCheckListBox;
    Label2: TLabel;
    Edit1: TEdit;
    Label3: TLabel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    Splitter4: TSplitter;
    StatusBar1: TStatusBar;
    PageControl1: TPageControl;
    procedure FormShow(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);
    procedure PageControl1Change(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
  private
    { Private declarations }
    FMapX: TMapX;
    FAnalyseType: TAnalyseType;
    FSourceFs: CMapXFeatures;

    FColumnToSort :Integer;
    FStatusDrawRect: TRect;
    FProgressBar: TProgressBar;

    FNewSheet: TTabSheet;
    FNewListView: TListView;

    FSourceF: CMapXFeature;

    procedure CreateNew(Value: string);
    procedure SetAnalyseType(const Value: TAnalyseType);

    procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn);
    procedure ListView1Compare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);

    procedure CreateProgressBar(MinValue,MaxValue: Integer);
    procedure BeginAnalyse;
    procedure FillData(Fs: CMapXFeatures; Lyr: string; ListView1: TListView);
  public
    { Public declarations }
    procedure SetBuddyMap(AMapX: TMapX);
    property AnalyseType: TAnalyseType read FAnalyseType write SetAnalyseType;
    property SourceFs: CMapXFeatures read  FSourceFs write  FSourceFs;
  end;

implementation

{$R *.dfm}

procedure TfrmAnalyse.FormShow(Sender: TObject);
var
  List: TStringList;
begin
  CreateNew('新建');
  if Assigned(FMapX)then
  begin
    List:= TStringList.Create;
    FMapX.Get_VisibleLayers(List);
    CheckListBox1.Items.Assign(List);
    List.Free;
  end;
end;

procedure TfrmAnalyse.CreateNew(Value: string);
begin
  FNewSheet:= TTabSheet.Create(Self);
  FNewSheet.PageControl:= PageControl1;
  FNewSheet.Caption:= Value;
  FNewListView:= TListView.Create(FNewSheet);
  FNewListView.Parent:= FNewSheet;
  FNewListView.Align:= alClient;
  FNewListView.ViewStyle:= vsReport;
  FNewListView.GridLines:= True;
  FNewListView.OnColumnClick:= ListView1ColumnClick;
  FNewListView.OnCompare:= ListView1Compare;
  FNewListView.RowSelect:= True;
end;

procedure TfrmAnalyse.SetAnalyseType(const Value: TAnalyseType);
begin
  FAnalyseType := Value;
  Edit1.Enabled:= (FAnalyseType = atAlongLine) or (FAnalyseType = atAroundPoint);
  CheckListBox1.Enabled:= (FAnalyseType <> atSelected);
  if Edit1.Enabled then
  begin
    Edit1.Text:= '1.0';
    Edit1.Color:= clWindow;
  end
  else
  begin
    Edit1.Text:= '';
    Edit1.Color:= clBtnFace;
  end;
  case Value of
    atSelected   : Caption:= Caption+' (选择结果查看)';
    atAlongLine  : Caption:= Caption+' (线周边分析)';
    atInRegion   : Caption:= Caption+' (区域内分析)';
    atAroundPoint: Caption:= Caption+' (点周围分析)';
  end;
end;

procedure TfrmAnalyse.ListView1ColumnClick(Sender: TObject;
  Column: TListColumn);
begin
  FColumnToSort := Column.Index;
  (Sender as TCustomListView).AlphaSort;
end;

procedure TfrmAnalyse.ListView1Compare(Sender: TObject; Item1,
  Item2: TListItem; Data: Integer; var Compare: Integer);
var
  Index: Integer;
begin
  if FColumnToSort = 0 then
    Compare := CompareText(Item1.Caption,Item2.Caption)
  else begin
   Index := FColumnToSort - 1;
   Compare := CompareText(Item1.SubItems[Index],Item2.SubItems[Index]);
  end;
end;

procedure TfrmAnalyse.StatusBar1DrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
  FStatusDrawRect:= Rect;
end;

procedure TfrmAnalyse.SpeedButton1Click(Sender: TObject);
var
  i: integer;
begin
  // 释放掉以前创建的TabSheet对象,重新分析
  if PageControl1.PageCount > 1 then
    for i:= PageControl1.PageCount-1 Downto 1 do
      PageControl1.Pages[i].Free;

  BeginAnalyse;
end;

procedure TfrmAnalyse.FillData(Fs: CMapXFeatures; Lyr: string; ListView1: TListView);
var
  MyDataSet: CMapXDataSet;
  NewColumn: TListColumn;
  NewItem: TListItem;
  i,j: integer;
begin
  ListView1.Columns.Clear;
  ListView1.Clear;

  MyDataSet:= FMapX.GetDataSetByName(Lyr);
  //创建字段
  for i:= 1 to MyDataSet.Fields.Count do
  begin
    NewColumn:= ListView1.Columns.Add;
    NewColumn.Width:=100;
    NewColumn.Caption:=MyDataSet.Fields.item[i].Name;
  end;

  if Fs.Count > 0 then
    CreateProgressBar(1,Fs.Count)
  else
    Exit;

  //填入内容
  for i:= 1 to Fs.Count do
  begin
    NewItem:= ListView1.Items.Add;
    if MyDataSet._Value[Fs.item[i].FeatureKey,1] <> null then
      NewItem.Caption:= MyDataSet.Value[Fs.item[i].FeatureKey,1]
    else NewItem.Caption:= '';  {非常有必要把它赋直为空，
                                    否则在排序的时候会因为找不到直而报错}
    if MyDataSet.Fields.Count >= 2 then
      for j:= 2 to MyDataSet.Fields.Count do
        if MyDataSet._Value[Fs.item[i].FeatureKey,j] <> null then
          NewItem.SubItems.Add(MyDataSet._Value[Fs.item[i].FeatureKey,j])
        else  NewItem.SubItems.Add('');
    if Assigned(FProgressBar) then
       FProgressBar.Position:= i;
    Application.ProcessMessages;
  end;
  FProgressBar.Free;
end;


procedure TfrmAnalyse.BeginAnalyse;
var
  Lyr: string;
  i, Num: Integer;
  Dis: Double;
begin
  if FAnalyseType = atSelected then
  begin
    Lyr:= FMapX.WorkLayer;
    PageControl1.Pages[0].Caption:= Lyr;
    FMapX.BindLayerData(Lyr);
    StatusBar1.Panels.Items[0].Text:= '正在处理数据...'+'['+Lyr+']';
    FillData(FSourceFs, Lyr, TListView(PageControl1.Pages[0].Controls[0]));
  end
  else
  begin
    //获得源对象
    if FAnalyseType = atAroundPoint then
      FSourceF:= FSourceFs.Item[1]
    else
      FSourceF:= FMapX.GetCombinedFeature(FSourceFs);

    if Edit1.Text = '' then
      Dis:= 0
    else
      Dis:= StrToFloat(Edit1.Text);

    Num:= 0;
    for i:= 0 to CheckListBox1.Items.Count -1 do
      if CheckListBox1.Checked[i] then
      begin
        Num:= Num+1;
        Lyr:= CheckListBox1.Items.Strings[i];
        if Num = 1 then
          PageControl1.Pages[0].Caption:= Lyr
        else
          CreateNew(Lyr);
        FMapX.BindLayerData(Lyr);
        StatusBar1.Panels.Items[0].Text:= ' 正在处理数据...'+'['+Lyr+']';

        FillData(FMapX.GetAnalyseResult(FAnalyseType,FSourceF,Lyr,Dis),
          Lyr, TListView(PageControl1.Pages[Num-1].Controls[0]));
      end; //if
  end; //else 

  //更新信息
  PageControl1.OnChange(nil);
end;

procedure TfrmAnalyse.PageControl1Change(Sender: TObject);
begin
  StatusBar1.Panels.Items[0].Text:= ' 共有：'+
    IntToStr(TListView(PageControl1.ActivePage.Controls[0]).Items.Count)+'个对象';
end;

procedure TfrmAnalyse.SpeedButton2Click(Sender: TObject);
begin
  ModalResult:= mrCancel;
end;

procedure TfrmAnalyse.CreateProgressBar(MinValue, MaxValue: Integer);
begin
  FProgressBar:= TProgressBar.Create(Self);
  StatusBar1.Repaint;
  with FProgressBar do
  begin
    //设定进程条的宽度和高度
    Top:= FStatusDrawRect.top;
    Left:= FStatusDrawRect.left;
    Width:= FStatusDrawRect.right- FStatusDrawRect.left;
    Height:= FStatusDrawRect.bottom-FStatusDrawRect.top;
    Parent := StatusBar1; //该进程条的拥有者为状态条status
    Max:= MaxValue;
    Min:= MinValue;
    Visible:=true;
  end; //with
end;

procedure TfrmAnalyse.SetBuddyMap(AMapX: TMapX);
begin
  if FMapX <> AMapX then
    FMapX:= AMapX;
end;

end.