Скачиваний:
72
Добавлен:
02.05.2014
Размер:
8 Кб
Скачать
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ActnList, Menus, ExtCtrls;

type
  TMainForm = class(TForm)
    ButtonLoadCard: TButton;
    MainMenu1: TMainMenu;
    ActionList1: TActionList;
    OpenDialog1: TOpenDialog;
    LabelNextAction: TLabel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Button0: TButton;
    ButtonBackSpace: TButton;
    ButtonEnter: TButton;
    mFile: TMenuItem;
    mCreateCard: TMenuItem;
    LabelStop: TLabel;
    LabelGo: TLabel;
    LabelTimer: TLabel;
    Timer1: TTimer;
    ButtonMove: TButton;
    ImageCar: TImage;
    TimerMove: TTimer;
    ShapeBlock: TShape;
    Shape2: TShape;
    ShapeSensor1: TShape;
    LabelMessage: TLabel;
    Bevel1: TBevel;
    procedure ButtonLoadCardClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button0Click(Sender: TObject);
    procedure ButtonBackSpaceClick(Sender: TObject);
    procedure ChangeKeybordEnabled(Flag: boolean);
    procedure FormCreate(Sender: TObject);
    procedure mCreateCardClick(Sender: TObject);
    procedure ButtonEnterClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure TimerMoveTimer(Sender: TObject);
    procedure ButtonMoveClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  procedure EnterNumber(Number:String);
var
  MainForm: TMainForm;

implementation

Uses Unit2,Unit3;

{$R *.dfm}
var
  glCard:TCard;
  glTryCount:integer;
  Proc:TProcessor;

procedure TMainForm.ChangeKeybordEnabled(Flag: boolean);
begin
  Button1.Enabled         := Flag;
  Button2.Enabled         := Flag;
  Button3.Enabled         := Flag;
  Button4.Enabled         := Flag;
  Button5.Enabled         := Flag;
  Button6.Enabled         := Flag;
  Button7.Enabled         := Flag;
  Button8.Enabled         := Flag;
  Button9.Enabled         := Flag;
  Button0.Enabled         := Flag;
  ButtonBackSpace.Enabled := Flag;
  ButtonEnter.Enabled     := Flag;
  if Flag then
  begin
    ButtonLoadCard.Caption  := 'Достать карту';
    LabelNextAction.Caption := 'Введите PIN код';
    LabelMessage.Caption := '';
  end
  else
  begin
    ButtonLoadCard.Caption  := 'Вставить карту';
    LabelNextAction.Caption := 'Вставьте карту';
    glCard.Free;
    LabelStop.Font.Color := clRed;
    LabelGo.Font.Color := clInactiveBorder;
    LabelTimer.Caption := '';
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  ChangeKeybordEnabled(False);
end;

procedure TMainForm.mCreateCardClick(Sender: TObject);
begin
  FormEditCard := TformEditCard.Create(Application);
  FormEditCard.ShowModal();
  FormEditCard.Free;
end;

procedure TMainForm.Timer1Timer(Sender: TObject);
var i:integer;
begin
  i := StrToInt(LabelTimer.Caption)-1;
  LabelTimer.Caption := IntToStr(i);
  if i=0 then
  begin
    ChangeKeybordEnabled(false);
    Timer1.Enabled := false;
    ImageCar.Top := 189;
  end;
    
end;

procedure TMainForm.TimerMoveTimer(Sender: TObject);
var iTop:integer;
begin
 iTop := ImageCar.Top;
 if iTop <-40 then
 begin
   TimerMove.Enabled := false;
   exit;
 end;
 if ShapeBlock.Visible then
   if iTop <(ShapeBlock.Top + ShapeBlock.Height*2) then
   begin
     TimerMove.Enabled := false;
     exit;
   end;
 if iTop=(ShapeSensor1.Top+ShapeSensor1.Height) then
   if LabelGo.Font.Color = clInactiveBorder then
   begin
     ShapeBlock.Visible := true;
     windows.Beep(1000,100);
   end;
 if iTop<(ShapeSensor1.Top+ShapeSensor1.Height) then
   if LabelGo.Font.Color <> clInactiveBorder then
     Timer1.Enabled := true;
 ImageCar.Top := iTop - 1;
end;

