cdib.pas

Delphi控件

unit cDIB;

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: cDIB.PAS, released August 28, 2000.

The Initial Developer of the Original Code is Peter Morris ([e-mail]),
Portions created by Peter Morris are Copyright (C) 2000 Peter Morris.
All Rights Reserved.

Purpose of file:
This is the main drawing engine.

Contributor(s):
RiceBall <[e-mail]>
Hans-J黵gen Schnorrenberg

Last Modified: March 31, 2003

You may retrieve the latest version of this file at http://www.droopyeyes.com


Known Issues:
-----------------------------------------------------------------------------}
//Modifications
(*
Date:   October 14, 2000
By:     Peter Morris
Change: Made SCANLINE property public to TWINDIB and TMemoryDIB

Date:   October 14, 2000
By:     Peter Morris
Change: Added a PIXELS property

Date:   November 7, 2000
By:     Peter Morris
Change: Made the Region created by MakeRGN* more accurate

Date:   November 10, 2000
By:     Peter Morris
Change: Rotated RGB TColor to ABGR in SetTransparentColor

Date:   November 18, 2000
By:     Peter Morris
Change: Added LoadPicture(+FromStream) and SavePicture(+ToStream) for custom
        picture formatting

Date:   November 21, 2000
By:     Peter Morris
Change: LoadDataFromStream and SaveDataToStream moved to PUBLIC section

Date:   November 30, 2000
By:     Peter Morris
Change: Made SCANLINE property public in TAbstractSuperDIB instead

Date:   December 2, 2000
By:     Peter Morris
Change: Made Width / Height public properties

Date:   June 24, 2001
By:     RiceBall
Change: Added TAbstractSuperDIB.DrawTiled

Date:   August 21, 2001
By:     Peter Morris
Change: Added DrawAll method

Date:   August 23, 2001
By:     Peter Morris
Change: Fixed a bug in GetTransparentColor

Date:   Nov 15, 2001
By:     CAM Moorman  ([e-mail])
Change: Added Export routines for Image and Mask

Date:   Aug 11, 2002
By:     Peter Morris
Change: Added support for 32bit bitmaps in ImportPicture (Red, Green, Blue, Alpha)

Date:   August 12, 2002
By:     Hans-J黵gen Schnorrenberg
Change: Removed byte-swapping in SetTransparentColor

Date:   March 27, 2003
By:     Peter Morris
Change: Improved GetRotatedSizes + DIB.Draw so that rotated / zoomed dibs
        do not "wobble"

Date:   March 31, 2003
By:     Peter Morris
Change: DrawGlyph and DrawGlyphTween added.

Date:   March 18, 2004
By:     Peter Morris
Change: Opacity blit routines altered so that the transparent colour is preserved
        when drawing.

Date:   Jan 3, 2005
By:     Peter Morris
Change: RotoZoom was not scaling correctly

Date:   Jan 3, 2005
By:     Peter Morris
Change: Changed the SIN/COS table to be multiplied by 65536 instead of 256, this
        gives far better precision, and removes the "jitter" experienced when
        rotating/zooming an image.  It does mean however that images are now
        limited to 65535 by 65535.

*)


{$O-} //This is needed as some routines are called implicitly, and will be omitted
      //by the compiler
{$A+} //This is default anyway, but we need alignment for DIBS, and it wont hurt.

interface

uses
  Classes, Windows, SysUtils, Graphics, Math, JPeg, Dialogs, cDIBPalette;

