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