⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ezgistiff.pas

📁 很管用的GIS控件
💻 PAS
📖 第 1 页 / 共 2 页
字号:

    img_StopStrip := img_end Div Integer(RowsPerStrip[0]);
    If img_StopStrip > StripCount - 1 Then
      img_StopStrip := StripCount - 1;
  End;

  FTIFFGraphic.EzReadStrips( img_StartStrip, img_StopStrip );

  GetDIBSizes( FTIFFGraphic.Handle, InfoSize, ImageSize );
  Info := GetMemEx( InfoSize );
  Image := GetMemEx( ImageSize );
  Try
    GetDIB( FTIFFGraphic.Handle, FTIFFGraphic.Palette, Info^, Image^ );
    If ( AlphaChannel = 0 ) Or ( BufferBitmap = Nil ) Then
    Begin
      // BufferBitmap=nil means we are printing
      { draw the bitmap }
      SetStretchBltMode( FTileGlobalInfo.dc, COLORONCOLOR );
      Tc := img_StripFirstScanLine;
      If Info^.bmiHeader.biHeight > 0 Then
        Tc := Info^.bmiHeader.biHeight - img_numscans - img_StripFirstScanLine;
      StretchDIBits( FTileGlobalInfo.dc,
        CurrentTileRect.Left,
        CurrentTileRect.Top,
        abs(CurrentTileRect.Right - CurrentTileRect.Left),
        abs(CurrentTileRect.Bottom - CurrentTileRect.Top),
        FTileGlobalInfo.SourceRect.Left, // left
        Tc, // top
        FTileGlobalInfo.SourceRect.Right - FTileGlobalInfo.SourceRect.Left, // width
        img_numscans, // height
        Image,
        Info^,
        DIB_RGB_COLORS, SRCCOPY );
    End
    Else If ( AlphaChannel > 0 ) And ( BufferBitmap <> Nil ) And
      ( BufferBitmap.PixelFormat In [pf24bit, pf32bit] ) Then
    Begin
      { will do it transparent }
      TmpBitmap := TBitmap.Create;
      Try
        { create a temporary bitmap }
        TmpBitmap.PixelFormat := pf24bit;
        TmpBitmap.Width := abs(CurrentTileRect.Right - CurrentTileRect.Left);
        TmpBitmap.Height := abs(CurrentTileRect.Bottom - CurrentTileRect.Top);
        { now stretch the original bitmap onto this one }
        SetStretchBltMode( TmpBitmap.Canvas.Handle, COLORONCOLOR );
        Tc := img_StripFirstScanLine;
        If Info^.bmiHeader.biHeight > 0 Then
          Tc := Info^.bmiHeader.biHeight - img_numscans - img_StripFirstScanLine;
        StretchDIBits(
          TmpBitmap.Canvas.Handle,
          0,
          0,
          abs(CurrentTileRect.Right - CurrentTileRect.Left),
          abs(CurrentTileRect.Bottom - CurrentTileRect.Top),
          FTileGlobalInfo.SourceRect.Left, // left
          Tc, // top
          FTileGlobalInfo.SourceRect.Right - FTileGlobalInfo.SourceRect.Left, // width
          img_numscans, // height
          Image,
          Info^,
          DIB_RGB_COLORS, SRCCOPY );
        { now combine the two bitmaps: FBufferBitmap and TmpBitmap }
        BackgFormat := BufferBitmap.PixelFormat;
        bgw := BufferBitmap.Width;
        bgh := BufferBitmap.Height;
        For y := 0 To TmpBitmap.Height - 1 Do
        Begin
          { it is assumed that FBufferBitmap.PixelFormat in [pf24bit, pf32bit] }
          bgy := y + CurrentTileRect.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 + CurrentTileRect.Left;
            If ( bgx < 0 ) Or ( bgx > bgw - 1 ) Then
              Continue;
            Case BackgFormat Of
              pf24bit:
                With p1_24^[bgx] Do
                Begin
                  rgbtBlue := FBlendTable[rgbtBlue - p2^[x].rgbtBlue] + p2^[x].rgbtBlue;
                  rgbtGreen := FBlendTable[rgbtGreen - p2^[x].rgbtGreen] + p2^[x].rgbtGreen;
                  rgbtRed := FBlendTable[rgbtRed - p2^[x].rgbtRed] + p2^[x].rgbtRed;
                End;
              pf32bit:
                With p1_32^[bgx] Do
                Begin
                  rgbBlue := FBlendTable[rgbBlue - p2^[x].rgbtBlue] + p2^[x].rgbtBlue;
                  rgbGreen := FBlendTable[rgbGreen - p2^[x].rgbtGreen] + p2^[x].rgbtGreen;
                  rgbRed := FBlendTable[rgbRed - p2^[x].rgbtRed] + p2^[x].rgbtRed;
                End;
            End;
          End;
        End;
      Finally
        TmpBitmap.free;
      End;
    End;
  Finally
    FreeMemEx( Info );
    FreeMemEx( Image );
  End;
  result := TRUE;
{$ENDIF}
End;

