ezermapper.pas

很管用的GIS控件

      8: // MOVE POINT
        Begin
          // calculate current move point
          MovePt.X := ( TmpR.Emin.X + TmpR.Emax.X ) / 2;
          MovePt.Y := ( TmpR.Emin.Y + TmpR.Emax.Y ) / 2;
          M := Translate2d( Value.X - MovePt.X, Value.Y - MovePt.Y );
          TmpR.Emin := TransformPoint2d( TmpR.Emin, M );
          TmpR.Emax := TransformPoint2d( TmpR.Emax, M );
        End;
    End;
    FPoints[0] := TmpR.Emin;
    FPoints[1] := TmpR.Emax;
    UpdateExtension;
  Finally
    FPoints.DisableEvents := false;
  End;
End;

Function TEzERMapper.GetDrawPoints: TEzVector;
Begin
  Result := FVector;
End;

Procedure TEzERMapper.LoadFromStream( Stream: TStream );
Var
  Reserved: Array[0..49] Of byte;
Begin
  Inherited LoadFromStream( stream );
  With Stream Do
  Begin
    Read( FAlphaChannel, SizeOf( Byte ) );
    FFileName := EzReadStrFromStream( stream );
    Read( Reserved, sizeof( Reserved ) );
  End;
  FPoints.CanGrow := false;
  UpdateExtension;
End;

Procedure TEzERMapper.SaveToStream( Stream: TStream );
Var
  Reserved: Array[0..49] Of byte;
Begin
  Inherited SaveToStream( Stream );
  With Stream Do
  Begin
    Write( fAlphaChannel, SizeOf( Byte ) );
    EzWriteStrToStream( FFileName, stream );
    Write( Reserved, sizeof( Reserved ) );
  End;
End;

Function TEzERMapper.StorageSize: Integer;
Begin
  Result := Inherited StorageSize + Length( FFileName );
End;

Procedure TEzERMapper.Draw( Grapher: TEzGrapher; Canvas: TCanvas;
  Const Clip: TEzRect; DrawMode: TEzDrawMode; Data: Pointer = Nil );
Var
  BmpRect, Src, Dest: TRect;
  Work: TEzRect;
  fx, fy: Double;
  L, T, W, H: Integer;
  hPaintPal, hOldPal: HPalette;
  Pass: Boolean;

  BackgFormat: TPixelformat;
  scanlin: Pointer;
  p1_24, p2: pRGBTripleArray;
  p1_32: pRGBQuadArray;
  TmpBitmap: TBitmap;
  x, y, bgx, bgy, bgw, bgh: integer;
  BlendTable: Array[SMALLINT] Of Smallint;
  OldStyle: TPenStyle;
  // ermapper needed data
  Alg : PEzERInfo;
  bitmap : HBITMAP;
  bmpInfo : BITMAPINFO;
  bits : Pointer;
  Bmp: TBitmap;
  DestW, DestH: Integer;
