| 磊's profileup2me的AO&AE空间BlogLists |  Tools  Help |
|
December 22 VC++中计算程序的运行时间(zz)C++中的计时函数是clock()，而与其相关的数据类型是clock_t（头文件是time.h）。函数定义原型为：clock_t clock(void); 这个函数返回从“开启这个程序进程”到“程序中调用clock()函数”时之间的CPU时钟计时单元（clock tick）数，在MSDN中称之为挂钟时间（wal-clock）。 其中clock_t是用来保存时间的数据类型，在time.h文件中，我们可以找到对它的定义： #ifndef _CLOCK_T_DEFINED typedef long clock_t; #define _CLOCK_T_DEFINED #endif clock_t是一个长整形数。另外在time.h文件中，还定义了一个常量CLOCKS_PER_SEC，它用来表示一秒钟会有多少个时钟计时单元，因此，可以使用公式clock()/CLOCKS_PER_SEC来计算一个进程自身的运行时间。 举个例子: #include<iostream.h> #include<time.h> void main() { clock_t start,finish; double totaltime; start=clock(); …… //把我们写的程序代码插入到这里面 finish=clock(); totaltime=(double)(finish-start)/CLOCKS_PER_SEC; cout<<"\n此程序的运行时间为"<<totaltime<<"秒！"<<endl; } 这样,我们就可以得出程序的运行时间了。 November 23 重温BMP文件结构BMP文件结构的探索
(zz)
一、文件格式
Bmp文件是非常常用的位图文件，无论是游戏还是其他都被广泛使用。针对bmp文件的处理也有一堆现成的api进行调用，然而文件内部究竟怎样，如何自己来解析这样的文件呢？为了消除无聊，我用了几天时间来研究了一下，同时作为学习笔记，进行记录。
首先，整个bmp文件的内容可以分为3到4块。之所以分为3到4块而不是固定的值，是因为，对于bmp来说可能存在调色板或者一些掩码。具体稍候讨论。
第一块是bmp的文件头用于描述整个bmp文件的情况。结构如下： typedef struct tagBITMAPFILEHEADER { WORD bfType; DWORD bfSize; WORD bfReserved1; WORD bfReserved2; DWORD bfOffBits; } BITMAPFILEHEADER, *PBITMAPFILEHEADER;
这些信息相当有用，如果你想直接来解析bmp文件。第一个bfType用于表示文件类型，如果它是bmp文件，那么它这个位置的值一定是”BM” 也就是0x4D42。第二个bfSize表示整个文件的字节数。第三第四个 则保留，目前无意义，最后一个相当重要，表示，位图的数据信息离文件头的偏移量，以字节为单位。
第二块是位图信息头，即BITMAPINFOHEADER，用于描述整个位图文件的情况。以下挑重要的数据进行解释
typedef struct tagBITMAPINFOHEADER{
DWORD biSize; //表示本结构的大小
LONG biWidth; //位图的宽度
LONG biHeight; //位图的高度
WORD biPlanes; //永远为1 ,由于没有用过所以 没做研究 附msdn解释
//Specifies the number of planes for the target device. This value must be set to 1.
WORD biBitCount;//位图的位数 分为1 4 8 16 24 32 本文没对1 4 进行研究
DWORD biCompression; //本以为压缩类型，但是却另外有作用，稍候解释
DWORD biSizeImage; //表示位图数据区域的大小以字节为单位
LONG biXPelsPerMeter;
LONG biYPelsPerMeter;
DWORD biClrUsed;
DWORD biClrImportant;
} BITMAPINFOHEADER, *PBITMAPINFOHEADER;
第三块就是调色板信息或者掩码部分，如果是8位位图 则存放调色板 ；16 与32位位图则存放RGB颜色的掩码，这些掩码以DWORD大小来存放。
最后一块就是位图的数据实体。
以上文件信息可以在任意一篇bmp文件结构的文章中找到描述，所以本文只是稍微带过。 二、4字节对其问题
关于数据读取。Bmp文件有个重要特性，那就是对于数据区域而言，每行的数据它必须凑满4字节，如果没有满，则用冗余的数据来补齐。这个特性直接影响到我们读取位图数据的方法，因为在我们看来（x,y）的数据应该在 y*width+x这样的位置上 但是因为会有冗余信息那么必须将width用width＋该行的冗余量来处理，而由于位图文件有不同的位数，所以这样的计算也不尽相同。
下面列出计算偏移量的一般公式。
首先将位图信息读入一个UCHAR 的buffer中 ：
8位：
int pitch;
if(width%4==0){
pitch=width;
}else{
pitch=width+4-width%4;
}
index=buffer[y*pitch+x]; 因为8位位图的数据区域存放的是调色板索引值，所以只需读取这个index
16位
int pitch=width+width%2;
buffer[(y*pitch+x)*2]
buffer[(i*pitch+j)*2＋1]
两个UCHAR内，存放的是(x,y)处的颜色信息
24位
int pitch=width%4;
buffer[(y*width+x)*3+y*pitch];
buffer[(y*width+x)*3+y*pitch+1];
buffer[(y*width+x)*3+y*pitch+2];
32位
由于一个象素就是4字节 所以无需补齐
虽然计算比较繁琐，但是这些计算是必须的，否则当你的位图每行的象素数不是4的倍数，那么y*width+x带给你的是一个扭曲的图片，当然如果你想做这样的旋转，也不错啊，至少我因为一开始没有考虑（不知道这个特性）让一个每行象素少1字节的16位图片变成了扭曲的菱形。
三、有了数据分离RGB分量。
由于我的测试代码用了GDI，所以我必须讲得到的某一个点的值 分离成 24位模式下的RGB分离，这不是一件容易的工作。位图麻烦的地方之一就是他的格式太多，所以我们还是要分格式再讨论。
8位
通过第二部分提到的操作我们得到了一个index，这个值的范围是0～255 一共256个 正好是调色板的颜色数量。
在8位bmp图片中 数据信息前256个RGBQUAD的大小开始就是调色板的信息。不过如果要组织成调色板还要一定的转换 因为里面是RGBQUAD信息 r b 两个与调色板中的顺序是颠倒的。因为我不需要调色板设置所以我字节读取到RGBQUAD数组中，并且通过下面的表达式获取RGB值：
UCHAR r=quad[index].rgbRed;
UCHAR g=quad[index].rgbGreen;
UCHAR b=quad[index].rgbBlue;
16位
这是最麻烦的一个。因为在处理时有555 565 两种格式的区别，而且还有所谓压缩类型的区别。
之前的bitmapinfoheader里面提到一个biCompression
现在我们分两种情况讨论：BI_RGB和BI_BITFIELDS
当他等于BI_RGB时 只有555 这种格式，所以可以放心大胆的进行如下的数据分离：
UCHAR b=buffer[(i*pitch+j)*2]&0x1F;
UCHAR g=(((buffer[(i*pitch+j)*2+1]<<6)&0xFF)>>3)+(buffer[(i*pitch+j)*2]>>5);
UCHAR r=(buffer[(i*pitch+j)*2+1]<<1)>>3;
希望不要被这个表达式折磨的眼花缭乱，我想既然你在看这篇文章，你就有能力阅读这样的代码，否则只能说你还没有到阅读这方面的地步，需要去学习基础的语法了。
有一点值得提醒的是由于有较多的位操作 ，所以在处理的时候在前一次操作的上面加上一对括号，我就曾经因为没有加而导致出现误差，另外虽然buffer中一个元素代表的是一个UCHAR 但是右移操作会自动增长为两字节所以需要在进行一次与操作截取低位的1字节数据。
现在讨论BI_BITFIELDS。
这个模式下 既可以有555 也可以有565 。
555 格式 xrrrrrgggggbbbbb
565 格式 rrrrrggggggbbbbb
显然不同的格式处理不同，所以我们要首先判断处到底属于那种格式。
Bitmapinfoheader的biCompression为BI_BITFIELDS时，在位图数据区域前存在一个RGB掩码的描述 是3个DWORD值，我们只需要读取其中的R或者G的掩码，来判断是那种格式。
以红色掩码为例 0111110000000000的时候就是555格式 1111100000000000就是565格式。
以下是565格式时的数据分离：
UCHAR b=buffer[(i*pitch+j)*2]&0x1F;
UCHAR g=(((buffer[(i*pitch+j)*2+1]<<5)&0xFF)>>2)+(buffer[(i*pitch+j)*2]>>5);
UCHAR r=buffer[(i*pitch+j)*2+1]>>3;
现在我们得到了RGB各自的分量，但是还有一个新的问题，那就是由于两字节表示了3个颜色 555下每个颜色最多到0x1F 565格式下最大的绿色分量也就0x3F。所以我们需要一个转换 color=color*255/最大颜色数 即可
如565下RGB(r*0xFF/0x1F,g*0xFF/0x3F,b*0xFF/0x1F)
24位
UCHAR b=buffer[(i*width+j)*3+realPitch];
UCHAR g=buffer[(i*width+j)*3+1+realPitch];
UCHAR r=buffer[(i*width+j)*3+2+realPitch];
32位
UCHAR b=buffer[(i*width+j)*4];
UCHAR g=buffer[(i*width+j)*4+1];
UCHAR r=buffer[(i*width+j)*4+2];
四、剩余的问题
当数据取到了，颜色也分离出来了 ，但是可能你绘出的位图是倒转的，这是因为有些位图的确是翻转的。通过bitmapinfoheader的biHeight可以判断是正常还是翻转，当biHeight>0的时候颠倒，它小于0的时候正常，不过测试写到现在看到的文件都是颠倒过来的。
五、相关测试代码：
采用MFC 目的只是实现自行解析位图文件
void CBmpTestView::OnDraw(CDC* pDC)
{
CBmpTestDoc* pDoc = GetDocument();
ASSERT_VALID(pDoc);
// TODO: 在此处为本机数据添加绘制代码
if(filename==""){
return;
}
FILE *fp=fopen(filename,"r");
if(fp==NULL){
pDC->TextOut(100,200,"no file found");
return;
}
BITMAPFILEHEADER fileheader;
BITMAPINFO info;
fread(&fileheader,sizeof(fileheader),1,fp);
if(fileheader.bfType!=0x4D42){
pDC->TextOut(100,200,"无位图文件请选择位图文件");
fclose(fp);
return ;
}
fread(&info.bmiHeader,sizeof(BITMAPINFOHEADER),1,fp);
long width=info.bmiHeader.biWidth;
long height=info.bmiHeader.biHeight;
UCHAR *buffer=new UCHAR[info.bmiHeader.biSizeImage];
fseek(fp,fileheader.bfOffBits,0);
fread(buffer,info.bmiHeader.biSizeImage,1,fp);
if(info.bmiHeader.biBitCount==8){
int pitch;
if(width%4==0){
pitch=width;
}else{
pitch=width+4-width%4;
}
RGBQUAD quad[256];
fseek(fp,fileheader.bfOffBits-sizeof(RGBQUAD)*256,0);
fread(quad,sizeof(RGBQUAD)*256,1,fp);
if(height>0){
//height>0 表示图片颠倒
for(int i=0;i<height;i++){
for(int j=0;j<width;j++){
int index=buffer[i*pitch+j];
UCHAR r=quad[index].rgbRed;
UCHAR g=quad[index].rgbGreen;
UCHAR b=quad[index].rgbBlue;
pDC->SetPixel(j,height-i,RGB(r,g,b));
}
}
}else{
for(int i=0;i<0-height;i++){
for(int j=0;j<width;j++){
int index=buffer[i*pitch+j];
UCHAR r=quad[index].rgbRed;
UCHAR g=quad[index].rgbGreen;
UCHAR b=quad[index].rgbBlue;
pDC->SetPixel(j,i,RGB(r,g,b));
}
}
}
}else if(info.bmiHeader.biBitCount==16){
int pitch=width+width%2;
if(height>0){
//height>0 表示图片颠倒
if(info.bmiHeader.biCompression==BI_RGB){
//该模式只有555
for(int i=0;i<height;i++){
for(int j=0;j<width;j++){
//5 5 5 格式
UCHAR b=buffer[(i*pitch+j)*2]&0x1F;
UCHAR g=(((buffer[(i*pitch+j)*2+1]<<6)&0xFF)>>3)+(buffer[(i*pitch+j)*2]>>5);
UCHAR r=(buffer[(i*pitch+j)*2+1]<<1)>>3;
pDC->SetPixel(j,height-i,RGB((r*0xFF)/0x1F,(g*0xFF)/0x1F,(b*0xFF)/0x1F));
}
}
}else if(info.bmiHeader.biCompression==BI_BITFIELDS){
//该模式在bitmapinfoheader之后存在RGB掩码 每个掩码1 DWORD
fseek(fp,fileheader.bfOffBits-sizeof(DWORD )*3,0);
DWORD rMask;
fread(&rMask,sizeof(DWORD ),1,fp);
if(rMask==0x7C00){
// 5 5 5 格式
MessageBeep(0);
for(int i=0;i<height;i++){
for(int j=0;j<width;j++){
UCHAR b=buffer[(i*pitch+j)*2]&0x1F;
UCHAR g=(((buffer[(i*pitch+j)*2+1]<<6)&0xFF)>>3)+(buffer[(i*pitch+j)*2]>>5);
UCHAR r=(buffer[(i*pitch+j)*2+1]<<1)>>3;
pDC->SetPixel(j,height-i,RGB((r*0xFF)/0x1F,(g*0xFF)/0x1F,(b*0xFF)/0x1F));
}
}
}else if(rMask==0xF800){
//5 6 5 格式
for(int i=0;i<height;i++){
for(int j=0;j<width;j++){
UCHAR b=buffer[(i*pitch+j)*2]&0x1F;
UCHAR g=(((buffer[(i*pitch+j)*2+1]<<5)&0xFF)>>2)+(buffer[(i*pitch+j)*2]>>5);
UCHAR r=buffer[(i*pitch+j)*2+1]>>3;
pDC->SetPixel(j,height-i,RGB(r*0xFF/0x1F,g*0xFF/0x3F,b*0xFF/0x1F));
}
}
}
}
}else{
if(info.bmiHeader.biCompression==BI_RGB){
//该模式只有555
for(int i=0;i<0-height;i++){
for(int j=0;j<width;j++){
//5 5 5 格式
UCHAR b=buffer[(i*pitch+j)*2]&0x1F;
UCHAR g=(((buffer[(i*pitch+j)*2+1]<<6)&0xFF)>>3)+(buffer[(i*pitch+j)*2]>>5);
UCHAR r=(buffer[(i*pitch+j)*2+1]<<1)>>3;
pDC->SetPixel(j,i,RGB((r*0xFF)/0x1F,(g*0xFF)/0x1F,(b*0xFF)/0x1F));
}
}
}else if(info.bmiHeader.biCompression==BI_BITFIELDS){
//该模式在bitmapinfoheader之后存在RGB掩码 每个掩码1 DWORD
fseek(fp,fileheader.bfOffBits-sizeof(DWORD )*3,0);
DWORD rMask;
fread(&rMask,sizeof(DWORD ),1,fp);
if(rMask==0x7C00){
// 5 5 5 格式
MessageBeep(0);
for(int i=0;i<0-height;i++){
for(int j=0;j<width;j++){
UCHAR b=buffer[(i*pitch+j)*2]&0x1F;
UCHAR g=(((buffer[(i*pitch+j)*2+1]<<6)&0xFF)>>3)+(buffer[(i*pitch+j)*2]>>5);
UCHAR r=(buffer[(i*pitch+j)*2+1]<<1)>>3;
pDC->SetPixel(j,i,RGB((r*0xFF)/0x1F,(g*0xFF)/0x1F,(b*0xFF)/0x1F));
}
}
}else if(rMask==0xF800){
//5 6 5 格式
for(int i=0;i<0-height;i++){
for(int j=0;j<width;j++){
UCHAR b=buffer[(i*pitch+j)*2]&0x1F;
UCHAR g=(((buffer[(i*pitch+j)*2+1]<<5)&0xFF)>>2)+(buffer[(i*pitch+j)*2]>>5);
UCHAR r=buffer[(i*pitch+j)*2+1]>>3;
pDC->SetPixel(j,i,RGB(r*0xFF/0x1F,g*0xFF/0x3F,b*0xFF/0x1F));
}
}
}
}
}
//pDC->TextOut(100,200,"16位图");
}else if(info.bmiHeader.biBitCount==24){
int pitch=width%4;
//b g r
if(height>0){
//height>0 表示图片颠倒
for(int i=0;i<height;i++){
int realPitch=i*pitch;
for(int j=0;j<width;j++){
UCHAR b=buffer[(i*width+j)*3+realPitch];
UCHAR g=buffer[(i*width+j)*3+1+realPitch];
UCHAR r=buffer[(i*width+j)*3+2+realPitch];
pDC->SetPixel(j,height-i,RGB(r,g,b));
}
}
}else{
for(int i=0;i<0-height;i++){
int realPitch=i*pitch;
for(int j=0;j<width;j++){
UCHAR b=buffer[(i*width+j)*3+realPitch];
UCHAR g=buffer[(i*width+j)*3+1+realPitch];
UCHAR r=buffer[(i*width+j)*3+2+realPitch];
pDC->SetPixel(j,i,RGB(r,g,b));
}
}
}
//pDC->TextOut(100,200,"24位图");
}else if(info.bmiHeader.biBitCount==32){
// b g r a
if(height>0){
//height>0 表示图片颠倒
for(int i=0;i<0-height;i++){
for(int j=0;j<width;j++){
UCHAR b=buffer[(i*width+j)*4];
UCHAR g=buffer[(i*width+j)*4+1];
UCHAR r=buffer[(i*width+j)*4+2];
pDC->SetPixel(j,height-i,RGB(r,g,b));
}
}
}else{
for(int i=0;i<height;i++){
for(int j=0;j<width;j++){
UCHAR b=buffer[(i*width+j)*4];
UCHAR g=buffer[(i*width+j)*4+1];
UCHAR r=buffer[(i*width+j)*4+2];
pDC->SetPixel(j,i,RGB(r,g,b));
}
}
}
//pDC->TextOut(100,200,"32位图");
}
delete buffer;
fclose(fp);
} November 09 CORBA(ZZ)CORBA中科永联高级技术培训中心（www.itisedu.com） CORBA（Common Object Request Broker Architecture,公共对象请求代理体系结构,通用对象请求代理体系结构）是由OMG组织制订的一种标准的面向对象应用程 序体系规范。或者说 CORBA体系结构是对象管理组织（OMG）为解决分布式处理环境(DCE)中，硬件和软件系统的互连而提出的一种解决方案；OMG组织是一个国际性的非盈利组织，其职责是为应用开发提供一个公共框架，制订工业指南和对象管理规范，加快对象技术的发展。 OMG组织成立后不久就制订了OMA(Object Management Architecture，对象管理体系结构)参考模型，该模型描述了OMG规范所遵循的概念化的基础结构。OMA由对象请求代理ORB、对象服务、公共设施、域接口和应用接口这几个部分组成，其核心部分是对象请求代理ORB（Object Request Broker）。对象服务是为使用和实现对象而提供的基本服务集合；公共设施是向终端用户应用程序提供的一组共享服务接口；域接口是为应用领域服务而提供的接口；应用接口是由开发商提供的产品，用于它们的接口，不属于OMG标准的内容。ORB提供了一种机制，通过这种机制，对象可以透明的发出请求和接收响应。分布的、可以互操作的对象可以利用ORB构造可以互操作的应用。 CORBA标准由物件管理组织（OMG）设立并进行控制，CORBA定议了一系列API，通信协议，和物件/服务信息模型用于使得异质应用程序能够互相操作，这些应用程序用不同的程序语言编写，运行在不同的平台上。CORBA因此为定义明确的物件提供了平台和位置的透明性，这些物件是分布式计算平台的基础。 通常来说，CORBA把用其他语言开发的程序码和关于该程序码能力和如何调用该程序码的资讯包到一个套装(package)中，包成套装的物件则可以在网络上被其他程序(或CORBA物件)调用。 在这个意义上来讲，CORBA可以被看作是一个机器可读的文件档格式，类似于标头档(header)，但是具有相当多的资讯。 CORBA使用一种接口定义语言用于刻画物件将呈现出来的接口。CORBA又规定了从IDL到特定程序语言，如C++或Java，实现的映射。这个映射精确的描述了CORBA资料类型是如何被用户端和服务器端实现的。标准映射的有Ada、C、C++、Smalltalk、Java、以及Python。 还有一些非标准的映射，为Perl和Tcl的映射由这些语言写的ORB实现。 CORBA的IDL只是IDL的一个例子。 在提供用户语言和平台中性的远端程序呼叫规范的同时，CORBA也定义了通常需要的服务，例如事务和安全。 CORBA（通用对象请求代理体系结构)是在当今快速发展的软件与硬件资源的情况下发展出的一种新技术。它可以让分布的应用程序完成通信，无论这种应用程序是什么厂商生产的，只要符合CORBA标准就可以相互通信。CORBA 1.1于1991年由OMG提出，同时还提出了接口定义语言Interface Definition Language，IDL）以及能够让客户/服务器对象在特定的ORB（对象请求代理）实现中进行通信。而1994年提出并被采纳的CORBA 2.0标准才真正实现了不同生产厂商间的互操作性。 ORB是一个在对象间建立客户/服务器联系的中件。使用ORB，客户可以调用服务器的对象或对象中的应用，被调用的对象不要求在同一台机器上。由ORB负责进行通信，同时ORB也负责寻找适于完成这一工作的对象，并在服务器对象完成后返回结果。客户对象完全可以不关心服务器对象的位置，实现它所采用的具体技术和工作的硬件平台，甚至不必关心服务器对象的与服务无关的接口信息，这就大大简化了客户程序的工作。既然能够这么方便，那ORB就需要提供在不同机器间应用程序间的通信，数据转换，并提供多对象系统的无缝连接。 我们通常编制客户/服务器程序时，常常需要自己定义通信协议，而协议的制定往往与硬件和实现的方法有关，而ORB能够简化这一过程。在ORB下，协议通过IDL语言进行定义，保证了一致性，为了照顾到灵活性，ORB允许程序员选择相应的操作系统，执行环境和编程语言。更重要的是它可以使原来的代码通过一定的方式重用。CORBA是面向对象标准的第一步，有了这个标准，软件的实现与工作环境对用户和开发者不再重要，可以把精力更多地放在本地系统的实现与优化上。 下面我们来看看CORBA的一些具体情况。CORBA被设计用来对不同对象系统进行集成，提供灵活的的对象调用与功能实现。下图是客户对象通过ORB调用服务器对象。
对象请求代理结构的大体工作过程就象上面的工作过程一样。客户将需要完成的工作交给ORB，由ORB决定由哪一个对象实例完成这个请求，然后激活这个对象，将完成请求所需要的参数传送给这个激活的对象。除了客户传送参数的接口外，客户不需要了解其它任何信息，这就大大节省了用户的开发精力。而下图着重说明ORB的接口结构。
这个图中的一些信息希望大家能够注意一下，在编程的时候不一定能够全部用上，但是它们还是很重要的。在提出请求时，客户可以使用动态调用接口或者OMG IDL句柄。当然用户也可以直接调用一些ORB内部的功能。对象实现通过OMG IDL产生的框架或通过动态框架接收到调用请求，在处理这些请求时，对象实现可以调用对象适配器和ORB。 对象的接口有两种定义方式，可以使用接口定义语言（称为OMG接口定义语言，OMG IDL）进行静态定义，这种语言根据进行的操作和传送的参数定义对象。另一种方法，可以将接口加入接口库服务中，这种服务代表作为对象的接口的组件，允许在运行时对这些成为组件的接口进行访问，这两种方法是等效的。下图表示的是客户使用句柄或动态调用接口进行访问的情况。
客户知道对象的类型和希望进行的操作（一般客户都知道这个，如果连需要进行什么操作都不知道，那就可笑了）客户可以通过访问一个对象的对象参考提出请求。客户可以通过调用句柄函数初始化调用，也可以动态提出请求。动态发出的请求和通过句柄接口发出的静态请求两者在格式是一样的，请求的接收者不可能知道这种请求是动态发出的还是静态发出的。下图是一个对象实现接收请求的示意图。
ORB定位合适的可以实现这个功能的代码，通过IDL框架或动态框架传向对象实现传送参数，并将控制权交给对象实现。框架是指定于接和对象适配器的，在实现请求的过程中，对象实现可以通过对象适配器获取一些ORB服务。在完成请求时，将控制权和输出数据返回给客户。不要被图给迷惑了，对象实现可以根据自己的需要选择需要的对象适配器使用。下图是接口和实现库的结构示意图。
上图显示了接口和实现住处如何对客户和对象实现是可用的，接口可以在OMG IDL或在接口库中实现，这种对接口的定义用于产生客户句柄和对象实现框架。对象实现信息在安装时提供，保存于实现库中，在传送请求时可以使用这个信息库中的内容。 对象请求代理这个结构在上图中并不需要作为组件单独实现，它由接口定义。任何提供正确接口的ORB实现都是可被接受的。接口可分为以下几大类： 1.对于所有ORB实现均相同的接口； 不同的ORB可以采用不同的实现策略，加上IDL编译器，库和不同的对象适配器，这一切提供了一系列对客户的服务和对具有不同属性对象的实现。可以存在多个ORB实现，它们有不同的名称和不同的实现方法与调用方法，对于客户而言，客户可以同时访问由不同ORB实现管理的对象，当几个ORB共同工作时，它们必须能够区别它们各自的对象名（也就是对象参考），客户不管区别只管使用。ORB内核是ORB的一部分，它提供了对象的基本命名和请求通信机制。CORBA设计得可以支持不同的对象机制，它是通过在ORB内核上建立ORB来完成这一点的。 一个对象的客户可以访问此对象参考，并对对象进行操作。客户不清楚对象的内部结构，它只知道对象的接口和执行操作所需要的时间和空间等资源。虽然我们可以把客户想象为一个调用对象的进程，但是我们也不要忘记了对象也可以调用另外对象的服务。客户看到的ORB接口和人观念中的接口有差不多，这就为编程提供了帮助。客户不需要对代码进行改变就可以通过ORB实现功能，对象适配器只能由ORB或对象实现调用。 对象实现提供了对象的表现形式。通常实现由另一对象提供或由相应的软件提供，当然也可以自己编程实现。在某些情况下，对象的主要功能是非对象实体产生作用。在CORBA中可以支持对象的不同实现。通常，对象实现不依赖于ORB或客户请求，对象实现可以通过选择对象适配器选择和ORB相关服务来选择接口。 对象参考是需要在ORB内指定的信息，客户和对象实现相应于语言映射有对象参考的一个透明定义，这样就把实现的表示与参考隔离开了。两个ORB实现可能在选择对象参考表示时是不同的。所有的ORB必须提供相对于对象参考一致的语言映射，这使得程序能够独立于ORB对对象参考进行访问。 OMG接口定义语言（OMG IDL）通过对象的接口定义了对象的类型。一个接口由一些命名的操作和与这些操作相关的参数组成。请注意，虽然IDL提供概念框架用于描述对象，但不需要有IDL源代码供ORB工作。只要相同的信息以句柄函数或运行接口库的形式提供，特定的ORB就可以正常工作。IDL是一种方法，它使对象实现能够告诉潜在的客户，什么样的操作可以执行。从IDL的定义上可以将CORBA对象映射为特定的编程语言或对象系统。 不同的面向对象语言和非面向对象语言可以以不同的方式访问CORBA对象。对于面向对象语言而言，它希望看到的是对象的形式，即使对非面向对象语言来说，它所希望看到的也不包括具体的内部实现。将OMG IDL映射为编程语言的方法对于所有的ORB实现应该是一致的。这些映射可能包括数据类型的映射和调用ORB的过程（或函数）接口的映射。语言映射还定义了对象调用和客户（或实现）中的控制线程之间的相互作用。最普通的映射提供了同步调用，结果可以在过程完成时返回。其它的映射可以用来初始化调用并将控制权返回给程序，在这些情况下，附加的函数必须相应的同步功能。 为了映射非面向对象语言，将有一个对每个接口类型的程序接口。通常，句柄将提供访问OMG IDL定义的操作的机制。句柄调用对于ORB核心是私有的那部分ORB。如果有多于一个ORB，将会有对应于不同ORB的接口。在这种情况下，需要ORB和语言映射相互协调以访问正确的对象参考句柄。面向对象语言不需要句柄接口。接口允许对象动态调用，用户可以不必调用一个特定对象上的操作，他可以指定调用特定的对象。客户程序提供关于操作和参数类型的信息就可以了。 允许动态处理对象调用的接口是非常有用的，不是由与特殊操作相关的框架来访问对象实现，而是由一个提供访问操作名和参数的界面用一种类似于动态调用接口的方式来访问对象实现。动态框架界面可以由客户句柄或动态调用接口来调用，它们向动态框架接口发出对象请求。动态框架接口的基本思想是让所有的对象请求通过调用同一组例程来达到调用对象实现中方法的目的，这组例程便叫做动态调用例程DIR。 对象适配器是对象实现访问ORB提供的服务的主要方式由ORB提供的服务在一个对象适配器中经常包括：对象引用的产生和解释、方式调用、交互性安全、对象和实现的激活与释放、对象引用到实现的映射及实现的定位由于各个不同对象的对象粒度、生命周期等等。ORB内核无法为所有的对象提供一个统一、方便有效的界面。通过对象适配器的作用，可以将目的对象分成若干组，每组通过特定的对象适配器来满足其特定的需要，但这样一来，对象适配器的种类便会急剧膨胀，为了减少对象适配器的种类，CORBA给出了基本对象适配器（BOA），以满足大多数对象的需要，BOA提供了产生和解释对象引用、对请求进行认证、激活/去活实现 、激活/去活单个对象、通过框架调用方法等功能. 在提供这些功能时 ,BOA要用到一些与操作系统有关的知识 ,这些知识由实现仓库提供，实现仓库还存放对象实现的有关信息。 ORB接口一种直接对应于ORB的接口，它对于所有的对象接口，对象适配器都是一样的。大部的操作都由对象适配器，句柄，框架或动态调用实现，对于所有对象都需要的操作很少。接口库是一种服务，其中保存着接口信息，这些信息在ORB执行请求时会用得上。而且，当一个应用程序在调用一个未知接口的对象时，可以通过接口库了解能够在其上进行的操作。除了，它可以充当ORB功能外，实现库通常还保存与ORB对象实现相关的信息。实现库包括了一些信息，这些信息让ORB可以定位并激活对象的实现。实现库中的信息是特定于ORB或实现环境的，通常，实现的安装和控制策略是通过实现库实现的。除了，它可以充当ORB功能外，实现库通常还保存与ORB对象实现相关的信息。 一、CORBA的来源 ●CORBA体系结构是对象管理组织（OMG）为解决分布式处理环境(DCE)中，硬件和软件系统的互连而提出的一种解决方案； ●OMG是一个世界性的非赢利论坛组织，成立于1989年，最初有3Com、AmericanAirlines、Cannon Inc、DataGeneral、HP、Philips Telecommunication N.M、SUN、Unisys八个成员，目前已超过700个成员，其目标是开发一种技术上先进和商业上可用，独立于厂商的软件工业规范； ●1991年OMG提出了CORBA1.1，定义了IDL接口定义语言，开发出对象请求代理ORB中间件,在客户机/服务器结构中，ORB通过一定的应用程序接口(API)，实现对象之间的交互； ●1994年12月OMG完成了CORBA2.0，提出了IIOP（Internet Inter Object Protocol），用以规范不同厂家的ORB之间的真正互通，同时增加了互操作性和对C＋＋及SmallTalk的匹配，OMG期望通过上述规范，建立一种“连接世界的体系结构”； ●CORBA 在面向对象的标准化和互操作上迈出了坚实的一步。使用CORBA，用户能在不知道软件和硬件平台以及网络位置的情况下透明的获取信息； ●CORBA自动进行许多网络规划任务如对象注册、定位、激活；多路径请求；分帧和错误处理机制；并行处理以及执行操作； ●作为面向对象系统中的通信核心， CORBA为当代的计算环境中带来了真正意义上的互联； 二、CORBA的含义及特点 ●CORBA定义了一种面向对象的软件构件构造方法，使不同的应用可以共享由此构造出来的软件构件； ●每个对象都将其内部操作细节封装起来，同时又向外界提供了精确定义的接口，从而降低了应用系统的复杂性，也降低了软件开发费用； ●CORBA的平台无关性实现了对象的跨平台引用，开发人员可以在更大的范围内选择最实用的对象加入到自己的应用系统之中； ●CORBA的语言无关性使开发人员可以在更大的范围内相互利用别人的编程技能和成果， 是实现软件复用的实用化工具；
●存取来自现行桌面应用程序的分布信息和资源； ●使现有业务数据和系统成为可供利用的网络资源； ●为某一特定业务用的定制的功能和能力来增强现行桌面工具和应用程序； ●改变和发展基于网络的系统以反映新的拓扑结构或新资源； 四、CORBA的技术背景 ●面向对象技术的兴起； ●客户/服务器模式的普遍应用； ●集成已有系统及通信和实现细节的需求； ●现有分布处理机制和方法存在着不足之处； 五、基于分布式对象计算的CORBA ●在CORBA环境中，应用程序的集成是基于面向对象模型的； ●CORBA通过分布式对象计算，即分布式计算和面向对象计算的结合，以实现软件重用，这是开发下一代软件的基础； ●分布式对象计算的组成 分布式计算和对象模型的结合：CORBA是这两者的完美结合，这两部分不仅带来了自身的优点，而且完善了对方的优点； 代理器的使用：CORBA使用代理器来处理系统中客户机与服务器之间的消息； ●什么是分布式计算 分布式计算是两个或多个软件互相共享信息； 大部分分布式计算是基于客户/服务器模型的； 分布式计算可以拥有稀有资源共享、平衡机器负载等优点，使计算机资源的使用更为有效； CORBA采用一定的手段增强分布式计算： ●CORBA采用增强分布式计算的手段 允许客户机与器间灵活变化的关系； 加入一个称为代理的中介； 允许服务器有多个进程； 支持同步及异步两种通信形式； ●对象模型是对象计算中的概念，是考虑问题及其可能解决方案的概念性框架； 对象模型的基础是对象概念之上的，对象提供了把行为和属性结合成一单独实体的手段； ●使用对象模型具有以下优点：定义一个基于现实世界的系统模型 把系统逻辑地分成能完成特定任务的对象 当需求改变时扩展模块 ● 在CORBA中分布式计算和对象模型的结合实现了相互促进，CORBA在分布式计算和对象模型环境中加入了下列内容： ●分布式计算方面的增强：对分布式计算环境，CORBA在环境中加入了特定对象的引用。在CORBA中，要完成某个操作，所需要做的仅仅是请求某个有能力完成该操作的对象去完成它，客户机不需要知道更多的信息； 对象模型方面的增强：对于对象模型，CORBA加入了代理器的概念。代理器使应用程序不需要知道对象在网络上哪个地方和对方是如何工作的就可以进行交互，只有代理器需要知道CORBA服务器和客户机在网络上的位置； 六、CORBA――通信中间件 ●中间件是处于应用程序及应用程序所在系统的内部工作方式之间的软件； ●中间件把应用程序与系统所依附软件的较低层细节和复杂性隔离开来，使应用程序开发者只处理某种类型的单个API――其他细节则可以由中间件处理； ●CORBA可以被称为通信中间件，它可以看成是把应用程序和通信核心的细节分离的软件； 七、CORBA规范的技术特点 ●引入了代理的概念； ●所实现的客户方程序与服务器方程序的完全分离； ●将分布计算同面向对象的概念相互结合； ●提供了软件总线的机制； ●分层的设计原则与实现方法； 八、CORBA产品一览 ●IONA公司的Orbix ； ●Inprise公司的VisoBroler ； ●Digital公司的Component Broker ； ●IBM公司的Component Broker ； ●Sun Microsystems 公司的NEO、JOE； ●SunSoft公司的DOE ； ●东南大学开发研制的ORBUS； 九、CORBA服务的基本内容 在CORBA体系规范中定义了多种类型的服务（Service），如命名（Naming）、生存期（LifeCycle）、事件（Event）、事务（Transaction）、对象持久化（Persistent Objects）、查询（Query）、特征（Property）、时间（Time）等服务功能。 在CORBA规范中，没有明确说明不同厂商的中间件产品要实现所有的服务功能，并且允许厂商开发自己的服务类型。因此, 不同厂商的ORB产品对CORBA服务的支持能力不同，使我们在针对待开发系统的功能进行中间件产品选择时，有更多的选择余地。 下面介绍与分布式应用程序设计和开发关系密切的CORBA服务内容： 1. 对象命名服务（Naming Service） 在命名服务中，通过将服务对象赋予一个在当前网络空间中的惟一标识来确定服务对象的实现。在客户端，通过指定服务对象的名字，利用绑定（Bind）方式，实现对服务对象实现的查找和定位，进而可以调用服务对象实现中的方法。 2. 对象安全性（Security）服务 在分布式系统中，服务对象的安全性和客户端应用的安全性一直是一个比较敏感的问题，安全性要求影响着分布式应用计算的每个方面。对于分布在互联网中的分布式应用来讲，为了防止恶意用户或未经授权的方法调用对象的服务功能，CORBA提供了严格的安全策略，并制定了相应的对象安全服务。安全服务可以实现如下功能： ● 服务请求对象的识别与认证; ● 授权和访问控制; ● 安全监听; ● 通信安全的保证; ● 安全信息的管理; ● 行为确认。 CORBA系统将对象请求的安全性管理的功能交由ORB负责，系统组件只需负责系统本身的安全管理，使得基于分布式应用在安全性控制方面的责任十分明确。 3. 并发控制（Cocurrency Control）服务 CORBA规范中定义并发控制服务的目的在于实现多客户访问情况下的并发性控制和对共享资源的管理。 并发控制服务由多个接口构成，能够支持访问方法的事务模型和非事务模型。由于两种模型的引入，使得非事务型客户在访问共享资源时，如果该资源被拥有事务模型的方法锁定（Lock），则该客户转入阻塞状态，直到事务型方法执行结束，将共享资源锁打开，非事务模型的客户才能够访问该共享资源。 并发控制服务使多个对象能够利用资源锁定（Lock）的方式来对共享资源进行访问。在访问共享资源之前，客户对象必须从并发控制服务中获得锁定。在确认资源目前正在空闲时，获得资源的使用权。每个锁定是一个资源-客户对，说明哪个客户正在访问何种类型的资源。 4. 对象生命期服务（LifeCycle） CORBA中的生命期服务定义和描述了创建、删除、拷贝和移动对象的方法。通过生命期服务，客户端应用可以实现对远程对象的控制。 利用命名（Naming）服务 实现分布式应用 在上篇文章中介绍的利用JavaIDL开发分布式应用时曾采用命名服务的方式。对象命名服务是ORB查找服务对象实现的一种简单的方式。 1. 功能需求分析和定义接口文件 本例的主要功能是模拟电话用户注册及电话号码查询业务，开发基于命名服务的分布式应用程序，中间件产品采用VisiBroker 4.5.1 for Java。 根据系统功能的定义，两种业务均属于电信业务的经营范围，因此定义模块名TeleCom。电话号码注册为电信业务管理功能范围，需定义该功能接口Registry，该接口内包含用户注册方法register（）；电话号码查询为用户服务功能范围，需定义接口User，该接口内包含查询个人电话号码方法getNumber（）。经过上述分析后编写的IDL接口定义文件TeleCom.idl如下： module TeleCom { interface User //接口User声明 { //接口中getNumber方法的定义 int getNumber(); }; interface Registry //接口Registry声明 { //接口中register方法定义，其中以string类型变量作为输入参数 ’方法返回User对象 User register(in string name); }; }; 上述接口定义文件经idl2java编译后，在当前接口文件目录中生成TeleCom子目录，该目录中包括UserPOA.java、RegistryPOA.java等文件。这些文件是客户端和服务对象实现功能的框架以及相关的支持文件。有兴趣的读者可以实际创建IDL文件，经IDL到Java语言的映射后，分析生成文件的格式。 2. 实现服务功能 （1）实现User接口的类UserImpl 根据系统分析确定的功能，定义接口User对应的实现类UserImpl的代码如下： // UserImpl类继承定义在UserPOA.java中的UserPOA类 public class UserImpl extends TeleCom .UserPOA { private int aNumber; //
在CIMS环境下，应用通常是分布的，应用之间需要交换信息和数据，例如CAD和CAM之间，CAD、CAM和MRP II之间，甚至是不同的CAD应用之间都会发生数据的交互。分布式应用的开发，尤其是面向对象的分布式应用的开发，对于系统开发者而言是极具挑战性的。CORBA、C OM/OLE Automation和JavaBeans是目前针对此类应用的主要分布对象计算模型和支持系统。一般来说，如果所开发的应用只面向Windows平台（Windows 3.x/95/NT），那么使用COM 是最佳的选择；如果所开发的应用完全是使用Java语言编制的，那么就应该采用JavaBeans 的方案。但是，如果所开发的应用需要集成异构的平台，那么无疑应该选择CORBA。通过C ORBA系统的支持，分布应用的开发者可以采用不同的语言、操作系统和硬件平台来开发面向对象的分布式应用。当然，首要的条件是存在支持该种平台、操作系统和语言的CORBA系统。 利用CORBA系统进行分布对象应用的开发具有下面三个特点：①开发代价小、效率高。系统开发者只需要编写描述服务对象接口的IDL语言文件并安装描述文件，实现服务对象的功能即完成了全部的任务。其它的相关代码或者是由IDL编译器自动创建，或者是由ORB 类库提供，应用程序员并不需要编写例如网络通信、数据编码/解码、名址映射和安全管理的程序代码，从而可以把工作重点放到服务对象实现的过程中去。②通过CORBA系统的支持，一个服务对象可以透明地被分布在本地和网络上的客户所调用，扩大了服务对象的使用范围，为分布的客户所共享。③CORBA系统作为“软件总线”，可以为服务对象提供“ 即插即用”的功能，而且当对象实现改进或升级时，只要接口保持不变，客户代码无需作任何改动。 在CIMS的应用环境之下，CORBA系统的另一个十分重要的作用是集成已有的应用系统，这样的应用系统通常称为“遗留系统”（Legacy System）。“面向CIMS的并行工程集成框架关键技术”课题就是一个很好的例子。各个领域框架的应用系统，例如，机械领域的Pro Engi neer、电子领域的Mentor Graphics等等，需要通过CORBA系统集成到一起实现信息的交互和共享。集成的关键在于对遗留系统的封装和包裹（wrap），经过包裹，遗留系统就能够以OMG IDL的形式提供给用户，从而和新开发的面向对象的分布式应用同样处理。包裹的形式视不同的遗留系统而不同，对于能够提供用户调用接口的遗留系统，只要利用原有的调用来构造新的界面（必要时需要进行一定的扩充）即可；而对于比较封闭的遗留系统，集成的难度就大得多了，通常是利用文件作为中介来集成。不过，目前CAD、CAM和MRP II 的系统厂商在发展过程中也在逐步使自身的应用系统更加开放，向用户提供更灵活的控制手段，完全封闭的系统已经十分少见了，从而使集成工作也变得相对简单。 July 21 管网分析,得到交点Public Sub LineAnalysis(ByRef pLayerOne As IFeatureLayer, ByRef pLayerTwo As IFeatureLayer) '管网分析 Dim pFeatCLSOne As IFeatureClass Dim pFeatCLSTwo As IFeatureClass Set pFeatCLSOne = pLayerOne.FeatureClass Set pFeatCLSTwo = pLayerTwo.FeatureClass '判断选中图层是否线图线,不是话，提示，退出 If Not pFeatCLSOne.ShapeType = esriGeometryPolyline Then MsgBox "所选图层-“" & pLayerOne.Name & "”不是线图层，不能进行管网分析！", , "管网分析" Exit Sub End If If Not pFeatCLSTwo.ShapeType = esriGeometryPolyline Then MsgBox "所选图层-“" & pLayerTwo.Name & "”不是线图层，不能进行管网分析！", , "管网分析" Exit Sub End If Dim rsPoints As ADODB.Recordset Set rsPoints = Form2.DataGrid1.DataSource If rsPoints.RecordCount > 0 Then If (Trim(rsPoints.Fields("管线图层1").Value) = pLayerOne.Name And Trim(rsPoints.Fields("管线图层2").Value) = pLayerTwo.Name) _ Or (Trim(rsPoints.Fields("管线图层1").Value) = pLayerTwo.Name And Trim(rsPoints.Fields("管线图层2").Value) = pLayerOne.Name) Then Form2.Show Else rsPoints.MoveFirst While Not rsPoints.EOF rsPoints.Delete rsPoints.MoveNext Wend Call LineAnalysis(pLayerOne, pLayerTwo) End If Else Dim pSpatialFilter As ISpatialFilter Dim pFeatureCursorOne As IFeatureCursor Dim pFeatureCursorTwo As IFeatureCursor Dim pFeatureOne As IFeature Dim pFeatureTwo As IFeature Dim pGeometryOne As IGeometry Dim pGeometryTwo As IGeometry Dim pTopoOperator As ITopologicalOperator Dim pGeomColl As IGeometryCollection Set pFeatureCursorOne = pFeatCLSOne.Search(Nothing, False) Set pFeatureOne = pFeatureCursorOne.NextFeature Set pSpatialFilter = New SpatialFilter With pSpatialFilter .SpatialRel = esriSpatialRelIntersects .GeometryField = "shape" End With Form1.ProgressBar1.Min = 0 Form1.ProgressBar1.Max = pFeatCLSOne.FeatureCount(Nothing) Form1.ProgressBar1.Value = Form1.ProgressBar1.Min Form1.ProgressBar1.Visible = True While Not pFeatureOne Is Nothing Set pSpatialFilter.Geometry = pFeatureOne.Shape Set pFeatureCursorTwo = pFeatCLSTwo.Search(pSpatialFilter, False) Set pFeatureTwo = pFeatureCursorTwo.NextFeature While Not pFeatureTwo Is Nothing Set pGeometryOne = pFeatureOne.Shape Set pGeometryTwo = pFeatureTwo.Shape Set pTopoOperator = pGeometryOne Set pGeomColl = pTopoOperator.Intersect(pGeometryTwo, esriGeometry0Dimension) If Not pGeomColl.GeometryCount < 1 Then Dim pPoint As IPoint Dim Count As Integer For Count = 0 To pGeomColl.GeometryCount - 1 Set pPoint = pGeomColl.Geometry(Count) rsPoints.AddNew With rsPoints .Fields("X").Value = pPoint.x .Fields("Y").Value = pPoint.y .Fields("管线图层1").Value = pLayerOne.Name .Fields("管线图层2").Value = pLayerTwo.Name .Fields("管理图层1中管线ID").Value = pFeatureOne.OID .Fields("管理图层2中管线ID").Value = pFeatureTwo.OID End With Next Count End If Set pFeatureTwo = pFeatureCursorTwo.NextFeature Wend Set pFeatureOne = pFeatureCursorOne.NextFeature Form1.ProgressBar1.Value = Form1.ProgressBar1.Value + 1 Wend If rsPoints.RecordCount = 0 Then MsgBox "两个图层中的线，没有交叉点！", , "管理网分析" Else rsPoints.MoveFirst Form2.Show 0, Form1 End If End If Form1.ProgressBar1.Visible = False End Sub June 30 遍历图层中的每一个节点Public Sub VisitAllFeature(pLayer As ILayer) Dim pFeatcls As IFeatureClass Dim pFeatLayer As IFeatureLayer Dim pPointCollection As IPointCollection Dim pFeatureCursor As IFeatureCursor Dim pFeature As IFeature Dim pPoint As IPoint Dim i, j As Integer Set pFeatLayer = pLayer Set pFeatcls = pFeatLayer.FeatureClass Dim pQFilt As IQueryFilter Set pQFilt = New QueryFilter pQFilt.WhereClause = "" Set pFeatureCursor = pFeatcls.Search(pQFilt, False) Set pFeature = pFeatureCursor.NextFeature For i = 0 To pFeatcls.FeatureCount(pQFilt) - 1 If Not (pFeature Is Nothing) Then If pFeature.Shape.GeometryType = esriGeometryPoint Then Set pPoint = pFeature.Shape Debug.Print pLayer.Name & " " & pPoint.x & "," & pPoint.y Else Set pPointCollection = pFeature.Shape For j = 0 To pPointCollection.PointCount - 1 Set pPoint = pPointCollection.Point(j) Debug.Print pLayer.Name & " " & pPoint.x & "," & pPoint.y Next j End If End If DoEvents Set pFeature = pFeatureCursor.NextFeature Next i End Sub June 24 获取原表和目标表 Dim pTab As ITable
Dim pDisplayTable As IDisplayTable Set pDisplayTable = pFeatLayer Set pTab = pDisplayTable.DisplayTable If pTab Is Nothing Then MsgBox "The Layer is not joined" End If Dim pRelQueryTable As IRelQueryTable Dim pDestTable As ITable Dim pDestSet As IDataset Dim pDestTabName As String Dim pSourceTable As ITable Dim pSourceSet As IDataset Dim pSourceTabName As String Set pRelQueryTable = pTab Set pDestTable = pRelQueryTable.DestinationTable Set pDestSet = pDestTable Set pSourceTable = pRelQueryTable.SourceTable Set pSourceSet = pSourceTable pDestTabName = pDestSet.Name pSourceTabName = pSourceSet.Name June 16 利用ao删除选择的要素(zz)打开Visual Basic Editor，拷贝下面代码 Option Explicit 选择要素，运行micro就可以了 如何得到图形的基本属性(zz)本例要实现的功能是得到一个FeatureLayer中被选择的Feature的基本图形属性，如，图形的维数，类型，范围，空间坐标系统等。 l 要点 接口IGeometry的主要属性有Dimension(维数)，GeometryType（图形类型），Envelope（范围），IsEmpty （是否为空），SpatialReference（空间坐标系）等。 l 程序说明 该过程在开始处使用IEnumFeature接口来得到所选择的Features,用Next方法取得每个Feature。然后利用IFeature接口的Shape属性得到Geometry。最后弹出消息框显示图形的属性信息。 l 代码 Public Sub GetGeometryProperty() 如何画Polygon Buffers (zz)本例要实现的是如何利用Polygon Buffer自定义记录选中时的显示方式。 l 要点 首先通过IRgbColor接口和ISimpleFillSymbol接口设置Polygon Buffer的填充方式。然后在发生SelectionChanged事件时，设置选中记录被显示时的边界并将选中的Polygon通过ITopologicalOperator.ConstructUnion方法，联合成一个临时的Polygon Buffer，使用IActiveView.PartialRefresh方法刷新这个Polygon Buffer区域，最后在发生AfterItemDraw事件时将这个Polygon Buffer画在Map上。 主要用到IPolygon接口，IEnvelope接口，ISimpleFillSymbol接口，IActiveView接口，IEnumFeature接口，IGeometryCollection接口和ITopologicalOperator接口。 l 程序说明 函数InitEvents是初始化变量并设置Polygon Buffer的填充方式。 AfterItemDraw事件实现的是画出Polygon Buffer。 SelectionChanged事件实现的是生成Polygon Buffer并设置边界。 l 代码
Private WithEvents ActiveViewEvents As Map Public Sub InitEvents() Private Sub ActiveViewEvents_AfterItemDraw(ByVal Index As Integer, ByVal Display As IDisplay, ByVal phase As esriDrawPhase) Private Sub ActiveViewEvents_SelectionChanged() Private Sub UIButtonControl1_Click() 如何实现在ArcMap中进行动作的撤销和重做(zz)本例要演示的是如何在ArcMap中对图形的移动动作进行撤销和重做，用到IExtentStack接口。以帮助理解ArcMap中对撤销和重做实现的方法。 l 要点 IActiveView的ExtentStack属性保存了其Extent改变的“历史记录”，而IMxDocument的OperationStack属性则有能力记录更复杂的编辑动作的历史。用户只有深刻理解了概念，才能够完成特定功能“历史记录”的定制。 l 程序说明 过程 Extent_UnDo和Extent_RnDo分别模拟了ArcMap中Tools工具栏上的“Go Back To Previous Extent”和“Go To Next Extent”两个按钮的功能。 l 代码
Option Explicit Public Sub Extent_UnDo() Public Sub Extent_ReDo() 如何实现在ArcMap中移动地图(zz)用户点击按钮后，可以拖动地图显示 l 要点 采用IActiveView.ScreenDisplay.PanStart和PanStop方法使地图移动。 l 程序说明 通过IActiveView.ScreenDisplay的PanStart和PanStop方法在ITool的MouseDown,MouseUp和MouseMove事件的响应实现移动效果，将移动结果得到IEnvelope赋值给IActiveView.Extent，实现地图的刷新 l 代码
Option Explicit Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, _ByVal x As Long, ByVal y As Long) Private Sub UIToolControl1_MouseMove(ByVal button As Long, ByVal shift As Long, _ByVal x As Long, ByVal y As Long) Private Sub UIToolControl1_MouseUp(ByVal button As Long, ByVal shift As Long, _ByVal x As Long, ByVal y As Long) Private Sub UIToolControl1_Select() Private Function GetFocusDisplay() As IScreenDisplay Private Function GetMapInset(pScreenDisplay As IScreenDisplay) As IMapInsetWindow 如何实现在ArcMap中放大缩小地图(zz)用户点击按钮后，可以在地图上进行点击或者拖放矩形框来放大缩小地图 l 要点 因为考虑到用户可以单击放大缩小，也可以拖放矩形框来放大缩小，所以不可以直接使用IRubberBand接口，而是采用INewEnvelopeFeedback接口 l 程序说明 主要通过InewEnvelopeFeedback.StartPoint 和MoveTo方法来绘制矩形框，然后赋值给IActiveView.Extend属性，达到地图的放大缩小 l 代码
Private m_pFeedbackEnv As INewEnvelopeFeedback Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, _ByVal y As Long) Private Sub UIToolControl1_MouseMove(ByVal button As Long, ByVal shift As Long, ByVal x As Long, _ByVal y As Long) Private Sub UIToolControl1_MouseUp(ByVal button As Long, ByVal shift As Long, ByVal x As Long, _ByVal y As Long) 如何设置和修改层的数据源(zz)本例要实现的是如何改变（或设置）一个层的数据源（Ｄata Source）。主要用到IMapAdmin2接口。 l 要点 首先需要得到新数据源的IFeatureClass接口对象和当前要改变数据源的层的当前IFeatureClass接口对象，然后调用IMapAdmin2接口的FireChangeFeatureClass方法实现之。 l 程序说明 过程UICMD_ChageDataSource_Click是实现模块，调用过程ChangeLayerDataSource实现功能。 sNewFileName是层的新数据源的shape文件的完整文件名（包含）。 l 代码 Private Sub UICMD_ChageDataSource_Click() Dim pVBProject As VBProject Dim sProjectName As String Dim sNewFileName As String On Error GoTo ErrorHandler: Set pVBProject = ThisDocument.VBProject 'Get MXD File Path sProjectName = pVBProject.FileName 'Get Data File Path sNewFileName = sProjectName & "\..\..\..\..\data\country.shp" 'Call Procedure ChangeLayerDataSource sNewFileName Exit Sub ErrorHandler: MsgBox Err.Description End Sub Private Sub ChangeLayerDataSource(ByVal sNewFileName As String) Dim pWorkspaceFactory As IWorkspaceFactory Dim pWorkspace As IWorkspace Dim pFeatureWorkspace As IFeatureWorkspace Dim pNewFeatureCls As IFeatureClass Dim pOldFeatureCls As IFeatureClass Dim pMxDocument As IMxDocument Dim pMap As IMap Dim pActiveView As IActiveView Dim pMapAdmin2 As IMapAdmin2 Dim pFeatureLayer As IFeatureLayer On Error GoTo ErrorHandler 'Get Data FeatureClass Set pWorkspaceFactory = New ShapefileWorkspaceFactory Set pWorkspace = pWorkspaceFactory.OpenFromFile(sNewFileName & "\..\", 0) Set pFeatureWorkspace = pWorkspace Set pNewFeatureCls = pFeatureWorkspace.OpenFeatureClass("country") 'Get Lay(0)'s FeatureClass Set pMxDocument = ThisDocument Set pMap = pMxDocument.FocusMap Set pMapAdmin2 = pMap Set pActiveView = pMap Set pFeatureLayer = pMap.Layer(0) Set pOldFeatureCls = pFeatureLayer.FeatureClass 'Change Data Source Set pFeatureLayer.FeatureClass = pNewFeatureCls pMapAdmin2.FireChangeFeatureClass pOldFeatureCls, pNewFeatureCls pActiveView.Refresh 'if want to change Display in Toc ,cancel these comment below 'pFeatureLayer.Name = pNewFeatureCls.AliasName 'pMxDocument.CurrentContentsView.Refresh 0 Exit Sub ErrorHandler: MsgBox Err.Description End Sub 如何实现在ArcMap上进行属性查询(Identify)(zz)本例要演示的是如何查询Feature的属性信息。实现后的结果为选择了UI Tool Control后，在要查询的Feature上单击鼠标，查询的结果将显示在弹出的窗体上。 l 要点 首先需要得到要查询的Feature对象。使用IIdentify接口的Identify方法可以对给定的位置进行查询，得到结果为IIdentifyObj对象的数组。然后通过为IIdentifyObj对象设置IFeatureIdentifyObj查询接口，即可进一步得到Feature对象。因为IFeatureIdentifyObj接口的Feature属性具有只写（write only）属性，故又用到另一个接口IRowIdentifyObj。 得到Feature对象后即可操作其Fields属性和Value属性，得到其属性字段名和值。 l 程序说明 在窗体上使用了MSFlexGrid Control 6.0来显示查询结果。所以本例也演示了MSFlexGrid控件的使用方法。 窗体名： frmResult MSFlexGrid控件名： flxAttr 标签控件名： lblLocation （标签用来显示查询位置的地理坐标） l 代码 Private Sub UIT_Identify_MouseDown(ByVal button As Long, ByVal shift As Long, _ ByVal x As Long, ByVal y As Long) Dim pMxApplication As IMxApplication Dim pMxDocument As IMxDocument Dim pMap As IMap Dim pPoint As IPoint Dim pIDArray As IArray Dim pIdentify As IIdentify Dim pFeatureIdentifyObj As IFeatureIdentifyObj Dim pIdentifyObj As IIdentifyObj Dim pRowIdentifyObj As IRowIdentifyObject Dim pFeature As IFeature Dim pFields As IFields Dim pField As IField Dim iFieldIndex As Integer Dim iLayerIndex As Integer Dim sShape As String On Error GoTo ErrorHandler Set pMxApplication = Application Set pMxDocument = Application.Document Set pMap = pMxDocument.FocusMap 'Identify from TOP layer to BOTTOM, exit loop since one Feature identified For iLayerIndex = 0 To pMap.LayerCount - 1 Set pIdentify = pMap.Layer(iLayerIndex) 'Convert x and y to map units Set pPoint = pMxApplication.Display.DisplayTransformation.ToMapPoint(x, y) 'Set label on the form, coordinates would have 6 digits behind decimal point frmResult.lblLocation = "Location:(" & Format(pPoint.x, "##0.000000") & "," _ & Format(pPoint.y, "##0.000000") & ")" Set pIDArray = pIdentify.Identify(pPoint) 'Get the FeatureIdentifyObject If Not pIDArray Is Nothing Then Set pFeatureIdentifyObj = pIDArray.Element(0) Set pIdentifyObj = pFeatureIdentifyObj pIdentifyObj.Flash pMxApplication.Display 'Feature property of FeatureIdentifyObject has write only access Set pRowIdentifyObj = pFeatureIdentifyObj Set pFeature = pRowIdentifyObj.Row Set pFields = pFeature.Fields 'Set the MSFlexGrid control on form te display identify result With frmResult.flxAttr .AllowUserResizing = flexResizeColumns .ColAlignment(1) = AlignmentSettings.flexAlignLeftCenter .ColWidth(0) = 1500 .ColWidth(1) = 1800 'Add header to MSFlexGrid control .Rows = pFields.FieldCount + 1 .Cols = 2 .FixedRows = 1 .FixedCols = 0 .TextMatrix(0, 0) = "Field" .TextMatrix(0, 1) = "Value" For iFieldIndex = 0 To pFields.FieldCount - 1 Set pField = pFields.Field(iFieldIndex) 'Set field "Field" of the MSFlex control .TextMatrix(iFieldIndex + 1, 0) = pField.Name 'Set field "Value" of the MSFlex control Select Case pField.Type Case esriFieldTypeOID .TextMatrix(iFieldIndex + 1, 1) = pFeature.OID Case esriFieldTypeGeometry 'The function QueryShapeType return a String that ' correspond with the esriGeoemtryType const sShape = QueryShapeType(pField.GeometryDef.GeometryType) .TextMatrix(iFieldIndex + 1, 1) = sShape Case Else .TextMatrix(iFieldIndex + 1, 1) = pFeature.Value(iFieldIndex) End Select Next iFieldIndex End With frmResult.Show modal Exit Sub End If Next iLayerIndex 'If code goes here, no Feature was indentified, clear the MSFlex control's content ' and show a message frmResult.flxAttr.Clear MsgBox "No feature identified." Exit Sub ErrorHandler: MsgBox Err.Description End Sub Public Function QueryShapeType(ByVal enuGeometryType As esriGeometryType) As String Dim sShapeType As String Select Case enuGeometryType Case esriGeometryPolyline sShapeType = "Polyline" Case esriGeometryPolygon sShapeType = "Polygon" Case esriGeometryPoint sShapeType = "Point" Case esriGeometryMultipoint sShapeType = "Multipoint" Case esriGeometryNull sShapeType = "Unknown" Case esriGeometryLine sShapeType = "Line" Case esriGeometryCircularArc sShapeType = "CircularArc" Case esriGeometryEllipticArc sShapeType = "EllipticArc" Case esriGeometryBezier3Curve sShapeType = "BezierCurve" Case esriGeometryPath sShapeType = "Path" Case esriGeometryRing sShapeType = "Ring" Case esriGeometryEnvelope sShapeType = "Envelope" Case esriGeometryAny sShapeType = "Any valid geometry" Case esriGeometryBag sShapeType = "GeometryBag" Case esriGeometryMultiPatch sShapeType = "MultiPatch" Case esriGeometryTriangleStrip sShapeType = "TriangleStrip" Case esriGeometryTriangeFan sShapeType = "TriangleFan" Case esriGeometryRay sShapeType = "Ray" Case esriGeometrySphere sShapeType = "Sphere" Case Else sShapeType = "Unknown!" End Select QueryShapeType = sShapeType End Function 如何利用用户定义的规则创建定制的排序(zz)利用ITableSort接口可以完成普通的对记录排序的功能。ITableSortCallBack机制允许用户通过执行自定义的排序算法来完成定制的排序。本例演示了如何创建这样的用户类，通过实现ITableSortCallBack接口来完成该功能。 假设有如下原始数据：其中“Address”字段描述了道路（Street）的道路编号（Street Number）如“2805”，和道路名(Stree Name)如“Citrus Ave”。 现在要按道路名排序所有的记录。因为排序字段时必须忽略道路编号，故需要自定排序规则。 l 要点 首先需要创建用户自定义的类，并生成其实例。该类实现了ITableSortCallBack接口。然后把它的引用赋给ITableSort的Compare属性。最后用ITableSort的Sort方法完成排序。 l 程序说明 过程UIBCustomSort_Click是实现模块，调用过程CustomSort实现功能。 类模块clsTailSort为自定义模块，实现ITalbeSortCallBack接口。包括两个函数：ITableSortCallBack_Compare（用于定义字符串比较的规则）和Get_String（用于得到地址字段的道路名部分）。 过程CustomSort中创建Tablesort和clsTailSort的实例，并对结果进行排序，然后调用过程CreateTable，将排序后的结果存入C:\temp目录的NewSortTable.dbf文件，并作为独立表加入当前Map。 l 代码 类模块clsTailSort Option Explicit ' Custom class for ITableSortCallBack ' ClassName: clsTailSort Implements ItableSortCallBack Private Function ITableSortCallBack_Compare(ByVal value1 As Variant, ByVal value2 As_ Variant,ByVal FieldIndex As Long, ByVal fieldSortIndex As Long) As Long ' Custom table sort ' Get_string function gets the first block of characters (e.g street numbers) ' in each value. ' Comparison is then made on the remaining characters (e.g. street names). On Error GoTo ErrorHandler value1 = Get_String(value1) value2 = Get_String(value2) If value1 > value2 Then ITableSortCallBack_Compare = 1 ElseIf value1 < value2 Then ITableSortCallBack_Compare = -1 Else: value1 = value2 ITableSortCallBack_Compare = 0 End If Exit Function ErrorHandler: MsgBox Err.Description End Function Private Function Get_String(ByVal sMyStr As Variant) As Variant ' This function gets the tail of the string ' after the first block of characters Dim sFindString As String Dim nPosition As Integer Dim nStringLen As Integer On Error GoTo ErrorHandler nStringLen = Len(sMyStr) nPosition = 1 Do Until nPosition = nStringLen sFindString = Mid(sMyStr, nPosition, 1) If sFindString = " " Then Exit Do End If nPosition = nPosition + 1 Loop Get_String = Mid(sMyStr, nPosition + 1) Exit Function ErrorHandler: MsgBox Err.Description End Function 功能模块 Option Explicit Private pMxDocument As IMxDocument Private pMap As IMap Private pApplication As IApplication Public Sub CustomSort() Dim pSelectedItem As IUnknown Dim pStandaloneTable As IStandaloneTable Dim pTable As ITable Dim pTableSort As ITableSort Dim pTableSortCallBack As ITableSortCallBack Dim pCursor As ICursor Dim pRow As IRow
On Error GoTo ErrorHandler
Set pMxDocument = ThisDocument Set pMap = pMxDocument.FocusMap Set pApplication = Application Set pSelectedItem = pMxDocument.SelectedItem
If pSelectedItem Is Nothing Then MsgBox "Nothing selectd.", vbExclamation Exit Sub ' If a table is selected ElseIf Not TypeOf pSelectedItem Is IStandaloneTable Then MsgBox "No table selectd.", vbExclamation Exit Sub Else Set pStandaloneTable = New esriCore.StandaloneTable Set pStandaloneTable = pSelectedItem End If
Set pTable = pStandaloneTable.Table
' Create a new custom TableSortCallBack and TableSort object ' Class clsTailSort defined in Class Modules Set pTableSortCallBack = New clsTailSort Set pTableSort = New TableSort
' Set up the parameters for the sort and excute With pTableSort .Fields = "Address" .Ascending("Address") = True .CaseSensitive("Address") = True Set .Table = pTable Set .Compare = pTableSortCallBack End With pTableSort.Sort Nothing
' Create a new cursor object to hold the sorted rows Set pCursor = pTableSort.Rows
' Create a new sorted table Call CreateTable(pTable, pCursor)
Set pTableSortCallBack = Nothing Set pTableSort = Nothing
Exit Sub ErrorHandler: MsgBox Err.Description End Sub Public Sub CreateTable(pTab As ITable, pCur As ICursor) ' Create a new .dbf file of the sorted data Dim pWorkspaceFactory As IWorkspaceFactory Dim pFeatureWorkspace As IFeatureWorkspace Dim pWorkspace As IWorkspace Dim pDatasetWkSp As IDataset Dim pWorkspaceName As IWorkspaceName Dim pDatasetNameOut As IDatasetName Dim pFields As IFields Dim pFields2 As esriCore.IFields Dim pDataset As IDataset Dim pDatasetName As IDatasetName Dim pDS As IDataset Dim pEnumDS As IEnumDataset
Dim pStandaloneTable2 As IStandaloneTable Dim pTable2 As ITable Dim pTableNew As ITable Dim pCursor2 As ICursor Dim pRowBuffer As IRowBuffer Dim pRow As IRow Dim pName As IName Dim pStandaloneTable As IStandaloneTable Dim pStandaloneTableC As IStandaloneTableCollection
Dim j As Integer Dim i As Integer
On Error GoTo ErrorHandler
' Get the dataset name for the input table Set pDataset = pTab Set pDatasetName = pDataset.FullName
' Set the output dataset name. ' New .dbf file will be created in c:\temp Set pFields = pTab.Fields Set pWorkspaceFactory = New ShapefileWorkspaceFactory Set pWorkspace = pWorkspaceFactory.OpenFromFile("c:\temp", 0) Set pFeatureWorkspace = pWorkspace Set pDatasetWkSp = pWorkspace Set pWorkspaceName = pDatasetWkSp.FullName Set pDatasetNameOut = New TableName pDatasetNameOut.Name = "NewSortTable" Set pDatasetNameOut.WorkspaceName = pWorkspaceName
' Check if .dbf file already exist: if yes, delete it Set pEnumDS = pWorkspace.Datasets(esriDTTable) Set pDS = pEnumDS.Next Do Until pDS Is Nothing If pDS.Name = pDatasetNameOut.Name Then pDS.Delete Exit Do End If Set pDS = pEnumDS.Next Loop ' Create a new .dbf table pFeatureWorkspace.CreateTable pDatasetNameOut.Name, pFields, Nothing, Nothing, ""
' Create a new stand alone table object to represent the .dbf table Set pStandaloneTable2 = New StandaloneTable Set pStandaloneTable2.Table = pFeatureWorkspace.OpenTable(pDatasetNameOut.Name) Set pTable2 = pStandaloneTable2.Table Set pFields2 = pTable2.Fields
' Open an insert cursor on the new table Set pCursor2 = pTable2.Insert(True)
' Create a row buffer for the row inserts Set pRowBuffer = pTable2.CreateRowBuffer
' Loop through the sorted cursor and write to new table For j = 0 To pTab.RowCount(Nothing) - 1 Set pRow = pCur.NextRow If Not pRow Is Nothing Then i = 1 Do Until i = pFields2.FieldCount If Not IsEmpty(pRow.Value(i)) Then If pFields.Field(i).Editable Then pRowBuffer.Value(i) = pRow.Value(i) End If End If i = i + 1 Loop pCursor2.InsertRow pRowBuffer End If Next j
' Add the new sorted table to map document Set pName = pDatasetNameOut Set pTableNew = pName.Open Set pStandaloneTable = New StandaloneTable Set pStandaloneTable.Table = pTableNew Set pStandaloneTableC = pMap pStandaloneTableC.AddStandaloneTable pStandaloneTable pMxDocument.UpdateContents Exit Sub ErrorHandler: MsgBox Err.Description End Sub 如何为当前层或独立表创建一个Summary表(zz)本例要实现的是如何按某一字段“分组”（dissolve）,统计其它字段的数据信息摘要（创建Summary表）。可得到的主要信息包括该字段值相同的每组记录中的记录数量、最大值、最小值、和、平均值等。主要用到IBasicGeoprocessor接口的Dissolve方法。 l 要点 为当前层创建Summary表，要得到当前层的引用，并确定在其上执行Dissolve操作的字段。对独立表的操作方法与层的操作类似。 l 程序说明 过程UIBCreateSummaryTable_Click是实现模块，调用过程CreateSummaryTable实现功能。过程CreateSummaryTable中应先确认层（例中为states）和要“Dissolve”的字段（例中为SUB_REGION）存在，同时要定义摘要表的名字（本例为SumStates）。 然后指定执行Dissolve方法的操作符（如Minimum,Count,Average等）和在其上施行操作的字段名（例中为AREA）。操作结果作为独立表添加到当前Map。 因为Dissolve方法参数表中的“输入表”和“输出数据集的名字”都是引用，为了避免多次调用过程使最终SumStates表中的结果不唯一，每次执行Dissolve前，将SumStates的已存内容删除。 l 代码 Private Sub UIBCreateSummaryTable_Click() Call CreateSummaryTable End Sub Public Sub CreateSummaryTable() Dim pMxDocument As IMxDocument Dim pMap As IMap Dim pLayer As ILayer Dim pFeatLayer As IFeatureLayer Dim iCount As Integer Dim pFeatureClass As IFeatureClass Dim pTable As ITable Dim pDataSet As IDataset Dim pWorkspace As IWorkspace Dim pWorkspaceDataset As IDataset Dim pWorkspaceName As IName Dim pOutTableName As ITableName Dim pOutDatasetName As IDatasetName Dim pEnumDataset As IEnumDataset Dim pBasicGeoprocessor As IBasicGeoprocessor Dim pSumTable As ITable Dim pStandaloneTable As IStandaloneTable Dim pStandaloneTableColl As IStandaloneTableCollection ' Define current layer name and output table name Const sLayerName As String = "states" Const sSumTableName As String = "SumStates" Set pMxDocument = ThisDocument Set pMap = pMxDocument.FocusMap On Error GoTo ErrorHandler Set pMxDocument = ThisDocument Set pMap = pMxDocument.FocusMap On Error GoTo ErrorHandler ' Find the layer named states For iCount = 0 To pMap.LayerCount - 1 Set pLayer = pMap.Layer(iCount) If TypeOf pLayer Is IFeatureLayer Then If pLayer.Name = sLayerName Then Set pFeatLayer = pLayer Exit For End If End If Next If pFeatLayer Is Nothing Then MsgBox "The " & sLayerName & " layer was not found" Exit Sub End If ' Get the workspace of the states layer Set pFeatureClass = pFeatLayer.FeatureClass Set pTable = pFeatureClass Set pDataSet = pTable Set pWorkspace = pDataSet.Workspace Set pWorkspaceDataset = pWorkspace Set pWorkspaceName = pWorkspaceDataset.FullName ' Set up the output table Set pOutTableName = New TableName Set pOutDatasetName = pOutTableName pOutDatasetName.Name = sSumTableName Set pOutDatasetName.WorkspaceName = pWorkspaceName ' Make sure there is a field called SUB_REGION in the layer If pTable.FindField("SUB_REGION") = -1 Then MsgBox "There must be a field named SUB_REGION in states" Exit Sub End If ' Check if SumStates.dbf file already exist: if yes, delete it Set pEnumDataset = pWorkspace.Datasets(esriDTTable) Set pWorkspaceDataset = pEnumDataset.Next Do Until pWorkspaceDataset Is Nothing If pWorkspaceDataset.Name = pOutDatasetName.Name Then pWorkspaceDataset.Delete Exit Do End If Set pWorkspaceDataset = pEnumDataset.Next Loop ' Perform the summarize. Note the summary fields string (minimum.SUB_REGION ...) ' below. This is a comma-delimited string that lists the generated summary ' fields. Each field must start with a keyword, and be followed by .fieldName, ' where fieldName is the name of a field in the original table. ' ' If you specify the Shape field, you must use the keyword 'Dissolve'. This ' is not used below since we are creating a non-spatial summary table. Set pBasicGeoprocessor = New BasicGeoprocessor Set pSumTable = pBasicGeoprocessor.Dissolve(pTable, False, "SUB_REGION", _ "Minimum.SUB_REGION, Count.SUB_REGION, Sum.AREA, Average.AREA," & _ "Minimum.AREA, Maximum.AREA, StdDev.AREA, Variance.AREA", _ pOutDatasetName) ' add the table to map Set pStandaloneTable = New StandaloneTable Set pStandaloneTable.Table = pSumTable Set pStandaloneTableColl = pMap pStandaloneTableColl.AddStandaloneTable pStandaloneTable ' Refresh the TOC pMxDocument.UpdateContents Exit Sub ErrorHandler: MsgBox Err.Number & " " & Err.Description End Sub 如何拷贝属性表中的一行(zz)本例要实现的是如何将所有属性表（Attribute Table）中的行拷贝到Windows剪贴板，使用户能使用文本编辑器等软件对选中的数据做进一步编辑，从而满足特殊要求。行中的每个属性用半角字符的逗号“,”分隔，行间用换行符分隔。 l 要点 首先需要取得某属性表中的所有选中记录的全部属性，以一个字符串来存储。因为在属性表中选取中记录（Row）后，层中的相应记录（Feature）也将选中。两种途径都能获得所需属性值。 得到所需的字符串sResult后，就可以将其拷贝到剪贴板。在VB中剪贴板是全局对象。可像如下使用： Clipboard.Clear Clipboard.SetText sResult 本例将在VBA中实现相同的功能。用到了IGraphicsContianer、IGraphicsContainerSelect、ITextElement、IElement、IClipboardFormat接口。 l 程序说明 过程UIBCopyRow_Click是实现模块，调用过程CopyRow实现功能。过程CopyRow将选中行的全部属性值（忽略Shape属性）连接成字符串，然后创建TextElement对象，并添加到IGraphicsContainer对象的选择集中，再调用TextClipboardFormat的Copy方法，把字符拷贝到Windows剪贴板。 l 代码 Option Explicit Private Sub UIBCopyRow_Click() Call CopyRow End Sub Public Sub CopyRow() Dim pMxDocument As IMxDocument Dim pMap As IMap Dim pActiveView As IActiveView Dim pGraphicsContainer As IGraphicsContainer Dim pGraphicsContainerS As IGraphicsContainerSelect Dim pFields As IFields Dim iCounter As Integer Dim iIndex As Integer Dim pTextElement As ITextElement Dim pElement As IElement Dim sResult As String Dim pEnumFeature As IEnumFeature Dim pEnumFeatureS As IEnumFeatureSetup Dim pFeature As IFeature Dim pClipboardFormat As IClipboardFormat On Error GoTo ErrorHandler ' Used for string operation on the clipboard Set pClipboardFormat = New TextClipboardFormat Set pMxDocument = ThisDocument Set pActiveView = pMxDocument.ActivatedView Set pMap = pMxDocument.FocusMap Set pGraphicsContainer = pMap ' Get selected features to retieve their attribute values Set pEnumFeature = pMap.FeatureSelection Set pEnumFeatureS = pEnumFeature pEnumFeatureS.AllFields = True Set pFeature = pEnumFeature.Next If pFeature Is Nothing Then MsgBox "No row selected" Exit Sub End If Set pFields = pFeature.Fields iCounter = pFields.FieldCount Do Until pFeature Is Nothing For iIndex = 0 To iCounter - 1 If Not TypeOf pFeature.Value(iIndex) Is IGeometry Then sResult = sResult & pFeature.Value(iIndex) & "," End If Next iIndex ' Remove the trailing comma sResult = Left(sResult, Len(sResult) - 1) sResult = sResult & vbNewLine Set pFeature = pEnumFeature.Next Loop ' If you're tending to build a dll to implement the same function and ' programming in VB enviroment, simply use the next to statement ' to copy the string into windows clippboard ' Clipboard.Clear ' Clipboard.SetText sResult ' Otherwise, programe as follows ' Copy the string into clippboard using objects included in esriCore
' To clear clippboard pClipboardFormat.Paste pMxDocument pGraphicsContainer.DeleteAllElements ' Construct a new TextElement with the string to copy into clipboard Set pTextElement = New TextElement pTextElement.Text = sResult Set pElement = pTextElement ' Point(100, 100) is for temporary use pElement.Geometry = pActiveView.ScreenDisplay.DisplayTransformation _ .ToMapPoint(100, 100) Set pGraphicsContainer = pMap pGraphicsContainer.AddElement pElement, 0 Set pGraphicsContainerS = pGraphicsContainer pGraphicsContainerS.UnselectAllElements pGraphicsContainerS.SelectElement pElement pClipboardFormat.copy pMxDocument pGraphicsContainerS.UnselectElement pElement pGraphicsContainer.DeleteElement pElement pActiveView.Refresh Exit Sub ErrorHandler: MsgBox Err.Description End Sub 如何打开选中的层或独立表的属性窗口 (zz)本例实现的是如何打开选中的层或独立表的属性窗口（Attribute Table）。主要用到ITableWindow和ITableWindow2接口。 l 要点 首先需要选中一个层或独立表。可在UI Button Cotrol的Enabled事件中测试用户选定了有效的对象后，才使按钮有效。 然后判断属性窗口是否已经打开。如果尚未打开，则创建新的ITableView2对象。 l 程序说明 过程UIBAttributeWindow_Click调用过程OpenAttribWnd实现功能。 函数UIBAttributeWindow_Enabled用来测试用户是否已正确选中了层或独立表，如果是，则使按钮有效。 过程OpenAttribWnd是功能模块，实现了属性窗口的测试和创建，以及显示。 l 代码 Option Explicit Private Sub UIBAttributeWindow_Click() Call OpenAttribWnd End Sub Private Function UIBAttributeWindow_Enabled() As Boolean Dim pMxDocument As IMxDocument Dim pSelectedItem As IUnknown Dim bEnabled As Boolean Set pMxDocument = ThisDocument Set pSelectedItem = pMxDocument.SelectedItem bEnabled = True ' Disable if the selected item is nothing or if ' it is not a layer or table If pSelectedItem Is Nothing Then bEnabled = False ElseIf (TypeOf pSelectedItem Is IFeatureLayer) Or (TypeOf pSelectedItem Is IStandaloneTable) Then bEnabled = True End If UIBAttributeWindow_Enabled = bEnabled End Function Private Sub OpenAttribWnd() Dim pMxDocument As IMxDocument Dim pLayer As ILayer Dim pStandaloneTable As IStandaloneTable Dim pSelectedItem As IUnknown Dim pTableWindowExist As ITableWindow Dim pTableWindow2 As ITableWindow2 Dim bSetProperties As Boolean On Error GoTo ErrorHandler: Set pMxDocument = ThisDocument Set pSelectedItem = pMxDocument.SelectedItem Set pTableWindow2 = New TableWindow ' Determine the selected item's type ' Exit sub if item is not a feature layer or standalone table If TypeOf pSelectedItem Is IFeatureLayer Then Set pLayer = pSelectedItem Set pTableWindowExist = pTableWindow2.FindViaLayer(pLayer) ' Check if a table already exist; if not create one If pTableWindowExist Is Nothing Then Set pTableWindow2.Layer = pLayer bSetProperties = True End If ElseIf TypeOf pSelectedItem Is IStandaloneTable Then Set pStandaloneTable = pSelectedItem Set pTableWindowExist = pTableWindow2.FindViaStandaloneTable(pStandaloneTable) ' Check if a table already exists; if not, create one If pTableWindowExist Is Nothing Then Set pTableWindow2.StandaloneTable = pStandaloneTable bSetProperties = True End If End If If bSetProperties Then pTableWindow2.TableSelectionAction = esriSelectFeatures pTableWindow2.ShowSelected = False pTableWindow2.ShowAliasNamesInColumnHeadings = True Set pTableWindow2.Application = Application Else Set pTableWindow2 = pTableWindowExist End If ' Ensure Table Is Visible If Not pTableWindow2.IsVisible Then pTableWindow2.Show True End If Exit Sub ErrorHandler: MsgBox Err.Description End Sub 如何将Map中显示的图形转化成栅格文件(zz)本例要实现的是如何将当前激活的Map中显示的图形转化成栅格文件。 l 要点 通过IMap实例获得IActiveView接口对象，定义IExporter接口变量，使用TiffExporter实现该接口并对其中的属性进行赋值，使用IActiveView.Output方法将Map中显示的图形导出。 主要用到IActiveView接口，IExporter接口和IEnvelope接口。 l 程序说明 函数Output将当前激活的Map中显示的图形转化成栅格文件，栅格文件路径及名称由参数sFileAllName确定。 l 代码
Private Sub Output(ByVal sFileAllName As String) Dim pMxDocument As IMxDocument Dim pActiveView As IActiveView Dim pExporter As IExporter Dim pEnvelope As IEnvelope Dim ptagRECT As tagRECT Dim pTrackCancel As ITrackCancel Dim lscreenResolution As Long On Error GoTo ErrorHandler: Set pMxDocument = ThisDocument Set pActiveView = pMxDocument.ActiveView lscreenResolution = pActiveView.ScreenDisplay.DisplayTransformation.Resolution ptagRECT.Top = 0 ptagRECT.Left = 0 ptagRECT.Right = pActiveView.Extent.Width ptagRECT.bottom = pActiveView.Extent.Height 'We must calculate the size of the user specified Rectangle in Device units 'Hence convert width and height Set pEnvelope = New Envelope pEnvelope.PutCoords ptagRECT.Left, ptagRECT.bottom, ptagRECT.Right, ptagRECT.Top Set pExporter = New TiffExporter pExporter.Resolution = lscreenResolution pExporter.ExportFileName = sFileAllName pExporter.PixelBounds = pEnvelope Set pTrackCancel = New CancelTracker pActiveView.Output pExporter.StartExporting, lscreenResolution, _ ptagRECT, pActiveView.Extent, pTrackCancel
pExporter.FinishExporting Exit Sub ErrorHandler: MsgBox Err.Description End Sub Private Sub UIButtonControl1_Click() Dim pVBProject As VBProject On Error GoTo ErrorHandler: Set pVBProject = ThisDocument.VBProject Output pVBProject.FileName & "\..\..\..\.." & "\data\MyTifFile.tif" Exit Sub ErrorHandler: MsgBox Err.Description End Sub 如何将shape文件转化成GeoDataBase(各种文件格式的转换)(zz)本例演示的是如何将shape文件转化成personal GeoDatabase文件，其它格式间的与此转换类似。主要用到IFeatureDataConverter接口的ConvertFeatureClass方法。 l 要点 首先，创建新的GeoDataBase数据库，并创建IFeatureDatasetName对象。创建定义两个IFeatureClassName接口对象分别引用输入表（shape文件）和输出表。 然后设置输出表的Shape字段的GeormetryDef属性。这一步非常关键，因为其中包含了数据库和shape文件的空间参考信息。 最后调用IFeatureDataConverter.ConvertFeatureClass方法完成功能。 l 程序说明 过程UIBConvert_Click是实现模块，调用过程ConvertShapeToGeodatabase实现功能。 sDataPath定义了数据与工程文件的相对路径。SHAPE_NAME描述了要转化的shape文件的文件名。MDB_NAME和F_DS_NAME分别描述了Access数据库名和库的数据集的名称。 l 代码 Option Explicit Private Sub UIBConvert_Click() Call ConvertShapeToGeodatabase End Sub Private Sub ConvertShapeToGeodatabase() Dim pOutWorkspaceFactory As IWorkspaceFactory Dim pOutWorkspaceName As IWorkspaceName Dim pInWorkspaceName As IWorkspaceName Dim pOutFeatureDSName As IFeatureDatasetName Dim pOutDSName As IDatasetName Dim pInFeatureClassName As IFeatureClassName Dim pInDatasetName As IDatasetName Dim pOutFeatureClassName As IFeatureClassName Dim pOutDatasetName As IDatasetName Dim iCounter As Long Dim pOutFields As IFields Dim pInFields As IFields Dim pFieldChecker As IFieldChecker Dim pGeoField As IField Dim pOutGeometryDef As IGeometryDef Dim pOutGeometryDefEdit As IGeometryDefEdit Dim pName As IName Dim pInFeatureClass As IFeatureClass Dim pShpToFeatClsConverter As IFeatureDataConverter Dim pVBProject As VBProject Dim sDataPath As String Const SHAPE_NAME As String = "country" Const MDB_NAME As String = "countryDB" Const F_DS_NAME As String = "World" On Error GoTo ErrorHandler Set pVBProject = ThisDocument.VBProject sDataPath = pVBProject.FileName & "\..\..\..\..\data\" If Not "" = Dir(sDataPath & MDB_NAME & ".mdb") Then MsgBox MDB_NAME & ".mdb already exist" Exit Sub Else ' Create a new Access database Set pOutWorkspaceFactory = New AccessWorkspaceFactory Set pOutWorkspaceName = pOutWorkspaceFactory.Create(sDataPath, MDB_NAME, Nothing, 0) ' create a new feature datset name object for the output Access feature dataset, call ' it "World" Set pOutFeatureDSName = New FeatureDatasetName Set pOutDSName = pOutFeatureDSName Set pOutDSName.WorkspaceName = pOutWorkspaceName pOutDSName.Name = F_DS_NAME ' Get the name object for the input shapefile workspace Set pInWorkspaceName = New WorkspaceName pInWorkspaceName.PathName = sDataPath pInWorkspaceName.WorkspaceFactoryProgID = _ "esriCore.ShapefileWorkspaceFactory.1" Set pInFeatureClassName = New FeatureClassName Set pInDatasetName = pInFeatureClassName pInDatasetName.Name = SHAPE_NAME Set pInDatasetName.WorkspaceName = pInWorkspaceName ' Create the new output FeatureClass name object that will be passed ' into the conversion function Set pOutFeatureClassName = New FeatureClassName Set pOutDatasetName = pOutFeatureClassName ' Set the new FeatureClass name to be the same as the input FeatureClass name pOutDatasetName.Name = pInDatasetName.Name ' Open the input Shapefile FeatureClass object, so that we can get its fields Set pName = pInFeatureClassName Set pInFeatureClass = pName.Open ' Get the fields for the input feature class and run them through ' field checker to make sure there are no illegal or duplicate field names Set pInFields = pInFeatureClass.Fields Set pFieldChecker = New FieldChecker pFieldChecker.Validate pInFields, Nothing, pOutFields ' Loop through the output fields to find the geometry field For iCounter = 0 To pOutFields.FieldCount If pOutFields.Field(iCounter).Type = esriFieldTypeGeometry Then Set pGeoField = pOutFields.Field(iCounter) Exit For End If Next iCounter ' Get the geometry field's geometry definition Set pOutGeometryDef = pGeoField.GeometryDef ' Give the geometry definition a spatial index grid count and grid size Set pOutGeometryDefEdit = pOutGeometryDef pOutGeometryDefEdit.GridCount = 1 pOutGeometryDefEdit.GridSize(0) = 1500000 ' Now use IFeatureDataConverter::Convert to create the output FeatureDataset and ' FeatureClass. Set pShpToFeatClsConverter = New FeatureDataConverter pShpToFeatClsConverter.ConvertFeatureClass pInFeatureClassName, Nothing, _pOutFeatureDSName, pOutFeatureClassName, Nothing, pOutFields, "", 1000, 0 End If Exit Sub ErrorHandler: MsgBox Err.Description End Sub |
|
|
