home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 January / Chip_1999-01_cd.bin / zkuste / delphi / D1 / DICE.ZIP / DICE.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-13  |  8KB  |  271 lines
  1. { ****************************************************************** }
  2. {                                                                    }
  3. {   Delphi component TDice                                           }
  4. {                                                                    }
  5. {   Dice                                                             }
  6. {                                                                    }
  7. {   Code generated by Component Create for Delphi                    }
  8. {                                                                    }
  9. {   Generated from source file E:\DELPHI\COMPCREA\DICE.CD            }
  10. {   on 13 July 1995 at 15:40                                         }
  11. {                                                                    }
  12. {   Copyright ⌐ 1995 by Zane Rathwick                                }
  13. {                                                                    }
  14. { ****************************************************************** }
  15.  
  16.  
  17. unit Dice;
  18.  
  19. interface
  20.  
  21. {$IFDEF WIN32}
  22. uses Messages, Windows, SysUtils, Classes, Controls, 
  23.      Forms, Menus, Graphics;
  24. {$ELSE}
  25. uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls, 
  26.      Forms, Menus, Graphics;
  27. {$ENDIF}
  28.  
  29.  
  30. type
  31.   TDice = class(TGraphicControl)
  32.     private
  33.       { Private fields of TDice }
  34.         { Storage for property Value }
  35.         FValue : Integer;
  36.         { Storage for property BackColor }
  37.         FBackColor : TColor;
  38.         { Storage for property DiceColor }
  39.         FDiceColor : TColor;
  40.  
  41.       { Private methods of TDice }
  42.         { Method to set variable and property values and create objects }
  43.         procedure AutoInitialize;
  44.         { Method to free any objects created by AutoInitialize }
  45.         procedure AutoDestroy;
  46.         { Write method for property Value }
  47.         procedure SetValue(Value : Integer);
  48.         { Write method for property BackColor }
  49.         procedure SetBackColor(Value : TColor);
  50.         { Write method for property DiceColor }
  51.         procedure SetDiceColor(Value : TColor);
  52.         procedure WMSize(var Message: TWMSize); message WM_PAINT;
  53.  
  54.     protected
  55.       { Protected fields of TDice }
  56.  
  57.       { Protected methods of TDice }
  58.         procedure Click; override;
  59.         procedure Paint; override;
  60.  
  61.     public
  62.       { Public fields of TDice }
  63.  
  64.       { Public methods of TDice }
  65.         constructor Create(AOwner: TComponent); override;
  66.         destructor Destroy; override;
  67.         procedure Roll;
  68.  
  69.     published
  70.       { Published properties of the component }
  71.         property OnClick;
  72.         property OnDblClick;
  73.         property OnDragDrop;
  74.         property OnDragOver;
  75.         property OnEndDrag;
  76.         property OnMouseDown;
  77.         property OnMouseMove;
  78.         property OnMouseUp;
  79.         property Value : Integer read FValue write SetValue default 1;
  80.         property BackColor : TColor
  81.              read FBackColor write SetBackColor
  82.              default clsilver;
  83.         property DiceColor : TColor
  84.              read FDiceColor write SetDiceColor
  85.              default clwhite;
  86.  
  87.   end;
  88.  
  89. procedure Register;
  90.  
  91. implementation
  92.  
  93. procedure Register;
  94. begin
  95.      { Register TDice with Added VCL as its
  96.        default page on the Delphi component palette }
  97.      RegisterComponents('Added VCL', [TDice]);
  98.  
  99.      { Custom property editors, if any, can be registered here with
  100.        calls to RegisterPropertyEditor }
  101.  
  102. end;
  103.  
  104. { Method to set variable and property values and create objects }
  105. procedure TDice.AutoInitialize;
  106. begin
  107.      FValue := 1;
  108.      FBackColor := clsilver;
  109.      FDiceColor := clwhite;
  110. end; { of AutoInitialize }
  111.  
  112. { Method to free any objects created by AutoInitialize }
  113. procedure TDice.AutoDestroy;
  114. begin
  115.      { No objects from AutoInitialize to free }
  116. end; { of AutoDestroy }
  117.  
  118. { Write method for property Value }
  119. procedure TDice.SetValue(Value : Integer);
  120. begin
  121.      FValue := Value;
  122.      if fvalue< 0 then fvalue:=0;
  123.      if fvalue > 6 then fvalue :=6;
  124.      { If changing this property affects the appearance of
  125.        the component, call Paint here so the image will be
  126.        updated. }
  127.       Paint;
  128. end;
  129.  
  130. { Write method for property BackColor }
  131. procedure TDice.SetBackColor(Value : TColor);
  132. begin
  133.      FBackColor := Value;
  134.  
  135.      { If changing this property affects the appearance of
  136.        the component, call Paint here so the image will be
  137.        updated. }
  138.       Paint;
  139. end;
  140.  
  141. { Write method for property DiceColor }
  142. procedure TDice.SetDiceColor(Value : TColor);
  143. begin
  144.      FDiceColor := Value;
  145.  
  146.      { If changing this property affects the appearance of
  147.        the component, call Paint here so the image will be
  148.        updated. }
  149.       Paint;
  150. end;
  151.  
  152. { Override OnClick handler from TGraphicControl }
  153. procedure TDice.Click;
  154. begin
  155.      { Code to execute before activating click
  156.        behavior of component's parent class }
  157.  
  158.      { Activate click behavior of parent }
  159.      inherited Click;
  160.  
  161.      { Code to execute after click behavior
  162.        of parent }
  163.  
  164. end;
  165.  
  166. constructor TDice.Create(AOwner: TComponent);
  167. begin
  168.      { Call the Create method of the parent class }
  169.      inherited Create(AOwner);
  170.  
  171.      { AutoInitialize sets the initial values of variables and      }
  172.      { properties; also, it creates objects for any variables       }
  173.      { and properties of standard Delphi object types (e.g., TFont, }
  174.      { TTimer, TPicture).  AutoInitialize method is generated by    }
  175.      { Component Create.                                            }
  176.      AutoInitialize;
  177.  
  178.      { Code to perform other tasks when the component is created }
  179.      width:=32;
  180.      height:=32;
  181. end;
  182.  
  183. destructor TDice.Destroy;
  184. begin
  185.      { AutoDestroy, which is generated by Component Create, frees any   }
  186.      { objects created by AutoInitialize.                               }
  187.      AutoDestroy;
  188.  
  189.      { Here, free any other dynamic objects that the component methods  }
  190.      { created but have not yet freed.  Also perform any other clean-up }
  191.      { operations needed before the component is destroyed.             }
  192.  
  193.      { Last, free the component by calling the Destroy method of the    }
  194.      { parent class.                                                    }
  195.      inherited Destroy;
  196. end;
  197.  
  198. procedure TDice.WMSize(var Message: TWMSize);
  199. begin
  200.      inherited;
  201.      {No resizing allowed}
  202.      Width:=32;
  203.      Height:=32;
  204. end;
  205.  
  206. procedure TDice.Paint;
  207. var
  208. mybitmap:tbitmap;
  209. begin
  210.      {Create drawing bitmap}
  211.      mybitmap:=tbitmap.create;
  212.      mybitmap.width:=32;
  213.      mybitmap.height:=32;
  214.      {Fill to backcolor}
  215.      mybitmap.canvas.brush.color:=fbackcolor;
  216.      mybitmap.canvas.pen.color:=fbackcolor;
  217.      mybitmap.canvas.rectangle(0,0,width,height);
  218.      {Draw Dice}
  219.      mybitmap.canvas.pen.color:=clblack;
  220.      mybitmap.canvas.brush.color:=fdicecolor;
  221.      mybitmap.canvas.roundrect(0,0,width,height,6,6);
  222.      mybitmap.canvas.brush.color:=clblack;
  223.      {Draw dots}
  224.      case fvalue of
  225.      1: mybitmap.canvas.ellipse(13,13,19,19);
  226.      2: begin
  227.         mybitmap.canvas.ellipse(5,5,11,11);
  228.         mybitmap.canvas.ellipse(21,21,27,27);
  229.         end;
  230.      3: begin
  231.         mybitmap.canvas.ellipse(13,13,19,19);
  232.         mybitmap.canvas.ellipse(5,5,11,11);
  233.         mybitmap.canvas.ellipse(21,21,27,27);
  234.         end;
  235.      4: begin
  236.         mybitmap.canvas.ellipse(5,5,11,11);
  237.         mybitmap.canvas.ellipse(21,21,27,27);
  238.         mybitmap.canvas.ellipse(5,21,11,27);
  239.         mybitmap.canvas.ellipse(21,5,27,11);
  240.         end;
  241.      5: begin
  242.         mybitmap.canvas.ellipse(5,5,11,11);
  243.         mybitmap.canvas.ellipse(21,21,27,27);
  244.         mybitmap.canvas.ellipse(5,21,11,27);
  245.         mybitmap.canvas.ellipse(21,5,27,11);
  246.         mybitmap.canvas.ellipse(13,13,19,19);
  247.         end;
  248.      6: begin
  249.         mybitmap.canvas.ellipse(5,5,11,11);
  250.         mybitmap.canvas.ellipse(21,21,27,27);
  251.         mybitmap.canvas.ellipse(5,21,11,27);
  252.         mybitmap.canvas.ellipse(21,5,27,11);
  253.         mybitmap.canvas.ellipse(5,13,11,19);
  254.         mybitmap.canvas.ellipse(21,13,27,19);
  255.         end;
  256.      end;
  257.      {Copy bitmap to screen and destroy}
  258.      canvas.copyrect(rect(0,0,32,32),mybitmap.canvas,rect(0,0,32,32));
  259.      mybitmap.free;
  260. end;
  261.  
  262. procedure TDice.Roll;
  263. begin
  264.      {Seed random number before rolling}
  265.      setvalue(random(6)+1);
  266. end;
  267.  
  268.  
  269.  
  270. end.
  271.