home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Runimage / Delphi50 / Help / Examples / Menu / MENUDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  6.1 KB  |  255 lines
  1. unit menudemo;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Menus, ExtCtrls, ComCtrls;
  8.  
  9. type
  10.   TMenuForm = class(TForm)
  11.     DisplayPanel: TPanel;
  12.     DemoShape: TShape;
  13.     MainMenu: TMainMenu;
  14.     Application1: TMenuItem;
  15.     Exit1: TMenuItem;
  16.     Color1: TMenuItem;
  17.     Outline1: TMenuItem;
  18.     Randomize1: TMenuItem;
  19.     Select1: TMenuItem;
  20.     Inside1: TMenuItem;
  21.     Randomize2: TMenuItem;
  22.     Select2: TMenuItem;
  23.     Shape1: TMenuItem;
  24.     Circle1: TMenuItem;
  25.     Ellipse1: TMenuItem;
  26.     Rectangle1: TMenuItem;
  27.     Square1: TMenuItem;
  28.     Misc1: TMenuItem;
  29.     ThickOutline1: TMenuItem;
  30.     RoundedShape1: TMenuItem;
  31.     Help1: TMenuItem;
  32.     About1: TMenuItem;
  33.     SolidColorDialog: TColorDialog;
  34.     AnyColorDialog: TColorDialog;
  35.     PopupMenu: TPopupMenu;
  36.     Random1: TMenuItem;
  37.     RandomizeColors1: TMenuItem;
  38.     InvertColors1: TMenuItem;
  39.     procedure DisplayPanelResize(Sender: TObject);
  40.     procedure Exit1Click(Sender: TObject);
  41.     procedure Randomize1Click(Sender: TObject);
  42.     procedure Select1Click(Sender: TObject);
  43.     procedure Randomize2Click(Sender: TObject);
  44.     procedure Select2Click(Sender: TObject);
  45.     procedure Circle1Click(Sender: TObject);
  46.     procedure Ellipse1Click(Sender: TObject);
  47.     procedure Rectangle1Click(Sender: TObject);
  48.     procedure Square1Click(Sender: TObject);
  49.     procedure ThickOutline1Click(Sender: TObject);
  50.     procedure RoundedShape1Click(Sender: TObject);
  51.     procedure About1Click(Sender: TObject);
  52.     procedure Random1Click(Sender: TObject);
  53.     procedure RandomizeColors1Click(Sender: TObject);
  54.     procedure InvertColors1Click(Sender: TObject);
  55.   private
  56.     { Private declarations }
  57.     Roundable: Boolean;
  58.  
  59.     function RandomColor: TColor;
  60.     procedure AlterShape(shape: TShapeType; roundable: Boolean);
  61.   public
  62.     { Public declarations }
  63.   end;
  64.  
  65. const
  66.   SHAPE_OFFSET = 4;
  67.  
  68. var
  69.   MenuForm: TMenuForm;
  70.  
  71. implementation
  72.  
  73. uses about;
  74.  
  75. {$R *.DFM}
  76.  
  77.  
  78. procedure TMenuForm.DisplayPanelResize(Sender: TObject);
  79. begin
  80.   DemoShape.Top := SHAPE_OFFSET;
  81.   DemoShape.Left := DemoShape.Top;
  82.   DemoShape.Height := DisplayPanel.Height - 2 * SHAPE_OFFSET;
  83.   DemoShape.Width := DisplayPanel.Width - 2 * SHAPE_OFFSET;
  84. end;
  85.  
  86. procedure TMenuForm.Exit1Click(Sender: TObject);
  87. begin
  88.   Close;
  89. end;
  90.  
  91. function TMenuForm.RandomColor;
  92. var
  93.   red, green, blue: Byte;
  94. begin
  95.   red := Random(255);
  96.   green := Random(255);
  97.   blue := Random(255);
  98.  
  99.   Result := red or (green shl 8) or (blue shl 16);
  100. end;
  101.  
  102. procedure TMenuForm.Randomize1Click(Sender: TObject);
  103. begin
  104.   DemoShape.Pen.Color := RandomColor;
  105. end;
  106.  
  107. procedure TMenuForm.Select1Click(Sender: TObject);
  108. begin
  109.   try
  110.     SolidColorDialog.Color := DemoShape.Pen.Color;
  111.     if SolidColorDialog.Execute then
  112.       DemoShape.Pen.Color := SolidColorDialog.Color;
  113.   except
  114.     ShowMessage('Color selection dialog failed to load');
  115.   end;
  116. end;
  117.  
  118. procedure TMenuForm.Randomize2Click(Sender: TObject);
  119. begin
  120.   DemoShape.Brush.Color := RandomColor;
  121. end;
  122.  
  123. procedure TMenuForm.Select2Click(Sender: TObject);
  124. begin
  125.   AnyColorDialog.Color := DemoShape.Brush.Color;
  126.   try
  127.     if AnyColorDialog.Execute then
  128.       DemoShape.Brush.Color := AnyColorDialog.Color;
  129.   except
  130.     ShowMessage('Color selection dialog failed to load.');
  131.   end;
  132. end;
  133.  
  134. procedure ToggleCheck(Sender: TObject);
  135. var
  136.   Item: TMenuItem;
  137. begin
  138.   Item := Sender as TMenuItem;
  139.   Item.Checked := not Item.Checked;
  140. end;
  141.  
  142. procedure SetCheck(Sender: TObject);
  143. var
  144.   Item: TMenuItem;
  145. begin
  146.   Item := Sender as TMenuItem;
  147.   Item.Checked := True;
  148. end;
  149.  
  150. procedure TMenuForm.AlterShape(shape: TShapeType; roundable: Boolean);
  151. begin
  152.   Self.Roundable := roundable;
  153.   DemoShape.Shape := shape;
  154. end;
  155.  
  156. procedure TMenuForm.Circle1Click(Sender: TObject);
  157. begin
  158.   SetCheck(Sender);
  159.   AlterShape(stCircle, False);
  160. end;
  161.  
  162. procedure TMenuForm.Ellipse1Click(Sender: TObject);
  163. begin
  164.   SetCheck(Sender);
  165.   AlterShape(stEllipse, False);
  166. end;
  167.  
  168. procedure TMenuForm.Rectangle1Click(Sender: TObject);
  169. begin
  170.   SetCheck(Sender);
  171.   if RoundedShape1.Checked then
  172.     AlterShape(stRoundRect, True)
  173.   else
  174.     AlterShape(stRectangle, True);
  175. end;
  176.  
  177. procedure TMenuForm.Square1Click(Sender: TObject);
  178. begin
  179.   SetCheck(Sender);
  180.   if RoundedShape1.Checked then
  181.     AlterShape(stRoundSquare, True)
  182.   else
  183.     AlterShape(stSquare, True);
  184. end;
  185.  
  186. procedure TMenuForm.ThickOutline1Click(Sender: TObject);
  187. begin
  188.   ToggleCheck(Sender);
  189.   DemoShape.Pen.Width := 11 - DemoShape.Pen.Width;
  190. end;
  191.  
  192. procedure TMenuForm.RoundedShape1Click(Sender: TObject);
  193. begin
  194.   ToggleCheck(Sender);
  195.   case DemoShape.Shape of
  196.     stRectangle:   DemoShape.Shape := stRoundRect;
  197.     stRoundRect:   DemoShape.Shape := stRectangle;
  198.     stSquare:      DemoShape.Shape := stRoundSquare;
  199.     stRoundSquare: DemoShape.Shape := stSquare;
  200.   end;
  201. end;
  202.  
  203. procedure TMenuForm.About1Click(Sender: TObject);
  204. var
  205.   AboutBox: TAboutBox;
  206. begin
  207.   AboutBox := TAboutBox.Create(Self);
  208.   try
  209.     AboutBox.ShowModal;
  210.   finally
  211.     AboutBox.Free;
  212.   end;
  213. end;
  214.  
  215. procedure TMenuForm.Random1Click(Sender: TObject);
  216. var
  217.   newshape: TShapeType;
  218. begin
  219.   // Ensure we actually change the shape.
  220.   repeat newshape := TShapeType(Random(6)) until
  221.     newshape <> DemoShape.Shape;
  222.  
  223.   // Adjust the "Shape" and Rounded Shape" menu selections.
  224.   case newshape of
  225.     stEllipse: Ellipse1Click(Ellipse1);
  226.     stCircle: Circle1Click(Circle1);
  227.     stRectangle, stRoundRect:
  228.       begin
  229.         RoundedShape1.Checked := newshape = stRoundRect;
  230.         Rectangle1Click(Rectangle1);
  231.       end;
  232.     stSquare, stRoundSquare:
  233.       begin
  234.         RoundedShape1.Checked := newshape = stRoundSquare;
  235.         Square1Click(Square1);
  236.       end;
  237.     end;
  238. end;
  239.  
  240. procedure TMenuForm.RandomizeColors1Click(Sender: TObject);
  241. begin
  242.   DemoShape.Brush.Color := RandomColor;
  243.   DemoShape.Pen.Color := RandomColor;
  244. end;
  245.  
  246. procedure TMenuForm.InvertColors1Click(Sender: TObject);
  247. var
  248.   i : Integer;
  249. begin
  250.   i := Integer(DemoShape.Brush.Color) xor $FFFFFF;
  251.   DemoShape.Brush.Color := TColor(i);
  252. end;
  253.  
  254. end.
  255.