ezgraphics.pas

很管用的GIS控件

        TmpWidth := Right - Left;
        TmpHeight := Bottom - Top;
      End;

      GetDIB( Bitmap.Handle, Bitmap.Palette, Header^, Bits^ );
      If Trunc( Factor ) <> Factor Then
      Begin
        ScaledWidth := Round( Factor + 0.5 ) * PBitmapInfo( Header )^.bmiHeader.biWidth;
        ScaledHeight := Round( Factor + 0.5 ) * PBitmapInfo( Header )^.bmiHeader.biHeight;
      End
      Else
      Begin
        ScaledWidth := Round( Factor * PBitmapInfo( Header )^.bmiHeader.biWidth );
        ScaledHeight := Round( Factor * PBitmapInfo( Header )^.bmiHeader.biHeight );
      End;

      If ( Bitmap.Width = 8 ) And ( Bitmap.Height = 8 ) And Bitmap.Monochrome Then
      Begin
        With PBitmapInfo( Header )^.bmiHeader Do
        Begin
          biClrUsed := 2;
          biClrImportant := 0;
        End;
        p1 := 0;
        With PBitmapInfo( Header )^.bmiColors[p1] Do
        Begin
          rgbRed := GetRValue( ForeColor );
          rgbGreen := GetGValue( ForeColor );
          rgbBlue := GetBValue( ForeColor );
        End;
        p1 := 1;
        With PBitmapInfo( Header )^.bmiColors[p1] Do
        Begin
          rgbRed := GetRValue( BackColor );
          rgbGreen := GetGValue( BackColor );
          rgbBlue := GetBValue( BackColor );
        End;
      End;

      if BackColor=clNone then XRop := SRCAND else XRop := SRCCOPY;

      DeltaX := 0;
      While DeltaX < TmpWidth Do
      Begin
        DeltaY := 0;
        While DeltaY < TmpHeight Do
        Begin
          ScaledRect := Rect( DeltaX, DeltaY, DeltaX + ScaledWidth, DeltaY + ScaledHeight );
          OffsetRect( ScaledRect, xmin, ymin );
          With ScaledRect Do
            StretchDIBits( Canvas.Handle, Left, Top, Right - Left, Bottom - Top,
              0, 0, Bitmap.Width, Bitmap.Height, Bits,
              Windows.TBitmapInfo( Header^ ), DIB_RGB_COLORS, XRop );
          Inc( DeltaY, ScaledHeight );
        End;
        Inc( DeltaX, ScaledWidth );
      End;
    Finally
      FreeMemEx( Header );
      FreeMemEx( Bits );
    End;
  End;

  {This method will print 8x8 bitmap patterns as small rectangles.
   That way the plotter will not crash with so much bitmaps}
  Procedure DrawAsVectors;
  Var
    cntleft, cnttop, StartLeft, StartTop, ifactor, bw, bh, tmpleft, tmptop: Integer;
    WorkArray: Array[0..1000, 0..1000] Of Boolean;
    TmpRect: TRect;
  Begin
    For cntleft := 0 To Bitmap.Width - 1 Do
      For cnttop := 0 To Bitmap.Height - 1 Do
        WorkArray[cntleft, cnttop] := Bitmap.Canvas.Pixels[cnttop, cntleft] = clBlack;
    ifactor := Round( Factor + 0.5 );
    bw := Bitmap.Width * ifactor;
    bh := Bitmap.Height * ifactor;
    If Grapher <> Nil Then
      Grapher.SaveCanvas( Canvas );
    (* Paint the background color*)
    Canvas.Brush.Style := bsSolid;
    Canvas.Pen.Style := psSolid;
    Canvas.Pen.Mode := pmCopy;
    If BackColor <> clWhite Then
    Begin
      Canvas.Brush.Color := BackColor;
      Canvas.Pen.Color := BackColor;
      With DestRect Do
        Canvas.Rectangle( Left, Top, Right, Bottom );
    End;
    (* now the forecolor *)
    Canvas.Brush.Color := ForeColor;
    Canvas.Pen.Color := ForeColor;

    StartTop := DestRect.Top;
    While StartTop <= DestRect.Bottom Do
    Begin
      StartLeft := DestRect.Left;
      While StartLeft <= DestRect.Right Do
      Begin
        cnttop := 0;
        While cnttop <= 7 Do
        Begin
          cntleft := 0;
          While cntleft <= 7 Do
          Begin
            If WorkArray[cntleft, cnttop] Then
            Begin
              tmpleft := StartLeft + cntleft * ifactor;
              tmptop := StartTop + cnttop * ifactor;
              TmpRect := Rect( tmpleft, tmptop, tmpleft + Pred( ifactor ), tmptop + Pred( ifactor ) );
              With TmpRect Do
                Canvas.Rectangle( Left, Top, Right, Bottom );
            End;
            Inc( cntleft );
          End;
          Inc( cnttop );
        End;
        Inc( StartLeft, bw );
      End;
      Inc( StartTop, bh );
    End;
    If Grapher <> Nil Then
      Grapher.RestoreCanvas( Canvas );
  End;

