ezgraphics.pas

很管用的GIS控件

      x0 := x0 + tE*dx;
      y0 := y0 + tE*dy;
    end;
    Result.AddPoint(x0, y0);
    Result.AddPoint(x1, y1);
    Result.Parts.Add(N);
    Inc(N, 2);
  end;
  if Result.Parts.Count < 2 then
    Result.Parts.Clear;
end;


{ ******************** bitmaps sections *********************** }

{$R-}
Procedure PrintBitmapEx( Canvas: TCanvas; Const DestinationRect: TRect;
  ABitmap: TBitmap; Const SourceRect: TRect );
Var
  Info: PBitmapInfo;
  Image: Pointer;
  Tc: Integer;
  InfoSize, ImageSize: DWORD;
  SourceHeight, SourceWidth: Integer;
Begin
  SourceHeight := Abs( SourceRect.Bottom - SourceRect.Top );
  SourceWidth := Abs( SourceRect.Right - SourceRect.Left );
  GetDIBSizes( ABitmap.Handle, InfoSize, ImageSize );
  Info := GetMemEx( InfoSize );
  Image := GetMemEx( ImageSize );
  Try
    GetDIB( ABitmap.Handle, ABitmap.Palette, Info^, Image^ );
    Tc := SourceRect.Top;
    If Info^.bmiHeader.biHeight > 0 Then
      Tc := Info^.bmiHeader.biHeight - SourceHeight - SourceRect.Top;
    SetStretchBltMode( Canvas.Handle, COLORONCOLOR );
    With DestinationRect Do
      StretchDIBits( Canvas.Handle,
        Left, Top, ( Right - Left ), ( Bottom - Top ),
        SourceRect.Left, Tc, SourceWidth, SourceHeight,
        Image, Info^, DIB_RGB_COLORS, SRCCOPY );
  Finally
    FreeMemEx( Info );
    FreeMemEx( Image );
  End;
End;

Procedure Fill8X8Bitmap( ACanvas: TCanvas;
  DestRect: TRect;
  Bitmap: TBitmap;
  ForeColor, BackColor: TColor );
Var
  Bits: Pointer;
  p1: Integer;
  HeaderSize, BitsSize: DWORD;
  OldHandle, ABrush: HBrush;
  compbitmap: HBitmap;
  BitmapInfo: PBitmapInfo;
Begin

  GetDIBSizes( Bitmap.Handle, HeaderSize, BitsSize );
  BitmapInfo := GetMemEx( HeaderSize );
  Bits := GetMemEx( BitsSize );
  Try
    GetDIB( Bitmap.Handle, Bitmap.Palette, BitmapInfo^, Bits^ );
    With BitmapInfo^.bmiHeader Do
    Begin
      biClrUsed := 2;
      biClrImportant := 0;
    End;
    p1 := 0;
    With BitmapInfo^.bmiColors[p1] Do
    Begin
      rgbRed := GetRValue( ForeColor );
      rgbGreen := GetGValue( ForeColor );
      rgbBlue := GetBValue( ForeColor );
    End;
    p1 := 1;
    With BitmapInfo^.bmiColors[p1] Do
    Begin
      rgbRed := GetRValue( BackColor );
      rgbGreen := GetGValue( BackColor );
      rgbBlue := GetBValue( BackColor );
    End;

    compbitmap := CreateDIBitmap( ACanvas.Handle, BitmapInfo^.bmiHeader,
      CBM_INIT, Bits, BitmapInfo^, DIB_RGB_COLORS );

    ABrush := CreatePatternBrush( compbitmap );

    DeleteObject( compbitmap );

    OldHandle := SelectObject( ACanvas.Handle, ABrush );

    With DestRect Do
      PatBlt( ACanvas.Handle, left, top, ( right - left ), ( bottom - top ), PATCOPY );

    SelectObject( ACanvas.handle, OldHandle );

    DeleteObject( ABrush );

  Finally
    FreeMemEx( BitmapInfo );
    FreeMemEx( Bits );
  End;
End;

Procedure PrinterFill8X8Bitmap( ACanvas: TCanvas;
  DestRect: TRect;
  Bitmap: TBitmap;
  ForeColor, BackColor: TColor;
  Factor: Double );
