home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Best of Select: Games 3
/
cd.iso
/
wingames
/
mind
/
mind.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-02-19
|
38KB
|
1,135 lines
{$A+,B-,D-,F-,G+,I-,L-,N+,P+,R-,S+,V-,W+,X+,Y-}
{$M 4096, 1024}
Program SuperMind;
USES OWindows, ODialogs, WinProcs, WinTypes, Strings, BWCC;
{$R Mind.RES}
CONST CM_NEU =101;
CM_RUNDE =102;
CM_EINGABE =103;
CM_PAUS =104;
CM_Show =105;
CM_ENDE =106;
CM_CODE =111;
CM_HINTER =112;
CM_MAXRUNDE =113;
cm_Speichern =114;
CM_OBEN =121;
CM_NURRICHTIG=122;
CM_RICHTIGSCHWARZ=123;
cm_ShowStatus=124;
CM_INDEX =131;
CM_REGEL =132;
CM_BEDIEN =133;
CM_INFO =134;
CM_AufBAU =135;
ID_KNOPF =201;
CONST Rect:TRect= ( left:445; top:33; right:495; bottom:47);
Eing:TRect=( left:350; top:135;right:590;bottom:180);
Ecken1:Array[1..6] Of TPoint=((x:270;y:414),(x:45;y:414),(X:65;Y:434),(X:290;Y:434),(X:290;Y:31),(X:270;Y:11));
Ecken2:Array[1..4] OF TPoint=((x:200; y:35), (x:95; y:35), (x:105; y:55), (x:210;y:55));
Ecken3:Array[1..4] OF TPoint=((x:200; y:35), (x:210; y:55), (x:210; y:20), (x:200;y:10));
Farben:Array[0..10] of LongInt=( $00004080, $0000FFFF, $000080FF, $000000FF, $00FF00FF,
$00FFFF00, $0000FF00, $00FF0000, $00408000, $00C0C0C0, $FFFFFF);
TYPE Arr=Array[1..8] of Byte;
VAR anzahl, maxcolor :Byte;
id_CheckB, ShowStatus:Boolean;
HGBitmap, Speichern:Boolean;
HGRot, HGGruen, HGBlau:Byte;
Oben, Schwarz, nurRichtig:Boolean;
MaxRunde :Byte;
TYPE PMain=^TMain;
TMain=Object ( TApplication)
Bit1 :HBitmap;
Procedure InitMainWindow; virtual;
Procedure InitInstance; virtual;
end;
TYPE PHaupt=^THaupt;
THaupt=Object ( TWindow)
runde, Altrunde, Mal, rund :Byte;
Colopos, Color :Byte;
setcode, code :arr;
Farbposition, Verglei :array[1..10] of arr;
hCurs, Curs :HCursor;
hPopup :HMenu;
diag :HBitmap;
Brush1 :HBrush;
OK_Button :PButton;
Constructor Init ( AParent:PWindowsObject; ATitle: PChar);
Procedure GetWindowClass ( var AWndClass: TWndClass); virtual;
Procedure SetupWindow; virtual;
Procedure NeuSpiel ( var Msg:TMessage); virtual CM_first + CM_NEU;
Procedure BackRunde ( var Msg:TMessage); virtual CM_first + CM_RUNDE;
Procedure HotEingabe ( var Msg:TMessage); virtual CM_first + CM_EINGABE;
Procedure Pause ( var Msg:TMessage); virtual CM_first + CM_PAUS;
Procedure CodeOpt ( var Msg:TMessage); virtual CM_first + CM_CODE;
Procedure Hintergr ( var Msg:TMessage); virtual CM_first + CM_HINTER;
Procedure CMShow (var Msg:TMessage); virtual CM_First + CM_Show;
Procedure CMEnde(var Msg:TMessage); virtual cm_First + cm_ENDE;
Procedure CMSpeichern (var Msg:TMessage); virtual cm_First + cm_Speichern;
Procedure CMShowStatus(var Msg:TMessage); virtual cm_First + cm_SHOWSTATUS;
Procedure CMMaxRunde (var Msg:Tmessage); virtual CM_First + CM_MaxRunde;
procedure obenStart (var Msg:Tmessage); Virtual CM_First + CM_Oben;
procedure NurRichtige (var msg:TMessage); virtual cm_First + cm_NurRichtig;
procedure RichtigSchwarz(var msg:TMessage); virtual cm_first + CM_RichtigSchwarz;
Procedure Index ( var Msg:TMessage); virtual CM_first + CM_INDEX;
Procedure Spielregel ( var Msg:TMessage); virtual CM_first + CM_REGEL;
Procedure Bedienung ( var Msg:TMessage); virtual CM_first + CM_BEDIEN;
Procedure Aufbau ( var Msg:TMessage); virtual CM_first + CM_AUFBAU;
Procedure Info ( var Msg:TMessage); virtual CM_first + CM_INFO;
Procedure WMMouseMove ( var Msg:TMessage); virtual wm_first + wm_MouseMove;
Procedure WMLButtonDown ( var Msg:TMessage); virtual wm_first + wm_LButtonDown;
Procedure WMRButtonDown ( var Msg:TMessage); virtual wm_first + wm_RButtonDown;
Procedure WMMButtonDown ( var Msg:TMessage); virtual wm_first + wm_MButtonDown;
Procedure Eingabe ( var Msg:TMessage); virtual id_first + ID_KNOPF;
Procedure Paint ( PaintDC:HDC; var PaintInfo: TPaintStruct); virtual;
Procedure Spiel; virtual;
Procedure Varzuweisen; virtual;
Procedure Vergleich ( var Posi:Byte); virtual;
Procedure Jaeingabe; virtual;
Function CanClose:Boolean; virtual;
Function Codericht ( var Reihe:Byte) :Boolean; virtual;
Destructor Done; virtual;
End;
TYPE PCodeOpt=^TCodeOpt;
TCodeOpt=Object ( TDialog)
jaOK, jaW :Boolean;
Farbz, Codez :Byte;
jagleiche :Boolean;
Function CanClose:Boolean; virtual;
Procedure OK ( var Msg:TMessage); virtual id_first + id_OK;
Procedure SetupWindow; virtual;
End;
TYPE PHintergr=^THintergr;
THintergr=Object ( TDialog)
RotLL, GruenLL, BlauLL :PScrollBar;
RotES, GruenES, BlauES :Byte;
RES, GES, BES :Array[0..3] of Char;
Constructor Init ( Fenster:PWindowsObject; Title:PChar);
Procedure SetupWindow; virtual;
Procedure WMPaint ( var Msg:TMessage); virtual wm_first + wm_paint;
Procedure RotScroll ( var Msg:TMessage); virtual id_first + 61;
Procedure GruenScroll ( var Msg:TMessage); virtual id_first + 63;
Procedure BlauScroll ( var Msg:TMessage); virtual id_first + 65;
Procedure OK ( var Msg:TMessage); virtual id_first + id_OK;
end;
Type PRundenDialog=^TRundenDialog;
TRundenDialog=Object(TDialog)
LL:PScrollBar;
ES:Byte;
Einstellung:Array[0..3] of Char;
Constructor Init(Fenster:PWindowsObject; Title:PChar);
Procedure SetUpWindow; virtual;
Procedure Scroll (var msg:TMessage); virtual id_First + 100;
procedure OK (var msg:TMessage); virtual id_first + id_OK;
end;
TYPE PShowDialog=^TShowDialog;
TShowDialog=Object(TDialog)
Code :Arr;
Laenge:Byte;
Constructor Init(Fenster:PWindowsObject; Titel:PChar; Darstellen:Arr; Lang:Byte);
Procedure WMPaint (var Msg:TMessage); virtual wm_First + WM_Paint;
end;
var Haupt :TMain;
Procedure TMain.InitMainWindow;
begin
MainWindow:=New ( PHaupt, Init ( nil, 'Super Mind'));
end;
Procedure TMain.InitInstance;
begin
TApplication.InitInstance;
HAccTable:=LoadAccelerators ( HInstance, 'SuperAccels');
end;
Constructor THaupt.Init;
begin
TWindow.Init ( AParent, ATitle);
Attr.Menu:=LoadMenu ( HInstance, 'SuperMenu');
Attr.style:=Attr.Style or WS_CLIPCHILDREN;
Attr.x:=-4;
Attr.y:=-4;
Attr.w:=648;
Attr.h:=488;
OK_Button:=New ( PButton, Init ( @self, ID_KNOPF, 'Eingabe', 438, 205, 110, 50, True));
end;
Procedure THaupt.GetWindowClass;
begin
TWindow.GetWindowClass ( AWndClass);
AWndClass.hIcon:=LoadIcon ( HInstance, 'SuperIcon1');
AWndClass.hCursor:=0;
HGBitmap:=Boolean ( GetPrivateProfileInt ( 'Hintergrund', 'HGBitmap', 1, 'MIND.INI'));
HGRot:=GetPrivateProfileInt ( 'Hintergrund', 'Rot', 128, 'MIND.INI');
HGBlau:=GetPrivateProfileInt ( 'Hintergrund', 'Blau', 128, 'MIND.INI');
HGGruen:=GetPrivateProfileInt ( 'Hintergrund', 'Gruen', 128, 'MIND.INI');
Haupt.Bit1:=LoadBitmap ( HInstance, 'SuperBackground');
IF HGBitmap=True then
AWndClass.hbrBackground:=CreatePatternBrush ( Haupt.Bit1)
else
AWndClass.hbrBackground:=CreateSolidBrush ( RGB ( HGRot, HGGruen, HGBlau));
end;
Procedure THaupt.SetupWindow;
begin
TWindow.SetupWindow;
hPopup:=CreatePopupMenu;
AppendMenu ( hPopup, MF_ENABLED, 101, 'Spiel neu');
AppendMenu ( hPopup, MF_ENABLED, 111, 'CODE-Optionen');
AppendMenu ( hPopup, MF_ENABLED, 104, 'Pause');
AppendMenu ( hPopup, MF_ENABLED, 131, 'Hilfe');
id_CheckB:=Boolean ( GetPrivateProfileInt ( 'Optionen', 'gleiche???', 1, 'MIND.INI'));
Anzahl:=GetPrivateProfileInt ( 'Optionen', 'Codelaenge', 4, 'MIND.INI');
Maxcolor:=GetPrivateProfileInt ( 'Optionen', 'FarbenZahl', 8, 'MIND.INI');
Oben:=Boolean(GetPrivateProfileInt('Optionen', 'Oben beginnen', 0, 'Mind.ini'));
Schwarz:=Boolean(GetPrivateProfileInt('Optionen', 'Schwarz', 0, 'Mind.ini'));
NurRichtig:=Boolean(GetPrivateProfileInt('Optionen', 'Nur Richtige anzeigen', 0, 'Mind.ini'));
MaxRunde:=GetPrivateProfileInt('Optionen', 'Maximale Rundenzahl', 10, 'MIND.INI');
ShowStatus:=Boolean(GetPrivateProfileInt('Optionen', 'StatusRechteck zeigen', 1, 'MIND.INI'));
Speichern:=Boolean(GetPrivateProfileInt('Optionen', 'Speichern beim Beenden', 1, 'MIND.INI'));
Mal:=0;
IF Oben then CheckMenuItem(Attr.Menu,cm_Oben, MF_Checked)
else CheckMenuItem(Attr.Menu, CM_Oben, MF_UNChecked);
IF NurRichtig then CheckMenuItem(Attr.menu, CM_NurRichtig, MF_Checked)
else CheckMenuItem(Attr.Menu, CM_NurRichtig, MF_Unchecked);
IF Schwarz then CheckMenuItem(Attr.menu, CM_RichtigSchwarz, MF_Checked)
else CheckMenuItem(Attr.Menu, CM_RichtigSchwarz, MF_Unchecked);
IF ShowStatus then CheckMenuItem(Attr.Menu, CM_ShowStatus, MF_Checked)
else CheckMenuItem(Attr.Menu, CM_ShowStatus, MF_Unchecked);
IF Speichern then CheckMenuItem(Attr.Menu, CM_Speichern, MF_Checked)
else CheckMenuItem(Attr.Menu, CM_Speichern, MF_Unchecked);
Randomize;
diag:=LoadBitmap ( HInstance, 'SuperDiagonal');
Curs:=LoadCursor ( HInstance, 'SUPERCURSOR');
Varzuweisen;
end;
Procedure THaupt.NeuSpiel;
begin
Spiel;
end;
Procedure THaupt.CMShow;
begin
IF BWCCMessageBox(HWindow, 'Wenn Sie sich den Code ansehen, beenden Sie dadurch Ihr gerade laufendes Spiel. Wollen Sie'+
' sich dennoch den Code ansehen?', 'Achtung', MB_IconExclamation or MB_YesNo)=ID_YES then
begin
Application^.ExecDialog(New(PShowDialog, Init(@Self, 'ShowDialog', Code, anzahl)));
Spiel;
Mal:=0;
end;
end;
Procedure THaupt.CMMAXRunde;
begin
Application^.ExecDialog(new(PRundenDialog, Init( @Self, 'RundenDialog')));
InvalidateRect(HWindow, NIL, false);
end;
Procedure THaupt.CodeOpt;
begin
IF Application^.ExecDialog ( New ( PCodeOpt, Init ( @Self, 'SuperCodeDialog')) ) =id_OK
THEN
begin
Spiel;
Mal:=0;
InvalidateRect(HWindow, Nil, False);
end;
end;
Procedure THaupt.Hintergr;
begin
If Application^.ExecDialog ( New ( PHintergr, Init ( @Self, 'SuperHinterDialog')) ) =ID_OK then
begin
DeleteObject ( GetClassWord ( HWindow, GCW_HbrBackground));
If HGBitmap=True then
SetClassWord ( HWindow, GCW_HBRBACKGROUND, CreatePatternBrush ( Haupt.Bit1))
else
SetClassWord ( HWindow, GCW_HBRBACKGROUND, CreateSolidBrush ( RGB ( HGRot, HGGruen, HGBlau)) );
Mal:=0;
InvalidateRect ( HWindow, nil, TRUE);
end;
end;
Procedure THaupt.BackRunde;
var x :Byte;
begin
IF runde>0 then
begin
For x:=1 to anzahl do
begin
Farbposition[runde, x]:=0;
Verglei[runde, x]:=0;
end;
Dec ( runde);
Dec ( Rund );
AltRunde:=Runde;
Mal:=6;
InvalidateRect ( HWindow, nil, false);
end
else
begin
IF Rund > 0 then BWCCMessageBox (HWindow, 'Sie k÷nnen nur die 10 letzten Runden zurⁿcknehmen, da die frⁿheren'+
' nicht gespeichert werden!!!', 'Achtung', MB_iconExclamation or MB_OK)
else BWCCMessageBox ( HWindow, 'Wenn Sie noch keine Rundeneingabe gemacht haben, k÷nnen Sie diese'+
'natⁿrlich auch nicht zurⁿcknehmen!', 'Leider, leider', MB_OK or MB_IconExclamation);
end;
end;
Procedure THaupt.Pause;
begin
SendMessage ( Application^.MainWindow^.HWindow, wm_Syscommand, sc_Minimize, 0);
end;
Procedure THaupt.HotEingabe;
begin
JaEingabe;
end;
Procedure THaupt.CMSpeichern;
begin
Speichern:=Not(Speichern);
IF Speichern then CheckMenuItem(Attr.Menu, CM_Speichern, MF_CHecked)
else CheckMenuItem(Attr.Menu, CM_Speichern, MF_Unchecked);
end;
Procedure THaupt.CMShowStatus;
begin
ShowStatus:=Not(ShowStatus);
IF ShowStatus then CheckMenuItem(Attr.Menu, CM_ShowStatus, MF_Checked)
else CheckMenuItem(Attr.Menu, CM_ShowStatus, MF_Unchecked);
Mal:=9;
InvalidateRect(HWindow, Nil, false);
end;
Procedure THaupt.CMEnde;
begin
IF CanClose=True then PostQuitMessage(0);
end;
Procedure THaupt.Index;
begin
WinHelp ( Application^.MainWindow^.HWindow, 'Mind.hlp', HELP_INDEX, 0);
end;
Procedure THaupt.Spielregel;
begin
WinHelp ( Application^.MainWindow^.HWindow, 'Mind.hlp', HELP_CONTEXT, 3);
end;
Procedure THaupt.Bedienung;
begin
WinHelp ( Application^.MainWindow^.HWindow, 'Mind.hlp', HELP_CONTEXT, 1{LongInt ( PChar ( 'Bedienung')) });
end;
Procedure THaupt.Aufbau;
begin
WinHelp(Application^.MainWindow^.HWindow, 'MIND.HLP', HELP_CONTEXT, 2);
end;
Procedure THaupt.Info;
begin
Application^.ExecDialog ( New ( PDialog, Init ( @Self, 'SuperInfoDialog')) );
end;
Procedure THaupt.WMMouseMove;
var woCurs :TPoint;
begin
woCurs:=MAKEPOINT ( Msg.lParam);
IF PtinRect ( Eing, woCurs) =true then hCurs:=Curs
else hCurs:=LoadCursor ( 0, IDC_ARROW);
SetCursor ( HCurs);
end;
Procedure THaupt.WMLButtonDown;
var pt :TPoint;
begin
pt:=MAKEPOINT ( Msg.lParam);
If hCurs=Curs then
begin
Colopos:=Round ( ( pt.x-Eing.left) * anzahl/ ( Eing.right - Eing.left) + 0.5);
setcode[Colopos]:=Color;
Mal:=2;
InvalidateRect ( HWindow, nil, false);
end;
end;
Procedure THaupt.WMRButtonDown;
begin
Inc ( Color);
IF color>maxcolor THEN Color:=1;
Mal:=1;
InvalidateRect ( HWindow, nil, false);
end;
Procedure THaupt.WMMButtonDown;
var pt :TPoint;
begin
pt:=MAKEPOINT ( Msg.lParam);
ClienttoScreen ( HWindow, pt);
TrackPopupMenu ( hPopup, 0, pt.x, pt.y, 0, HWindow, nil);
end;
Procedure THaupt.Eingabe;
begin
JaEingabe;
end;
Procedure THaupt.Paint;
var B, Balt :HBrush;
PenAlt, Pen1 :HPen;
Zaehl :Byte;
Procedure StatusLine;
var Buff:Array[0..4] of Char;
begin
IF ShowStatus then
begin
SetTextColor(PaintDC, RGB(192, 0, 64));
SetBKColor(PaintDC, RGB(192, 192, 192));
Str(Rund+1, Buff);
TextOut(PaintDC, 400, 265, Buff, StrLen(Buff));
Str(MaxRunde:4, Buff);
IF MaxRunde<100 then TextOut(PaintDC, 527, 265, Buff, StrLen(Buff))
else TextOut(PaintDC, 525, 265, Buff, StrLen(Buff));
Str(Anzahl, Buff);
TextOut(PaintDC, 418, 293, Buff, StrLen(Buff));
Str(maxcolor, Buff);
TextOut(PaintDC, 418, 306, Buff, StrLen(Buff));
IF id_CheckB=True then TextOut(PaintDC, 492, 319, '÷fters', 6)
else TextOut(PaintDC, 492, 319, 'einmal', 6);
IF Oben then TextOut(PaintDC, 340, 348, 'oben ', 5)
else TextOut(PaintDC, 340, 348, 'unten', 5);
IF NurRichtig then TextOut(PaintDC, 340, 364, 'Nur Richtige anzeigen ', 54)
else TextOut(PaintDC, 340, 364, 'Auch anzeigen, wenn nur die Farbe stimmt', 40);
B:=GetStockObject(WHITE_BRUSH);
BAlt:=SelectObject(PaintDC, b);
IF Schwarz=False then Rectangle(PaintDC, 350, 390, 450, 410)
else Rectangle(PaintDC, 500, 390, 600, 410);
B:=GetStockObject(BLACK_Brush);
DeleteObject( SelectObject(PaintDC, B));
IF Schwarz then Rectangle(PaintDC, 350, 390, 450, 410)
else Rectangle(PaintDC, 500, 390, 600, 410);
DeleteObject(SelectObject(PaintDC, BAlt));
end;
end;
Procedure State;
begin
IF ShowStatus then
begin
BAlt:=SelectObject(PaintDC, CreateSolidBrush(RGB(192, 192, 192)));
Rectangle(PaintDC, 321, 260, 619, 430);
DeleteObject(SelectObject(PaintDC, Balt));
SetBKMode(PaintDC, TRANSPARENT);
TextOut(PaintDC, 340, 265, 'Runde: ', 7);
TextOut(PaintDC, 470, 265, 'Maximal Runden', 20);
TextOut(PaintDC, 326, 280, 'Code - Optionen', 15);
TextOut(PaintDC, 340, 293, 'LΣnge: Steine', 24);
TextOut(PaintDC, 340, 306, 'Farben: verschiedene', 30);
TextOut(PaintDC, 340, 319, 'Gleiche Farbe im Code erlaubt', 41);
TextOut(PaintDC, 326, 335, 'Darstellung', 11);
TextOut(PaintDC, 340, 348, ' beginnen', 21);
TextOut(PaintDC, 326, 410, 'Farbe + Position richtig nur Farbe richtig ', 48);
DeleteObject(SelectObject(PaintDC, BAlt));
StatusLine;
end;
end;
Procedure Spielstein ( Position, Farbe:Byte);
var link, recht :Integer;
begin
B:=CreateSolidBrush ( Farben[Farbe]);
Balt:=SelectObject ( PaintDC, B);
link:=Round ( 355 + 240 / anzahl* ( Position-1));
recht:=Round ( 345 + 240 / anzahl*Position);
Ellipse ( PaintDC, link, 140, recht, 175);
DeleteObject ( SelectObject ( PaintDC, Balt));
end;
Procedure Neureihe;
var link :Integer;
x :Byte;
begin
Pen1 := CreatePen ( ps_Solid, 2, RGB ( 0, 0, 0));
PenAlt:=SelectObject ( PaintDC, Pen1);
Rectangle ( PaintDC, 350, 135, 590, 180);
For x:=1 to ( anzahl-1) do
begin
link:=Round ( 350+240/anzahl*x);
MoveTo ( PaintDC, link, 135);
LineTo ( PaintDC, link, 178);
end;
DeleteObject ( SelectObject ( PaintDC, PenAlt));
For x:=1 to anzahl do
begin
Spielstein ( x, setcode[x]);
end;
end;
Procedure Reihe ( Position:Byte);
var o, u :Integer;
x :Byte;
begin
IF oben=True then
begin
u:=73 + 34*Position;
o:=u-28;
end
else
begin
u:=73 + 34*(11-Position);
o:=u-28;
end;
For x:=1 to anzahl do
begin
B:=CreateSolidBrush ( Farben[Farbposition[Position, x]]);
BAlt:=SelectObject ( PaintDC, B);
Ellipse ( PaintDC, Round ( 50 + 165* ( x-1) /anzahl) , o, Round ( 43 + 165*x/anzahl) , u-3);
DeleteObject ( SelectObject ( PaintDC, BAlt));
end;
end;
Procedure SWPunkte ( Position:Byte);
var unt :Byte;
Procedure Codereihe ( anf, ende:Byte;ob:Boolean); far;
var links, obe :Integer;
x :Byte;
begin
B:=GetStockObject(WHITE_BRUSH);
Balt:=SelectObject ( PaintDC, B);
For x:=anf to ende do
begin
Case Verglei[Position, x] of
0:begin
B:=CreateSolidBrush ( Farben[0]);
DeleteObject ( SelectObject ( PaintDC, B));
end;
1:begin
IF NurRichtig=False then
begin
IF Schwarz=True then B:=GetStockObject ( WHITE_BRUSH)
else B:=GetStockObject ( BLACK_BRUSH);
end
else B:=CreateSolidBrush(Farben[0]);
DeleteObject ( SelectObject ( PaintDC, B));
end;
2:begin
IF Schwarz=True then B:=GetStockObject ( BLACK_BRUSH)
else B:=GetStockObject ( WHITE_BRUSH);
DeleteObject ( SelectObject ( PaintDC, B));
end;
end;
IF ob=true then
begin
links:=Round ( ( 212+ ( 60 - ( ( Anzahl - unt) *14)) /2) + ( x-anf) *14);
IF oben=true then obe:=Round ( 46+34* Position )
else Obe:=Round ( 420- 34* Position);
end
else
begin
links:=Round ( ( 212+ ( 60 - ( ( unt) *14)) /2) + ( x-anf) *14);
IF oben=true then obe:=Round ( 60 + 34* Position)
else Obe:=Round ( 434 - 34* Position );
end;
Ellipse ( PaintDC, links, obe, links+10, obe+10);
end;
DeleteObject ( SelectObject ( PaintDC, Balt));
end;
begin
unt:=Round ( anzahl/2);
Codereihe ( 1, unt, false);
Codereihe ( unt+1, anzahl, true);
end;
Procedure Farbe ( Farbe:Byte);
begin
B:=CreateSolidBrush ( Farben[Farbe]);
Balt:=SelectObject ( PaintDC, B);
Rectangle ( PaintDC, 435, 52, 505, 90);
DeleteObject ( SelectObject ( PaintDC, BAlt));
end;
Procedure ganzBild;
var anf :Integer;
x :Byte;
begin
B:=CreateSolidBrush ( Farben[0]);
Balt:=SelectObject ( PaintDC, B);
Pen1:=CreatePen ( ps_Solid, 3, RGB ( 0, 0, 0));
PenAlt:=SelectObject ( PaintDC, Pen1);
Rectangle ( PaintDC, 45, 11, 270, 414);
Rectangle ( PaintDC, 95, 10, 200, 35);
B:=CreateHatchBrush ( hs_fDiagonal, RGB ( 0, 0, 0));
DeleteObject ( SelectObject ( PaintDC, B));
Polygon ( PaintDC, Ecken1, 6);
MoveTo ( PaintDC, 270, 414);
LineTo ( PaintDC, 290, 434);
Polygon ( PaintDC, Ecken3, 4);
B:=CreatePatternBrush ( diag);
DeleteObject ( SelectObject ( PaintDC, B));
Polygon ( PaintDC, Ecken2, 4);
DeleteObject ( SelectObject ( PaintDC, BAlt));
anf:=108;
For x:=1 to 9 do
begin
MoveTo ( PaintDC, 45, anf);
LineTo ( PaintDC, 270, anf);
Inc ( anf, 34);
end;
Pen1:=CreatePen ( ps_Solid, 2, RGB ( 0, 0, 0));
DeleteObject ( SelectObject ( PaintDC, Pen1));
MoveTo ( PaintDC, 210, 74);
LineTo ( PaintDC, 210, 414);
DeleteObject ( SelectObject ( PaintDC, PenAlt));
Rectangle ( PaintDC, 425, 40, 515, 100);
DrawText ( PaintDC, 'Farbe'#0, -1, Rect, DT_CENTER or DT_VCENTER);
DeleteObject(SelectObject(PaintDC, BAlt));
State;
Neureihe;
Farbe ( Color);
For x:=1 to 10 do
begin
Reihe ( x);
SWPunkte ( x);
end;
end;
begin
CASE Mal of
1:Farbe ( Color);
2:Spielstein ( Colopos, Color);
3:Neureihe;
4:begin
Reihe ( runde);
SWPunkte ( runde);
Neureihe;
IF ShowStatus then StatusLine;
end;
5:SWPunkte ( runde);
6:begin
Reihe ( runde+1);
SWPunkte ( runde+1);
IF ShowStatus then StatusLine;
end;
7:begin
For Zaehl:=1 to 10 do
begin
Reihe(Zaehl);
SWPunkte(Zaehl);
end;
Farbe(Color);
Neureihe;
IF ShowStatus then StatusLine;
end;
8:begin
For Zaehl:=1 to Runde do SWPunkte(Zaehl);
StatusLine;
end;
9:begin
IF ShowStatus then State
else
begin
IF HGBitMap then b:=CreatePatternBrush(Haupt.Bit1)
else b:=CreateSolidBrush(RGB(HGRot, HGGruen, HGBlau));
BAlt:=SelectObject(PaintDC, B);
PenAlt:=SelectObject(PaintDC, CreatePen(PS_NULL, 0, 0));
Rectangle(PaintDC, 321, 260, 620, 431);
DeleteObject(SelectObject(PaintDC, PenAlt));
DeleteObject(SelectObject(PaintDC, BAlt));
end;
end;
10:StatusLine;
11:begin
For Zaehl:=1 to 10 do
begin
Reihe(Zaehl);
SWPunkte(Zaehl);
end;
StatusLine;
end;
else ganzBild;
end;
mal:=0;
end;
Procedure THaupt.Spiel;
begin
Varzuweisen;
Mal:=7;
InvalidateRect ( HWindow, nil, false);
end;
Procedure THaupt.Varzuweisen;
var x, x1 :Byte;
begin
For x:=1 to 10 do
begin
For x1:=1 to anzahl do
begin
Farbposition[x, x1]:=0;
Verglei[x, x1]:=0;
end;
end;
runde:=0;
Rund:=0;
AltRunde:=0;
Color:=1;
For x:=1 to anzahl do
begin
setcode[x]:=10;
Code[x]:=Random ( maxcolor) +1;
end;
If id_CheckB=false then
begin
For x:=2 to anzahl do
begin
x1:=1;
Repeat
If ( Code[x]=Code[x1]) then
begin
Inc(Code[x]);
If Code[x]>Maxcolor then Code[x]:=1;
x1:=1;
end
else inc(x1);
Until x1>=x;
end;
end;
end;
Procedure THaupt.Vergleich;
var x, x1, x2 :Byte;
ja, c :Boolean;
cod, jacod :array[1..8] of Boolean;
begin
For x1:=1 to Anzahl do
begin
cod[x1]:=false;
jacod[x1]:=false;
end;
x:=1;
For x1:=1 to anzahl do
begin
IF Farbposition[posi, x1]=Code[x1] THEN
begin
Verglei[posi, x]:=2;
Inc ( x);
cod[x1]:=true;
jacod[x1]:=true;
end;
end;
For x1:=1 to anzahl do
begin
x2:=0;
Repeat
Inc ( x2);
c:=not ( cod[x2] or jacod[x1]);
ja:= ( Farbposition[posi, x1]=Code[x2]) and ( x1<>x2) and c;
IF ja=true then
begin
Verglei[posi, x]:=1;
Inc ( x);
cod[x2]:=true;
jacod[x1]:=true;
end;
Until ( ja=true) or ( x2>=anzahl);
end;
Mal:=5;
InvalidateRect ( HWindow, nil, false);
end;
Procedure THaupt.ObenStart;
begin
Oben:=Not(Oben);
IF Oben then CheckMenuItem(Attr.Menu,cm_Oben, MF_Checked)
else CheckMenuItem(Attr.Menu, CM_Oben, MF_UNChecked);
Mal:=11;
InvalidateRect(HWindow, nil, False);
end;
Procedure THaupt.RichtigSchwarz;
begin
Schwarz:=Not(Schwarz);
IF Schwarz then CheckMenuItem(Attr.Menu, CM_RichtigSchwarz, MF_Checked)
else CheckMenuItem(Attr.Menu, CM_RichtigSchwarz, MF_Unchecked);
Mal:=8;
InvalidateRect(HWindow, Nil, False);
end;
Procedure THaupt.NurRichtige;
begin
NurRichtig:=Not(NurRichtig);
IF NurRichtig then CheckMenuItem(Attr.menu, CM_NurRichtig, MF_Checked)
else CheckMenuItem(Attr.Menu, CM_NurRichtig, MF_Unchecked);
Mal:=8;
InvalidateRect(HWindow, nil, False);
end;
Procedure THaupt.JaEingabe;
var x :Byte;
a :Boolean;
begin
x:=0;
a:=False;
Repeat
Inc ( x);
IF setcode[x]=10 then a:=true;
Until ( x>=anzahl) or ( a=true);
IF a=true then
begin
BWCCMessageBox ( HWindow, 'Sie mⁿssen zuerst alle Felder belegen, bevor Sie "Eingabe" drⁿcken!!!', 'Achtung',
MB_OK or MB_IconExclamation);
end
else
begin
Inc(runde);
Inc(Rund);
IF Runde>10 then Runde:=10;
Altrunde:=Runde;
IF (Rund > 10) and (Runde=10) then
begin
For x:=1 to 9 do
begin
FarbPosition[x]:=FarbPosition[x+1];
Verglei[x]:=Verglei[x+1];
end;
end;
for x:=1 to anzahl do
begin
Farbposition[runde, x]:=setcode[x];
setcode[x]:=10;
end;
Vergleich ( runde);
Mal:=4;
IF (Rund>10) AND (Runde=10) then Mal:=7;
IF Codericht ( runde) =true THEN
begin
For x:=1 to 5 do
begin
FlashWindow ( HWindow, false);
MessageBeep ( 0);
end;
IF BWCCMessageBox ( HWindow, 'Sie haben den Code richtig herausgefunden! Damit haben Sie das Spiel gegen den'+
' Computer gewonnen. Wollen Sie noch einmal spielen?', 'Super, super!', MB_YesNo or MB_IconExclamation) =id_Yes
then begin
Spiel;
Mal:=0;
end
else
begin
IF THaupt.CanClose=True then PostQuitMessage(0)
else begin
Spiel;
Mal:=0;
end;
end;
end
else
begin
IF rund>=MaxRunde THEN
begin
Application^.ExecDialog(New(PShowDialog, Init(@SElf, 'ShowDialog', Code, Anzahl)));
IF BWCCMessageBox ( HWindow, 'Der Computer hat das Spiel gegen Sie gewonnen. Wollen Sie noch einmal spielen?',
'Uih, Schade!!!', MB_YesNo
or MB_IconExclamation) =id_yes
then begin
Spiel;
Mal:=0;
end
else
begin
IF THaupt.CanClose=True then PostQuitMessage(0)
else begin
Spiel;
Mal:=0;
end;
end;
end;
end;
end;
end;
Function WritePrivateProfileInt(KeyName, EntryName:PChar; Value:Integer; IniFile:PChar):Boolean;
var st:array[0..10] of Char;
begin
Str(Value,st);
WritePrivateProfileInt:=WritePrivateProfileString(KeyName, EntryName, st, iniFile);
end;
Function THaupt.CanClose:Boolean;
Begin
CanClose:=false;
IF BWCCMessageBox ( HWindow, 'Wollen Sie "SUPER MIND" wirklich beenden?', 'Beenden',
MB_YesNo or MB_IconQuestion) =ID_Yes
THEN
begin
WritePrivateProfileInt('Optionen', 'Speichern beim Beenden', Integer(Speichern), 'MIND.INI');
IF Speichern then
begin
WritePrivateProfileInt('Optionen', 'StatusRechteck zeigen', Integer(ShowStatus), 'MIND.INI');
WritePrivateProfileInt ( 'Optionen', 'Codelaenge', Anzahl , 'MIND.INI');
WritePrivateProfileInt ( 'Optionen', 'FarbenZahl', MaxColor , 'MIND.INI');
WritePrivateProfileInt ( 'Optionen', 'Gleiche???', Integer(id_CheckB) , 'MIND.INI');
WritePrivateProfileInt ( 'Hintergrund', 'HGBitmap', Integer(HGBitmap) , 'MIND.INI');
WritePrivateProfileInt ( 'Hintergrund', 'Rot', HGRot , 'MIND.INI');
WritePrivateProfileInt ( 'Hintergrund', 'Gruen', HGGruen , 'MIND.INI');
WritePrivateProfileInt ( 'Hintergrund', 'Blau', HGBlau , 'MIND.INI');
WritePrivateProfileInt ( 'Optionen', 'Oben beginnen', Integer(oben) , 'MIND.INI');
WritePrivateProfileInt ( 'Optionen', 'Schwarz', Integer(Schwarz) , 'MIND.INI');
WritePrivateProfileInt ( 'Optionen', 'Nur Richtige anzeigen', Integer(NurRichtig) , 'MIND.INI');
WritePrivateProfileInt( 'Optionen', 'Maximale Rundenzahl', MaxRunde, 'MIND.INI');
end;
CanClose:=true;
end;
end;
Function THaupt.Codericht ( var Reihe:Byte) :Boolean;
var x :Byte;
ja :Boolean;
begin
x:=0;
Repeat
Inc ( x);
If Farbposition[Reihe, x]=Code[x] then ja:=true
else ja:=false;
Until ( ja=false) or ( x>=anzahl);
Codericht:=ja;
end;
Destructor Thaupt.Done;
begin
WinHelp(HWindow, 'MIND.HLP', HELP_QUIT, 0);
DeleteObject(Haupt.Bit1);
DeleteObject(diag);
TWindow.Done;
end;
Function TCodeOpt.CanClose:Boolean;
begin
TDialog.CanClose;
CanClose:=true;
IF ( jaOK AND jaW) then
begin
IF ( jagleiche = false) AND ( FarbZ < CodeZ ) then
begin
BWCCMessageBox ( HWindow, 'Wenn Sie "GLEICHE ERLAUBT" nicht angewΣhlt haben, darf die Anzahl der Codesteine'+
' die Anzahl der Farben nicht ⁿbersteigen!!!', 'Achtung!!!', MB_OK or MB_IconInformation);
CanClose:=false;
end
else
begin
id_CheckB:=jagleiche;
maxcolor:=FarbZ;
anzahl:=CodeZ;
end;
end
else
IF ( jaOK) then CanClose:=false;
end;
Procedure TCodeOpt.OK;
var x:Byte;
begin
jaOK:=True;
IF BWCCMessageBox ( HWindow, 'Hiermit beginnen Sie ein neues Spiel. Das bereits begonnene geht damit unwiederbringlich'+
' verloren. Wollen sie dennoch weitermachen?', 'Achtung',
MB_YesNo or Mb_IconQuestion) = id_Yes then
begin
jaW:=True;
jagleiche:=Boolean(IsDlgButtonChecked ( HWindow, 71));
For x:=51 to 57 do
IF SendDlgItemMessage ( HWindow, x, BM_GETCHECK, 0, 0) =word ( true) then Farbz:=x-48;
For x:=61 to 66 do
IF SendDlgItemMessage ( HWindow, x, BM_GETCHECK, 0, 0) =word ( true) then Codez:=x-58;
end;
TDialog.OK ( Msg);
end;
Procedure TCodeOpt.SetupWindow;
begin
CheckRadioButton ( HWindow, 51, 57, Maxcolor+48);
CheckRadioButton ( HWindow, 61, 66, anzahl+58);
CheckDlgButton ( HWindow, 71, Word(id_CheckB));
jaW:=False;
jaOK:=False;
end;
Constructor THintergr.Init;
begin
TDialog.Init ( Fenster, Title);
RotLL:=New ( PScrollBar, InitResource ( @Self, 61));
GruenLL:=New ( PScrollBar, InitResource ( @Self, 63));
BlauLL:=New ( PScrollBar, InitResource ( @Self, 65));
end;
Procedure THintergr.SetupWindow;
var MStr :String;
begin
TDialog.SetupWindow;
RotES:=HGRot;
GruenES:=HGGruen;
BlauES:=HGBlau;
RotLL^.SetRange ( 0, 255);
RotLL^.SetPosition ( RotES);
GruenLL^.SetRange ( 0, 255);
GruenLL^.SetPosition ( GruenES);
BlauLL^.SetRange ( 0, 255);
BlauLL^.SetPosition ( BlauES);
Str ( RotES:3, MStr);
StrPCopy ( RES, MStr);
SetWindowText ( GetDlgItem ( HWindow, 62) , RES);
Str ( GruenES:3, MStr);
StrPCopy ( GES, MStr);
SetWindowText ( GetDlgItem ( HWindow, 64) , GES);
Str ( BlauES:3, MStr);
StrPCopy ( BES, MStr);
SetWindowText ( GetDlgItem ( HWindow, 66) , BES);
IF HGBitmap=true
then CheckRadioButton ( HWindow, 50, 60, 50)
else CheckRadioButton ( HWindow, 50, 60, 60);
end;
Procedure THintergr.WMPaint;
var Brush, BrushAlt :HBrush;
PaintDC :HDC;
PaintInfo :TPaintStruct;
Client :TRect;
Bit :HBitmap;
begin
PaintDC:=BeginPaint ( HWindow, PaintInfo);
Bit:=LoadBitMap(HInstance,'BorBack');
Brush:=CreatePatternBrush(Bit);
BrushAlt:=SelectObject(PaintDC, Brush);
GetClientRect(HWindow, Client);
Rectangle(PaintDC, 0, 0, Client.Right, Client.bottom);
DeleteObject(SelectObject ( PaintDC, CreatePatternBrush ( Haupt.Bit1)));
Rectangle ( PaintDC, 30, 62, 300, 102);
Brush:=CreateSolidBrush ( RGB ( RotES, GruenES, BlauES));
DeleteObject ( SelectObject ( PaintDC, Brush));
Rectangle ( PaintDC, 30, 134, 300, 174);
DeleteObject ( SelectObject ( PaintDC, BrushAlt));
DeleteObject(Bit);
EndPaint ( HWindow, PaintInfo);
end;
Procedure THintergr.OK;
begin
HGBitmap:=Boolean ( IsDlgButtonChecked ( HWindow, 50));
HGRot:=RotES;
HGGruen:=GruenES;
HGBlau:=BlauES;
TDialog.OK ( MSG);
end;
Procedure THintergr.RotScroll;
var MStr :String;
begin
RotES:=RotLL^.GetPosition;
Str ( RotES:3, MStr);
StrPCopy ( RES, MStr);
SetWindowText ( GetDlgItem ( HWindow, 62) , RES);
InvalidateRect ( HWindow, NIL, false);
end;
Procedure THintergr.GruenScroll;
var MStr :String;
begin
GruenES:=GruenLL^.GetPosition;
Str ( GruenES:3, MStr);
StrPCopy ( GES, MStr);
SetWindowText ( GetDlgItem ( HWindow, 64) , GES);
InvalidateRect ( HWindow, NIL, false);
end;
Procedure THintergr.BlauScroll;
var MStr :String;
begin
BlauES:=BlauLL^.GetPosition;
Str ( BlauES:3, MStr);
StrPCopy ( BES, MStr);
SetWindowText ( GetDlgItem ( HWindow, 66) , BES);
InvalidateRect ( HWindow, NIL, false);
end;
Constructor TRundenDialog.Init;
begin
TDialog.Init(Fenster, Title);
LL:=New(PScrollBar, InitResource(@Self, 100));
end;
Procedure TRundenDialog.SetUpWindow;
var MStr:String;
begin
TDialog.SetUpWindow;
ES:=MaxRunde;
LL^.SetRange(10,255);
LL^.SetPosition(ES);
Str ( ES:3, MStr);
StrPCopy(Einstellung, MStr);
SetWindowText ( GetDlgItem ( HWindow, 101) , Einstellung);
end;
Procedure TRundenDialog.OK;
begin
MaxRunde:=ES;
TDialog.OK(Msg);
end;
Procedure TRundenDialog.Scroll;
var MStr:String;
begin
ES:=LL^.GetPosition;
Str(ES:3, MStr);
StrPCopy(Einstellung, MStr);
SetWindowText(GetDlgItem(hWindow, 101), Einstellung);
end;
Constructor TShowDialog.Init;
begin
TDialog.Init(Fenster, Titel);
Code:=Darstellen;
Laenge:=Lang;
end;
Procedure TShowDialog.WMPaint;
var TPS:TPaintStruct;
Client:TRect;
B:hBrush;
Bit:HBitmap;
x:Byte;
begin
BeginPaint(HWindow, TPS);
Bit:=LoadBitMap(HInstance, 'BorBack');
B:=SelectObject(TPS.hDC, CreatePatternBrush(Bit));
GetClientRect(HWindow, Client);
Rectangle(TPS.hDc, 0, 0, Client.Right, Client.bottom);
DeleteObject(SelectObject(TPS.hDC, CreateSolidBrush(RGB(192, 192, 192))));
Rectangle (TPS.hDC, 11, 55, 272, 110);
For x:=1 to Laenge-1 do
begin
MoveTo(TPS.hDC, Round(11+((272-11)/Laenge)*x), 55);
LineTo(TPS.hDC, Round(11+((272-11)/Laenge)*x), 110);
end;
For x:=1 to Laenge do
begin
DeleteObject(SelectObject(TPS.hDC, CreateSolidBrush(Farben[Code[x]])));
Ellipse(TPS.hDC, Round(11+5+(x-1)*(272-11)/Laenge), 60, Round(11-5+x*(272-11)/Laenge), 105);
end;
DeleteObject(SelectObject(TPS.hDC, B));
DeleteObject(Bit);
end;
begin
Haupt.Init ( 'Super Mind');
Haupt.Run;
Haupt.Done;
end.