Vanilla_Fury

laba_4_1_del_v7

Feb 28th, 2021
258
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 32.79 KB | None | 0 0
  1. unit laba_4_1_f1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.StdCtrls, Vcl.Grids, System.RegularExpressions,
  8.   Vcl.ExtCtrls, Vcl.Imaging.pngimage, Data.DB, Vcl.DBGrids, Vcl.ComCtrls;
  9.  
  10. type
  11.     TArrStr = Array of String;
  12.     TArrInt = Array of Integer;
  13.  
  14.     TPersonAndHisResults = Record
  15.         FGroupNumber: String[9];
  16.         FSurname: String[16];
  17.         FGradeMath, FGradePhys, FGradeProgr, FGradeEngGraph: Byte;
  18.     End;
  19.  
  20.     TArrPeopleAndResults = Array of TPersonAndHisResults;
  21.     TBuckets = Array of TArrPeopleAndResults;
  22.  
  23.     TFormMain = class(TForm)
  24.     MainMenu1: TMainMenu;
  25.     N1: TMenuItem;
  26.     N3: TMenuItem;
  27.     OpenDialog1: TOpenDialog;
  28.     N4: TMenuItem;
  29.     N7: TMenuItem;
  30.     N6: TMenuItem;
  31.     LabelTask: TLabel;
  32.     ButtonDelete: TButton;
  33.     N2: TMenuItem;
  34.     StringGrid1: TStringGrid;
  35.     PanelRight: TPanel;
  36.     PanelDown: TPanel;
  37.     LabelInfoAboutPerson: TLabel;
  38.     LabelInformation: TLabel;
  39.     LabelToMeasureScreenOfUser: TLabel;
  40.     CheckReadOnly: TCheckBox;
  41.     ComboBoxSortBy: TComboBox;
  42.     ButtonSortBy: TButton;
  43.     ButtonFilterBy: TButton;
  44.     ComboBoxFilterWhat: TComboBox;
  45.     ComboBoxFilterHow: TComboBox;
  46.     ComboBoxFilterNumber: TComboBox;
  47.     SaveDialog1: TSaveDialog;
  48.     N5: TMenuItem;
  49.     N8: TMenuItem;
  50.     ComboBoxFilterGroup: TComboBox;
  51.     procedure N3Click(Sender: TObject);
  52.     procedure N7Click(Sender: TObject);
  53.     procedure N6Click(Sender: TObject);
  54.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  55.     procedure FormCreate(Sender: TObject);
  56.     procedure ButtonDeleteClick(Sender: TObject);
  57.     procedure N2Click(Sender: TObject);
  58.     procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;
  59.         const Value: string);
  60.     function CheckAndCorrectCell(Input: String; Column: Byte) : String;
  61.     procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
  62.         var CanSelect: Boolean);
  63.     procedure LabelInfoFill(ARow: Integer);
  64.     procedure CheckReadOnlyClick(Sender: TObject);
  65.     procedure DeleteRow(ARow: Integer);
  66.     procedure ButtonSortByClick(Sender: TObject);
  67.     procedure ButtonFilterByClick(Sender: TObject);
  68.     function MsdSort(ArrInput: TArrPeopleAndResults) : TArrPeopleAndResults;
  69.     function SplitInputBetweenLists(ArrInput: TArrPeopleAndResults; LetterNumber: Integer; ArrBuckets: TBuckets;
  70.         Bitness: Integer) : TBuckets;
  71.     function FindIndexForSorting(Person : TPersonAndHisResults; LetterNumber: Integer) : Integer;
  72.     function CountAverageScore(Person: TPersonAndHisResults) : Single;
  73.     function LoadInfoFromGridToArray() :  TArrPeopleAndResults;
  74.     procedure RepresentDataInGrid(ArrayOfData: TArrPeopleAndResults);
  75.     function FilterData(ArrayOfData: TArrPeopleAndResults) : TArrPeopleAndResults;
  76.     procedure N5Click(Sender: TObject);
  77.     procedure MoveMouseAfterFilteringToKillBug();
  78.     procedure N8Click(Sender: TObject);
  79.     procedure ComboBoxFilterGroupEnter(Sender: TObject);
  80.     function MultPixels(PixQuant: Integer) : Integer;
  81.  
  82.     private
  83.         SelectedRow: Integer;
  84.         MultPix: Single;
  85.         ArrOfData, ArrOfDataTemp: TArrPeopleAndResults; // Для сортировок и фильтров
  86.         StrFile: String;
  87.         IsSaved, WasOnlyRead: Boolean;
  88.         GroupNumbers: TArrStr;
  89.     public
  90.  
  91.     end;
  92.  
  93.     TGridHelper = class(TStringGrid);
  94.  
  95. const
  96.     LabelInfoAboutPersonCaption = 'Выберите строку в таблице, чтобы посмотреть информацию.';
  97.     RegExForGroupNumber = '\d{1,9}';
  98.     RegExForSurname = '[a-zA-Zа-яА-Я][-a-zA-Zа-яА-Я]{0,15}';
  99.     RegExForGrades = '10|[1-9]';
  100.     StrNoName = 'Безымянный';
  101.  
  102. var
  103.     FormMain: TFormMain;
  104.  
  105. implementation
  106. {$R *.dfm}
  107.  
  108. function FindRegEx(SInput, StrRegEx: String; StrIfNothingFound: String = '') : TArrStr; forward;
  109.  
  110. //******************************************************************************
  111. // Работа с таблицей
  112.  
  113. function TFormMain.CheckAndCorrectCell(Input: String; Column: Byte) : String;
  114. var
  115.     RightString: String;
  116.    
  117. begin
  118.     case Column of
  119.         0: RightString := FindRegEx(Input, RegExForGroupNumber)[0];
  120.         1: RightString := FindRegEx(Input, RegExForSurname)[0];
  121.         2..5: RightString := FindRegEx(Input, RegExForGrades)[0];
  122.     end;
  123.     Result := RightString;
  124. end;
  125.  
  126. procedure TFormMain.CheckReadOnlyClick(Sender: TObject);
  127. begin
  128.     with StringGrid1 do
  129.     begin
  130.         if CheckReadOnly.Checked then
  131.             Options := Options - [goEditing]
  132.         else
  133.             Options := Options + [goEditing];
  134.     end;
  135. end;
  136.  
  137. procedure TFormMain.StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;
  138.                                         const Value: string);
  139. var
  140.     Input: String;
  141.     SelStart: Integer;
  142.     i: Integer;
  143.     IsEmpty: Boolean;
  144.  
  145. begin
  146.     if ACol = 0 then
  147.         with ComboBoxFilterGroup do
  148.         begin
  149.             Items.Clear;
  150.             Items.Add('*Все группы');
  151.             ItemIndex := 0;
  152.         end;
  153.  
  154.     IsSaved := False;
  155.     Input := Value;
  156.     Input := CheckAndCorrectCell(Input, ACol);
  157.    
  158.     with TGridHelper(StringGrid1) do
  159.         SelStart := InplaceEditor.SelStart;
  160.    
  161.     StringGrid1.Cells[Acol, ARow] := Input;
  162.  
  163.     with TGridHelper(StringGrid1) do
  164.         InplaceEditor.SelStart := SelStart;
  165.    
  166.     LabelInfoFill(ARow);
  167.  
  168.     with StringGrid1 do
  169.     begin
  170.         if (ARow = RowCount - 1) then
  171.             RowCount := RowCount + 1;
  172.  
  173.         if (ARow <> RowCount - 1) then
  174.         begin
  175.             IsEmpty := True;
  176.             i := 0;
  177.             while (i < 6) and IsEmpty do
  178.             begin
  179.                 if Cells[i, ARow].Trim <> '' then
  180.                     IsEmpty := False;
  181.                 Inc(i);
  182.             end;
  183.             if IsEmpty then
  184.             begin
  185.                 DeleteRow(ARow);
  186.                 LabelInfoFill(ARow);
  187.             end;
  188.         end;
  189.     end;
  190. end;
  191.  
  192.  
  193. //******************************************************************************
  194. // Сортировка и фильтр
  195.  
  196. procedure TFormMain.ButtonFilterByClick(Sender: TObject);
  197. begin
  198.     with ButtonFilterBy do
  199.     begin
  200.         if Caption = 'Фильтровать' then
  201.         begin
  202.             Caption := 'Не фильтровать';
  203.             ComboBoxFilterWhat.Enabled := False;
  204.             ComboBoxFilterHow.Enabled := False;
  205.             ComboBoxFilterNumber.Enabled := False;
  206.             ComboBoxFilterGroup.Enabled := False;
  207.             ButtonDelete.Enabled := False;
  208.             SelectedRow := -1;
  209.  
  210.             with StringGrid1 do
  211.                 Options := Options - [goEditing];
  212.  
  213.             with CheckReadOnly do
  214.             begin
  215.                 WasOnlyRead := Checked;
  216.                 Checked := True;
  217.                 Enabled := False;
  218.             end;
  219.  
  220.             ArrOfData := LoadInfoFromGridToArray();
  221.             ArrOfDataTemp := FilterData(ArrOfData);
  222.             if Length(ArrOfDataTemp) > 0 then
  223.             begin
  224.                 RepresentDataInGrid(ArrOfDataTemp);
  225.                 MoveMouseAfterFilteringToKillBug();
  226.                 DeleteRow(StringGrid1.RowCount - 1);
  227.                 SetLength(ArrOfDataTemp, 0);
  228.             end
  229.             else
  230.             begin
  231.                 ShowMessage('Не найдено ни одного совпадения');
  232.                 ButtonFilterByClick(Self);
  233.             end;
  234.         end
  235.         else
  236.         begin
  237.             Caption := 'Фильтровать';
  238.             ComboBoxFilterWhat.Enabled := True;
  239.             ComboBoxFilterHow.Enabled := True;
  240.             ComboBoxFilterNumber.Enabled := True;
  241.             ComboBoxFilterGroup.Enabled := True;
  242.  
  243.             if not WasOnlyRead then
  244.                 with StringGrid1 do
  245.                     Options := Options + [goEditing];
  246.  
  247.             with CheckReadOnly do
  248.             begin
  249.                 Checked := WasOnlyRead;
  250.                 Enabled := True;
  251.             end;
  252.  
  253.             RepresentDataInGrid(ArrOfData);
  254.         end;
  255.     end;
  256. end;
  257.  
  258. procedure TFormMain.MoveMouseAfterFilteringToKillBug();
  259. var
  260.     GridRect: TGridRect;
  261.     Row: Integer;
  262.     CursorClipArea: TRect;
  263.     BoundsRect: TRect;
  264.     MousePoint1, MousePoint2: TPoint;
  265.  
  266. begin
  267.     GetCursorPos(MousePoint1);
  268.  
  269.     GridRect := StringGrid1.Selection;
  270.     Row := GridRect.Top;
  271.  
  272.     CursorClipArea.TopLeft := StringGrid1.ClientToScreen(StringGrid1.CellRect(0, 0).TopLeft);
  273.     CursorClipArea.BottomRight := StringGrid1.ClientToScreen(StringGrid1.CellRect(0, 0).BottomRight);
  274.     CursorClipArea.BottomRight.X := CursorClipArea.BottomRight.X - Round(StringGrid1.ColWidths[0] / 2);
  275.     CursorClipArea.BottomRight.Y := CursorClipArea.BottomRight.Y - Round(StringGrid1.RowHeights[1] / 2);
  276.     Winapi.Windows.ClipCursor(@CursorClipArea);
  277.  
  278.     GetCursorPos(MousePoint2);
  279.     mouse_event(MOUSEEVENTF_LEFTDOWN,MousePoint2.X,MousePoint2.Y,0,0);
  280.     mouse_event(MOUSEEVENTF_LEFTUP,MousePoint2.X,MousePoint2.Y,0,0);
  281.  
  282.     Winapi.Windows.ClipCursor(nil);
  283.     SetCursorPos(MousePoint1.X, MousePoint1.Y);
  284. end;
  285.  
  286. procedure TFormMain.ButtonSortByClick(Sender: TObject);
  287. var
  288.     IsCorrect: Boolean;
  289.  
  290. begin
  291.     IsCorrect := True;
  292.  
  293.     if (StringGrid1.RowCount = 2) and (ButtonFilterBy.Caption = 'Фильтровать') then
  294.     begin
  295.         ShowMessage('Таблица пуста');
  296.         IsCorrect := False;
  297.     end;
  298.  
  299.     if IsCorrect then
  300.     begin
  301.         IsSaved := False;
  302.         ArrOfDataTemp := LoadInfoFromGridToArray();
  303.  
  304.         ArrOfDataTemp := MsdSort(ArrOfDataTemp);
  305.  
  306.         RepresentDataInGrid(ArrOfDataTemp);
  307.         SetLength(ArrOfDataTemp, 0);
  308.  
  309.         SelectedRow := - 1;
  310.         LabelInfoAboutPerson.Caption := LabelInfoAboutPersonCaption;
  311.         ButtonDelete.Enabled := False;
  312.     end;
  313. end;
  314.  
  315. function TFormMain.FilterData(ArrayOfData: TArrPeopleAndResults) : TArrPeopleAndResults;
  316. var
  317.     Person: TPersonAndHisResults;
  318.     IndexesOfFilteredPerson: TArrInt;
  319.     WhatToCompareWith, i, k: Integer;
  320.     WhatToFilter: Single;
  321.     IsAllowedByFilter: Boolean;
  322.     ArrOut: TArrPeopleAndResults;
  323.  
  324. begin
  325.     for i := 0 to High(ArrayOfData) do
  326.     begin
  327.         Person := ArrayOfData[i];
  328.         with ComboBoxFilterGroup do
  329.             if (ItemIndex = 0) or (Items[ItemIndex] = Person.FGroupNumber) then
  330.             begin
  331.                 with Person do
  332.                     case ComboBoxFilterWhat.ItemIndex of
  333.                         0: WhatToFilter := CountAverageScore(Person);
  334.                         1: WhatToFilter := FGradeMath;
  335.                         2: WhatToFilter := FGradePhys;
  336.                         3: WhatToFilter := FGradeProgr;
  337.                         4: WhatToFilter := FGradeEngGraph;
  338.                     end;
  339.  
  340.                 if WhatToFilter > 0 then
  341.                 begin
  342.                     WhatToCompareWith := 10 - ComboBoxFilterNumber.ItemIndex;
  343.                     case ComboBoxFilterHow.ItemIndex of
  344.                         0: IsAllowedByFilter := WhatToFilter >= WhatToCompareWith;
  345.                         1: IsAllowedByFilter := WhatToFilter <= WhatToCompareWith;
  346.                         2: IsAllowedByFilter := WhatToFilter = WhatToCompareWith;
  347.                     end;
  348.                 end
  349.                 else
  350.                     IsAllowedByFilter := False;
  351.             end
  352.             else
  353.                 IsAllowedByFilter := False;
  354.  
  355.         if IsAllowedByFilter then
  356.         begin
  357.             SetLength(IndexesOfFilteredPerson, Length(IndexesOfFilteredPerson) + 1);
  358.             IndexesOfFilteredPerson[High(IndexesOfFilteredPerson)] := i;
  359.         end;
  360.     end;
  361.  
  362.     k := 0;
  363.     SetLength(ArrOut, Length(IndexesOfFilteredPerson));
  364.     for i in IndexesOfFilteredPerson do
  365.     begin
  366.         ArrOut[k] := ArrayOfData[i];
  367.         Inc(k);
  368.     end;
  369.  
  370.     Result := ArrOut;
  371. end;
  372.  
  373. procedure TFormMain.RepresentDataInGrid(ArrayOfData: TArrPeopleAndResults);
  374. var
  375.     i, OldRowCount, NewRowCount: Integer;
  376.  
  377. begin
  378.     with StringGrid1 do
  379.     begin
  380.         OldRowCount := RowCount;
  381.         NewRowCount := Length(ArrayOfData) + 2;
  382.         for i := OldRowCount - 2 downto NewRowCount - 1 do
  383.             DeleteRow(Row);
  384.         RowCount := Length(ArrayOfData) + 2;
  385.  
  386.         for i := 1 to RowCount - 2 do
  387.         begin
  388.             Cells[0, i] := FindRegEx(ArrayOfData[i - 1].FGroupNumber,
  389.                 RegExForGroupNumber, '')[0];
  390.             if Cells[0, i] = '0' then
  391.                 Cells[0, i] := '';
  392.  
  393.             Cells[1, i] := FindRegEx(ArrayOfData[i - 1].FSurname, RegExForSurname, '')[0];
  394.             Cells[2, i] := FindRegEx(IntToStr(ArrayOfData[i - 1].FGradeMath), RegExForGrades, '')[0];
  395.             Cells[3, i] := FindRegEx(IntToStr(ArrayOfData[i - 1].FGradePhys), RegExForGrades, '')[0];
  396.             Cells[4, i] := FindRegEx(IntToStr(ArrayOfData[i - 1].FGradeProgr), RegExForGrades, '')[0];
  397.             Cells[5, i] := FindRegEx(IntToStr(ArrayOfData[i - 1].FGradeEngGraph), RegExForGrades, '')[0];
  398.         end;
  399.     end;
  400. end;
  401.  
  402. function TFormMain.LoadInfoFromGridToArray() :  TArrPeopleAndResults;
  403. var
  404.     i, j: Integer;
  405.     StrTemp, StrTemp2: String;
  406.     ArrayOfData: TArrPeopleAndResults;
  407.  
  408. begin
  409.     with StringGrid1 do
  410.     begin
  411.         SetLength(ArrayOfData, RowCount - 2);
  412.         for i := 1 to RowCount - 2 do
  413.         begin
  414.             StrTemp := FindRegEx(Cells[0, i], RegExForGroupNumber, '0')[0];
  415.             if FindRegEx(StrTemp, '0+')[0] = StrTemp then
  416.                 StrTemp := '0';
  417.             ArrayOfData[i - 1].FGroupNumber := StrTemp;
  418.  
  419.  
  420.             StrTemp2 := FindRegEx(Cells[1, i], RegExForSurname, StrNoName)[0];
  421.  
  422.             if Length(StrTemp2) > 1 then
  423.                 StrTemp := Copy(StrTemp2, 2, 15)
  424.             else
  425.                 StrTemp := '';
  426.             ArrayOfData[i - 1].FSurname := AnsiUpperCase(StrTemp2[1]) + AnsiLowerCase(StrTemp);
  427.  
  428.  
  429.             StrTemp := FindRegEx(Cells[2, i], RegExForGrades, '0')[0];
  430.             ArrayOfData[i - 1].FGradeMath := StrToInt(StrTemp);
  431.  
  432.             StrTemp := FindRegEx(Cells[3, i], RegExForGrades, '0')[0];
  433.             ArrayOfData[i - 1].FGradePhys := StrToInt(StrTemp);
  434.  
  435.             StrTemp := FindRegEx(Cells[4, i], RegExForGrades, '0')[0];
  436.             ArrayOfData[i - 1].FGradeProgr := StrToInt(StrTemp);
  437.  
  438.             StrTemp := FindRegEx(Cells[5, i], RegExForGrades, '0')[0];
  439.             ArrayOfData[i - 1].FGradeEngGraph := StrToInt(StrTemp);
  440.         end;
  441.     end;
  442.  
  443.     Result := ArrayOfData;
  444. end;
  445.  
  446. procedure TFormMain.ComboBoxFilterGroupEnter(Sender: TObject);
  447. var
  448.     i, j, TempItemIndex: Integer;
  449.     TempItem: String;
  450.     SameNotFound: Boolean;
  451.  
  452. begin
  453.     with StringGrid1 do
  454.     begin
  455.         SetLength(GroupNumbers, 0);
  456.         for i := 1 to RowCount - 2 do
  457.         begin
  458.             SameNotFound := True;
  459.             j := 0;
  460.  
  461.             if (Cells[0, i].Trim = '') or (StrToInt(Cells[0, i]) = 0) then
  462.                 SameNotFound := False;
  463.  
  464.             while (j < Length(GroupNumbers)) and SameNotFound do
  465.             begin
  466.                 if Cells[0, i] = GroupNumbers[j] then
  467.                     SameNotFound := False;
  468.  
  469.                 Inc(j);
  470.             end;
  471.  
  472.             if SameNotFound then
  473.             begin
  474.                 SetLength(GroupNumbers, Length(GroupNumbers) + 1);
  475.                 GroupNumbers[High(GroupNumbers)] := Cells[0 , i];
  476.             end;
  477.         end;
  478.     end;
  479.  
  480.     with ComboBoxFilterGroup do
  481.     begin
  482.         TempItemIndex := ItemIndex;
  483.         TempItem := Items[TempItemIndex];
  484.         Items.Clear;
  485.         Items.Add('*Все группы');
  486.         for i := 0 to High(GroupNumbers) do
  487.             Items.Add(GroupNumbers[i]);
  488.         if Items[TempItemIndex] = TempItem then
  489.             ItemIndex := TempItemIndex
  490.         else
  491.             ItemIndex := 0;
  492.     end;
  493. end;
  494.  
  495. function TFormMain.FindIndexForSorting(Person : TPersonAndHisResults; LetterNumber: Integer) : Integer;
  496. var
  497.     Index, i, Temp: Integer;
  498.     Ch: Char;
  499.     ACh: AnsiChar;
  500.     Str: String;
  501.     AverageScore: Single;
  502.  
  503. begin
  504.     with ComboBoxSortBy do
  505.     begin
  506.         Case ItemIndex of
  507.             0: begin
  508.                 Str := Person.FGroupNumber;
  509.                 for i := 1 to 16 - Length(Str) do
  510.                     Str := '0' + Str;
  511.                 Ch := Str[LetterNumber];
  512.                 Index := Ord(Ch);
  513.                 if Person.FGroupNumber = '0' then
  514.                     Index := 255;
  515.             end;
  516.             1: begin
  517.                 ACh := Person.FSurname[LetterNumber];
  518.                 Index := Ord(ACh);
  519.  
  520.                 if (FindRegEx(Person.FSurname, StrNoName, '')[0] <> '') and (LetterNumber < 2) then
  521.                     Index := 255;
  522.             end;
  523.             2..3: begin
  524.                 AverageScore := CountAverageScore(Person);
  525.  
  526.                 Str := FloatToStrF(AverageScore, ffFixed, 2, 2);
  527.                 if Length(Str) < 5 then
  528.                     Str := '0' + Str;
  529.  
  530.                 for i := 1 to 16 - Length(Str) do
  531.                     Str := Str + '0';
  532.  
  533.                 Temp := Ord(Str[LetterNumber]);
  534.                 if AverageScore = 0 then
  535.                     Temp := 255;
  536.             end;
  537.         End;
  538.  
  539.         Case ItemIndex of
  540.             2: begin
  541.                 Index := 255 - Temp;
  542.                 if Temp = 255 then
  543.                     Index := 255;
  544.             end;
  545.             3: Index := Temp;
  546.         end;
  547.     end;
  548.     Result := Index;
  549. end;
  550.  
  551. function TFormMain.CountAverageScore(Person: TPersonAndHisResults) : Single;
  552. var
  553.     AverageScore: Single;
  554.     Divider: Byte;
  555.  
  556. begin
  557.     AverageScore := 0;
  558.     Divider := 0;
  559.  
  560.     with Person do
  561.     begin
  562.         if FGradeMath > 0 then
  563.             Inc(Divider);
  564.         if FGradePhys > 0 then
  565.             Inc(Divider);
  566.         if FGradeProgr > 0 then
  567.             Inc(Divider);
  568.         if FGradeEngGraph > 0 then
  569.             Inc(Divider);
  570.         if Divider > 0 then
  571.             AverageScore := (FGradeMath + FGradePhys + FGradeProgr + FGradeEngGraph) / Divider;
  572.     end;
  573.  
  574.     Result := AverageScore;
  575. end;
  576.  
  577. function TFormMain.SplitInputBetweenLists(ArrInput: TArrPeopleAndResults; LetterNumber: Integer; ArrBuckets: TBuckets;
  578.     Bitness: Integer): TBuckets;
  579. var
  580.     Index, j, i: Integer;
  581.     iInBuckets: Array of Integer;
  582.     Person: TPersonAndHisResults;
  583.     Ch: AnsiChar;
  584.     Bucket: TArrPeopleAndResults;
  585.     ArrBuckets2: TBuckets;
  586.  
  587. begin
  588.     SetLength(ArrBuckets2, Bitness);
  589.     for i := 0 to High(ArrBuckets2) do
  590.         Setlength(ArrBuckets2[i], 0);
  591.  
  592.     for Person in ArrInput do
  593.     begin
  594.         Index := FindIndexForSorting(Person, LetterNumber);
  595.  
  596.         SetLength(ArrBuckets[Index], Length(ArrBuckets[Index]) + 1);
  597.         ArrBuckets[Index][High(ArrBuckets[Index])] := Person;
  598.     end;
  599.  
  600.     if LetterNumber < 16 then
  601.     begin
  602.         Inc(LetterNumber);
  603.         for Bucket in ArrBuckets do
  604.         begin
  605.             i := 0;
  606.             if Length(Bucket) <> 0 then
  607.             begin
  608.                 ArrBuckets2 := SplitInputBetweenLists(Bucket, LetterNumber, ArrBuckets2, Bitness);
  609.  
  610.                 for j := 0 to Bitness - 1 do
  611.                 begin
  612.                     for Person in ArrBuckets2[j] do
  613.                     begin
  614.                         Bucket[i] := Person;
  615.                         Inc(i);
  616.                     end;
  617.                     Setlength(ArrBuckets2[j], 0);
  618.                 end;
  619.             end;
  620.         end;
  621.     end;
  622.  
  623.     Result := ArrBuckets;
  624. end;
  625.  
  626. function TFormMain.MsdSort(ArrInput: TArrPeopleAndResults) : TArrPeopleAndResults;
  627. const
  628.     Bitness = 256; // разрядность
  629.  
  630. var
  631.     i, j, LetterNumber: Integer;
  632.     ArrBuckets: TBuckets;
  633.     Person: TPersonAndHisResults;
  634.  
  635. Begin
  636.     SetLength(ArrBuckets, Bitness);
  637.     for i := 0 to High(ArrBuckets) do
  638.         Setlength(ArrBuckets[i], 0);
  639.  
  640.     LetterNumber := 1;
  641.     ArrBuckets := SplitInputBetweenLists(ArrInput, LetterNumber, ArrBuckets, Bitness);
  642.     // moving lists back into input array
  643.     i := 0;
  644.     for j := 0 to Bitness - 1 do
  645.     begin
  646.         for Person in ArrBuckets[j] do
  647.         begin
  648.             ArrInput[i] := Person;
  649.             Inc(i);
  650.         end;
  651.         Setlength(ArrBuckets[j], 0); //clear ArrBuckets
  652.     end;
  653.  
  654.     Result := ArrInput;
  655. end;
  656.  
  657. //******************************************************************************
  658. // Удаление данных, а также информационное окно
  659.  
  660. procedure TFormMain.ButtonDeleteClick(Sender: TObject);
  661. var
  662.     Bool: Boolean;
  663.  
  664. begin
  665.     if (SelectedRow <> StringGrid1.RowCount - 1) and (MessageDlg(
  666.         'Вы уверены, что хотите удалить этого студента?',
  667.         mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
  668.     begin
  669.         DeleteRow(SelectedRow);
  670.         if SelectedRow <> StringGrid1.RowCount - 1 then
  671.         begin
  672.             Bool := True;
  673.             StringGrid1SelectCell(Self, 0, SelectedRow, Bool);
  674.         end
  675.         else
  676.         begin
  677.             SelectedRow := -1;
  678.             LabelInfoAboutPerson.Caption := LabelInfoAboutPersonCaption;
  679.             ButtonDelete.Enabled := False;
  680.         end;
  681.     end;
  682. end;
  683.  
  684. procedure TFormMain.StringGrid1SelectCell(Sender: TObject; ACol,
  685.   ARow: Integer; var CanSelect: Boolean);
  686. begin        
  687.     SelectedRow := ARow;
  688.     LabelInfoFill(ARow);
  689.     if (ButtonFilterBy.Caption = 'Фильтровать') and (SelectedRow <> StringGrid1.RowCount - 1) then
  690.         ButtonDelete.Enabled := True
  691.     else
  692.         ButtonDelete.Enabled := False;
  693. end;
  694.  
  695. procedure TFormMain.LabelInfoFill(ARow: Integer);
  696. begin
  697.     With StringGrid1 do
  698.     begin
  699.         LabelInfoAboutPerson.Caption := 'Группа: ' + Cells[0, ARow] + #10#13 +
  700.             'Фамилия: ' + Cells[1, ARow] + #10#13 + #10#13 +
  701.             'Оценки:' + #10#13 +
  702.             '   Математика: ' + Cells[2, ARow] + #10#13 +
  703.             '   Физика: ' + Cells[3, ARow] + #10#13 +
  704.             '   Программирование: ' + Cells[4, ARow] + #10#13 +
  705.             '   Инженерная графика: ' + Cells[5, ARow] + #10#13;
  706.     end;
  707. end;
  708.  
  709. procedure TFormMain.DeleteRow(ARow: Integer);
  710. var
  711.     i, j: Integer;
  712. begin
  713.     IsSaved := False;
  714.     with StringGrid1 do
  715.     begin
  716.         for i := ARow + 1 to RowCount - 1 do
  717.             for j := 0 to ColCount - 1 do
  718.                 Cells[j, i - 1] := Cells[j, i];
  719.  
  720.         for i := 0 to ColCount - 1 do
  721.             Cells[i, RowCount-1] := '';
  722.  
  723.         RowCount := RowCount - 1;
  724.     end;
  725. end;
  726.  
  727. //******************************************************************************
  728. // Работа с файлами
  729.  
  730. procedure TFormMain.N7Click(Sender: TObject);
  731. const
  732.     ErrorDuringInputOccured = 'Возникла ошибка при открытии файла.' + #10#13 +
  733.                 'Пожалуйста, выберите файл нужного формата(.datgrad) с ' +
  734.                 'корректными данными.';
  735.  
  736. var
  737.     FileInput : File of TPersonAndHisResults;
  738.     i, FirstTimeSeconds, NewTimeSeconds: Integer;
  739.     PathToFile: String;
  740.     IsNotTooLong: Boolean;
  741.  
  742. begin
  743.     if not IsSaved and (MessageDlg('Вы хотите сохранить текущие данные?' +
  744.         #10#13 + 'Иначе после открытия файла текущие записи будут удалены.',
  745.         mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
  746.         N5Click(Self);
  747.  
  748.     if (IsSaved or (MessageDlg('Вы уверены, что хотите открыть другой файл?' + #10#13 +
  749.         'Все текущие записи будут удалены.', mtConfirmation, [mbYes, mbCancel], 0) = mrYes))
  750.         and OpenDialog1.Execute then
  751.     begin
  752.         if ButtonFilterBy.Caption <> 'Фильтровать' then
  753.             ButtonFilterByClick(Self);
  754.  
  755.         PathToFile := OpenDialog1.FileName;
  756.         try
  757.             AssignFile(FileInput, PathToFile);
  758.             Reset(FileInput);
  759.  
  760.             FirstTimeSeconds := StrToInt(Copy(TimeToStr(Time), 7, 2));
  761.             IsNotTooLong := True;
  762.  
  763.             SetLength(ArrOfData, FileSize(FileInput));
  764.             i := 0;
  765.             while (not Eof(FileInput) and IsNotTooLong) do
  766.             begin
  767.                 Read(FileInput, ArrOfData[i]);
  768.                 Inc(i);
  769.                 NewTimeSeconds := StrToInt(Copy(TimeToStr(Time), 7, 2));
  770.                 IsNotTooLong := (Abs(NewTimeSeconds - FirstTimeSeconds) < 2) or (NewTimeSeconds < 2);
  771.             end;
  772.  
  773.             CloseFile(FileInput);
  774.             if IsNotTooLong then
  775.             begin
  776.                 StrFile := PathToFile;
  777.                 N5.Enabled := True;
  778.                 RepresentDataInGrid(ArrOfData);
  779.                 IsSaved := True;
  780.             end
  781.             else
  782.                 ShowMessage(ErrorDuringInputOccured);
  783.         except
  784.             ShowMessage(ErrorDuringInputOccured);
  785.         end;
  786.  
  787.         SelectedRow := -1;
  788.         LabelInfoAboutPerson.Caption := LabelInfoAboutPersonCaption;
  789.         ButtonDelete.Enabled := False;
  790.         CheckReadOnly.Checked := True;
  791.         with StringGrid1 do
  792.             Options := Options - [goEditing]
  793.     end;
  794. end;
  795.  
  796. procedure TFormMain.N6Click(Sender: TObject);
  797. var
  798.     FileOutput : File of TPersonAndHisResults;
  799.     i: Integer;
  800.     StrFilePath: String;
  801.     Person: TPersonAndHisResults;
  802.     ShouldNotRepeat: Boolean;
  803.  
  804. begin
  805.     if (StringGrid1.RowCount > 2) and (ButtonFilterBy.Caption = 'Фильтровать') then
  806.         try
  807.             repeat
  808.                 ShouldNotRepeat := True;
  809.                 if SaveDialog1.Execute then
  810.                 begin
  811.                     StrFilePath := SaveDialog1.FileName;
  812.                     StrFilePath := FindRegEx(StrFilePath, '.+\.datgrad', StrFilePath + '.datgrad')[0];
  813.                     StrFile := StrFilePath;
  814.                     N5.Enabled := True;
  815.  
  816.                     if FileExists(StrFilePath) then
  817.                         if MessageDlg('Такой файл уже существует.' +
  818.                             #10#13 + 'Вы хотите перезаписать файл? Это действие невозможно отменить.',
  819.                             mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  820.                             ShouldNotRepeat := True
  821.                         else
  822.                             ShouldNotRepeat := False
  823.                     else
  824.                         ShouldNotRepeat := True;
  825.  
  826.                     if ShouldNotRepeat then
  827.                     begin
  828.                         AssignFile(FileOutput, StrFilePath);
  829.                         Rewrite(FileOutput);
  830.  
  831.                         ArrOfData := LoadInfoFromGridToArray;
  832.  
  833.                         for Person in ArrOfData do
  834.                             Write(FileOutput, Person);
  835.  
  836.                         CloseFile(FileOutput);
  837.                         IsSaved := True;
  838.                     end;
  839.                 end;
  840.             until ShouldNotRepeat;
  841.         except
  842.            ShowMessage('Не удается открыть файл для вывода данных или записать в него данные.');
  843.         end
  844.     else
  845.         ShowMessage('Нет данных для экспорта или включен фильтр.');
  846. end;
  847.  
  848. procedure TFormMain.N5Click(Sender: TObject);
  849. var
  850.     FileOutput : File of TPersonAndHisResults;
  851.     Person: TPersonAndHisResults;
  852.  
  853. begin
  854.     if MessageDlg('Вы хотите перезаписать файл "' + StrFile + '"?' + #10#13 +
  855.         'Это действие невозможно отменить.', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  856.         if FileExists(StrFile) then
  857.             if (StringGrid1.RowCount > 2) and (ButtonFilterBy.Caption = 'Фильтровать') then
  858.             begin
  859.                 AssignFile(FileOutput, StrFile);
  860.                 Rewrite(FileOutput);
  861.  
  862.                 ArrOfData := LoadInfoFromGridToArray;
  863.  
  864.                 for Person in ArrOfData do
  865.                     Write(FileOutput, Person);
  866.  
  867.                 CloseFile(FileOutput);
  868.                 IsSaved := True;
  869.             end
  870.             else
  871.                 ShowMessage('Нет данных для экспорта или включен фильтр.')
  872.         else
  873.         begin
  874.             ShowMessage('Этого файла уже не существует.');
  875.             StrFile := '';
  876.             N5.Enabled := False;
  877.             N6Click(Self);
  878.         end;
  879. end;
  880.  
  881.  
  882. //******************************************************************************
  883. // Form Create
  884.  
  885. procedure TFormMain.FormCreate(Sender: TObject);
  886. var
  887.     i: Integer;
  888.  
  889. begin
  890.     MultPix := LabelToMeasureScreenOfUser.Width / 100;
  891.     LabelTask.Caption := 'Сведения о результатах комплексной контрольной.';
  892.     LabelInfoAboutPerson.Caption := LabelInfoAboutPersonCaption;
  893.     SelectedRow := -1;
  894.     StrFile := '';
  895.     IsSaved := True;
  896.  
  897.     with StringGrid1 do
  898.     begin
  899.         RowCount := 2;
  900.         ColCount := 6;
  901.        
  902.         Cells[0, 0] := 'Группа №';
  903.         Cells[1, 0] := 'Фамилия';
  904.         Cells[2, 0] := 'Матем';
  905.         Cells[3, 0] := 'Физика';
  906.         Cells[4, 0] := 'Прогр';
  907.         Cells[5, 0] := 'ИнжГр';
  908.        
  909.         for i := 2 to 5 do
  910.             ColWidths[i] := MultPixels(58);
  911.         ColWidths[0] := MultPixels(100);
  912.         ColWidths[1] := MultPixels(120);
  913.     end;
  914. end;
  915.  
  916. //******************************************************************************
  917. // Прочее
  918.  
  919. procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  920. begin
  921.     CanClose := IsSaved or (StringGrid1.RowCount = 2) or (MessageDlg('Вы уверены, что хотите выйти из программы?' +
  922.         #10#13 + 'Все несохранённые данные будут утеряны.',
  923.         mtConfirmation, [mbYes, mbNo], 0) = mrYes);
  924. end;
  925.  
  926. procedure TFormMain.N2Click(Sender: TObject);
  927. begin
  928.     ShowMessage('Помощь' + #10#13 +
  929.         'Вы можете просматривать базу данных, изменять её компоненты, добавлять и удалять строки.' +
  930.         #10#13 + 'Вы также можете сортировать и фильровать данные.' + #10#13#10#13 +
  931.         '   - Чтобы открыть базу данных из файла, нажмите "Открыть" в Меню.' + #10#13 +
  932.         '   - Чтобы получить возможность изменять данные, уберите галочку "Только чтение".' + #10#13 +
  933.         '   - Чтобы добавить новую информацию, используйте последнюю строку таблицы.' + #10#13 +
  934.         '   - Чтобы удалить строку, сотрите с неё данные либо нажмите кнопку "Удалить" после того, как выберите строку для удаления.' + #10#13 +
  935.         '   - Чтобы экспортировать данные, нажмите "Сохранить как..." в Меню.' + #10#13 +
  936.         '   - Вы также можете нажать "Сохранить", чтобы сохранить данные в последний открытый файл.' + #10#13 +
  937.         '   - Чтобы отсортировать данные, выберите, по какому критерию сортировать, затем нажмите кнопку "Сортировать".' + #10#13 +
  938.         '   - Чтобы фильтровать данные, выберите, что, как и относительно чего фильтроваь, затем нажмите кнопку "Фильтровать".');
  939. end;
  940.  
  941. procedure TFormMain.N3Click(Sender: TObject);
  942. begin
  943.     ShowMessage('Панев Александр, гр. 051007' + #10#13 + 'Минск, 2021');
  944. end;
  945.  
  946. procedure TFormMain.N8Click(Sender: TObject);
  947. begin
  948.     ShowMessage('Вывести список студентов группы Х в алфавитном порядке ' +
  949.         'фамилий, у которых средний балл за контрольную 7 и выше.');
  950. end;
  951.  
  952. function FindRegEx(SInput, StrRegEx: String; StrIfNothingFound: String = '') : TArrStr;
  953. var
  954.     ArrStr: TArrStr;
  955.     RegEx: TRegEx;
  956.     MatchCollection: TMatchCollection;
  957.     i: Integer;
  958. begin
  959.     RegEx := TRegEx.Create(StrRegEx);
  960.     MatchCollection := RegEx.Matches(SInput);
  961.     SetLength(ArrStr, MatchCollection.Count);
  962.     for i := 0 to MatchCollection.Count - 1 do
  963.         ArrStr[i] := MatchCollection.Item[i].Value;
  964.  
  965.     if (Length(ArrStr) < 1) then
  966.         ArrStr := [StrIfNothingFound];
  967.     Result := ArrStr;
  968. end;
  969.  
  970. function TFormMain.MultPixels(PixQuant: Integer) : Integer;
  971. begin
  972.     Result := Round(PixQuant * MultPix);
  973. end;
  974.  
  975. end.
Advertisement
Add Comment
Please, Sign In to add comment