Лістинг програми.

unit Lab1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

Menus, ComCtrls, ToolWin, StdCtrls, ExtCtrls, ActnList, Buttons, ImgList;

type

TLab1form = class(TForm)

CoolBar1: TCoolBar;

ToolBar1: TToolBar;

ToolButton1: TToolButton;

ToolButton2: TToolButton;

Filemenu: TPopupMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

Helpmenu: TPopupMenu;

N6: TMenuItem;

ActionList1: TActionList;

Start: TAction;

Stop: TAction;

Exit: TAction;

About: TAction;

Clock: TTimer;

CPU: TPanel;

DLO: TPanel;

ObjCont: TPanel;

N5: TMenuItem;

N7: TMenuItem;

Setclock: TAction;

Legend: TAction;

N8: TMenuItem;

Panel4: TPanel;

Label1: TLabel;

Tick: TEdit;

UpDown1: TUpDown;

ToolBar2: TToolBar;

ToolButton3: TToolButton;

ToolButton4: TToolButton;

Images: TImageList;

Hotimages: TImageList;

Obj: TPanel;

Shape1: TShape;

Theory: TAction;

N9: TMenuItem;

Help: TMemo;

procedure ExitExecute(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure LegendExecute(Sender: TObject);

procedure AboutExecute(Sender: TObject);

procedure Draw (Channel: ShortInt; Colour: TColor);

procedure ClockTimer(Sender: TObject);

procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);

procedure SetclockExecute(Sender: TObject);

procedure StartExecute(Sender: TObject);

procedure StopExecute(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure FormShow(Sender: TObject);

procedure TheoryExecute(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

const

cn = 5;

var

Lab1form: TLab1form;

//////////////////////////////////////////////////////////

//Status variable

//---------------

//-1 - System is off

//0 - System is on (ready)

//1 - Turn the object on

//////////////////////////////////////////////////////////

Status: ShortInt;

implementation

{$R *.DFM}

procedure TLab1form.Draw (Channel: ShortInt; Colour: TColor);

//////////////////////////////////////////////////////////

//Channels:

//---------

//0 - DB

//1 - AB

//2 - CB

//3 - DC

//4 - CC

//5 - SC

//////////////////////////////////////////////////////////

begin

with Canvas do

begin

Pen.Color:=Colour;

Pen.Width:=2;

Pen.Style:=psSolid;

Brush.Color:=Colour;

Font.Color:=clWindow;

case Channel of

0: begin

MoveTo(250, 50);

LineTo(290, 50);

Polygon([Point(251,50), Point(254,47), Point(254, 53)]);

Polygon([Point(286,53), Point(286,47), Point(289, 50)]);

TextOut(262, 35, 'DB');

end;

1: begin

MoveTo(250, 100);

LineTo(290, 100);

//Polygon([Point(251,100), Point(254,97), Point(254, 103)]);

Polygon([Point(286,103), Point(286,97), Point(289, 100)]);

TextOut(262, 85, 'AB');

end;

2: begin

MoveTo(250, 150);

LineTo(290, 150);

Polygon([Point(251,150), Point(254,147), Point(254, 153)]);

Polygon([Point(285,153), Point(285,147), Point(289, 150)]);

TextOut(262, 135, 'CB');

end;

3: begin

MoveTo(390, 50);

LineTo(430, 50);

Polygon([Point(391,50), Point(394,47), Point(394, 53)]);

Polygon([Point(426,53), Point(426,47), Point(429, 50)]);

TextOut(402, 35, 'DC');

end;

4: begin

MoveTo(390, 100);

LineTo(430, 100);

//Polygon([Point(391,100), Point(394,97), Point(394, 103)]);

Polygon([Point(426,103), Point(426,97), Point(429, 100)]);

TextOut(402, 85, 'CC');

end;

5: begin

MoveTo(390, 150);

LineTo(430, 150);

Polygon([Point(391,150), Point(394,147), Point(394, 153)]);

//Polygon([Point(426,153), Point(426,147), Point(429, 150)]);

TextOut(402, 135, 'SC');

end;

end;

end;

end;

procedure TLab1form.ExitExecute(Sender: TObject);

begin

Application.Terminate();

end;

procedure TLab1form.FormCreate(Sender: TObject);

begin

Status:=-1;

with Help do

begin

Visible:=False;

ScrollBars:=ssNone;

Lines.LoadFromFile('Legend1.txt');

end;

end;

procedure TLab1form.LegendExecute(Sender: TObject);

begin

with Help do

begin

Visible:=True;

ScrollBars:=ssNone;

Lines.LoadFromFile('Legend1.txt');

end;

end;

procedure TLab1form.AboutExecute(Sender: TObject);

begin

with Help do

begin

Visible:=True;

ScrollBars:=ssNone;

Lines.LoadFromFile('About1.txt');

end;

end;

procedure TLab1form.ClockTimer(Sender: TObject);

var

i: Integer;

begin

case Status of

-1: begin

for i:=0 to cn do

Draw(i, clAppWorkSpace);

Obj.Color:=clAppWorkSpace;

end;

0: begin

for i:=0 to cn do

Draw(i, clAppWorkSpace);

Draw(5, clActiveCaption);

Obj.Color:=clAppWorkSpace;

Status:=1;

end;

1: begin

for i:=0 to cn-1 do

Draw(i, clAppWorkSpace);

Draw(2, clActiveCaption);

Draw(4, clActiveCaption);

Obj.Color:=clActiveCaption;

Status:=2;

end;

2: begin

for i:=0 to cn-1 do

Draw(i, clAppWorkSpace);

for i:=0 to cn-1 do

Draw(i, clActiveCaption);

Obj.Color:=clActiveCaption;

Status:=3;

end;

3: begin

for i:=0 to cn-1 do

Draw(i, clAppWorkSpace);

Draw(2, clActiveCaption);

Draw(4, clActiveCaption);

Obj.Color:=clAppWorkSpace;

Status:=4;

end;

4: begin

for i:=0 to cn do

Draw(i, clAppWorkSpace);

Obj.Color:=clAppWorkSpace;

Status:=0;

end;

end;

end;

procedure TLab1form.UpDown1Click(Sender: TObject; Button: TUDBtnType);

var

t: Integer;

Code: Integer;

begin

Val(Tick.Text, t, Code);

Clock.Interval:=t;

end;

procedure TLab1form.SetclockExecute(Sender: TObject);

begin

Help.Visible:=False;

end;

procedure TLab1form.StartExecute(Sender: TObject);

begin

Status:=0;

Setclock.Enabled:=False;

Tick.Enabled:=False;

Stop.Enabled:=True;

Clock.Enabled:=True;

Start.Enabled:=False;

end;

procedure TLab1form.StopExecute(Sender: TObject);

begin

Status:=-1;

Setclock.Enabled:=True;

Tick.Enabled:=True;

Start.Enabled:=True;

Stop.Enabled:=False;

end;

procedure TLab1form.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Status:=-1;

Setclock.Enabled:=True;

Tick.Enabled:=True;

Start.Enabled:=True;

Stop.Enabled:=False;

// Mainform.Show;

end;

procedure TLab1form.FormShow(Sender: TObject);

begin

Icon:=Application.Icon;

Application.Title:=Caption;

end;

procedure TLab1form.TheoryExecute(Sender: TObject);

begin

WinExec('explorer.exe d.doc' + #0, SW_SHOW);

end;

end.