Function GetTiffDimensions( Const FileName: String;
  Stream: TStream;
  Var TiffWidth, TiffHeight: integer;
  Var IsCompressed: Boolean ): Boolean;
{$IFDEF USE_GRAPHICEX}
Var
  FTIFFGraphic: TTIFFGraphic;
{$ENDIF}
Begin
{$IFDEF USE_GRAPHICEX}
  IsCompressed := false; // not important
  FTIFFGraphic := TTIFFGraphic.Create;
  Try
    If Stream = Nil Then
      FTIFFGraphic.EzOpen( FileName )
    Else
    Begin
      FTIFFGraphic.EzOpenFromStream( Stream );
      Stream.Position := 0;
    End;
    TiffWidth := FTIFFGraphic.ImageProperties.Width;
    TiffHeight := FTIFFGraphic.ImageProperties.Height;
    Result := true;
  Finally
    If Stream = Nil Then
      FTIFFGraphic.EzClose
    Else
      FTIFFGraphic.EzCloseFromStream;
    FTIFFGraphic.Free;
  End;
{$ENDIF}
End;

{$IFDEF FALSE}
{------------------------------------------------------------------------------}
{                  TEzBandsTiff                                               }
{------------------------------------------------------------------------------}

Function TEzBandsTiff.BasicInfoAsString: string;
Begin
  Result:= Format(sBandsTiffInfo, [FPoints.AsString,FileName,AlphaChannel]);
End;

Function TEzBandsTiff.GetEntityID: TEzEntityID;
Begin
  result := idBandsTiff;
End;

Procedure TEzBandsTiff.Draw( Grapher: TEzGrapher; Canvas: TCanvas;
  Const Clip: TEzRect; DrawMode: TEzDrawMode; Data: Pointer = Nil );
Var
  BmpRect, Src, Dest: TRect;
  Work: TEzRect;
  fx, fy: Double;
  BitmapWidth, BitmapHeight, L, T, W, H: Integer;
  TiffEx: TEzTiffEx;
  IsCompressed: boolean;
  filnam: String;
  PreloadedSet: Boolean;
  Index: Integer;

  Procedure DrawAsFrame;
  var
    Oldstyle: TPenstyle;
  Begin
    Oldstyle:= Canvas.Pen.Style;
    If DrawMode = dmRubberpen Then
      Canvas.Pen.Style:= psDot;
    DrawPoints.DrawOpened( Canvas, Clip, FBox, Grapher, PenTool.FPenStyle, self.GetTransformMatrix, DrawMode );
    If DrawMode = dmRubberpen Then
      Canvas.Pen.Style:= Oldstyle;
  End;

Begin
  If Not IsBoxInBox2D( FBox, Clip ) Then Exit;

  If DrawMode <> dmNormal Then
  Begin
    DrawAsFrame;
    Exit;
  End;
{$IFDEF USE_GRAPHICEX}
  PreloadedSet := false;
  If ( Stream = Nil ) And Ez_Preferences.UsePreloadedBandedImages Then
  Begin
    Index := Ez_Preferences.PreloadedBandedImages.IndexOf( FileName );
    If Index >= 0 Then
    Begin
      Stream := TStream( Ez_Preferences.PreloadedBandedImages.Objects[Index] );
      Stream.Position := 0;
      PreloadedSet := true;
    End;
  End;

  If Stream = Nil Then
  Begin
    filnam := AddSlash( Ez_Preferences.CommonSubDir ) + FileName;
    If Not FileExists( filnam ) Then
    Begin
      DrawAsFrame;
      Exit;
    End;
  End;

  If Not GetTiffDimensions( filnam, Stream, BitmapWidth, BitmapHeight, IsCompressed ) Then
  Begin
    If PreloadedSet Then
      Stream := Nil;
    Exit;
  End;

  TiffEx := TEzTiffEx.Create;
  Try
    TiffEx.BufferBitmap := Self.BufferBitmap;
    TiffEx.AlphaChannel := Self.AlphaChannel;
    TiffEx.PainterObject := Self.PainterObject;
    If IsBoxFullInBox2D( fBox, Clip ) Then
    Begin
      Dest := ReorderRect( Grapher.RealToRect( FBox ) );
      With Dest Do
        TiffEx.TiffFromFileInStrips( filnam,
          Stream,
          Canvas.Handle,
          Left,
          Top,
          ( Right - Left ),
          ( Bottom - Top ),
          ( Bottom - Top ),
          0, 0,
          BitmapWidth,
          BitmapHeight );
    End
    Else
    Begin
      // Calculate image rectangle
      Work := IntersectRect2D( FBox, Clip );

      If IsRectEmpty2D( Work ) Then
        Exit;

      Dest := Grapher.RealToRect( Work );
      BmpRect := Grapher.RealToRect( fBox );
      Src := Dest;
      With BmpRect Do
      Begin
        fx := BitmapWidth / ( Right - Left );
        fy := BitmapHeight / ( bottom - top );
        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;

      With Dest Do
        TiffEx.TiffFromFileInStrips( filnam,
          Stream,
          Canvas.Handle,
          Left,
          Top,
          ( Right - Left ),
          ( Bottom - Top ),
          ( BmpRect.Bottom - BmpRect.Top ),
          L, T, W, H );
    End;
    WasSuspended := TiffEx.WasSuspended;
  Finally
    TiffEx.Free;
    If PreloadedSet Then
      Stream := Nil;
  End;
{$ELSE}
  DrawAsFrame;
{$ENDIF}
End;
{$ENDIF}

End.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -