unit Unit4;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, DBCtrls,db, jpeg, ExtCtrls;

type
  TForm4 = class(TForm)
    SpeedButton20: TSpeedButton;
    DBMemo1: TDBMemo;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    Label1: TLabel;
    DBText2: TDBText;
    DBText3: TDBText;
    DBText4: TDBText;
    DBText5: TDBText;
    DBText6: TDBText;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Image1: TImage;
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure DBText2Click(Sender: TObject);
    procedure DBText3Click(Sender: TObject);
    procedure DBText4Click(Sender: TObject);
    procedure DBText5Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton20Click(Sender: TObject);
    procedure DBText6Click(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

function BitmapToRgn(Image: TBitmap): HRGN;

var
  Form4: TForm4;
  i,c,v:integer;
  d: array[1..400] of string;
  sPath:String[60];
  MaskBmp: TBitmap;
  begin_ques:integer;
  start_qest:integer;
 implementation

uses Unit2, Unit5, Unit3, Unit7, Unit8, Unit9;

{$R *.dfm}

procedure TForm4.SpeedButton1Click(Sender: TObject);
begin
  if i>start_qest then
    begin
      i:=i-1;
      label1.Caption:=inttostr(i-start_qest+1)+' из 20';
      datamodule5.ADOTable1.Prior;
    end;
end;

procedure TForm4.SpeedButton2Click(Sender: TObject);
  begin
    if i<start_qest+19 then
    begin
      i:=i+1;
      datamodule5.ADOTable1.Next;
      label1.Caption:=inttostr(i-start_qest+1)+' из 20';
    end;
  end;

// A
procedure TForm4.DBText2Click(Sender: TObject);
begin
  v:=0;
  if i < start_qest+20 then
    begin
      if d[i]<>'' then
        begin
          if (form4.Tag =4) or (form4.Tag=5) then
            v:=application.messagebox('Сіздер жауап бердіѕіздер мынауды сўраќ, ауыстыруды ќалаѕыздар','Ескерту',MB_YESNO)
          else
            v:=application.messagebox('Вы уже ответили на этот вопрос, хотите заменить','Предупреждение',MB_YESNO);
          if v=7 then exit
        end
      else
        begin
          d[i]:='a';
          i:=i+1;
          label1.Caption:=inttostr(i-start_qest)+' из 20';
          datamodule5.ADOTable1.Next;
        end;
    end
    else
      if i = start_qest+20 then
      begin
      if d[i]<>'' then
        begin
          if (form4.Tag =4) or (form4.Tag=5) then
            v:=application.messagebox('Сіздер жауап бердіѕіздер мынауды сўраќ, ауыстыруды ќалаѕыздар','Ескерту',MB_YESNO)
          else
            v:=application.messagebox('Вы уже ответили на этот вопрос, хотите заменить','Предупреждение',MB_YESNO);
          if v=7 then exit
        end
      else
        begin
          d[i]:='a';
          label1.Caption:=inttostr(i-start_qest)+' из 20';
        end;
    end
end;

//b
procedure TForm4.DBText3Click(Sender: TObject);
begin
  v:=0;
  if i < start_qest+20 then
    begin
      if d[i]<>'' then
        begin
          if (form4.Tag =4) or (form4.Tag=5) then
            v:=application.messagebox('Сіздер жауап бердіѕіздер мынауды сўраќ, ауыстыруды ќалаѕыздар','Ескерту',MB_YESNO)
          else
            v:=application.messagebox('Вы уже ответили на этот вопрос, хотите заменить','Предупреждение',MB_YESNO);
          if v=7 then exit
        end
      else
        begin
          d[i]:='b';
          i:=i+1;
          label1.Caption:=inttostr(i-start_qest)+' из 20';
          datamodule5.ADOTable1.Next;
        end;
    end
    else
      if i = start_qest+20 then
      begin
      if d[i]<>'' then
        begin
          if (form4.Tag =4) or (form4.Tag=5) then
            v:=application.messagebox('Сіздер жауап бердіѕіздер мынауды сўраќ, ауыстыруды ќалаѕыздар','Ескерту',MB_YESNO)
          else
            v:=application.messagebox('Вы уже ответили на этот вопрос, хотите заменить','Предупреждение',MB_YESNO);
          if v=7 then exit
        end
      else
        begin
          d[i]:='b';
          label1.Caption:=inttostr(i-start_qest)+' из 20';
        end;
    end
end;


//c
procedure TForm4.DBText4Click(Sender: TObject);
begin
  v:=0;
  if i < start_qest+20 then
    begin
      if d[i]<>'' then
        begin
          if (form4.Tag =4) or (form4.Tag=5) then
            v:=application.messagebox('Сіздер жауап бердіѕіздер мынауды сўраќ, ауыстыруды ќалаѕыздар','Ескерту',MB_YESNO)
          else
            v:=application.messagebox('Вы уже ответили на этот вопрос, хотите заменить','Предупреждение',MB_YESNO);
          if v=7 then exit
        end
      else
        begin
          d[i]:='c';
          i:=i+1;
          label1.Caption:=inttostr(i-start_qest)+' из 20';
          datamodule5.ADOTable1.Next;
        end;
    end
    else
      if i = start_qest+20 then
      begin
      if d[i]<>'' then
        begin
          if (form4.Tag =4) or (form4.Tag=5) then
            v:=application.messagebox('Сіздер жауап бердіѕіздер мынауды сўраќ, ауыстыруды ќалаѕыздар','Ескерту',MB_YESNO)
          else
            v:=application.messagebox('Вы уже ответили на этот вопрос, хотите заменить','Предупреждение',MB_YESNO);
          if v=7 then exit
        end
      else
        begin
          d[i]:='c';
          label1.Caption:=inttostr(i-start_qest)+' из 20';
        end;
    end
end;


//d
procedure TForm4.DBText5Click(Sender: TObject);
begin
  v:=0;
  if i < start_qest+20 then
    begin
      if d[i]<>'' then
        begin
          if (form4.Tag =4) or (form4.Tag=5) then
            v:=application.messagebox('Сіздер жауап бердіѕіздер мынауды сўраќ, ауыстыруды ќалаѕыздар','Ескерту',MB_YESNO)
          else
            v:=application.messagebox('Вы уже ответили на этот вопрос, хотите заменить','Предупреждение',MB_YESNO);
          if v=7 then exit
        end
      else
        begin
          d[i]:='d';
          i:=i+1;
          label1.Caption:=inttostr(i-start_qest)+' из 20';
          datamodule5.ADOTable1.Next;
        end;
    end
    else
      if i = start_qest+20 then
      begin
      if d[i]<>'' then
        begin
          if (form4.Tag =4) or (form4.Tag=5) then
            v:=application.messagebox('Сіздер жауап бердіѕіздер мынауды сўраќ, ауыстыруды ќалаѕыздар','Ескерту',MB_YESNO)
          else
            v:=application.messagebox('Вы уже ответили на этот вопрос, хотите заменить','Предупреждение',MB_YESNO);
          if v=7 then exit
        end
      else
        begin
          d[i]:='d';
          label1.Caption:=inttostr(i-start_qest)+' из 20';
        end;
    end
end;


procedure TForm4.FormCreate(Sender: TObject);
var   MyJPG: TJPEGImage;
begin

  GetDir(0,sPath);
  MaskBmp := TBitmap.Create;
  MyJPG := TJPEGImage.Create;
  MyJPG.LoadFromStream(TResourceStream.CreateFromID(HInstance, 3, RT_RCDATA));
  image1.Picture.Assign(MyJPG);
  try
   MaskBmp.LoadFromResourceName(HInstance, 'DW2');
    Height := MaskBmp.Height;
    Width := MaskBmp.Width;
    SetWindowRgn(Self.Handle, BitmapToRgn(MaskBmp), True);
  finally
    MaskBmp.Free;
  end;
end;

//test out
procedure TForm4.SpeedButton20Click(Sender: TObject);
var ball:integer;
    neotv,ocenka,neprav:string;
    neot:boolean;
begin
//  datamodule5.ADOTable1.First;
  ball:=0;
  neot:=false;
  for c:=start_qest to start_qest+20 do
    if d[c]='' then
      begin
//        datamodule5.ADOTable1.Locate('num',i,[ loCaseInsensitive	,loPartialKey]);
        neot:=true;
      end;

if neot then
  begin
    if (form4.Tag =4) or (form4.Tag=5) then
      c:=application.messagebox('Сіздер жауап бермедіѕіздер бірнеше сўраќтыѕ , жалєастыру','Ескерту',MB_YESNO)
    else
      c:=application.messagebox('Вы не ответили на несколько вопросов, продолжить','Предупреждение',MB_YESNO)
  end;
//datamodule5.ADOTable1.First;
//тут поправить
datamodule5.ADOTable1.Locate('num',start_qest,[ loCaseInsensitive	,loPartialKey]);
if c=7 then exit else
    for c:=start_qest to start_qest+20 do
      begin
        if datamodule5.DataSource1.DataSet.fieldbyname('otvet').AsString=d[c] then
          ball:=ball+1
        else
          if d[c]<>'' then
            neprav:=neprav+', '+inttostr(c-start_qest+1);
        if d[c]='' then
          begin
            neotv:=neotv+', '+inttostr(c-start_qest+1);
            neot:=true;
          end;
        datamodule5.ADOTable1.Next;
      end;
    case ball of
    1..7:ocenka:='2';
    8..12:ocenka:='3';
    13..17:ocenka:='4';
    18..20:ocenka:='5';
    end;
    if neot then begin
      if (form4.Tag =4) or (form4.Tag=5) then
        begin
          form7.memo1.Clear;
          form7.memo1.Lines.Add('Студент - '+ datamodule5.DataSource2.DataSet.fieldbyname('user').AsString);
          form7.Memo1.Lines.Add('Тестілеуде сіз  - '+inttostr(ball)+' балл алдыѕыз');
{          form7.Memo1.Lines.Add('Баєалауды алды - '+ocenka);}
          form7.Memo1.Lines.Add('Келесі сўраќтарєа сенімсіз жауап берді '+neprav);
          form7.Memo1.Lines.Add('Келесі сўраќтарєа жауап бермеді '+neotv);
          form7.Caption:='Тесті жиынылары';
          form7.Visible :=true;
        end
      else
        begin
          form7.memo1.Clear;
          form7.memo1.Lines.Add('Студент - '+ datamodule5.DataSource2.DataSet.fieldbyname('user').AsString);
          form7.Memo1.Lines.Add('В тестировании набрали - '+inttostr(ball)+' баллов');
 {         form7.Memo1.Lines.Add('Получили оценку - '+ocenka);}
          form7.Memo1.Lines.Add('Неправильно ответили на следующие вопросы '+neprav);
          form7.Memo1.Lines.Add('Не ответили на следующие вопросы '+neotv);
          form7.Caption:='Итоги теста';
          form7.Visible :=true;
        end;
      for c:=1 to 400 do
      d[c]:='';
      i:=1;
      datamodule5.ADOTable1.First;
      end
    else begin
      if (form4.Tag =4) or (form4.Tag=5) then
        begin
          form7.memo1.Clear;
          form7.memo1.Lines.Add('Студент - '+ datamodule5.DataSource2.DataSet.fieldbyname('user').AsString);
          form7.Memo1.Lines.Add('Тестілеуде теріп алды - '+inttostr(ball)+' балдардыѕ');
{          form7.Memo1.Lines.Add('Баєалауды алды - '+ocenka);}
          form7.Memo1.Lines.Add('Келесі сўраќтарєа сенімсіз жауап берді '+neprav);
          form7.Caption:='Тесті жиынылары';
          form7.Visible :=true;
        end
      else
        begin
          form7.memo1.Clear;
          form7.memo1.Lines.Add('Студент - '+ datamodule5.DataSource2.DataSet.fieldbyname('user').AsString);
          form7.Memo1.Lines.Add('В тестировании набрали - '+inttostr(ball)+' баллов');
{          form7.Memo1.Lines.Add('Получили оценку - '+ocenka); }
          form7.Memo1.Lines.Add('Неправильно ответили на следующие вопросы '+neprav);
          form7.Caption:='Итоги теста';
          form7.Visible :=true;
        end;
      for c:=1 to 400 do
      d[c]:='';
      i:=1;
      datamodule5.ADOTable1.First;
      end;
end;

//e
procedure TForm4.DBText6Click(Sender: TObject);
begin
  v:=0;
  if i < start_qest+20 then
    begin
      if d[i]<>'' then
        begin
          if (form4.Tag =4) or (form4.Tag=5) then
            v:=application.messagebox('Сіздер жауап бердіѕіздер мынауды сўраќ, ауыстыруды ќалаѕыздар','Ескерту',MB_YESNO)
          else
            v:=application.messagebox('Вы уже ответили на этот вопрос, хотите заменить','Предупреждение',MB_YESNO);
          if v=7 then exit
        end
      else
        begin
          d[i]:='e';
          i:=i+1;
          label1.Caption:=inttostr(i-start_qest)+' из 20';
          datamodule5.ADOTable1.Next;
        end;
    end
    else
      if i = start_qest+20 then
      begin
      if d[i]<>'' then
        begin
          if (form4.Tag =4) or (form4.Tag=5) then
            v:=application.messagebox('Сіздер жауап бердіѕіздер мынауды сўраќ, ауыстыруды ќалаѕыздар','Ескерту',MB_YESNO)
          else
            v:=application.messagebox('Вы уже ответили на этот вопрос, хотите заменить','Предупреждение',MB_YESNO);
          if v=7 then exit
        end
      else
        begin
          d[i]:='e';
          label1.Caption:=inttostr(i-start_qest)+' из 20';
        end;
    end
end;

procedure TForm4.FormHide(Sender: TObject);
begin
      for c:=1 to 400 do
      d[c]:='';
      i:=1;
      datamodule5.ADOTable1.First;
if tag=2 then form2.Visible :=true;
if tag=3 then form3.visible:=true;
if tag=4 then form8.Visible :=true;
if tag=5 then form9.visible:=true;
end;

function BitmapToRgn(Image: TBitmap): HRGN;
var
  TmpRgn: HRGN;
  x, y: integer;
  ConsecutivePixels: integer;
  CurrentPixel: TColor;
  CreatedRgns: integer;
  CurrentColor: TColor;
begin
  CreatedRgns := 0;
  Result := CreateRectRgn(0, 0, maskbmp.Width, maskbmp.Height);
  inc(CreatedRgns);

  if (maskbmp.Width = 0) or (maskbmp.Height = 0) then
    exit;

  for y := 0 to maskbmp.Height - 1 do
  begin
    CurrentColor := maskbmp.Canvas.Pixels[0,y];
    ConsecutivePixels := 1;
    for x := 0 to maskbmp.Width - 1 do
    begin
      CurrentPixel := maskbmp.Canvas.Pixels[x, y];

      if CurrentColor = CurrentPixel then
        inc(ConsecutivePixels)
      else
      begin
        if CurrentColor = clWhite then
        begin
          TmpRgn := CreateRectRgn(x - ConsecutivePixels, y, x, y + 1);
          CombineRgn(Result, Result, TmpRgn, RGN_DIFF);
          inc(CreatedRgns);
          DeleteObject(TmpRgn);
        end;
        CurrentColor := CurrentPixel;
        ConsecutivePixels := 1;
      end;
    end;

    if (CurrentColor = clWhite) and (ConsecutivePixels > 0) then
    begin
      TmpRgn := CreateRectRgn(x-ConsecutivePixels, y, x, y+1);
      CombineRgn(Result, Result, TmpRgn, RGN_DIFF);
      inc(CreatedRgns);
      DeleteObject(TmpRgn);
    end;
  end;
end;

procedure TForm4.FormShow(Sender: TObject);
begin
  Randomize;
  start_qest := 1+Random(379);
  i:=start_qest;
  datamodule5.ADOTable1.Locate('num',start_qest,[]);
  label1.Caption:='1 из 20';
end;

end.