Begin
  If PartCount = 0 Then Exit;

  Xmin := MaxInt;
  Ymin := MaxInt;
  Xmax := 0;
  Ymax := 0;
  N := 0;
  For cnt := 0 To PartCount - 1 Do
    Inc( N, Parts[cnt] );
  For cnt := Low( Vertices ) To N - 1 Do
  Begin
    Xmin := EzLib.IMin( Vertices[cnt].X, Xmin );
    Ymin := EzLib.IMin( Vertices[cnt].Y, Ymin );
    Xmax := EzLib.IMax( Vertices[cnt].X, Xmax );
    Ymax := EzLib.IMax( Vertices[cnt].Y, Ymax );
  End;
  DestRect := Rect( Xmin, Ymin, Xmax, Ymax );

  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    Idx1:= 0;
    Idx2:= 0;
  end else
  begin
    Idx1:= 0;
    Idx2:= PartCount - 1;
  end;

  K:= 0;

  For I:= Idx1 to Idx2 do
  begin
    If PartCount = 1 Then
      PolyRgn := CreatePolygonRgn( Vertices, Parts[0], WINDING )
    Else
    begin
      if Win32Platform = VER_PLATFORM_WIN32_NT then
        PolyRgn := CreatePolyPolygonRgn( Vertices, Parts, PartCount, ALTERNATE )
      else
      begin
        pointarr:= @Vertices[K];
        PolyRgn := CreatePolygonRgn( pointarr^, Parts[I], WINDING);
        Inc( K, Parts[I] );
      end;
    end;
    If PolyRgn = 0 Then Exit;

    If Grapher <> Nil Then
      Grapher.CanvasRegionStacker.Push( Canvas, PolyRgn )
    Else
      SelectClipRgn( Canvas.Handle, PolyRgn );

    Try
      If ( Bitmap.Monochrome ) And ( Bitmap.Width = 8 ) And ( Bitmap.Height = 8 ) Then
      Begin
        If PlotterOptimized Then
          { draw as vectors }
          DrawAsVectors
        Else
          { draw as bitmap }
          DrawAsBitmap;
      End
      Else
        DrawAsBitmap;
    Finally
      If Grapher <> Nil Then
        Grapher.CanvasRegionStacker.Pop( Canvas )
      Else
      Begin
        SelectClipRgn( Canvas.Handle, 0 );
        DeleteObject( PolyRgn );
      End;
    End;
  End;
End;
{$R-}

Function GetMemEx( size: DWORD ): pointer;
Begin
  Try
    result := Pointer( GlobalAlloc( GPTR, size ) );
  Except
    result := Nil;
  End;
End;

Function FreeMemEx( p: pointer ): pointer;
Begin
  Try
    If p = Nil Then
    Begin
      result := Nil;
    End
    Else
    Begin
      result := Pointer( GlobalFree( THandle( p ) ) );
    End;
  Except
    result := Nil;
  End;
End;

{ LoadDIBFromStream }

Function LoadDIBFromStream( TheStream: TStream;
  Var lpBitmapInfo: PBITMAPINFO;
  Var lpBits: Pointer;
  Var BitmapWidth: integer;
  Var BitmapHeight: integer ): Boolean;
Var
  bmf: TBITMAPFILEHEADER;
  TheFileSize: integer;
  BitmapHeaderSize: integer;
  TheImageSize: integer;
