ezgraphics.pas

很管用的GIS控件

12/10/99 new code added to make a standalone method. Original in (*comments*)
		Copyright (c) 1999-2000 har*GIS LLC, Englewood CO USA; [e-mail]
    V1.0.0 release
12/15/99 add rotation axis to be specified
		add transparent color, add rotated rectangle output (non-clipped).
12/25/99  recomputed  new rotation axis.
1/6/2000  allow multibyte pixel formats. Translate 1bit and 4bit to 8bit.
10/31/00  add support for pixel formats pfDevice, pfCustom (from Rob Rossmair);
  drop err and debug message I/O;
  deleted the changed code from EFG; use "with" for efficiency;
  add check for nil angle (rotates less than 1 pizel;
  publish as general function, not a method.
11/5/00 allow variable real formats (but only need single precision);
  drop temp bitmap (BM8),  OriginalBitmap is converted if needed.
  fix BUG which ignored OldAxis, always rotated about center, set bad NewAxis
  fix BUG in false optimization for angle zero, which overwrote the input bmp)
11/12/00 fix BUG in calc of NewAxis; simplify math for center rotation.
  V1.0.5 release}
{ToDo.. use pointer arithmetic instead of type subscripting for faster pixels.
  Test pfDevice and pfCustom, test palettes. <no data>. }
		VAR
		cosTheta       :  Single;   {in windows}
		sinTheta       :  Single;
		i              :  INTEGER;
		iOriginal      :  INTEGER;
		//iRotationAxis  :  INTEGER;// Axis of rotation is normally center of image
		iPrime         :  INTEGER;
//		iPrimeRotated  :  INTEGER; use width if doubled
		j              :  INTEGER;
		jOriginal      :  INTEGER;
		//jRotationAxis  :  INTEGER;
		jPrime         :  INTEGER;
//		jPrimeRotated  :  INTEGER; use height if doubled
		NewWidth,NewHeight:INTEGER;
		nBytes, nBits: Integer;//no. bytes per pixelformat
		Oht,Owi,Rht,Rwi: Integer;//Original and Rotated subscripts to bottom/right
//The variant pixel formats for subscripting       1/6/00
	type // from Delphi
		TRGBTripleArray = array [0..32767] of TRGBTriple; //allow integer subscript
		pRGBTripleArray = ^TRGBTripleArray;
		TRGBQuadArray = array [0..32767]  of TRGBQuad;//allow integer subscript
		pRGBQuadArray = ^TRGBQuadArray;
	var //each of the following points to the same scanlines
		RowRotatedB: pByteArray; 			//1 byte
		RowRotatedW: pWordArray;  		//2 bytes
		RowRotatedT: pRGBtripleArray;	//3 bytes
		RowRotatedQ: pRGBquadArray;  	//4 bytes
	var //a single pixel for each format 	1/8/00
		TransparentB: Byte;
		TransparentW: Word;
		TransparentT: TRGBTriple;
		TransparentQ: TRGBQuad;
  var
    DIB: TDIBSection;//10/31/00
    //Center:  TPOINT; //the middle of the bmp relative to bmp origin.
    SiCoPhi: SiCoDiType;//sine,cosine, distance
{=======================================}
begin

with BitMapOriginal do begin

