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


unit Choice;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ImgList, ComCtrls, Menus, ExtCtrls, System.ImageList;
 
type
  TLevelChoice = class(TForm)
    PlayBtn: TButton;
    CancelBtn: TButton;
    LevelImageList: TImageList;
    LevelPopupMenu: TPopupMenu;
    PLoadLevel: TMenuItem;
    PRefreshList: TMenuItem;
    PreviewGrp: TGroupBox;
    PreviewImage: TImage;
    LevelGrp: TGroupBox;
    LevelList: TListView;
    procedure PlayBtnClick(Sender: TObject);
    procedure CancelBtnClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure LevelListClick(Sender: TObject);
    procedure LevelListChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure PRefreshListClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    procedure RefreshList;
  public
    function SelectedLevel: string;
  end;
 
var
  LevelChoice: TLevelChoice;
 
implementation
 
{$R *.dfm}
 
uses
  Functions, LevelFunctions, Constants;
 
function TLevelChoice.SelectedLevel: string;
begin
  result := Format(LVL_FILE, [LevelList.Selected.Caption]);
end;
 
procedure TLevelChoice.PlayBtnClick(Sender: TObject);
var
  Level: TLevel;
begin
  if Assigned(LevelList.Selected) then
  begin
    if LevelList.Selected.ImageIndex = 2 then
    begin
      Level := TLevel.Create(Format(LVL_FILE, [LevelList.Selected.Caption]));
      try
        if Level.CheckLevelIntegrity(true) <> leNone then
        begin
          exit;
        end;
      finally
        FreeAndNil(Level);
      end;
    end;
    ModalResult := mrOk;
  end;
end;
 
procedure TLevelChoice.CancelBtnClick(Sender: TObject);
begin
  ModalResult := mrCancel;
end;
 
procedure TLevelChoice.FormShow(Sender: TObject);
begin
  RefreshList;
end;
 
procedure TLevelChoice.LevelListClick(Sender: TObject);
var
  LevelFile: string;
  Level: TLevel;
begin
  PlayBtn.Enabled := Assigned(LevelList.Selected);
  PLoadLevel.Enabled := Assigned(LevelList.Selected);
 
  if Assigned(LevelList.Selected) then
  begin
    LevelFile := Format(LVL_FILE, [LevelList.Selected.Caption]);
    Level := TLevel.Create(LevelFile);
    try
      DrawLevelPreview(Level, PreviewImage, Color);
    finally
      FreeAndNil(Level);
    end;
  end
  else
  begin
    ClearImage(PreviewImage, Color);
  end;
end;
 