Begin
  lpBitmapInfo := Nil;
  lpBits := Nil;
  BitmapWidth := 0;
  BitmapHeight := 0;
  If TheStream = Nil Then
  Begin
    result := FALSE;
    exit;
  End;
  Try
    TheFileSize := TheStream.Size - TheStream.Position;
    TheStream.ReadBuffer( bmf, sizeof( TBITMAPFILEHEADER ) );
  Except
    result := FALSE;
    exit;
  End;
  BitmapHeaderSize := bmf.bfOffBits - sizeof( TBITMAPFILEHEADER );
  TheImageSize := TheFileSize - integer( bmf.bfOffBits );
  If ( ( bmf.bfType <> $4D42 ) Or ( integer( bmf.bfOffBits ) < 1 ) Or
    ( TheFileSize < 1 ) Or ( BitmapHeaderSize < 1 ) Or ( TheImageSize < 1 ) Or
    ( TheFileSize < ( sizeof( TBITMAPFILEHEADER ) + BitmapHeaderSize + TheImageSize ) ) ) Then
  Begin
    result := FALSE;
    exit;
  End;
  lpBitmapInfo := GetMemEx( BitmapHeaderSize );
  Try
    TheStream.ReadBuffer( lpBitmapInfo^, BitmapHeaderSize );
  Except
    Try
      FreeMemEx( lpBitmapInfo );
    Except
    End;
    lpBitmapInfo := Nil;
    result := FALSE;
    exit;
  End;
  Try
    BitmapWidth := lpBitmapInfo^.bmiHeader.biWidth;
    BitmapHeight := abs( lpBitmapInfo^.bmiHeader.biHeight );
    If lpBitmapInfo^.bmiHeader.biSizeImage <> 0 Then
    Begin
      TheImageSize := lpBitmapInfo^.bmiHeader.biSizeImage;
    End
    Else
    Begin
      TheImageSize := ( ( ( ( ( lpBitmapInfo^.bmiHeader.biWidth *
        lpBitmapInfo^.bmiHeader.biBitCount ) + 31 ) And Not 31 ) shr 3 ) *
        ABS( lpBitmapInfo^.bmiHeader.biHeight ) );
    End;
  Except
    Try
      FreeMemEx( lpBitmapInfo );
    Except
    End;
    lpBitmapInfo := Nil;
    BitmapWidth := 0;
    BitmapHeight := 0;
    result := FALSE;
    exit;
  End;
  If ( BitmapWidth < 1 ) Or ( BitmapHeight < 1 ) Or ( TheImageSize < 32 ) Then
  Begin
    Try
      FreeMemEx( lpBitmapInfo );
    Except
    End;
    lpBitmapInfo := Nil;
    BitmapWidth := 0;
    BitmapHeight := 0;
    result := FALSE;
    exit;
  End;
  lpBits := GetMemEx( TheImageSize );
  Try
    TheStream.ReadBuffer( lpBits^, TheImageSize );
  Except
    Try
      FreeMemEx( lpBits );
    Except
    End;
    Try
      FreeMemEx( lpBitmapInfo );
    Except
    End;
    lpBits := Nil;
    lpBitmapInfo := Nil;
    result := FALSE;
    exit;
  End;
  result := True;
End;

{ LoadDIBFromFile }

Function LoadDIBFromFile( Const FileName: String;
  Var lpBitmapInfo: PBITMAPINFO;
  Var lpBits: Pointer;
  Var BitmapWidth: integer;
  Var BitmapHeight: integer ): Boolean;
Var
  TheFileStream: TFileStream;
Begin
  lpBitmapInfo := Nil;
  lpBits := Nil;
  BitmapWidth := 0;
  BitmapHeight := 0;
  Try
    TheFileStream := TFileStream.Create( FileName, fmOpenRead Or fmShareDenyWrite );
  Except
    result := FALSE;
    exit;
  End;
  result := LoadDIBFromStream( TheFileStream,
    lpBitmapInfo,
    lpBits,
    BitmapWidth,
    BitmapHeight );

  TheFileStream.Free;
End;

{ LoadDIBFromTBitmap }

Function LoadDIBFromTBitmap( ABitmap: TBitmap;
  Var lpBitmapInfo: PBITMAPINFO;
  Var lpBits: Pointer;
  Var BitmapWidth: integer;
  Var BitmapHeight: integer ): Boolean;
Var
  TheStream: TMemoryStream;
Begin
  lpBitmapInfo := Nil;
  lpBits := Nil;
  BitmapWidth := 0;
  BitmapHeight := 0;
  TheStream := TMemoryStream.Create;
  Try
    ABitmap.SaveToStream( TheStream );
    TheStream.Position := 0;
  Except
    TheStream.Free;
    result := FALSE;
    exit;
  End;
  result := LoadDIBFromStream( TheStream, lpBitmapInfo, lpBits, BitmapWidth, BitmapHeight );
  TheStream.Free;
End;

{Constructor TEzBitmapEx.Create;
Var
  HeaderSize: Integer;
Begin
  Inherited Create;
  HeaderSize := SizeOf( TBitmapInfoHeader ) + 3 * SizeOf( TRGBQuad );
  Fbmi := GetMemEx( HeaderSize );
  With Fbmi^.bmiHeader Do
  Begin
    biSize := SizeOf( Fbmi^.bmiHeader );
    biWidth := 0;
    biHeight := 0;
    biPlanes := 1;
    biBitCount := 24;
    biCompression := BI_RGB;
    biSizeImage := 0;
    biXPelsPerMeter :