home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1996 August / VPR9608A.BIN / del20try / install / data.z / GRAPHICS.INT < prev    next >
Text File  |  1996-05-08  |  24KB  |  623 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,96 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit Graphics;
  11.  
  12. {$P+,S-,W-,R-}
  13. {$C PRELOAD}
  14.  
  15. interface
  16.  
  17. uses Windows, SysUtils, Classes;
  18.  
  19. { Graphics Objects }
  20.  
  21. type
  22.   TColor = $80000000..$7FFFFFFF;
  23.  
  24. const
  25.   clScrollBar = COLOR_SCROLLBAR or $80000000;
  26.   clBackground = COLOR_BACKGROUND or $80000000;
  27.   clActiveCaption = COLOR_ACTIVECAPTION or $80000000;
  28.   clInactiveCaption = COLOR_INACTIVECAPTION or $80000000;
  29.   clMenu = COLOR_MENU or $80000000;
  30.   clWindow = COLOR_WINDOW or $80000000;
  31.   clWindowFrame = COLOR_WINDOWFRAME or $80000000;
  32.   clMenuText = COLOR_MENUTEXT or $80000000;
  33.   clWindowText = COLOR_WINDOWTEXT or $80000000;
  34.   clCaptionText = COLOR_CAPTIONTEXT or $80000000;
  35.   clActiveBorder = COLOR_ACTIVEBORDER or $80000000;
  36.   clInactiveBorder = COLOR_INACTIVEBORDER or $80000000;
  37.   clAppWorkSpace = COLOR_APPWORKSPACE or $80000000;
  38.   clHighlight = COLOR_HIGHLIGHT or $80000000;
  39.   clHighlightText = COLOR_HIGHLIGHTTEXT or $80000000;
  40.   clBtnFace = COLOR_BTNFACE or $80000000;
  41.   clBtnShadow = COLOR_BTNSHADOW or $80000000;
  42.   clGrayText = COLOR_GRAYTEXT or $80000000;
  43.   clBtnText = COLOR_BTNTEXT or $80000000;
  44.   clInactiveCaptionText = COLOR_INACTIVECAPTIONTEXT or $80000000;
  45.   clBtnHighlight = COLOR_BTNHIGHLIGHT or $80000000;
  46.   cl3DDkShadow = COLOR_3DDKSHADOW or $80000000;
  47.   cl3DLight = COLOR_3DLIGHT or $80000000;
  48.   clInfoText = COLOR_INFOTEXT or $80000000;
  49.   clInfoBk = COLOR_INFOBK or $80000000;
  50.  
  51.   clBlack = TColor($000000);
  52.   clMaroon = TColor($000080);
  53.   clGreen = TColor($008000);
  54.   clOlive = TColor($008080);
  55.   clNavy = TColor($800000);
  56.   clPurple = TColor($800080);
  57.   clTeal = TColor($808000);
  58.   clGray = TColor($808080);
  59.   clSilver = TColor($C0C0C0);
  60.   clRed = TColor($0000FF);
  61.   clLime = TColor($00FF00);
  62.   clYellow = TColor($00FFFF);
  63.   clBlue = TColor($FF0000);
  64.   clFuchsia = TColor($FF00FF);
  65.   clAqua = TColor($FFFF00);
  66.   clLtGray = TColor($C0C0C0);
  67.   clDkGray = TColor($808080);
  68.   clWhite = TColor($FFFFFF);
  69.   clNone = TColor($1FFFFFFF);
  70.   clDefault = TColor($20000000);
  71.  
  72. const
  73.   cmBlackness = BLACKNESS;
  74.   cmDstInvert = DSTINVERT;
  75.   cmMergeCopy = MERGECOPY;
  76.   cmMergePaint = MERGEPAINT;
  77.   cmNotSrcCopy = NOTSRCCOPY;
  78.   cmNotSrcErase = NOTSRCERASE;
  79.   cmPatCopy = PATCOPY;
  80.   cmPatInvert = PATINVERT;
  81.   cmPatPaint = PATPAINT;
  82.   cmSrcAnd = SRCAND;
  83.   cmSrcCopy = SRCCOPY;
  84.   cmSrcErase = SRCERASE;
  85.   cmSrcInvert = SRCINVERT;
  86.   cmSrcPaint = SRCPAINT;
  87.   cmWhiteness = WHITENESS;
  88.  
  89. type
  90.   HMETAFILE = THandle;
  91.   HENHMETAFILE = THandle;
  92.  
  93.   EInvalidGraphic = class(Exception);
  94.   EInvalidGraphicOperation = class(Exception);
  95.  
  96.   TGraphic = class;
  97.   TBitmap = class;
  98.   TIcon = class;
  99.   TMetafile = class;
  100.  
  101.   TResData = record
  102.     Handle: THandle;
  103.   end;
  104.  
  105.   TFontStyle = (fsBold, fsItalic, fsUnderline, fsStrikeOut);
  106.   TFontStyles = set of TFontStyle;
  107.   TFontPitch = (fpDefault, fpVariable, fpFixed);
  108.   TFontName = string[LF_FACESIZE - 1];
  109.  
  110.   TFontData = record
  111.     Handle: HFont;
  112.     Height: Integer;
  113.     Pitch: TFontPitch;
  114.     Style: TFontStyles;
  115.     Name: TFontName;
  116.   end;
  117.  
  118.   TPenStyle = (psSolid, psDash, psDot, psDashDot, psDashDotDot, psClear,
  119.     psInsideFrame);
  120.   TPenMode = (pmBlack, pmWhite, pmNop, pmNot, pmCopy, pmNotCopy,
  121.     pmMergePenNot, pmMaskPenNot, pmMergeNotPen, pmMaskNotPen, pmMerge,
  122.     pmNotMerge, pmMask, pmNotMask, pmXor, pmNotXor);
  123.  
  124.   TPenData = record
  125.     Handle: HPen;
  126.     Color: TColor;
  127.     Width: Integer;
  128.     Style: TPenStyle;
  129.   end;
  130.  
  131.   TBrushStyle = (bsSolid, bsClear, bsHorizontal, bsVertical,
  132.     bsFDiagonal, bsBDiagonal, bsCross, bsDiagCross);
  133.  
  134.   TBrushData = record
  135.     Handle: HBrush;
  136.     Color: TColor;
  137.     Bitmap: TBitmap;
  138.     Style: TBrushStyle;
  139.   end;
  140.  
  141.   PResource = ^TResource;
  142.   TResource = record
  143.     Next: PResource;
  144.     RefCount: Integer;
  145.     Handle: THandle;
  146.     HashCode: Word;
  147.     case Integer of
  148.       0: (Data: TResData);
  149.       1: (Font: TFontData);
  150.       2: (Pen: TPenData);
  151.       3: (Brush: TBrushData);
  152.   end;
  153.  
  154.   TGraphicsObject = class(TPersistent)
  155.   protected
  156.     procedure Changed; dynamic;
  157.   public
  158.     property OnChange: TNotifyEvent;
  159.   end;
  160.  
  161.   TFont = class(TGraphicsObject)
  162.   protected
  163.     function GetHandle: HFont;
  164.     function GetHeight: Integer;
  165.     function GetName: TFontName;
  166.     function GetPitch: TFontPitch;
  167.     function GetSize: Integer;
  168.     function GetStyle: TFontStyles;
  169.     procedure SetColor(Value: TColor);
  170.     procedure SetHandle(Value: HFont);
  171.     procedure SetHeight(Value: Integer);
  172.     procedure SetName(const Value: TFontName);
  173.     procedure SetPitch(Value: TFontPitch);
  174.     procedure SetSize(Value: Integer);
  175.     procedure SetStyle(Value: TFontStyles);
  176.   public
  177.     constructor Create;
  178.     destructor Destroy; override;
  179.     procedure Assign(Source: TPersistent); override;
  180.     property Handle: HFont;
  181.     property PixelsPerInch: Integer;
  182.   published
  183.     property Color: TColor;
  184.     property Height: Integer;
  185.     property Name: TFontName;
  186.     property Pitch: TFontPitch default fpDefault;
  187.     property Size: Integer;
  188.     property Style: TFontStyles;
  189.   end;
  190.  
  191.   TPen = class(TGraphicsObject)
  192.   protected
  193.     function GetColor: TColor;
  194.     procedure SetColor(Value: TColor);
  195.     function GetHandle: HPen;
  196.     procedure SetHandle(Value: HPen);
  197.     procedure SetMode(Value: TPenMode);
  198.     function GetStyle: TPenStyle;
  199.     procedure SetStyle(Value: TPenStyle);
  200.     function GetWidth: Integer;
  201.     procedure SetWidth(Value: Integer);
  202.   public
  203.     constructor Create;
  204.     destructor Destroy; override;
  205.     procedure Assign(Source: TPersistent); override;
  206.     property Handle: HPen;
  207.   published
  208.     property Color: TColor default clBlack;
  209.     property Mode: TPenMode default pmCopy;
  210.     property Style: TPenStyle default psSolid;
  211.     property Width: Integer default 1;
  212.   end;
  213.  
  214.   TBrush = class(TGraphicsObject)
  215.   protected
  216.     function GetBitmap: TBitmap;
  217.     procedure SetBitmap(Value: TBitmap);
  218.     function GetColor: TColor;
  219.     procedure SetColor(Value: TColor);
  220.     function GetHandle: HBrush;
  221.     procedure SetHandle(Value: HBrush);
  222.     function GetStyle: TBrushStyle;
  223.     procedure SetStyle(Value: TBrushStyle);
  224.   public
  225.     constructor Create;
  226.     destructor Destroy; override;
  227.     procedure Assign(Source: TPersistent); override;
  228.     property Bitmap: TBitmap;
  229.     property Handle: HBrush;
  230.   published
  231.     property Color: TColor default clWhite;
  232.     property Style: TBrushStyle default bsSolid;
  233.   end;
  234.  
  235.   TFillStyle = (fsSurface, fsBorder);
  236.   TFillMode = (fmAlternate, fmWinding);
  237.  
  238.   TCopyMode = Longint;
  239.  
  240.   TCanvasStates = (csHandleValid, csFontValid, csPenValid, csBrushValid);
  241.   TCanvasState = set of TCanvasStates;
  242.  
  243.   TCanvas = class(TPersistent)
  244.   protected
  245.     procedure Changed; virtual;
  246.     procedure Changing; virtual;
  247.     procedure CreateHandle; virtual;
  248.     procedure RequiredState(ReqState: TCanvasState);
  249.   public
  250.     constructor Create;
  251.     destructor Destroy; override;
  252.     procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
  253.     procedure BrushCopy(const Dest: TRect; Bitmap: TBitmap;
  254.       const Source: TRect; Color: TColor);
  255.     procedure Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
  256.     procedure CopyRect(const Dest: TRect; Canvas: TCanvas;
  257.       const Source: TRect);
  258.     procedure Draw(X, Y: Integer; Graphic: TGraphic);
  259.     procedure DrawFocusRect(const Rect: TRect);
  260.     procedure Ellipse(X1, Y1, X2, Y2: Integer);
  261.     procedure FillRect(const Rect: TRect);
  262.     procedure FloodFill(X, Y: Integer; Color: TColor; FillStyle: TFillStyle);
  263.     procedure FrameRect(const Rect: TRect);
  264.     procedure LineTo(X, Y: Integer);
  265.     procedure MoveTo(X, Y: Integer);
  266.     procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
  267.     procedure Polygon(const Points: array of TPoint);
  268.     procedure Polyline(const Points: array of TPoint);
  269.     procedure Rectangle(X1, Y1, X2, Y2: Integer);
  270.     procedure Refresh;
  271.     procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
  272.     procedure StretchDraw(const Rect: TRect; Graphic: TGraphic);
  273.     function TextHeight(const Text: string): Integer;
  274.     procedure TextOut(X, Y: Integer; const Text: string);
  275.     procedure TextRect(Rect: TRect; X, Y: Integer; const Text: string);
  276.     function TextWidth(const Text: string): Integer;
  277.     property ClipRect: TRect;
  278.     property Handle: HDC;
  279.     property PenPos: TPoint;
  280.     property Pixels[X, Y: Integer]: TColor;
  281.     property OnChange: TNotifyEvent;
  282.     property OnChanging: TNotifyEvent;
  283.   published
  284.     property Brush: TBrush;
  285.     property CopyMode: TCopyMode default cmSrcCopy;
  286.     property Font: TFont;
  287.     property Pen: TPen;
  288.   end;
  289.  
  290.   { The TGraphic class is a abstract base class for dealing with graphic images
  291.     such as metafile, bitmaps and icons; but is not limited to such.
  292.       LoadFromFile - Read the graphic from the file system.  The old contents of
  293.         the graphic are lost.  If the file is not of the right format, an
  294.         exception will be generated.
  295.       SaveToFile - Writes the graphic to disk in the file provided.
  296.       LoadFromStream - Like LoadFromFile except source is a stream (e.g.
  297.         TBlobStream).
  298.       SaveToStream - stream analogue of SaveToFile.
  299.       LoadFromClipboardFormat - Replaces the current image with the data
  300.         provided.  If the TGraphic does not support that format it will generate
  301.         an exception.
  302.       SaveToClipboardFormats - Converts the image to a clipboard format.  If the
  303.         image does not support being translated into a clipboard format it
  304.         will generate an exception.
  305.       Height - The native, unstretched, height of the graphic.
  306.       Width - The native, unstretched, width of the graphic.
  307.       OnChange - Called whenever the graphic changes }
  308.  
  309.   TGraphic = class(TPersistent)
  310.   protected
  311.     constructor Create; virtual;
  312.     procedure Changed(Sender: TObject);
  313.     procedure DefineProperties(Filer: TFiler); override;
  314.     procedure Draw(ACanvas: TCanvas; const Rect: TRect); virtual; abstract;
  315.     function Equals(Graphic: TGraphic): Boolean; virtual;
  316.     function GetEmpty: Boolean; virtual; abstract;
  317.     function GetHeight: Integer; virtual; abstract;
  318.     function GetWidth: Integer; virtual; abstract;
  319.     procedure ReadData(Stream: TStream); virtual;
  320.     procedure SetHeight(Value: Integer); virtual; abstract;
  321.     procedure SetWidth(Value: Integer); virtual; abstract;
  322.     procedure WriteData(Stream: TStream); virtual;
  323.   public
  324.     procedure LoadFromFile(const Filename: string); virtual;
  325.     procedure SaveToFile(const Filename: string); virtual;
  326.     procedure LoadFromStream(Stream: TStream); virtual; abstract;
  327.     procedure SaveToStream(Stream: TStream); virtual; abstract;
  328.     procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  329.       APalette: HPALETTE); virtual; abstract;
  330.     procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
  331.       var APalette: HPALETTE); virtual; abstract;
  332.     property Empty: Boolean;
  333.     property Height: Integer;
  334.     property Modified: Boolean;
  335.     property Width: Integer;
  336.     property OnChange: TNotifyEvent;
  337.   end;
  338.  
  339.   TGraphicClass = class of TGraphic;
  340.  
  341.   { TPicture }
  342.   { TPicture is a TGraphic container.  It is used in place of a TGraphic if the
  343.     graphic can be of any TGraphic class.  LoadFromFile and SaveToFile are
  344.     polymorphic. For example, if the TPicture is holding an Icon, you can
  345.     LoadFromFile a bitmap file, where if the class was TIcon you could only read
  346.     .ICO files.
  347.       LoadFromFile - Reads a picture from disk.  The TGraphic class created
  348.         determined by the file extension of the file.  If the file extension is
  349.         not recognized an exception is generated.
  350.       SaveToFile - Writes the picture to disk.
  351.       LoadFromClipboardFormat - Reads the picture from the handle provided in
  352.         the given clipboard format.  If the format is not supported, an
  353.         exception is generated.
  354.       SaveToClipboardFormats - Allocates a global handle and writes the picture
  355.         in its native clipboard format (CF_BITMAP for bitmaps, CF_METAFILE
  356.         for metafiles, etc.).  Formats will contain the formats written.
  357.         Returns the number of clipboard items written to the array pointed to
  358.         by Formats and Datas or would be written if either Formats or Datas are
  359.         nil.
  360.       SupportsClipboardFormat - Returns true if the given clipboard format
  361.         is supported by LoadFromClipboardFormat.
  362.       Assign - Copys the contents of the given TPicture.  Used most often in
  363.         the implementation of TPicture properties.
  364.       RegisterFileFormat - Register a new TGraphic class for use in
  365.         LoadFromFile.
  366.       RegisterClipboardFormat - Registers a new TGraphic class for use in
  367.         LoadFromClipboardFormat.
  368.       Height - The native, unstretched, height of the picture.
  369.       Width - The native, unstretched, width of the picture.
  370.       Graphic - The TGraphic object contained by the TPicture
  371.       Bitmap - Returns a bitmap.  If the contents is not already a bitmap, the
  372.         contents are thrown away and a blank bitmap is returned.
  373.       Icon - Returns an icon.  If the contents is not already an icon, the
  374.         contents are thrown away and a blank icon is returned.
  375.       Metafile - Returns a metafile.  If the contents is not already a metafile,
  376.         the contents are thrown away and a blank metafile is returned. }
  377.   TPicture = class(TPersistent)
  378.   protected
  379.     procedure AssignTo(Dest: TPersistent); override;
  380.     procedure Changed(Sender: TObject);
  381.     procedure DefineProperties(Filer: TFiler); override;
  382.   public
  383.     destructor Destroy; override;
  384.     procedure LoadFromFile(const Filename: string);
  385.     procedure SaveToFile(const Filename: string);
  386.     procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  387.       APalette: HPALETTE);
  388.     procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
  389.       var APalette: HPALETTE);
  390.     class function SupportsClipboardFormat(AFormat: Word): Boolean;
  391.     procedure Assign(Source: TPersistent); override;
  392.     class procedure RegisterFileFormat(const AExtension, ADescription: string;
  393.       AGraphicClass: TGraphicClass);
  394.     class procedure RegisterFileFormatRes(const AExtension: String;
  395.       ADescriptionResID: Integer; AGraphicClass: TGraphicClass);
  396.     class procedure RegisterClipboardFormat(AFormat: Word;
  397.       AGraphicClass: TGraphicClass);
  398.     property Bitmap: TBitmap;
  399.     property Graphic: TGraphic;
  400.     property Height: Integer;
  401.     property Icon: TIcon;
  402.     property Metafile: TMetafile;
  403.     property Width: Integer;
  404.     property OnChange: TNotifyEvent;
  405.   end;
  406.  
  407.   { TMetafile }
  408.   { TMetafile is an encapsulation of the Win32 Enhanced metafile.
  409.       Handle - The metafile handle.
  410.       Enhanced - determines how the metafile will be stored on disk.
  411.         Enhanced = True (default) stores as EMF (Win32 Enhanced Metafile),
  412.         Enhanced = False stores as WMF (Windows 3.1 Metafile, with Aldus header).
  413.         The in-memory format is always EMF.  WMF has very limited capabilities;
  414.         storing as WMF will lose information that would be retained by EMF.
  415.         This property is set to match the metafile type when loaded from a
  416.         stream or file.  This maintains form file compatibility with 16 bit
  417.         Delphi (If loaded as WMF, then save as WMF).
  418.       Inch - The units per inch assumed by a WMF metafile.  Used to alter
  419.         scale when writing as WMF, but otherwise this property is obsolete.
  420.         Enhanced metafiles maintain complete scale information internally.
  421.       MMWidth,
  422.       MMHeight: Width and Height in 0.01 millimeter units, the native
  423.         scale used by enhanced metafiles.  The Width and Height properties
  424.         are always in screen device pixel units; you can avoid loss of
  425.         precision in converting between device pixels and mm by setting
  426.         or reading the dimentions in mm with these two properties.
  427.       CreatedBy - Optional name of the author or application used to create
  428.         the metafile.
  429.       Description - Optional text description of the metafile.
  430.       You can set the CreatedBy and Description of a new metafile by calling
  431.       TMetafileCanvas.CreateWithComment.
  432.  
  433.     TMetafileCanvas
  434.       To create a metafile image from scratch, you must draw the image in
  435.       a metafile canvas.  When the canvas is destroyed, it transfers the
  436.       image into the metafile object provided to the canvas constructor.
  437.       After the image is drawn on the canvas and the canvas is destroyed,
  438.       the image is 'playable' in the metafile object.  Like this:
  439.  
  440.       MyMetafile := TMetafile.Create;
  441.       with TMetafileCanvas.Create(MyMetafile, 0) do
  442.       try
  443.         Brush.Color := clRed;
  444.         Ellipse(0,0,100,100);
  445.         ...
  446.       finally
  447.         Free;
  448.       end;
  449.       Form1.Canvas.Draw(0,0,MyMetafile);  (* 1 red circle  *)
  450.  
  451.       To add to an existing metafile image, create a metafile canvas
  452.       and play the source metafile into the metafile canvas.  Like this:
  453.  
  454.       (* continued from previous example, so MyMetafile contains an image *)
  455.       with TMetafileCanvas.Create(MyMetafile, 0) do
  456.       try
  457.         Draw(0,0,MyMetafile);
  458.         Brush.Color := clBlue;
  459.         Ellipse(100,100,200,200);
  460.         ...
  461.       finally
  462.         Free;
  463.       end;
  464.       Form1.Canvas.Draw(0,0,MyMetafile);  (* 1 red circle and 1 blue circle *)
  465.   }
  466.  
  467.   TMetafileCanvas = class(TCanvas)
  468.   public
  469.     constructor Create(AMetafile: TMetafile; ReferenceDevice: HDC);
  470.     constructor CreateWithComment(AMetafile: TMetafile; ReferenceDevice: HDC;
  471.       const CreatedBy, Description: String);
  472.     destructor Destroy; override;
  473.   end;
  474.  
  475.   TMetafileImage = class
  476.   end;
  477.  
  478.   TMetafile = class(TGraphic)
  479.   protected
  480.     function GetEmpty: Boolean; override;
  481.     function GetHeight: Integer; override;
  482.     function GetWidth: Integer; override;
  483.     procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
  484.     procedure ReadData(Stream: TStream); override;
  485.     procedure ReadEMFStream(Stream: TStream);
  486.     procedure ReadWMFStream(Stream: TStream; Length: Longint);
  487.     procedure SetHeight(Value: Integer); override;
  488.     procedure SetWidth(Value: Integer); override;
  489.     function  TestEMF(Stream: TStream): Boolean;
  490.     procedure WriteData(Stream: TStream); override;
  491.     procedure WriteEMFStream(Stream: TStream);
  492.     procedure WriteWMFStream(Stream: TStream);
  493.   public
  494.     constructor Create; override;
  495.     destructor Destroy; override;
  496.     procedure Clear;
  497.     procedure LoadFromStream(Stream: TStream); override;
  498.     procedure SaveToFile(const Filename: String); override;
  499.     procedure SaveToStream(Stream: TStream); override;
  500.     procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  501.       APalette: HPALETTE); override;
  502.     procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
  503.       var APalette: HPALETTE); override;
  504.     procedure Assign(Source: TPersistent); override;
  505.     property CreatedBy: String;
  506.     property Description: String;
  507.     property Enhanced: Boolean default True;
  508.     property Handle: HENHMETAFILE;
  509.     property MMWidth: Integer;
  510.     property MMHeight: Integer;
  511.     property Inch: Word;
  512.     property Palette: HPALETTE;
  513.   end;
  514.  
  515.   { TBitmap }
  516.   { TBitmap is an encapsulation of a Windows HBITMAP and HPALETTE.  It manages
  517.     the palette realizing automatically as well as having a Canvas to allow
  518.     modifications to the palette.  Creating copies of a TBitmap is very fast
  519.     since the handles is copied not the image.  If the image is modified, and
  520.     the handle is shared by more than one TBitmap object, the image is copied
  521.     before the modification is performed (i.e. copy on write).
  522.       Canvas - Allows drawing on the bitmap.
  523.       Handle - The HBITMAP encapsulated by the TBitmap.  Grabbing the handle
  524.         directly should be avoided since it causes the HBITMAP to be copied if
  525.         more than one TBitmap share the handle.
  526.       Palette - The HPALETTE realized by the TBitmap.  Grabbing this handle
  527.         directly should be avoided since it causes the HPALETTE to be copied if
  528.         more than one TBitmap share the handle.
  529.       Monochrome - True if the bitmap is a monochrome bitmap }
  530.  
  531.   TInternalImage = class
  532.   end;
  533.  
  534.   TDIBType = (dtNone, dtWin, dtPM);
  535.  
  536.   TBitmapImage = class(TInternalImage)
  537.   end;
  538.  
  539.   TBitmap = class(TGraphic)
  540.   protected
  541.     procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
  542.     function GetEmpty: Boolean; override;
  543.     function GetHeight: Integer; override;
  544.     function GetWidth: Integer; override;
  545.     procedure ReadData(Stream: TStream); override;
  546.     procedure SetWidth(Value: Integer); override;
  547.     procedure SetHeight(Value: Integer); override;
  548.     procedure WriteData(Stream: TStream); override;
  549.   public
  550.     constructor Create; override;
  551.     destructor Destroy; override;
  552.     procedure Assign(Source: TPersistent); override;
  553.     procedure Dormant;
  554.     procedure FreeImage;
  555.     procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  556.       APalette: HPALETTE); override;
  557.     procedure LoadFromStream(Stream: TStream); override;
  558.     procedure LoadFromResourceName(Instance: THandle; const ResName: String);
  559.     procedure LoadFromResourceID(Instance: THandle; ResID: Integer);
  560.     function ReleaseHandle: HBITMAP;
  561.     function ReleasePalette: HPALETTE;
  562.     procedure SaveToClipboardFormat(var Format: Word; var Data: THandle;
  563.       var APalette: HPALETTE); override;
  564.     procedure SaveToStream(Stream: TStream); override;
  565.     property Canvas: TCanvas;
  566.     property Handle: HBITMAP;
  567.     property Monochrome: Boolean;
  568.     property Palette: HPALETTE;
  569.     property IgnorePalette: Boolean;
  570.     property TransparentColor: TColor;
  571.   end;
  572.  
  573.   { TIcon }
  574.   { TIcon encapsulates window HICON handle. Drawing of an icon does not stretch
  575.     so calling stretch draw is not meaningful.
  576.       Handle - The HICON used by the TIcon. }
  577.  
  578.   TIconImage = class(TInternalImage)
  579.   end;
  580.  
  581.   TIcon = class(TGraphic)
  582.   protected
  583.     procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
  584.     function GetEmpty: Boolean; override;
  585.     function GetHeight: Integer; override;
  586.     function GetWidth: Integer; override;
  587.     procedure SetHeight(Value: Integer); override;
  588.     procedure SetWidth(Value: Integer); override;
  589.     procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  590.       APalette: HPALETTE); override;
  591.     procedure SaveToClipboardFormat(var Format: Word; var Data: THandle;
  592.       var APalette: HPALETTE); override;
  593.   public
  594.     constructor Create; override;
  595.     destructor Destroy; override;
  596.     procedure Assign(Source: TPersistent); override;
  597.     procedure LoadFromStream(Stream: TStream); override;
  598.     function ReleaseHandle: HICON;
  599.     procedure SaveToStream(Stream: TStream); override;
  600.     property Handle: HICON;
  601.   end;
  602.  
  603. function GraphicFilter(GraphicClass: TGraphicClass): string;
  604. function GraphicExtension(GraphicClass: TGraphicClass): string;
  605.  
  606. function ColorToRGB(Color: TColor): Longint;
  607. function ColorToString(Color: TColor): string;
  608. function StringToColor(const S: string): TColor;
  609. procedure GetColorValues(Proc: TGetStrProc);
  610. function ColorToIdent(Color: Longint; var Ident: string): Boolean;
  611. function IdentToColor(const Ident: string; var Color: Longint): Boolean;
  612.  
  613. function MemAlloc(Size: Longint): Pointer;
  614. procedure GetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: Integer;
  615.   var ImageSize: DWORD);
  616. function GetDIB(Bitmap: HBITMAP; Palette: HPALETTE; var BitmapInfo; var Bits): Boolean;
  617.  
  618. procedure InitGraphics;
  619. procedure PaletteChanged;
  620. procedure FreeMemoryContexts;
  621.  
  622. implementation
  623.