WebSVN – jumper – Blame – /trunk/Choice.pas

Rev	Author	Line No.	Line
1	daniel-mar	1	unit Choice;
		2
		3	interface
		4
		5	uses
		6	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
21	daniel-mar	7	Dialogs, StdCtrls, ImgList, ComCtrls, Menus, ExtCtrls, System.ImageList, LevelFunctions;
1	daniel-mar	8
		9	type
		10	TLevelChoice = class(TForm)
		11	PlayBtn: TButton;
		12	CancelBtn: TButton;
		13	LevelImageList: TImageList;
		14	LevelPopupMenu: TPopupMenu;
		15	PLoadLevel: TMenuItem;
		16	PRefreshList: TMenuItem;
		17	PreviewGrp: TGroupBox;
		18	PreviewImage: TImage;
		19	LevelGrp: TGroupBox;
		20	LevelList: TListView;
		21	procedure PlayBtnClick(Sender: TObject);
		22	procedure CancelBtnClick(Sender: TObject);
		23	procedure FormShow(Sender: TObject);
		24	procedure LevelListClick(Sender: TObject);
21	daniel-mar	25	procedure LevelListChange(Sender: TObject; Item: TListItem; Change: TItemChange);
1	daniel-mar	26	procedure PRefreshListClick(Sender: TObject);
		27	procedure FormCreate(Sender: TObject);
		28	private
		29	procedure RefreshList;
21	daniel-mar	30	procedure DrawLevelPreview(Level: TLevel);
1	daniel-mar	31	public
		32	function SelectedLevel: string;
		33	end;
		34
		35	var
		36	LevelChoice: TLevelChoice;
		37
		38	implementation
		39
		40	{$R *.dfm}
		41
		42	uses
21	daniel-mar	43	Functions, Constants;
1	daniel-mar	44
21	daniel-mar	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(xPREVIEW_BLOCK_SIZE + indentPREVIEW_TAB_SIZE,
		87	y*PREVIEW_BLOCK_SIZE,
		88	xPREVIEW_BLOCK_SIZE + indentPREVIEW_TAB_SIZE + PREVIEW_BLOCK_SIZE,
		89	y*PREVIEW_BLOCK_SIZE + PREVIEW_BLOCK_SIZE);
		90	end;
		91	end;
		92	end;
		93
1	daniel-mar	94	function TLevelChoice.SelectedLevel: string;
		95	begin
		96	result := Format(LVL_FILE, [LevelList.Selected.Caption]);
		97	end;
		98
		99	procedure TLevelChoice.PlayBtnClick(Sender: TObject);
		100	var
11	daniel-mar	101	Level: TLevel;
1	daniel-mar	102	begin
		103	if Assigned(LevelList.Selected) then
		104	begin
		105	if LevelList.Selected.ImageIndex = 2 then
		106	begin
11	daniel-mar	107	Level := TLevel.Create(Format(LVL_FILE, [LevelList.Selected.Caption]));
		108	try
		109	if Level.CheckLevelIntegrity(true) <> leNone then
		110	begin
		111	exit;
		112	end;
		113	finally
		114	FreeAndNil(Level);
1	daniel-mar	115	end;
		116	end;
		117	ModalResult := mrOk;
		118	end;
		119	end;
		120
		121	procedure TLevelChoice.CancelBtnClick(Sender: TObject);
		122	begin
		123	ModalResult := mrCancel;
		124	end;
		125
		126	procedure TLevelChoice.FormShow(Sender: TObject);
		127	begin
		128	RefreshList;
		129	end;
		130
		131	procedure TLevelChoice.LevelListClick(Sender: TObject);
		132	var
18	daniel-mar	133	LevelFile: string;
11	daniel-mar	134	Level: TLevel;
1	daniel-mar	135	begin
		136	PlayBtn.Enabled := Assigned(LevelList.Selected);
		137	PLoadLevel.Enabled := Assigned(LevelList.Selected);
		138
		139	if Assigned(LevelList.Selected) then
		140	begin
		141	LevelFile := Format(LVL_FILE, [LevelList.Selected.Caption]);
11	daniel-mar	142	Level := TLevel.Create(LevelFile);
		143	try
21	daniel-mar	144	DrawLevelPreview(Level);
11	daniel-mar	145	finally
		146	FreeAndNil(Level);
		147	end;
1	daniel-mar	148	end
		149	else
		150	begin
		151	ClearImage(PreviewImage, Color);
		152	end;
		153	end;
		154
		155	procedure TLevelChoice.LevelListChange(Sender: TObject; Item: TListItem;
		156	Change: TItemChange);
		157	begin
		158	if Change = ctState then LevelListClick(self);
		159	end;
		160
		161	procedure TLevelChoice.PRefreshListClick(Sender: TObject);
		162	begin
		163	RefreshList;
		164	end;
		165
		166	procedure TLevelChoice.RefreshList;
		167	var
		168	s: TSearchRec;
11	daniel-mar	169	Level: TLevel;
1	daniel-mar	170	begin
		171	LevelList.Clear;
		172
		173	// Levels auflisten
		174	if FindFirst(Format(LVL_FILE, ['*']), faAnyFile, s) = 0 then
		175	begin
		176	repeat
		177	with LevelList.Items.Add do
		178	begin
		179	Caption := Copy(s.Name, 1, Length(s.Name)-Length(LVL_EXT));
11	daniel-mar	180	Level := TLevel.Create(LVL_PATH + s.Name);
18	daniel-mar	181
		182	if Level.CheckLevelIntegrity <> leNone then
		183	ImageIndex := 2{Error}
		184	else case Level.GetGameMode of
		185	gmNormal: ImageIndex := 0{Normal};
		186	gmDiagonal: ImageIndex := 1{Diagonal};
		187	gmUndefined: ImageIndex := 2{Error};
1	daniel-mar	188	end;
		189	end;
		190	until FindNext(s) <> 0;
		191	FindClose(s);
		192	end;
		193	end;
		194
		195	procedure TLevelChoice.FormCreate(Sender: TObject);
		196	begin
		197	if not ForceDirectories(ExtractFilePath(Application.ExeName) + LVL_PATH) then
		198	begin
9	daniel-mar	199	MessageDlg(Format(LNG_COULD_NOT_CREATE_DIR, [LVL_PATH]), mtError, [mbOK], 0);
1	daniel-mar	200	end;
		201	end;
		202
		203	end.

Subversion Repositories jumper

jumper/trunk/Choice.pas – Rev 21