//Decipher the appropriate pixelformat to use Delphi byte subscripting 1/6/00
//pfDevice, pf1bit, pf4bit, pf8bit, pf15bit, pf16bit, pf24bit, pf32bit,pfCustom;
		case pixelformat of
      pfDevice: begin //handle only pixelbits= 1..8,16,24,32 //10/31/00
        nbits :=  GetDeviceCaps( Canvas.Handle,BITSPIXEL )+1 ;
        nbytes := nbits div 8; //no. bytes for bits per pixel
        if (nbytes>0)and(nbits mod 8 <> 0) then exit;//ignore if invalid
        end;
			pf1bit:  nBytes:=0;// 1bit, TByteArray      //2 color pallete , re-assign byte value to 8 pixels, for entire scan line
			pf4bit:	 nBytes:=0;// 4bit, PByteArray     // 16 color pallette; build nibble for pixel pallette index; convert to 8 pixels
			pf8bit:  nBytes:=1;// 8bit, PByteArray     // byte pallette, 253 out of 256 colors; depends on display mode, needs Truecolor ;
			pf15bit: nBytes:=2;// 15bit,PWordArrayType // 0rrrrr ggggg bbbbb  0+5+5+5
			pf16bit: nBytes:=2;// 16bit,PWordArrayType // rrrrr gggggg bbbbb  5+6+5
			pf24bit: nBytes:=3;// 24bit,pRGBtripleArray// bbbbbbbb gggggggg rrrrrrrr  8+8+8
			pf32bit: nBytes:=4;// 32bit,pRGBquadArray  // bbbbbbbb gggggggg rrrrrrrr aaaaaaaa 8+8+8+alpha
											   // can assign 'Single' reals to this for generating displays/plasma!
      pfCustom: begin  //handle only pixelbits= 1..8,16,24,32  //10/31/00
          GetObject( Handle, SizeOf(DIB), @DIB );
          nbits := DIB.dsBmih.biSizeImage;
          nbytes := nbits div 8;
          if (nbytes>0)and(nbits mod 8 <> 0) then exit;//ignore if invalid
        end;// pfcustom

			else exit;// 10/31/00 ignore invalid formats
		end;// case

// BitmapRotated.PixelFormat is the same as BitmapOriginal.PixelFormat;
// IF PixelFormat is less than 8 bit, then BitMapOriginal.PixelFormat = pf8Bit,
//  because Delphi can't index to bits, just bytes;
// The next time BitMapOriginal is used it will already be converted.
//( bmp storage may increase by factor of n*n, where n=8/(no. bits per pixel)  )
	if nBytes=0 then PixelFormat := pf8bit; //note that input bmp is changed

//assign copies all properties, including pallette and transparency   11/7/00
//fix bug 1/30/00 where BitMapOriginal was overwritten bec. pointer was copied
  BitmapRotated.Assign( BitMapOriginal);

//COUNTERCLOCKWISE rotation angle in radians. 12/10/99
	 sinTheta := SIN( theta ); cosTheta := COS( theta );
//SINCOS( theta, sinTheta, cosTheta ) ; math.pas requires extended reals.

//calculate the enclosing rectangle  12/15/00
	NewWidth  := ABS( ROUND( Height*sinTheta) ) + ABS( ROUND( Width*cosTheta ) );
	NewHeight := ABS( ROUND( Width*sinTheta ) ) + ABS( ROUND( Height*cosTheta) );

//diff size bitmaps have diff resolution of angle, ie r*sin(theta)<1 pixel
//use the small angle approx: sin(theta) ~~ theta   //11/7/00
  if ( ABS(theta)*MAX( width,height ) ) > 1 then
  begin//non-zero rotation

//set output bitmap formats; we do not assume a fixed format or size 1/6/00
	BitmapRotated.Width  := NewWidth;   //resize it for rotation
	BitmapRotated.Height := NewHeight;
//center of rotation is center of bitmap
  //iRotationAxis := width div 2;
  //jRotationAxis := height div 2;

//local constants for loop, each was hit at least width*height times   1/8/00
	Rwi := NewWidth - 1; //right column index
	Rht := NewHeight - 1;//bottom row index
	Owi := Width - 1;    //transp color column index
	Oht := Height - 1;   //transp color row  index

//Transparent pixel color used for out of range pixels 1/8/00
//how to translate a Bitmap.TransparentColor=Canvas.Pixels[0, Height - 1];
// from Tcolor into pixelformat..
	case nBytes of
		0,1:TransparentB := PByteArray     ( Scanline[ Oht ] )[0];
		2:	TransparentW := PWordArray     ( Scanline[ Oht ] )[0];
		3:	TransparentT := pRGBtripleArray( Scanline[ Oht ] )[0];
		4:	TransparentQ := pRGBquadArray  ( Scanline[ Oht ] )[0];
	end;//case *)

