ezgraphics.pas

很管用的GIS控件

Unit EzGraphics;

{***********************************************************}
{     EzGIS/CAD Components                                  }
{   (c) 2003 EzSoft Engineering                             }
{         All Rights Reserved                               }
{***********************************************************}

{$I EZ_FLAG.PAS}
Interface

Uses
  SysUtils, Windows, Classes, Graphics, Controls, EzBaseGIS, EzLib, ezbase;

Type

  TRGBTripleArray = Array[WORD] Of TRGBTriple;
  pRGBTripleArray = ^TRGBTripleArray;

  TRGBQuadArray = Array[WORD] Of TRGBQuad;
  pRGBQuadArray = ^TRGBQuadArray;

  TEzTileGlobalInfo = Record
    dc: HDC;
    TheStream: TStream;
    bmf: TBITMAPFILEHEADER;
    lpBitmapInfo: PBITMAPINFO;
    BitmapHeaderSize: integer;
    TotalBitmapWidth: integer;
    TotalBitmapHeight: integer;
    SourceIsTopDown: Boolean;
    SourceRect: TRect;
    SourceBytesPerScanLine: integer;
    SourceLastScanLine: extended;
    SourceBandHeight: extended;
    SourceFirstTileHeight: extended;
  End;

  TEzBitmapEx = Class
  Private
    { internal data }
    FBlendTable: Array[-255..255] Of Smallint;
    { configuration }
    FPainterObject: TEzPainterObject;
    FWasSuspended: Boolean;
    FAlphaChannel: Byte;
    FBufferBitmap: TBitmap;
    FTileGlobalInfo: TEzTileGlobalInfo;

    Function TileCurrentBand( const CurrentTileRect: TRect): Boolean;
    Procedure SetAlphaChannel( Value: Byte );
  Public
    { methods }
    Function BitDIBFromFileInBands( Const FileName: String;
      Stream: TStream; dc: HDC; DestLeft, DestTop, DestWidth, DestHeight,
      DestTotalHeight, SourceLeft, SourceTop, SourceWidth, SourceHeight,
      BufferSize: integer ): Boolean;
    { properties }
    Property PainterObject: TEzPainterObject Read FPainterObject Write FPainterObject;
    Property WasSuspended: Boolean Read FWasSuspended;
    { AlphaChannel, 0= opaque, >0 = transparent }
    Property AlphaChannel: byte Read FAlphaChannel Write SetAlphaChannel;
    { the bitmap agains with which will be made transparent this bitmap }
    Property BufferBitmap: TBitmap Read FBufferBitmap Write FBufferBitmap;
  End;

  TEzBILReader = Class
  Private
    { internal data }
    FFileName: string;
    FBlendTable: Array[-255..255] Of Smallint;
    { configuration }
    FPainterObject: TEzPainterObject;
    FWasSuspended: Boolean;
    FAlphaChannel: Byte;
    FBufferBitmap: TBitmap;
    FTileGlobalInfo: TEzTileGlobalInfo;

    Function TileCurrentBand( const CurrentTileRect: TRect): Boolean;
    Procedure SetAlphaChannel( Value: Byte );
    function ReadHdr: Boolean;
  Public
    BIGENDIAN: Boolean;
    SKIPBYTES: integer;
    NROWS: integer;
    NCOLS: integer;
    NBANDS: integer;
    NBITS: integer;
    BANDROWBYTES: integer;
    TOTALROWBYTES: integer;
    BANDGAPBYTES: integer;
    NODATA: integer;
    ULXMAP: double;
    ULYMAP: double;
    XDIM: double;
    YDIM: double;

    Constructor Create(const Filename: string);
    { methods }
    Function BILFromFileInBands( Stream: TStream; DC: HDC;
      DestLeft, DestTop, DestWidth, DestHeight,
      DestTotalHeight, SourceLeft, SourceTop, SourceWidth, SourceHeight,
      BufferSize: Integer ): Boolean;
    { Properties }
    Property PainterObject: TEzPainterObject Read FPainterObject Write FPainterObject;
    Property WasSuspended: Boolean Read FWasSuspended;
    { AlphaChannel, 0= opaque, >0 = transparent }
    Property AlphaChannel: byte Read FAlphaChannel Write SetAlphaChannel;
    { the bitmap agains with which will be made transparent this bitmap }
    Property BufferBitmap: TBitmap Read FBufferBitmap Write FBufferBitmap;
  End;


