home *** CD-ROM | disk | FTP | other *** search
/ Kompuutteri K-CD 2002 #1 / K-CD_2002-01.iso / Delphi / INSTALL / program files / Borland / Delphi6 / Doc / Graphics.int < prev    next >
Encoding:
Text File  |  2001-05-22  |  33.5 KB  |  848 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {                                                       }
  6. {  Copyright (c) 1995-2001 Borland Software Corporation }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit Graphics;
  11.  
  12. {$P+,S-,W-,R-,T-,X+,H+,B-}
  13. {$C PRELOAD}
  14.  
  15. interface
  16.  
  17. uses Windows, Types, SysUtils, Classes;
  18.  
  19. { Graphics Objects }
  20.  
  21. type
  22.   PColor = ^TColor;
  23.   TColor = -$7FFFFFFF-1..$7FFFFFFF;
  24.   {$NODEFINE TColor}
  25.  
  26.   (*$HPPEMIT 'namespace Graphics'*)
  27.   (*$HPPEMIT '{'*)
  28.   (*$HPPEMIT '  enum TColor {clMin=-0x7fffffff-1, clMax=0x7fffffff};'*)
  29.   (*$HPPEMIT '}'*)
  30.  
  31.  
  32. const
  33.   clScrollBar = TColor(COLOR_SCROLLBAR or $80000000);
  34.   clBackground = TColor(COLOR_BACKGROUND or $80000000);
  35.   clActiveCaption = TColor(COLOR_ACTIVECAPTION or $80000000);
  36.   clInactiveCaption = TColor(COLOR_INACTIVECAPTION or $80000000);
  37.   clMenu = TColor(COLOR_MENU or $80000000);
  38.   clWindow = TColor(COLOR_WINDOW or $80000000);
  39.   clWindowFrame = TColor(COLOR_WINDOWFRAME or $80000000);
  40.   clMenuText = TColor(COLOR_MENUTEXT or $80000000);
  41.   clWindowText = TColor(COLOR_WINDOWTEXT or $80000000);
  42.   clCaptionText = TColor(COLOR_CAPTIONTEXT or $80000000);
  43.   clActiveBorder = TColor(COLOR_ACTIVEBORDER or $80000000);
  44.   clInactiveBorder = TColor(COLOR_INACTIVEBORDER or $80000000);
  45.   clAppWorkSpace = TColor(COLOR_APPWORKSPACE or $80000000);
  46.   clHighlight = TColor(COLOR_HIGHLIGHT or $80000000);
  47.   clHighlightText = TColor(COLOR_HIGHLIGHTTEXT or $80000000);
  48.   clBtnFace = TColor(COLOR_BTNFACE or $80000000);
  49.   clBtnShadow = TColor(COLOR_BTNSHADOW or $80000000);
  50.   clGrayText = TColor(COLOR_GRAYTEXT or $80000000);
  51.   clBtnText = TColor(COLOR_BTNTEXT or $80000000);
  52.   clInactiveCaptionText = TColor(COLOR_INACTIVECAPTIONTEXT or $80000000);
  53.   clBtnHighlight = TColor(COLOR_BTNHIGHLIGHT or $80000000);
  54.   cl3DDkShadow = TColor(COLOR_3DDKSHADOW or $80000000);
  55.   cl3DLight = TColor(COLOR_3DLIGHT or $80000000);
  56.   clInfoText = TColor(COLOR_INFOTEXT or $80000000);
  57.   clInfoBk = TColor(COLOR_INFOBK or $80000000);
  58.   clGradientActiveCaption = TColor(COLOR_GRADIENTACTIVECAPTION or $80000000);
  59.   clGradientInactiveCaption = TColor(COLOR_GRADIENTINACTIVECAPTION or $80000000);
  60.  
  61.   clBlack = TColor($000000);
  62.   clMaroon = TColor($000080);
  63.   clGreen = TColor($008000);
  64.   clOlive = TColor($008080);
  65.   clNavy = TColor($800000);
  66.   clPurple = TColor($800080);
  67.   clTeal = TColor($808000);
  68.   clGray = TColor($808080);
  69.   clSilver = TColor($C0C0C0);
  70.   clRed = TColor($0000FF);
  71.   clLime = TColor($00FF00);
  72.   clYellow = TColor($00FFFF);
  73.   clBlue = TColor($FF0000);
  74.   clFuchsia = TColor($FF00FF);
  75.   clAqua = TColor($FFFF00);
  76.   clLtGray = TColor($C0C0C0);
  77.   clDkGray = TColor($808080);
  78.   clWhite = TColor($FFFFFF);
  79.   StandardColorsCount = 16;
  80.  
  81.   clMoneyGreen = TColor($C0DCC0);
  82.   clSkyBlue = TColor($F0CAA6);
  83.   clCream = TColor($F0FBFF);
  84.   clMedGray = TColor($A4A0A0);
  85.   ExtendedColorsCount = 4;
  86.  
  87.   clNone = TColor($1FFFFFFF);
  88.   clDefault = TColor($20000000);
  89.  
  90.   //clUnused = TColor($D4D4D4);
  91.  
  92. const
  93.   cmBlackness = BLACKNESS;
  94.   cmDstInvert = DSTINVERT;
  95.   cmMergeCopy = MERGECOPY;
  96.   cmMergePaint = MERGEPAINT;
  97.   cmNotSrcCopy = NOTSRCCOPY;
  98.   cmNotSrcErase = NOTSRCERASE;
  99.   cmPatCopy = PATCOPY;
  100.   cmPatInvert = PATINVERT;
  101.   cmPatPaint = PATPAINT;
  102.   cmSrcAnd = SRCAND;
  103.   cmSrcCopy = SRCCOPY;
  104.   cmSrcErase = SRCERASE;
  105.   cmSrcInvert = SRCINVERT;
  106.   cmSrcPaint = SRCPAINT;
  107.   cmWhiteness = WHITENESS;
  108.  
  109. type
  110.   {$EXTERNALSYM HMETAFILE}
  111.   HMETAFILE = THandle;
  112.   {$EXTERNALSYM HENHMETAFILE}
  113.   HENHMETAFILE = THandle;
  114.  
  115.   EInvalidGraphic = class(Exception);
  116.   EInvalidGraphicOperation = class(Exception);
  117.  
  118.   TGraphic = class;
  119.   TBitmap = class;
  120.   TIcon = class;
  121.   TMetafile = class;
  122.  
  123.   TResData = record
  124.     Handle: THandle;
  125.   end;
  126.  
  127.   TFontPitch = (fpDefault, fpVariable, fpFixed);
  128.   TFontName = type string;
  129.   TFontCharset = 0..255;
  130.  
  131.   { Changes to the following types should be reflected in the $HPPEMIT directives. }
  132.  
  133.   TFontDataName = string[LF_FACESIZE - 1];
  134.   {$NODEFINE TFontDataName}
  135.   TFontStyle = (fsBold, fsItalic, fsUnderline, fsStrikeOut);
  136.   {$NODEFINE TFontStyle}
  137.   TFontStyles = set of TFontStyle;
  138.   TFontStylesBase = set of TFontStyle;
  139.   {$NODEFINE TFontStylesBase}
  140.  
  141.   (*$HPPEMIT 'namespace Graphics'*)
  142.   (*$HPPEMIT '{'*)
  143.   (*$HPPEMIT '  enum TFontStyle { fsBold, fsItalic, fsUnderline, fsStrikeOut };'*)
  144.   (*$HPPEMIT '  typedef SmallStringBase<31> TFontDataName;'*)
  145.   (*$HPPEMIT '  typedef SetBase<TFontStyle, fsBold, fsStrikeOut> TFontStylesBase;'*)
  146.   (*$HPPEMIT '}'*)
  147.  
  148.   TFontData = record
  149.     Handle: HFont;
  150.     Height: Integer;
  151.     Pitch: TFontPitch;
  152.     Style: TFontStylesBase;
  153.     Charset: TFontCharset;
  154.     Name: TFontDataName;
  155.   end;
  156.  
  157.   TPenStyle = (psSolid, psDash, psDot, psDashDot, psDashDotDot, psClear,
  158.     psInsideFrame);
  159.   TPenMode = (pmBlack, pmWhite, pmNop, pmNot, pmCopy, pmNotCopy,
  160.     pmMergePenNot, pmMaskPenNot, pmMergeNotPen, pmMaskNotPen, pmMerge,
  161.     pmNotMerge, pmMask, pmNotMask, pmXor, pmNotXor);
  162.  
  163.   TPenData = record
  164.     Handle: HPen;
  165.     Color: TColor;
  166.     Width: Integer;
  167.     Style: TPenStyle;
  168.   end;
  169.  
  170.   TBrushStyle = (bsSolid, bsClear, bsHorizontal, bsVertical,
  171.     bsFDiagonal, bsBDiagonal, bsCross, bsDiagCross);
  172.  
  173.   TBrushData = record
  174.     Handle: HBrush;
  175.     Color: TColor;
  176.     Bitmap: TBitmap;
  177.     Style: TBrushStyle;
  178.   end;
  179.  
  180.   PResource = ^TResource;
  181.   TResource = record
  182.     Next: PResource;
  183.     RefCount: Integer;
  184.     Handle: THandle;
  185.     HashCode: Word;
  186.     case Integer of
  187.       0: (Data: TResData);
  188.       1: (Font: TFontData);
  189.       2: (Pen: TPenData);
  190.       3: (Brush: TBrushData);
  191.   end;
  192.  
  193.   TGraphicsObject = class(TPersistent)
  194.   protected
  195.     procedure Changed; dynamic;
  196.     procedure Lock;
  197.     procedure Unlock;
  198.   public
  199.     function HandleAllocated: Boolean;
  200.     property OnChange: TNotifyEvent;
  201.     property OwnerCriticalSection: PRTLCriticalSection;
  202.   end;
  203.  
  204.   IChangeNotifier = interface
  205.     ['{1FB62321-44A7-11D0-9E93-0020AF3D82DA}']
  206.     procedure Changed;
  207.   end;
  208.  
  209.   TFont = class(TGraphicsObject)
  210.   protected
  211.     procedure Changed; override;
  212.     function GetHandle: HFont;
  213.     function GetHeight: Integer;
  214.     function GetName: TFontName;
  215.     function GetPitch: TFontPitch;
  216.     function GetSize: Integer;
  217.     function GetStyle: TFontStyles;
  218.     function GetCharset: TFontCharset;
  219.     procedure SetColor(Value: TColor);
  220.     procedure SetHandle(Value: HFont);
  221.     procedure SetHeight(Value: Integer);
  222.     procedure SetName(const Value: TFontName);
  223.     procedure SetPitch(Value: TFontPitch);
  224.     procedure SetSize(Value: Integer);
  225.     procedure SetStyle(Value: TFontStyles);
  226.     procedure SetCharset(Value: TFontCharset);
  227.   public
  228.     constructor Create;
  229.     destructor Destroy; override;
  230.     procedure Assign(Source: TPersistent); override;
  231.     property FontAdapter: IChangeNotifier;
  232.     property Handle: HFont;
  233.     property PixelsPerInch: Integer;
  234.   published
  235.     property Charset: TFontCharset;
  236.     property Color: TColor;
  237.     property Height: Integer;
  238.     property Name: TFontName;
  239.     property Pitch: TFontPitch default fpDefault;
  240.     property Size: Integer;
  241.     property Style: TFontStyles;
  242.   end;
  243.  
  244.   TPen = class(TGraphicsObject)
  245.   protected
  246.     function GetColor: TColor;
  247.     procedure SetColor(Value: TColor);
  248.     function GetHandle: HPen;
  249.     procedure SetHandle(Value: HPen);
  250.     procedure SetMode(Value: TPenMode);
  251.     function GetStyle: TPenStyle;
  252.     procedure SetStyle(Value: TPenStyle);
  253.     function GetWidth: Integer;
  254.     procedure SetWidth(Value: Integer);
  255.   public
  256.     constructor Create;
  257.     destructor Destroy; override;
  258.     procedure Assign(Source: TPersistent); override;
  259.     property Handle: HPen;
  260.   published
  261.     property Color: TColor default clBlack;
  262.     property Mode: TPenMode default pmCopy;
  263.     property Style: TPenStyle default psSolid;
  264.     property Width: Integer default 1;
  265.   end;
  266.  
  267.   TBrush = class(TGraphicsObject)
  268.   protected
  269.     function GetBitmap: TBitmap;
  270.     procedure SetBitmap(Value: TBitmap);
  271.     function GetColor: TColor;
  272.     procedure SetColor(Value: TColor);
  273.     function GetHandle: HBrush;
  274.     procedure SetHandle(Value: HBrush);
  275.     function GetStyle: TBrushStyle;
  276.     procedure SetStyle(Value: TBrushStyle);
  277.   public
  278.     constructor Create;
  279.     destructor Destroy; override;
  280.     procedure Assign(Source: TPersistent); override;
  281.     property Bitmap: TBitmap;
  282.     property Handle: HBrush;
  283.   published
  284.     property Color: TColor default clWhite;
  285.     property Style: TBrushStyle default bsSolid;
  286.   end;
  287.  
  288.   TFontRecall = class(TRecall)
  289.   public
  290.     constructor Create(AFont: TFont);
  291.   end;
  292.  
  293.   TPenRecall = class(TRecall)
  294.   public
  295.     constructor Create(APen: TPen);
  296.   end;
  297.  
  298.   TBrushRecall = class(TRecall)
  299.   public
  300.     constructor Create(ABrush: TBrush);
  301.   end;
  302.  
  303.   TFillStyle = (fsSurface, fsBorder);
  304.   TFillMode = (fmAlternate, fmWinding);
  305.  
  306.   TCopyMode = Longint;
  307.  
  308.   TCanvasStates = (csHandleValid, csFontValid, csPenValid, csBrushValid);
  309.   TCanvasState = set of TCanvasStates;
  310.   TCanvasOrientation = (coLeftToRight, coRightToLeft);
  311.  
  312.   TCanvas = class(TPersistent)
  313.   protected
  314.     procedure Changed; virtual;
  315.     procedure Changing; virtual;
  316.     procedure CreateHandle; virtual;
  317.     procedure RequiredState(ReqState: TCanvasState);
  318.   public
  319.     constructor Create;
  320.     destructor Destroy; override;
  321.     procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
  322.     procedure BrushCopy(const Dest: TRect; Bitmap: TBitmap;
  323.       const Source: TRect; Color: TColor);
  324.     procedure Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
  325.     procedure CopyRect(const Dest: TRect; Canvas: TCanvas;
  326.       const Source: TRect);
  327.     procedure Draw(X, Y: Integer; Graphic: TGraphic);
  328.     procedure DrawFocusRect(const Rect: TRect);
  329.     procedure Ellipse(X1, Y1, X2, Y2: Integer); overload;
  330.     procedure Ellipse(const Rect: TRect); overload;
  331.     procedure FillRect(const Rect: TRect);
  332.     procedure FloodFill(X, Y: Integer; Color: TColor; FillStyle: TFillStyle);
  333.     procedure FrameRect(const Rect: TRect);
  334.     function HandleAllocated: Boolean;
  335.     procedure LineTo(X, Y: Integer);
  336.     procedure Lock;
  337.     procedure MoveTo(X, Y: Integer);
  338.     procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
  339.     procedure Polygon(const Points: array of TPoint);
  340.     procedure Polyline(const Points: array of TPoint);
  341.     procedure PolyBezier(const Points: array of TPoint);
  342.     procedure PolyBezierTo(const Points: array of TPoint);
  343.     procedure Rectangle(X1, Y1, X2, Y2: Integer); overload;
  344.     procedure Rectangle(const Rect: TRect); overload;
  345.     procedure Refresh;
  346.     procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
  347.     procedure StretchDraw(const Rect: TRect; Graphic: TGraphic);
  348.     function TextExtent(const Text: string): TSize;
  349.     function TextHeight(const Text: string): Integer;
  350.     procedure TextOut(X, Y: Integer; const Text: string);
  351.     procedure TextRect(Rect: TRect; X, Y: Integer; const Text: string);
  352.     function TextWidth(const Text: string): Integer;
  353.     function TryLock: Boolean;
  354.     procedure Unlock;
  355.     property ClipRect: TRect;
  356.     property Handle: HDC;
  357.     property LockCount: Integer;
  358.     property CanvasOrientation: TCanvasOrientation;
  359.     property PenPos: TPoint;
  360.     property Pixels[X, Y: Integer]: TColor;
  361.     property TextFlags: Longint;
  362.     property OnChange: TNotifyEvent;
  363.     property OnChanging: TNotifyEvent;
  364.   published
  365.     property Brush: TBrush;
  366.     property CopyMode: TCopyMode default cmSrcCopy;
  367.     property Font: TFont;
  368.     property Pen: TPen;
  369.   end;
  370.  
  371.   { TProgressEvent is a generic progress notification event which may be
  372.         used by TGraphic classes with computationally intensive (slow)
  373.         operations, such as loading, storing, or transforming image data.
  374.     Event params:
  375.       Stage - Indicates whether this call to the OnProgress event is to
  376.         prepare for, process, or clean up after a graphic operation.  If
  377.         OnProgress is called at all, the first call for a graphic operation
  378.         will be with Stage = psStarting, to allow the OnProgress event handler
  379.         to allocate whatever resources it needs to process subsequent progress
  380.         notifications.  After Stage = psStarting, you are guaranteed that
  381.         OnProgress will be called again with Stage = psEnding to allow you
  382.         to free those resources, even if the graphic operation is aborted by
  383.         an exception.  Zero or more calls to OnProgress with Stage = psRunning
  384.         may occur between the psStarting and psEnding calls.
  385.       PercentDone - The ratio of work done to work remaining, on a scale of
  386.         0 to 100.  Values may repeat or even regress (get smaller) in
  387.         successive calls.  PercentDone is usually only a guess, and the
  388.         guess may be dramatically altered as new information is discovered
  389.         in decoding the image.
  390.       RedrawNow - Indicates whether the graphic can be/should be redrawn
  391.         immediately.  Useful for showing successive approximations of
  392.         an image as data is available instead of waiting for all the data
  393.         to arrive before drawing anything.  Since there is no message loop
  394.         activity during graphic operations, you should call Update to force
  395.         a control to be redrawn immediately in the OnProgress event handler.
  396.         Redrawing a graphic when RedrawNow = False could corrupt the image
  397.         and/or cause exceptions.
  398.       Rect - Area of image that has changed and needs to be redrawn.
  399.       Msg - Optional text describing in one or two words what the graphic
  400.         class is currently working on.  Ex:  "Loading" "Storing"
  401.         "Reducing colors".  The Msg string can also be empty.
  402.         Msg strings should be resourced for translation,  should not
  403.         contain trailing periods, and should be used only for
  404.         display purposes.  (do not: if Msg = 'Loading' then...)
  405.   }
  406.  
  407.   TProgressStage = (psStarting, psRunning, psEnding);
  408.   TProgressEvent = procedure (Sender: TObject; Stage: TProgressStage;
  409.     PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string) of object;
  410.  
  411.   { The TGraphic class is a abstract base class for dealing with graphic images
  412.     such as metafile, bitmaps, icons, and other image formats.
  413.       LoadFromFile - Read the graphic from the file system.  The old contents of
  414.         the graphic are lost.  If the file is not of the right format, an
  415.         exception will be generated.
  416.       SaveToFile - Writes the graphic to disk in the file provided.
  417.       LoadFromStream - Like LoadFromFile except source is a stream (e.g.
  418.         TBlobStream).
  419.       SaveToStream - stream analogue of SaveToFile.
  420.       LoadFromClipboardFormat - Replaces the current image with the data
  421.         provided.  If the TGraphic does not support that format it will generate
  422.         an exception.
  423.       SaveToClipboardFormats - Converts the image to a clipboard format.  If the
  424.         image does not support being translated into a clipboard format it
  425.         will generate an exception.
  426.       Height - The native, unstretched, height of the graphic.
  427.       Palette - Color palette of image.  Zero if graphic doesn't need/use palettes.
  428.       Transparent - Image does not completely cover its rectangular area
  429.       Width - The native, unstretched, width of the graphic.
  430.       OnChange - Called whenever the graphic changes
  431.       PaletteModified - Indicates in OnChange whether color palette has changed.
  432.         Stays true until whoever's responsible for realizing this new palette
  433.         (ex: TImage) sets it to False.
  434.       OnProgress - Generic progress indicator event. Propagates out to TPicture
  435.         and TImage OnProgress events.}
  436.  
  437.   TGraphic = class(TInterfacedPersistent, IStreamPersist)
  438.   protected
  439.     procedure Changed(Sender: TObject); virtual;
  440.     procedure DefineProperties(Filer: TFiler); override;
  441.     procedure Draw(ACanvas: TCanvas; const Rect: TRect); virtual; abstract;
  442.     function Equals(Graphic: TGraphic): Boolean; virtual;
  443.     function GetEmpty: Boolean; virtual; abstract;
  444.     function GetHeight: Integer; virtual; abstract;
  445.     function GetPalette: HPALETTE; virtual;
  446.     function GetTransparent: Boolean; virtual;
  447.     function GetWidth: Integer; virtual; abstract;
  448.     procedure Progress(Sender: TObject; Stage: TProgressStage;
  449.       PercentDone: Byte;  RedrawNow: Boolean; const R: TRect; const Msg: string); dynamic;
  450.     procedure ReadData(Stream: TStream); virtual;
  451.     procedure SetHeight(Value: Integer); virtual; abstract;
  452.     procedure SetPalette(Value: HPALETTE); virtual;
  453.     procedure SetTransparent(Value: Boolean); virtual;
  454.     procedure SetWidth(Value: Integer); virtual; abstract;
  455.     procedure WriteData(Stream: TStream); virtual;
  456.   public
  457.     constructor Create; virtual;
  458.     procedure LoadFromFile(const Filename: string); virtual;
  459.     procedure SaveToFile(const Filename: string); virtual;
  460.     procedure LoadFromStream(Stream: TStream); virtual; abstract;
  461.     procedure SaveToStream(Stream: TStream); virtual; abstract;
  462.     procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  463.       APalette: HPALETTE); virtual; abstract;
  464.     procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
  465.       var APalette: HPALETTE); virtual; abstract;
  466.     property Empty: Boolean;
  467.     property Height: Integer;
  468.     property Modified: Boolean;
  469.     property Palette: HPALETTE;
  470.     property PaletteModified: Boolean;
  471.     property Transparent: Boolean;
  472.     property Width: Integer;
  473.     property OnChange: TNotifyEvent;
  474.     property OnProgress: TProgressEvent;
  475.   end;
  476.  
  477.   TGraphicClass = class of TGraphic;
  478.  
  479.   { TPicture }
  480.   { TPicture is a TGraphic container.  It is used in place of a TGraphic if the
  481.     graphic can be of any TGraphic class.  LoadFromFile and SaveToFile are
  482.     polymorphic. For example, if the TPicture is holding an Icon, you can
  483.     LoadFromFile a bitmap file, where if the class was TIcon you could only read
  484.     .ICO files.
  485.       LoadFromFile - Reads a picture from disk.  The TGraphic class created
  486.         determined by the file extension of the file.  If the file extension is
  487.         not recognized an exception is generated.
  488.       SaveToFile - Writes the picture to disk.
  489.       LoadFromClipboardFormat - Reads the picture from the handle provided in
  490.         the given clipboard format.  If the format is not supported, an
  491.         exception is generated.
  492.       SaveToClipboardFormats - Allocates a global handle and writes the picture
  493.         in its native clipboard format (CF_BITMAP for bitmaps, CF_METAFILE
  494.         for metafiles, etc.).  Formats will contain the formats written.
  495.         Returns the number of clipboard items written to the array pointed to
  496.         by Formats and Datas or would be written if either Formats or Datas are
  497.         nil.
  498.       SupportsClipboardFormat - Returns true if the given clipboard format
  499.         is supported by LoadFromClipboardFormat.
  500.       Assign - Copys the contents of the given TPicture.  Used most often in
  501.         the implementation of TPicture properties.
  502.       RegisterFileFormat - Register a new TGraphic class for use in
  503.         LoadFromFile.
  504.       RegisterClipboardFormat - Registers a new TGraphic class for use in
  505.         LoadFromClipboardFormat.
  506.       UnRegisterGraphicClass - Removes all references to the specified TGraphic
  507.         class and all its descendents from the file format and clipboard format
  508.         internal lists.
  509.       Height - The native, unstretched, height of the picture.
  510.       Width - The native, unstretched, width of the picture.
  511.       Graphic - The TGraphic object contained by the TPicture
  512.       Bitmap - Returns a bitmap.  If the contents is not already a bitmap, the
  513.         contents are thrown away and a blank bitmap is returned.
  514.       Icon - Returns an icon.  If the contents is not already an icon, the
  515.         contents are thrown away and a blank icon is returned.
  516.       Metafile - Returns a metafile.  If the contents is not already a metafile,
  517.         the contents are thrown away and a blank metafile is returned. }
  518.  
  519.   TPicture = class(TInterfacedPersistent, IStreamPersist)
  520.   protected
  521.     procedure AssignTo(Dest: TPersistent); override;
  522.     procedure Changed(Sender: TObject); dynamic;
  523.     procedure DefineProperties(Filer: TFiler); override;
  524.     procedure Progress(Sender: TObject; Stage: TProgressStage;
  525.       PercentDone: Byte;  RedrawNow: Boolean; const R: TRect; const Msg: string); dynamic;
  526.     procedure LoadFromStream(Stream: TStream);
  527.     procedure SaveToStream(Stream: TStream); 
  528.   public
  529.     constructor Create;
  530.     destructor Destroy; override;
  531.     procedure LoadFromFile(const Filename: string);
  532.     procedure SaveToFile(const Filename: string);
  533.     procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  534.       APalette: HPALETTE);
  535.     procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
  536.       var APalette: HPALETTE);
  537.     class function SupportsClipboardFormat(AFormat: Word): Boolean;
  538.     procedure Assign(Source: TPersistent); override;
  539.     class procedure RegisterFileFormat(const AExtension, ADescription: string;
  540.       AGraphicClass: TGraphicClass);
  541.     class procedure RegisterFileFormatRes(const AExtension: String;
  542.       ADescriptionResID: Integer; AGraphicClass: TGraphicClass);
  543.     class procedure RegisterClipboardFormat(AFormat: Word;
  544.       AGraphicClass: TGraphicClass);
  545.     class procedure UnregisterGraphicClass(AClass: TGraphicClass);
  546.     property Bitmap: TBitmap;
  547.     property Graphic: TGraphic;
  548.     property PictureAdapter: IChangeNotifier;
  549.     property Height: Integer;
  550.     property Icon: TIcon;
  551.     property Metafile: TMetafile;
  552.     property Width: Integer;
  553.     property OnChange: TNotifyEvent;
  554.     property OnProgress: TProgressEvent;
  555.   end;
  556.  
  557.   { TMetafile }
  558.   { TMetafile is an encapsulation of the Win32 Enhanced metafile.
  559.       Handle - The metafile handle.
  560.       Enhanced - determines how the metafile will be stored on disk.
  561.         Enhanced = True (default) stores as EMF (Win32 Enhanced Metafile),
  562.         Enhanced = False stores as WMF (Windows 3.1 Metafile, with Aldus header).
  563.         The in-memory format is always EMF.  WMF has very limited capabilities;
  564.         storing as WMF will lose information that would be retained by EMF.
  565.         This property is set to match the metafile type when loaded from a
  566.         stream or file.  This maintains form file compatibility with 16 bit
  567.         Delphi (If loaded as WMF, then save as WMF).
  568.       Inch - The units per inch assumed by a WMF metafile.  Used to alter
  569.         scale when writing as WMF, but otherwise this property is obsolete.
  570.         Enhanced metafiles maintain complete scale information internally.
  571.       MMWidth,
  572.       MMHeight: Width and Height in 0.01 millimeter units, the native
  573.         scale used by enhanced metafiles.  The Width and Height properties
  574.         are always in screen device pixel units; you can avoid loss of
  575.         precision in converting between device pixels and mm by setting
  576.         or reading the dimentions in mm with these two properties.
  577.       CreatedBy - Optional name of the author or application used to create
  578.         the metafile.
  579.       Description - Optional text description of the metafile.
  580.       You can set the CreatedBy and Description of a new metafile by calling
  581.       TMetafileCanvas.CreateWithComment.
  582.  
  583.     TMetafileCanvas
  584.       To create a metafile image from scratch, you must draw the image in
  585.       a metafile canvas.  When the canvas is destroyed, it transfers the
  586.       image into the metafile object provided to the canvas constructor.
  587.       After the image is drawn on the canvas and the canvas is destroyed,
  588.       the image is 'playable' in the metafile object.  Like this:
  589.  
  590.       MyMetafile := TMetafile.Create;
  591.       MyMetafile.Width := 200;
  592.       MyMetafile.Height := 200;
  593.       with TMetafileCanvas.Create(MyMetafile, 0) do
  594.       try
  595.         Brush.Color := clRed;
  596.         Ellipse(0,0,100,100);
  597.         ...
  598.       finally
  599.         Free;
  600.       end;
  601.       Form1.Canvas.Draw(0,0,MyMetafile);  (* 1 red circle  *)
  602.  
  603.       To add to an existing metafile image, create a metafile canvas
  604.       and play the source metafile into the metafile canvas.  Like this:
  605.  
  606.       (* continued from previous example, so MyMetafile contains an image *)
  607.       with TMetafileCanvas.Create(MyMetafile, 0) do
  608.       try
  609.         Draw(0,0,MyMetafile);
  610.         Brush.Color := clBlue;
  611.         Ellipse(100,100,200,200);
  612.         ...
  613.       finally
  614.         Free;
  615.       end;
  616.       Form1.Canvas.Draw(0,0,MyMetafile);  (* 1 red circle and 1 blue circle *)
  617.   }
  618.  
  619.   TMetafileCanvas = class(TCanvas)
  620.   public
  621.     constructor Create(AMetafile: TMetafile; ReferenceDevice: HDC);
  622.     constructor CreateWithComment(AMetafile: TMetafile; ReferenceDevice: HDC;
  623.       const CreatedBy, Description: String);
  624.     destructor Destroy; override;
  625.   end;
  626.  
  627.   TSharedImage = class
  628.   protected
  629.     procedure Reference;
  630.     procedure Release;
  631.     procedure FreeHandle; virtual; abstract;
  632.     property RefCount: Integer;
  633.   end;
  634.  
  635.   TMetafileImage = class(TSharedImage)
  636.   protected
  637.     procedure FreeHandle; override;
  638.   public
  639.     destructor Destroy; override;
  640.   end;
  641.  
  642.   TMetafile = class(TGraphic)
  643.   protected
  644.     function GetEmpty: Boolean; override;
  645.     function GetHeight: Integer; override;
  646.     function GetPalette: HPALETTE; override;
  647.     function GetWidth: Integer; override;
  648.     procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
  649.     procedure ReadData(Stream: TStream); override;
  650.     procedure ReadEMFStream(Stream: TStream);
  651.     procedure ReadWMFStream(Stream: TStream; Length: Longint);
  652.     procedure SetHeight(Value: Integer); override;
  653.     procedure SetTransparent(Value: Boolean); override;
  654.     procedure SetWidth(Value: Integer); override;
  655.     function  TestEMF(Stream: TStream): Boolean;
  656.     procedure WriteData(Stream: TStream); override;
  657.     procedure WriteEMFStream(Stream: TStream);
  658.     procedure WriteWMFStream(Stream: TStream);
  659.   public
  660.     constructor Create; override;
  661.     destructor Destroy; override;
  662.     procedure Clear;
  663.     function HandleAllocated: Boolean;
  664.     procedure LoadFromStream(Stream: TStream); override;
  665.     procedure SaveToFile(const Filename: String); override;
  666.     procedure SaveToStream(Stream: TStream); override;
  667.     procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  668.       APalette: HPALETTE); override;
  669.     procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
  670.       var APalette: HPALETTE); override;
  671.     procedure Assign(Source: TPersistent); override;
  672.     function ReleaseHandle: HENHMETAFILE;
  673.     property CreatedBy: String;
  674.     property Description: String;
  675.     property Enhanced: Boolean default True;
  676.     property Handle: HENHMETAFILE;
  677.     property MMWidth: Integer;
  678.     property MMHeight: Integer;
  679.     property Inch: Word;
  680.   end;
  681.  
  682.   { TBitmap }
  683.   { TBitmap is an encapsulation of a Windows HBITMAP and HPALETTE.  It manages
  684.     the palette realizing automatically as well as having a Canvas to allow
  685.     modifications to the image.  Creating copies of a TBitmap is very fast
  686.     since the handle is copied not the image.  If the image is modified, and
  687.     the handle is shared by more than one TBitmap object, the image is copied
  688.     before the modification is performed (i.e. copy on write).
  689.       Canvas - Allows drawing on the bitmap.
  690.       Handle - The HBITMAP encapsulated by the TBitmap.  Grabbing the handle
  691.         directly should be avoided since it causes the HBITMAP to be copied if
  692.         more than one TBitmap share the handle.
  693.       Palette - The HPALETTE realized by the TBitmap.  Grabbing this handle
  694.         directly should be avoided since it causes the HPALETTE to be copied if
  695.         more than one TBitmap share the handle.
  696.       Monochrome - True if the bitmap is a monochrome bitmap }
  697.  
  698.   TBitmapImage = class(TSharedImage)
  699.   protected
  700.     procedure FreeHandle; override;
  701.   public
  702.     destructor Destroy; override;
  703.   end;
  704.  
  705.   TBitmapHandleType = (bmDIB, bmDDB);
  706.   TPixelFormat = (pfDevice, pf1bit, pf4bit, pf8bit, pf15bit, pf16bit, pf24bit, pf32bit, pfCustom);
  707.   TTransparentMode = (tmAuto, tmFixed);
  708.  
  709.   TBitmap = class(TGraphic)
  710.   protected
  711.     procedure Changed(Sender: TObject); override;
  712.     procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
  713.     function GetEmpty: Boolean; override;
  714.     function GetHeight: Integer; override;
  715.     function GetPalette: HPALETTE; override;
  716.     function GetWidth: Integer; override;
  717.     procedure HandleNeeded;
  718.     procedure MaskHandleNeeded;
  719.     procedure PaletteNeeded;
  720.     procedure ReadData(Stream: TStream); override;
  721.     procedure SetHeight(Value: Integer); override;
  722.     procedure SetPalette(Value: HPALETTE); override;
  723.     procedure SetWidth(Value: Integer); override;
  724.     procedure WriteData(Stream: TStream); override;
  725.   public
  726.     constructor Create; override;
  727.     destructor Destroy; override;
  728.     procedure Assign(Source: TPersistent); override;
  729.     procedure Dormant;
  730.     procedure FreeImage;
  731.     function HandleAllocated: Boolean;
  732.     procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  733.       APalette: HPALETTE); override;
  734.     procedure LoadFromStream(Stream: TStream); override;
  735.     procedure LoadFromResourceName(Instance: THandle; const ResName: String);
  736.     procedure LoadFromResourceID(Instance: THandle; ResID: Integer);
  737.     procedure Mask(TransparentColor: TColor);
  738.     function ReleaseHandle: HBITMAP;
  739.     function ReleaseMaskHandle: HBITMAP;
  740.     function ReleasePalette: HPALETTE;
  741.     procedure SaveToClipboardFormat(var Format: Word; var Data: THandle;
  742.       var APalette: HPALETTE); override;
  743.     procedure SaveToStream(Stream: TStream); override;
  744.     property Canvas: TCanvas;
  745.     property Handle: HBITMAP;
  746.     property HandleType: TBitmapHandleType;
  747.     property IgnorePalette: Boolean;
  748.     property MaskHandle: HBITMAP;
  749.     property Monochrome: Boolean;
  750.     property PixelFormat: TPixelFormat;
  751.     property ScanLine[Row: Integer]: Pointer;
  752.     property TransparentColor: TColor;
  753.     property TransparentMode: TTransparentMode default tmAuto;
  754.   end;
  755.  
  756.   { TIcon }
  757.   { TIcon encapsulates window HICON handle. Drawing of an icon does not stretch
  758.     so calling stretch draw is not meaningful.
  759.       Handle - The HICON used by the TIcon. }
  760.  
  761.   TIconImage = class(TSharedImage)
  762.   protected
  763.     procedure FreeHandle; override;
  764.   public
  765.     destructor Destroy; override;
  766.   end;
  767.  
  768.   TIcon = class(TGraphic)
  769.   protected
  770.     procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
  771.     function GetEmpty: Boolean; override;
  772.     function GetHeight: Integer; override;
  773.     function GetWidth: Integer; override;
  774.     procedure SetHeight(Value: Integer); override;
  775.     procedure SetTransparent(Value: Boolean); override;
  776.     procedure SetWidth(Value: Integer); override;
  777.   public
  778.     constructor Create; override;
  779.     destructor Destroy; override;
  780.     procedure Assign(Source: TPersistent); override;
  781.     function HandleAllocated: Boolean;
  782.     procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  783.       APalette: HPALETTE); override;
  784.     procedure LoadFromStream(Stream: TStream); override;
  785.     function ReleaseHandle: HICON;
  786.     procedure SaveToClipboardFormat(var Format: Word; var Data: THandle;
  787.       var APalette: HPALETTE); override;
  788.     procedure SaveToStream(Stream: TStream); override;
  789.     property Handle: HICON;
  790.   end;
  791.  
  792. var    // New TFont instances are intialized with the values in this structure:
  793.   DefFontData: TFontData = (
  794.     Handle: 0;
  795.     Height: 0;
  796.     Pitch: fpDefault;
  797.     Style: [];
  798.     Charset : DEFAULT_CHARSET;
  799.     Name: 'MS Sans Serif');
  800.  
  801. var
  802.   SystemPalette16: HPalette; // 16 color palette that maps to the system palette
  803.  
  804. var
  805.   DDBsOnly: Boolean = False; // True = Load all BMPs as device bitmaps.
  806.                              // Not recommended.
  807.  
  808. function GraphicFilter(GraphicClass: TGraphicClass): string;
  809. function GraphicExtension(GraphicClass: TGraphicClass): string;
  810. function GraphicFileMask(GraphicClass: TGraphicClass): string;
  811.  
  812. function ColorToRGB(Color: TColor): Longint;
  813. function ColorToString(Color: TColor): string;
  814. function StringToColor(const S: string): TColor;
  815. procedure GetColorValues(Proc: TGetStrProc);
  816. function ColorToIdent(Color: Longint; var Ident: string): Boolean;
  817. function IdentToColor(const Ident: string; var Color: Longint): Boolean;
  818. procedure GetCharsetValues(Proc: TGetStrProc);
  819. function CharsetToIdent(Charset: Longint; var Ident: string): Boolean;
  820. function IdentToCharset(const Ident: string; var Charset: Longint): Boolean;
  821.  
  822. procedure GetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: DWORD;
  823.   var ImageSize: DWORD);
  824. function GetDIB(Bitmap: HBITMAP; Palette: HPALETTE; var BitmapInfo; var Bits): Boolean;
  825.  
  826. function CopyPalette(Palette: HPALETTE): HPALETTE;
  827.  
  828. procedure PaletteChanged;
  829. procedure FreeMemoryContexts;
  830.  
  831. function GetDefFontCharSet: TFontCharSet;
  832.  
  833. function TransparentStretchBlt(DstDC: HDC; DstX, DstY, DstW, DstH: Integer;
  834.   SrcDC: HDC; SrcX, SrcY, SrcW, SrcH: Integer; MaskDC: HDC; MaskX,
  835.   MaskY: Integer): Boolean;
  836.  
  837. function CreateMappedBmp(Handle: HBITMAP; const OldColors, NewColors: array of TColor): HBITMAP;
  838. function CreateMappedRes(Instance: THandle; ResName: PChar; const OldColors, NewColors: array of TColor): HBITMAP;
  839. function CreateGrayMappedBmp(Handle: HBITMAP): HBITMAP;
  840. function CreateGrayMappedRes(Instance: THandle; ResName: PChar): HBITMAP;
  841.  
  842. function AllocPatternBitmap(BkColor, FgColor: TColor): TBitmap;
  843.  
  844. // Alignment must be a power of 2.  Color BMPs require DWORD alignment (32).
  845. function BytesPerScanline(PixelsPerScanline, BitsPerPixel, Alignment: Longint): Longint;
  846.  
  847. implementation
  848.