cdibs.int

Delphi Dib usage component... D3-4-5 but there is CBuilder OBJ files. u can use them. :>)

unit CDIBs;

//-----------------------------------------------
// Provides a class for handling DIBs before displaying them.
// TBitmap on the other hand always realizes the palettes and converts the DIB
// to a DDB
//
// Author: Lubomir Antonov   Version: 1.3
//
// Ver 1.1
//    Added properties:
//
//       Header       - a pointer to the TBitmapInfoHeader of the DIB
//       Bits         - a pointer to the beginning of the bits of the DIB
//       ColorTable   - a pointer to the palette of the DIB
//       ColorTableSize - number of colors in the palette
//       Colors       - an array of the colors of the palette
//       BitDepth     - bit depth, or bits-per-pixel of the DIB
//
// Ver 1.2
//    Added support for assigning to and from a TBlobField
//
// Ver 1.22
//    Fixed a bug with 8-bit bitmaps
//    Added method CreateFromSection for easy section extraction
//
// Ver 1.23
//    Fixed a bug with assigning 256-color DIBs to a TBitmap
//
// Ver 1.3
//    Ported the class to Delphi 3 (Delphi 2 compatibility remains)
//    Removed dependance on undocumented string constants for error messages
//    Implemented direct drawing of the DIB on a canvas:
//      now TDIB objects can be used everywhere a TGraphic can, including
//      the Draw method of a canvas, and assigning to a TPicture as in:
//        Picture.Graphic := ADib
//    Removed TBlobField support from the TDIB class to remove dependancy
//      on BDE. Moved the support to a separate class TBlobDIB in unit BlobDib
//
//-----------------------------------------------

interface

uses Windows, Classes, Graphics, Clipbrd, SysUtils;

{$IFDEF VER90}
{$DEFINE DELPHI2}
{$ENDIF}
{$IFDEF VER91}
{$DEFINE DELPHI2}
{$ENDIF}
{$IFDEF VER92}
{$DEFINE DELPHI2}
{$ENDIF}
{$IFDEF VER93}
{$DEFINE DELPHI2}
{$ENDIF}

type
  // Internal class to hold the image data
  TDIBImage = class
    private
      FRefCount: Integer;
      FMemoryImage: TCustomMemoryStream;
      FWidth: Integer;
      FHeight: Integer;
      FDIBHeader: Pointer;
      //FDIBClrTable: Pointer;
      FDIBBits: Pointer;
      FMonochrome: Boolean;
      procedure Reference;
      procedure Release;
      procedure FreeHandle;
  end;

  EDIBError = class( Exception );

  TDIB = class( TGraphic )
    private
      FImage: TDIBImage;
      procedure FreeContext;
      procedure AssignFromDIB( Source: TDIB );
      procedure AssignFromClipboard( Source: TClipboard );
      procedure AssignFromBitmap( Source: TBitmap );
      procedure AssignToBitmap( Dest: TBitmap );
      procedure InitBIFromBC( var BI: TBitmapInfoHeader;
        var BC: TBitmapCoreHeader; ImageSize: Integer );
      procedure NewImage( NewWidth, NewHeight: Integer; NewMonochrome: Boolean;
        NewImage: TCustomMemoryStream; NewDIBHeader, NewDIBBits: Pointer);
      procedure ReadStream( Size: Longint; Stream: TStream );
      procedure WriteStream( Stream: TStream; WriteSize: Boolean );
      procedure LoadDataFromStream( Stream: TStream );
      function GetMonochrome: Boolean;
      procedure SetMonochrome( Value: Boolean );
      function CopyHeader( Image: TMemoryStream; AWidth, AHeight: Integer ):
        LongInt;
      procedure CopyImage( ALeft, ATop, AWidth, AHeight: Integer;
        AMonochrome: Boolean; Dest: TDIB );
      function GetHeader: PBitmapInfoHeader;
      function GetBits: Pointer;
      function GetColorTable: Pointer;
      function GetColorTableSize: Integer;
      function GetColors( Index: Cardinal ): TColor;
      function GetBitDepth: Word;
    protected
      procedure AssignTo( Dest: TPersistent ); override;
{$IFDEF DELPHI2}
      function GetPalette: HPALETTE; virtual;
{$ELSE}
      function GetPalette: HPALETTE; override;
{$ENDIF}
      procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
      function GetEmpty: Boolean; override;
      function GetHeight: Integer; override;
      function GetWidth: Integer; override;
      procedure SetWidth(Value: Integer); override;
      procedure SetHeight(Value: Integer); override;
      procedure ReadData( Stream: TStream ); override;
      procedure WriteData( Stream: TStream ); override;
      function CreateStockPalette: HPALETTE;
    public
      constructor Create; override;
      destructor Destroy; override;
      procedure Assign( Source: TPersistent ); override;
      procedure LoadFromClipboardFormat( AFormat: Word; AData: THandle;
        APalette: HPALETTE ); override;
      procedure LoadFromStream( Stream: TStream ); override;
      procedure LoadFromResourceName( Instance: THandle; const ResName: String );
      procedure LoadFromResourceID( Instance: THandle; ResID: Integer );
      procedure SaveToClipboardFormat( var AFormat: Word; var AData: THandle;
        var APalette: HPALETTE ); override;
      procedure SaveToStream( Stream: TStream ); override;
      procedure CopySection( ALeft, ATop, AWidth, AHeight: Integer );
      procedure CreateFromSection( Src: TDIB; ALeft, ATop, AWidth,
                                   AHeight: Integer );
      function CanConvert16to24: Boolean;
      procedure Convert16to24;
      function DIBToBitmap( Pal: HPALETTE ): HBITMAP;
      property Monochrome: Boolean read GetMonochrome write SetMonochrome;
      property Header: PBitmapInfoHeader read GetHeader;
      property Bits: Pointer read GetBits;
      property ColorTable: Pointer read GetColorTable;
      property ColorTableSize: Integer read GetColorTableSize;
      property Colors[Index: Cardinal]: TColor read GetColors;
      property BitDepth: Word read GetBitDepth;
  end;

implementation