{ useful routines }
procedure CyrusBeckLineClip(Polyline, Polygon, Result: TEzVector);
Function CreateText( Const AText: String; APosition: TEzLabelPos;
  Const AAngle: Double; Const Pt1, Pt2: TEzPoint; Const AFont: TEzFontStyle;
  TrueType: Boolean ): TEzEntity;
Procedure SaveClippedAreaTo( DrawBox: TEzBaseDrawBox; Const NewGis: TEzBaseGis );
Function GetMemEx( size: DWORD ): pointer;
Function FreeMemEx( p: pointer ): pointer;
{Function LoadDIBFromStream( TheStream: TStream;
  Var lpBitmapInfo: PBITMAPINFO;
  Var lpBits: Pointer;
  Var BitmapWidth, BitmapHeight: integer ): Boolean; }
Function LoadDIBFromFile( Const FileName: String;
  Var lpBitmapInfo: PBITMAPINFO;
  Var lpBits: Pointer;
  Var BitmapWidth, BitmapHeight: integer ): Boolean;
Function LoadDIBFromTBitmap( ABitmap: TBitmap;
  Var lpBitmapInfo: PBITMAPINFO;
  Var lpBits: Pointer;
  Var BitmapWidth, BitmapHeight: integer ): Boolean;
Function GetDIBDimensions( Const FileName: String;
  Stream: TStream;
  Var BitmapWidth, BitmapHeight: integer;
  Var IsCompressed: Boolean ): Boolean;
Function GetBILDimensions( Const FileName: String;
  Var BitmapWidth, BitmapHeight: integer ): Boolean;

Procedure PrintBitmapEx( Canvas: TCanvas;
  Const DestinationRect: TRect;
  ABitmap: TBitmap;
  Const SourceRect: TRect );
Procedure Fill8X8Bitmap( ACanvas: TCanvas;
  DestRect: TRect;
  Bitmap: TBitmap;
  ForeColor, BackColor: TColor );
Procedure PrinterFill8X8Bitmap( ACanvas: TCanvas;
  DestRect: TRect;
  Bitmap: TBitmap;
  ForeColor, BackColor: TColor;
  Factor: Double );
Procedure PolygonScreenFill8X8Bitmap( Canvas: TCanvas;
  Grapher: TEzGrapher; Var Vertices: Array Of TPoint; Var Parts: Array Of Integer;
  PartCount: Integer; Bitmap: TBitmap; ForeColor, BackColor: TColor );
Procedure PolygonPrinterFill8X8Bitmap( Canvas: TCanvas;
  Grapher: TEzGrapher; Var Vertices: Array Of TPoint; Var Parts: Array Of Integer;
  PartCount: Integer; Bitmap: TBitmap; ForeColor, BackColor: TColor;
  Factor: Double; PlotterOptimized: Boolean );
PROCEDURE RotateBitmap(
  const BitmapOriginal:TBitMap;//input bitmap (possibly converted)
  out   BitMapRotated:TBitMap; //output bitmap
  const theta:Double;  // rotn angle in radians counterclockwise in windows
  const oldAxis:TPOINT; 	// center of rotation in pixels, rel to bmp origin
  var   newAxis:TPOINT);  // center of rotated bitmap, relative to bmp origin

function FindContrastColor(aColor: TColor): TColor;

Implementation

Uses
  Math, ezsystem, ezentities, ezpolyclip, ezconsts, ezrtree;


{ CreateText procedure used for on the fly labeling }

Function CreateText( Const AText: String;
  APosition: TEzLabelPos;
  Const AAngle: Double;
  Const Pt1, Pt2: TEzPoint;
  Const AFont: TEzFontStyle;
  TrueType: Boolean ): TEzEntity;
Const
  ENLARGE_FACTOR = 0.15;

Var
  Angle: Double;
  DX, DY, MidY: Double;
  P, TmpPt1, TmpPt2: TEzPoint;
