You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
240 lines
11 KiB
240 lines
11 KiB
7 years ago
|
{
|
||
|
|
/******************************************************************************
|
||
|
|
* $Id: ShapeFileII.pas,v 1.4 2016-12-05 12:44:07 erouault Exp $
|
||
|
|
*
|
||
|
|
* Project: Shapelib
|
||
|
|
* Purpose: Delphi Pascal interface to Shapelib.
|
||
|
|
* Author: Kevin Meyer (Kevin@CyberTracker.co.za)
|
||
|
|
*
|
||
|
|
******************************************************************************
|
||
|
|
* Copyright (c) 2002, Keven Meyer (Kevin@CyberTracker.co.za)
|
||
|
|
*
|
||
|
|
* This software is available under the following "MIT Style" license,
|
||
|
|
* or at the option of the licensee under the LGPL (see COPYING). This
|
||
|
|
* option is discussed in more detail in shapelib.html.
|
||
|
|
*
|
||
|
|
* --
|
||
|
|
*
|
||
|
|
* Permission is hereby granted, free of charge, to any person obtaining a
|
||
|
|
* copy of this software and associated documentation files (the "Software"),
|
||
|
|
* to deal in the Software without restriction, including without limitation
|
||
|
|
* the rights to use, copy, modify, merge, publish, distribute, sublicense,
|
||
|
|
* and/or sell copies of the Software, and to permit persons to whom the
|
||
|
|
* Software is furnished to do so, subject to the following conditions:
|
||
|
|
*
|
||
|
|
* The above copyright notice and this permission notice shall be included
|
||
|
|
* in all copies or substantial portions of the Software.
|
||
|
|
*
|
||
|
|
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
|
||
|
|
* OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||
|
|
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
|
||
|
|
* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||
|
|
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||
|
|
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
|
||
|
|
* DEALINGS IN THE SOFTWARE.
|
||
|
|
******************************************************************************
|
||
|
|
*
|
||
|
|
* $Log: ShapeFileII.pas,v $
|
||
|
|
* Revision 1.4 2016-12-05 12:44:07 erouault
|
||
|
|
* * Major overhaul of Makefile build system to use autoconf/automake.
|
||
|
|
*
|
||
|
|
* * Warning fixes in contrib/
|
||
|
|
*
|
||
|
|
* Revision 1.3 2003-05-14 20:04:51 warmerda
|
||
|
|
* Changed fpSHP and fpSHX to integer at suggestion of Ivan Lucena.
|
||
|
|
*
|
||
|
|
* Revision 1.2 2002/01/21 14:09:26 warmerda
|
||
|
|
* Fixed name.
|
||
|
|
*
|
||
|
|
* Revision 1.1 2002/01/17 14:30:37 warmerda
|
||
|
|
* New
|
||
|
|
*
|
||
|
|
*/
|
||
|
|
}
|
||
|
|
unit ShapeFileII;
|
||
|
|
|
||
|
|
interface
|
||
|
|
//uses { uses clause }
|
||
|
|
// ;
|
||
|
|
{ Set compiler to pack on byte boundaries only }
|
||
|
|
{$ALIGN OFF}
|
||
|
|
{$OVERFLOWCHECKS OFF}
|
||
|
|
{$J-}
|
||
|
|
const
|
||
|
|
SHPT_NULL = 0;
|
||
|
|
SHPT_POINT = 1;
|
||
|
|
SHPT_ARC = 3;
|
||
|
|
SHPT_POLYGON = 5;
|
||
|
|
SHPT_MULTIPOINT = 8;
|
||
|
|
SHPT_POINTZ = 11;
|
||
|
|
SHPT_ARCZ = 13;
|
||
|
|
SHPT_POLYGONZ = 15;
|
||
|
|
SHPT_MULTIPOINTZ = 18;
|
||
|
|
SHPT_POINTM = 21;
|
||
|
|
SHPT_ARCM = 23;
|
||
|
|
SHPT_POLYGONM = 25;
|
||
|
|
SHPT_MULTIPOINTM = 28;
|
||
|
|
SHPT_MULTIPATCH = 31;
|
||
|
|
XBASE_FLDHDR_SZ = 32;
|
||
|
|
szAccessBRW = 'rb+';
|
||
|
|
|
||
|
|
// *********************** SHP support ************************
|
||
|
|
|
||
|
|
type
|
||
|
|
SHPObject = record
|
||
|
|
nSHPType,
|
||
|
|
nShapeId,
|
||
|
|
nParts : LongWord;
|
||
|
|
panPartStart,
|
||
|
|
panPartType : array of LongWord;
|
||
|
|
nVertices : LongWord;
|
||
|
|
padfX, padfY, padfZ, padfM : array of double;
|
||
|
|
dfXMin, dfYMin, dfZMin, dfMMin : double;
|
||
|
|
dfXMax, dfYMax, dfZMax, dfMMax : double;
|
||
|
|
end;
|
||
|
|
SHPObjectHandle = ^SHPObject;
|
||
|
|
|
||
|
|
SHPBoundsArr = double;
|
||
|
|
|
||
|
|
SHPInfo = record
|
||
|
|
fpSHP,
|
||
|
|
fpSHX : integer;
|
||
|
|
|
||
|
|
nShapeType,
|
||
|
|
nFileSize,
|
||
|
|
nRecords,
|
||
|
|
nMaxRecords : LongWord;
|
||
|
|
panRecOffset,
|
||
|
|
panRecSize : array of LongWord;
|
||
|
|
adBoundsMin, adBoundsMax : SHPBoundsArr;
|
||
|
|
bUpdated : LongWord;
|
||
|
|
end;
|
||
|
|
SHPHandle = ^SHPInfo;
|
||
|
|
|
||
|
|
// *********************** DBF support ************************
|
||
|
|
|
||
|
|
DBFInfo = record
|
||
|
|
fp : FILE;
|
||
|
|
nRecords,
|
||
|
|
nRecordLength,
|
||
|
|
nHeaderLength,
|
||
|
|
nFields : LongWord;
|
||
|
|
|
||
|
|
panFieldOffset,
|
||
|
|
panFieldSize,
|
||
|
|
panFieldDecimals : array of LongWord;
|
||
|
|
|
||
|
|
pachFieldType : LongWord;
|
||
|
|
pszHeader : PChar;
|
||
|
|
nCurrentRecord,
|
||
|
|
bCurrentRecordModified : LongWord;
|
||
|
|
pszCurrentRecord : PChar;
|
||
|
|
|
||
|
|
bNoHeader,
|
||
|
|
bUpdated : LongWord;
|
||
|
|
end;
|
||
|
|
DBFHandle = ^DBFInfo;
|
||
|
|
|
||
|
|
DBFFieldType = (DBFTString, DBFTInteger, DBFTDouble, DBFTInvalid) ;
|
||
|
|
|
||
|
|
// *********************** SHP func declarations ************************
|
||
|
|
|
||
|
|
{$ALIGN ON}
|
||
|
|
|
||
|
|
function SHPOpen(pszShapeFile, pszAccess : PChar) : SHPHandle;cdecl;
|
||
|
|
procedure SHPGetInfo(hSHP : SHPHandle; var pnEntities, pnShapeType : LongWord; var padfMinBoud, padfMaxBound : SHPBoundsArr);cdecl;
|
||
|
|
procedure SHPClose(hSHP : SHPHandle);cdecl;
|
||
|
|
function SHPReadObject(hSHP : SHPHandle; iShape : LongWord): SHPObjectHandle;cdecl;
|
||
|
|
function SHPCreate(pszShapeFile : PChar; nShapeType : LongWord):SHPHandle;cdecl;
|
||
|
|
function SHPWriteObject(hSHP : SHPHandle; iShape : LongWord; psObject : SHPObjectHandle): LongWord;cdecl;
|
||
|
|
function SHPCreateSimpleObject(nSHPType, nVertices : LongWord; var padfX, padfY, padfZ : double):SHPObjectHandle;cdecl;
|
||
|
|
procedure SHPDestroy(psObject : SHPObjectHandle);cdecl;
|
||
|
|
|
||
|
|
procedure SHPComputeExtents(psObject : SHPObjectHandle);cdecl;
|
||
|
|
function SHPCreateObject(nSHPType, iShape, nParts : LongWord; var panPartStart, panPartType : LongWord; nVertices : LongWord; var padfX, padfY, padfZ, padfM : SHPBoundsArr): SHPObjectHandle;cdecl;
|
||
|
|
|
||
|
|
function SHPTypeStr(pnShapeType : LongWord): string;
|
||
|
|
|
||
|
|
// *********************** DBF func declarations ************************
|
||
|
|
|
||
|
|
function DBFOpen(pszDBFFile, pszAccess : PChar): DBFHandle;cdecl;
|
||
|
|
function DBFCreate(pszDBFFile : PChar): DBFHandle ;cdecl;
|
||
|
|
function DBFGetFieldCount(hDBF : DBFHandle) : LongWord ;cdecl;
|
||
|
|
function DBFGetRecordCount(hDBF : DBFHandle) : LongWord;cdecl;
|
||
|
|
function DBFGetFieldIndex(hDBF: DBFHandle; pszFieldName : PChar): LongWord;cdecl;
|
||
|
|
function DBFGetFieldInfo(hDBF : DBFHandle; iField : LongWord; pszFieldName : PChar;
|
||
|
|
var pnWidth, pnDecimals : LongWord): DBFFieldType;cdecl;
|
||
|
|
function DBFAddField(hDBF : DBFHandle; pszFieldName : PChar;
|
||
|
|
eType : DBFFieldType; nWidth, nDecimals : LongWord): LongWord;cdecl;
|
||
|
|
|
||
|
|
function DBFReadIntegerAttribute(hDBF : DBFHandle;iShape, iField : LongWord ): LongWord;cdecl;
|
||
|
|
function DBFReadDoubleAttribute(hDBF : DBFHandle; iShape, iField : LongWord ):double;cdecl;
|
||
|
|
function DBFReadStringAttribute(hDBF : DBFHandle; iShape, iField : LongWord ) : pchar;cdecl;
|
||
|
|
function DBFIsAttributeNULL(hDBF : DBFHandle; iShape, iField : LongWord ): LongWord;cdecl;
|
||
|
|
function DBFWriteIntegerAttribute(hDBF : DBFHandle;iShape, iField, nFieldValue : LongWord): LongWord;cdecl;
|
||
|
|
function DBFWriteDoubleAttribute(hDBF : DBFHandle;iShape, iField : LongWord;
|
||
|
|
dFieldValue : double): LongWord ;cdecl;
|
||
|
|
function DBFWriteStringAttribute(hDBF : DBFHandle;iShape, iField : LongWord;
|
||
|
|
pszFieldValue : PChar): LongWord ;cdecl;
|
||
|
|
function DBFWriteNULLAttribute(hDBF : DBFHandle; iShape, iField : LongWord ) : LongWord;cdecl;
|
||
|
|
procedure DBFClose(hDBF : DBFHandle);cdecl;
|
||
|
|
function DBFGetNativeFieldType(hDBF : DBFHandle; iField : LongWord) : Char;cdecl;
|
||
|
|
|
||
|
|
// *********************** SHP implementation ************************
|
||
|
|
implementation
|
||
|
|
// *****************************************************************************
|
||
|
|
function SHPCreateSimpleObject(nSHPType, nVertices : LongWord; var padfX, padfY, padfZ : double):SHPObjectHandle;external 'shapelib.dll' name 'SHPCreateSimpleObject';
|
||
|
|
function SHPOpen(pszShapeFile, pszAccess : PChar) : SHPHandle; external 'shapelib.dll' name 'SHPOpen';
|
||
|
|
procedure SHPGetInfo(hSHP : SHPHandle; var pnEntities, pnShapeType : LongWord; var padfMinBoud, padfMaxBound : SHPBoundsArr);external 'shapelib.dll' name 'SHPGetInfo';
|
||
|
|
procedure SHPClose(hSHP : SHPHandle);external 'shapelib.dll' name 'SHPClose';
|
||
|
|
function SHPReadObject(hSHP : SHPHandle; iShape : LongWord) : SHPObjectHandle;external 'shapelib.dll' name 'SHPReadObject';
|
||
|
|
function SHPCreate(pszShapeFile : PChar; nShapeType : LongWord):SHPHandle;external 'shapelib.dll' name 'SHPCreate';
|
||
|
|
function SHPWriteObject(hSHP : SHPHandle; iShape : LongWord; psObject : SHPObjectHandle): LongWord;cdecl;external 'shapelib.dll' name 'SHPWriteObject';
|
||
|
|
procedure SHPDestroy(psObject : SHPObjectHandle);external 'shapelib.dll' name 'SHPDestroyObject';
|
||
|
|
procedure SHPComputeExtents(psObject : SHPObjectHandle);external 'shapelib.dll' name 'SHPComputeExtents';
|
||
|
|
function SHPCreateObject(nSHPType, iShape, nParts : LongWord; var panPartStart, panPartType : LongWord; nVertices : LongWord; var padfX, padfY, padfZ, padfM : SHPBoundsArr): SHPObjectHandle;external 'shapelib.dll' name 'SHPCreateObject';
|
||
|
|
// *****************************************************************************
|
||
|
|
function SHPTypeStr(pnShapeType : LongWord): string;
|
||
|
|
begin
|
||
|
|
case pnShapeType of
|
||
|
|
SHPT_NULL : result := 'NULL';
|
||
|
|
SHPT_POINT : result := 'POINT';
|
||
|
|
SHPT_ARC : result := 'ARC';
|
||
|
|
SHPT_POLYGON : result := 'POLYGON';
|
||
|
|
SHPT_MULTIPOINT : result := 'MULTIPOINT';
|
||
|
|
SHPT_POINTZ : result := 'POINTZ';
|
||
|
|
SHPT_ARCZ : result := 'ARCZ';
|
||
|
|
SHPT_POLYGONZ : result := 'POLYGONZ';
|
||
|
|
SHPT_MULTIPOINTZ : result := 'MULTIPOINTZ';
|
||
|
|
SHPT_POINTM : result := 'POINTM';
|
||
|
|
SHPT_ARCM : result := 'ARCM';
|
||
|
|
SHPT_POLYGONM : result := 'POLYGONM';
|
||
|
|
SHPT_MULTIPOINTM : result := 'MULTIPOINTM';
|
||
|
|
SHPT_MULTIPATCH : result := 'MULTIPATCH';
|
||
|
|
else
|
||
|
|
result := '--unknown--';
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
// *****************************************************************************
|
||
|
|
// *****************************************************************************
|
||
|
|
function DBFOpen(pszDBFFile, pszAccess : PChar): DBFHandle;external 'shapelib.dll';
|
||
|
|
function DBFCreate(pszDBFFile : PChar): DBFHandle ;external 'shapelib.dll';
|
||
|
|
function DBFGetFieldCount(hDBF : DBFHandle) : LongWord ;external 'shapelib.dll';
|
||
|
|
function DBFGetRecordCount(hDBF : DBFHandle) : LongWord;external 'shapelib.dll';
|
||
|
|
function DBFGetFieldIndex(hDBF: DBFHandle; pszFieldName : PChar): LongWord;external 'shapelib.dll';
|
||
|
|
function DBFGetFieldInfo(hDBF : DBFHandle; iField : LongWord; pszFieldName : PChar; var pnWidth, pnDecimals : LongWord): DBFFieldType;external 'shapelib.dll';
|
||
|
|
function DBFAddField(hDBF : DBFHandle; pszFieldName : PChar; eType : DBFFieldType; nWidth, nDecimals : LongWord): LongWord;external 'shapelib.dll';
|
||
|
|
function DBFReadIntegerAttribute(hDBF : DBFHandle;iShape, iField : LongWord ): LongWord;external 'shapelib.dll';
|
||
|
|
function DBFReadDoubleAttribute(hDBF : DBFHandle; iShape, iField : LongWord ):double;external 'shapelib.dll';
|
||
|
|
function DBFReadStringAttribute(hDBF : DBFHandle; iShape, iField : LongWord ) : pchar;external 'shapelib.dll';
|
||
|
|
function DBFIsAttributeNULL(hDBF : DBFHandle; iShape, iField : LongWord ): LongWord;external 'shapelib.dll';
|
||
|
|
function DBFWriteIntegerAttribute(hDBF : DBFHandle;iShape, iField, nFieldValue : LongWord): LongWord;external 'shapelib.dll';
|
||
|
|
function DBFWriteDoubleAttribute(hDBF : DBFHandle;iShape, iField : LongWord; dFieldValue : double): LongWord ;external 'shapelib.dll';
|
||
|
|
function DBFWriteStringAttribute(hDBF : DBFHandle;iShape, iField : LongWord; pszFieldValue : PChar): LongWord ;external 'shapelib.dll';
|
||
|
|
function DBFWriteNULLAttribute(hDBF : DBFHandle; iShape, iField : LongWord ) : LongWord;external 'shapelib.dll';
|
||
|
|
procedure DBFClose(hDBF : DBFHandle);external 'shapelib.dll';
|
||
|
|
function DBFGetNativeFieldType(hDBF : DBFHandle; iField : LongWord) : Char;external 'shapelib.dll';
|
||
|
|
// *****************************************************************************
|
||
|
|
|
||
|
|
end.
|