Delphi Programming Unleashed/Delphi_Programming_Unleashed_SAMS_Publishing_1995.iso/chap28/object4/main.pas

Pascal/Delphi Source File | 1995-03-21 | 6.0 KB | 232 lines

unit Main;

{ Program copyright (c) 1995 by Charles Calvert }
{ Project Name: OBJECT4 }

{ This program is a simplified warehouse simulation.

  When you open the program there are a number of
  empty palettes sitting in a large room. If you
  click on one of the palettes, you can "stock" it
  with either yellow, blue, green or violet widgets.

  If you click on a palette that has widgets, you
  can see the number and type of widgets on that
  palette.

  If you click on the List menuitem, you get a list
  of all available items in the warehouse, shown
  in a graphics based format.

  If you click on the Sell menuitem, you can "sell"
  items from the warehouse, which means that stocked
  items will be deleted. If you sell an entire
  palettes worth of items, then that palette will
  be removed. }

interface

uses
  SysUtils, WinTypes, WinProcs,
  Messages, Classes, Graphics,
  Controls, Forms, Dialogs,
  StdCtrls, ClassDef, ExtCtrls,
  Menus, Buttons, SellDlgs;

type
  TMenagerie = class(TForm)
    PopupMenu1: TPopupMenu;
    Blue1: TMenuItem;
    Yellow1: TMenuItem;
    Timer1: TTimer;
    Green1: TMenuItem;
    Violet1: TMenuItem;
    MainMenu1: TMainMenu;
    Sell1: TMenuItem;
    List: TMenuItem;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    Panel6: TPanel;
    sp41: TSpeedButton;
    Sp42: TSpeedButton;
    Sp43: TSpeedButton;
    Sp44: TSpeedButton;
    Sp45: TSpeedButton;
    Sp46: TSpeedButton;
    Sp47: TSpeedButton;
    Sp48: TSpeedButton;
    Sp49: TSpeedButton;
    Sp410: TSpeedButton;
    SpeedButton12: TSpeedButton;
    SpeedButton13: TSpeedButton;
    SpeedButton14: TSpeedButton;
    SpeedButton15: TSpeedButton;
    SpeedButton16: TSpeedButton;
    SpeedButton17: TSpeedButton;
    SpeedButton18: TSpeedButton;
    SpeedButton19: TSpeedButton;
    SpeedButton20: TSpeedButton;
    SpeedButton21: TSpeedButton;
    SpeedButton22: TSpeedButton;
    SpeedButton23: TSpeedButton;
    SpeedButton24: TSpeedButton;
    SpeedButton25: TSpeedButton;
    SpeedButton31: TSpeedButton;
    SpeedButton33: TSpeedButton;
    SpeedButton34: TSpeedButton;
    SpeedButton35: TSpeedButton;
    Panel7: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton11: TSpeedButton;
    SpeedButton26: TSpeedButton;
    SpeedButton27: TSpeedButton;
    SpeedButton28: TSpeedButton;
    SpeedButton29: TSpeedButton;
    SpeedButton30: TSpeedButton;
    SpeedButton32: TSpeedButton;
    SpeedButton36: TSpeedButton;
    SpeedButton37: TSpeedButton;
    SpeedButton38: TSpeedButton;
    SpeedButton39: TSpeedButton;
    SpeedButton40: TSpeedButton;
    SpeedButton41: TSpeedButton;
    SpeedButton42: TSpeedButton;
    SpeedButton43: TSpeedButton;
    SpeedButton44: TSpeedButton;
    SpeedButton45: TSpeedButton;
    SpeedButton46: TSpeedButton;
    SpeedButton47: TSpeedButton;
    SpeedButton48: TSpeedButton;
    procedure Timer1Timer(Sender: TObject);
    procedure WidgetClick(Sender: TObject);
    procedure Sell1Click(Sender: TObject);
    procedure ListClick(Sender: TObject);
    procedure sp41Click(Sender: TObject);
  private
    { Private declarations }
    FCurSp: TSpeedButton;
    FWidget: TWidget;
    procedure SellProduct(var Widget: TWidget; var DataRec: TDataRec);
  end;

var
  Menagerie: TMenagerie;

implementation

{$R *.DFM}

uses
  Status;

procedure TMenagerie.sp41Click(Sender: TObject);
var
  P: TPoint;
begin
  FCurSp := TSpeedButton(Sender);
  P := Point(FCurSp.Left, FCurSp.Top);
  WinProcs.ClientToScreen(FCurSp.Parent.Handle, P);
  PopUpMenu1.Popup(P.X, P.Y);
end;

procedure TMenagerie.WidgetClick(Sender: TObject);
var
  WidgetType: Integer;
  Widget: TWidget;
begin
  WidgetType := (Sender as TMenuItem).Tag;
  case WidgetType of
    idBlue:  Widget := TBlue.Create(Self);
    idYellow:  Widget := TYellow.Create(Self);
    idGreen: Widget := TGreen.Create(Self);
    idViolet: Widget := TViolet.Create(Self);
  end;
  FCurSp.Enabled := False;
  FCurSp.Visible := False;
  Widget.Parent := FCurSp.Parent;
  Widget.Left := FCurSp.Left;
  Widget.Top := FCurSp.Top;
  Widget.Twin := FCurSp;
  Widget.Show;
end;

procedure TMenagerie.Timer1Timer;
var
  i: Integer;
  A: TWidget;
begin
  for i := 0 to ComponentCount - 1 do
    if Components[i] is TWidget then begin
       A := TWidget(Components[i]);
       if A.Quantity <= 0 then begin
         A.Twin.Enabled := True;
         A.Twin.Visible := True;
         A.Free;
         Exit;
       end;
    end;
end;

procedure TMenagerie.SellProduct(var Widget: TWidget; var DataRec: TDataRec);
var
  NewTotal: LongInt;
begin
  if Widget is TBlue then
    NewTotal := DataRec.BlueTotal
  else if Widget is TYellow then
    NewTotal := DataRec.YellowTotal
  else if Widget is TGreen then
    NewTotal := DataRec.GreenTotal
  else
    NewTotal := DataRec.VioletTotal;

  if NewTotal <= Widget.Quantity then begin
     Widget.Quantity := Widget.Quantity - NewTotal;
     NewTotal := 0;
  end else begin
     NewTotal := NewTotal - Widget.Quantity;
     Widget.Quantity := 0;
  end;

  if Widget is TBlue then
    DataRec.BlueTotal := NewTotal
  else if Widget is TYellow then
    DataRec.YellowTotal := NewTotal
  else if Widget is TGreen then
    DataRec.GreenTotal := NewTotal
  else
    DataRec.VioletTotal := NewTotal;
end;

procedure TMenagerie.Sell1Click(Sender: TObject);
var
  DataRec: TDataRec;
  i: Integer;
  Widget: TWidget;
begin
  if not SellDlg.GetData(DataRec) then exit;
  for i := 0 to ComponentCount - 1 do begin
    Widget := TWidget(Components[i]);
    if Components[i] is TWidget then
      SellProduct(Widget, DataRec);
  end;
end;

procedure TMenagerie.ListClick(Sender: TObject);
var
  i: Integer;
  List: TList;
begin
  List := TList.Create;
  for i := 0 to ComponentCount - 1 do
    if Components[i] is TWidget then
       List.Add(Components[i]);
  StatusForm.RunAll(List);
  List.Free;
end;

end.