Advertisement
altervisi0n

Untitled

May 31st, 2023
130
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 4.82 KB | None | 0 0
  1. unit PlayerOfTeam;
  2.  
  3. interface
  4.  
  5. uses
  6.     Vcl.Forms, MainUnit, Math, System.Classes, Vcl.Controls, Vcl.ComCtrls, SysUtils,
  7.   Vcl.Graphics, CommCtrl, Winapi.Messages, Winapi.Windows, Vcl.Menus,
  8.   Vcl.Dialogs, Vcl.Styles, Vcl.Themes;
  9.  
  10. type
  11.  
  12.    TListView = class(Vcl.ComCtrls.TListView)
  13.   protected
  14.       procedure WndProc(var Message: TMessage); override;
  15.   end;
  16.  
  17.   TTeamForm = class(TForm)
  18.     ListView1: TListView;
  19.     MainMenu: TMainMenu;
  20.     N1: TMenuItem;
  21.     SaveDialog: TSaveDialog;
  22.     Procedure CalculatePlayers(Current: PTeam);
  23.     procedure FormCreate(Sender: TObject);
  24.     procedure ListView1AdvancedCustomDrawSubItem(Sender: TCustomListView;
  25.       Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  26.       Stage: TCustomDrawStage; var DefaultDraw: Boolean);
  27.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  28.     procedure N1Click(Sender: TObject);
  29.     private
  30.         FListViewOldWndProc: TWndMethod;
  31.         procedure ListViewNewWndProc(var Msg: TMessage);
  32.         Const FBackgroundColor: TColor = 3615019;
  33.   end;
  34.  
  35. var
  36.   TeamForm: TTeamForm;
  37.  
  38. implementation
  39.  
  40. procedure TListView.WndProc(var Message: TMessage);
  41. begin
  42.     If Message.Msg = WM_NCCALCSIZE then
  43.         ShowScrollBar(Handle, SB_HORZ, False);
  44.     Inherited WndProc(Message);
  45. end;
  46.  
  47. Procedure TTeamForm.CalculatePlayers(Current: PTeam);
  48. Var
  49.     Temp: PTeam;
  50.     I: Integer;
  51.     Penalty, AllScore: TPlayer;
  52.     Item: TListItem;
  53. Begin
  54.     Temp := Current;
  55.     While Temp <> Nil do
  56.     Begin
  57.         Penalty := Temp^.Info.TeamPlayers[0];
  58.         AllScore := Temp^.Info.TeamPlayers[0];
  59.         For I := 1 to High(Temp^.Info.TeamPlayers) do
  60.         Begin
  61.             If Penalty.PenaltyPoints < Temp^.Info.TeamPlayers[I].PenaltyPoints Then
  62.                 Penalty := Temp^.Info.TeamPlayers[I];
  63.             If AllScore.GoalsScored < Temp^.Info.TeamPlayers[I].GoalsScored Then
  64.                 AllScore := Temp^.Info.TeamPlayers[I];
  65.         End;
  66.  
  67.         Item := ListView1.Items.Add;
  68.         Item.Caption := IntToStr(Temp^.Info.Data.Code);
  69.         Item.SubItems.Add(Temp^.Info.Data.Name);
  70.         Item.SubItems.Add(IntToStr(Temp^.Info.Data.Rank));
  71.         Item.SubItems.Add(' ');
  72.         Item.SubItems.Add(AllScore.Code);
  73.         Item.SubItems.Add(AllScore.FullName);
  74.         Item.SubItems.Add(IntToStr(AllScore.GoalsScored));
  75.         Item.SubItems.Add(' ');
  76.         Item.SubItems.Add(Penalty.Code);
  77.         Item.SubItems.Add(Penalty.FullName);
  78.         Item.SubItems.Add(IntToStr(Penalty.PenaltyPoints));
  79.         Temp := Temp^.Next;
  80.     End;
  81. End;
  82.  
  83. {$R *.dfm}
  84.  
  85. procedure TTeamForm.ListView1AdvancedCustomDrawSubItem(Sender: TCustomListView;
  86.   Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  87.   Stage: TCustomDrawStage; var DefaultDraw: Boolean);
  88. begin
  89.     Sender.Canvas.Brush.Color := StyleServices.GetStyleColor(Vcl.Themes.TStyleColor.scListView);
  90.     case SubItem of
  91.         4..6:
  92.             Sender.Canvas.Font.Color := ClLime;
  93.         8..10:
  94.             Sender.Canvas.Font.Color := ClRed;
  95.         Else
  96.             Sender.Canvas.Font.Color := ClWhite;
  97.     end;
  98.  
  99. end;
  100.  
  101. procedure TTeamForm.ListViewNewWndProc(var Msg: TMessage);
  102. var
  103.     hdn: ^THDNotify;
  104. begin
  105.     if Msg.Msg = WM_NOTIFY then
  106.     begin
  107.         hdn := Pointer(Msg.lParam);
  108.         if (hdn.hdr.code = HDN_BeginTrackW) or (hdn.hdr.code = HDN_BeginTrackA) then
  109.             Msg.Result := 1
  110.         else
  111.             FListViewOldWndProc(Msg);
  112.     end
  113.     else
  114.         FListViewOldWndProc(Msg);
  115. end;
  116.  
  117. procedure TTeamForm.N1Click(Sender: TObject);
  118. Var
  119.     FileOutput: TextFile;
  120.     I, J: Integer;
  121.     Str: String;
  122. begin
  123.     If SaveDialog.Execute Then
  124.     Begin
  125.         Try
  126.             Try
  127.                 AssignFile(FileOutput, ChangeFileExt(SaveDialog.FileName, '.txt'));
  128.                 Rewrite(FileOutput);
  129.                 For I := 0 to ListView1.Items.Count - 1 do
  130.                 Begin
  131.                     Str := ListView1.Items.Item[I].Caption + ', ';
  132.                     For J := 0 to ListView1.Items.Item[I].SubItems.Count - 1 do
  133.                         Str := Str + ListView1.Items.Item[I].SubItems.Strings[J] + ', ';
  134.                     Delete(Str, Length(Str) - 2, 2);
  135.                     WriteLn(FileOutput, Str);
  136.                 End;
  137.             Except
  138.                 MessageBox(Handle, 'Файл некорректен!', 'Внимание!', MB_OK + MB_ICONWARNING);
  139.             End;
  140.         Finally
  141.             If FileExists(ChangeFileExt(SaveDialog.FileName, '.txt')) Then
  142.                 CloseFile(FileOutput);
  143.         End;
  144.     End;
  145. end;
  146.  
  147. procedure TTeamForm.FormClose(Sender: TObject; var Action: TCloseAction);
  148. begin
  149.     ListView1.Clear;
  150. end;
  151.  
  152. procedure TTeamForm.FormCreate(Sender: TObject);
  153. begin
  154.     FListViewOldWndProc := ListView1.WindowProc;
  155.     ListView1.WindowProc := ListViewNewWndProc;
  156. end;
  157.  
  158. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement