source: tags/1.2.0/Log.pas

Last change on this file was 183, checked in by chronos, 4 years ago
File size: 3.6 KB
Line 
1{$INCLUDE Switches.inc}
2unit Log;
3
4interface
5
6uses
7 LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms,
8 StdCtrls, Menus;
9
10type
11 TLogDlg = class(TForm)
12 LogPopup: TPopupMenu;
13 mLog0: TMenuItem;
14 mLog1: TMenuItem;
15 mLog2: TMenuItem;
16 mLog3: TMenuItem;
17 N1: TMenuItem;
18 mClear: TMenuItem;
19 mSlot: TMenuItem;
20 N2: TMenuItem;
21 mInvalid: TMenuItem;
22 mTime: TMenuItem;
23 List: TMemo;
24 mNegotiation: TMenuItem;
25 procedure mLogClick(Sender: TObject);
26 procedure FormCreate(Sender: TObject);
27 procedure mClearClick(Sender: TObject);
28 procedure mSlotClick(Sender: TObject);
29 procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
30 procedure Toggle(Sender: TObject);
31 procedure ListMouseDown(Sender: TObject; Button: TMouseButton;
32 Shift: TShiftState; X, Y: Integer);
33 procedure FormKeyUp(Sender: TObject; var Key: word; Shift: TShiftState);
34 public
35 Host: TForm;
36 procedure Add(Level, Turn: Integer; Text: pchar);
37 private
38 MaxLevel: Integer;
39 end;
40
41var
42 LogDlg: TLogDlg;
43
44
45implementation
46
47uses
48 ClientTools, Tribes;
49
50{$R *.lfm}
51
52const
53 MaxLines = 1000;
54
55procedure TLogDlg.FormCreate(Sender: TObject);
56begin
57 MaxLevel := 0;
58end;
59
60procedure TLogDlg.mLogClick(Sender: TObject);
61begin
62 MaxLevel := TMenuItem(Sender).Tag;
63 TMenuItem(Sender).Checked := true;
64end;
65
66procedure TLogDlg.Add(Level, Turn: Integer; Text: pchar);
67begin
68 if (MaxLevel > 0) and (Level <= MaxLevel) or (Level = 1 shl 16 + 1) and
69 mInvalid.Checked or (Level = 1 shl 16 + 2) and mTime.Checked or
70 (Level = 1 shl 16 + 3) and mNegotiation.Checked then
71 begin
72 if List.Lines.Count = MaxLines then
73 List.Lines.Delete(0);
74 List.Lines.Add(char(48 + Turn div 100 mod 10) +
75 char(48 + Turn div 10 mod 10) + char(48 + Turn mod 10) + ' ' + Text);
76 PostMessage(List.Handle, WM_VSCROLL, SB_BOTTOM, 0);
77 Update;
78 end;
79end;
80
81procedure TLogDlg.mClearClick(Sender: TObject);
82begin
83 List.Clear;
84end;
85
86procedure TLogDlg.mSlotClick(Sender: TObject);
87const
88 SlotNo: array [0 .. 2, 0 .. 2] of Integer = ((8, 1, 2), (7, 0, 3), (6, 5, 4));
89var
90 X, Y: Integer;
91 s: string;
92begin
93 for Y := 0 to 2 do
94 begin
95 s := '| ';
96 for X := 0 to 2 do
97 if G.Difficulty[SlotNo[Y, X]] = 0 then
98 s := s + 'SUP |'
99 else if G.Difficulty[SlotNo[Y, X]] < 0 then
100 s := s + '--- |'
101 else
102 begin
103 if SlotNo[Y, X] in [6 .. 8] then
104 begin // check multi control
105 if G.Difficulty[SlotNo[Y, X] + 3] >= 0 then
106 s := s + Tribe[SlotNo[Y, X] + 3].TPhrase('SHORTNAME') + '+';
107 if G.Difficulty[SlotNo[Y, X] + 6] >= 0 then
108 s := s + Tribe[SlotNo[Y, X] + 6].TPhrase('SHORTNAME') + '+';
109 end;
110 s := s + Tribe[SlotNo[Y, X]].TPhrase('SHORTNAME') + ' | ';
111 end;
112 List.Lines.Add(s)
113 end;
114 PostMessage(List.Handle, WM_VSCROLL, SB_BOTTOM, 0);
115end;
116
117procedure TLogDlg.FormKeyDown(Sender: TObject; var Key: word;
118 Shift: TShiftState);
119begin
120 if Host <> nil then
121 Host.OnKeyDown(Sender, Key, Shift);
122end;
123
124procedure TLogDlg.Toggle(Sender: TObject);
125begin
126 TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;
127end;
128
129procedure TLogDlg.ListMouseDown(Sender: TObject; Button: TMouseButton;
130 Shift: TShiftState; X, Y: Integer);
131begin
132 if Button = mbRight then
133 LogPopup.Popup(Left + X, Top + Y);
134end;
135
136procedure TLogDlg.FormKeyUp(Sender: TObject; var Key: word; Shift: TShiftState);
137begin
138 if Host <> nil then
139 Host.OnKeyUp(Sender, Key, Shift);
140end;
141
142end.
Note: See TracBrowser for help on using the repository browser.