home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / AddOns / Books / 4 / EX07.ZIP / SHAPDEM2 / MAIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-10-26  |  2.3 KB  |  98 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   WinTypes, WinProcs, Classes, Graphics, Forms, Controls,
  7.   ColorDlg, StdCtrls, Menus, Dialogs, ExtCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Shape1: TShape;
  12.     ColorDialog1: TColorDialog;
  13.     ScrollBar1: TScrollBar;
  14.     ScrollBar2: TScrollBar;
  15.     MainMenu1: TMainMenu;
  16.     Shapes1: TMenuItem;
  17.     ShapeColor1: TMenuItem;
  18.     FormColor1: TMenuItem;
  19.     Shapes2: TMenuItem;
  20.     Rectangle1: TMenuItem;
  21.     Square1: TMenuItem;
  22.     RoundRect1: TMenuItem;
  23.     RoundSquare1: TMenuItem;
  24.     Ellipes1: TMenuItem;
  25.     Circle1: TMenuItem;
  26.     ExitItem: TMenuItem;
  27.     procedure NewShapeClick(Sender: TObject);
  28.     procedure ShapeColorClick(Sender: TObject);
  29.     procedure FormColorClick(Sender: TObject);
  30.     procedure ScrollBar2Change(Sender: TObject);
  31.     procedure ScrollBar1Change(Sender: TObject);
  32.     procedure FormResize(Sender: TObject);
  33.     procedure ExitItemClick(Sender: TObject);
  34.   private
  35.     { Private declarations }
  36.   public
  37.     { Public declarations }
  38.   end;
  39.  
  40. var
  41.   Form1: TForm1;
  42.  
  43. implementation
  44.  
  45. {$R *.DFM}
  46.  
  47. procedure TForm1.NewShapeClick(Sender: TObject);
  48. begin
  49.   Shape1.Shape := TShapeType((Sender as TMenuItem).Tag);
  50. end;
  51.  
  52. procedure TForm1.ShapeColorClick(Sender: TObject);
  53. begin
  54.   if ColorDialog1.Execute then
  55.     Shape1.Brush.Color := ColorDialog1.Color;
  56. end;
  57.  
  58. procedure TForm1.FormColorClick(Sender: TObject);
  59. begin
  60.   if ColorDialog1.Execute then
  61.     Form1.Color := ColorDialog1.Color;
  62. end;
  63.  
  64. procedure TForm1.ScrollBar2Change(Sender: TObject);
  65. begin
  66.   Shape1.Height := ScrollBar2.Position;
  67. end;
  68.  
  69. procedure TForm1.ScrollBar1Change(Sender: TObject);
  70. begin
  71.   Shape1.Width := ScrollBar1.Position;
  72. end;
  73.  
  74. procedure TForm1.FormResize(Sender: TObject);
  75. var
  76.   Menu,
  77.   Caption,
  78.   Frame: Integer;
  79. begin
  80.   Caption := GetSystemMetrics(sm_cyCaption);
  81.   Frame := GetSystemMetrics(sm_cxFrame) * 2;
  82.   Menu := GetSystemMetrics(sm_cyMenu);
  83.   Scrollbar1.Max := Width;
  84.   Scrollbar2.Max := Height;
  85.   Scrollbar2.Left := Width - Frame - Scrollbar2.Width;
  86.   Scrollbar1.Top := Height - ScrollBar2.Width - Frame - Caption - Menu;
  87.   Scrollbar1.Width := Width - Scrollbar2.Width - Frame;
  88.   Scrollbar2.Height := Height - Frame - Caption - Menu - Scrollbar1.Height;
  89. end;
  90.  
  91. procedure TForm1.ExitItemClick(Sender: TObject);
  92. begin
  93.   Close;
  94. end;
  95.  
  96. end.
  97.  
  98.