Subversion Repositories jumper

Rev

Rev 18 | Rev 22 | Go to most recent revision | Only display areas with differences | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 18 Rev 21
1 
unit Choice;
 1 
unit Choice;
2 
 
 2 
 
3 
interface
 3 
interface
4 
 
 4 
 
5 
uses
 5 
uses
6 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 6 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
7 
  Dialogs, StdCtrls, ImgList, ComCtrls, Menus, ExtCtrls, System.ImageList;
 7 
  Dialogs, StdCtrls, ImgList, ComCtrls, Menus, ExtCtrls, System.ImageList, LevelFunctions;
8 
 
 8 
 
9 
type
 9 
type
10 
  TLevelChoice = class(TForm)
 10 
  TLevelChoice = class(TForm)
11 
    PlayBtn: TButton;
 11 
    PlayBtn: TButton;
12 
    CancelBtn: TButton;
 12 
    CancelBtn: TButton;
13 
    LevelImageList: TImageList;
 13 
    LevelImageList: TImageList;
14 
    LevelPopupMenu: TPopupMenu;
 14 
    LevelPopupMenu: TPopupMenu;
15 
    PLoadLevel: TMenuItem;
 15 
    PLoadLevel: TMenuItem;
16 
    PRefreshList: TMenuItem;
 16 
    PRefreshList: TMenuItem;
17 
    PreviewGrp: TGroupBox;
 17 
    PreviewGrp: TGroupBox;
18 
    PreviewImage: TImage;
 18 
    PreviewImage: TImage;
19 
    LevelGrp: TGroupBox;
 19 
    LevelGrp: TGroupBox;
20 
    LevelList: TListView;
 20 
    LevelList: TListView;
21 
    procedure PlayBtnClick(Sender: TObject);
 21 
    procedure PlayBtnClick(Sender: TObject);
22 
    procedure CancelBtnClick(Sender: TObject);
 22 
    procedure CancelBtnClick(Sender: TObject);
23 
    procedure FormShow(Sender: TObject);
 23 
    procedure FormShow(Sender: TObject);
24 
    procedure LevelListClick(Sender: TObject);
 24 
    procedure LevelListClick(Sender: TObject);
25 
    procedure LevelListChange(Sender: TObject; Item: TListItem;
 25 
    procedure LevelListChange(Sender: TObject; Item: TListItem; Change: TItemChange);
26 
      Change: TItemChange);
 - 
 
27 
    procedure PRefreshListClick(Sender: TObject);
 26 
    procedure PRefreshListClick(Sender: TObject);
28 
    procedure FormResize(Sender: TObject);
 - 
 
29 
    procedure FormCreate(Sender: TObject);
 27 
    procedure FormCreate(Sender: TObject);
30 
  private
 28 
  private
31 
    procedure RefreshList;
 29 
    procedure RefreshList;
- 
 
 30 
    procedure DrawLevelPreview(Level: TLevel);
32 
  public
 31 
  public
33 
    function SelectedLevel: string;
 32 
    function SelectedLevel: string;
34 
  end;
 33 
  end;
35 
 
 34 
 
36 
var
 35 
var
37 
  LevelChoice: TLevelChoice;
 36 
  LevelChoice: TLevelChoice;
38 
 
 37 
 
39 
implementation
 38 
implementation
40 
 
 39 
 
41 
{$R *.dfm}
 40 
{$R *.dfm}
42 
 
 41 
 
43 
uses
 42 
uses
44 
  Functions, LevelFunctions, Constants;
 43 
  Functions, Constants;
- 
 
 44 
 
- 
 
 45 
procedure TLevelChoice.DrawLevelPreview(Level: TLevel);
- 
 
 46 
var
- 
 
 47 
  LevelArray: TLevelArray;
- 
 
 48 
  y, x: integer;
- 
 
 49 
  t: TFieldType;
- 
 
 50 
  indent: Integer;
- 
 
 51 
  Image: TImage;
- 
 
 52 
  BackgroundColor: TColor;
- 
 
 53 
const
- 
 
 54 
  PREVIEW_BLOCK_SIZE = 10; // Enthält Field und Abstand
- 
 
 55 
  PREVIEW_TAB_SIZE = PREVIEW_BLOCK_SIZE div 2; // 5
