home *** CD-ROM | disk | FTP | other *** search
/ PC Format Collection 48 / SENT14D.ISO / tech / delphi / disk14 / doc.pak / GRAPHICS.INT < prev    next >
Encoding:
Text File  |  1995-08-24  |  19.6 KB  |  505 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       Delphi Visual Component Library                 }
  4. {                                                       }
  5. {       Copyright (c) 1995 Borland International        }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit Graphics;
  10.  
  11. {$P+,S-,W-,R-}
  12. {$C PRELOAD}
  13.  
  14. interface
  15.  
  16. uses WinTypes, WinProcs, SysUtils, Classes;
  17.  
  18. { Graphics Objects }
  19.  
  20. type
  21.   TColor = -(COLOR_ENDCOLORS + 1)..$2FFFFFF;
  22.  
  23. const
  24.   clScrollBar = TColor(-COLOR_SCROLLBAR - 1);
  25.   clBackground = TColor(-COLOR_BACKGROUND - 1);
  26.   clActiveCaption = TColor(-COLOR_ACTIVECAPTION - 1);
  27.   clInactiveCaption = TColor(-COLOR_INACTIVECAPTION - 1);
  28.   clMenu = TColor(-COLOR_MENU - 1);
  29.   clWindow = TColor(-COLOR_WINDOW - 1);
  30.   clWindowFrame = TColor(-COLOR_WINDOWFRAME - 1);
  31.   clMenuText = TColor(-COLOR_MENUTEXT - 1);
  32.   clWindowText = TColor(-COLOR_WINDOWTEXT - 1);
  33.   clCaptionText = TColor(-COLOR_CAPTIONTEXT - 1);
  34.   clActiveBorder = TColor(-COLOR_ACTIVEBORDER - 1);
  35.   clInactiveBorder = TColor(-COLOR_INACTIVEBORDER - 1);
  36.   clAppWorkSpace = TColor(-COLOR_APPWORKSPACE - 1);
  37.   clHighlight = TColor(-COLOR_HIGHLIGHT - 1);
  38.   clHighlightText = TColor(-COLOR_HIGHLIGHTTEXT - 1);
  39.   clBtnFace = TColor(-COLOR_BTNFACE - 1);
  40.   clBtnShadow = TColor(-COLOR_BTNSHADOW - 1);
  41.   clGrayText = TColor(-COLOR_GRAYTEXT - 1);
  42.   clBtnText = TColor(-COLOR_BTNTEXT - 1);
  43.   clInactiveCaptionText = TColor(-COLOR_INACTIVECAPTIONTEXT - 1);
  44.   clBtnHighlight = TColor(-COLOR_BTNHIGHLIGHT - 1);
  45.  
  46.   clBlack = TColor($000000);
  47.   clMaroon = TColor($000080);
  48.   clGreen = TColor($008000);
  49.   clOlive = TColor($008080);
  50.   clNavy = TColor($800000);
  51.   clPurple = TColor($800080);
  52.   clTeal = TColor($808000);
  53.   clGray = TColor($808080);
  54.   clSilver = TColor($C0C0C0);
  55.   clRed = TColor($0000FF);
  56.   clLime = TColor($00FF00);
  57.   clYellow = TColor($00FFFF);
  58.   clBlue = TColor($FF0000);
  59.   clFuchsia = TColor($FF00FF);
  60.   clAqua = TColor($FFFF00);
  61.   clLtGray = TColor($C0C0C0);
  62.   clDkGray = TColor($808080);
  63.   clWhite = TColor($FFFFFF);
  64.  
  65. const
  66.   cmBlackness = BLACKNESS;
  67.   cmDstInvert = DSTINVERT;
  68.   cmMergeCopy = MERGECOPY;
  69.   cmMergePaint = MERGEPAINT;
  70.   cmNotSrcCopy = NOTSRCCOPY;
  71.   cmNotSrcErase = NOTSRCERASE;
  72.   cmPatCopy = PATCOPY;
  73.   cmPatInvert = PATINVERT;
  74.   cmPatPaint = PATPAINT;
  75.   cmSrcAnd = SRCAND;
  76.   cmSrcCopy = SRCCOPY;
  77.   cmSrcErase = SRCERASE;
  78.   cmSrcInvert = SRCINVERT;
  79.   cmSrcPaint = SRCPAINT;
  80.   cmWhiteness = WHITENESS;
  81.  
  82. type
  83.   HMETAFILE = THandle;
  84.   TExtension = string[3];
  85.  
  86.   EInvalidGraphic = class(Exception);
  87.   EInvalidGraphicOperation = class(Exception);
  88.  
  89.   TGraphic = class;
  90.   TBitmap = class;
  91.   TIcon = class;
  92.   TMetafile = class;
  93.  
  94.   TFontStyle = (fsBold, fsItalic, fsUnderline, fsStrikeOut);
  95.   TFontStyles = set of TFontStyle;
  96.   TFontPitch = (fpDefault, fpVariable, fpFixed);
  97.   TFontName = string[LF_FACESIZE - 1];
  98.  
  99.   TPenStyle = (psSolid, psDash, psDot, psDashDot, psDashDotDot, psClear,
  100.     psInsideFrame);
  101.   TPenMode = (pmBlack, pmWhite, pmNop, pmNot, pmCopy, pmNotCopy,
  102.     pmMergePenNot, pmMaskPenNot, pmMergeNotPen, pmMaskNotPen, pmMerge,
  103.     pmNotMerge, pmMask, pmNotMask, pmXor, pmNotXor);
  104.  
  105.   TBrushStyle = (bsSolid, bsClear, bsHorizontal, bsVertical,
  106.     bsFDiagonal, bsBDiagonal, bsCross, bsDiagCross);
  107.  
  108.   TBrushData = record
  109.     Handle: HBrush;
  110.     Color: TColor;
  111.     Bitmap: TBitmap;
  112.     Style: TBrushStyle;
  113.   end;
  114.  
  115.   TGraphicsObject = class(TPersistent)
  116.   protected
  117.     procedure Changed; dynamic;
  118.   public
  119.     property OnChange: TNotifyEvent;
  120.   end;
  121.  
  122.   TFont = class(TGraphicsObject)
  123.   protected
  124.     function GetHandle: HFont;
  125.     function GetHeight: Integer;
  126.     function GetName: TFontName;
  127.     function GetPitch: TFontPitch;
  128.     function GetSize: Integer;
  129.     function GetStyle: TFontStyles;
  130.     procedure SetColor(Value: TColor);
  131.     procedure SetHandle(Value: HFont);
  132.     procedure SetHeight(Value: Integer);
  133.     procedure SetName(const Value: TFontName);
  134.     procedure SetPitch(Value: TFontPitch);
  135.     procedure SetSize(Value: Integer);
  136.     procedure SetStyle(Value: TFontStyles);
  137.   public
  138.     constructor Create;
  139.     destructor Destroy; override;
  140.     procedure Assign(Source: TPersistent); override;
  141.     property Handle: HFont;
  142.     property PixelsPerInch: Integer;
  143.   published
  144.     property Color: TColor;
  145.     property Height: Integer;
  146.     property Name: TFontName;
  147.     property Pitch: TFontPitch default fpDefault;
  148.     property Size: Integer;
  149.     property Style: TFontStyles;
  150.   end;
  151.  
  152.   TPen = class(TGraphicsObject)
  153.   protected
  154.     function GetColor: TColor;
  155.     procedure SetColor(Value: TColor);
  156.     function GetHandle: HPen;
  157.     procedure SetHandle(Value: HPen);
  158.     procedure SetMode(Value: TPenMode);
  159.     function GetStyle: TPenStyle;
  160.     procedure SetStyle(Value: TPenStyle);
  161.     function GetWidth: Integer;
  162.     procedure SetWidth(Value: Integer);
  163.   public
  164.     constructor Create;
  165.     destructor Destroy; override;
  166.     procedure Assign(Source: TPersistent); override;
  167.     property Handle: HPen;
  168.   published
  169.     property Color: TColor default clBlack;
  170.     property Mode: TPenMode default pmCopy;
  171.     property Style: TPenStyle default psSolid;
  172.     property Width: Integer default 1;
  173.   end;
  174.  
  175.   TBrush = class(TGraphicsObject)
  176.   protected
  177.     function GetBitmap: TBitmap;
  178.     procedure SetBitmap(Value: TBitmap);
  179.     function GetColor: TColor;
  180.     procedure SetColor(Value: TColor);
  181.     function GetHandle: HBrush;
  182.     procedure SetHandle(Value: HBrush);
  183.     function GetStyle: TBrushStyle;
  184.     procedure SetStyle(Value: TBrushStyle);
  185.   public
  186.     constructor Create;
  187.     destructor Destroy; override;
  188.     procedure Assign(Source: TPersistent); override;
  189.     property Bitmap: TBitmap;
  190.     property Handle: HBrush;
  191.   published
  192.     property Color: TColor default clWhite;
  193.     property Style: TBrushStyle default bsSolid;
  194.   end;
  195.  
  196.   TFillStyle = (fsSurface, fsBorder);
  197.  
  198.   TCopyMode = Longint;
  199.  
  200.   TCanvasStates = (csHandleValid, csFontValid, csPenValid, csBrushValid);
  201.   TCanvasState = set of TCanvasStates;
  202.  
  203.   TCanvas = class(TPersistent)
  204.   protected
  205.     procedure Changed; virtual;
  206.     procedure Changing; virtual;
  207.     procedure CreateHandle; virtual;
  208.   public
  209.     constructor Create;
  210.     destructor Destroy; override;
  211.     procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
  212.     procedure BrushCopy(const Dest: TRect; Bitmap: TBitmap;
  213.       const Source: TRect; Color: TColor);
  214.     procedure Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
  215.     procedure CopyRect(const Dest: TRect; Canvas: TCanvas;
  216.       const Source: TRect);
  217.     procedure Draw(X, Y: Integer; Graphic: TGraphic);
  218.     procedure DrawFocusRect(const Rect: TRect);
  219.     procedure Ellipse(X1, Y1, X2, Y2: Integer);
  220.     procedure FillRect(const Rect: TRect);
  221.     procedure FloodFill(X, Y: Integer; Color: TColor; FillStyle: TFillStyle);
  222.     procedure FrameRect(const Rect: TRect);
  223.     procedure LineTo(X, Y: Integer);
  224.     procedure MoveTo(X, Y: Integer);
  225.     procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
  226.     procedure Polygon(const Points: array of TPoint);
  227.     procedure Polyline(const Points: array of TPoint);
  228.     procedure Rectangle(X1, Y1, X2, Y2: Integer);
  229.     procedure Refresh;
  230.     procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
  231.     procedure StretchDraw(const Rect: TRect; Graphic: TGraphic);
  232.     function TextHeight(const Text: string): Integer;
  233.     procedure TextOut(X, Y: Integer; const Text: string);
  234.     procedure TextRect(Rect: TRect; X, Y: Integer; const Text: string);
  235.     function TextWidth(const Text: string): Integer;
  236.     property ClipRect: TRect;
  237.     property Handle: HDC;
  238.     property PenPos: TPoint;
  239.     property Pixels[X, Y: Integer]: TColor;
  240.     property OnChange: TNotifyEvent;
  241.     property OnChanging: TNotifyEvent;
  242.   published
  243.     property Brush: TBrush;
  244.     property CopyMode: TCopyMode default cmSrcCopy;
  245.     property Font: TFont;
  246.     property Pen: TPen;
  247.   end;
  248.  
  249.   { The TGraphic class is a abstract base class for dealing with graphic images
  250.     such as metafile, bitmaps and icons; but is not limited to such.
  251.       LoadFromFile - Read the graphic from the file system.  The old contents of
  252.         the graphic are lost.  If the file is not of the right format, an
  253.         exception will be generated.
  254.       SaveToFile - Writes the graphic to disk in the file provided.
  255.       LoadFromStream - Like LoadFromFile except source is a stream (e.g.
  256.         TBlobStream).
  257.       SaveToStream - stream analogue of SaveToFile.
  258.       LoadFromClipboardFormat - Replaces the current image with the data
  259.         provided.  If the TGraphic does not support that format it will generate
  260.         an exception.
  261.       SaveToClipboardFormats - Converts the image to a clipboard format.  If the
  262.         image does not support being translated into a clipboard format it
  263.         will generate an exception.
  264.       Height - The native, unstretched, height of the graphic.
  265.       Width - The native, unstretched, width of the graphic.
  266.       OnChange - Called whenever the graphic changes }
  267.  
  268.   TGraphic = class(TPersistent)
  269.   protected
  270.     constructor Create; virtual;
  271.     procedure Changed(Sender: TObject);
  272.     procedure DefineProperties(Filer: TFiler); override;
  273.     procedure Draw(ACanvas: TCanvas; const Rect: TRect); virtual; abstract;
  274.     function GetEmpty: Boolean; virtual; abstract;
  275.     function GetHeight: Integer; virtual; abstract;
  276.     function GetWidth: Integer; virtual; abstract;
  277.     procedure ReadData(Stream: TStream); virtual;
  278.     procedure SetHeight(Value: Integer); virtual; abstract;
  279.     procedure SetWidth(Value: Integer); virtual; abstract;
  280.     procedure WriteData(Stream: TStream); virtual;
  281.   public
  282.     procedure Assign(Source: TPersistent); override;
  283.     procedure LoadFromFile(const Filename: string); virtual;
  284.     procedure SaveToFile(const Filename: string); virtual;
  285.     procedure LoadFromStream(Stream: TStream); virtual; abstract;
  286.     procedure SaveToStream(Stream: TStream); virtual; abstract;
  287.     procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  288.       APalette: HPALETTE); virtual; abstract;
  289.     procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
  290.       var APalette: HPALETTE); virtual; abstract;
  291.     property Empty: Boolean;
  292.     property Height: Integer;
  293.     property Modified: Boolean;
  294.     property Width: Integer;
  295.     property OnChange: TNotifyEvent;
  296.   end;
  297.  
  298.   TGraphicClass = class of TGraphic;
  299.  
  300.   { TPicture }
  301.   { TPicture is a TGraphic container.  It is used in place of a TGraphic if the
  302.     graphic can be of any TGraphic class.  LoadFromFile and SaveToFile are
  303.     polymorphic. For example, if the TPicture is holding an Icon, you can
  304.     LoadFromFile a bitmap file, where if the class was TIcon you could only read
  305.     .ICO files.
  306.       LoadFromFile - Reads a picture from disk.  The TGraphic class created
  307.         determined by the file extension of the file.  If the file extension is
  308.         not recognized an exception is generated.
  309.       SaveToFile - Writes the picture to disk.
  310.       LoadFromClipboardFormat - Reads the picture from the handle provided in
  311.         the given clipboard format.  If the format is not supported, an
  312.         exception is generated.
  313.       SaveToClipboardFormats - Allocates a global handle and writes the picture
  314.         in its native clipboard format (CF_BITMAP for bitmaps, CF_METAFILE
  315.         for metafiles, etc.).  Formats will contain the formats written.
  316.         Returns the number of clipboard items written to the array pointed to
  317.         by Formats and Datas or would be written if either Formats or Datas are
  318.         nil.
  319.       SupportsClipboardFormat - Returns true if the given clipboard format
  320.         is supported by LoadFromClipboardFormat.
  321.       Assign - Copys the contents of the given TPicture.  Used most often in
  322.         the implementation of TPicture properties.
  323.       RegisterFileFormat - Register a new TGraphic class for use in
  324.         LoadFromFile.
  325.       RegisterClipboardFormat - Registers a new TGraphic class for use in
  326.         LoadFromClipboardFormat.
  327.       Height - The native, unstretched, height of the picture.
  328.       Width - The native, unstretched, width of the picture.
  329.       Graphic - The TGraphic object contained by the TPicture
  330.       Bitmap - Returns a bitmap.  If the contents is not already a bitmap, the
  331.         contents are thrown away and a blank bitmap is returned.
  332.       Icon - Returns an icon.  If the contents is not already an icon, the
  333.         contents are thrown away and a blank icon is returned.
  334.       Metafile - Returns a metafile.  If the contents is not already a bitmap,
  335.         the contents are thrown away and a blank metafile is returned. }
  336.   TPicture = class(TPersistent)
  337.   protected
  338.     procedure Changed(Sender: TObject);
  339.     procedure DefineProperties(Filer: TFiler); override;
  340.   public
  341.     destructor Destroy; override;
  342.     procedure LoadFromFile(const Filename: string);
  343.     procedure SaveToFile(const Filename: string);
  344.     procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  345.       APalette: HPALETTE);
  346.     procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
  347.       var APalette: HPALETTE);
  348.     class function SupportsClipboardFormat(AFormat: Word): Boolean;
  349.     procedure Assign(Source: TPersistent); override;
  350.     class procedure RegisterFileFormat(const AExtension, ADescription: string;
  351.       AGraphicClass: TGraphicClass);
  352.     class procedure RegisterClipboardFormat(AFormat: Word;
  353.       AGraphicClass: TGraphicClass);
  354.     property Bitmap: TBitmap;
  355.     property Graphic: TGraphic;
  356.     property Height: Integer;
  357.     property Icon: TIcon;
  358.     property Metafile: TMetafile;
  359.     property Width: Integer;
  360.     property OnChange: TNotifyEvent;
  361.   end;
  362.  
  363.   { TMetafile }
  364.   { TMetafile is an encapsulation of Windows metafile rendering.
  365.       Handle - The metafile handle.
  366.       Inch - The units per inch assumed by the metafile.  Changing this
  367.         value changes the coordinate system and, therefore, the width
  368.         and height of the metafile.  New metafiles default to the device
  369.         LOGPIXELSPERINCH value given by Windows GDI. }
  370.  
  371.   TMetafile = class(TGraphic)
  372.   protected
  373.     function GetEmpty: Boolean; override;
  374.     function GetHeight: Integer; override;
  375.     function GetWidth: Integer; override;
  376.     procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
  377.     procedure ReadData(Stream: TStream); override;
  378.     procedure SetHeight(Value: Integer); override;
  379.     procedure SetWidth(Value: Integer); override;
  380.     procedure WriteData(Stream: TStream); override;
  381.   public
  382.     constructor Create;
  383.     destructor Destroy; override;
  384.     procedure LoadFromStream(Stream: TStream); override;
  385.     procedure SaveToStream(Stream: TStream); override;
  386.     procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  387.       APalette: HPALETTE); override;
  388.     procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
  389.       var APalette: HPALETTE); override;
  390.     procedure Assign(Source: TPersistent); override;
  391.     property Handle: HMETAFILE;
  392.     property Inch: Word;
  393.   end;
  394.  
  395.   { TBitmap }
  396.   { TBitmap is an encapuslation of a Windows HBITMAP and HPALETTE.  It manages
  397.     the palette realizing automatically as well as having a Canvas to allow
  398.     modifications to the palette.  Creating copies of a TBitmap is very fast
  399.     since the handles is copied not the image.  If the image is modified, and
  400.     the handle is shared by more than one TBitmap object, the image is copied
  401.     before the modification is performed (i.e. copy on write).
  402.       Canvas - Allows drawing on the bitmap.
  403.       Handle - The HBITMAP encapsulated by the TBitmap.  Grabbing the handle
  404.         directly should be avoided since it causes the HBITMAP to be copied if
  405.         more than one TBitmap share the handle.
  406.       Palette - The HPALETTE realized by the TBitmap.  Grabbing this handle
  407.         directly should be avoided since it causes the HPALETTE to be copied if
  408.         more than one TBitmap share the handle.
  409.       Monochrome - True if the bitmap is a monochrome bitmap }
  410.  
  411.   TBitmap = class(TGraphic)
  412.   protected
  413.     procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
  414.     function GetEmpty: Boolean; override;
  415.     function GetHeight: Integer; override;
  416.     function GetWidth: Integer; override;
  417.     procedure ReadData(Stream: TStream); override;
  418.     procedure SetWidth(Value: Integer); override;
  419.     procedure SetHeight(Value: Integer); override;
  420.     procedure WriteData(Stream: TStream); override;
  421.   public
  422.     constructor Create; override;
  423.     destructor Destroy; override;
  424.     procedure Assign(Source: TPersistent); override;
  425.     procedure Dormant;
  426.     procedure FreeImage;
  427.     procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  428.       APalette: HPALETTE); override;
  429.     procedure LoadFromStream(Stream: TStream); override;
  430.     function ReleaseHandle: HBITMAP;
  431.     function ReleasePalette: HPALETTE;
  432.     procedure SaveToClipboardFormat(var Format: Word; var Data: THandle;
  433.       var APalette: HPALETTE); override;
  434.     procedure SaveToStream(Stream: TStream); override;
  435.     property Canvas: TCanvas;
  436.     property Handle: HBITMAP;
  437.     property Monochrome: Boolean;
  438.     property Palette: HPALETTE;
  439.     property TransparentColor: TColor;
  440.   end;
  441.  
  442.   { TIcon }
  443.   { TIcon encapsulates window HICON handle. Drawing of an icon does not stretch
  444.     so calling stretch draw is not meaningful.
  445.       Handle - The HICON used by the TIcon. }
  446.  
  447.   TIcon = class(TGraphic)
  448.   protected
  449.     procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
  450.     function GetEmpty: Boolean; override;
  451.     function GetHeight: Integer; override;
  452.     function GetWidth: Integer; override;
  453.     procedure SetHeight(Value: Integer); override;
  454.     procedure SetWidth(Value: Integer); override;
  455.     procedure SaveToClipboardFormat(var Format: Word; var Data: THandle;
  456.       var APalette: HPALETTE); override;
  457.   public
  458.     constructor Create; override;
  459.     destructor Destroy; override;
  460.     procedure Assign(Source: TPersistent); override;
  461.     procedure LoadFromStream(Stream: TStream); override;
  462.     function ReleaseHandle: HICON;
  463.     procedure SaveToStream(Stream: TStream); override;
  464.     property Handle: HICON;
  465.   end;
  466.  
  467.   { TImageList }
  468.  
  469.   TImageList = class
  470.   public
  471.     constructor Create(AWidth, AHeight: Integer);
  472.     destructor Destroy; override;
  473.     function Add(Image, Mask: TBitmap): Integer;
  474.     function AddMasked(Image: TBitmap; MaskColor: TColor): Integer;
  475.     procedure Replace(Index: Integer; Image, Mask: TBitmap);
  476.     procedure ReplaceMasked(Index: Integer; Image: TBitmap; MaskColor: TColor);
  477.     procedure Draw(Canvas: TCanvas; X, Y: Integer; Index: Integer);
  478.     procedure Delete(Index: Integer);
  479.     property Count: Integer;
  480.     property Delta: Integer;
  481.     property Width: Integer;
  482.     property Height: Integer;
  483.   end;
  484.  
  485. function GraphicFilter(GraphicClass: TGraphicClass): string;
  486. function GraphicExtension(GraphicClass: TGraphicClass): string;
  487.  
  488. function ColorToRGB(Color: TColor): Longint;
  489. function ColorToString(Color: TColor): string;
  490. function StringToColor(S: string): TColor;
  491. procedure GetColorValues(Proc: TGetStrProc);
  492. function ColorToIdent(Color: Longint; var Ident: string): Boolean;
  493. function IdentToColor(const Ident: string; var Color: Longint): Boolean;
  494.  
  495. function MemAlloc(Size: Longint): Pointer;
  496. procedure GetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: Integer;
  497.   var ImageSize: Longint);
  498. function GetDIB(Bitmap: HBITMAP; Palette: HPALETTE; var BitmapInfo; var Bits): Boolean;
  499.  
  500. procedure InitGraphics;
  501. procedure PaletteChanged;
  502. procedure FreeMemoryContexts;
  503.  
  504. implementation
  505.