Begin
  Angle := AAngle;
  If Pt1.X < Pt2.X Then
  Begin
    TmpPt1 := Pt1;
    TmpPt2 := Pt2;
  End
  Else
  Begin
    TmpPt1 := Pt2;
    TmpPt2 := Pt1;
  End;
  { a veces el angulo es recibido con valor 0 }
  If Angle = 0 Then
  Begin
    MidY := ( TmpPt1.Y + TmpPt2.Y ) / 2;
    TmpPt1.Y := MidY;
    TmpPt2.Y := MidY;
  End
  Else
  Begin
    Angle := Angle2d( TmpPt1, TmpPt2 );
  End;
  TmpPt2.X := TmpPt1.X + Dist2d( Pt1, Pt2 );
  If TrueType Then
  Begin
    Result := TEzTrueTypeText.CreateEntity( Tmppt1, AText, AFont.Height, 0 );
    TEzTrueTypeText( Result ).FontTool.FFontStyle := AFont;
  End
  Else
  Begin
    Result := TEzFittedVectorText.CreateEntity( TmpPt1,
      AText,
      AFont.Height,
      -1, // calculate text width
      0 );
    TEzFittedVectorText( Result ).FontColor := AFont.Color;
  End;

  With Result.FBox Do
  Begin
    DX := abs( Emax.X - Emin.X );
    DY := abs( Emax.Y - Emin.Y );
  End;
  { posicion as if the angle was cero }
  Case APosition Of
    lpCenter:
      Begin
        p.X := ( TmpPt1.X + TmpPt2.X ) / 2 - DX / 2;
        p.y := TmpPt1.Y + DY / 2;
      End;
    lpCenterUp:
      Begin
        p.X := ( TmpPt1.X + TmpPt2.X ) / 2 - DX / 2;
        p.Y := TmpPt1.Y + DY * ( 1 + ENLARGE_FACTOR );
      End;
    lpUpperLeft:
      Begin
        p.X := TmpPt1.X;
        p.Y := TmpPt1.Y + DY * ( 1 + ENLARGE_FACTOR );
      End;
    lpUpperRight:
      Begin
        p.X := TmpPt2.X - DX;
        p.Y := TmpPt1.Y + DY * ( 1 + ENLARGE_FACTOR );
      End;
    lpCenterLeft:
      Begin
        p.X := TmpPt1.X;
        p.Y := TmpPt1.Y + DY / 2;
      End;
    lpCenterRight:
      Begin
        p.X := TmpPt2.X - DX;
        p.Y := TmpPt1.Y + DY / 2;
      End;
    lpLowerLeft:
      Begin
        p.X := TmpPt1.X;
        p.Y := TmpPt1.Y - DY * ENLARGE_FACTOR;
      End;
    lpCenterDown:
      Begin
        p.X := ( TmpPt1.X + TmpPt2.X ) / 2 - DX / 2;
        p.Y := TmpPt1.Y - DY * ENLARGE_FACTOR;
      End;
    lpLowerRight:
      Begin
        p.X := TmpPt2.X - DX;
        p.Y := TmpPt1.Y - DY * ENLARGE_FACTOR;
      End;
  End;
  { now apply the angle }
  If Angle <> 0 Then
  Begin
    If TrueType Then
    Begin
      Result.BeginUpdate;
      TEzTrueTypeText( Result ).Points[0] := TransformPoint2d( p, Rotate2d( Angle, TmpPt1 ) );
      TEzTrueTypeText( Result ).FontTool.Angle := Angle;
      Result.EndUpdate;
    End
    Else
    Begin
      TEzFittedVectorText( Result ).BasePoint := TransformPoint2d( p, Rotate2d( Angle, TmpPt1 ) );
      TEzFittedVectorText( Result ).Angle := Angle;
    End;
  End
  Else
  Begin
    If TrueType Then
      TEzTrueTypeText( Result ).Points[0] := p
    Else
      TEzFittedVectorText( Result ).BasePoint := p;
  End;
End;

function FindContrastColor(aColor: TColor): TColor;
begin
  if ((aColor and $FF)*77 + ((aColor shr 8) and $FF)*150 + ((aColor shr 16) and $FF)*29) > 127 * 256 then
    Result := clBlack
  else
    Result := clWhite;
end;

///////////////////////////////////////////////////////////////////////////////
//Rotate  a bitmap about an arbritray center point;
///////////////////////////////////////////////////////////////////////////////
//a structure to hold sine,cosine,distance (faster than angle)
type SiCoDiType=
  record
	 si, co, di:Double; {sine, cosine, distance 6/29/98}
  end;

