Changeset 34 for trunk/Forms


Ignore:
Timestamp:
Nov 25, 2017, 12:27:33 AM (7 years ago)
Author:
chronos
Message:
  • Modified: Improved New game window.
  • Modified: Used newer version of Common and CoolTranslator packages.
Location:
trunk
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • trunk

    • Property svn:ignore
      •  

        old new  
        33backup
        44tunneler.exe
         5tunneler.dbg
         6tunneler.lps
        57heaptrclog.trc
        6 tunneler.lps
         8Components/Common/Languages/*.mo
         9Components/CoolTranslator/Demo/lib
  • trunk/Forms/UMainForm.lfm

    r31 r34  
    11object MainForm: TMainForm
    2   Left = 470
     2  Left = 886
    33  Height = 412
    4   Top = 150
     4  Top = 378
    55  Width = 514
    66  Caption = 'Tunneler'
    7   ClientHeight = 387
     7  ClientHeight = 383
    88  ClientWidth = 514
    99  Menu = MainMenu1
     
    1515  OnKeyUp = FormKeyUp
    1616  OnShow = FormShow
    17   LCLVersion = '1.1'
     17  LCLVersion = '1.5'
    1818  object StatusBar1: TStatusBar
    1919    Left = 0
    20     Height = 21
    21     Top = 366
     20    Height = 29
     21    Top = 354
    2222    Width = 514
    2323    Panels = <   
     
    4747  object Image1: TImage
    4848    Left = 0
    49     Height = 366
     49    Height = 354
    5050    Top = 0
    5151    Width = 514
  • trunk/Forms/UMainForm.pas

    r33 r34  
    88  Registry, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
    99  ComCtrls, Menus, ActnList, UCore, UPlatform, Math, DateUtils, GraphType,
    10   UPersistentForm, UApplicationInfo, UCoolTranslator, LCLType;
     10  UPersistentForm, UApplicationInfo, UCoolTranslator, LCLType, URegistry;
    1111
    1212type
     
    5353    procedure TimerDrawTimer(Sender: TObject);
    5454    procedure TimerEngineTickTimer(Sender: TObject);
    55     procedure EraseBackground(DC: HDC); override;
    5655  private
    5756    OriginalBounds: TRect;
     
    6463    PersistentForm: TPersistentForm;
    6564    Engine: TEngine;
    66   end;
     65    procedure EraseBackground(DC: HDC); override;
     66  end;
    6767
    6868var
     
    8989    StartTime := NowPrecise;
    9090    //Engine.Draw;
    91     DrawDuration := NowPrecise - StartTime;
    9291    try
    9392      Engine.Lock.Acquire;
     
    9594      //  IntToStr(TPlayer(Engine.Players[0]).Position.Y) + ' ' +
    9695      //  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));
    9897      StatusBar1.Panels[3].Text := Format(SRound, [IntToStr(Engine.CurrentRound),
    9998        IntToStr(Engine.MaxRound)]);
     
    118117procedure TMainForm.FormCreate(Sender: TObject);
    119118begin
    120   PersistentForm := TPersistentForm.Create;
    121   PersistentForm.RegistryKey := ApplicationInfo1.RegistryKey;
    122   PersistentForm.RegistryRootKey := HKEY(ApplicationInfo1.RegistryRoot);
     119  PersistentForm := TPersistentForm.Create(nil);
     120  PersistentForm.RegistryContext := RegContext(HKEY(ApplicationInfo1.RegistryRoot),
     121    ApplicationInfo1.RegistryKey);
    123122
    124123  Application.OnDeactivate := FormDeactivate;
     
    130129  Engine.Active := True;
    131130  Image1Resize(Self);
     131
     132  Image1.ControlStyle := Image1.ControlStyle + [csOpaque];
    132133end;
    133134
     
    172173procedure TMainForm.ANewGameExecute(Sender: TObject);
    173174begin
    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;
    175180end;
    176181
     
    212217  PersistentForm.Load(Self);
    213218  CoolTranslator1.Language := CoolTranslator1.Languages.SearchByCode('cs');
    214   DebugForm.Show;
    215219end;
    216220
  • trunk/Forms/UNewGameForm.lfm

    r23 r34  
    11object NewGameForm: TNewGameForm
    2   Left = 312
    3   Height = 387
    4   Top = 137
    5   Width = 560
     2  Left = 579
     3  Height = 434
     4  Top = 226
     5  Width = 677
    66  Caption = 'New game'
    7   ClientHeight = 387
    8   ClientWidth = 560
     7  ClientHeight = 434
     8  ClientWidth = 677
     9  OnCreate = FormCreate
     10  OnDestroy = FormDestroy
    911  OnShow = FormShow
    10   LCLVersion = '0.9.31'
     12  LCLVersion = '1.8.0.4'
    1113  object ButtonStart: TButton
    12     Left = 476
     14    Left = 592
    1315    Height = 25
    14     Top = 358
     16    Top = 400
    1517    Width = 75
    1618    Anchors = [akRight, akBottom]
    1719    Caption = 'Start'
    1820    ModalResult = 1
    19     OnClick = ButtonStartClick
    2021    TabOrder = 0
    2122  end
    2223  object ButtonCancel: TButton
    23     Left = 388
     24    Left = 504
    2425    Height = 25
    25     Top = 358
     26    Top = 400
    2627    Width = 75
    2728    Anchors = [akRight, akBottom]
     
    3233  object Label1: TLabel
    3334    Left = 8
    34     Height = 18
    35     Top = 8
    36     Width = 53
     35    Height = 26
     36    Top = 0
     37    Width = 66
    3738    Caption = 'Players:'
    3839    ParentColor = False
     
    4041  object ListView1: TListView
    4142    Left = 8
    42     Height = 320
     43    Height = 368
    4344    Top = 24
    4445    Width = 368
     46    Anchors = [akTop, akLeft, akBottom]
    4547    Checkboxes = True
    4648    Columns = <   
     
    5456      item
    5557        Caption = 'Controls'
    56         Width = 147
     58        Width = 151
    5759      end>
     60    OwnerData = True
    5861    ReadOnly = True
    5962    RowSelect = True
     
    6164    ViewStyle = vsReport
    6265    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
    63198  end
    64199end
  • trunk/Forms/UNewGameForm.lrt

    r21 r34  
    66TNEWGAMEFORM.LISTVIEW1.COLUMNS[1].CAPTION=Color
    77TNEWGAMEFORM.LISTVIEW1.COLUMNS[2].CAPTION=Controls
     8TNEWGAMEFORM.LABEL2.CAPTION=Color:
     9TNEWGAMEFORM.GROUPBOX1.CAPTION=Control keys
     10TNEWGAMEFORM.LABEL3.CAPTION=Up:
     11TNEWGAMEFORM.LABEL4.CAPTION=Down:
     12TNEWGAMEFORM.LABEL5.CAPTION=Left:
     13TNEWGAMEFORM.LABEL6.CAPTION=Right:
     14TNEWGAMEFORM.LABEL7.CAPTION=Shoot:
     15TNEWGAMEFORM.LABEL8.CAPTION=Name:
  • trunk/Forms/UNewGameForm.pas

    r24 r34  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    9   ComCtrls;
     9  ComCtrls, UCore;
    1010
    1111type
     
    1616    ButtonStart: TButton;
    1717    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;
    1826    Label1: TLabel;
     27    Label2: TLabel;
     28    Label3: TLabel;
     29    Label4: TLabel;
     30    Label5: TLabel;
     31    Label6: TLabel;
     32    Label7: TLabel;
     33    Label8: TLabel;
    1934    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);
    2153    procedure FormShow(Sender: TObject);
    2254    procedure ListView1Change(Sender: TObject; Item: TListItem;
    2355      Change: TItemChange);
     56    procedure ListView1Data(Sender: TObject; Item: TListItem);
     57    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
     58      Selected: Boolean);
    2459  private
    25     { private declarations }
     60    Players: TPlayers;
     61    procedure ReloadList;
    2662  public
    27     { public declarations }
     63    procedure LoadData(Engine: TEngine);
     64    procedure SaveData(Engine: TEngine);
    2865  end;
    2966
     
    3471
    3572uses
    36   UCore, UMainForm;
     73  UMainForm;
    3774
    3875{$R *.lfm}
     
    4784end;
    4885
    49 procedure TNewGameForm.ButtonStartClick(Sender: TObject);
    50 begin
    51 
     86procedure TNewGameForm.ListView1Data(Sender: TObject; Item: TListItem);
     87begin
     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;
     96end;
     97
     98procedure TNewGameForm.ListView1SelectItem(Sender: TObject; Item: TListItem;
     99  Selected: Boolean);
     100begin
     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;
     111end;
     112
     113procedure TNewGameForm.ReloadList;
     114begin
     115  ListView1.Items.Count := Players.Count;
     116  ListView1.Refresh;
     117end;
     118
     119procedure TNewGameForm.LoadData(Engine: TEngine);
     120begin
     121  Players.Assign(Engine.PlayerPool);
     122end;
     123
     124procedure TNewGameForm.SaveData(Engine: TEngine);
     125begin
     126  Engine.PlayerPool.Assign(Players);
     127end;
     128
     129procedure TNewGameForm.ColorButton1ColorChanged(Sender: TObject);
     130begin
     131  if Assigned(ListView1.Selected) then
     132  with TPlayer(ListView1.Selected.Data) do begin
     133    Color := ColorButton1.ButtonColor;
     134    ReloadList;
     135  end;
     136end;
     137
     138procedure TNewGameForm.EditDownChange(Sender: TObject);
     139var
     140  Value: Integer;
     141begin
     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;
     147end;
     148
     149procedure TNewGameForm.EditDownKeyDown(Sender: TObject; var Key: Word;
     150  Shift: TShiftState);
     151begin
     152  EditDown.Text := IntToStr(Key);
     153end;
     154
     155procedure TNewGameForm.EditLeftChange(Sender: TObject);
     156var
     157  Value: Integer;
     158begin
     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;
     164end;
     165
     166procedure TNewGameForm.EditLeftKeyDown(Sender: TObject; var Key: Word;
     167  Shift: TShiftState);
     168begin
     169  EditLeft.Text := IntToStr(Key);
     170end;
     171
     172procedure TNewGameForm.EditNameChange(Sender: TObject);
     173begin
     174  if Assigned(ListView1.Selected) then
     175  with TPlayer(ListView1.Selected.Data) do begin
     176    Name := EditName.Text;
     177    ReloadList;
     178  end;
     179end;
     180
     181procedure TNewGameForm.EditRightChange(Sender: TObject);
     182var
     183  Value: Integer;
     184begin
     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;
     190end;
     191
     192procedure TNewGameForm.EditRightKeyDown(Sender: TObject; var Key: Word;
     193  Shift: TShiftState);
     194begin
     195  EditRight.Text := IntToStr(Key);
     196end;
     197
     198procedure TNewGameForm.EditShootChange(Sender: TObject);
     199var
     200  Value: Integer;
     201begin
     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;
     207end;
     208
     209procedure TNewGameForm.EditShootKeyDown(Sender: TObject; var Key: Word;
     210  Shift: TShiftState);
     211begin
     212  EditShoot.Text := IntToStr(Key);
     213end;
     214
     215procedure TNewGameForm.EditUpChange(Sender: TObject);
     216var
     217  Value: Integer;
     218begin
     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;
     224end;
     225
     226procedure TNewGameForm.EditUpKeyDown(Sender: TObject; var Key: Word;
     227  Shift: TShiftState);
     228begin
     229  EditUp.Text := IntToStr(Key);
     230end;
     231
     232procedure TNewGameForm.FormCreate(Sender: TObject);
     233begin
     234  Players := TPlayers.Create
     235end;
     236
     237procedure TNewGameForm.FormDestroy(Sender: TObject);
     238begin
     239  FreeAndNil(Players);
    52240end;
    53241
    54242procedure 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;
     243begin
     244  ReloadList;
    74245end;
    75246
Note: See TracChangeset for help on using the changeset viewer.