home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Kinjite Games 1996 November
/
SENTINEL.img
/
wingames
/
sports
/
nfltpw
/
nfltpw.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-12-15
|
42KB
|
1,361 lines
Program NFLTPW;
{$r nfltpw.res}
uses WinTypes, WinProcs, WObjects, Printer,
win31,bitmap,Strings,stddlgs;
const
MaxTeams = 28;
MaxGames = 14;
MaxWeeks = 18;
PlayerNameSize = 20;
ScoreFieldSize = 3;
TeamNameSize = 25;
DLLName = 'NFLLIB.DLL';
em_DLLNotFound = 1;
cm_PlayerMaint = 102;
cm_DeletePlayers = 103;
cm_DeleteSchedule = 104;
cm_EnterSchedule = 105;
cm_EnterPicks = 202;
cm_EnterScores = 203;
cm_PrintSchedule = 301;
cm_PrintResults = 302;
cm_SetupPrinter = 303;
cm_about = 401;
id_AddPlayer = 102;
id_DeletePlayer = 103;
id_BoxMask = 100;
id_ButtonMask = 100;
id_TeamMask = 200;
id_week = 11;
id_PlayerCombo = 12;
id_PickPoints = 13;
id_PlayerBox = 101;
id_Transparent = 10;
type
pMyDialog = ^tMyDialog;
tmyDialog = object(tDialog)
constructor init(aParent:pWindowsObject; aName:pChar);
procedure wmCtlColor(var Msg:tMessage);
virtual wm_first + wm_CtlColor;
end;
PickType = (Visitor,Home,None);
tNFLApp = object(tApplication)
Lib: THandle;
constructor Init(AName: PChar);
destructor done; virtual;
procedure InitMainWindow; virtual;
procedure WritePlayerList; virtual;
end;
pMyListBox = ^tMyListBox;
tmyListBox = object(tlistbox)
procedure wmVScroll(var msg:tmessage); virtual wm_first + wm_VScroll;
end;
procedure tmylistbox.wmVScroll(var msg:tmessage);
begin
case msg.wparam of
sb_LineDown:
if GetSelIndex <> getcount then
begin
SetSelIndex(GetSelIndex + 1);
sendmessage(Parent^.hwindow,wm_command,getid,
hwindow or (lbn_selchange shl 16));
end;
sb_LineUp :
if GetSelIndex <> 0 then
begin
SetSelIndex(GetSelIndex - 1);
sendmessage(Parent^.hwindow,wm_command,getid,
hwindow or (lbn_selchange shl 16));
end;
else DefWndProc(msg);
end;
end;
var NFLApp : tNFLApp;
constructor tmydialog.init(aParent:pWindowsObject; aName:pChar);
begin
tdialog.init(aparent,aname);
end;
type
ListRec = record
ListStrings : pStrCollection;
ListSelection : integer;
end;
ComboRec = record
ComboStrings : pStrCollection;
ComboSelection : array[0..20] of Char;
end;
SchdTransferRec = record
STRWeek : ListRec;
STRTeams : array[1..MaxTeams] of ComboRec;
end;
TeamRec = record
Name : array[0..PlayerNameSize] of char;
Score : array[0..3] of char;
end;
Scores = record
Score : array [1..MaxGames,0..1] of byte;
end;
Schedule = record
Team : array [1..MaxGames,0..1] of byte;
GameScore : Scores
end;
PickData = record
GamePick : array [1..14] of word;
MNFScore : integer;
end;
ResultData = record
Wins,
Losses,
Ties,
PtDiff : word;
end;
Player = record
Name : pchar;
PickRec : array [1..MaxWeeks] of PickData;
Results : array [1..MaxWeeks] of ResultData;
end;
tPickRec = array [1..MaxWeeks] of PickData;
tResults = array [1..MaxWeeks] of ResultData;
pPlayer = ^tPlayer;
tPlayer = object(tObject)
Name : pchar;
PickRec : tPickRec;
Results : tResults;
constructor init(NewName : pchar;
NewPickRec : tPickRec;
NewResults : tResults);
constructor Load(var s:tstream);
procedure Store(var s:tstream); virtual;
destructor Done; virtual;
end;
tPlayerCollection = record
vs : pstringcollection;
focus : word;
end;
const
rPlayer : tstreamrec = (
objtype : 150;
vmtlink: ofs(typeof(tplayer)^);
load : @tplayer.load;
store: @tplayer.store);
constructor tPlayer.Init(NewName : pchar;
NewPickRec : tPickRec;
NewResults : tResults);
begin
tobject.init;
Name := NewName;
PickRec := NewPickRec;
Results := NewResults;
end;
constructor tplayer.load(var s:tstream);
begin
name := s.strread;
s.read(pickrec,sizeof(pickrec));
s.read(results,sizeof(results));
end;
procedure tplayer.store(var s:tstream);
begin
s.strwrite(Name);
s.write(PickRec,sizeof(PickRec));
s.write(Results,sizeof(Results));
end;
destructor tPlayer.done;
begin
StrDispose(Name);
tobject.done;
end;
type
pStandings = ^tStandings;
tStandings = object(tObject)
Wins,
Losses,
Ties,
PtDiff : word;
Name : pchar;
constructor init(NewName : pchar;
NewWins,
NewLosses,
NewTies,
NewPtDiff : word);
destructor Done; virtual;
end;
constructor tStandings.init(NewName : pchar;
NewWins,
NewLosses,
NewTies,
NewPtDiff : word);
begin
tobject.init;
Name := NewName;
Wins := newwins;
Losses := newlosses;
ties := newties;
PtDiff := newptdiff;
end;
destructor tStandings.done;
begin
tobject.done;
end;
type
pStandingsCollection = ^tStandingsCollection;
tStandingsCollection = object(tSortedCollection)
function KeyOf(Item:pointer): pointer; virtual;
function Compare(key1, key2: pointer):integer; virtual;
end;
function tStandingsCollection.KeyOf(item:pointer): pointer;
begin
KeyOf := pstandings(item);
end;
function tStandingsCollection.Compare(key1,key2:pointer):integer;
begin
if pstandings(key1)^.Wins < pstandings(key2)^.Wins
then compare := 1
else if pstandings(key1)^.Wins > pstandings(key2)^.Wins
then compare := -1
else if pstandings(key1)^.PtDiff > pstandings(key2)^.PtDiff
then compare := 1
else compare := -1;
end;
type
pSchedule = ^tSchedule;
tSchedule = object(tObject)
ScheduleRec : Schedule;
constructor init(NewSchedule : Schedule);
constructor load(var s:tBufStream);
procedure store(var s:tBufStream); virtual;
destructor done; virtual;
end;
pNumericEdit = ^tNumericEdit;
tNumericEdit = object(tEdit)
procedure wmchar(var Msg:tMessage);virtual Wm_first + wm_char;
end;
pSchDialog = ^tSchDialog;
tSchDialog = object(tMyDialog)
sWeek : pMyListBox;
combo : array [1..MaxTeams] of pcombobox;
constructor init(aParent:pWindowsObject; aName:pChar);
procedure setupwindow; virtual;
procedure StoreSched;
procedure Ok(var Msg: TMessage);
virtual id_First + id_ok;
procedure HandleListBox(var Msg:tMessage);
virtual id_first + id_Week;
end;
pScoreDialog = ^tScoreDialog;
tScoreDialog = object(tMyDialog)
scoreWeek : pMyListBox;
TeamName : array [1..MaxTeams] of pStatic;
ScoreEdit : array [1..MaxTeams] of pNumericEdit;
constructor init(aParent:pWindowsObject; aName:pChar);
procedure SetupWindow; virtual;
procedure BuildSchedule;
procedure StoreScores;
procedure Ok(var Msg: TMessage);
virtual id_First + id_ok;
procedure HandleListBox(var Msg:tMessage);
virtual id_first + id_Week;
procedure wmCtlColor(var Msg:tMessage);
virtual wm_first + wm_CtlColor;
end;
pPrintSchedDlg = ^tPrintSchedDlg;
tPrintSchedDlg = object(tMyDialog)
PrintWeek : pMyListBox;
constructor init(aParent:pWindowsObject; aName:pChar);
procedure setupwindow; virtual;
procedure HandleListBox(var Msg:tMessage);
virtual id_first + id_Week;
end;
pPicksDialog = ^tPicksDialog;
tPicksDialog = object(tMyDialog)
PickWeek : pMyListBox;
PickPlayer : pComboBox;
PickPoints : pNumericEdit;
FoundPlayer: pPlayer;
ButtonName : array [1..maxteams*3] of pRadioButton;
constructor init(aParent:pWindowsObject; aName:pChar);
destructor done; virtual;
procedure setupwindow; virtual;
procedure StorePicks;
procedure BuildButtons;
procedure Cancel(var Msg: TMessage);
virtual id_First + id_Cancel;
procedure OK(var Msg: TMessage);
virtual id_First + id_OK;
procedure HandleListBox(var Msg:tMessage);
virtual id_first + id_Week;
procedure HandleComboBox(var Msg:tMessage);
virtual id_first + id_PlayerCombo;
end;
pPlayerMaintDlg = ^tPlayerMaintDlg;
tPlayerMaintDlg = object(tMyDialog)
PlayerListBox : pMyListBox;
constructor init(aParent:pWindowsObject; aName:pChar);
destructor done; virtual;
procedure setupwindow; virtual;
procedure DeletePlayer (var Msg:tMessage);
virtual id_first + id_DeletePlayer;
procedure AddPlayer (var Msg:tMessage);
virtual id_first + id_AddPlayer;
end;
pNFLWindow = ^tNFLWindow;
tNFLWindow = object(tWindow)
nflicon : hicon;
LogoBitmap : pTBMP;
constructor init(AParent:pWindowsObject; ATitle:pChar);
destructor done; virtual;
procedure GetWindowClass(var WndClass : tWndClass); virtual;
procedure Paint(PaintDC : HDC; var PaintInfo : TPaintStruct); virtual;
procedure Schedule (var Msg: TMessage);
virtual cm_First + cm_EnterSchedule;
procedure PlayerMaint (var Msg: TMessage);
virtual cm_First + cm_PlayerMaint;
procedure DeleteSched (var msg:tmessage);
virtual cm_first + cm_DeleteSchedule;
procedure DeletePlayers(var msg:tmessage);
virtual cm_first + cm_DeletePlayers;
procedure Scores (var Msg: TMessage);
virtual cm_First + cm_EnterScores;
procedure PrintSchedule(var Msg: TMessage);
virtual cm_First + cm_PrintSchedule;
procedure PrintResults (var Msg: TMessage);
virtual cm_First + cm_PrintResults;
procedure SetUpPrinter (var Msg: TMessage);
virtual cm_First + cm_SetUpPrinter;
procedure EnterPicks (var msg: tMessage);
virtual cm_First + cm_EnterPicks;
procedure AboutBox (var msg: tMessage);
virtual cm_First + cm_About;
end;
pPrintItOut = ^tPrintItOut;
tPrintItOut = object(tPrintout)
maxX : word; {max width of page}
maxY : word; {max height of page}
posX : word; {current column}
posY : word; {current row}
Height : word;
Width : word;
metrics : TTextMetric; {text metric information}
myfont : tlogfont;
thefont : hfont;
ps : tpoint;
PixX,PixY,Center,
PageVert,PageHorz : integer;
procedure selectfont(dc:hdc; LinesPerPage,CharsPerLine:word);
procedure PrintPage(DC:HDC; page:word; Size:tPoint;
var Rect:tRect; Flags:word); virtual;
end;
pPrintResultsOut = ^tPrintResultsOut;
tPrintResultsOut = object(tPrintItOut)
procedure PrintPage(DC:HDC; page:word; Size:tPoint;
var Rect:tRect; Flags:word); virtual;
end;
MyLong = record
case integer of
0 : (TheLong: Longint);
1 : (lo :word;
Hi : word);
end;
var
week : integer;
aLong : myLong;
SchedBuffer : SchdTransferRec;
SchedColl : pStrCollection;
ScheduleStream: tBufStream;
PlayerStream : tBufStream;
PlayerList : pCollection;
PlayerRec : Player;
PlayerCollection : ListRec;
SchedRec : pSchedule;
vSchedule : Schedule;
vPickRec : tPickRec;
vResults : tResults;
defaultprinter: pPrinter;
const
WeekStr : array [1..MaxWeeks] of array[0..255] of char =
(' 1',' 2',' 3',' 4',' 5',' 6',' 7',' 8',' 9','10','11','12','13','14','15','16','17','18');
rSchedule : tstreamrec = (
objtype : 151;
vmtlink: ofs(typeof(tSchedule)^);
load : @tSchedule.load;
store: @tSchedule.store);
constructor tSchedule.init(NewSchedule:Schedule);
begin
tobject.init;
ScheduleRec := NewSchedule;
end;
constructor tSchedule.load(var s:tBufStream);
begin
s.read(ScheduleRec,sizeof(ScheduleRec));
end;
procedure tSchedule.Store(var s:tBufStream);
begin
s.write(ScheduleRec,sizeof(ScheduleRec));
end;
destructor tSchedule.done;
begin
tobject.Done;
end;
procedure tMyDialog.wmCtlColor(var msg:tmessage);
begin
case msg.lparamhi of
ctlColor_static:
begin
msg.result:= GetStockObject(Null_Brush);
SetBkMode(msg.wparam,Transparent);
end;
ctlColor_Btn :
begin
msg.result:= GetStockObject(ltgray_Brush);
SetBkMode(msg.wparam,Transparent);
end;
else defwndproc(msg);
end; {case}
end;
procedure tScoreDialog.wmCtlColor(var msg:tmessage);
begin
case msg.lparamhi of
CtlColor_static:
begin
case GetDlgCtrlID(msg.lParamLo) of
id_Transparent : msg.result:= GetStockObject(Null_Brush);
else msg.result:= GetStockObject(ltGray_Brush);
end; {case}
SetBkMode(msg.wparam,transparent);
end;
else tMyDialog.wmCtlColor(msg);
end;
end;
procedure tNumericEdit.wmChar(var Msg : tMessage);
begin
if (msg.message = wm_char)
and not (msg.wParam in [8,48..57])
then messagebeep(0)
else defwndproc(msg);
end;
constructor tNFLApp.Init(AName: PChar);
var x,w,g : integer;
begin
Week := 1;
Lib := LoadLibrary(DLLName);
if Lib < 32 then Status := em_DLLNotFound;
TApplication.Init(AName);
registertype(rSchedule);
registertype(rPlayer);
registerwobjects;
ScheduleStream.init('NflSch.stm',stOpen,512);
schedrec := new(pSchedule, init(vSchedule));
PlayerStream.init('NFLPlayr.stm',stOpen,512);
playerlist := pcollection(PlayerStream.get);
PlayerStream.done;
end;
procedure tNFLApp.WritePlayerList;
var x:integer;
begin
PlayerStream.init('NFLPlayr.stm',stopen,512);
PlayerStream.put(playerlist);
PlayerStream.done;
end;
destructor tNFLApp.Done;
begin
ScheduleStream.done;
WritePlayerList;
if playerlist <> nil
then Dispose(playerlist,done);
if DefaultPrinter <> nil
then dispose(DefaultPrinter,done);
TApplication.Done;
FreeLibrary(Lib);
end;
procedure tNFLWindow.DeleteSched(var Msg: TMessage);
var
c,g,t,SchedKey : word;
begin
c:=MessageBox(hWindow,'Do you really want to delete the schedule?',
'Delete Schedule', mb_OKCancel or mb_iconstop);
if c = id_OK then
begin
ScheduleStream.done;
ScheduleStream.init('nflsch.stm',stCreate,512);
for SchedKey:=1 to MaxWeeks do
begin
for g := 1 to MaxGames do
for t := 0 to 1 do
with SchedRec^.ScheduleRec do
begin
Team[g,t] := 0;
GameScore.Score[g,t] := 0;
end;
ScheduleStream.put(Schedrec);
end;
ScheduleStream.done;
ScheduleStream.init('NflSch.stm',stOpen,512);
end;
end;
procedure tNFLWindow.Schedule(var Msg: TMessage);
begin
Application^.ExecDialog(new(pSchDialog,init(@self,'Schedule')));
end;
procedure tNFLWindow.Scores(var Msg: TMessage);
begin
Application^.ExecDialog(new(pScoreDialog,init(@self,'Scores')));
end;
procedure tNFLWindow.PrintSchedule(var Msg: TMessage);
var Printout : pPrintItOut;
begin
if (Application^.ExecDialog(new
(pPrintSchedDlg,init(@self,'PrintSchedule'))) = id_ok) then
begin
ScheduleStream.seek((Week-1)*(sizeof(schedrec^.schedulerec)+2));
SchedRec := pSchedule(ScheduleStream.get);
if DefaultPrinter = nil
then DefaultPrinter := New(PPrinter, Init);
printout := new(pPrintItOut,init('NFL Schedule'));
defaultprinter^.Print(@self,printout);
dispose(printout,done);
end;
end;
procedure tNFLWindow.PrintResults(var Msg: TMessage);
var Printout : pPrintResultsOut;
begin
if (Application^.ExecDialog(
new(pPrintSchedDlg,init(@self,'PrintResults'))) = id_ok) then
begin
ScheduleStream.seek((Week-1)*(sizeof(schedrec^.schedulerec)+2));
SchedRec := pSchedule(ScheduleStream.get);
if DefaultPrinter = nil
then DefaultPrinter := New(PPrinter, Init);
printout := new(pPrintResultsOut,init('NFL Results'));
defaultprinter^.Print(@self,printout);
dispose(printout,done);
end;
end;
procedure tNFLWindow.SetUpPrinter(var Msg: TMessage);
begin
if DefaultPrinter = nil
then DefaultPrinter := New(PPrinter, Init);
DefaultPrinter^.Setup(@self);
end;
constructor tSchDialog.Init(aParent:pWindowsObject; aName:pChar);
var x : word;
begin
tDialog.init(aParent,aName);
new(sWeek, initResource(@self,id_Week));
for x := 1 to MaxTeams
do
begin
new(combo[x], InitResource(@self,id_BoxMask+x,
sizeof(SchedBuffer.StrTeams[x].ComboSelection)));
end;
TransferBuffer := @SchedBuffer;
end;
procedure tSchDialog.SetUpWindow;
var TextItem : array [0..255] of char;
x,y,g,t : word;
begin
ScheduleStream.seek((Week-1)*(sizeof(schedrec^.schedulerec)+2));
SchedRec := pSchedule(ScheduleStream.get);
tdialog.Setupwindow;
TransferData(tf_SetData);
x:= 1;
for g := 1 to MaxGames do
for t := 0 to 1 do
with SchedRec^.ScheduleRec do
begin
y := team[g,t];
combo[x]^.setselindex(Team[g,t]);
inc(x);
end;
end;
procedure tSchDialog.StoreSched;
var g,t,x,y : word;
begin
x := 1;
for g := 1 to MaxGames do
for t := 0 to 1 do
with SchedRec^.ScheduleRec do
begin
y := team[g,t];
team[g,t] := combo[x]^.GetSelIndex;
inc(x);
end;
ScheduleStream.seek((Week-1)*(sizeof(schedrec^.schedulerec)+2));
ScheduleStream.put(Schedrec);
end;
procedure tSchDialog.HandleListBox(var Msg: TMessage);
var x,y,g,t : word;
begin
if Msg.lParamHi = lbn_SelChange then
begin
StoreSched;
Week := sWeek^.GetSelIndex+1;
ScheduleStream.seek((Week-1)*(sizeof(schedrec^.schedulerec)+2));
SchedRec := pSchedule(ScheduleStream.get);
x:= 1;
for g := 1 to MaxGames do
for t := 0 to 1 do
with SchedRec^.ScheduleRec do
begin
y := team[g,t];
combo[x]^.setselindex(Team[g,t]);
inc(x);
end;
TransferData(tf_GetData);
end
else DefWndProc(msg);
end;
procedure tSchDialog.OK(var Msg: TMessage);
var g,t,x,y : word;
begin
x := 1;
for g := 1 to MaxGames do
for t := 0 to 1 do
with SchedRec^.ScheduleRec do
begin
y := team[g,t];
team[g,t] := combo[x]^.GetSelIndex;
inc(x);
end;
tDialog.ok(Msg);
ScheduleStream.seek((Week-1)*(sizeof(schedrec^.schedulerec)+2));
ScheduleStream.put(Schedrec);
end;
constructor tPrintSchedDlg.Init(aParent:pWindowsObject; aName:pChar);
var x : word;
begin
tDialog.init(aParent,aName);
new(PrintWeek, initResource(@self,id_Week));
end;
procedure tPrintSchedDlg.SetUpWindow;
var x : integer;
begin
tdialog.Setupwindow;
for x := 1 to MaxWeeks
do PrintWeek^.AddString(WeekStr[x]);
PrintWeek^.SetSelIndex(Week-1);
end;
procedure tPrintSchedDlg.HandleListBox(var Msg: TMessage);
begin
if Msg.lParamHi = lbn_SelChange then
begin
Week := PrintWeek^.GetSelIndex+1;
SchedBuffer.strWeek.ListSelection := week - 1;
end
else DefWndProc(msg);
end;
constructor tScoreDialog.Init(aParent:pWindowsObject; aName:pChar);
var x : word;
begin
tDialog.init(aParent,aName);
new(scoreWeek, initResource(@self,id_Week));
for x := 1 to MaxTeams
do
begin
new(TeamName[x], InitResource(@self,id_TeamMask+x,TeamNameSize));
new(ScoreEdit[x], InitResource(@self,id_BoxMask+x,ScoreFieldSize));
end;
end;
procedure tScoreDialog.BuildSchedule;
var x,y,g,t : word;
msg : tmessage;
OutStr : array[0..4] of char;
s : string;
begin
ScheduleStream.seek((Week-1)*(sizeof(schedrec^.schedulerec)+2));
SchedRec := pSchedule(ScheduleStream.get);
x:= 1;
for g := 1 to MaxGames do
for t := 0 to 1 do
with SchedRec^.ScheduleRec do
begin
str(gamescore.score[g,t]:3,s);
if (team[g,t] = 0) and
(gamescore.score[g,t] = 0)
then OutStr[0] := #00
else strpcopy(outstr,s);
SetDlgItemText(hWindow,id_BoxMask + x,strnew(outstr));
SetDlgItemText(hWindow,id_TeamMask + x,
pChar(SchedColl^.at(team[g,t])));
if OutStr[0] = #00
then ScoreEdit[x]^.Show(sw_Hide)
else ScoreEdit[x]^.Show(sw_Show);
inc(x);
end;
end;
procedure tScoreDialog.StoreScores;
var x,g,t : word;
ScoreStr : array [0..4] of char;
result : integer;
begin
x:= 1;
for g := 1 to MaxGames do
for t := 0 to 1 do
with SchedRec^.ScheduleRec do
begin
ScoreEdit[x]^.GetSubText(ScoreStr,0,3);
val(strpas(scorestr),GameScore.Score[g,t],result);
inc(x);
end;
ScheduleStream.seek((Week-1)*(sizeof(schedrec^.schedulerec)+2));
ScheduleStream.put(Schedrec);
end;
procedure tScoreDialog.SetUpWindow;
var x : word;
begin
tdialog.Setupwindow;
for x := 1 to MaxWeeks
do ScoreWeek^.AddString(WeekStr[x]);
ScoreWeek^.SetSelIndex(Week-1);
BuildSchedule;
end;
procedure tScoreDialog.HandleListBox(var Msg: TMessage);
begin
if Msg.lParamHi = lbn_SelChange then
begin
StoreScores;
Week := ScoreWeek^.GetSelIndex+1;
BuildSchedule;
SchedBuffer.strWeek.ListSelection := week - 1;
end
else DefWndProc(msg);
end;
procedure tScoreDialog.OK(var Msg: TMessage);
var g,t,x,y,result : word;
begin
StoreScores;
tDialog.ok(Msg);
end;
constructor tNFLWindow.Init(AParent:pWindowsObject; ATitle:pChar);
var x,y : word;
textitem : array [0..255] of Char;
result : integer;
begin
SchedColl := new(pStrCollection, init(29,0));
SchedBuffer.strWeek.ListStrings := new(pStrCollection, init(MaxWeeks,0));
for x:= 1 to MaxWeeks do
begin
SchedBuffer.strWeek.ListStrings^.insert(@WeekStr[x]);
end;
for x:= 0 to MaxTeams do
begin
LoadString(hInstance, x, @textitem,
sizeof(SchedBuffer.strTeams[x].ComboSelection));
SchedColl^.insert(StrNew(@TextItem));
end;
for y := 1 to MaxTeams do
begin
SchedBuffer.strteams[y].ComboStrings := schedcoll;
end;
SchedBuffer.strWeek.ListSelection := week - 1;
tWindow.Init(AParent,ATitle);
Attr.Menu := LoadMenu(HInstance, 'MainMenu');
LogoBitmap := new(pTBMP, init('NFL'));
if not logobitmap^.LoadBitmapFile('NFL.BMP')
then MessageBox(hwindow,'Could Not Load Logo','ERROR',mb_ok);
end;
procedure tNFLWindow.Paint(PaintDC : HDC; var PaintInfo : TPaintStruct);
var
PictRect : trect;
scale : boolean;
begin
scale := true;
getclientrect(hwindow,pictrect);
LogoBitmap^.Draw(PaintDC,PictRect,Scale);
end;
procedure TNFLWindow.GetWindowClass;
begin
TWindow.GetWindowClass(WndClass);
NflIcon := LoadIcon(HInstance,'NFL');
WndClass.hIcon := NFLIcon;
end;
procedure tNFLwindow.AboutBox(var msg: tMessage);
var dlg : pmydialog;
begin
dlg := new(pMydialog,init(@self,'About'));
Application^.execdialog(dlg);
end;
procedure tNFLwindow.EnterPicks(var msg: tMessage);
begin
Application^.execdialog(new(pPicksdialog,init(@self,'Picks')));
end;
constructor tPicksDialog.init(aParent:pWindowsObject; aName:pChar);
var x : word;
begin
tdialog.init(aParent,aName);
new(PickWeek, InitResource(@self, Id_week));
new(PickPlayer, initResource(@self,id_PlayerCombo,PlayerNameSize));
for x := 1 to maxgames*3
do new(ButtonName[x], InitResource(@self,id_ButtonMask+x));
new(PickPoints, InitResource(@self,id_PickPoints,4));
end;
procedure tPicksDialog.BuildButtons;
var x,y,z : word;
s : string;
p : Array [0..3] of Char;
Hidden : boolean;
PlayerName : array[0..PlayerNameSize] of char;
function FindPlayer(P:pPlayer) : boolean; far;
begin
FindPlayer := StrComp(P^.Name,PlayerName) = 0;
end;
function CheckState(P:PickType) : word;
begin
if ((FoundPlayer^.PickRec[Week].GamePick[x]) = ord(p))
then CheckState := 1
else CheckState := 0;
end;
begin
ScheduleStream.seek((Week-1)*(sizeof(schedrec^.schedulerec)+2));
SchedRec := pSchedule(ScheduleStream.get);
PickPlayer^.GetSelString(PlayerName,PlayerNameSize);
FoundPlayer := PlayerList^.FirstThat(@FindPlayer);
if FoundPlayer = nil
then exit;
z := 1;
for x:= 1 to MaxGames do
begin
for y:= 0 to 2 do
begin
case y of
0,1 :
begin
SetDlgItemText(hWindow,id_ButtonMask+z,
pChar(SchedColl^.at(SchedRec^.Schedulerec.team[x,y])));
if StrLen(pChar(SchedColl^.at(SchedRec^.Schedulerec.team[x,y]))) < 2
then Hidden := true
else Hidden := false;
end;
2 : SetDlgItemText(hWindow,id_ButtonMask+z,'None');
end; {case}
if Hidden
then ButtonName[z]^.Show(sw_Hide)
else ButtonName[z]^.Show(sw_show);
Inc(z);
end;
ButtonName[x*3-2]^.SetCheck(CheckState(Visitor));
ButtonName[x*3-1]^.SetCheck(CheckState(Home));
ButtonName[x*3 ]^.SetCheck(CheckState(None));
end;
str(FoundPlayer^.PickRec[Week].MNFScore,s);
strpcopy(p,s);
SetDlgItemText(hWindow,id_PickPoints,p);
end;
procedure tPicksDialog.StorePicks;
var x,
result,
Score : word;
p : array[0..3] of Char;
StartPos, EndPos: integer;
begin
for x:= 1 to MaxGames do
if ButtonName[x*3-2]^.GetCheck = bf_Checked
then FoundPlayer^.PickRec[Week].GamePick[x] := 0
else if ButtonName[x*3-1]^.GetCheck = bf_Checked
then FoundPlayer^.PickRec[Week].GamePick[x] := 1
else if ButtonName[x*3 ]^.GetCheck = bf_Checked
then FoundPlayer^.PickRec[Week].GamePick[x] := 2;
PickPoints^.GetSubText(p,0,3);
val(strpas(p),Score,Result);
FoundPlayer^.PickRec[Week].MNFScore := score;
end;
procedure tPicksDialog.SetUpWindow;
procedure BuildList(P:pPlayer); far;
begin
PickPlayer^.addString(StrNew(P^.Name));
end;
var x:word;
msg:tmessage;
begin
tdialog.Setupwindow;
for x := 1 to MaxWeeks
do PickWeek^.AddString(WeekStr[x]);
PickWeek^.SetSelIndex(Week-1);
PlayerList^.ForEach(@BuildList);
PickPlayer^.SetSelIndex(0);
BuildButtons;
if FoundPlayer = nil then
begin
messagebeep(0);
messagebox(hwindow,'You must first add a player to pick results',
'Error',mb_ok or mb_iconstop);
tdialog.cancel(msg);
end;
end;
procedure tPicksDialog.HandleListBox(var Msg: TMessage);
begin
if (Msg.lParamHi = lbn_SelChange)
and (Week <> PickWeek^.GetSelIndex+1) then
begin
StorePicks;
Week := PickWeek^.GetSelIndex+1;
BuildButtons;
end
else DefWndProc(msg);
end;
procedure tPicksDialog.HandleComboBox(var Msg: TMessage);
begin
if Msg.lParamHi = lbn_SelChange then
begin
StorePicks;
BuildButtons;
end;
end;
procedure tPicksDialog.Cancel(var Msg: TMessage);
begin
StorePicks;
tDialog.Cancel(msg);
end;
procedure tPicksDialog.OK(var Msg: TMessage);
begin
StorePicks;
tDialog.OK(msg);
end;
destructor tPicksDialog.done;
begin
tDialog.Done;
end;
constructor tPlayerMaintDlg.init(aParent:pWindowsObject; aName:pChar);
begin
tdialog.init(aParent,aName);
new(PlayerListBox, initResource(@self,id_PlayerBox));
end;
procedure tPlayerMaintDlg.SetUpWindow;
procedure BuildList(P:pPlayer); far;
begin
PlayerListBox^.AddString(p^.Name);
end;
begin
tdialog.Setupwindow;
PlayerList^.ForEach(@BuildList);
PlayerListBox^.SetSelIndex(0);
end;
destructor tPlayerMaintDlg.Done;
begin
dispose(PlayerListBox, done);
tdialog.Done;
end;
procedure tNFLwindow.PlayerMaint(var msg: tMessage);
var dlg : pplayermaintdlg;
begin
Application^.execdialog(new(pPlayerMaintDlg,init(@self,'PlayerMaintenance')));
end;
procedure tPlayerMaintDlg.AddPlayer(var Msg: TMessage);
var EditText : array[0..PlayerNameSize] of char;
w,g : word;
result : integer;
var
rcUpdate : TRect;
begin
EditText[0] := #00;
if (Application^.ExecDialog(new(pInputDialog, Init(@self, 'Add Player',
'Enter New Player''s Name:',EditText,SizeOf(EditText)))) = id_ok )
and (strlen(edittext) > 0) then
with PlayerRec do
begin
result := playerlistbox^.SetSelString(EditText,-1);
if (result > -1)
and(PlayerListBox^.GetStringLen(result) = StrLen(EditText)) then
begin
MessageBeep(0);
MessageBox(hWindow,'Player already exists.','Error',
mb_ok or mb_IconExclamation);
end
else
begin
Name := strnew(@EditText);
fillchar(vresults,sizeof(vResults),#00);
fillchar(vPickRec,sizeof(vPickRec),#00);
for w := 1 to MaxWeeks do
for g := 1 to MaxGames do
vPickRec[w].GamePick[g] := 2;
PlayerList^.Insert(new(pPlayer,init(Name,vPickrec,vResults)));
PlayerListBox^.AddString(Name);
getUpdateRect(Hwindow,rcUpdate,False);
PlayerListBox^.SetSelString(Name,-1);
RedrawWindow(Hwindow,@rcUpdate,0, RDW_INVALIDATE or
RDW_UPDATENOW or RDW_ALLCHILDREN);
end;
end;
end;
procedure tPlayerMaintDlg.DeletePlayer(var Msg: TMessage);
var MsgText : array [0..128] of char;
MsgName : array [0..50] of char;
ListIndex,
ListCount : integer;
function FindPlayerToDelete(P:pPlayer): boolean; far;
begin
FindPlayerToDelete := strcomp(p^.Name,msgname) = 0;
end;
begin
ListIndex:= PlayerListBox^.GetSelIndex;
if ListIndex < 0
then
begin
messagebeep(0);
MessageBox(hWindow,
'No Player Selected To Delete!',
'Error',
mb_ok or mb_IconExclamation);
end
else
begin
PlayerListBox^.GetSelString(MsgName,50);
Strcopy(MsgText,'Delete ');
StrCat (MsgText,MsgName);
StrCat (MsgText,'?');
if MessageBox(hWindow,
MsgText,
'Delete Player',
mb_OKCancel or mb_iconstop) = id_ok then
begin
ListCount := PlayerListBox^.DeleteString(ListIndex);
PlayerList^.Delete(PlayerList^.FirstThat(@FindPlayerToDelete));
If ListCount = listindex
then PlayerListBox^.SetSelIndex(Listindex-1)
else PlayerListBox^.SetSelIndex(ListIndex);
end;
end;
end;
procedure tNFLwindow.DeletePlayers(var msg: tMessage);
begin
if MessageBox(hWindow,'Do you really want to delete the Player Roster?',
'Purge Players', mb_OKCancel or mb_iconstop)
= id_ok then
begin
if playerlist <> nil
then PlayerList^.freeAll;
NFLapp.WritePlayerList;
end;
end;
procedure tPrintItOut.SelectFont(dc:hdc;LinesPerPage,CharsPerLine:word);
begin
gettextmetrics(dc,metrics);
pixX := getdevicecaps(dc,LogPixelsX);
pixY := getdevicecaps(dc,LogPixelsY);
pageVert := getdevicecaps(dc,VertRes);
pageHorz := getdevicecaps(dc,HorzRes);
with myfont do
begin
lfheight := PageVert div LinesPerPage;
lfwidth := PageHorz div CharsPerLine;
lfescapement := 0;
lforientation := 0;
lfweight := fw_dontcare;
lfitalic := 0;
lfunderline := 0;
lfstrikeout := 0;
lfcharset := ansi_charset;
lfoutprecision := out_default_precis;
lfclipprecision := clip_default_precis;
lfquality := default_quality;
lfpitchandfamily := variable_pitch or ff_swiss;
strcopy (@lffacename,'Arial');
end;
Center := PageHorz div 2;
thefont := createfontindirect(myfont);
selectobject(dc,thefont);
gettextmetrics(dc,metrics);
Height := metrics.tmHeight + metrics.tmExternalLeading;
Width := metrics.tmAveCharWidth;
ps.X := GetDeviceCaps(DC,HorzRes);
ps.Y := GetDeviceCaps(DC,VertRes);
maxX := ps.x-1;
maxY := ps.y-1;
posx:= 0;
posY:= 0;
end;
procedure tPrintItOut.PrintPage(DC:HDC; page:word; Size:tPoint;
var Rect:tRect; Flags:word);
const Heading1 : pChar = ('N.F.L. Schedule');
MNF : pChar = ('Monday Night Football');
Footing : pChar = ('Total MNF Points');
var
x,g,t : word;
p : pchar;
ThePen,OldPen : hPen;
outstr:array[0..80] of char;
begin
SelectFont(dc,25,32);
textout(dc,PageHorz div 5,posY,Heading1,strlen(Heading1));
inc(posY,Height);
wvsprintf(OutStr,'Week %d',week);
textout(dc,(PageHorz div 3),posY,OutStr,strlen(OutStr));
inc(posY,Height);
for g := 1 to MaxGames do
with SchedRec^.ScheduleRec do
begin
if g = 14 then
begin
inc(posY,(Height div 2));
textout(dc,(pagehorz div 8),posY,MNF,strlen(MNF));
inc(posY,Height);
end;
p:= pChar(SchedColl^.at(team[g,0]));
textout(dc,posX,posY,p,strlen(p));
p:=pChar(SchedColl^.at(team[g,1]));
textout(dc,Center,posY,p,strlen(p));
inc(posY,Height);
inc(x);
end;
inc(posY,Height div 2);
textout(dc,PageHorz div 6,posY,Footing,strlen(Footing));
inc(posY,Height);
ThePen := createpen(ps_solid,10,0);
OldPen := SelectObject(dc,ThePen);
Rectangle(dc,Width * 12,posY,Width * 16,posY + Height*2);
SelectObject(dc,OldPen);
deleteobject(thepen);
deleteobject(thefont);
end;
procedure tPrintResultsOut.PrintPage(DC:HDC; page:word; Size:tPoint;
var Rect:tRect; Flags:word);
var WeeklyStandings : pStandingsCollection;
YTDStandings : pStandingsCollection;
pStr : array [0..80] of char;
s,WeekStr : String;
OutStr : array [0..80] of char;
TabStops :integer;
pLine : pchar;
procedure NewPage;
begin
escape(dc,NewFrame,0,nil,nil);
posX := 0;
posY := 0;
selectobject(dc,thefont);
end;
procedure CheckEOP;
begin
if posy > maxy
then NewPage;
end;
procedure PrintIt(p:pStandings); far;
var s : string;
pStr : array[0..5] of char;
OutRec : record
outwins,
outlosses,
outties,
outpts : word;
end;
begin
if (p^.Wins<>0) or (p^.Losses<>0) or (p^.Ties<>0) then
begin
textout(dc,posX,posY,p^.Name,strlen(p^.Name));
OutRec.OutWins := p^.wins;
OutRec.OutLosses := p^.losses;
OutRec.OutTies := p^.Ties;
OutRec.OutPts := p^.PtDiff;
wvsprintf(OutStr,'%4d'#09'%4d'#09'%4d'#09'%4d',OutRec);
TabbedTextOut(dc,Center,posY,OutStr,strlen(OutStr)
,0,TabStops,0);
inc(posY,Height);
CheckEOP;
end;
end;
procedure CalculateResults(p:pPlayer); far;
var x,w,g,t,
YTDWins,
YTDLosses,
YTDTies,
YTDPtDiff : word;
begin
with p^.PickRec[Week] do
with SchedRec^.ScheduleRec.GameScore do
begin
p^.Results[Week].Wins := 0;
p^.Results[Week].Losses := 0;
p^.Results[Week].Ties := 0;
YTDWins :=0;
YTDLosses :=0;
YTDTies :=0;
YTDPtDiff :=0;
for g := 1 to MaxGames do
if ((Score[g,0] <> 0)
or (Score[g,1] <> 0))
and (GamePick[g] <> 2)
then if Score[g,0] = Score[g,1]
then inc(p^.Results[Week].Ties)
else if Score[g,0] > Score[g,1]
then if GamePick[g] = 0
then inc(p^.Results[Week].Wins)
else inc(p^.Results[Week].Losses)
else if GamePick[g] = 1
then inc(p^.Results[Week].Wins)
else inc(p^.Results[Week].Losses);
p^.Results[Week].PtDiff :=
abs(MNFScore - Score[14,0] - Score[14,1]);
WeeklyStandings^.insert(new(pStandings, init(p^.Name,
p^.Results[Week].Wins,
p^.Results[Week].Losses,
p^.Results[Week].Ties,
p^.Results[Week].PtDiff)));
for w := 1 to Week do
begin
inc(YTDWins ,p^.Results[w].Wins);
inc(YTDLosses,p^.Results[w].Losses);
inc(YTDTies ,p^.Results[w].Ties);
inc(YTDPtDiff,p^.Results[w].PtDiff);
end;
YTDStandings^.insert(new
(pStandings, init(p^.Name,YTDWins,YTDLosses,YTDTies,YTDPtDiff)));
end;
end;
var heading : record
col1 : pChar;
col2 : pChar;
Col3 : pChar;
Col4 : pChar;
end;
begin
SelectFont(dc,60,80);
wvsprintf(OutStr,'Standings For Week %d',week);
textout(dc,posX,posY,OutStr,strlen(OutStr));
inc(posY,Height*2);
textout(dc,posX ,posY,'Player',strlen('Player'));
heading.col1:= 'Wins';
heading.Col2:= 'Loss';
heading.col3:= 'Ties';
heading.col4:= 'Points';
wvsprintf(OutStr,'%-4s'#09'%-4s'#09'%-4s'#09'%-6s',
heading);
TabbedTextOut(dc,Center,posY,OutStr,strlen(OutStr)
,0,TabStops,0);
inc(posY,Height);
WeeklyStandings := new(pStandingsCollection, init(20,10));
YTDStandings := new(pStandingsCollection, init(20,10));
PlayerList^.ForEach(@CalculateResults);
weeklystandings^.ForEach(@PrintIt);
dispose(weeklystandings,done);
NewPage;
wvsprintf(OutStr,'YTD Standings Thru Week %d',week);
textout(dc,posX,posY,OutStr,strlen(OutStr));
inc(posY,Height*2);
textout(dc,posX ,posY,'Player',strlen('Player'));
wvsprintf(OutStr,'%-4s'#09'%-4s'#09'%-4s'#09'%-6s',
heading);
TabbedTextOut(dc,Center,posY,OutStr,strlen(OutStr)
,0,TabStops,0);
inc(posY,Height);
YTDStandings^.ForEach(@PrintIt);
dispose(YTDStandings,done);
deleteobject(TheFont);
end;
destructor tNFLWindow.Done;
begin
dispose(LogoBitmap,done);
deleteobject( NFLIcon);
twindow.done;
end;
procedure tNFLApp.InitMainWindow;
begin
MainWindow := new(pNFLWindow, init(nil,'NFL Office Pool'));
end;
begin
CmdShow := sw_ShowMaximized;
NFLApp.init('NFL Program');
NFLApp.run;
NFLApp.done;
end.