// Step through each row of rotated image.
	FOR j := Rht DOWNTO 0 DO   //1/8/00
	BEGIN //for j

		case nBytes of  //1/6/00
		0,1:RowRotatedB := BitmapRotated.Scanline[ j ] ;
		2:	RowRotatedW := BitmapRotated.Scanline[ j ] ;
		3:	RowRotatedT := BitmapRotated.Scanline[ j ] ;
		4:	RowRotatedQ := BitmapRotated.Scanline[ j ] ;
		end;//case

	// offset origin by the growth factor     //12/25/99
	//	jPrime := 2*(j - (NewHeight - Height) div 2 - jRotationAxis) + 1 ;
		jPrime := 2*j - NewHeight + 1 ;

	// Step through each column of rotated image
		FOR i := Rwi DOWNTO 0 DO   //1/8/00
		BEGIN //for i

			// offset origin by the growth factor  //12/25/99
			//iPrime := 2*(i - (NewWidth - Width) div 2 - iRotationAxis ) + 1;
      iPrime := 2*i - NewWidth   + 1;

			// Rotate (iPrime, jPrime) to location of desired pixel	(iPrimeRotated,jPrimeRotated)
			// Transform back to pixel coordinates of image, including translation
			// of origin from axis of rotation to origin of image.
//iOriginal := ( ROUND( iPrime*CosTheta - jPrime*sinTheta ) - 1) DIV 2 + iRotationAxis;
//jOriginal := ( ROUND( iPrime*sinTheta + jPrime*cosTheta ) - 1) DIV 2 + jRotationAxis;
			iOriginal := ( ROUND( iPrime*CosTheta - jPrime*sinTheta ) -1 + width ) DIV 2;
			jOriginal := ( ROUND( iPrime*sinTheta + jPrime*cosTheta ) -1 + height) DIV 2 ;

			// Make sure (iOriginal, jOriginal) is in BitmapOriginal.  If not,
			// assign background color to corner points.
			IF   ( iOriginal >= 0 ) AND ( iOriginal <= Owi ) AND
					 ( jOriginal >= 0 ) AND ( jOriginal <= Oht )    //1/8/00
			THEN BEGIN //inside
				// Assign pixel from rotated space to current pixel in BitmapRotated
				//( nearest neighbor interpolation)
				case nBytes of  //get pixel bytes according to pixel format   1/6/00
				0,1:RowRotatedB[i] := pByteArray(      scanline[joriginal] )[iOriginal];
				2:	RowRotatedW[i] := pWordArray(      Scanline[jOriginal] )[iOriginal];
				3:	RowRotatedT[i] := pRGBtripleArray( Scanline[jOriginal] )[iOriginal];
				4:	RowRotatedQ[i] := pRGBquadArray(   Scanline[jOriginal] )[iOriginal];
				end;//case
			END //inside
			ELSE	BEGIN //outside

//12/10/99 set background corner color to transparent (lower left corner)
//	RowRotated[i]:=tpixelformat(BitMapOriginal.TRANSPARENTCOLOR) ; wont work
				case nBytes of
				0,1:RowRotatedB[i] := TransparentB;
				2:	RowRotatedW[i] := TransparentW;
				3:	RowRotatedT[i] := TransparentT;
				4:	RowRotatedQ[i] := TransparentQ;
				end;//case
			END //if inside

		END //for i
	END;//for j
  end;//non-zero rotation

//offset to the apparent center of rotation   11/12/00 12/25/99
//rotate/translate the old bitmap origin to the new bitmap origin,FIXED 11/12/00
  sicoPhi := sicodiPoint(  POINT( width div 2, height div 2 ),oldaxis );
  //sine/cosine/dist of axis point from center point
  with sicoPhi do begin
