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

📄 ezgistiff.pas

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

{***********************************************************}
{     EzGIS/CAD Components                                  }
{   (c) 2003 EzSoft Engineering                             }
{         All Rights Reserved                               }
{***********************************************************}

{$I EZ_FLAG.PAS}
Interface

Uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Dialogs,
  EzGraphics, EzEntities, EzLib, EzBase, EzBaseGis
{$IFDEF USE_GRAPHICEX}
  , GraphicEx, GraphicCompression
{$ENDIF}
  ;

Type

  TEzTiffEx = Class( TObject )
  Private
    { Private declarations }
{$IFDEF USE_GRAPHICEX}
    FTIFFGraphic: TTIFFGraphic;
{$ENDIF}
    FBlendTable: Array[SMALLINT] Of Smallint;
    { configuration }
    FPainterObject: TEzPainterObject;
    FWasSuspended: Boolean;
    FAlphaChannel: Byte;
    FBufferBitmap: TBitmap;
    FTileGlobalInfo: TEzTileGlobalInfo;
    Function TileStrip( Const CurrentTileRect: TRect ): Boolean;
    Procedure SetAlphaChannel( Value: Byte );
  Public
    { Public declarations }
    Function TiffFromFileInStrips( Const FileName: String;
      Stream: TStream;
      dc: HDC;
      DestLeft, DestTop, DestWidth, DestHeight,
      DestTotalHeight,
      SourceLeft, SourceTop,
      SourceWidth, SourceHeight: integer ): Boolean;
    { properties }
    Property PainterObject: TEzPainterObject Read FPainterObject Write FPainterObject;
    Property WasSuspended: Boolean Read FWasSuspended;
    { AlphaChannel, 0= opaque, >0 = transparent }
    Property AlphaChannel: byte Read FAlphaChannel Write SetAlphaChannel;
    { the bitmap agains with which will be made transparent this bitmap }
    Property BufferBitmap: TBitmap Read FBufferBitmap Write FBufferBitmap;
  End;

{$IFDEF FALSE}    // no longer used, instead a TEzBandsBitmap is used
  TEzBandsTiff = Class( TEzBandsBitmap )
  Protected
    Function GetEntityID: TEzEntityID; Override;
    Function BasicInfoAsString: string; Override;
  Public
    Procedure Draw( Grapher: TEzGrapher; Canvas: TCanvas; Const Clip: TEzRect;
      DrawMode: TEzDrawMode; Data: Pointer = Nil ); Override;
  End;
{$ENDIF}

Function GetTiffDimensions( Const FileName: String; Stream: TStream;
  Var TiffWidth, TiffHeight: Integer; Var IsCompressed: Boolean ): Boolean;

Implementation

Uses
  EzSystem, EzConsts;

{ TEzTiffEx }

Procedure TEzTiffEx.SetAlphaChannel( Value: Byte );
Var
  x: Integer;
Begin
  For x := -255 To 255 Do
    FBlendTable[x] := ( Value * x ) Shr 8;
  FAlphaChannel := Value;
End;

