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.
239 lines
11 KiB
239 lines
11 KiB
{ |
|
/****************************************************************************** |
|
* $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.
|
|
|