- 
 
 56 
begin
- 
 
 57 
  Image := PreviewImage;
- 
 
 58 
  BackgroundColor := Self.Color;
- 
 
 59 
 
- 
 
 60 
  LevelArray := nil;
- 
 
 61 
 
- 
 
 62 
  ClearImage(Image, BackgroundColor);
- 
 
 63 
 
- 
 
 64 
  LevelArray := Level.LevelStringToLevelArray(false);
- 
 
 65 
 
- 
 
 66 
  for y := Low(LevelArray) to High(LevelArray) do
- 
 
 67 
  begin
- 
 
 68 
    for x := Low(LevelArray[y].Fields) to High(LevelArray[y].Fields) do
- 
 
 69 
    begin
- 
 
 70 
      t      := LevelArray[y].Fields[x].Typ;
- 
 
 71 
      indent := LevelArray[y].Indent;
- 
 
 72 
 
- 
 
 73 
      case t of
- 
 
 74 
        ftFullSpace: Image.Canvas.Brush.Color := BackgroundColor;
- 
 
 75 
        ftEmpty:     Image.Canvas.Brush.Color := clWhite;
- 
 
 76 
        ftGreen:     Image.Canvas.Brush.Color := clLime;
- 
 
 77 
        ftYellow:    Image.Canvas.Brush.Color := clYellow;
- 
 
 78 
        ftRed:       Image.Canvas.Brush.Color := clRed;
- 
 
 79 
      end;
- 
 
 80 
 
- 
 
 81 
      if LevelArray[y].Fields[x].Goal then
- 
 
 82 
        Image.Canvas.Pen.Color := clBlack
- 
 
 83 
      else
- 
 
 84 
        Image.Canvas.Pen.Color := BackgroundColor;
- 
 
 85 
 
- 
 
 86 
      Image.Canvas.Rectangle(x*PREVIEW_BLOCK_SIZE + indent*PREVIEW_TAB_SIZE,
- 
 
 87 
                             y*PREVIEW_BLOCK_SIZE,
- 
 
 88 
                             x*PREVIEW_BLOCK_SIZE + indent*PREVIEW_TAB_SIZE + PREVIEW_BLOCK_SIZE,
- 
 
 89 
                             y*PREVIEW_BLOCK_SIZE                           + PREVIEW_BLOCK_SIZE);
- 
 
 90 
    end;
- 
 
 91 
  end;
- 
 
 92 
end;
45 
 
 93 
 
46 
function TLevelChoice.SelectedLevel: string;
 94 
function TLevelChoice.SelectedLevel: string;
47 
begin
 95 
begin
48 
  result := Format(LVL_FILE, [LevelList.Selected.Caption]);
 96 
  result := Format(LVL_FILE, [LevelList.Selected.Caption]);
49 
end;
 97 
end;
50 
 
 98 
 
51 
procedure TLevelChoice.PlayBtnClick(Sender: TObject);
 99 
procedure TLevelChoice.PlayBtnClick(Sender: TObject);
52 
var
 100 
var
53 
  Level: TLevel;
 101 
  Level: TLevel;
54 
begin
 102 
begin
55 
  if Assigned(LevelList.Selected) then
 103 
  if Assigned(LevelList.Selected) then
56 
  begin
 104 
  begin
57 
    if LevelList.Selected.ImageIndex = 2 then
 105 
    if LevelList.Selected.ImageIndex = 2 then
58 
    begin
 106 
    begin
59 
      Level := TLevel.Create(Format(LVL_FILE, [LevelList.Selected.Caption]));
 107 
      Level := TLevel.Create(Format(LVL_FILE, [LevelList.Selected.Caption]));
60 
      try
 108 
      try
61 
        if Level.CheckLevelIntegrity(true) <> leNone then
 109 
        if Level.CheckLevelIntegrity(true) <> leNone then
62 
        begin
 110 
        begin
63 
          exit;
 111 
          exit;
64 
        end;
 112 
        end;
65 
      finally
 113 
      finally
66 
        FreeAndNil(Level);
 114 
        FreeAndNil(Level);
67 
      end;
 115 
      end;
68 
    end;
 116 
    end;