procedure TLevelChoice.LevelListChange(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin
  if Change = ctState then LevelListClick(self);
end;
 
procedure TLevelChoice.PRefreshListClick(Sender: TObject);
begin
  RefreshList;
end;
 
procedure TLevelChoice.RefreshList;
var
  s: TSearchRec;
  Level: TLevel;
begin
  LevelList.Clear;
 
  // Levels auflisten
  if FindFirst(Format(LVL_FILE, ['*']), faAnyFile, s) = 0 then
  begin
    repeat
      with LevelList.Items.Add do
      begin
        Caption := Copy(s.Name, 1, Length(s.Name)-Length(LVL_EXT));
        Level := TLevel.Create(LVL_PATH + s.Name);
 
        if Level.CheckLevelIntegrity <> leNone then
          ImageIndex := 2{Error}
        else case Level.GetGameMode of
          gmNormal: ImageIndex := 0{Normal};
          gmDiagonal: ImageIndex := 1{Diagonal};
          gmUndefined: ImageIndex := 2{Error};
        end;
      end;
    until FindNext(s) <> 0;
    FindClose(s);
  end;
end;
 
procedure TLevelChoice.FormResize(Sender: TObject);
var
  p: integer;
begin
  // WIDTH
  p := ClientWidth - 3*LevelGrp.Left; // 100% useable
  LevelGrp.Width := Round((1-MET_PREVIEW_SIZE_RATIO) * p);
  PreviewGrp.Width := Round(MET_PREVIEW_SIZE_RATIO * p);
  PreviewGrp.Left := 2*LevelGrp.Left + LevelGrp.Width;
  LevelList.Width := LevelGrp.Width - 2*LevelList.Left;
  PreviewImage.Width := PreviewGrp.Width - 2*PreviewImage.Left;
  PlayBtn.Left := (LevelGrp.Left + LevelGrp.Width) - PlayBtn.Width;
 
  // HEIGHT
  LevelGrp.Height := ClientHeight - 3*LevelGrp.Top - PlayBtn.Height;
  PreviewGrp.Height := LevelGrp.Height;
  PlayBtn.Top := 2*LevelGrp.Top + LevelGrp.Height;
  CancelBtn.Top := PlayBtn.Top;
  LevelList.Height := LevelGrp.Height - 2*LevelList.Top;
  PreviewImage.Height := PreviewGrp.Height - 2*PreviewImage.Top;
 
  // TODO: Icons rearrangieren
end;
 
procedure TLevelChoice.FormCreate(Sender: TObject);
begin
  if not ForceDirectories(ExtractFilePath(Application.ExeName) + LVL_PATH) then
  begin
    MessageDlg(Format(LNG_COULD_NOT_CREATE_DIR, [LVL_PATH]), mtError, [mbOK], 0);
  end;
end;
 
end.
 

Rev 11	Rev 18
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;
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;
26	Change: TItemChange);	26	Change: TItemChange);
27	procedure PRefreshListClick(Sender: TObject);	27	procedure PRefreshListClick(Sender: TObject);
28	procedure FormResize(Sender: TObject);	28	procedure FormResize(Sender: TObject);
29	procedure FormCreate(Sender: TObject);	29	procedure FormCreate(Sender: TObject);
30	private	30	private
31	procedure RefreshList;	31	procedure RefreshList;
32	public	32	public
33	function SelectedLevel: string;	33	function SelectedLevel: string;
34	end;	34	end;
35		35
36	var	36	var
37	LevelChoice: TLevelChoice;	37	LevelChoice: TLevelChoice;
38		38
39	implementation	39	implementation
40		40
41	{$R *.dfm}	41	{$R *.dfm}
42		42
43	uses	43	uses
44	Functions, LevelFunctions, Constants;	44	Functions, LevelFunctions, Constants;
45		45
46	function TLevelChoice.SelectedLevel: string;	46	function TLevelChoice.SelectedLevel: string;
47	begin	47	begin
48	result := Format(LVL_FILE, [LevelList.Selected.Caption]);	48	result := Format(LVL_FILE, [LevelList.Selected.Caption]);
49	end;	49	end;
50		50
51	procedure TLevelChoice.PlayBtnClick(Sender: TObject);	51	procedure TLevelChoice.PlayBtnClick(Sender: TObject);
52	var	52	var
53	Level: TLevel;	53	Level: TLevel;
54	begin	54	begin
55	if Assigned(LevelList.Selected) then	55	if Assigned(LevelList.Selected) then
56	begin	56	begin
57	if LevelList.Selected.ImageIndex = 2 then	57	if LevelList.Selected.ImageIndex = 2 then
58	begin	58	begin
59	Level := TLevel.Create(Format(LVL_FILE, [LevelList.Selected.Caption]));	59	Level := TLevel.Create(Format(LVL_FILE, [LevelList.Selected.Caption]));
60	try	60	try
61	if Level.CheckLevelIntegrity(true) <> leNone then	61	if Level.CheckLevelIntegrity(true) <> leNone then
62	begin	62	begin
63	exit;	63	exit;
64	end;	64	end;
65	finally	65	finally
66	FreeAndNil(Level);	66	FreeAndNil(Level);
67	end;	67	end;
68	end;	68	end;
69	ModalResult := mrOk;	69	ModalResult := mrOk;
70	end;	70	end;
71	end;	71	end;
72		72
73	procedure TLevelChoice.CancelBtnClick(Sender: TObject);	73	procedure TLevelChoice.CancelBtnClick(Sender: TObject);
74	begin	74	begin
75	ModalResult := mrCancel;	75	ModalResult := mrCancel;
76	end;	76	end;
77		77
78	procedure TLevelChoice.FormShow(Sender: TObject);	78	procedure TLevelChoice.FormShow(Sender: TObject);
79	begin	79	begin
80	RefreshList;	80	RefreshList;
81	end;	81	end;
82		82
83	procedure TLevelChoice.LevelListClick(Sender: TObject);	83	procedure TLevelChoice.LevelListClick(Sender: TObject);
84	var	84	var
85	LevelFile, LevelString: string;	85	LevelFile: string;
86	Level: TLevel;	86	Level: TLevel;
87	begin	87	begin
88	PlayBtn.Enabled := Assigned(LevelList.Selected);	88	PlayBtn.Enabled := Assigned(LevelList.Selected);
89	PLoadLevel.Enabled := Assigned(LevelList.Selected);	89	PLoadLevel.Enabled := Assigned(LevelList.Selected);
90		90
91	if Assigned(LevelList.Selected) then	91	if Assigned(LevelList.Selected) then
92	begin	92	begin
93	LevelFile := Format(LVL_FILE, [LevelList.Selected.Caption]);	93	LevelFile := Format(LVL_FILE, [LevelList.Selected.Caption]);
94	Level := TLevel.Create(LevelFile);	94	Level := TLevel.Create(LevelFile);
95	try	95	try
96	DrawLevelPreview(Level, PreviewImage, Color);	96	DrawLevelPreview(Level, PreviewImage, Color);
97	finally	97	finally
98	FreeAndNil(Level);	98	FreeAndNil(Level);
99	end;	99	end;
100	end	100	end
101	else	101	else
102	begin	102	begin
103	ClearImage(PreviewImage, Color);	103	ClearImage(PreviewImage, Color);
104	end;	104	end;
105	end;	105	end;
106		106
107	procedure TLevelChoice.LevelListChange(Sender: TObject; Item: TListItem;	107	procedure TLevelChoice.LevelListChange(Sender: TObject; Item: TListItem;
108	Change: TItemChange);	108	Change: TItemChange);
109	begin	109	begin
110	if Change = ctState then LevelListClick(self);	110	if Change = ctState then LevelListClick(self);
111	end;	111	end;
112		112
113	procedure TLevelChoice.PRefreshListClick(Sender: TObject);	113	procedure TLevelChoice.PRefreshListClick(Sender: TObject);
114	begin	114	begin
115	RefreshList;	115	RefreshList;
116	end;	116	end;
117		117
118	procedure TLevelChoice.RefreshList;	118	procedure TLevelChoice.RefreshList;
119	var	119	var
120	s: TSearchRec;	120	s: TSearchRec;
121	Level: TLevel;	121	Level: TLevel;
122	begin	122	begin
123	LevelList.Clear;	123	LevelList.Clear;
124		124
125	// Levels auflisten	125	// Levels auflisten
126	if FindFirst(Format(LVL_FILE, ['*']), faAnyFile, s) = 0 then	126	if FindFirst(Format(LVL_FILE, ['*']), faAnyFile, s) = 0 then
127	begin	127	begin
128	repeat	128	repeat
129	with LevelList.Items.Add do	129	with LevelList.Items.Add do
130	begin	130	begin
131	Caption := Copy(s.Name, 1, Length(s.Name)-Length(LVL_EXT));	131	Caption := Copy(s.Name, 1, Length(s.Name)-Length(LVL_EXT));
132	Level := TLevel.Create(LVL_PATH + s.Name);	132	Level := TLevel.Create(LVL_PATH + s.Name);
-		133
-		134	if Level.CheckLevelIntegrity <> leNone then
-		135	ImageIndex := 2{Error}
133	case Level.GetGameMode of	136	else case Level.GetGameMode of
134	gmNormal: ImageIndex := 0;	137	gmNormal: ImageIndex := 0{Normal};
135	gmDiagonal: ImageIndex := 1;	138	gmDiagonal: ImageIndex := 1{Diagonal};
136	gmUndefined: ImageIndex := 2;	139	gmUndefined: ImageIndex := 2{Error};
137	end;	140	end;
138	end;	141	end;
139	until FindNext(s) <> 0;	142	until FindNext(s) <> 0;
140	FindClose(s);	143	FindClose(s);
141	end;	144	end;
142	end;	145	end;
143		146
144	procedure TLevelChoice.FormResize(Sender: TObject);	147	procedure TLevelChoice.FormResize(Sender: TObject);
145	var	148	var
146	p: integer;	149	p: integer;
147	begin	150	begin
148	// WIDTH	151	// WIDTH
149	p := ClientWidth - 3*LevelGrp.Left; // 100% useable	152	p := ClientWidth - 3*LevelGrp.Left; // 100% useable
150	LevelGrp.Width := Round((1-MET_PREVIEW_SIZE_RATIO) * p);	153	LevelGrp.Width := Round((1-MET_PREVIEW_SIZE_RATIO) * p);
151	PreviewGrp.Width := Round(MET_PREVIEW_SIZE_RATIO * p);	154	PreviewGrp.Width := Round(MET_PREVIEW_SIZE_RATIO * p);
152	PreviewGrp.Left := 2*LevelGrp.Left + LevelGrp.Width;	155	PreviewGrp.Left := 2*LevelGrp.Left + LevelGrp.Width;
153	LevelList.Width := LevelGrp.Width - 2*LevelList.Left;	156	LevelList.Width := LevelGrp.Width - 2*LevelList.Left;
154	PreviewImage.Width := PreviewGrp.Width - 2*PreviewImage.Left;	157	PreviewImage.Width := PreviewGrp.Width - 2*PreviewImage.Left;
155	PlayBtn.Left := (LevelGrp.Left + LevelGrp.Width) - PlayBtn.Width;	158	PlayBtn.Left := (LevelGrp.Left + LevelGrp.Width) - PlayBtn.Width;
156		159
157	// HEIGHT	160	// HEIGHT
158	LevelGrp.Height := ClientHeight - 3*LevelGrp.Top - PlayBtn.Height;	161	LevelGrp.Height := ClientHeight - 3*LevelGrp.Top - PlayBtn.Height;
159	PreviewGrp.Height := LevelGrp.Height;	162	PreviewGrp.Height := LevelGrp.Height;
160	PlayBtn.Top := 2*LevelGrp.Top + LevelGrp.Height;	163	PlayBtn.Top := 2*LevelGrp.Top + LevelGrp.Height;
161	CancelBtn.Top := PlayBtn.Top;	164	CancelBtn.Top := PlayBtn.Top;
162	LevelList.Height := LevelGrp.Height - 2*LevelList.Top;	165	LevelList.Height := LevelGrp.Height - 2*LevelList.Top;
163	PreviewImage.Height := PreviewGrp.Height - 2*PreviewImage.Top;	166	PreviewImage.Height := PreviewGrp.Height - 2*PreviewImage.Top;
164		167
165	// TODO: Icons rearrangieren	168	// TODO: Icons rearrangieren
166	end;	169	end;
167		170
168	procedure TLevelChoice.FormCreate(Sender: TObject);	171	procedure TLevelChoice.FormCreate(Sender: TObject);
169	begin	172	begin
170	if not ForceDirectories(ExtractFilePath(Application.ExeName) + LVL_PATH) then	173	if not ForceDirectories(ExtractFilePath(Application.ExeName) + LVL_PATH) then
171	begin	174	begin
172	MessageDlg(Format(LNG_COULD_NOT_CREATE_DIR, [LVL_PATH]), mtError, [mbOK], 0);	175	MessageDlg(Format(LNG_COULD_NOT_CREATE_DIR, [LVL_PATH]), mtError, [mbOK], 0);
173	end;	176	end;
174	end;	177	end;
175		178
176	end.	179	end.
177		180

Subversion Repositories jumper

jumper/trunk/Choice.pas – Rev 11 → 18