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

📄 tableform.pas

📁 delphi 和mapx联合开发的例程 实现mapx的相应功能
💻 PAS
字号:
unit TableForm;

interface

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

type
  TTableFrm = class(TForm)
    Panel1: TPanel;
    ListView1: TListView;
    Panel2: TPanel;
    Memo1: TMemo;
    Bevel1: TBevel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    StatusBar1: TStatusBar;
    procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn);
    procedure ListView1Compare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
  private
    { Private declarations }
     Handle: THandle;
     FLayer: string;
     ColumnToSort :longint;
     StatusDrawRect: TRect;
  public
    { Public declarations }
    Procedure SetContext(aHandle: Thandle; aLayer: string; MyDataSet: DataSet; MyFs: Features); overload;
    Procedure SetContext(aHandle: Thandle; aLayer: string; MyDataSet: DataSet; Mysel: Selection); overload;
    property Layer: string read FLayer;
  end;


implementation

uses uMsgConst;


{$R *.dfm}
Procedure TTableFrm.SetContext(aHandle: Thandle; aLayer: string; MyDataSet: DataSet; MyFs: Features);
var
  NewColumn: TListColumn;
  NewItem: TListItem;
  i,j: integer;
  progress: TProgressbar;
begin
  Handle:= aHandle;
  FLayer:= aLayer;
  ListView1.Columns.Clear;
  ListView1.Clear;
  {创建字段}
  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 MyFs.Count = 0 then Exit;
  progress:= TProgressbar.Create(nil);
  StatusBar1.Repaint;  //很重要,否则第一次运行显示不了progress
  with progress do
  begin
    //设定进程条的宽度和高度
    Top:=StatusDrawRect.top;
    Left:=StatusDrawRect.left;
    Width:=StatusDrawRect.right-StatusDrawRect.left;
    Height:=StatusDrawRect.bottom-StatusDrawRect.top;
    Parent := StatusBar1; //该进程条的拥有者为状态条status
    Max:= MyFs.Count;
    Min:= 1;
    Visible:=true;
  end; //with

  {创建内容}
  for i:= 1 to MyFs.Count do
  begin
     NewItem:= ListView1.Items.Add;
    if MyDataSet._Value[MyFs.item[i].FeatureKey,1] <> null then
      NewItem.Caption:= MyDataSet.Value[MyFs.item[i].FeatureKey,1]
    else NewItem.Caption:= '';{非常有必要把它赋直为空,否则在排序的时候会因为找不到直而报错}

    if MyDataSet.Fields.Count >= 2 then
      for j:= 2 to MyDataSet.Fields.Count do
      begin
        if MyDataSet._Value[MyFs.item[i].FeatureKey,j] <> null then
          NewItem.SubItems.Add(MyDataSet._Value[MyFs.item[i].FeatureKey,j])
        else  NewItem.SubItems.Add('');
      end;
    progress.Position:= i;
    Application.ProcessMessages;
  end;
  StatusBar1.Panels.Items[1].Text:= '共有:'+inttostr(MyFs.Count)+'个对象';
  progress.Free;
end;


procedure TTableFrm.SetContext(aHandle: Thandle; aLayer: string; MyDataSet: DataSet; Mysel: Selection);
var
  NewColumn: TListColumn;
  NewItem: TListItem;
  i,j: integer;
  progress: TProgressbar;
begin
  Handle:= aHandle;
  FLayer:= aLayer;
  ListView1.Columns.Clear;
  ListView1.Clear;
  {创建字段}
  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 Mysel.Count = 0 then Exit;
  progress:= TProgressbar.Create(nil);
  StatusBar1.Repaint;
  with progress do
  begin
    //设定进程条的宽度和高度
    Top:=StatusDrawRect.top;
    Left:=StatusDrawRect.left;
    Width:=StatusDrawRect.right-StatusDrawRect.left;
    Height:=StatusDrawRect.bottom-StatusDrawRect.top;
    Parent := StatusBar1; //该进程条的拥有者为状态条status
    Max:= Mysel.Count;
    Min:= 1;
    Visible:=true;
  end; //with

  {创建内容}
  for i:= 1 to Mysel.Count do
  begin
     NewItem:= ListView1.Items.Add;
    if MyDataSet._Value[Mysel.item[i].FeatureKey,1] <> null then
      NewItem.Caption:= MyDataSet._Value[Mysel.item[i].FeatureKey,1]
    else NewItem.Caption:= '';{非常有必要把它赋直为空,否则在排序的时候会因为找不到直而报错}

    if MyDataSet.Fields.Count >= 2 then
      for j:= 2 to MyDataSet.Fields.Count do
      begin
        if MyDataSet._Value[Mysel.item[i].FeatureKey,j] <> null then
          NewItem.SubItems.Add(MyDataSet._Value[Mysel.item[i].FeatureKey,j])
        else  NewItem.SubItems.Add('');
      end;
    progress.Position:= i;
    Application.ProcessMessages;
  end;
  StatusBar1.Panels.Items[1].Text:= '共有:'+inttostr(Mysel.Count)+'个对象';
  progress.Free;
end;

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

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


procedure TTableFrm.StatusBar1DrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
  StatusDrawRect:=rect; //记录要实现状态条特技的坐标范围
end;


procedure TTableFrm.SpeedButton1Click(Sender: TObject);
var
  AMessage: TMessage;
begin
  if ListView1.Selected <> nil then
  begin
    AMessage.Msg:= GOTO_MSG;   // 信息齐全了,让地图去定位
    SendMessage(Handle,AMessage.Msg,0,0);
  end
  else
    Application.MessageBox('请选择一个对象!','提示信息!',mb_ok);
end;

procedure TTableFrm.SpeedButton2Click(Sender: TObject);
begin
  Close;
end;


procedure TTableFrm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  StatusBar1.Panels.Items[1].Text:= '';
  ListView1.Clear;
  Action:= caHide;
end;

end.

⌨️ 快捷键说明

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