69 
    ModalResult := mrOk;
 117 
    ModalResult := mrOk;
70 
  end;
 118 
  end;
71 
end;
 119 
end;
72 
 
 120 
 
73 
procedure TLevelChoice.CancelBtnClick(Sender: TObject);
 121 
procedure TLevelChoice.CancelBtnClick(Sender: TObject);
74 
begin
 122 
begin
75 
  ModalResult := mrCancel;
 123 
  ModalResult := mrCancel;
76 
end;
 124 
end;
77 
 
 125 
 
78 
procedure TLevelChoice.FormShow(Sender: TObject);
 126 
procedure TLevelChoice.FormShow(Sender: TObject);
79 
begin
 127 
begin
80 
  RefreshList;
 128 
  RefreshList;
81 
end;
 129 
end;
82 
 
 130 
 
83 
procedure TLevelChoice.LevelListClick(Sender: TObject);
 131 
procedure TLevelChoice.LevelListClick(Sender: TObject);
84 
var
 132 
var
85 
  LevelFile: string;
 133 
  LevelFile: string;
86 
  Level: TLevel;
 134 
  Level: TLevel;
87 
begin
 135 
begin
88 
  PlayBtn.Enabled := Assigned(LevelList.Selected);
 136 
  PlayBtn.Enabled := Assigned(LevelList.Selected);
89 
  PLoadLevel.Enabled := Assigned(LevelList.Selected);
 137 
  PLoadLevel.Enabled := Assigned(LevelList.Selected);
90 
 
 138 
 
91 
  if Assigned(LevelList.Selected) then
 139 
  if Assigned(LevelList.Selected) then
92 
  begin
 140 
  begin
93 
    LevelFile := Format(LVL_FILE, [LevelList.Selected.Caption]);
 141 
    LevelFile := Format(LVL_FILE, [LevelList.Selected.Caption]);
94 
    Level := TLevel.Create(LevelFile);
 142 
    Level := TLevel.Create(LevelFile);
95 
    try
 143 
    try
96 
      DrawLevelPreview(Level, PreviewImage, Color);
 144 
      DrawLevelPreview(Level);
97 
    finally
 145 
    finally
98 
      FreeAndNil(Level);
 146 
      FreeAndNil(Level);
99 
    end;
 147 
    end;
100 
  end
 148 
  end
101 
  else
 149 
  else
102 
  begin
 150 
  begin
103 
    ClearImage(PreviewImage, Color);
 151 
    ClearImage(PreviewImage, Color);
104 
  end;
 152 
  end;
105 
end;
 153 
end;
106 
 
 154 
 
107 
procedure TLevelChoice.LevelListChange(Sender: TObject; Item: TListItem;
 155 
procedure TLevelChoice.LevelListChange(Sender: TObject; Item: TListItem;
108 
  Change: TItemChange);
 156 
  Change: TItemChange);
109 
begin
 157 
begin
110 
  if Change = ctState then LevelListClick(self);
 158 
  if Change = ctState then LevelListClick(self);
111 
end;
 159 
end;
112 
 
 160 
 
113 
procedure TLevelChoice.PRefreshListClick(Sender: TObject);
 161 
procedure TLevelChoice.PRefreshListClick(Sender: TObject);
114 
begin
 162 
begin
115 
  RefreshList;
 163 
  RefreshList;
116 
end;
 164 
end;
117 
 
 165 
 
118 
procedure TLevelChoice.RefreshList;
 166 
procedure TLevelChoice.RefreshList;
119 
var
 167 
var
120 
  s: TSearchRec;
 168 
  s: TSearchRec;
121 
  Level: TLevel;
 169 
  Level: TLevel;
122 
begin
 170 
begin
123 
  LevelList.Clear;
 171 
  LevelList.Clear;
124 
 
 172 
 
125 
  // Levels auflisten
 173 
  // Levels auflisten
126 
  if FindFirst(Format(LVL_FILE, ['*']), faAnyFile, s) = 0 then
 174 
  if FindFirst(Format(LVL_FILE, ['*']), faAnyFile, s) = 0 then
127 
  begin
 175 
  begin
128 
    repeat
 176 
    repeat
129 
      with LevelList.Items.Add do
 177 
      with LevelList.Items.Add do