Begin
  If Not IsBoxInBox2D( FBox, Clip ) Then Exit;

  If DrawMode <> dmNormal Then
  Begin
    If DrawMode = dmRubberpen Then
    begin
      Oldstyle:= Canvas.Pen.Style;
      Canvas.Pen.Style:= psDot;
    end;
    FVector.DrawOpened( Canvas, Clip, FBox, Grapher, PenTool.FPenStyle,
      Self.GetTransformMatrix, DrawMode );
    If DrawMode = dmRubberpen Then
      Canvas.Pen.Style:= Oldstyle;
    Exit;
  End;

  If Not ERMapperDllLoaded Then
    LoadERMapperDll;

  Alg := getEzERInfo(PChar(FFileName));
  if Alg = Nil Then Exit;   // no se pudo cargar el Algoritmo
  Bmp:= TBitmap.Create;
  try
    Alg^.x_dpi := Grapher.DpiX;
    Alg^.y_dpi := Grapher.DpiY;
    Alg^.bitCount:= 24;
    Alg^.XPelsPerMeter:= 1; // don't care
    Alg^.YPelsPerMeter:= 1; // don't care

    {Las dimensiones del canvas deben de ser menores o iguales que las del Algoritmo.
     Preferentemente las mismas. He observado un comportamiento extra駉, en cuanto a la
     relacion que existe entre las dimensiones del canvas con respecto a los colores de
     la imagen, cuando la propiedad canvas_width no es divisible entre 20 la imagen se
     muestra en escala de grises.}

    If IsBoxFullInBox2D( FBox, Clip ) Then
    begin
      Dest := ReorderRect( Grapher.RealToRect( FBox ) );
      // If the canvas_width is not a multiplier of 20, the image is seen oddly.
      // we don't know why. Maybe a bug in ermapper dll
      DestW:= (Dest.Right - Dest.Left);
      DestH:= (Dest.Bottom - Dest.Top);
      Alg^.canvas_width := DestW - DestW mod 20;
      Alg^.canvas_height := DestH;
      Alg^.output_width :=  DestW;
      Alg^.output_height := DestH;
      Alg^.applytopleft := Alg^.topleft;
      Alg^.applybottomright := Alg^.bottomright;
    end else
    begin
      // Calculate image rectangle
      Work := IntersectRect2D( FBox, Clip );
      If IsRectEmpty2D( Work ) Then Exit;

      { calculate the destination rectangle}
      Dest := Grapher.RealToRect( Work );
      BmpRect := Grapher.RealToRect( FBox );
      Src := Dest;
      { calcula el porcentaje que el bitmap }
      With BmpRect Do
      Begin
        fx := Grapher.DistToRealX( Alg^.nr_columns ) / Abs( FBox.X2 - FBox.X1 );
        fy := Grapher.DistToRealY( Alg^.nr_rows ) / Abs( FBox.Y2 - FBox.Y1 );
        OffsetRect( Src, -Left, -Top );
      End;

      L := round( Src.Left * fx );
      T := round( Src.Top * fy );
      W := round( ( Src.Right - Src.Left ) * fx );
      H := round( ( Src.Bottom - Src.Top ) * fy );
      If ( W = 0 ) Or ( H = 0 ) Then Exit;

      // If the canvas_width is not a multiplier of 20, the image is seen oddly.
      // we don't know why :-(
      DestW:= (Dest.Right - Dest.Left);
      DestH:= (Dest.Bottom - Dest.Top);
      Alg^.canvas_width :=  DestW - DestW mod 20;
      Alg^.canvas_height := DestH;
      Alg^.output_width :=  DestW;
      Alg^.output_height := DestH;

      Alg^.applytopleft := Alg^.topleft;
      Alg^.applytopleft.en.eastings := Alg^.applytopleft.en.eastings + L * Alg^.x_rel;
      Alg^.applytopleft.en.northings := Alg^.applytopleft.en.northings - T * Alg^.y_rel;

      Alg^.applybottomright := Alg^.bottomright;
      Alg^.applybottomright.en.eastings := Alg^.applybottomright.en.eastings - (Alg^.nr_columns - (L+W)) * Alg^.x_rel;
      Alg^.applybottomright.en.northings := Alg^.applybottomright.en.northings + (Alg^.nr_rows -(T+H)) * Alg^.y_rel;

    end;

    If getImage(Alg, bitmap, bmpInfo, Canvas.Handle, bits) <= 0 Then Exit;

    SetStretchBltMode( Canvas.Handle, COLORONCOLOR );

    Bmp.Handle:= bitmap;

    If FAlphaChannel > 0 Then
    Begin
      For x := -255 To 255 Do
        BlendTable[x] := ( FAlphaChannel * x ) Shr 8;
    End;

    If Grapher.Device = adScreen Then
    Begin
      If FAlphaChannel <= 0 Then
        Canvas.StretchDraw( Dest, Bmp )
      Else
      Begin
        TmpBitmap := TBitmap.Create;
        Try
          TmpBitmap.PixelFormat := pf24bit;
          TmpBitmap.Width := succ( Dest.Right - Dest.Left );
          TmpBitmap.Height := succ( Dest.Bottom - Dest.Top );
          TmpBitmap.Canvas.StretchDraw( Rect( 0, 0, TmpBitmap.Width, TmpBitmap.Height ), Bmp );
          bgw := BufferBitmap.Width;
          bgh := BufferBitmap.Height;
          BackgFormat := BufferBitmap.PixelFormat;
          For y := 0 To TmpBitmap.Height - 1 Do
          Begin
            bgy := y + Dest.Top;
            If ( bgy < 0 ) Or ( bgy > bgh - 1 ) Then Continue;

            scanlin := BufferBitmap.ScanLine[bgy];
            p1_24 := scanlin;
            p1_32 := scanlin;
            p2 := TmpBitmap.ScanLine[y];
            For x := 0 To TmpBitmap.Width - 1 Do
            Begin
              bgx := x + Dest.Left;
              If ( bgx < 0 ) Or ( bgx > bgw - 1 ) Then
                Continue;
              Case BackgFormat Of
                pf24bit:
                  With p1_24^[bgx] Do
                  Begin
                    rgbtBlue := BlendTable[rgbtBlue - p2^[x].rgbtBlue] + p2^[x].rgbtBlue;
                    rgbtGreen := BlendTable[rgbtGreen - p2^[x].rgbtGreen] + p2^[x].rgbtGreen;
                    rgbtRed := BlendTable[rgbtRed - p2^[x].rgbtRed] + p2^[x].rgbtRed;
                  End;
                pf32bit:
                  With p1_32^[bgx] Do
                  Begin
                    rgbBlue := BlendTable[rgbBlue - p2^[x].rgbtBlue] + p2^[x].rgbtBlue;
                    rgbGreen := BlendTable[rgbGreen - p2^[x].rgbtGreen] + p2^[x].rgbtGreen;
                    rgbRed := BlendTable[rgbRed - p2^[x].rgbtRed] + p2^[x].rgbtRed;
                  End;
              End;
            End;
          End;
        Finally
          TmpBitmap.free;
        End;
      End;
    End
    Else
      EzGraphics.PrintBitmapEx( Canvas, Dest, Bmp, Rect(0, 0, Bmp.Width, Bmp.Height) );

  Finally
    FreeEzERInfo( Alg );
    DeleteObject( bitmap );
    Bmp.Free;
  End;

End;

Procedure TEzERMapper.UpdateExtension;
Begin
  Inherited UpdateExtension;
  If FPoints.Count <> 2 Then Exit;
  If FVector = Nil Then
    FVector := TEzVector.Create( 5 )
  Else
    FVector.Clear;
  With FVector Do
  Begin
    Add( FPoints[0] );
    Add( Point2D( FPoints[0].X, FPoints[1].Y ) );
    Add( FPoints[1] );
    Add( Point2D( FPoints[1].X, FPoints[0].Y ) );
    Add( FPoints[0] );
  End;
End;

function TEzERMapper.IsEqualTo(Entity: TEzEntity; IncludeAttribs: Boolean  = false): Boolean;
begin
  Result:= False;
  if Not ( Entity.EntityID = idERMapper ) Or
    ( Inherited IsEqualTo( Entity, IncludeAttribs ) = False )
    {$IFDEF FALSE}Or
    ( IncludeAttribs And ( FFileName <> TEzERMapper(Entity).FFileName ) ){$ENDIF} Then Exit;
  Result:= True;
end;

initialization

finalization
  If ERMapperDllLoaded Then
    FreeLibrary(HandleERMapperDll);

end.