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

Subversion Repositories jumper

jumper/trunk/Choice.pas – Rev 21 → 22