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


unit Choice;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ImgList, ComCtrls, Menus, ExtCtrls, 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
  PlaygroundMatrix: TPlayGroundMatrix;
  y, x: integer;
 
  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;
 
 
 
  ClearImage(Image, BackgroundColor);
 
  Level.FillPlaygroundMatrix(PlaygroundMatrix, false);
  try
    for x := Low(PlaygroundMatrix.Fields) to High(PlaygroundMatrix.Fields) do
    begin
      for y := Low(PlaygroundMatrix.Fields[x]) to High(PlaygroundMatrix.Fields[x]) do
      begin
        // Rectange filling
        case PlaygroundMatrix.Fields[x,y].FieldType of
 
 
          ftFullSpace: Image.Canvas.Brush.Color := BackgroundColor; // invisible
          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;
 
        // Rectangle border
        if PlaygroundMatrix.Fields[x,y].Goal then
          Image.Canvas.Pen.Color := clBlack
        else
        begin
          if PlaygroundMatrix.Fields[x,y].FieldType = ftFullSpace then
            Image.Canvas.Pen.Color := BackgroundColor // invisible
          else
            Image.Canvas.Pen.Color := clLtGray;
        end;
 
        // Draw the rectangle
        indent := PlaygroundMatrix.Fields[x,y].Indent;
        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;
  finally
    PlaygroundMatrix.ClearMatrix(true);
  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 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(xPREVIEW_BLOCK_SIZE + indentPREVIEW_TAB_SIZE,	90	Image.Canvas.Rectangle(xPREVIEW_BLOCK_SIZE + indentPREVIEW_TAB_SIZE,
87	y*PREVIEW_BLOCK_SIZE,	91	y*PREVIEW_BLOCK_SIZE,
88	xPREVIEW_BLOCK_SIZE + indentPREVIEW_TAB_SIZE + PREVIEW_BLOCK_SIZE,	92	xPREVIEW_BLOCK_SIZE + indentPREVIEW_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

Subversion Repositories jumper

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