type
//  TAngle = 0..359;
  TDIBFilter = class;
  EDIBError = class(Exception);

  //For getting / settings the Pixels property
  TPixel32 = packed record
    Blue,
    Green,
    Red,
    Alpha: Byte;
  end;

  TAbstractSuperDIB = class;
  TAbstractSuperDIBClass = class of TAbstractSuperDIB;

  //A blitter proc is a routine which copies data from 1 DIB to another.
  //New blitter procs may be written.  To activate the blitter proc you will
  //need to override ChangeBlitter.
  TBlitterProc = procedure(SourceData, DestData: Pointer;
    SourceModulo, DestModulo: DWord;
    NoPixels, NoLines: Integer) of object;

  //The main class that all DIBs are created from, this holds all functions for
  //manipulating the data, but does not actually create any data
  TAbstractSuperDIB = class(TPersistent)
  private
    FAngle: Extended;
    FAutoSize: Boolean;
    FClipRect: TRect;
    FHeight: Word;
    FMasked: Boolean;
    FOpacity: Byte;
    FOwnedData: Boolean;
    FScaleX,
    FScaleY: Extended;
    FTransparent: Boolean;
    FTransparentColor: TPixel32;
    FTransparentMode: TTransparentMode;
    FUpdateCount: DWord;
    FWidth: Word;
    FOnChange: TNotifyEvent;

    procedure FreeTheData;
    procedure CreateTheData;
    //Can't see why you would want to override these property routines !
    function GetScanline(Row: Integer): Pointer;
    procedure SetClipRect(const aRect: TRect);
    procedure SetTransparent(const Value: Boolean);
    procedure SetTransparentColor(Value: TColor);
    procedure SetTransparentMode(const Value: TTransparentMode);
    function GetTransparentColor: TColor;
    function GetPixel(X, Y: Integer): TPixel32;
    procedure SetPixel(X, Y: Integer; Value: TPixel32);
  protected
    //Which blitter routine to use for drawing
    FBlitter: TBlitterProc;
    FData: Pointer;

    //Abstract method which MUST be overridden
    procedure CreateData; virtual; abstract;
    procedure FreeData; virtual; abstract;

    //Streaming
    procedure DefineProperties(Filer: TFiler); override;

    //OnChange notification, and an opportunity to alter the blitter proc
    procedure Changed; virtual;
    procedure ChangeBlitter; virtual;

    //Blitter routines
    procedure BlitMaskAsGrayScale(SourceData, DestData: Pointer;
      SourceModulo, DestModulo: DWord;
      NoPixels, NoLines: Integer); virtual;
    //Only blit the mask
    procedure BlitMaskOnly(SourceData, DestData: Pointer;
      SourceModulo, DestModulo: DWord;
      NoPixels, NoLines: Integer); virtual;
    //Copy the bytes, no special effects
    procedure SolidBlit(SourceData, DestData: Pointer;
      SourceModulo, DestModulo: DWord;
      NoPixels, NoLines: Integer); virtual;
    procedure SolidBlitO(SourceData, DestData: Pointer;
      SourceModulo, DestModulo: DWord;
      NoPixels, NoLines: Integer); virtual;
    //Copy the bytes, take into account the Mask value
    procedure MaskedBlit(SourceData, DestData: Pointer;
      SourceModulo, DestModulo: DWord;
      NoPixels, NoLines: Integer); virtual;
    procedure MaskedBlitO(SourceData, DestData: Pointer;
      SourceModulo, DestModulo: DWord;
      NoPixels, NoLines: Integer); virtual;
    //Blit the image, but not Transparent Colors
    procedure TransparentBlit(SourceData, DestData: Pointer;
      SourceModulo, DestModulo: DWord;
      NoPixels, NoLines: Integer); virtual;
    procedure TransparentBlitO(SourceData, DestData: Pointer;
      SourceModulo, DestModulo: DWord;
      NoPixels, NoLines: Integer); virtual;


    //property routines
    procedure SetAngle(const Value: Extended); virtual;
    procedure SetAutoSize(const Value: Boolean); virtual;
    procedure SetHeight(const aValue: Word); virtual;
    procedure SetMasked(const Value: Boolean); virtual;
    procedure SetOpacity(const Value: Byte); virtual;
    procedure SetScale(const Value: Extended); virtual;
    procedure SetScaleX(const Value: Extended); virtual;
    procedure SetScaleY(const Value: Extended); virtual;
    procedure SetWidth(const aValue: Word); virtual;

    property Angle: Extended read FAngle write SetAngle;
    property AutoSize: Boolean read FAutoSize write SetAutoSize;
    property ClipRect: TRect read FClipRect write SetClipRect;
    property Masked: Boolean read FMasked write SetMasked;
    property Opacity: Byte read FOpacity write SetOpacity;
    property Pixels[X, Y: Integer]: TPixel32 read GetPixel write SetPixel;
    property Scale: Extended read FScaleX write SetScale;
    property ScaleX: Extended read FScaleX write SetScaleX;
    property ScaleY: Extended read FScaleY write SetScaleY;
    property Transparent: Boolean read FTransparent write SetTransparent;
    property TransparentColor: TColor read GetTransparentColor write SetTransparentColor;
    property TransparentMode: TTransparentMode 
      read FTransparentMode write SetTransparentMode;

    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  public
    //Standard create routines
    constructor Create; overload; virtual;
    constructor Create(aWidth, aHeight: Word); overload; virtual;
    //This constructor creates a new header for manipulation, but points FData
    //at existing data from another DIB.  This allows 2 DIBs to Share data.
    //There will be a problem if the source DIB is freed !
    constructor CreateReplicaOf(aSource: TAbstractSuperDIB); virtual;
    destructor Destroy; override;

    //Updates stuff
    procedure BeginUpdate;
    procedure EndUpdate;

    //Formatted loading / saving
    procedure LoadDataFromStream(S: TStream); virtual;
    procedure LoadPicture(const Filename: string);
    procedure LoadPictureFromStream(FileExt: string; Stream: TStream);
    procedure SaveDataToStream(S: TStream); virtual;
    procedure SavePicture(const Filename: string);
    procedure SavePictureToStream(FileExt: string; Stream: TStream);

    //Apply a 3x3 matrix
    procedure ApplyFilter(AFilter: TDIBFilter); virtual;
    //Like AssignTo, but ONLY for header information, not data
    procedure AssignHeaderTo(Dest: TPersistent); virtual;
    procedure AssignTo(Dest: TPersistent); override;
    //Like AssignTo, but ONLY the data, not the header
    procedure CopyPicture(Source: TAbstractSuperDIB);
    procedure StretchCopyPicture(Source: TAbstractSuperDIB);

    //Draw will calculate the parameters for the BlitterProc, and then call
    //the current Blitter routine
    procedure Draw(DestX, DestY: Integer;
      DestWidth, DestHeight: Integer;
      Dest: TAbstractSuperDIB;
      SrcX, SrcY: Word); virtual;
    //Will just do a solidblit ignoring mask / transparency etc
    procedure DrawAll(DestX, DestY: Integer;
      DestWidth, DestHeight: Integer;
      Dest: TAbstractSuperDIB;
      SrcX, SrcY: Word); virtual;
    //This will draw part of an image, as a TSpeedButton draws its Glyph property
    procedure DrawGlyph(DestX, DestY, GlyphIndex, NumGlyphs: Integer; Dest: TAbstractSuperDIB);
    //This will draw a mix between two Glyphs (similar to above)
    procedure DrawGlyphTween(DestX, DestY, NumGlyphs: Integer; Dest: TAbstractSuperDIB;
      Min, Max, Position: Integer; LoopFrames: Boolean);
    //This will copy the mask only, not RGB values, it uses BlitMaskOnly
    procedure DrawMask(DestX, DestY: Integer;
      DestWidth, DestHeight: Integer;
      Dest: TAbstractSuperDIB;
      SrcX, SrcY: Word); virtual;
    procedure DrawMaskAsGrayScale(DestX, DestY: Integer;
      DestWidth, DestHeight: Integer;
      Dest: TAbstractSuperDIB;
      SrcX, SrcY: Word); virtual;
    procedure DrawTiled(DestRect: TRect; Dest: TAbstractSuperDIB);

    //Import a mask from a file.  The file MUST be 8bit GreyScale
    procedure ImportMask(AFilename: string); dynamic;
    //Import a picture from any supported file
    procedure ImportPicture(AFilename: string); dynamic;
    //Import a mask from a file.  The file MUST be 8bit GreyScale
    procedure ExportMask(AFilename: string);
    //Import a picture from any supported file
    procedure ExportPicture(AFilename: string);
    //Converts the DIB to a RGN by using the MASK
    function MakeRGN(const AMasklevel: Byte): HRGN;
    //Converts the DIB to a RGN by using a TColor
    function MakeRGNFromColor(ATransparentColor: TColor): HRGN;
    //Destroys the current data, and references an existing DIB's data
    procedure PointDataAt(aSource: TAbstractSuperDIB); virtual;
    //Fill the DIB with a color
    procedure QuickFill(aColor: TColor); virtual;
    //Fill a sub-rect of the DIB with a color
    procedure QuickFillRect(aColor: TColor; aLeft, aTop, aWidth, aHeight: Integer);
      virtual;
    //Render8BIT will render to an 8BIT dc using a DIBPalette with UseTable=True
    procedure Render8Bit(DestDC: HDC; X, Y, aWidth,
      aHeight: Integer; XSrc, YSrc: Word; ROP: Cardinal;
      Palette: TDIBPalette); virtual;
    //Override ResetHeader in child classes if you add new properties
    procedure ResetHeader; virtual;
    procedure ReSize(aWidth, aHeight: Word); virtual;
    //This routine handles Rotate AND Zoom at the same time, Good eh ?
    procedure RotoZoom(D: TAbstractSuperDIB); virtual;
    //Set all the masked values in the DIB to Opacity
    procedure SetMaskedValues(const Opacity: Byte);
    //Is the DIB drawable or not
    function Valid: Boolean; virtual;

    property Height: Word read FHeight write SetHeight;
    property ScanLine[Row: Integer]: Pointer read GetScanLine;
    property Width: Word read FWidth write SetWidth;
  published
  end;

  TCustomWinDIB = class(TAbstractSuperDIB)
  private
    FDC: HDC;
    FBitmap: HBitmap;
    FOldBitmap: HBitmap;
    FCanvas: TCanvas;
    procedure DoCanvasChanged(Sender: TObject);
  protected
    procedure CreateData; override;
    procedure FreeData; override;

    property Canvas: TCanvas read FCanvas;
    property Handle: HDC read FDC;
  public
    constructor Create; override;
    destructor Destroy; override;
  published
  end;

  TWinDIB = class(TCustomWinDIB)
  private
  protected
  public
    property ClipRect;
    property Data: Pointer read FData;
    property ScaleX;
    property ScaleY;
    property ScanLine;
    property Pixels;
  published
    property Angle;
    property AutoSize;
    property Canvas;
    property Handle;
    property Height;
    property Masked;
    property Opacity;
    property Scale;
    property Transparent;
    property TransparentColor;
    property TransparentMode;
    property Width;
  end;

  //A MemoryDIB uses the GlobalHeap to store its data.
  //(No handles for example)
  TCustomMemoryDIB = class(TAbstractSuperDIB)
  private
    FImageFilename: string;
    FMaskFilename: string;
    FSaveImageData: Boolean;
    procedure ReadImageFilename(Reader: TReader);
    procedure ReadMaskFilename(Reader: TReader);
    procedure WriteImageFilename(Writer: TWriter);
    procedure WriteMaskFilename(Writer: TWriter);
  protected
    procedure DefineProperties(Filer: TFiler); override;
    procedure CreateData; override;
    procedure FreeData; override;
  public
    constructor Create; override;
    procedure AssignTo(Dest: TPersistent); override;
    procedure ImportMask(AFilename: string); override;
    procedure ImportPicture(AFilename: string); override;
    procedure LoadDataFromStream(S: TStream); override;
    procedure SaveDataToStream(S: TStream); override;

    property ImageFilename: string read FImageFilename;
    property SaveImageData: Boolean read FSaveImageData write FSaveImageData;
    property MaskFilename: string read FMaskFilename;
  published
  end;

  TMemoryDIB = class;
  TMemoryDIBClass = class of TMemoryDIB;
  TMemoryDIB = class(TCustomMemoryDIB)
  private
  protected
  public
    property ClipRect;
    property ScaleX;
    property ScaleY;
    property ScanLine;
    property Pixels;
  published
    property Angle;
    property AutoSize;
    property Height;
    property Masked;
    property Opacity;
    property Scale;
    property Transparent;
    property TransparentColor;
    property TransparentMode;
    property Width;
  end;

  //A DIBFilter will apply a 3x3 matrix to a DIB.  Simple !
  TDIBFilter = class(TPersistent)
  private
    FRedBias,
    FGreenBias,
    FBlueBias: Smallint;
    FOpacity: Byte;
    FFactor: Integer;
  protected
  public
    Data: array[0..8] of SmallInt;
    constructor Create; virtual;
    class function GetDisplayName: string;

  published
    property BlueBias: Smallint read FBlueBias write FBlueBias;
    property GreenBias: Smallint read FGreenBias write FGreenBias;
    property Factor: Integer read FFactor write FFactor;
    property Opacity: Byte read FOpacity write FOpacity;
    property RedBias: Smallint read FRedBias write FRedBias;
  end;