{	Calculate sine/cosine/distance from INTEGER coordinates}
function SiCoDiPoint ( const p1, p2: TPoint ): SiCoDiType; {out}
{	This is MUCH faster than using angle functions such as arctangent}
{11.96    Jim Hargis  original SiCoDi for rotations.
{11/22/96 modified for Zero length check, and replace SiCodi}
{6/14/98  modified  for Delphi}
{6/29/98  renamed from SiCo point}
{8/3/98	  set Zero angle for Zero length line}
{10/24/99 use hypot from math.pas}
var
  dx, dy: Integer;
begin
  dx := ( p2.x - p1.x ); 	dy := ( p2.y - p1.y );
  with RESULT do
    begin
      di := HYPOT( dx, dy ); //10/24/99 	di := Sqrt( dx * dx + dy * dy );
      if abs( di )<1
        then begin si := 0.0; co := 1.0 end//Zero length line
        else begin si := dy/di; co := dx/di end;
    end;
end;

// read time stamp in CPU Cycles for Pentium
function RDTSC: Int64;
asm
  DB 0FH, 31H   //allows out-of-sequence execution, caching
end;

	PROCEDURE RotateBitmap(
		const BitmapOriginal:TBitMap;//input bitmap (possibly converted)
		out   BitMapRotated:TBitMap; //output bitmap
		const theta:Double;  // rotn angle in radians counterclockwise in windows
		const oldAxis:TPOINT; 	// center of rotation in pixels, rel to bmp origin
		var   newAxis:TPOINT);  // center of rotated bitmap, relative to bmp origin
{
  (c) har*GIS L.L.C., 1999
  	You are free to use this in any way, but please retain this comment block.
  	Please email questions to [e-mail] .
  Doc & Updates: http://www.efg2.com/Lab/ImageProcessing/RotateScanline.htm
  and http://www.efg2.com/Lab/Library/Delphi/Graphics/JimHargis_RotateBitMap.zip
}
{Notes...
  Coordinates and rotation are adjusted for 'flipped' Y axis (+Y is down)
  Bitmap origins are (0,0) in top-left.
  BitMapRotated is enlarged to contain the rotated bitmap
  BitMapOriginal may be changed from 1,2,4 bit to pf8Bit, if needed.
//	rotate about center, Oldaxis:=POINT( bmp.width div 2, bmp.height div 2 );
//  rotate about origin top-left, Oldaxis:=POINT( 0,0 );
//  rotate about bottom-center, Oldaxis:=POINT( bmp.width div 2, bmp.height )
  NewAxis: is the new center of rotation for BitMapRotated;
}
{Usage...
  var Inbmp,Newbmp:TbitMap;
  var Center, NewCenter: TPoint;
  begin  //draw at 45 degrees rotated about center
    inbmp:=Tbitmap.Create; Newbmp:=Tbitmap.Create;
    InBMP.LoadFromFile( '..\Athena.bmp'); InBMP.Transparent:=True;
    Center:=POINT( inbmp.width div 2, inbmp.height div 2 );
    RotateBitMap( inBMP, 45*pi/180, NewBMP, Center, NewCenter );
    //place the bmp rotation axis at 100,100...
    Canvas.Draw( 100-NewCenter.x, 100-NewCenter.y, NewBMP );
    inbmp.free; newbmp.free;
  end;
}
{Features/ improvements over original EFG RotateBitMap:
  This is generalized procedure; application independent.
  Does NOT clip corners; Enlarges Output bmp if needed.
  Output keeps same transparency and pallette as set by BitMapOriginal.
	Handles all pixel formats, format converted to least one byte per pixel.
	Axis of rotation specified by caller, but new axis will differ from oldaxis.
	Minor Delphi performance optimizations (about 8 instructions per pixel)
  Skips "null" angles which have no discernable effect.
}
{Restrictions:
	Caller responsible for create/destroy bitmaps.  This improves perfc in loops.
  Caller must provide the following:
    AngleType: the user-specified float format for real angle.
      can be single, double or extended; you won't see any difference.
    function min( const i,j:integer ):integer;  // from Math.pas
    procedure sincos(const theta:real; var sine,cosine:Extended );//from Math.pas
	Uses nearest neighbor sampling, no antialiasing: poor quality;
	Not optimized for Pentium;  no MMX. (see Intel Image Processing Library)
}
{Revisions...
12/1/99 original code extracted from Earl F. Glynn
		Copyright (C) 1997-1998 Earl F. Glynn, Overland Park, KS  USA.
		All Rights Reserved.