Var
  Header, Bits: Pointer;
  p1: Integer;
  HeaderSize, BitsSize: DWORD;
  ScaledWidth, ScaledHeight,
    DeltaX, DeltaY: integer;
  ScaledRect: TRect;
  WorkBmp: TBitmap;
Begin
  GetDIBSizes( Bitmap.Handle, HeaderSize, BitsSize );
  Header := GetMemEx( HeaderSize );
  Bits := GetMemEx( BitsSize );

  WorkBmp := TBitmap.Create;
  Try

    With WorkBmp, DestRect Do
    Begin
      Width := Right - Left;
      Height := Bottom - Top;
    End;

    GetDIB( Bitmap.Handle, Bitmap.Palette, Header^, Bits^ );
    ScaledWidth := trunc( PBitmapInfo( Header )^.bmiHeader.biWidth * factor );
    ScaledHeight := trunc( PBitmapInfo( Header )^.bmiHeader.biHeight * factor );

    { modify the bitmap }
    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;

    DeltaX := 0;
    While DeltaX < WorkBmp.Width Do
    Begin
      DeltaY := 0;
      While DeltaY < WorkBmp.Height Do
      Begin
        ScaledRect := Rect( DeltaX, DeltaY, DeltaX + ScaledWidth, DeltaY + ScaledHeight );
        With ScaledRect Do
          StretchDIBits( WorkBmp.Canvas.Handle,
            Left,
            Top,
            Right - Left,
            Bottom - Top,
            0,
            0,
            Bitmap.Width,
            Bitmap.Height,
            Bits,
            Windows.TBitmapInfo( Header^ ),
            DIB_RGB_COLORS,
            SRCCOPY );
        Inc( DeltaY, ScaledHeight );
      End;
      Inc( DeltaX, ScaledWidth );
    End;
    PrintBitmapEx( ACanvas,
      DestRect,
      WorkBmp,
      Rect( 0, 0, WorkBmp.Width, WorkBmp.Height ) );
  Finally
    WorkBmp.free;
    FreeMemEx( Header );
    FreeMemEx( Bits );
  End;
End;

Procedure PolygonScreenFill8X8Bitmap( Canvas: TCanvas; Grapher: TEzGrapher;
  Var Vertices: Array Of TPoint; Var Parts: Array Of Integer;
  PartCount: Integer; Bitmap: TBitmap; ForeColor, BackColor: TColor );
Var
  Bits: Pointer;
  Index: Integer;
  HeaderSize, BitsSize: DWORD;
  OldHandle, TmpBrush: HBrush;
  CompBitmap: HBitmap;
  BitmapInfo: PBitmapInfo;
  SavedBitMap: TBitmap;
  I, N, K, Idx1, Idx2, BW, BH: Integer;
  Xmin, Ymin, Xmax, Ymax: Integer;
  PolyRgn: HRgn;
  pointarr: PPointArray;