procedure EnterNumber(Number:String);
var Str:String;
begin
  Str := MainForm.LabelNextAction.Caption;
  if Length(Str) = 4 then
    exit;
  if (Str = 'Введите PIN код')
  or (Str = 'Неверный PIN!') then
    Str := '';
  MainForm.LabelNextAction.Caption := Str + Number;
end;

procedure TMainForm.Button0Click(Sender: TObject);
begin
  EnterNumber('0');
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
  EnterNumber('1');
end;

procedure TMainForm.Button2Click(Sender: TObject);
begin
  EnterNumber('2');
end;

procedure TMainForm.Button3Click(Sender: TObject);
begin
  EnterNumber('3');
end;

procedure TMainForm.Button4Click(Sender: TObject);
begin
  EnterNumber('4');
end;

procedure TMainForm.Button5Click(Sender: TObject);
begin
  EnterNumber('5');
end;

procedure TMainForm.Button6Click(Sender: TObject);
begin
  EnterNumber('6');
end;

procedure TMainForm.Button7Click(Sender: TObject);
begin
  EnterNumber('7');
end;

procedure TMainForm.Button8Click(Sender: TObject);
begin
  EnterNumber('8');
end;

procedure TMainForm.Button9Click(Sender: TObject);
begin
  EnterNumber('9');
end;

procedure TMainForm.ButtonBackSpaceClick(Sender: TObject);
var Str:String;
begin
  Str := LabelNextAction.Caption;
  if Str = 'Введите PIN код'then
    exit;
  Delete(Str,Length(Str),1);
  if Str = '' then
    Str := 'Введите PIN код';
  LabelNextAction.Caption := Str;
end;

procedure TMainForm.ButtonEnterClick(Sender: TObject);
var
  FileHandle:integer;
  Pbool:boolean;
  tf:TextFile;
begin
  if (LabelNextAction.Caption = 'Введите PIN код')
  or (LabelNextAction.Caption = 'Неверный PIN!') then
    exit;
  if NOT Proc.CheckPIN(StrToInt(LabelNextAction.Caption)) then
  begin
    LabelNextAction.Caption := 'Неверный PIN!';
    if Proc.BlockCard() then
      ChangeKeybordEnabled(False);
    exit;
  end;
  if NOT Proc.GetMoney() then
  begin
    LabelMessage.Caption := 'На карте недостаточно средств!';
    ChangeKeybordEnabled(False);
    exit;
  end;
  LabelStop.Font.Color := clInactiveBorder;
  LabelGo.Font.Color   := clGreen;
  LabelTimer.Caption := '15';
  ShapeBlock.Visible := false;
  //

  try
    AssignFile(tf,'C:\ProgramLog.txt');
    if FileExists('C:\ProgramLog.txt') = False then
       Rewrite(tf)
    else
     begin
       Append(tf);
     end;
    WriteLn(tf,TimeToStr(Time()));
  finally
    CloseFile(tf);
  end;
  
end;

procedure TMainForm.ButtonLoadCardClick(Sender: TObject);
var
  FileHandle:integer;
  fMessage:String;
begin
  if ButtonLoadCard.Caption = 'Достать карту' then
    begin
      ChangeKeybordEnabled(False);
      exit;
    end;
  if OpenDialog1.Execute then
  try
    FileHandle := FileOpen(OpenDialog1.FileName,fmOpenRead);
    Proc := TProcessor.Create;
    fMessage := Proc.LoadAndCheckCard(FileHandle,OpenDialog1.FileName);
    if fMessage ='OK' then
      ChangeKeybordEnabled(True)
    else
      LabelMessage.Caption := fMessage;
  finally
    FileClose(FileHandle);
  end;

end;

procedure TMainForm.ButtonMoveClick(Sender: TObject);
begin
  TimerMove.Enabled := true;
end;

end.
Соседние файлы в папке Программа
  • #
    02.05.20141 Кб70Project1.dproj.local
  • #
    02.05.2014483 б71Project1.identcache
  • #
    02.05.20143 Кб70Project1.res
  • #
    02.05.201414 Кб70Unit1.dcu
  • #
    02.05.201414 Кб70Unit1.dfm
  • #
    02.05.20148 Кб72Unit1.pas
  • #
    02.05.20143 Кб71Unit2.dcu
  • #
    02.05.20143 Кб72Unit2.pas
  • #
    02.05.20147 Кб71Unit3.dcu
  • #
    02.05.20142 Кб71Unit3.dfm
  • #
    02.05.20143 Кб71Unit3.pas