Rev 4 | Go to most recent revision | Details | Last modification | View Log | RSS feed
| Rev | Author | Line No. | Line |
|---|---|---|---|
| 1 | daniel-mar | 1 | unit Main; |
| 2 | |||
| 3 | interface |
||
| 4 | |||
| 5 | uses |
||
| 6 | Windows, SysUtils, Classes, Graphics, Dialogs, StdCtrls, Menus, Controls, |
||
| 7 | ComCtrls, ExtCtrls, Forms, MMSystem, LevelFunctions, Registry; |
||
| 8 | |||
| 9 | type |
||
| 10 | TField = record |
||
| 11 | FieldType: TFieldType; |
||
| 12 | Goal: Boolean; |
||
| 13 | Panel: TPanel; |
||
| 14 | Stone: TImage; |
||
| 15 | end; |
||
| 16 | |||
| 17 | TFieldState = (fsError, fsLocked, fsAvailable, fsStone); |
||
| 18 | |||
| 19 | TPlayGroundMatrix = array of array of TField; |
||
| 20 | |||
| 21 | TMainForm = class(TForm) |
||
| 22 | Playground: TPanel; |
||
| 23 | MainMenu: TMainMenu; |
||
| 24 | Help1: TMenuItem; |
||
| 25 | MExit: TMenuItem; |
||
| 26 | Statistics: TStatusBar; |
||
| 27 | Timer: TTimer; |
||
| 28 | MNewGame: TMenuItem; |
||
| 29 | Help2: TMenuItem; |
||
| 30 | MAbout: TMenuItem; |
||
| 31 | MHelp: TMenuItem; |
||
| 32 | N5: TMenuItem; |
||
| 33 | MJumpHistory: TMenuItem; |
||
| 34 | N2: TMenuItem; |
||
| 35 | N4: TMenuItem; |
||
| 36 | MHighScores: TMenuItem; |
||
| 37 | MRestartGame: TMenuItem; |
||
| 38 | MSettings: TMenuItem; |
||
| 39 | MEnableSound: TMenuItem; |
||
| 40 | MPauseTime: TMenuItem; |
||
| 41 | N1: TMenuItem; |
||
| 42 | MUndo: TMenuItem; |
||
| 43 | MRedo: TMenuItem; |
||
| 44 | N3: TMenuItem; |
||
| 45 | procedure MExitClick(Sender: TObject); |
||
| 46 | procedure TimerTimer(Sender: TObject); |
||
| 47 | procedure MNewGameClick(Sender: TObject); |
||
| 48 | procedure MAboutClick(Sender: TObject); |
||
| 49 | procedure FormShow(Sender: TObject); |
||
| 50 | procedure FormCreate(Sender: TObject); |
||
| 51 | procedure FormDestroy(Sender: TObject); |
||
| 52 | procedure MJumpHistoryClick(Sender: TObject); |
||
| 53 | procedure MRestartGameClick(Sender: TObject); |
||
| 54 | procedure MHighScoresClick(Sender: TObject); |
||
| 55 | procedure MPauseTimeClick(Sender: TObject); |
||
| 56 | procedure FormClose(Sender: TObject; var Action: TCloseAction); |
||
| 57 | procedure MHelpClick(Sender: TObject); |
||
| 58 | procedure MEnableSoundClick(Sender: TObject); |
||
| 59 | private |
||
| 60 | CountedSeconds: Integer; |
||
| 61 | LevelFile: String; |
||
| 62 | LookupFieldCoordinateArray: array of TPoint; |
||
| 63 | OriginalPlayGroundMatrix: TPlayGroundMatrix; |
||
| 64 | PlaygroundMatrix: TPlayGroundMatrix; |
||
| 65 | Points: Integer; |
||
| 66 | LevelTotalStones: Integer; |
||
| 67 | LevelRemovedStones: Integer; |
||
| 68 | JumpHistory: TStringList; |
||
| 69 | procedure LoadSettings; |
||
| 70 | procedure SaveSettings; |
||
| 71 | procedure RestartLevel; |
||
| 72 | procedure SetNewPlayGroundMatrix(Matrix: TPlayGroundMatrix); |
||
| 73 | procedure RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix); |
||
| 74 | function AskForLevel: String; |
||
| 75 | function AreJumpsPossible: boolean; |
||
| 76 | procedure StoneDraggingAllow(Stone: TImage; Allow: boolean); |
||
| 77 | procedure NewGame(Filename: string); |
||
| 78 | function LevelTime: String; |
||
| 79 | procedure DestroyLevel; |
||
| 80 | procedure RefreshTime; |
||
| 81 | procedure RefreshPoints; |
||
| 82 | procedure RefreshStonesRemoved; |
||
| 83 | procedure CountPoints(t: TFieldType); |
||
| 84 | procedure RemoveStone(x, y: integer; count_points: boolean); |
||
| 85 | procedure DoJump(SourceTag, DestTag: integer); |
||
| 86 | function CanJump(x, y: integer): boolean; |
||
| 87 | function MayJump(SourceX, SourceY, DestX, DestY: integer): boolean; overload; |
||
| 88 | function MayJump(SourceTag, DestTag: integer): boolean; overload; |
||
| 89 | procedure StoneDragOver(Sender, Source: TObject; X, |
||
| 90 | Y: Integer; State: TDragState; var Accept: Boolean); |
||
| 91 | procedure StoneDragDrop(Sender, Source: TObject; X, Y: Integer); |
||
| 92 | procedure DrawField(x, y: integer; t: TFieldProperties; halftabs: integer); |
||
| 93 | function DrawStone(fieldtype: TFieldType; panel: TPanel): TImage; |
||
| 94 | function DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel; |
||
| 95 | procedure BuildPlayground(LevelArray: TLevelArray); |
||
| 96 | function FieldState(t: TFieldType): TFieldState; overload; |
||
| 97 | function FieldState(f: TField): TFieldState; overload; |
||
| 98 | function FieldState(x, y: integer): TFieldState; overload; |
||
| 99 | procedure ClearMatrix(Matrix: TPlayGroundMatrix; FreeVCL: boolean); |
||
| 100 | function CloneMatrix(Source: TPlayGroundMatrix): TPlayGroundMatrix; |
||
| 101 | procedure LoadPictureForType(FieldType: TFieldType; Picture: TPicture); |
||
| 102 | end; |
||
| 103 | |||
| 104 | var |
||
| 105 | MainForm: TMainForm; |
||
| 106 | |||
| 107 | implementation |
||
| 108 | |||
| 109 | uses |
||
| 110 | About, Finish, Choice, Functions, History, HighScore, Help, Constants; |
||
| 111 | |||
| 112 | {$R *.dfm} |
||
| 113 | |||
| 114 | procedure TMainForm.ClearMatrix(Matrix: TPlayGroundMatrix; FreeVCL: boolean); |
||
| 115 | var |
||
| 116 | i, j: integer; |
||
| 117 | begin |
||
| 118 | for i := Low(Matrix) to High(Matrix) do |
||
| 119 | begin |
||
| 120 | for j := Low(Matrix[i]) to High(Matrix[i]) do |
||
| 121 | begin |
||
| 122 | if FreeVCL then |
||
| 123 | begin |
||
| 124 | if Assigned(Matrix[i][j].Stone) then Matrix[i][j].Stone.Free; |
||
| 125 | if Assigned(Matrix[i][j].Panel) then Matrix[i][j].Panel.Free; |
||
| 126 | end; |
||
| 127 | end; |
||
| 128 | SetLength(Matrix[i], 0); |
||
| 129 | end; |
||
| 130 | SetLength(Matrix, 0); |
||
| 131 | end; |
||
| 132 | |||
| 133 | procedure TMainForm.RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix); |
||
| 134 | var |
||
| 135 | i, j: integer; |
||
| 136 | begin |
||
| 137 | for i := Low(Matrix) to High(Matrix) do |
||
| 138 | begin |
||
| 139 | for j := Low(Matrix[i]) to High(Matrix[i]) do |
||
| 140 | begin |
||
| 141 | if Assigned(Matrix[i][j].Stone) then |
||
| 142 | begin |
||
| 143 | LoadPictureForType(Matrix[i][j].FieldType, Matrix[i][j].Stone.Picture); |
||
| 144 | StoneDraggingAllow(Matrix[i][j].Stone, FieldState(Matrix[i][j].FieldType) <> fsAvailable); |
||
| 145 | end; |
||
| 146 | end; |
||
| 147 | end; |
||
| 148 | end; |
||
| 149 | |||
| 150 | procedure TMainForm.DestroyLevel; |
||
| 151 | begin |
||
| 152 | MPauseTime.Enabled := false; |
||
| 153 | Timer.Enabled := false; |
||
| 154 | |||
| 155 | MRestartGame.Enabled := false; |
||
| 156 | |||
| 157 | LevelFile := ''; |
||
| 158 | |||
| 159 | CountedSeconds := 0; |
||
| 160 | RefreshTime; |
||
| 161 | |||
| 162 | Points := 0; |
||
| 163 | RefreshPoints; |
||
| 164 | |||
| 165 | LevelRemovedStones := 0; |
||
| 166 | LevelTotalStones := 0; |
||
| 167 | RefreshStonesRemoved; |
||
| 168 | |||
| 169 | JumpHistory.Clear; |
||
| 170 | |||
| 171 | ClearMatrix(PlayGroundMatrix, true); |
||
| 172 | ClearMatrix(OriginalPlayGroundMatrix, false); |
||
| 173 | |||
| 174 | SetLength(LookupFieldCoordinateArray, 0); |
||
| 175 | end; |
||
| 176 | |||
| 177 | procedure TMainForm.LoadPictureForType(FieldType: TFieldType; Picture: TPicture); |
||
| 178 | begin |
||
| 179 | case FieldType of |
||
| 180 | ftEmpty: Picture.Bitmap.LoadFromResourceName(HInstance, RES_EMPTY); |
||
| 181 | ftGreen: Picture.Bitmap.LoadFromResourceName(HInstance, RES_GREEN); |
||
| 182 | ftYellow: Picture.Bitmap.LoadFromResourceName(HInstance, RES_YELLOW); |
||
| 183 | ftRed: Picture.Bitmap.LoadFromResourceName(HInstance, RES_RED); |
||
| 184 | end; |
||
| 185 | end; |
||
| 186 | |||
| 187 | function TMainForm.DrawStone(fieldtype: TFieldType; panel: TPanel): TImage; |
||
| 188 | begin |
||
| 189 | result := TImage.Create(panel); |
||
| 190 | result.Parent := panel; |
||
| 191 | LoadPictureForType(fieldtype, result.Picture); |
||
| 192 | result.Width := panel.Width - 2*MET_SHAPE_MARGIN; |
||
| 193 | result.Height := panel.Height - 2*MET_SHAPE_MARGIN; |
||
| 194 | result.Left := MET_SHAPE_MARGIN; |
||
| 195 | result.Top := MET_SHAPE_MARGIN; |
||
| 196 | result.Center := true; |
||
| 197 | result.Transparent := true; |
||
| 198 | |||
| 199 | result.Tag := panel.Tag; |
||
| 200 | result.OnDragOver := panel.OnDragOver; |
||
| 201 | result.OnDragDrop := panel.OnDragDrop; |
||
| 202 | |||
| 203 | StoneDraggingAllow(result, FieldState(fieldtype) <> fsAvailable); |
||
| 204 | end; |
||
| 205 | |||
| 206 | procedure TMainForm.StoneDraggingAllow(Stone: TImage; Allow: boolean); |
||
| 207 | begin |
||
| 208 | if Allow then |
||
| 209 | begin |
||
| 210 | Stone.DragMode := dmAutomatic; |
||
| 211 | (Stone.Parent as TPanel).DragMode := dmAutomatic; |
||
| 212 | end |
||
| 213 | else |
||
| 214 | begin |
||
| 215 | Stone.DragMode := dmManual; |
||
| 216 | (Stone.Parent as TPanel).DragMode := dmManual; |
||
| 217 | end; |
||
| 218 | end; |
||
| 219 | |||
| 220 | function TMainForm.DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel; |
||
| 221 | begin |
||
| 222 | result := TPanel.Create(Playground); |
||
| 223 | result.Parent := Playground; |
||
| 224 | if isGoal then |
||
| 225 | begin |
||
| 226 | result.BevelInner := bvLowered; |
||
| 227 | end; |
||
| 228 | result.Color := Playground.Color; |
||
| 229 | result.BevelOuter := bvLowered; |
||
| 230 | result.Width := MET_FIELD_SIZE; |
||
| 231 | result.Height := MET_FIELD_SIZE; |
||
| 232 | result.Left := x * (MET_FIELD_SIZE+MET_FIELD_SPACE) + MET_FIELD_SPACE - (halftabs*MET_HALFTAB_SIZE); |
||
| 233 | result.Top := y * (MET_FIELD_SIZE+MET_FIELD_SPACE) + MET_FIELD_SPACE; |
||
| 234 | |||
| 235 | result.Tag := tag; |
||
| 236 | result.OnDragOver := StoneDragOver; |
||
| 237 | result.OnDragDrop := StoneDragDrop; |
||
| 238 | end; |
||
| 239 | |||
| 240 | procedure TMainForm.MExitClick(Sender: TObject); |
||
| 241 | begin |
||
| 242 | Close; |
||
| 243 | end; |
||
| 244 | |||
| 245 | function TMainForm.FieldState(t: TFieldType): TFieldState; |
||
| 246 | begin |
||
| 247 | result := fsError; |
||
| 248 | case t of |
||
| 249 | ftLocked: result := fsLocked; |
||
| 250 | ftLockedWithTab: result := fsLocked; |
||
| 251 | ftEmpty: result := fsAvailable; |
||
| 252 | ftGreen: result := fsStone; |
||
| 253 | ftYellow: result := fsStone; |
||
| 254 | ftRed: result := fsStone; |
||
| 255 | end; |
||
| 256 | end; |
||
| 257 | |||
| 258 | function TMainForm.FieldState(f: TField): TFieldState; |
||
| 259 | begin |
||
| 260 | result := FieldState(f.FieldType); |
||
| 261 | end; |
||
| 262 | |||
| 263 | function TMainForm.FieldState(x, y: integer): TFieldState; |
||
| 264 | begin |
||
| 265 | result := fsError; |
||
| 266 | if (x < Low(PlayGroundMatrix)) or (x > High(PlayGroundMatrix)) then exit; |
||
| 267 | if (y < Low(PlayGroundMatrix[x])) or (y > High(PlayGroundMatrix[x])) then exit; |
||
| 268 | |||
| 269 | result := FieldState(PlayGroundMatrix[x][y]); |
||
| 270 | end; |
||
| 271 | |||
| 272 | procedure TMainForm.RefreshTime; |
||
| 273 | begin |
||
| 274 | Statistics.Panels.Items[0].Text := Format(LNG_TIME, [LevelTime]); |
||
| 275 | end; |
||
| 276 | |||
| 277 | procedure TMainForm.RefreshStonesRemoved; |
||
| 278 | begin |
||
| 279 | Statistics.Panels.Items[1].Text := Format(LNG_STONES_REMOVED, [LevelRemovedStones, LevelTotalStones]); |
||
| 280 | end; |
||
| 281 | |||
| 282 | procedure TMainForm.RefreshPoints; |
||
| 283 | begin |
||
| 284 | Statistics.Panels.Items[2].Text := Format(LNG_POINTS, [Points]); |
||
| 285 | end; |
||
| 286 | |||
| 287 | procedure TMainForm.CountPoints(t: TFieldType); |
||
| 288 | begin |
||
| 289 | if t = ftGreen then inc(Points, 10); |
||
| 290 | if t = ftYellow then inc(Points, 20); |
||
| 291 | if t = ftRed then inc(Points, 30); |
||
| 292 | RefreshPoints; |
||
| 293 | end; |
||
| 294 | |||
| 295 | procedure TMainForm.RemoveStone(x, y: integer; count_points: boolean); |
||
| 296 | begin |
||
| 297 | if count_points then |
||
| 298 | begin |
||
| 299 | CountPoints(PlayGroundMatrix[x, y].FieldType); |
||
| 300 | Inc(LevelRemovedStones); |
||
| 301 | RefreshStonesRemoved; |
||
| 302 | end; |
||
| 303 | PlayGroundMatrix[x, y].FieldType := ftEmpty; |
||
| 304 | LoadPictureForType(PlayGroundMatrix[x, y].FieldType, PlayGroundMatrix[x, y].Stone.Picture); |
||
| 305 | StoneDraggingAllow(PlayGroundMatrix[x, y].Stone, false); |
||
| 306 | end; |
||
| 307 | |||
| 308 | function TMainForm.CanJump(x, y: integer): boolean; |
||
| 309 | begin |
||
| 310 | if FieldState(x, y) <> fsStone then |
||
| 311 | begin |
||
| 312 | result := false; |
||
| 313 | exit; |
||
| 314 | end; |
||
| 315 | |||
| 316 | result := true; |
||
| 317 | |||
| 318 | if MayJump(x, y, x+2, y) then exit; |
||
| 319 | if MayJump(x, y, x-2, y) then exit; |
||
| 320 | if MayJump(x, y, x, y+2) then exit; |
||
| 321 | if MayJump(x, y, x, y-2) then exit; |
||
| 322 | |||
| 323 | if AllowDiagonalMoves then |
||
| 324 | begin |
||
| 325 | if MayJump(x, y, x-2, y-2) then exit; |
||
| 326 | if MayJump(x, y, x+2, y-2) then exit; |
||
| 327 | if MayJump(x, y, x-2, y+2) then exit; |
||
| 328 | if MayJump(x, y, x+2, y+2) then exit; |
||
| 329 | end; |
||
| 330 | |||
| 331 | result := false; |
||
| 332 | end; |
||
| 333 | |||
| 334 | function TMainForm.AreJumpsPossible: boolean; |
||
| 335 | var |
||
| 336 | i, j: integer; |
||
| 337 | begin |
||
| 338 | result := false; |
||
| 339 | for i := Low(PlayGroundMatrix) to High(PlayGroundMatrix) do |
||
| 340 | begin |
||
| 341 | for j := Low(PlayGroundMatrix[i]) to High(PlayGroundMatrix[i]) do |
||
| 342 | begin |
||
| 343 | if CanJump(i, j) then |
||
| 344 | begin |
||
| 345 | result := true; |
||
| 346 | break; |
||
| 347 | end; |
||
| 348 | if result then break; |
||
| 349 | end; |
||
| 350 | end; |
||
| 351 | end; |
||
| 352 | |||
| 353 | procedure TMainForm.DoJump(SourceTag, DestTag: integer); |
||
| 354 | var |
||
| 355 | d, s: TPoint; |
||
| 356 | old_fieldtype: TFieldType; |
||
| 357 | res: Integer; |
||
| 358 | begin |
||
| 359 | if not MayJump(SourceTag, DestTag) then exit; |
||
| 360 | |||
| 361 | d := LookupFieldCoordinateArray[DestTag]; |
||
| 362 | s := LookupFieldCoordinateArray[SourceTag]; |
||
| 363 | |||
| 364 | JumpHistory.Add(Format(LNG_JUMP_LOG, [SourceTag+1, s.x+1, s.y+1, DestTag+1, d.x+1, d.y+1])); |
||
| 365 | |||
| 366 | if AllowDiagonalMoves then |
||
| 367 | begin |
||
| 368 | if (s.X-2 = d.X) and (s.Y-2 = d.Y) and (FieldState(s.X-1, s.Y-1) = fsStone) then RemoveStone(s.X-1, s.Y-1, true); |
||
| 369 | if (s.X-2 = d.X) and (s.Y+2 = d.Y) and (FieldState(s.X-1, s.Y+1) = fsStone) then RemoveStone(s.X-1, s.Y+1, true); |
||
| 370 | if (s.X+2 = d.X) and (s.Y-2 = d.Y) and (FieldState(s.X+1, s.Y-1) = fsStone) then RemoveStone(s.X+1, s.Y-1, true); |
||
| 371 | if (s.X+2 = d.X) and (s.Y+2 = d.Y) and (FieldState(s.X+1, s.Y+1) = fsStone) then RemoveStone(s.X+1, s.Y+1, true); |
||
| 372 | end; |
||
| 373 | |||
| 374 | if (s.X+2 = d.X) and (s.Y = d.Y) and (FieldState(s.X+1, s.Y ) = fsStone) then RemoveStone(s.X+1, s.Y, true); |
||
| 375 | if (s.X-2 = d.X) and (s.Y = d.Y) and (FieldState(s.X-1, s.Y ) = fsStone) then RemoveStone(s.X-1, s.Y, true); |
||
| 376 | if (s.X = d.X) and (s.Y+2 = d.Y) and (FieldState(s.X , s.Y+1) = fsStone) then RemoveStone(s.X, s.Y+1, true); |
||
| 377 | if (s.X = d.X) and (s.Y-2 = d.Y) and (FieldState(s.X , s.Y-1) = fsStone) then RemoveStone(s.X, s.Y-1, true); |
||
| 378 | |||
| 379 | // Den Timer erst nach dem ersten Zug starten |
||
| 380 | // oder nach einer Pause neustarten |
||
| 381 | if not Timer.Enabled then |
||
| 382 | begin |
||
| 383 | MPauseTime.Enabled := true; |
||
| 384 | Timer.Enabled := true; |
||
| 385 | end; |
||
| 386 | |||
| 387 | if not MRestartGame.Enabled then MRestartGame.Enabled := true; |
||
| 388 | |||
| 389 | // Sound abspielen |
||
| 390 | if MEnableSound.Checked then PlaySound(RES_JUMP, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE); |
||
| 391 | |||
| 392 | // Nun den Stein springen lassen |
||
| 393 | old_fieldtype := PlayGroundMatrix[s.X, s.Y].FieldType; // Steinfarbe merken |
||
| 394 | RemoveStone(s.X, s.Y, false); // Eigenen Stein entfernen |
||
| 395 | PlayGroundMatrix[d.X, d.Y].FieldType := old_fieldtype; // Farbe wiederherstellen |
||
| 396 | LoadPictureForType(PlayGroundMatrix[d.X, d.Y].FieldType, PlayGroundMatrix[d.X, d.Y].Stone.Picture); // Stein an neue Position malen |
||
| 397 | StoneDraggingAllow(PlayGroundMatrix[d.X, d.Y].Stone, true); // Und die Drag-Eigenschaft erneuern |
||
| 398 | |||
| 399 | // Ist ein weiterer Sprung möglich? |
||
| 400 | if not AreJumpsPossible then |
||
| 401 | begin |
||
| 402 | MPauseTime.Enabled := false; |
||
| 403 | Timer.Enabled := false; |
||
| 404 | RefreshTime; |
||
| 405 | if MEnableSound.Checked then PlaySound(RES_FINISH, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE); |
||
| 406 | res := FinishForm.Execute(ExtractFileNameWithoutExt(LevelFile), Points, LevelTotalStones, LevelRemovedStones, CountedSeconds, JumpHistory); |
||
| 407 | if (res = mrOK) and FinishForm.ReplayCheckbox.Checked then RestartLevel; |
||
| 408 | end; |
||
| 409 | end; |
||
| 410 | |||
| 411 | function TMainForm.MayJump(SourceX, SourceY, DestX, DestY: integer): boolean; |
||
| 412 | begin |
||
| 413 | result := false; |
||
| 414 | |||
| 415 | // Check 1: Ist das Zielfeld überhaupt leer? |
||
| 416 | if FieldState(DestX, DestY) <> fsAvailable then exit; |
||
| 417 | |||
| 418 | // Check 2: Befindet sich ein Stein zwischen Source und Destination und ist der Abstand 2? |
||
| 419 | if AllowDiagonalMoves then |
||
| 420 | begin |
||
| 421 | if (SourceX-2 = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX-1, SourceY-1) = fsStone) then result := true; |
||
| 422 | if (SourceX-2 = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX-1, SourceY+1) = fsStone) then result := true; |
||
| 423 | if (SourceX+2 = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX+1, SourceY-1) = fsStone) then result := true; |
||
| 424 | if (SourceX+2 = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX+1, SourceY+1) = fsStone) then result := true; |
||
| 425 | end; |
||
| 426 | |||
| 427 | if (SourceX+2 = DestX) and (SourceY = DestY) and (FieldState(SourceX+1, SourceY ) = fsStone) then result := true; |
||
| 428 | if (SourceX-2 = DestX) and (SourceY = DestY) and (FieldState(SourceX-1, SourceY ) = fsStone) then result := true; |
||
| 429 | if (SourceX = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX , SourceY+1) = fsStone) then result := true; |
||
| 430 | if (SourceX = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX , SourceY-1) = fsStone) then result := true; |
||
| 431 | end; |
||
| 432 | |||
| 433 | function TMainForm.MayJump(SourceTag, DestTag: integer): boolean; |
||
| 434 | var |
||
| 435 | s, d: TPoint; |
||
| 436 | begin |
||
| 437 | d := LookupFieldCoordinateArray[DestTag]; |
||
| 438 | s := LookupFieldCoordinateArray[SourceTag]; |
||
| 439 | |||
| 440 | result := MayJump(s.X, s.Y, d.X, d.Y); |
||
| 441 | end; |
||
| 442 | |||
| 443 | procedure TMainForm.StoneDragDrop(Sender, Source: TObject; X, Y: Integer); |
||
| 444 | begin |
||
| 445 | DoJump(TComponent(Source).Tag, TComponent(Sender).Tag); |
||
| 446 | end; |
||
| 447 | |||
| 448 | procedure TMainForm.StoneDragOver(Sender, Source: TObject; X, |
||
| 449 | Y: Integer; State: TDragState; var Accept: Boolean); |
||
| 450 | begin |
||
| 451 | Accept := MayJump(TComponent(Source).Tag, TComponent(Sender).Tag); |
||
| 452 | end; |
||
| 453 | |||
| 454 | procedure TMainForm.DrawField(x, y: integer; t: TFieldProperties; halftabs: integer); |
||
| 455 | var |
||
| 456 | newField: TField; |
||
| 457 | index: integer; |
||
| 458 | begin |
||
| 459 | if (t.Typ = ftLocked) or (t.Typ = ftLockedWithTab) then exit; |
||
| 460 | |||
| 461 | index := Length(LookupFieldCoordinateArray); |
||
| 462 | |||
| 463 | newField.FieldType := t.Typ; |
||
| 464 | newField.Goal := t.Goal; |
||
| 465 | newField.Panel := DrawStoneBox(x, y, index, halftabs, t.Goal); |
||
| 466 | newField.Stone := DrawStone(t.Typ, newField.Panel); |
||
| 467 | if FieldState(t.Typ) = fsStone then Inc(LevelTotalStones); |
||
| 468 | |||
| 469 | SetLength(LookupFieldCoordinateArray, index + 1); |
||
| 470 | LookupFieldCoordinateArray[index].X := x; |
||
| 471 | LookupFieldCoordinateArray[index].Y := y; |
||
| 472 | |||
| 473 | if Length(PlayGroundMatrix) < x+1 then SetLength(PlayGroundMatrix, x+1); |
||
| 474 | if Length(PlayGroundMatrix[x]) < y+1 then SetLength(PlayGroundMatrix[x], y+1); |
||
| 475 | PlaygroundMatrix[x, y] := newField; |
||
| 476 | end; |
||
| 477 | |||
| 478 | function TMainForm.CloneMatrix(Source: TPlayGroundMatrix): TPlayGroundMatrix; |
||
| 479 | var |
||
| 480 | i, j: integer; |
||
| 481 | begin |
||
| 482 | SetLength(result, Length(Source)); |
||
| 483 | for i := Low(Source) to High(Source) do |
||
| 484 | begin |
||
| 485 | SetLength(result[i], Length(Source[i])); |
||
| 486 | for j := Low(Source[i]) to High(Source[i]) do |
||
| 487 | begin |
||
| 488 | result[i][j].FieldType := Source[i][j].FieldType; |
||
| 489 | result[i][j].Goal := Source[i][j].Goal; |
||
| 490 | result[i][j].Panel := Source[i][j].Panel; |
||
| 491 | result[i][j].Stone := Source[i][j].Stone; |
||
| 492 | end; |
||
| 493 | end; |
||
| 494 | end; |
||
| 495 | |||
| 496 | procedure TMainForm.BuildPlayground(LevelArray: TLevelArray); |
||
| 497 | var |
||
| 498 | i, j, halftabs, cur_x: integer; |
||
| 499 | max_x, max_y, old_cw, old_ch: integer; |
||
| 500 | begin |
||
| 501 | PlayGround.Visible := false; |
||
| 502 | |||
| 503 | // Die Dimensionen ermitteln |
||
| 504 | max_x := 0; |
||
| 505 | for i := Low(LevelArray) to High(LevelArray) do |
||
| 506 | begin |
||
| 507 | halftabs := 0; |
||
| 508 | for j := Low(LevelArray[i]) to High(LevelArray[i]) do |
||
| 509 | begin |
||
| 510 | if LevelArray[i][j].Typ = ftLockedWithTab then inc(halftabs); |
||
| 511 | DrawField(j, i, LevelArray[i][j], halftabs); |
||
| 512 | end; |
||
| 513 | cur_x := High(LevelArray[i]) + 1; |
||
| 514 | if cur_x > max_x then max_x := cur_x; |
||
| 515 | end; |
||
| 516 | max_y := High(LevelArray) + 1; |
||
| 517 | |||
| 518 | PlayGround.Visible := true; |
||
| 519 | |||
| 520 | // Die aktuellen Dimensionen merken |
||
| 521 | old_cw := ClientWidth; |
||
| 522 | old_ch := ClientHeight; |
||
| 523 | |||
| 524 | // Das Form an das Level anpassen |
||
| 525 | PlayGround.Width := MET_FIELD_SPACE + max_x * (MET_FIELD_SPACE + MET_FIELD_SIZE); |
||
| 526 | PlayGround.Height := MET_FIELD_SPACE + max_y * (MET_FIELD_SPACE + MET_FIELD_SIZE); |
||
| 527 | ClientWidth := 2 * MET_OUTER_MARGIN + PlayGround.Width; |
||
| 528 | ClientHeight := 2 * MET_OUTER_MARGIN + PlayGround.Height + Statistics.Height; |
||
| 529 | |||
| 530 | Statistics.Panels.Items[0].Width := Round(ClientWidth*MET_PERCENT_PNL_TIME); |
||
| 531 | Statistics.Panels.Items[1].Width := Round(ClientWidth*MET_PERCENT_PNL_STONES); |
||
| 532 | |||
| 533 | // Wenn sich das Form vergrößert oder verkleinert hat, neu justieren |
||
| 534 | if (old_cw <> ClientWidth) or (old_ch <> ClientHeight) then |
||
| 535 | begin |
||
| 536 | Left := Screen.Width div 2 - Width div 2; |
||
| 537 | Top := Screen.Height div 2 - Height div 2; |
||
| 538 | |||
| 539 | // Playground mittig setzen, falls die Mindestgröße für die |
||
| 540 | // Punkteanzeige unterschritten wurde, |
||
| 541 | PlayGround.Left := ClientWidth div 2 - PlayGround.Width div 2; |
||
| 542 | PlayGround.Top := ClientHeight div 2 - PlayGround.Height div 2; |
||
| 543 | end; |
||
| 544 | |||
| 545 | OriginalPlayGroundMatrix := CloneMatrix(PlayGroundMatrix); |
||
| 546 | end; |
||
| 547 | |||
| 548 | procedure TMainForm.TimerTimer(Sender: TObject); |
||
| 549 | begin |
||
| 550 | if mainform.Focused then Inc(CountedSeconds); |
||
| 551 | RefreshTime; |
||
| 552 | end; |
||
| 553 | |||
| 554 | function TMainForm.LevelTime: String; |
||
| 555 | begin |
||
| 556 | result := SecondsToTimeString(CountedSeconds); |
||
| 557 | end; |
||
| 558 | |||
| 559 | procedure TMainForm.NewGame(Filename: string); |
||
| 560 | var |
||
| 561 | LevelString: String; |
||
| 562 | LevelArray: TLevelArray; |
||
| 563 | begin |
||
| 564 | DestroyLevel; |
||
| 565 | LevelFile := Filename; |
||
| 566 | LevelString := ReadFile(LevelFile); |
||
| 567 | LevelArray := LevelStringToLevelArray(LevelString, true); |
||
| 568 | if Length(LevelArray) = 0 then Exit; |
||
| 569 | BuildPlayground(LevelArray); |
||
| 570 | if not AreJumpsPossible then |
||
| 571 | begin |
||
| 572 | ShowMessage(LNG_LVL_INVALID_NO_JUMP); |
||
| 573 | end; |
||
| 574 | RefreshTime; |
||
| 575 | RefreshStonesRemoved; |
||
| 576 | RefreshPoints; |
||
| 577 | end; |
||
| 578 | |||
| 579 | procedure TMainForm.MNewGameClick(Sender: TObject); |
||
| 580 | begin |
||
| 581 | LevelFile := AskForLevel; |
||
| 582 | if LevelFile <> '' then |
||
| 583 | begin |
||
| 584 | NewGame(LevelFile); |
||
| 585 | end; |
||
| 586 | end; |
||
| 587 | |||
| 588 | procedure TMainForm.MAboutClick(Sender: TObject); |
||
| 589 | begin |
||
| 590 | AboutBox.ShowModal; |
||
| 591 | end; |
||
| 592 | |||
| 593 | function TMainForm.AskForLevel: String; |
||
| 594 | begin |
||
| 595 | LevelChoice.ShowModal; |
||
| 596 | |||
| 597 | if LevelChoice.ModalResult <> mrOK then |
||
| 598 | begin |
||
| 599 | result := ''; |
||
| 600 | exit; |
||
| 601 | end; |
||
| 602 | |||
| 603 | result := LevelChoice.SelectedLevel; |
||
| 604 | end; |
||
| 605 | |||
| 606 | procedure TMainForm.FormShow(Sender: TObject); |
||
| 607 | begin |
||
| 608 | LevelFile := AskForLevel; |
||
| 609 | if LevelFile <> '' then |
||
| 610 | begin |
||
| 611 | NewGame(LevelFile); |
||
| 612 | end |
||
| 613 | else Close(); |
||
| 614 | end; |
||
| 615 | |||
| 616 | procedure TMainForm.FormCreate(Sender: TObject); |
||
| 617 | begin |
||
| 618 | JumpHistory := TStringList.Create; |
||
| 619 | LoadSettings; |
||
| 620 | end; |
||
| 621 | |||
| 622 | procedure TMainForm.FormDestroy(Sender: TObject); |
||
| 623 | begin |
||
| 624 | JumpHistory.Free; |
||
| 625 | end; |
||
| 626 | |||
| 627 | procedure TMainForm.MJumpHistoryClick(Sender: TObject); |
||
| 628 | begin |
||
| 629 | HistoryForm.JumpMemo.Lines.Assign(JumpHistory); |
||
| 630 | HistoryForm.ShowModal; |
||
| 631 | end; |
||
| 632 | |||
| 633 | procedure TMainForm.RestartLevel; |
||
| 634 | begin |
||
| 635 | MPauseTime.Enabled := false; |
||
| 636 | Timer.Enabled := false; |
||
| 637 | |||
| 638 | MRestartGame.Enabled := false; |
||
| 639 | |||
| 640 | CountedSeconds := 0; |
||
| 641 | RefreshTime; |
||
| 642 | |||
| 643 | Points := 0; |
||
| 644 | RefreshPoints; |
||
| 645 | |||
| 646 | LevelRemovedStones := 0; |
||
| 647 | RefreshStonesRemoved; |
||
| 648 | |||
| 649 | JumpHistory.Clear; |
||
| 650 | |||
| 651 | RedrawStonesFromMatrix(OriginalPlayGroundMatrix); |
||
| 652 | SetNewPlayGroundMatrix(OriginalPlayGroundMatrix); |
||
| 653 | end; |
||
| 654 | |||
| 655 | procedure TMainForm.SetNewPlayGroundMatrix(Matrix: TPlayGroundMatrix); |
||
| 656 | begin |
||
| 657 | ClearMatrix(PlayGroundMatrix, false); // Memory Leak verhindern |
||
| 658 | PlayGroundMatrix := CloneMatrix(Matrix); |
||
| 659 | end; |
||
| 660 | |||
| 661 | procedure TMainForm.MRestartGameClick(Sender: TObject); |
||
| 662 | begin |
||
| 663 | RestartLevel; |
||
| 664 | end; |
||
| 665 | |||
| 666 | procedure TMainForm.MHighScoresClick(Sender: TObject); |
||
| 667 | begin |
||
| 668 | HighScoreForm.Execute(ExtractFileNameWithoutExt(LevelFile)); |
||
| 669 | end; |
||
| 670 | |||
| 671 | procedure TMainForm.MPauseTimeClick(Sender: TObject); |
||
| 672 | begin |
||
| 673 | MPauseTime.Enabled := false; |
||
| 674 | Timer.Enabled := false; |
||
| 675 | end; |
||
| 676 | |||
| 677 | procedure TMainForm.LoadSettings; |
||
| 678 | var |
||
| 679 | reg: TRegistry; |
||
| 680 | begin |
||
| 681 | reg := TRegistry.Create; |
||
| 682 | try |
||
| 683 | reg.RootKey := HKEY_CURRENT_USER; |
||
| 684 | if reg.OpenKeyReadOnly(REG_KEY) then |
||
| 685 | begin |
||
| 686 | if reg.ValueExists(REG_SOUND) then |
||
| 687 | MEnableSound.Checked := reg.ReadBool(REG_SOUND); |
||
| 688 | reg.CloseKey; |
||
| 689 | end; |
||
| 690 | finally |
||
| 691 | reg.Free; |
||
| 692 | end; |
||
| 693 | end; |
||
| 694 | |||
| 695 | procedure TMainForm.SaveSettings; |
||
| 696 | var |
||
| 697 | reg: TRegistry; |
||
| 698 | begin |
||
| 699 | reg := TRegistry.Create; |
||
| 700 | try |
||
| 701 | reg.RootKey := HKEY_CURRENT_USER; |
||
| 702 | if reg.OpenKey(REG_KEY, true) then |
||
| 703 | begin |
||
| 704 | reg.WriteBool(REG_SOUND, MEnableSound.Checked); |
||
| 705 | reg.CloseKey; |
||
| 706 | end; |
||
| 707 | finally |
||
| 708 | reg.Free; |
||
| 709 | end; |
||
| 710 | end; |
||
| 711 | |||
| 712 | |||
| 713 | procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction); |
||
| 714 | begin |
||
| 715 | SaveSettings; |
||
| 716 | if FinishForm.NameEdit.Text <> '' then |
||
| 717 | begin |
||
| 718 | FinishForm.SaveSettings; |
||
| 719 | end; |
||
| 720 | end; |
||
| 721 | |||
| 722 | procedure TMainForm.MHelpClick(Sender: TObject); |
||
| 723 | begin |
||
| 724 | HelpForm.ShowModal; |
||
| 725 | end; |
||
| 726 | |||
| 727 | procedure TMainForm.MEnableSoundClick(Sender: TObject); |
||
| 728 | begin |
||
| 729 | MEnableSound.Checked := not MEnableSound.Checked; |
||
| 730 | end; |
||
| 731 | |||
| 732 | end. |