Function TEzTiffEx.TiffFromFileInStrips( Const FileName: String;
  Stream: TStream;
  dc: HDC;
  DestLeft, DestTop, DestWidth, DestHeight,
  DestTotalHeight,
  SourceLeft, SourceTop,
  SourceWidth, SourceHeight: integer ): Boolean;
{$IFDEF USE_GRAPHICEX}
Var
  CurrentTileRect: TRect;
  dest_MaxTileWidth, dest_MaxTileHeight, vdest_TileHeight: Integer;
  dest_MaxScans: Integer;
  dsty_top, vdest_TilesDown, dest_Residual: Integer;
  dy: extended;
  dest_r: TRect;
  SourceScaleY: extended;
{$ENDIF}
Begin
  result := FALSE;
{$IFDEF USE_GRAPHICEX}

  FTIFFGraphic := TTIFFGraphic.Create;
  If Stream = Nil Then
    FTIFFGraphic.EzOpen( FileName )
  Else
  Begin
    FTIFFGraphic.EzOpenFromStream( Stream );
    Stream.Position := 0;
  End;
  Try
    FTileGlobalInfo.SourceRect := Rect( SourceLeft, SourceTop, SourceLeft + SourceWidth, SourceTop + SourceHeight );

    { some initialization to TileGlobalInfo record }
    //FTileGlobalInfo.lpBitmapInfo:= Pointer(BMPInfo);

    FTileGlobalInfo.TotalBitmapWidth := FTIFFGraphic.ImageProperties.Width;
    FTileGlobalInfo.TotalBitmapHeight := Abs( FTIFFGraphic.ImageProperties.Height );

    FTileGlobalInfo.dc := dc;
    SourceScaleY := FTileGlobalInfo.TotalBitmapHeight / DestTotalHeight;
    FTileGlobalInfo.SourceLastScanLine := SourceTop;

    dest_MaxScans := FTIFFGraphic.ImageProperties.RowsPerStrip[0];
    dest_MaxScans := Round( dest_MaxScans * ( 1 / SourceScaleY ) );
    If dest_MaxScans < 2 Then
      dest_MaxScans := 2;
    If dest_MaxScans > FTileGlobalInfo.TotalBitmapHeight Then
      dest_MaxScans := FTileGlobalInfo.TotalBitmapHeight;

    { count the tiles down }
    dsty_top := 0;
    vdest_TilesDown := 0;
    While ( dsty_Top + dest_MaxScans ) <= DestTotalHeight Do
    Begin
      Inc( vdest_TilesDown );
      Inc( dsty_top, dest_MaxScans );
    End;
    If vdest_TilesDown = 0 Then
    Begin
      FTileGlobalInfo.SourceBandHeight := 0;
      FTileGlobalInfo.SourceFirstTileHeight := FTileGlobalInfo.TotalBitmapHeight;
    End
    Else
    Begin
      dest_Residual := DestTotalHeight Mod dest_MaxScans;
      FTileGlobalInfo.SourceBandHeight :=
        ( FTileGlobalInfo.TotalBitmapHeight * ( 1 - ( dest_Residual / DestTotalHeight ) ) ) / vdest_TilesDown;
      If SourceTop > 0 Then
      Begin
        dy := 0;
        While dy < SourceTop Do
          dy := dy + FTileGlobalInfo.SourceBandHeight;
        FTileGlobalInfo.SourceFirstTileHeight := ( dy - SourceTop );
      End
      Else
      Begin
        FTileGlobalInfo.SourceFirstTileHeight := 0;
      End;
    End;

    { continues }
    dest_r := rect( DestLeft, DestTop, DestLeft + DestWidth, DestTop + DestHeight );

    dest_MaxTileWidth := DestWidth;
    dest_MaxTileHeight := dest_MaxScans;

    CurrentTileRect.Top := dest_r.Top;
    If FTileGlobalInfo.SourceFirstTileHeight <> 0 Then
    Begin
      vdest_TileHeight := Round( FTileGlobalInfo.SourceFirstTileHeight * ( 1 / SourceScaleY ) );
      If vdest_TileHeight = 0 Then
      Begin
        vdest_TileHeight := dest_MaxTileHeight;
        FTileGlobalInfo.SourceFirstTileHeight := 0;
      End;
    End
    Else
      vdest_TileHeight := dest_MaxTileHeight;

    CurrentTileRect.Bottom := dest_r.Top + vdest_TileHeight;
    If CurrentTileRect.Bottom > dest_r.Bottom Then
    Begin
      CurrentTileRect.Bottom := dest_r.Bottom;
      If FTileGlobalInfo.SourceFirstTileHeight <> 0 Then
        FTileGlobalInfo.SourceFirstTileHeight :=
          FTileGlobalInfo.SourceFirstTileHeight * ( abs(CurrentTileRect.Bottom - CurrentTileRect.Top) / vdest_TileHeight )
      Else
        FTileGlobalInfo.SourceBandHeight :=
          FTileGlobalInfo.SourceBandHeight * ( abs(CurrentTileRect.Bottom - CurrentTileRect.Top) / vdest_TileHeight );
    End;
    CurrentTileRect.Left := dest_r.Left;
    CurrentTileRect.Right := dest_r.Left + dest_MaxTileWidth;

    While CurrentTileRect.Top < dest_r.Bottom Do
    Begin
      If Not Windows.IsRectEmpty( CurrentTileRect ) Then
      Begin
        If Not TileStrip( CurrentTileRect ) Then Break;
      End;
      CurrentTileRect.Top := CurrentTileRect.Bottom;
      CurrentTileRect.Bottom := CurrentTileRect.Top + dest_MaxTileHeight;
      If CurrentTileRect.Bottom > dest_r.Bottom Then
      Begin
        CurrentTileRect.Bottom := dest_r.Bottom;
        FTileGlobalInfo.SourceBandHeight :=
          ( abs(CurrentTileRect.Bottom - CurrentTileRect.Top) / dest_MaxTileHeight ) * FTileGlobalInfo.SourceBandHeight;
      End;

      If PainterObject <> Nil Then
      Begin
        If PainterObject.Thread = Nil Then
        Begin
          If PainterObject.IsTimer And
            ( GetTickCount > Cardinal(PainterObject.TickStart + PainterObject.SourceGis.TimerFrequency )) Then
          Begin
            PainterObject.SourceGis.OnGisTimer( PainterObject.SourceGis, FWasSuspended );
            If FWasSuspended Then Exit;

            PainterObject.TickStart := GetTickCount;
          End;
        End Else If PainterObject.Thread.Terminated Then
        Begin
          FWasSuspended:= True;
          Exit;
        End;
      End;
    End;
  Finally
    If Stream = Nil Then
      FTIFFGraphic.EzClose
    Else
      FTIFFGraphic.EzCloseFromStream;
    FTIFFGraphic.Free;
  End;
{$ENDIF}
End;

