home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d123456 / CHEMPLOT.ZIP / Misc / Shapeex.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-26  |  10KB  |  293 lines
  1. unit Shapeex;
  2.  
  3. {-----------------------------------------------------------------------------
  4. The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at
  5.  
  6. http://www.mozilla.org/MPL/MPL-1.1.html
  7.  
  8. Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License.
  9.  
  10. The Original Code is: ShapeEx.pas, released 12 September 2000.
  11.  
  12. The Initial Developer of the Original Code is Mat Ballard.
  13. Portions created by Mat Ballard are Copyright (C) 1999 Mat Ballard.
  14. Portions created by Microsoft are Copyright (C) 1998, 1999 Microsoft Corp.
  15. All Rights Reserved.
  16.  
  17. Contributor(s): Mat Ballard                 e-mail: mat.ballard@chemware.hypermart.net.
  18.  
  19. Last Modified: 05/25/2000
  20. Current Version: 2.00
  21.  
  22. You may retrieve the latest version of this file from:
  23.  
  24.         http://Chemware.hypermart.net/
  25.  
  26. This work was created with the Project JEDI VCL guidelines:
  27.  
  28.         http://www.delphi-jedi.org/Jedi:VCLVCL
  29.  
  30. in mind. 
  31.  
  32.  
  33. Purpose:
  34. This component is similar to TShape, but adds arrows and lines.
  35.  
  36. Known Issues:
  37. -----------------------------------------------------------------------------}
  38.  
  39. interface
  40.  
  41. uses
  42.   Classes, SysUtils,
  43. {$IFDEF WINDOWS}
  44.   WinTypes, WinProcs,
  45.   Controls, Graphics
  46. {$ENDIF}
  47. {$IFDEF WIN32}
  48.   Windows,
  49.   Controls, Graphics
  50. {$ENDIF}
  51. {$IFDEF LINUX}
  52.   Qt,
  53.   QControls, QGraphics
  54. {$ENDIF}
  55.   ;
  56.  
  57. const
  58.   TSHAPEEX_VERSION = 100;
  59.  
  60. type
  61.   TShapeExType = (stArrowRight, stArrowLeft,
  62.                   stArrowUp, stArrowDown,
  63.                   stEllipse,
  64.                   stLineHorz, stLineVert,
  65.                   stRectangle, stRectangleRound,
  66.                   stTriangleUp, stTriangleDown, stTriangleLeft, stTriangleRight 
  67.                   );
  68.   {These are the extended shape types:}
  69.   {}
  70.   {stRectangle, stRectangleRound,}
  71.   {stEllipse,}
  72.   {stLineHorz, stLineVert,}
  73.   {stArrowRight, stArrowLeft,}
  74.   {stArrowUp, stArrowDown}
  75.  
  76.   TShapeEx = class(TGraphicControl)
  77.   private
  78.     { Private declarations }
  79.     FShape: TShapeExType;
  80.     FPen: TPen;
  81.     FBrush: TBrush;
  82.     procedure SetShape(Value: TShapeExType);
  83.     procedure SetPen(Value: TPen);
  84.     procedure SetBrush(Value: TBrush);
  85.   protected
  86.     procedure Paint; override;
  87.     {This is the new Paint procedure that draws the various shapes on the canvas.}
  88.     procedure StyleChange(Sender: TObject); dynamic;
  89.  
  90.   public
  91.     { Public declarations }
  92.     Constructor Create(AOwner: TComponent); override;
  93.     {This is the normal constructor. It creates the Pen and Brush,
  94.      initializes some properties, and sets the FBrush.OnChange event method.}
  95.     Destructor Destroy; override;
  96.     {This is the normal destructor. It frees the Pen and Brush.}
  97.   published
  98.     { Published declarations }
  99.     Property Shape: TShapeExType read FShape write SetShape;
  100.     {This is the shape to draw.}
  101.     Property Brush: TBrush read FBrush write SetBrush;
  102.     {This is the brush with which to draw the shape.}
  103.     Property Pen: TPen read FPen write SetPen;
  104.     {This is the pen with which to draw the shape.}
  105.  
  106. {Publish the Protected Events of the base class:}
  107.     Property OnClick;
  108.     Property OnDragDrop;
  109.     Property OnEndDrag;
  110.     Property OnMouseMove;
  111.     Property OnDblClick;
  112.     Property OnDragOver;
  113.     Property OnMouseDown;
  114.     Property OnMouseUp;
  115.   end;
  116.  
  117. implementation
  118.  
  119. {------------------------------------------------------------------------------
  120.     Procedure: TShapeEx.Create
  121.   Description: standard constructor
  122.        Author: Mat Ballard
  123.  Date created: 04/25/2000
  124. Date modified: 04/25/2000 by Mat Ballard
  125.       Purpose: creates the Pen and Brush, and sets the Position
  126.  Known Issues:
  127.  ------------------------------------------------------------------------------}
  128. Constructor TShapeEx.Create(AOwner:TComponent);
  129. begin
  130.   inherited Create(AOwner);
  131.   Width := 50;
  132.   Height := 50;
  133.   { Create Pen}
  134.   FPen := TPen.Create;
  135.   FPen.OnChange := StyleChange; { assign method to OnChange event }
  136.   { Create Brush}
  137.   FBrush := TBrush.Create;
  138.   FBrush.OnChange := StyleChange; { assign method to OnChange event }
  139. end;
  140.  
  141. {------------------------------------------------------------------------------
  142.     Procedure: TShapeEx.Destroy
  143.   Description: standard destructor
  144.        Author: Mat Ballard
  145.  Date created: 04/25/2000
  146. Date modified: 04/25/2000 by Mat Ballard
  147.       Purpose: frees the Pen and Brush
  148.  Known Issues:
  149.  ------------------------------------------------------------------------------}
  150. Destructor TShapeEx.Destroy;
  151. begin
  152.   FPen.Free;
  153.   FBrush.Free;
  154.   inherited Destroy;
  155. end;
  156.  
  157. {------------------------------------------------------------------------------
  158.     Procedure: TShapeEx.SetShape
  159.   Description: standard property Set procedure
  160.        Author: Mat Ballard
  161.  Date created: 04/25/2000
  162. Date modified: 04/25/2000 by Mat Ballard
  163.       Purpose: sets the Shape Property
  164.  Known Issues:
  165.  ------------------------------------------------------------------------------}
  166. procedure TShapeEx.SetShape(Value: TShapeExType);
  167. begin
  168.   FShape := Value;
  169.   Refresh;
  170. end;
  171.  
  172. {------------------------------------------------------------------------------
  173.     Procedure: TShapeEx.SetPen
  174.   Description: standard property Set procedure
  175.        Author: Mat Ballard
  176.  Date created: 04/25/2000
  177. Date modified: 04/25/2000 by Mat Ballard
  178.       Purpose: sets the Pen Property
  179.  Known Issues:
  180.  ------------------------------------------------------------------------------}
  181. procedure TShapeEx.SetPen(Value: TPen);
  182. begin
  183.   FPen.Assign(Value);
  184.   Refresh;
  185. end;
  186.  
  187. {------------------------------------------------------------------------------
  188.     Procedure: TShapeEx.SetBrush
  189.   Description: standard property Set procedure
  190.        Author: Mat Ballard
  191.  Date created: 04/25/2000
  192. Date modified: 04/25/2000 by Mat Ballard
  193.       Purpose: sets the Brush Property
  194.  Known Issues:
  195.  ------------------------------------------------------------------------------}
  196. procedure TShapeEx.SetBrush(Value: TBrush);
  197. begin
  198.   FBrush.Assign(Value);
  199.   Refresh;
  200. end;
  201.  
  202. {------------------------------------------------------------------------------
  203.     Procedure: TShapeEx.Paint
  204.   Description: standard Paint procedure
  205.        Author: Mat Ballard
  206.  Date created: 04/25/2000
  207. Date modified: 04/25/2000 by Mat Ballard
  208.       Purpose: draws the shape on the canvas
  209.  Known Issues:
  210.  ------------------------------------------------------------------------------}
  211. procedure TShapeEx.Paint;
  212. var
  213.   {Radius_X, Radius_Y: Integer;}
  214.   PT: Integer; {pen thickness / 2}
  215. begin
  216.   Canvas.Pen := FPen;
  217.   Canvas.Brush := FBrush;
  218.   PT := Pen.Width div 2;
  219.   case FShape of
  220.     stRectangle: Canvas.Rectangle(PT,PT, Width-PT, Height-PT);
  221.     stRectangleRound: Canvas.RoundRect(PT,PT, Width-PT, Height-PT, Width div 4, Height div 4);
  222.     stEllipse: Canvas.Ellipse(PT, PT, Width-PT, Height-PT);
  223.     stLineHorz:
  224.       begin
  225.         Canvas.MoveTo(0, Height div 2);
  226.         Canvas.LineTo(Width-1, Height div 2);
  227.       end;
  228.     stLineVert:
  229.       begin
  230.         Canvas.MoveTo(Width div 2, 0);
  231.         Canvas.LineTo(Width div 2, Height-1);
  232.       end;
  233.     stArrowLeft:
  234.       begin
  235.         Canvas.MoveTo(Width-1, Height div 2);
  236.         Canvas.LineTo(PT, Height div 2);
  237.         Canvas.LineTo(Height div 2, Height-1);
  238.         Canvas.MoveTo(PT, Height div 2);
  239.         Canvas.LineTo(Height div 2, 0);
  240.       end;
  241.     stArrowRight:
  242.       begin
  243.         Canvas.MoveTo(0, Height div 2);
  244.         Canvas.LineTo(Width-PT, Height div 2);
  245.         Canvas.LineTo(Width-1-(Height div 2), Height-1);
  246.         Canvas.MoveTo(Width-PT, Height div 2);
  247.         Canvas.LineTo(Width-1-(Height div 2), 0);
  248.       end;
  249.     stArrowUp:
  250.       begin
  251.         Canvas.MoveTo(Width div 2, Height-1);
  252.         Canvas.LineTo(Width div 2, PT);
  253.         Canvas.LineTo(0, Width div 2);
  254.         Canvas.MoveTo(Width div 2, PT);
  255.         Canvas.LineTo(Width-1, Width div 2);
  256.       end;
  257.     stArrowDown:
  258.       begin
  259.         Canvas.MoveTo(Width div 2, 0);
  260.         Canvas.LineTo(Width div 2, Height-PT);
  261.         Canvas.LineTo(0, Height-1-(Width div 2));
  262.         Canvas.MoveTo(Width div 2, Height-PT);
  263.         Canvas.LineTo(Width-1, Height-1-(Width div 2));
  264.       end;
  265.     stTriangleUp:
  266.       Canvas.Polygon([Point(Width div 2, 0), Point(Width-1, Height-1), Point(0, Height-1)]);
  267.     stTriangleDown:
  268.       Canvas.Polygon([Point(0, 0), Point(Width-1, 0), Point(Width div 2, Height-1)]);
  269.     stTriangleLeft:
  270.       Canvas.Polygon([Point(0, Height div 2), Point(Width-1, 0), Point(Width-1, Height-1)]);
  271.     stTriangleRight:
  272.       Canvas.Polygon([Point(0, 0), Point(Width-1, Height div 2), Point(0, Height-1)]);
  273.   end; {switch}
  274. end;
  275.  
  276. {------------------------------------------------------------------------------
  277.     Procedure: TShapeEx.StyleChange
  278.   Description: standard change event handler
  279.        Author: Mat Ballard
  280.  Date created: 04/25/2000
  281. Date modified: 04/25/2000 by Mat Ballard
  282.       Purpose: forces a redraw
  283.  Known Issues:
  284.  ------------------------------------------------------------------------------}
  285. procedure TShapeEx.StyleChange(Sender: TObject);
  286. begin
  287.   Refresh;
  288.   { Invalidate;  erase and repaint the component }
  289. end;
  290.  
  291. end.
  292.  
  293.