home *** CD-ROM | disk | FTP | other *** search
- { ****************************************************************** }
- { }
- { Delphi component TDice }
- { }
- { Dice }
- { }
- { Code generated by Component Create for Delphi }
- { }
- { Generated from source file E:\DELPHI\COMPCREA\DICE.CD }
- { on 13 July 1995 at 15:40 }
- { }
- { Copyright ⌐ 1995 by Zane Rathwick }
- { }
- { ****************************************************************** }
-
-
- unit Dice;
-
- interface
-
- {$IFDEF WIN32}
- uses Messages, Windows, SysUtils, Classes, Controls,
- Forms, Menus, Graphics;
- {$ELSE}
- uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
- Forms, Menus, Graphics;
- {$ENDIF}
-
-
- type
- TDice = class(TGraphicControl)
- private
- { Private fields of TDice }
- { Storage for property Value }
- FValue : Integer;
- { Storage for property BackColor }
- FBackColor : TColor;
- { Storage for property DiceColor }
- FDiceColor : TColor;
-
- { Private methods of TDice }
- { Method to set variable and property values and create objects }
- procedure AutoInitialize;
- { Method to free any objects created by AutoInitialize }
- procedure AutoDestroy;
- { Write method for property Value }
- procedure SetValue(Value : Integer);
- { Write method for property BackColor }
- procedure SetBackColor(Value : TColor);
- { Write method for property DiceColor }
- procedure SetDiceColor(Value : TColor);
- procedure WMSize(var Message: TWMSize); message WM_PAINT;
-
- protected
- { Protected fields of TDice }
-
- { Protected methods of TDice }
- procedure Click; override;
- procedure Paint; override;
-
- public
- { Public fields of TDice }
-
- { Public methods of TDice }
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure Roll;
-
- published
- { Published properties of the component }
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property Value : Integer read FValue write SetValue default 1;
- property BackColor : TColor
- read FBackColor write SetBackColor
- default clsilver;
- property DiceColor : TColor
- read FDiceColor write SetDiceColor
- default clwhite;
-
- end;
-
- procedure Register;
-
- implementation
-
- procedure Register;
- begin
- { Register TDice with Added VCL as its
- default page on the Delphi component palette }
- RegisterComponents('Added VCL', [TDice]);
-
- { Custom property editors, if any, can be registered here with
- calls to RegisterPropertyEditor }
-
- end;
-
- { Method to set variable and property values and create objects }
- procedure TDice.AutoInitialize;
- begin
- FValue := 1;
- FBackColor := clsilver;
- FDiceColor := clwhite;
- end; { of AutoInitialize }
-
- { Method to free any objects created by AutoInitialize }
- procedure TDice.AutoDestroy;
- begin
- { No objects from AutoInitialize to free }
- end; { of AutoDestroy }
-
- { Write method for property Value }
- procedure TDice.SetValue(Value : Integer);
- begin
- FValue := Value;
- if fvalue< 0 then fvalue:=0;
- if fvalue > 6 then fvalue :=6;
- { If changing this property affects the appearance of
- the component, call Paint here so the image will be
- updated. }
- Paint;
- end;
-
- { Write method for property BackColor }
- procedure TDice.SetBackColor(Value : TColor);
- begin
- FBackColor := Value;
-
- { If changing this property affects the appearance of
- the component, call Paint here so the image will be
- updated. }
- Paint;
- end;
-
- { Write method for property DiceColor }
- procedure TDice.SetDiceColor(Value : TColor);
- begin
- FDiceColor := Value;
-
- { If changing this property affects the appearance of
- the component, call Paint here so the image will be
- updated. }
- Paint;
- end;
-
- { Override OnClick handler from TGraphicControl }
- procedure TDice.Click;
- begin
- { Code to execute before activating click
- behavior of component's parent class }
-
- { Activate click behavior of parent }
- inherited Click;
-
- { Code to execute after click behavior
- of parent }
-
- end;
-
- constructor TDice.Create(AOwner: TComponent);
- begin
- { Call the Create method of the parent class }
- inherited Create(AOwner);
-
- { AutoInitialize sets the initial values of variables and }
- { properties; also, it creates objects for any variables }
- { and properties of standard Delphi object types (e.g., TFont, }
- { TTimer, TPicture). AutoInitialize method is generated by }
- { Component Create. }
- AutoInitialize;
-
- { Code to perform other tasks when the component is created }
- width:=32;
- height:=32;
- end;
-
- destructor TDice.Destroy;
- begin
- { AutoDestroy, which is generated by Component Create, frees any }
- { objects created by AutoInitialize. }
- AutoDestroy;
-
- { Here, free any other dynamic objects that the component methods }
- { created but have not yet freed. Also perform any other clean-up }
- { operations needed before the component is destroyed. }
-
- { Last, free the component by calling the Destroy method of the }
- { parent class. }
- inherited Destroy;
- end;
-
- procedure TDice.WMSize(var Message: TWMSize);
- begin
- inherited;
- {No resizing allowed}
- Width:=32;
- Height:=32;
- end;
-
- procedure TDice.Paint;
- var
- mybitmap:tbitmap;
- begin
- {Create drawing bitmap}
- mybitmap:=tbitmap.create;
- mybitmap.width:=32;
- mybitmap.height:=32;
- {Fill to backcolor}
- mybitmap.canvas.brush.color:=fbackcolor;
- mybitmap.canvas.pen.color:=fbackcolor;
- mybitmap.canvas.rectangle(0,0,width,height);
- {Draw Dice}
- mybitmap.canvas.pen.color:=clblack;
- mybitmap.canvas.brush.color:=fdicecolor;
- mybitmap.canvas.roundrect(0,0,width,height,6,6);
- mybitmap.canvas.brush.color:=clblack;
- {Draw dots}
- case fvalue of
- 1: mybitmap.canvas.ellipse(13,13,19,19);
- 2: begin
- mybitmap.canvas.ellipse(5,5,11,11);
- mybitmap.canvas.ellipse(21,21,27,27);
- end;
- 3: begin
- mybitmap.canvas.ellipse(13,13,19,19);
- mybitmap.canvas.ellipse(5,5,11,11);
- mybitmap.canvas.ellipse(21,21,27,27);
- end;
- 4: begin
- mybitmap.canvas.ellipse(5,5,11,11);
- mybitmap.canvas.ellipse(21,21,27,27);
- mybitmap.canvas.ellipse(5,21,11,27);
- mybitmap.canvas.ellipse(21,5,27,11);
- end;
- 5: begin
- mybitmap.canvas.ellipse(5,5,11,11);
- mybitmap.canvas.ellipse(21,21,27,27);
- mybitmap.canvas.ellipse(5,21,11,27);
- mybitmap.canvas.ellipse(21,5,27,11);
- mybitmap.canvas.ellipse(13,13,19,19);
- end;
- 6: begin
- mybitmap.canvas.ellipse(5,5,11,11);
- mybitmap.canvas.ellipse(21,21,27,27);
- mybitmap.canvas.ellipse(5,21,11,27);
- mybitmap.canvas.ellipse(21,5,27,11);
- mybitmap.canvas.ellipse(5,13,11,19);
- mybitmap.canvas.ellipse(21,13,27,19);
- end;
- end;
- {Copy bitmap to screen and destroy}
- canvas.copyrect(rect(0,0,32,32),mybitmap.canvas,rect(0,0,32,32));
- mybitmap.free;
- end;
-
- procedure TDice.Roll;
- begin
- {Seed random number before rolling}
- setvalue(random(6)+1);
- end;
-
-
-
- end.
-