Function TEzTiffEx.TileStrip( Const CurrentTileRect: TRect ): Boolean;
{$IFDEF USE_GRAPHICEX}
Var
  img_numscans: integer;
  img_start: integer;
  img_end: integer;
  img_StartStrip: Integer;
  img_StopStrip: Integer;
  img_StripFirstScanLine: Integer;
  TmpBitmap: TBitmap;
  x, y, bgx, bgy, bgw, bgh: Integer;
  p1_32: pRGBQuadArray;
  p1_24, p2: pRGBTripleArray;
  scanlin: Pointer;
  BackgFormat: TPixelformat;
  Info: PBitmapInfo;
  Image: Pointer;
  InfoSize, ImageSize: DWORD;
  Tc: Integer;
{$ENDIF}
Begin
{$IFDEF USE_GRAPHICEX}
  img_start := Round( FTileGlobalInfo.SourceLastScanLine );
  If FTileGlobalInfo.SourceFirstTileHeight <> 0 Then
  Begin
    FTileGlobalInfo.SourceLastScanLine :=
      FTileGlobalInfo.SourceLastScanLine + FTileGlobalInfo.SourceFirstTileHeight;
    FTileGlobalInfo.SourceFirstTileHeight := 0;
  End
  Else
  Begin
    FTileGlobalInfo.SourceLastScanLine :=
      FTileGlobalInfo.SourceLastScanLine + FTileGlobalInfo.SourceBandHeight;
  End;

  img_end := Round( FTileGlobalInfo.SourceLastScanLine );
  If img_end > FTileGlobalInfo.TotalBitmapHeight Then
  Begin
    img_end := FTileGlobalInfo.TotalBitmapHeight;
  End;
  img_numscans := img_end - img_start;
  If img_numscans < 1 Then
  Begin
    result := TRUE;
    Exit;
  End;

  { read from img_start to img_end }
  With FTIFFGraphic.ImageProperties Do
  Begin
    img_StartStrip := img_start Div Integer(RowsPerStrip[0]);
    If img_StartStrip > StripCount - 1 Then
      img_StartStrip := StripCount - 1;
    img_StripFirstScanLine := img_start Mod Integer(RowsPerStrip[0]);

⌨️ 快捷键说明

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