Changeset 34 for trunk/Forms
- Timestamp:
- Nov 25, 2017, 12:27:33 AM (7 years ago)
- Location:
- trunk
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk
- Property svn:ignore
-
old new 3 3 backup 4 4 tunneler.exe 5 tunneler.dbg 6 tunneler.lps 5 7 heaptrclog.trc 6 tunneler.lps 8 Components/Common/Languages/*.mo 9 Components/CoolTranslator/Demo/lib
-
- Property svn:ignore
-
trunk/Forms/UMainForm.lfm
r31 r34 1 1 object MainForm: TMainForm 2 Left = 4702 Left = 886 3 3 Height = 412 4 Top = 1504 Top = 378 5 5 Width = 514 6 6 Caption = 'Tunneler' 7 ClientHeight = 38 77 ClientHeight = 383 8 8 ClientWidth = 514 9 9 Menu = MainMenu1 … … 15 15 OnKeyUp = FormKeyUp 16 16 OnShow = FormShow 17 LCLVersion = '1. 1'17 LCLVersion = '1.5' 18 18 object StatusBar1: TStatusBar 19 19 Left = 0 20 Height = 2 121 Top = 3 6620 Height = 29 21 Top = 354 22 22 Width = 514 23 23 Panels = < … … 47 47 object Image1: TImage 48 48 Left = 0 49 Height = 3 6649 Height = 354 50 50 Top = 0 51 51 Width = 514 -
trunk/Forms/UMainForm.pas
r33 r34 8 8 Registry, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, 9 9 ComCtrls, Menus, ActnList, UCore, UPlatform, Math, DateUtils, GraphType, 10 UPersistentForm, UApplicationInfo, UCoolTranslator, LCLType ;10 UPersistentForm, UApplicationInfo, UCoolTranslator, LCLType, URegistry; 11 11 12 12 type … … 53 53 procedure TimerDrawTimer(Sender: TObject); 54 54 procedure TimerEngineTickTimer(Sender: TObject); 55 procedure EraseBackground(DC: HDC); override;56 55 private 57 56 OriginalBounds: TRect; … … 64 63 PersistentForm: TPersistentForm; 65 64 Engine: TEngine; 66 end; 65 procedure EraseBackground(DC: HDC); override; 66 end; 67 67 68 68 var … … 89 89 StartTime := NowPrecise; 90 90 //Engine.Draw; 91 DrawDuration := NowPrecise - StartTime;92 91 try 93 92 Engine.Lock.Acquire; … … 95 94 // IntToStr(TPlayer(Engine.Players[0]).Position.Y) + ' ' + 96 95 // IntToStr(TPlayer(Engine.Players[0]).Direction); 97 StatusBar1.Panels[2].Text := FloatToStr(RoundTo( DrawDuration / OneMillisecond, -2));96 StatusBar1.Panels[2].Text := FloatToStr(RoundTo(Engine.DrawDuration / OneMillisecond, -2)); 98 97 StatusBar1.Panels[3].Text := Format(SRound, [IntToStr(Engine.CurrentRound), 99 98 IntToStr(Engine.MaxRound)]); … … 118 117 procedure TMainForm.FormCreate(Sender: TObject); 119 118 begin 120 PersistentForm := TPersistentForm.Create ;121 PersistentForm.Registry Key := ApplicationInfo1.RegistryKey;122 PersistentForm.RegistryRootKey := HKEY(ApplicationInfo1.RegistryRoot);119 PersistentForm := TPersistentForm.Create(nil); 120 PersistentForm.RegistryContext := RegContext(HKEY(ApplicationInfo1.RegistryRoot), 121 ApplicationInfo1.RegistryKey); 123 122 124 123 Application.OnDeactivate := FormDeactivate; … … 130 129 Engine.Active := True; 131 130 Image1Resize(Self); 131 132 Image1.ControlStyle := Image1.ControlStyle + [csOpaque]; 132 133 end; 133 134 … … 172 173 procedure TMainForm.ANewGameExecute(Sender: TObject); 173 174 begin 174 if NewGameForm.ShowModal = mrOk then Engine.NewGame; 175 NewGameForm.LoadData(Engine); 176 if NewGameForm.ShowModal = mrOk then begin 177 NewGameForm.SaveData(Engine); 178 Engine.NewGame; 179 end; 175 180 end; 176 181 … … 212 217 PersistentForm.Load(Self); 213 218 CoolTranslator1.Language := CoolTranslator1.Languages.SearchByCode('cs'); 214 DebugForm.Show;215 219 end; 216 220 -
trunk/Forms/UNewGameForm.lfm
r23 r34 1 1 object NewGameForm: TNewGameForm 2 Left = 3123 Height = 3874 Top = 1375 Width = 5602 Left = 579 3 Height = 434 4 Top = 226 5 Width = 677 6 6 Caption = 'New game' 7 ClientHeight = 387 8 ClientWidth = 560 7 ClientHeight = 434 8 ClientWidth = 677 9 OnCreate = FormCreate 10 OnDestroy = FormDestroy 9 11 OnShow = FormShow 10 LCLVersion = ' 0.9.31'12 LCLVersion = '1.8.0.4' 11 13 object ButtonStart: TButton 12 Left = 47614 Left = 592 13 15 Height = 25 14 Top = 35816 Top = 400 15 17 Width = 75 16 18 Anchors = [akRight, akBottom] 17 19 Caption = 'Start' 18 20 ModalResult = 1 19 OnClick = ButtonStartClick20 21 TabOrder = 0 21 22 end 22 23 object ButtonCancel: TButton 23 Left = 38824 Left = 504 24 25 Height = 25 25 Top = 35826 Top = 400 26 27 Width = 75 27 28 Anchors = [akRight, akBottom] … … 32 33 object Label1: TLabel 33 34 Left = 8 34 Height = 1835 Top = 836 Width = 5335 Height = 26 36 Top = 0 37 Width = 66 37 38 Caption = 'Players:' 38 39 ParentColor = False … … 40 41 object ListView1: TListView 41 42 Left = 8 42 Height = 3 2043 Height = 368 43 44 Top = 24 44 45 Width = 368 46 Anchors = [akTop, akLeft, akBottom] 45 47 Checkboxes = True 46 48 Columns = < … … 54 56 item 55 57 Caption = 'Controls' 56 Width = 1 4758 Width = 151 57 59 end> 60 OwnerData = True 58 61 ReadOnly = True 59 62 RowSelect = True … … 61 64 ViewStyle = vsReport 62 65 OnChange = ListView1Change 66 OnData = ListView1Data 67 OnSelectItem = ListView1SelectItem 68 end 69 object ColorButton1: TColorButton 70 Left = 504 71 Height = 25 72 Top = 64 73 Width = 75 74 BorderWidth = 2 75 ButtonColorSize = 16 76 ButtonColor = clBlack 77 OnColorChanged = ColorButton1ColorChanged 78 end 79 object Label2: TLabel 80 Left = 400 81 Height = 26 82 Top = 67 83 Width = 50 84 Caption = 'Color:' 85 ParentColor = False 86 end 87 object GroupBox1: TGroupBox 88 Left = 392 89 Height = 264 90 Top = 104 91 Width = 272 92 Caption = 'Control keys' 93 ClientHeight = 236 94 ClientWidth = 268 95 TabOrder = 3 96 object EditUp: TEdit 97 Left = 86 98 Height = 36 99 Top = 2 100 Width = 80 101 OnChange = EditUpChange 102 OnKeyDown = EditUpKeyDown 103 TabOrder = 0 104 end 105 object Label3: TLabel 106 Left = 6 107 Height = 26 108 Top = 10 109 Width = 29 110 Caption = 'Up:' 111 ParentColor = False 112 end 113 object Label4: TLabel 114 Left = 6 115 Height = 26 116 Top = 42 117 Width = 54 118 Caption = 'Down:' 119 ParentColor = False 120 end 121 object EditDown: TEdit 122 Left = 88 123 Height = 36 124 Top = 32 125 Width = 80 126 OnChange = EditDownChange 127 OnKeyDown = EditDownKeyDown 128 TabOrder = 1 129 end 130 object Label5: TLabel 131 Left = 6 132 Height = 26 133 Top = 74 134 Width = 37 135 Caption = 'Left:' 136 ParentColor = False 137 end 138 object EditLeft: TEdit 139 Left = 86 140 Height = 36 141 Top = 66 142 Width = 80 143 OnChange = EditLeftChange 144 OnKeyDown = EditLeftKeyDown 145 TabOrder = 2 146 end 147 object Label6: TLabel 148 Left = 6 149 Height = 26 150 Top = 106 151 Width = 50 152 Caption = 'Right:' 153 ParentColor = False 154 end 155 object EditRight: TEdit 156 Left = 86 157 Height = 36 158 Top = 98 159 Width = 80 160 OnChange = EditRightChange 161 OnKeyDown = EditRightKeyDown 162 TabOrder = 3 163 end 164 object Label7: TLabel 165 Left = 6 166 Height = 26 167 Top = 138 168 Width = 55 169 Caption = 'Shoot:' 170 ParentColor = False 171 end 172 object EditShoot: TEdit 173 Left = 86 174 Height = 36 175 Top = 130 176 Width = 80 177 OnChange = EditShootChange 178 OnKeyDown = EditShootKeyDown 179 TabOrder = 4 180 end 181 end 182 object EditName: TEdit 183 Left = 480 184 Height = 36 185 Top = 24 186 Width = 176 187 OnChange = EditNameChange 188 OnKeyDown = EditUpKeyDown 189 TabOrder = 4 190 end 191 object Label8: TLabel 192 Left = 400 193 Height = 26 194 Top = 32 195 Width = 56 196 Caption = 'Name:' 197 ParentColor = False 63 198 end 64 199 end -
trunk/Forms/UNewGameForm.lrt
r21 r34 6 6 TNEWGAMEFORM.LISTVIEW1.COLUMNS[1].CAPTION=Color 7 7 TNEWGAMEFORM.LISTVIEW1.COLUMNS[2].CAPTION=Controls 8 TNEWGAMEFORM.LABEL2.CAPTION=Color: 9 TNEWGAMEFORM.GROUPBOX1.CAPTION=Control keys 10 TNEWGAMEFORM.LABEL3.CAPTION=Up: 11 TNEWGAMEFORM.LABEL4.CAPTION=Down: 12 TNEWGAMEFORM.LABEL5.CAPTION=Left: 13 TNEWGAMEFORM.LABEL6.CAPTION=Right: 14 TNEWGAMEFORM.LABEL7.CAPTION=Shoot: 15 TNEWGAMEFORM.LABEL8.CAPTION=Name: -
trunk/Forms/UNewGameForm.pas
r24 r34 7 7 uses 8 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 9 ComCtrls ;9 ComCtrls, UCore; 10 10 11 11 type … … 16 16 ButtonStart: TButton; 17 17 ButtonCancel: TButton; 18 ColorButton1: TColorButton; 19 EditUp: TEdit; 20 EditDown: TEdit; 21 EditLeft: TEdit; 22 EditRight: TEdit; 23 EditShoot: TEdit; 24 EditName: TEdit; 25 GroupBox1: TGroupBox; 18 26 Label1: TLabel; 27 Label2: TLabel; 28 Label3: TLabel; 29 Label4: TLabel; 30 Label5: TLabel; 31 Label6: TLabel; 32 Label7: TLabel; 33 Label8: TLabel; 19 34 ListView1: TListView; 20 procedure ButtonStartClick(Sender: TObject); 35 procedure ColorButton1ColorChanged(Sender: TObject); 36 procedure EditDownChange(Sender: TObject); 37 procedure EditDownKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState 38 ); 39 procedure EditLeftChange(Sender: TObject); 40 procedure EditLeftKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState 41 ); 42 procedure EditNameChange(Sender: TObject); 43 procedure EditRightChange(Sender: TObject); 44 procedure EditRightKeyDown(Sender: TObject; var Key: Word; 45 Shift: TShiftState); 46 procedure EditShootChange(Sender: TObject); 47 procedure EditShootKeyDown(Sender: TObject; var Key: Word; 48 Shift: TShiftState); 49 procedure EditUpChange(Sender: TObject); 50 procedure EditUpKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 51 procedure FormCreate(Sender: TObject); 52 procedure FormDestroy(Sender: TObject); 21 53 procedure FormShow(Sender: TObject); 22 54 procedure ListView1Change(Sender: TObject; Item: TListItem; 23 55 Change: TItemChange); 56 procedure ListView1Data(Sender: TObject; Item: TListItem); 57 procedure ListView1SelectItem(Sender: TObject; Item: TListItem; 58 Selected: Boolean); 24 59 private 25 { private declarations } 60 Players: TPlayers; 61 procedure ReloadList; 26 62 public 27 { public declarations } 63 procedure LoadData(Engine: TEngine); 64 procedure SaveData(Engine: TEngine); 28 65 end; 29 66 … … 34 71 35 72 uses 36 U Core, UMainForm;73 UMainForm; 37 74 38 75 {$R *.lfm} … … 47 84 end; 48 85 49 procedure TNewGameForm.ButtonStartClick(Sender: TObject); 50 begin 51 86 procedure TNewGameForm.ListView1Data(Sender: TObject; Item: TListItem); 87 begin 88 if Item.Index < Players.Count then 89 with TPlayer(Players[Item.Index]) do begin 90 Item.Caption := Name; 91 Item.SubItems.Add(IntToHex(Color, 6)); 92 Item.SubItems.Add(''); 93 Item.Checked := Enabled; 94 Item.Data := Pointer(Players[Item.Index]); 95 end; 96 end; 97 98 procedure TNewGameForm.ListView1SelectItem(Sender: TObject; Item: TListItem; 99 Selected: Boolean); 100 begin 101 if Assigned(Item) and Selected then 102 with TPlayer(Item.Data) do begin 103 EditName.Text := Name; 104 ColorButton1.ButtonColor := Color; 105 EditDown.Text := IntToStr(Keys.Down); 106 EditUp.Text := IntToStr(Keys.Up); 107 EditLeft.Text := IntToStr(Keys.Left); 108 EditRight.Text := IntToStr(Keys.Right); 109 EditShoot.Text := IntToStr(Keys.Shoot); 110 end; 111 end; 112 113 procedure TNewGameForm.ReloadList; 114 begin 115 ListView1.Items.Count := Players.Count; 116 ListView1.Refresh; 117 end; 118 119 procedure TNewGameForm.LoadData(Engine: TEngine); 120 begin 121 Players.Assign(Engine.PlayerPool); 122 end; 123 124 procedure TNewGameForm.SaveData(Engine: TEngine); 125 begin 126 Engine.PlayerPool.Assign(Players); 127 end; 128 129 procedure TNewGameForm.ColorButton1ColorChanged(Sender: TObject); 130 begin 131 if Assigned(ListView1.Selected) then 132 with TPlayer(ListView1.Selected.Data) do begin 133 Color := ColorButton1.ButtonColor; 134 ReloadList; 135 end; 136 end; 137 138 procedure TNewGameForm.EditDownChange(Sender: TObject); 139 var 140 Value: Integer; 141 begin 142 if Assigned(ListView1.Selected) then 143 with TPlayer(ListView1.Selected.Data) do begin 144 if TryStrToInt(EditDown.Text, Value) then Keys.Down := Value; 145 ReloadList; 146 end; 147 end; 148 149 procedure TNewGameForm.EditDownKeyDown(Sender: TObject; var Key: Word; 150 Shift: TShiftState); 151 begin 152 EditDown.Text := IntToStr(Key); 153 end; 154 155 procedure TNewGameForm.EditLeftChange(Sender: TObject); 156 var 157 Value: Integer; 158 begin 159 if Assigned(ListView1.Selected) then 160 with TPlayer(ListView1.Selected.Data) do begin 161 if TryStrToInt(EditLeft.Text, Value) then Keys.Left := Value; 162 ReloadList; 163 end; 164 end; 165 166 procedure TNewGameForm.EditLeftKeyDown(Sender: TObject; var Key: Word; 167 Shift: TShiftState); 168 begin 169 EditLeft.Text := IntToStr(Key); 170 end; 171 172 procedure TNewGameForm.EditNameChange(Sender: TObject); 173 begin 174 if Assigned(ListView1.Selected) then 175 with TPlayer(ListView1.Selected.Data) do begin 176 Name := EditName.Text; 177 ReloadList; 178 end; 179 end; 180 181 procedure TNewGameForm.EditRightChange(Sender: TObject); 182 var 183 Value: Integer; 184 begin 185 if Assigned(ListView1.Selected) then 186 with TPlayer(ListView1.Selected.Data) do begin 187 if TryStrToInt(EditRight.Text, Value) then Keys.Right := Value; 188 ReloadList; 189 end; 190 end; 191 192 procedure TNewGameForm.EditRightKeyDown(Sender: TObject; var Key: Word; 193 Shift: TShiftState); 194 begin 195 EditRight.Text := IntToStr(Key); 196 end; 197 198 procedure TNewGameForm.EditShootChange(Sender: TObject); 199 var 200 Value: Integer; 201 begin 202 if Assigned(ListView1.Selected) then 203 with TPlayer(ListView1.Selected.Data) do begin 204 if TryStrToInt(EditShoot.Text, Value) then Keys.Shoot := Value; 205 ReloadList; 206 end; 207 end; 208 209 procedure TNewGameForm.EditShootKeyDown(Sender: TObject; var Key: Word; 210 Shift: TShiftState); 211 begin 212 EditShoot.Text := IntToStr(Key); 213 end; 214 215 procedure TNewGameForm.EditUpChange(Sender: TObject); 216 var 217 Value: Integer; 218 begin 219 if Assigned(ListView1.Selected) then 220 with TPlayer(ListView1.Selected.Data) do begin 221 if TryStrToInt(EditUp.Text, Value) then Keys.Up := Value; 222 ReloadList; 223 end; 224 end; 225 226 procedure TNewGameForm.EditUpKeyDown(Sender: TObject; var Key: Word; 227 Shift: TShiftState); 228 begin 229 EditUp.Text := IntToStr(Key); 230 end; 231 232 procedure TNewGameForm.FormCreate(Sender: TObject); 233 begin 234 Players := TPlayers.Create 235 end; 236 237 procedure TNewGameForm.FormDestroy(Sender: TObject); 238 begin 239 FreeAndNil(Players); 52 240 end; 53 241 54 242 procedure TNewGameForm.FormShow(Sender: TObject); 55 var 56 NewItem: TListItem; 57 I: Integer; 58 begin 59 with ListView1 do try 60 BeginUpdate; 61 Clear; 62 for I := 0 to MainForm.Engine.PlayerPool.Count - 1 do 63 with TPlayer(MainForm.Engine.PlayerPool[I]) do begin 64 NewItem := Items.Add; 65 NewItem.Caption := Name; 66 NewItem.SubItems.Add(IntToStr(Color)); 67 NewItem.SubItems.Add(''); 68 NewItem.Checked := Enabled; 69 NewItem.Data := Pointer(Engine.PlayerPool[I]); 70 end; 71 finally 72 EndUpdate; 73 end; 243 begin 244 ReloadList; 74 245 end; 75 246
Note:
See TracChangeset
for help on using the changeset viewer.