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