Добавил:
rn Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
15
Добавлен:
26.05.2018
Размер:
5 Кб
Скачать
unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, OleAuto,
  Data.DB, Data.Win.ADODB, HTMLHelpViewer, Vcl.Buttons;

type
  TFStart = class(TForm)
    PHeader: TPanel;
    LRes: TListBox;
    LTest: TListBox;
    PFooter: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    ADOQTest: TADOQuery;
    RGAccess: TRadioGroup;
    BitBtn1: TBitBtn;
    BNew: TBitBtn;
    BDel: TBitBtn;
    BRes: TBitBtn;
    BitBtn2: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure LResClick(Sender: TObject);
    procedure LTestClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BResClick(Sender: TObject);
    procedure BNewClick(Sender: TObject);
    procedure BDelClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FStart: TFStart;

implementation

{$R *.dfm}

uses Variable, Main, Unit3, Unit4, Unit5;

procedure TFStart.BDelClick(Sender: TObject);
begin
with FResults.ADOQResult do
  begin
   SQL.Clear;
   SQL.Add('DELETE FROM Respondents WHERE ID='+IntToStr(LRes.ItemIndex + 1));
   ExecSQL;
   ShowMessage('Пользователь удален');
  end;
  LRes.DeleteSelected;
end;

procedure TFStart.BitBtn1Click(Sender: TObject);
begin  // смена пользователя
if (RGAccess.ItemIndex = 1) then
  begin
    FAuth.ShowModal;
  end;
if (RGAccess.ItemIndex = 0) then
  begin
    BNew.Visible := FALSE;
    BDel.Visible := FALSE;
    BRes.Visible := FALSE;
  end;
end;

procedure TFStart.BNewClick(Sender: TObject);
begin
FAddUser.ShowModal;
if FIONew<>'' then LRes.Items.Add(FioNew);

end;

procedure TFStart.BResClick(Sender: TObject);
begin
FResults.ShowModal;
end;

procedure TFStart.Button1Click(Sender: TObject);
begin
UserFIO := LRes.Items[LRes.ItemIndex];
UserId := GetUserId(UserFIO);
if LTest.ItemIndex = 0 then
  begin
    TestId := 1;
    FMain.BBTest.Visible:=true;
    FMain.BBRes.Visible:=false;
    FMain.ShowModal;
  end;
if LTest.ItemIndex = 1 then
  begin
    TestId := 2;
    FMain.BBTest.Visible:=true;
    FMain.BBRes.Visible:=false;
    FMain.ShowModal;
  end;
end;

procedure TFStart.FormCreate(Sender: TObject);
begin
  SetBounds( Left - ClientOrigin.X, Top - ClientOrigin.Y, GetDeviceCaps(
  Canvas.handle, HORZRES ) + (Width - ClientWidth), GetDeviceCaps( Canvas.handle,VERTRES )
  + (Height - ClientHeight ));
  LRes.Height := FStart.Height - PHeader.Height - 40 - PFooter.Height - 40;
  LRes.Left :=  FStart.Width div 7;
  LRes.Width := FStart.Width div 3;
  LTest.Left :=  LRes.Left + LRes.Width + 100;
  LTest.Width := LRes.Width;
  LTest.Height := LRes.Height;
  LRes.Top := PHeader.Height + 50;
  LTest.Top := LRes.Top;
  Label1.Left := LRes.Left + LRes.Width div 2 - Label1.Width div 2;
  Label2.Left := LTest.Left + LTest.Width div 2 - Label2.Width div 2;
  Label1.Top := PHeader.Height + 20;
  Label2.Top := PHeader.Height + 20;
  Button1.Left := PFooter.Width div 2 - Button1.Width div 2;
  BNew.Left := LRes.Left - BNew.Width - 10;
  BDel.Left := BNew.Left;
  BRes.Left := BNew.Left;
  BNew.Top := LRes.Height div 3 + LRes.Top;
  BDel.Top := BNew.Top + BNew.Height + 20;
  BRes.Top := BDel.Top + BDel.Height + 20;
  // считать путь запуска программы
  S := ExtractFilePath(Application.ExeName);
  // присвоить переменной Variant значение приложения Access
  a := CreateOleObject('Access.Application');
  // определить номер версии Access
  SV := a.Version;
  // сформировать строку подключения базы данных
  SDB := 'Provider=Microsoft.ACE.OLEDB.'+SV+';Data Source=' + S + '\Base\PDT.accdb;Persist Security Info=False';
  ADOQTest.ConnectionString := SDB;
  SH := S + '\materials\Help\Help.chm';
  HelpFile := SH;
end;

procedure TFStart.FormShow(Sender: TObject);
var
  i, Max :integer;
begin
with ADOQTest do
  begin
    for i := 1 to 2 do
      begin
        SQL.Clear;
        SQL.Add('SELECT * FROM Test WHERE ID_Test = '+IntToSTr(i));
        Active := TRUE;
        LTest.Items.Add(FieldByName('NameTest').AsString);
      end;
    SQL.Clear;
    SQL.Add('SELECT COUNT(*) AS "Max" FROM Respondents');
    Active := TRUE;
    Max := FieldByName('"Max"').AsInteger;
    for i := 1 to Max do
      begin
        SQL.Clear;
        SQL.Add('SELECT * FROM Respondents WHERE ID = '+IntToSTr(i));
        Active := TRUE;
        LRes.Items.Add(FieldByName('FIO').AsString);
      end;

  end;
end;

procedure TFStart.LResClick(Sender: TObject);
begin
if (LRes.ItemIndex<>(-1))AND(LTest.ItemIndex<>(-1)) then Button1.Enabled := TRUE;
if(LRes.ItemIndex <> -1)then
  begin
    BDel.Enabled := TRUE;
    BRes.Enabled := TRUE;
  end;
end;

procedure TFStart.LTestClick(Sender: TObject);
begin
if (LRes.ItemIndex<>(-1))AND(LTest.ItemIndex<>(-1)) then Button1.Enabled := TRUE;
end;

end.
Соседние файлы в папке Курсовая ( Мюнсберга и Когана )
  • #
    26.05.20182 Кб15Test.res
  • #
    26.05.2018172 б15Test.stat
  • #
    26.05.201814 Кб15Test.~dsk
  • #
    26.05.201814 Кб15Unit2.dcu
  • #
    26.05.20187 Кб15Unit2.dfm
  • #
    26.05.20185 Кб15Unit2.pas
  • #
    26.05.20187 Кб15Unit3.dcu
  • #
    26.05.2018949 б15Unit3.dfm
  • #
    26.05.2018962 б15Unit3.pas
  • #
    26.05.20189 Кб15Unit4.dcu
  • #
    26.05.20182 Кб15Unit4.dfm