//NewAxis := NewCenter + dist* <sin( theta+phi ),cos( theta+phi )>
    NewAxis.x := newWidth div 2 + ROUND( di*(CosTheta*co - SinTheta*si) );
    NewAxis.y := newHeight div 2- ROUND( di*(SinTheta*co + CosTheta*si) );//flip yaxis
  end;

end;//with

END; {RotateImage}

{ save clipped area to procedure }

Procedure SaveClippedAreaTo( DrawBox: TEzBaseDrawBox; Const NewGis: TEzBaseGis );
Var
  hasClipped, hasClippedThis: Boolean;
  I, J, N, ARecno, ClipIndex: Integer;
  Layer, NewLayer: TEzBaseLayer;
  WCRect: TEzRect;
  Entities: Array[TEzEntityID] Of TEzEntity;
  Cont: TEzEntityID;
  SavedCursor: TCursor;
  FieldList: TStringList;
  SavedLimit: SmallInt;

  Procedure ClipOpenedEntity( Ent: TEzEntity; Const Clip: TEzRect );
  Var
    VisPoints, cnt, n, Idx1, Idx2: Integer;
    TmpPt1, TmpPt2: TEzPoint;
    TmpPts, EntPts: PEzPointArray;
    Parts: PIntegerArray;
    TmpSize, PartSize: Integer;
    ClipRes: TEzClipCodes;
    n1, PartCount, PartStart: integer;

    Procedure AddPolyline;
    Var
      cnt: integer;
    Begin
      For cnt := 0 To VisPoints - 1 Do
      Begin
        EntPts^[n1] := TmpPts^[cnt];
        Inc( n1 );
      End;
      Parts^[PartCount] := PartStart;
      Inc( PartStart, VisPoints );
      Inc( PartCount );
    End;

  Begin
    If Ent.Points.Count = 0 Then Exit;

    n := 0;
    If Ent.Points.Parts.Count < 2 Then
    Begin
      Idx1 := 0;
      Idx2 := Ent.Points.Count - 1;
    End
    Else
    Begin
      Idx1 := Ent.Points.Parts[n];
      Idx2 := Ent.Points.Parts[n + 1] - 1;
    End;
    PartSize := ( Ent.Points.Parts.Count + 4 ) * sizeOf( Integer ) * 2;
    TmpSize := ( Ent.Points.Count + 4 ) * sizeof( TEzPoint );

    GetMem( TmpPts, TmpSize );
    GetMem( EntPts, TmpSize * 2 );
    GetMem( Parts, PartSize );

    Try
      n1 := 0;
      PartCount := 0;
      PartStart := 0;
      Repeat
        VisPoints := 0;
        If IsBoxFullInBox2D( Ent.FBox, Clip ) Then
        Begin
          For cnt := Idx1 To Idx2 Do
            TmpPts^[cnt - Idx1] := Ent.Points[cnt];
          VisPoints := Succ( Idx2 - Idx1 );
        End
        Else
        Begin
          For cnt := Idx1 + 1 To Idx2 Do
          Begin
            TmpPt1 := Ent.Points[cnt - 1];
            TmpPt2 := Ent.Points[cnt];
            ClipRes := ClipLine2D( Clip, TmpPt1.X, TmpPt1.Y, TmpPt2.X, TmpPt2.Y );
            If Not ( ccNotVisible In ClipRes ) Then
            Begin
              TmpPts^[VisPoints] := TmpPt1;
              Inc( VisPoints );
            End;
            If ccSecond In ClipRes Then
            Begin
              TmpPts^[VisPoints] := TmpPt2;
              Inc( VisPoints );

              AddPolyline;

              VisPoints := 0;
            End;
          End;
          If Not ( ccNotVisible In ClipRes ) Then
          Begin
            TmpPts^[VisPoints] := TmpPt2;
            Inc( VisPoints );
          End;
        End;
        If VisPoints > 0 Then
          AddPolyline;

        If Ent.Points.Parts.Count < 2 Then
          Break;
        Inc( n );
        If n >= Ent.Points.Parts.Count Then
          Break;
        Idx1 := Ent.Points.Parts[n];
        If n < Ent.Points.Parts.Count - 1 Then
          Idx2 := Ent.Points.Parts[n + 1] - 1
        Else
          Idx2 := Ent.Points.Count - 1;
      Until false;
      Ent.Points.Clear;
      If PartCount > 1 Then
        For cnt := 0 To PartCount - 1 Do
          Ent.Points.Parts.Add( Parts[cnt] );
      For cnt := 0 To n1 - 1 Do
        Ent.Points.Add( EntPts^[cnt] );
    Finally
      FreeMem( TmpPts, TmpSize );
      FreeMem( EntPts, TmpSize * 2 );
      FreeMem( Parts, PartSize );
    End;
  End;

  Procedure ClipClosedEntity( Ent: TEzEntity; Const Clip: TEzRect );
  Var
    cnt, VisPoints, VisPoints1, PartStart, Idx1, Idx2, PartCount, n, n1: integer;
    TmpPts, FirstClipPts, EntPts: PEzPointArray;
    Parts: PIntegerArray;
    TmpSize, PartSize: Integer;
    TmpPt1, TmpPt2: TEzPoint;
    ClipRes: TEzClipCodes;
  Begin
    If Ent.Points.Count = 0 Then
      exit;
    If Ent.Points.Count = 2 Then
    Begin
      ClipOpenedEntity( Ent, Clip );
      exit;
    End;
    n := 0;
    If Ent.Points.Parts.Count < 2 Then
    Begin
      Idx1 := 0;
      Idx2 := Ent.Points.Count - 1;
    End
    Else
    Begin
      Idx1 := Ent.Points.Parts[n];
      Idx2 := Ent.Points.Parts[n + 1] - 1;
    End;

    TmpSize := ( Ent.Points.Count + 4 ) * sizeof( TEzPoint );
    PartSize := ( Ent.Points.Count + 4 ) * sizeof( Integer );

    GetMem( TmpPts, TmpSize );
    GetMem( FirstClipPts, TmpSize );
    GetMem( EntPts, TmpSize * 2 );
    GetMem( Parts, PartSize );

    Try
      PartCount := 0;
      n1 := 0;
      PartStart := 0;
      Repeat
        VisPoints1 := 0;
        If IsBoxFullInBox2D( Ent.FBox, Clip ) Then
        Begin
          For cnt := Idx1 To Idx2 Do
            TmpPts^[cnt - Idx1] := Ent.Points[cnt];
          VisPoints := ( Idx2 - Idx1 ) + 1;
        End
        Else
        Begin
          For cnt := Idx1 To Idx2 Do
          Begin
            TmpPt1 := Ent.Points[cnt];
            If cnt < Idx2 Then
              TmpPt2 := Ent.Points[cnt + 1]
            Else
              TmpPt2 := Ent.Points[Idx1];
            ClipRes := ClipLineLeftRight2D( Clip, TmpPt1.X, TmpPt1.Y, TmpPt2.X, TmpPt2.Y );
            If Not ( ccNotVisible In ClipRes ) Then
            Begin
              FirstClipPts^[VisPoints1] := TmpPt1;
              Inc( VisPoints1 );
            End;
            If ccSecond In ClipRes Then
            Begin
              FirstClipPts^[VisPoints1] := TmpPt2;
              Inc( VisPoints1 );
            End;
          End;
          FirstClipPts^[VisPoints1] := FirstClipPts^[0];
          Inc( VisPoints1 );
          VisPoints := 0;
          For cnt := 0 To VisPoints1 - 2 Do
          Begin
            TmpPt1 := FirstClipPts^[cnt];
            TmpPt2 := FirstClipPts^[cnt + 1];