function GetRotatedPoint(X, Y, Radius, Angle: Extended): TPoint;
function GetRotatedSize(Width, Height: Word; Angle: Extended;
  ScaleX, ScaleY: Extended): TPoint;
function Largest(A, B: Integer): Integer;
function RelativeAngle(X1, Y1, X2, Y2: Integer): Extended;
function SafeAngle(Angle: Extended): Extended;
function Smallest(A, B: Integer): Integer;


function ColorToPixel32(const AColor: TColor): TPixel32; register;
function Pixel32ToColor(const APixel32: TPixel32): TColor; register;
function CosTable1(Angle: Extended): Integer;
function CosTable2(Angle: Extended): Integer;
function SinTable1(Angle: Extended): Integer;
function SinTable2(Angle: Extended): Integer;

const
  cNullPixel32: TPixel32 = (Blue:0; Green:0; Red:0; Alpha:0);

implementation

uses
  cDIBFormat, cDIBCompressor;

const
  cRectAllocs = 400;
  cMaxRectChunks = 2000;
  CSinCosTablePrecision = 1000;

var
  GSinTable1, GCosTable1, GSinTable2, GCosTable2: array[0..(360 * CSinCosTablePrecision) - 1] of Integer;

type
  PByte = ^Byte;
  PDWord = ^DWord;

function CosTable1(Angle: Extended): Integer;
begin
  Result := GCosTable1[Trunc(Angle * CSinCosTablePrecision)];
end;

function CosTable2(Angle: Extended): Integer;
begin
  Result := GCosTable2[Trunc(Angle * CSinCosTablePrecision)];
end;


function SinTable1(Angle: Extended): Integer;
begin
  Result := GSinTable1[Trunc(Angle * CSinCosTablePrecision)];
end;


function SinTable2(Angle: Extended): Integer;