Begin
  if PartCount = 0 then Exit;
  If Not ( Bitmap.Monochrome And ( Bitmap.Width = 8 ) And ( Bitmap.Height = 8 ) ) Then
  Begin
    PolygonPrinterFill8X8Bitmap( Canvas, Grapher, Vertices, Parts, PartCount,
      Bitmap, ForeColor, BackColor, 1, False );
    Exit;
  End;

  GetDIBSizes( Bitmap.Handle, HeaderSize, BitsSize );
  BitmapInfo := GetMemEx( HeaderSize );
  Bits := GetMemEx( BitsSize );
  Try
    GetDIB( Bitmap.Handle, Bitmap.Palette, BitmapInfo^, Bits^ );
    With BitmapInfo^.bmiHeader Do
    Begin
      biClrUsed := 2;
      biClrImportant := 0;
    End;
    With BitmapInfo^.bmiColors[0] Do
    Begin
      rgbRed := GetRValue( ForeColor );
      rgbGreen := GetGValue( ForeColor );
      rgbBlue := GetBValue( ForeColor );
    End;
    Index := 1;
    With BitmapInfo^.bmiColors[Index] Do
    Begin
      rgbRed := GetRValue( BackColor );
      rgbGreen := GetGValue( BackColor );
      rgbBlue := GetBValue( BackColor );
    End;

    CompBitmap := CreateDIBitmap( Canvas.Handle, BitmapInfo^.bmiHeader,
      CBM_INIT, Bits, BitmapInfo^, DIB_RGB_COLORS );

    TmpBrush := CreatePatternBrush( CompBitmap );

    DeleteObject( CompBitmap );

    {Create Transparent Bitmap}

    Xmin := 0;  // to make happy the compiler
    Ymin := 0;  // to make happy the compiler
    BW := 0;    // to make happy the compiler
    BH := 0;    // to make happy the compiler

    SavedBitMap := nil;
    if BackColor=clNone then
    begin
      Xmin := MaxInt;
      Ymin := MaxInt;
      Xmax := 0;
      Ymax := 0;
      N := 0;
      for I:= 0 to PartCount - 1 do Inc(N, Parts[I]);
      for I := Low(vertices) to N - 1 do
      begin
        Xmin := EzLib.IMin(Vertices[I].X, Xmin);
        Ymin := EzLib.IMin(Vertices[I].Y, Ymin);
        Xmax := EzLib.IMax(Vertices[I].X, Xmax);
        Ymax := EzLib.IMax(Vertices[I].Y, Ymax);
      end;
      BW := Xmax - Xmin;
      BH := Ymax - Ymin;
      if ( BW > 0 ) and ( BH > 0 ) then
      begin
        SavedBitMap := TBitmap.Create;
        SavedBitMap.PixelFormat:= pf24bit;
        SavedBitMap.Width := BW;
        SavedBitMap.Height:= BH;
        OldHandle := SelectObject(SavedBitMap.Canvas.Handle, TmpBrush);
        Bitblt( SavedBitMap.Canvas.Handle, 0, 0, BW, BH,
                     Bitmap.Canvas.handle, 0, 0, PATCOPY );
        SelectObject(SavedBitMap.Canvas.handle, OldHandle);
      end else
        BackColor:= clBlack;
    end;

    OldHandle := SelectObject( Canvas.Handle, TmpBrush );

    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

      PolyRgn:= 0;  // to make happy the compiler
      if BackColor=clNone then
      begin
        if PartCount = 1 then
           PolyRgn := CreatePolygonRgn( Vertices, Parts[I], 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);

        BitBlt(Canvas.handle, Xmin, Ymin, BW, BH, SavedBitmap.Canvas.Handle, 0,0, SRCAND);

      end else
      begin
        If PartCount = 1 Then
          Polygon( Canvas.Handle, Vertices, Parts[0] )
        Else
        Begin
          if Win32Platform = VER_PLATFORM_WIN32_NT then
            PolyPolygon( Canvas.Handle, Vertices, Parts, PartCount )
          else
          begin
            pointarr:= @Vertices[K];
            Polygon( Canvas.Handle, pointarr^, Parts[I] );
            Inc( K, Parts[I] );
          end;
        End;
      end;

      SelectObject( Canvas.handle, OldHandle );

      DeleteObject( TmpBrush );

      if BackColor=clNone then
      begin
        if Grapher<>nil then
          Grapher.CanvasRegionStacker.Pop(Canvas)
        else
        begin
          SelectClipRgn(Canvas.Handle, 0);
          DeleteObject(PolyRgn);
        end;
      end;
    end;
    if BackColor=clNone then
      SavedBitMap.Free;
  Finally
    FreeMemEx( BitmapInfo );
    FreeMemEx( Bits );
  End;
End;

// Print polygon filled with 8x8 bitmap pattern

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 );
Var
  Header, Bits: Pointer;
  HeaderSize, BitsSize: DWORD;
  ScaledRect: TRect;
  DestRect: TRect;
  PolyRgn: HRgn;
  I, K, Idx1, Idx2, p1, N: Integer;
  ScaledWidth: Integer;
  ScaledHeight: Integer;
  DeltaX: Integer;
  DeltaY: integer;
  TmpWidth: Integer;
  TmpHeight: Integer;
  cnt: Integer;
  Xmin: Integer;
  Xmax: Integer;
  Ymin: Integer;
  Ymax: Integer;
  XRop: DWORD;
  pointarr: EzLib.PPointArray;

  { some plotters will gets full printing patterns as bitmaps }
  Procedure DrawAsBitmap;
  Begin
    GetDIBSizes( Bitmap.Handle, HeaderSize, BitsSize );
    Header := GetMemEx( HeaderSize );
    Bits := GetMemEx( BitsSize );

    Try
      With DestRect Do
      Begin