130 
      begin
 178 
      begin
131 
        Caption := Copy(s.Name, 1, Length(s.Name)-Length(LVL_EXT));
 179 
        Caption := Copy(s.Name, 1, Length(s.Name)-Length(LVL_EXT));
132 
        Level := TLevel.Create(LVL_PATH + s.Name);
 180 
        Level := TLevel.Create(LVL_PATH + s.Name);
133 
 
 181 
 
134 
        if Level.CheckLevelIntegrity <> leNone then
 182 
        if Level.CheckLevelIntegrity <> leNone then
135 
          ImageIndex := 2{Error}
 183 
          ImageIndex := 2{Error}
136 
        else case Level.GetGameMode of
 184 
        else case Level.GetGameMode of
137 
          gmNormal: ImageIndex := 0{Normal};
 185 
          gmNormal: ImageIndex := 0{Normal};
138 
          gmDiagonal: ImageIndex := 1{Diagonal};
 186 
          gmDiagonal: ImageIndex := 1{Diagonal};
139 
          gmUndefined: ImageIndex := 2{Error};
 187 
          gmUndefined: ImageIndex := 2{Error};
140 
        end;
 188 
        end;
141 
      end;
 189 
      end;
142 
    until FindNext(s) <> 0;
 190 
    until FindNext(s) <> 0;
143 
    FindClose(s);
 191 
    FindClose(s);
144 
  end;
 192 
  end;
145 
end;
 193 
end;
146 
 
 - 
 
147 
procedure TLevelChoice.FormResize(Sender: TObject);
 - 
 
148 
var
 - 
 
149 
  p: integer;
 - 
 
150 
begin
 - 
 
151 
  // WIDTH
 - 
 
152 
  p := ClientWidth - 3*LevelGrp.Left; // 100% useable
 - 
 
153 
  LevelGrp.Width := Round((1-MET_PREVIEW_SIZE_RATIO) * p);
 - 
 
154 
  PreviewGrp.Width := Round(MET_PREVIEW_SIZE_RATIO * p);
 - 
 
155 
  PreviewGrp.Left := 2*LevelGrp.Left + LevelGrp.Width;
 - 
 
156 
  LevelList.Width := LevelGrp.Width - 2*LevelList.Left;
 - 
 
157 
  PreviewImage.Width := PreviewGrp.Width - 2*PreviewImage.Left;
 - 
 
158 
  PlayBtn.Left := (LevelGrp.Left + LevelGrp.Width) - PlayBtn.Width;
 - 
 
159 
 
 - 
 
160 
  // HEIGHT
 - 
 
161 
  LevelGrp.Height := ClientHeight - 3*LevelGrp.Top - PlayBtn.Height;
 - 
 
162 
  PreviewGrp.Height := LevelGrp.Height;
 - 
 
163 
  PlayBtn.Top := 2*LevelGrp.Top + LevelGrp.Height;
 - 
 
164 
  CancelBtn.Top := PlayBtn.Top;
 - 
 
165 
  LevelList.Height := LevelGrp.Height - 2*LevelList.Top;
 - 
 
166 
  PreviewImage.Height := PreviewGrp.Height - 2*PreviewImage.Top;
 - 
 
167 
 
 - 
 
168 
  // TODO: Icons rearrangieren
 - 
 
169 
end;
 - 
 
170 
 
 194 
 
171 
procedure TLevelChoice.FormCreate(Sender: TObject);
 195 
procedure TLevelChoice.FormCreate(Sender: TObject);
172 
begin
 196 
begin
173 
  if not ForceDirectories(ExtractFilePath(Application.ExeName) + LVL_PATH) then
 197 
  if not ForceDirectories(ExtractFilePath(Application.ExeName) + LVL_PATH) then
174 
  begin
 198 
  begin
175 
    MessageDlg(Format(LNG_COULD_NOT_CREATE_DIR, [LVL_PATH]), mtError, [mbOK], 0);
 199 
    MessageDlg(Format(LNG_COULD_NOT_CREATE_DIR, [LVL_PATH]), mtError, [mbOK], 0);
176 
  end;
 200 
  end;
177 
end;
 201 
end;
178 
 
 202 
 
179 
end.
 203 
end.
180 
 
 204