home *** CD-ROM | disk | FTP | other *** search
/ The Best of Select: Games 3 / cd.iso / wingames / mind / mind.pas < prev    next >
Pascal/Delphi Source File  |  1994-02-19  |  38KB  |  1,135 lines
  1. {$A+,B-,D-,F-,G+,I-,L-,N+,P+,R-,S+,V-,W+,X+,Y-}
  2.  
  3. {$M 4096, 1024}
  4.  
  5. Program SuperMind;
  6.  
  7. USES OWindows, ODialogs, WinProcs, WinTypes, Strings, BWCC;
  8.  
  9. {$R Mind.RES}
  10.  
  11. CONST CM_NEU       =101;
  12.       CM_RUNDE     =102;
  13.       CM_EINGABE   =103;
  14.       CM_PAUS      =104;
  15.       CM_Show      =105;
  16.       CM_ENDE      =106;
  17.       CM_CODE      =111;
  18.       CM_HINTER    =112;
  19.       CM_MAXRUNDE  =113;
  20.       cm_Speichern =114;
  21.       CM_OBEN      =121;
  22.       CM_NURRICHTIG=122;
  23.       CM_RICHTIGSCHWARZ=123;
  24.       cm_ShowStatus=124;
  25.       CM_INDEX     =131;
  26.       CM_REGEL     =132;
  27.       CM_BEDIEN    =133;
  28.       CM_INFO      =134;
  29.       CM_AufBAU    =135;
  30.       ID_KNOPF     =201;
  31.  
  32. CONST Rect:TRect= ( left:445; top:33; right:495; bottom:47);
  33.       Eing:TRect=( left:350; top:135;right:590;bottom:180);
  34.       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));
  35.       Ecken2:Array[1..4] OF TPoint=((x:200; y:35), (x:95; y:35), (x:105; y:55), (x:210;y:55));
  36.       Ecken3:Array[1..4] OF TPoint=((x:200; y:35), (x:210; y:55), (x:210; y:20), (x:200;y:10));
  37.       Farben:Array[0..10] of LongInt=(  $00004080, $0000FFFF, $000080FF, $000000FF, $00FF00FF,
  38.                                         $00FFFF00, $0000FF00, $00FF0000, $00408000, $00C0C0C0, $FFFFFF);
  39.  
  40. TYPE Arr=Array[1..8] of Byte;
  41.  
  42. VAR anzahl, maxcolor  :Byte;
  43.     id_CheckB, ShowStatus:Boolean;
  44.     HGBitmap, Speichern:Boolean;
  45.     HGRot, HGGruen, HGBlau:Byte;
  46.     Oben, Schwarz, nurRichtig:Boolean;
  47.     MaxRunde          :Byte;
  48.  
  49.  
  50. TYPE PMain=^TMain;
  51.      TMain=Object ( TApplication)
  52.         Bit1              :HBitmap;
  53.         Procedure InitMainWindow; virtual;
  54.         Procedure InitInstance; virtual;
  55.      end;
  56.  
  57. TYPE PHaupt=^THaupt;
  58.      THaupt=Object ( TWindow) 
  59.        runde, Altrunde, Mal, rund             :Byte;
  60.        Colopos, Color         :Byte;
  61.        setcode, code          :arr;
  62.        Farbposition, Verglei  :array[1..10] of arr;
  63.        hCurs, Curs            :HCursor;
  64.        hPopup                 :HMenu;
  65.        diag                   :HBitmap;
  66.        Brush1                 :HBrush;
  67.        OK_Button              :PButton;
  68.        Constructor Init ( AParent:PWindowsObject; ATitle: PChar);
  69.        Procedure GetWindowClass ( var AWndClass: TWndClass); virtual;
  70.        Procedure SetupWindow; virtual;
  71.        Procedure NeuSpiel ( var Msg:TMessage); virtual CM_first + CM_NEU;
  72.        Procedure BackRunde ( var Msg:TMessage); virtual CM_first + CM_RUNDE;
  73.        Procedure HotEingabe ( var Msg:TMessage); virtual CM_first + CM_EINGABE;
  74.        Procedure Pause ( var Msg:TMessage); virtual CM_first + CM_PAUS;
  75.        Procedure CodeOpt ( var Msg:TMessage); virtual CM_first + CM_CODE;
  76.        Procedure Hintergr ( var Msg:TMessage); virtual CM_first + CM_HINTER;
  77.        Procedure CMShow (var Msg:TMessage); virtual CM_First + CM_Show;
  78.        Procedure CMEnde(var Msg:TMessage); virtual cm_First + cm_ENDE;
  79.        Procedure CMSpeichern (var Msg:TMessage); virtual cm_First + cm_Speichern;
  80.        Procedure CMShowStatus(var Msg:TMessage); virtual cm_First + cm_SHOWSTATUS;
  81.        Procedure CMMaxRunde (var Msg:Tmessage); virtual CM_First + CM_MaxRunde;
  82.        procedure obenStart (var Msg:Tmessage); Virtual CM_First + CM_Oben;
  83.        procedure NurRichtige (var msg:TMessage); virtual cm_First + cm_NurRichtig;
  84.        procedure RichtigSchwarz(var msg:TMessage); virtual cm_first + CM_RichtigSchwarz;
  85.        Procedure Index ( var Msg:TMessage); virtual CM_first + CM_INDEX;
  86.        Procedure Spielregel ( var Msg:TMessage); virtual CM_first + CM_REGEL;
  87.        Procedure Bedienung ( var Msg:TMessage); virtual CM_first + CM_BEDIEN;
  88.        Procedure Aufbau ( var Msg:TMessage); virtual CM_first + CM_AUFBAU;
  89.        Procedure Info ( var Msg:TMessage); virtual CM_first + CM_INFO;
  90.        Procedure WMMouseMove ( var Msg:TMessage); virtual wm_first + wm_MouseMove;
  91.        Procedure WMLButtonDown ( var Msg:TMessage); virtual wm_first + wm_LButtonDown;
  92.        Procedure WMRButtonDown ( var Msg:TMessage); virtual wm_first + wm_RButtonDown;
  93.        Procedure WMMButtonDown ( var Msg:TMessage); virtual wm_first + wm_MButtonDown;
  94.        Procedure Eingabe ( var Msg:TMessage); virtual id_first + ID_KNOPF;
  95.        Procedure Paint ( PaintDC:HDC; var PaintInfo: TPaintStruct); virtual;
  96.        Procedure Spiel; virtual;
  97.        Procedure Varzuweisen; virtual;
  98.        Procedure Vergleich ( var Posi:Byte); virtual;
  99.        Procedure Jaeingabe; virtual;
  100.        Function CanClose:Boolean; virtual;
  101.        Function Codericht ( var Reihe:Byte) :Boolean; virtual;
  102.        Destructor Done; virtual;
  103.      End;
  104.  
  105. TYPE PCodeOpt=^TCodeOpt;
  106.      TCodeOpt=Object ( TDialog) 
  107.        jaOK, jaW      :Boolean;
  108.        Farbz, Codez :Byte;
  109.        jagleiche     :Boolean;
  110.        Function CanClose:Boolean; virtual;
  111.        Procedure OK ( var Msg:TMessage); virtual id_first + id_OK;
  112.        Procedure SetupWindow; virtual;
  113.      End;
  114.  
  115. TYPE PHintergr=^THintergr;
  116.      THintergr=Object ( TDialog) 
  117.        RotLL, GruenLL, BlauLL :PScrollBar;
  118.        RotES, GruenES, BlauES :Byte;
  119.        RES, GES, BES          :Array[0..3] of Char;
  120.        Constructor Init ( Fenster:PWindowsObject; Title:PChar);
  121.        Procedure SetupWindow; virtual;
  122.        Procedure WMPaint ( var Msg:TMessage); virtual wm_first + wm_paint;
  123.        Procedure RotScroll ( var Msg:TMessage); virtual id_first + 61;
  124.        Procedure GruenScroll ( var Msg:TMessage); virtual id_first + 63;
  125.        Procedure BlauScroll ( var Msg:TMessage); virtual id_first + 65;
  126.        Procedure OK ( var Msg:TMessage); virtual id_first + id_OK;
  127.      end;
  128.  
  129. Type PRundenDialog=^TRundenDialog;
  130.      TRundenDialog=Object(TDialog)
  131.        LL:PScrollBar;
  132.        ES:Byte;
  133.        Einstellung:Array[0..3] of Char;
  134.        Constructor Init(Fenster:PWindowsObject; Title:PChar);
  135.        Procedure SetUpWindow; virtual;
  136.        Procedure Scroll (var msg:TMessage); virtual id_First + 100;
  137.        procedure OK (var msg:TMessage); virtual id_first + id_OK;
  138.      end;
  139.  
  140. TYPE PShowDialog=^TShowDialog;
  141.      TShowDialog=Object(TDialog)
  142.        Code :Arr;
  143.        Laenge:Byte;
  144.        Constructor Init(Fenster:PWindowsObject; Titel:PChar; Darstellen:Arr; Lang:Byte);
  145.        Procedure WMPaint (var Msg:TMessage); virtual wm_First + WM_Paint;
  146.      end;
  147.  
  148. var  Haupt   :TMain;
  149.  
  150. Procedure TMain.InitMainWindow;
  151.   begin
  152.    MainWindow:=New ( PHaupt, Init ( nil, 'Super Mind'));
  153.   end;
  154.  
  155. Procedure TMain.InitInstance;
  156.   begin
  157.     TApplication.InitInstance;
  158.     HAccTable:=LoadAccelerators ( HInstance, 'SuperAccels');
  159.   end;
  160.  
  161. Constructor THaupt.Init;
  162.   begin
  163.     TWindow.Init ( AParent, ATitle);
  164.     Attr.Menu:=LoadMenu ( HInstance, 'SuperMenu');
  165.     Attr.style:=Attr.Style or WS_CLIPCHILDREN;
  166.     Attr.x:=-4;
  167.     Attr.y:=-4;
  168.     Attr.w:=648;
  169.     Attr.h:=488;
  170.     OK_Button:=New ( PButton, Init ( @self, ID_KNOPF, 'Eingabe', 438, 205, 110, 50, True));
  171.   end;
  172.  
  173. Procedure THaupt.GetWindowClass;
  174.   begin
  175.     TWindow.GetWindowClass ( AWndClass);
  176.     AWndClass.hIcon:=LoadIcon ( HInstance, 'SuperIcon1');
  177.     AWndClass.hCursor:=0;
  178.     HGBitmap:=Boolean ( GetPrivateProfileInt ( 'Hintergrund', 'HGBitmap', 1, 'MIND.INI'));
  179.     HGRot:=GetPrivateProfileInt ( 'Hintergrund', 'Rot', 128, 'MIND.INI');
  180.     HGBlau:=GetPrivateProfileInt ( 'Hintergrund', 'Blau', 128, 'MIND.INI');
  181.     HGGruen:=GetPrivateProfileInt ( 'Hintergrund', 'Gruen', 128, 'MIND.INI');
  182.     Haupt.Bit1:=LoadBitmap ( HInstance, 'SuperBackground');
  183.     IF HGBitmap=True then
  184.       AWndClass.hbrBackground:=CreatePatternBrush ( Haupt.Bit1) 
  185.     else
  186.       AWndClass.hbrBackground:=CreateSolidBrush ( RGB ( HGRot, HGGruen, HGBlau));
  187.   end;
  188.  
  189. Procedure THaupt.SetupWindow;
  190.   begin
  191.     TWindow.SetupWindow;
  192.     hPopup:=CreatePopupMenu;
  193.     AppendMenu ( hPopup, MF_ENABLED, 101, 'Spiel neu');
  194.     AppendMenu ( hPopup, MF_ENABLED, 111, 'CODE-Optionen');
  195.     AppendMenu ( hPopup, MF_ENABLED, 104, 'Pause');
  196.     AppendMenu ( hPopup, MF_ENABLED, 131, 'Hilfe');
  197.     id_CheckB:=Boolean ( GetPrivateProfileInt ( 'Optionen', 'gleiche???', 1, 'MIND.INI'));
  198.     Anzahl:=GetPrivateProfileInt ( 'Optionen', 'Codelaenge', 4, 'MIND.INI');
  199.     Maxcolor:=GetPrivateProfileInt ( 'Optionen', 'FarbenZahl', 8, 'MIND.INI');
  200.     Oben:=Boolean(GetPrivateProfileInt('Optionen', 'Oben beginnen', 0, 'Mind.ini'));
  201.     Schwarz:=Boolean(GetPrivateProfileInt('Optionen', 'Schwarz', 0, 'Mind.ini'));
  202.     NurRichtig:=Boolean(GetPrivateProfileInt('Optionen', 'Nur Richtige anzeigen', 0, 'Mind.ini'));
  203.     MaxRunde:=GetPrivateProfileInt('Optionen', 'Maximale Rundenzahl', 10, 'MIND.INI');
  204.     ShowStatus:=Boolean(GetPrivateProfileInt('Optionen', 'StatusRechteck zeigen', 1, 'MIND.INI'));
  205.     Speichern:=Boolean(GetPrivateProfileInt('Optionen', 'Speichern beim Beenden', 1, 'MIND.INI'));
  206.     Mal:=0;
  207.     IF Oben then CheckMenuItem(Attr.Menu,cm_Oben, MF_Checked)
  208.             else CheckMenuItem(Attr.Menu, CM_Oben, MF_UNChecked);
  209.     IF NurRichtig then CheckMenuItem(Attr.menu, CM_NurRichtig, MF_Checked)
  210.                   else CheckMenuItem(Attr.Menu, CM_NurRichtig, MF_Unchecked);
  211.     IF Schwarz then CheckMenuItem(Attr.menu, CM_RichtigSchwarz, MF_Checked)
  212.                  else CheckMenuItem(Attr.Menu, CM_RichtigSchwarz, MF_Unchecked);
  213.     IF ShowStatus then CheckMenuItem(Attr.Menu, CM_ShowStatus, MF_Checked)
  214.                   else CheckMenuItem(Attr.Menu, CM_ShowStatus, MF_Unchecked);
  215.     IF Speichern then CheckMenuItem(Attr.Menu, CM_Speichern, MF_Checked)
  216.                  else CheckMenuItem(Attr.Menu, CM_Speichern, MF_Unchecked);
  217.     Randomize;
  218.     diag:=LoadBitmap ( HInstance, 'SuperDiagonal');
  219.     Curs:=LoadCursor ( HInstance, 'SUPERCURSOR');
  220.     Varzuweisen;
  221. end;
  222.  
  223. Procedure THaupt.NeuSpiel;
  224.   begin
  225.     Spiel;
  226.   end;
  227.  
  228. Procedure THaupt.CMShow;
  229. begin
  230.   IF BWCCMessageBox(HWindow, 'Wenn Sie sich den Code ansehen, beenden Sie dadurch Ihr gerade laufendes Spiel. Wollen Sie'+
  231.   ' sich dennoch den Code ansehen?', 'Achtung', MB_IconExclamation or MB_YesNo)=ID_YES then
  232.   begin
  233.     Application^.ExecDialog(New(PShowDialog, Init(@Self, 'ShowDialog', Code, anzahl)));
  234.     Spiel;
  235.     Mal:=0;
  236.   end;
  237. end;
  238.  
  239. Procedure THaupt.CMMAXRunde;
  240. begin
  241.   Application^.ExecDialog(new(PRundenDialog, Init( @Self, 'RundenDialog')));
  242.   InvalidateRect(HWindow, NIL, false);
  243. end;
  244.  
  245. Procedure THaupt.CodeOpt;
  246.   begin
  247.     IF Application^.ExecDialog ( New ( PCodeOpt, Init ( @Self, 'SuperCodeDialog')) ) =id_OK
  248.     THEN
  249.     begin
  250.       Spiel;
  251.       Mal:=0;
  252.       InvalidateRect(HWindow, Nil, False);
  253.     end;
  254.   end;
  255.  
  256. Procedure THaupt.Hintergr;
  257.   begin
  258.     If Application^.ExecDialog ( New ( PHintergr, Init ( @Self, 'SuperHinterDialog')) ) =ID_OK then
  259.     begin
  260.       DeleteObject ( GetClassWord ( HWindow, GCW_HbrBackground));
  261.       If HGBitmap=True then
  262.         SetClassWord ( HWindow, GCW_HBRBACKGROUND, CreatePatternBrush ( Haupt.Bit1)) 
  263.       else
  264.         SetClassWord ( HWindow, GCW_HBRBACKGROUND, CreateSolidBrush ( RGB ( HGRot, HGGruen, HGBlau)) );
  265.       Mal:=0;
  266.       InvalidateRect ( HWindow, nil, TRUE);
  267.     end;
  268.   end;
  269.  
  270. Procedure THaupt.BackRunde;
  271.   var x   :Byte;
  272.   begin
  273.     IF runde>0 then
  274.     begin
  275.       For x:=1 to anzahl do
  276.       begin
  277.         Farbposition[runde, x]:=0;
  278.         Verglei[runde, x]:=0;
  279.       end;
  280.       Dec ( runde);
  281.       Dec ( Rund );
  282.       AltRunde:=Runde;
  283.       Mal:=6;
  284.       InvalidateRect ( HWindow, nil, false);
  285.     end
  286.     else
  287.     begin
  288.       IF Rund > 0 then BWCCMessageBox (HWindow, 'Sie k÷nnen nur die 10 letzten Runden zurⁿcknehmen, da die frⁿheren'+
  289.       ' nicht gespeichert werden!!!', 'Achtung', MB_iconExclamation or MB_OK)
  290.       else BWCCMessageBox ( HWindow, 'Wenn Sie noch keine Rundeneingabe gemacht haben, k÷nnen Sie diese'+
  291.       'natⁿrlich auch nicht zurⁿcknehmen!', 'Leider, leider', MB_OK or MB_IconExclamation);
  292.     end;
  293.   end;
  294.  
  295. Procedure THaupt.Pause;
  296.   begin
  297.     SendMessage ( Application^.MainWindow^.HWindow, wm_Syscommand, sc_Minimize, 0);
  298.   end;
  299.  
  300. Procedure THaupt.HotEingabe;
  301.   begin
  302.     JaEingabe;
  303.   end;
  304.  
  305. Procedure THaupt.CMSpeichern;
  306. begin
  307.   Speichern:=Not(Speichern);
  308.   IF Speichern then CheckMenuItem(Attr.Menu, CM_Speichern, MF_CHecked)
  309.                else CheckMenuItem(Attr.Menu, CM_Speichern, MF_Unchecked);
  310. end;
  311.  
  312. Procedure THaupt.CMShowStatus;
  313. begin
  314.   ShowStatus:=Not(ShowStatus);
  315.   IF ShowStatus then CheckMenuItem(Attr.Menu, CM_ShowStatus, MF_Checked)
  316.                 else CheckMenuItem(Attr.Menu, CM_ShowStatus, MF_Unchecked);
  317.   Mal:=9;
  318.   InvalidateRect(HWindow, Nil, false);
  319. end;
  320.  
  321. Procedure THaupt.CMEnde;
  322. begin
  323.   IF CanClose=True then PostQuitMessage(0);
  324. end;
  325.  
  326. Procedure THaupt.Index;
  327.   begin
  328.     WinHelp ( Application^.MainWindow^.HWindow, 'Mind.hlp', HELP_INDEX, 0);
  329.   end;
  330.  
  331. Procedure THaupt.Spielregel;
  332.   begin
  333.     WinHelp ( Application^.MainWindow^.HWindow, 'Mind.hlp', HELP_CONTEXT, 3);
  334.   end;
  335.  
  336. Procedure THaupt.Bedienung;
  337.   begin
  338.     WinHelp ( Application^.MainWindow^.HWindow, 'Mind.hlp', HELP_CONTEXT, 1{LongInt ( PChar ( 'Bedienung')) });
  339.   end;
  340.  
  341. Procedure THaupt.Aufbau;
  342. begin
  343.   WinHelp(Application^.MainWindow^.HWindow, 'MIND.HLP', HELP_CONTEXT, 2);
  344. end;
  345.  
  346. Procedure THaupt.Info;
  347.   begin
  348.     Application^.ExecDialog ( New ( PDialog, Init ( @Self, 'SuperInfoDialog')) );
  349.   end;
  350.  
  351. Procedure THaupt.WMMouseMove;
  352.   var  woCurs   :TPoint;
  353.   begin
  354.     woCurs:=MAKEPOINT ( Msg.lParam);
  355.     IF PtinRect ( Eing, woCurs) =true then hCurs:=Curs
  356.       else hCurs:=LoadCursor ( 0, IDC_ARROW);
  357.     SetCursor ( HCurs);
  358.   end;
  359.  
  360. Procedure THaupt.WMLButtonDown;
  361.   var  pt   :TPoint;
  362.   begin
  363.       pt:=MAKEPOINT ( Msg.lParam);
  364.       If hCurs=Curs then
  365.       begin
  366.         Colopos:=Round ( ( pt.x-Eing.left) * anzahl/ ( Eing.right - Eing.left)  + 0.5);
  367.         setcode[Colopos]:=Color;
  368.         Mal:=2;
  369.         InvalidateRect ( HWindow, nil, false);
  370.       end;
  371.   end;
  372.  
  373. Procedure THaupt.WMRButtonDown;
  374.   begin
  375.     Inc ( Color);
  376.     IF color>maxcolor THEN Color:=1;
  377.     Mal:=1;
  378.     InvalidateRect ( HWindow, nil, false);
  379.   end;
  380.  
  381. Procedure THaupt.WMMButtonDown;
  382.   var pt :TPoint;
  383.   begin
  384.     pt:=MAKEPOINT ( Msg.lParam);
  385.     ClienttoScreen ( HWindow, pt);
  386.     TrackPopupMenu ( hPopup, 0, pt.x, pt.y, 0, HWindow, nil);
  387.   end;
  388.  
  389. Procedure THaupt.Eingabe;
  390.   begin
  391.     JaEingabe;
  392.   end;
  393.  
  394. Procedure THaupt.Paint;
  395. var B, Balt      :HBrush;
  396.     PenAlt, Pen1 :HPen;
  397.     Zaehl        :Byte;
  398.   Procedure StatusLine;
  399.   var  Buff:Array[0..4] of Char;
  400.   begin
  401.     IF ShowStatus then
  402.     begin
  403.       SetTextColor(PaintDC, RGB(192, 0, 64));
  404.       SetBKColor(PaintDC, RGB(192, 192, 192));
  405.       Str(Rund+1, Buff);
  406.       TextOut(PaintDC, 400, 265, Buff, StrLen(Buff));
  407.       Str(MaxRunde:4, Buff);
  408.       IF MaxRunde<100 then TextOut(PaintDC, 527, 265, Buff, StrLen(Buff))
  409.                      else TextOut(PaintDC, 525, 265, Buff, StrLen(Buff));
  410.       Str(Anzahl, Buff);
  411.       TextOut(PaintDC, 418, 293, Buff, StrLen(Buff));
  412.       Str(maxcolor, Buff);
  413.       TextOut(PaintDC, 418, 306, Buff, StrLen(Buff));
  414.       IF id_CheckB=True then TextOut(PaintDC, 492, 319, '÷fters', 6)
  415.                  else TextOut(PaintDC, 492, 319, 'einmal', 6);
  416.       IF Oben then TextOut(PaintDC, 340, 348, 'oben ', 5)
  417.               else TextOut(PaintDC, 340, 348, 'unten', 5);
  418.       IF NurRichtig then TextOut(PaintDC, 340, 364, 'Nur Richtige anzeigen                                 ', 54)
  419.                     else TextOut(PaintDC, 340, 364, 'Auch anzeigen, wenn nur die Farbe stimmt', 40);
  420.       B:=GetStockObject(WHITE_BRUSH);
  421.       BAlt:=SelectObject(PaintDC, b);
  422.       IF Schwarz=False then Rectangle(PaintDC, 350, 390, 450, 410)
  423.                  else Rectangle(PaintDC, 500, 390, 600, 410);
  424.       B:=GetStockObject(BLACK_Brush);
  425.       DeleteObject( SelectObject(PaintDC, B));
  426.       IF Schwarz then Rectangle(PaintDC, 350, 390, 450, 410)
  427.                  else Rectangle(PaintDC, 500, 390, 600, 410);
  428.       DeleteObject(SelectObject(PaintDC, BAlt));
  429.     end;
  430.   end;
  431.   Procedure State;
  432.   begin
  433.     IF ShowStatus then
  434.     begin
  435.       BAlt:=SelectObject(PaintDC, CreateSolidBrush(RGB(192, 192, 192)));
  436.       Rectangle(PaintDC, 321, 260, 619, 430);
  437.       DeleteObject(SelectObject(PaintDC, Balt));
  438.       SetBKMode(PaintDC, TRANSPARENT);
  439.       TextOut(PaintDC, 340, 265, 'Runde: ', 7);
  440.       TextOut(PaintDC, 470, 265, 'Maximal       Runden', 20);
  441.       TextOut(PaintDC, 326, 280, 'Code - Optionen', 15);
  442.       TextOut(PaintDC, 340, 293, 'LΣnge:            Steine', 24);
  443.       TextOut(PaintDC, 340, 306, 'Farben:           verschiedene', 30);
  444.       TextOut(PaintDC, 340, 319, 'Gleiche Farbe im Code             erlaubt', 41);
  445.       TextOut(PaintDC, 326, 335, 'Darstellung', 11);
  446.       TextOut(PaintDC, 340, 348, '             beginnen', 21);
  447.       TextOut(PaintDC, 326, 410, 'Farbe + Position richtig      nur Farbe richtig ', 48);
  448.       DeleteObject(SelectObject(PaintDC, BAlt));
  449.       StatusLine;
  450.     end;
  451.   end;
  452.   Procedure Spielstein ( Position, Farbe:Byte);
  453.     var  link, recht   :Integer;
  454.     begin
  455.       B:=CreateSolidBrush ( Farben[Farbe]);
  456.       Balt:=SelectObject ( PaintDC, B);
  457.       link:=Round ( 355 + 240 / anzahl* ( Position-1));
  458.       recht:=Round ( 345 + 240 / anzahl*Position);
  459.       Ellipse ( PaintDC, link, 140, recht, 175);
  460.       DeleteObject ( SelectObject ( PaintDC, Balt));
  461.     end;
  462.   Procedure Neureihe;
  463.     var  link  :Integer;
  464.          x     :Byte;
  465.     begin
  466.       Pen1 := CreatePen ( ps_Solid, 2, RGB ( 0, 0, 0));
  467.       PenAlt:=SelectObject ( PaintDC, Pen1);
  468.       Rectangle ( PaintDC, 350, 135, 590, 180);
  469.       For x:=1 to ( anzahl-1)  do
  470.       begin
  471.         link:=Round ( 350+240/anzahl*x);
  472.         MoveTo ( PaintDC, link, 135);
  473.         LineTo ( PaintDC, link, 178);
  474.       end;
  475.       DeleteObject ( SelectObject ( PaintDC, PenAlt));
  476.       For x:=1 to anzahl do
  477.       begin
  478.         Spielstein ( x, setcode[x]);
  479.       end;
  480.     end;
  481.   Procedure Reihe ( Position:Byte);
  482.     var  o, u :Integer;
  483.          x         :Byte;
  484.     begin
  485.       IF oben=True then
  486.       begin
  487.         u:=73 + 34*Position;
  488.         o:=u-28;
  489.       end
  490.       else
  491.       begin
  492.         u:=73 + 34*(11-Position);
  493.         o:=u-28;
  494.       end;
  495.       For x:=1 to anzahl do
  496.       begin
  497.         B:=CreateSolidBrush ( Farben[Farbposition[Position, x]]);
  498.         BAlt:=SelectObject ( PaintDC, B);
  499.         Ellipse ( PaintDC, Round ( 50 + 165* ( x-1) /anzahl) , o, Round ( 43 + 165*x/anzahl) , u-3);
  500.         DeleteObject ( SelectObject ( PaintDC, BAlt));
  501.       end;
  502.     end;
  503.   Procedure SWPunkte ( Position:Byte);
  504.     var unt  :Byte;
  505.     Procedure Codereihe ( anf, ende:Byte;ob:Boolean); far;
  506.       var links, obe    :Integer;
  507.           x             :Byte;
  508.       begin
  509.         B:=GetStockObject(WHITE_BRUSH);
  510.         Balt:=SelectObject ( PaintDC, B);
  511.         For x:=anf to ende do
  512.         begin
  513.           Case Verglei[Position, x] of
  514.             0:begin
  515.                 B:=CreateSolidBrush ( Farben[0]);
  516.                 DeleteObject ( SelectObject ( PaintDC, B));
  517.                end;
  518.             1:begin
  519.                 IF NurRichtig=False then 
  520.                 begin
  521.                   IF Schwarz=True then B:=GetStockObject ( WHITE_BRUSH)
  522.                                   else B:=GetStockObject ( BLACK_BRUSH);
  523.                 end
  524.                 else B:=CreateSolidBrush(Farben[0]);
  525.                 DeleteObject ( SelectObject ( PaintDC, B));
  526.               end;
  527.             2:begin
  528.                 IF Schwarz=True then B:=GetStockObject ( BLACK_BRUSH)
  529.                                 else B:=GetStockObject ( WHITE_BRUSH);
  530.                 DeleteObject ( SelectObject ( PaintDC, B));
  531.               end;
  532.           end;
  533.           IF ob=true then
  534.           begin
  535.             links:=Round ( ( 212+ ( 60  - ( ( Anzahl - unt) *14)) /2) + ( x-anf) *14);
  536.             IF oben=true then obe:=Round ( 46+34* Position )
  537.                          else Obe:=Round ( 420- 34* Position);
  538.           end
  539.           else
  540.           begin
  541.             links:=Round ( ( 212+ ( 60  - ( ( unt) *14)) /2) + ( x-anf) *14);
  542.             IF oben=true then obe:=Round ( 60 + 34* Position)
  543.                          else Obe:=Round ( 434 - 34* Position );
  544.           end;
  545.           Ellipse ( PaintDC, links, obe, links+10, obe+10);
  546.         end;
  547.         DeleteObject ( SelectObject ( PaintDC, Balt));
  548.       end;
  549.     begin
  550.       unt:=Round ( anzahl/2);
  551.       Codereihe ( 1, unt, false);
  552.       Codereihe ( unt+1, anzahl, true);
  553.     end;
  554.   Procedure Farbe ( Farbe:Byte);
  555.     begin
  556.       B:=CreateSolidBrush ( Farben[Farbe]);
  557.       Balt:=SelectObject ( PaintDC, B);
  558.       Rectangle ( PaintDC, 435, 52, 505, 90);
  559.       DeleteObject ( SelectObject ( PaintDC, BAlt));
  560.     end;
  561.   Procedure ganzBild;
  562.     var  anf            :Integer;
  563.          x              :Byte;
  564.     begin                 
  565.       B:=CreateSolidBrush ( Farben[0]);
  566.       Balt:=SelectObject ( PaintDC, B);
  567.       Pen1:=CreatePen ( ps_Solid, 3, RGB ( 0, 0, 0));
  568.       PenAlt:=SelectObject ( PaintDC, Pen1);
  569.       Rectangle ( PaintDC, 45, 11, 270, 414);
  570.       Rectangle ( PaintDC, 95, 10, 200, 35);
  571.       B:=CreateHatchBrush ( hs_fDiagonal, RGB ( 0, 0, 0));
  572.       DeleteObject ( SelectObject ( PaintDC, B));
  573.       Polygon ( PaintDC, Ecken1, 6);
  574.       MoveTo ( PaintDC, 270, 414);
  575.       LineTo ( PaintDC, 290, 434);
  576.       Polygon ( PaintDC, Ecken3, 4);
  577.       B:=CreatePatternBrush ( diag);
  578.       DeleteObject ( SelectObject ( PaintDC, B));
  579.       Polygon ( PaintDC, Ecken2, 4);
  580.       DeleteObject ( SelectObject ( PaintDC, BAlt));
  581.       anf:=108;
  582.       For x:=1 to 9 do
  583.       begin
  584.         MoveTo ( PaintDC, 45, anf);
  585.         LineTo ( PaintDC, 270, anf);
  586.         Inc ( anf, 34);
  587.       end;
  588.       Pen1:=CreatePen ( ps_Solid, 2, RGB ( 0, 0, 0));
  589.       DeleteObject ( SelectObject ( PaintDC, Pen1));
  590.       MoveTo ( PaintDC, 210, 74);
  591.       LineTo ( PaintDC, 210, 414);
  592.       DeleteObject ( SelectObject ( PaintDC, PenAlt));
  593.       Rectangle ( PaintDC, 425, 40, 515, 100);
  594.       DrawText ( PaintDC, 'Farbe'#0, -1, Rect, DT_CENTER or DT_VCENTER);
  595.       DeleteObject(SelectObject(PaintDC, BAlt));
  596.       State;
  597.       Neureihe;
  598.       Farbe ( Color);
  599.       For x:=1 to 10 do
  600.       begin
  601.         Reihe ( x);
  602.         SWPunkte ( x);
  603.       end;
  604.     end;
  605.   begin
  606.     CASE Mal of
  607.       1:Farbe ( Color);
  608.       2:Spielstein ( Colopos, Color);
  609.       3:Neureihe;
  610.       4:begin
  611.           Reihe ( runde);
  612.           SWPunkte ( runde);
  613.           Neureihe;
  614.           IF ShowStatus then StatusLine;
  615.         end;
  616.       5:SWPunkte ( runde);
  617.       6:begin
  618.           Reihe ( runde+1);
  619.           SWPunkte ( runde+1);
  620.           IF ShowStatus then StatusLine;
  621.         end;
  622.       7:begin
  623.           For Zaehl:=1 to 10 do
  624.           begin
  625.             Reihe(Zaehl);
  626.             SWPunkte(Zaehl);
  627.           end;
  628.           Farbe(Color);
  629.           Neureihe;
  630.           IF ShowStatus then StatusLine;
  631.         end;
  632.       8:begin
  633.           For Zaehl:=1 to Runde do SWPunkte(Zaehl);
  634.           StatusLine;
  635.         end;
  636.      9:begin
  637.           IF ShowStatus then State
  638.           else
  639.           begin
  640.             IF HGBitMap then b:=CreatePatternBrush(Haupt.Bit1)
  641.                         else b:=CreateSolidBrush(RGB(HGRot, HGGruen, HGBlau));
  642.             BAlt:=SelectObject(PaintDC, B);
  643.             PenAlt:=SelectObject(PaintDC, CreatePen(PS_NULL, 0, 0));
  644.             Rectangle(PaintDC, 321, 260, 620, 431);
  645.             DeleteObject(SelectObject(PaintDC, PenAlt));
  646.             DeleteObject(SelectObject(PaintDC, BAlt));
  647.           end;
  648.         end;
  649.      10:StatusLine;
  650.      11:begin
  651.           For Zaehl:=1 to 10 do
  652.           begin
  653.             Reihe(Zaehl);
  654.             SWPunkte(Zaehl);
  655.           end;
  656.           StatusLine;
  657.         end;
  658.      else ganzBild;
  659.     end;
  660.     mal:=0;
  661.   end;
  662.  
  663. Procedure THaupt.Spiel;
  664.   begin
  665.     Varzuweisen;
  666.     Mal:=7;
  667.     InvalidateRect ( HWindow, nil, false);
  668.   end;
  669.  
  670. Procedure THaupt.Varzuweisen;
  671.   var x, x1  :Byte;
  672. begin
  673.   For x:=1 to 10 do
  674.   begin
  675.     For x1:=1 to anzahl do
  676.     begin
  677.       Farbposition[x, x1]:=0;
  678.       Verglei[x, x1]:=0;
  679.     end;
  680.   end;
  681.   runde:=0;
  682.   Rund:=0;
  683.   AltRunde:=0;
  684.   Color:=1;
  685.   For x:=1 to anzahl do
  686.   begin
  687.     setcode[x]:=10;
  688.     Code[x]:=Random ( maxcolor) +1;
  689.   end;
  690.   If id_CheckB=false  then
  691.   begin
  692.     For x:=2 to anzahl do
  693.     begin
  694.       x1:=1;
  695.       Repeat
  696.         If ( Code[x]=Code[x1]) then
  697.         begin
  698.           Inc(Code[x]);
  699.           If Code[x]>Maxcolor then Code[x]:=1;
  700.           x1:=1;
  701.         end
  702.         else inc(x1);
  703.       Until x1>=x;
  704.     end;
  705.   end;
  706. end;
  707.  
  708. Procedure THaupt.Vergleich;
  709.   var  x, x1, x2  :Byte;
  710.        ja, c      :Boolean;
  711.        cod, jacod :array[1..8] of Boolean;
  712.   begin
  713.     For x1:=1 to Anzahl do
  714.     begin
  715.       cod[x1]:=false;
  716.       jacod[x1]:=false;
  717.     end;
  718.     x:=1;
  719.     For x1:=1 to anzahl do
  720.     begin
  721.       IF Farbposition[posi, x1]=Code[x1] THEN
  722.       begin
  723.         Verglei[posi, x]:=2;
  724.         Inc ( x);
  725.         cod[x1]:=true;
  726.         jacod[x1]:=true;
  727.       end;
  728.     end;
  729.     For x1:=1 to anzahl do
  730.     begin
  731.       x2:=0;
  732.       Repeat
  733.         Inc ( x2);
  734.         c:=not ( cod[x2] or jacod[x1]);
  735.         ja:= ( Farbposition[posi, x1]=Code[x2])  and ( x1<>x2)  and c;
  736.         IF ja=true then
  737.         begin
  738.           Verglei[posi, x]:=1;
  739.           Inc ( x);
  740.           cod[x2]:=true;
  741.           jacod[x1]:=true;
  742.         end;
  743.       Until ( ja=true)  or ( x2>=anzahl);
  744.     end;
  745.     Mal:=5;
  746.     InvalidateRect ( HWindow, nil, false);
  747.   end;
  748.  
  749. Procedure THaupt.ObenStart;
  750. begin
  751.   Oben:=Not(Oben);
  752.   IF Oben then CheckMenuItem(Attr.Menu,cm_Oben, MF_Checked)
  753.           else CheckMenuItem(Attr.Menu, CM_Oben, MF_UNChecked);
  754.   Mal:=11;
  755.   InvalidateRect(HWindow, nil, False);
  756. end;
  757.  
  758. Procedure THaupt.RichtigSchwarz;
  759. begin
  760.   Schwarz:=Not(Schwarz);
  761.   IF Schwarz then CheckMenuItem(Attr.Menu, CM_RichtigSchwarz, MF_Checked)
  762.                  else CheckMenuItem(Attr.Menu, CM_RichtigSchwarz, MF_Unchecked);
  763.   Mal:=8;
  764.   InvalidateRect(HWindow, Nil, False);
  765. end;
  766.  
  767. Procedure THaupt.NurRichtige;
  768. begin
  769.   NurRichtig:=Not(NurRichtig);
  770.   IF NurRichtig then CheckMenuItem(Attr.menu, CM_NurRichtig, MF_Checked)
  771.                 else CheckMenuItem(Attr.Menu, CM_NurRichtig, MF_Unchecked);
  772.   Mal:=8;
  773.   InvalidateRect(HWindow, nil, False);
  774. end;
  775.  
  776. Procedure THaupt.JaEingabe;
  777.   var  x :Byte;
  778.        a :Boolean;
  779.   begin
  780.     x:=0;
  781.     a:=False;
  782.     Repeat
  783.       Inc ( x);
  784.       IF setcode[x]=10 then a:=true;
  785.     Until ( x>=anzahl)  or ( a=true);
  786.     IF a=true then
  787.     begin
  788.       BWCCMessageBox ( HWindow, 'Sie mⁿssen zuerst alle Felder belegen, bevor Sie "Eingabe" drⁿcken!!!', 'Achtung',
  789.       MB_OK or MB_IconExclamation);
  790.     end
  791.     else
  792.     begin
  793.       Inc(runde);
  794.       Inc(Rund);
  795.       IF Runde>10 then Runde:=10;
  796.       Altrunde:=Runde;
  797.       IF (Rund > 10) and (Runde=10) then
  798.       begin
  799.         For x:=1 to 9 do
  800.         begin
  801.           FarbPosition[x]:=FarbPosition[x+1];
  802.           Verglei[x]:=Verglei[x+1];
  803.         end;
  804.       end;
  805.       for x:=1 to anzahl do
  806.       begin
  807.            Farbposition[runde, x]:=setcode[x];
  808.            setcode[x]:=10;
  809.       end;
  810.       Vergleich ( runde);
  811.       Mal:=4;
  812.       IF (Rund>10) AND (Runde=10) then Mal:=7;
  813.       IF Codericht ( runde) =true THEN  
  814.       begin
  815.         For x:=1 to 5 do
  816.         begin
  817.           FlashWindow ( HWindow, false);
  818.           MessageBeep ( 0);
  819.         end;
  820.         IF BWCCMessageBox ( HWindow, 'Sie haben den Code richtig herausgefunden! Damit haben Sie das Spiel gegen den'+
  821.         ' Computer gewonnen. Wollen Sie noch einmal spielen?', 'Super, super!', MB_YesNo or MB_IconExclamation) =id_Yes
  822.         then begin
  823.                Spiel;
  824.                Mal:=0;
  825.              end
  826.         else
  827.         begin
  828.           IF THaupt.CanClose=True then PostQuitMessage(0)
  829.                                     else begin
  830.                                            Spiel;
  831.                                            Mal:=0;
  832.                                          end;
  833.         end;
  834.       end
  835.       else
  836.       begin
  837.         IF rund>=MaxRunde THEN
  838.         begin
  839.           Application^.ExecDialog(New(PShowDialog, Init(@SElf, 'ShowDialog', Code, Anzahl)));
  840.           IF BWCCMessageBox ( HWindow, 'Der Computer hat das Spiel gegen Sie gewonnen. Wollen Sie noch einmal spielen?',
  841.            'Uih, Schade!!!', MB_YesNo
  842.           or MB_IconExclamation) =id_yes
  843.           then begin
  844.                  Spiel;
  845.                  Mal:=0;
  846.                end
  847.           else
  848.           begin
  849.             IF THaupt.CanClose=True then PostQuitMessage(0)
  850.                                     else begin
  851.                                            Spiel;
  852.                                            Mal:=0;
  853.                                          end;
  854.           end;
  855.         end;
  856.       end;
  857.     end;
  858.   end;
  859.  
  860. Function WritePrivateProfileInt(KeyName, EntryName:PChar; Value:Integer; IniFile:PChar):Boolean;
  861. var st:array[0..10] of Char;
  862. begin
  863.   Str(Value,st);
  864.   WritePrivateProfileInt:=WritePrivateProfileString(KeyName, EntryName, st, iniFile);
  865. end;
  866.  
  867.  
  868. Function THaupt.CanClose:Boolean;
  869.   Begin
  870.     CanClose:=false;
  871.     IF BWCCMessageBox ( HWindow, 'Wollen Sie "SUPER MIND" wirklich beenden?', 'Beenden',
  872.     MB_YesNo or MB_IconQuestion) =ID_Yes
  873.     THEN
  874.     begin
  875.       WritePrivateProfileInt('Optionen', 'Speichern beim Beenden', Integer(Speichern), 'MIND.INI');
  876.       IF Speichern then
  877.       begin
  878.         WritePrivateProfileInt('Optionen', 'StatusRechteck zeigen', Integer(ShowStatus), 'MIND.INI');
  879.         WritePrivateProfileInt ( 'Optionen', 'Codelaenge', Anzahl , 'MIND.INI');
  880.         WritePrivateProfileInt ( 'Optionen', 'FarbenZahl', MaxColor , 'MIND.INI');
  881.         WritePrivateProfileInt ( 'Optionen', 'Gleiche???', Integer(id_CheckB) , 'MIND.INI');
  882.         WritePrivateProfileInt ( 'Hintergrund', 'HGBitmap', Integer(HGBitmap) , 'MIND.INI');
  883.         WritePrivateProfileInt ( 'Hintergrund', 'Rot', HGRot , 'MIND.INI');
  884.         WritePrivateProfileInt ( 'Hintergrund', 'Gruen', HGGruen , 'MIND.INI');
  885.         WritePrivateProfileInt ( 'Hintergrund', 'Blau', HGBlau , 'MIND.INI');
  886.         WritePrivateProfileInt ( 'Optionen', 'Oben beginnen', Integer(oben) , 'MIND.INI');
  887.         WritePrivateProfileInt ( 'Optionen', 'Schwarz', Integer(Schwarz) , 'MIND.INI');
  888.         WritePrivateProfileInt ( 'Optionen', 'Nur Richtige anzeigen', Integer(NurRichtig) , 'MIND.INI');
  889.         WritePrivateProfileInt( 'Optionen', 'Maximale Rundenzahl', MaxRunde, 'MIND.INI');
  890.       end;
  891.       CanClose:=true;
  892.     end;
  893.   end;
  894.  
  895. Function THaupt.Codericht ( var Reihe:Byte) :Boolean;
  896.   var  x  :Byte;
  897.        ja :Boolean;
  898.   begin
  899.     x:=0;
  900.     Repeat
  901.     Inc ( x);
  902.     If Farbposition[Reihe, x]=Code[x] then ja:=true
  903.                                       else ja:=false;
  904.     Until ( ja=false)  or ( x>=anzahl);
  905.     Codericht:=ja;
  906.   end;
  907.  
  908. Destructor Thaupt.Done;
  909. begin
  910.   WinHelp(HWindow, 'MIND.HLP', HELP_QUIT, 0);
  911.   DeleteObject(Haupt.Bit1);
  912.   DeleteObject(diag);
  913.   TWindow.Done;
  914. end;
  915.  
  916. Function TCodeOpt.CanClose:Boolean;
  917.   begin
  918.     TDialog.CanClose;
  919.     CanClose:=true;
  920.     IF ( jaOK AND jaW)  then
  921.     begin
  922.       IF ( jagleiche = false)  AND ( FarbZ < CodeZ )  then
  923.       begin
  924.         BWCCMessageBox ( HWindow, 'Wenn Sie "GLEICHE ERLAUBT" nicht angewΣhlt haben, darf die Anzahl der Codesteine'+
  925.         ' die Anzahl der Farben nicht ⁿbersteigen!!!', 'Achtung!!!', MB_OK or MB_IconInformation);
  926.         CanClose:=false;
  927.       end
  928.       else
  929.       begin
  930.         id_CheckB:=jagleiche;
  931.         maxcolor:=FarbZ;
  932.         anzahl:=CodeZ;
  933.       end;
  934.     end
  935.     else
  936.       IF ( jaOK)  then CanClose:=false;
  937.   end;
  938.  
  939. Procedure TCodeOpt.OK;
  940.   var x:Byte;
  941.   begin
  942.     jaOK:=True;
  943.     IF BWCCMessageBox ( HWindow, 'Hiermit beginnen Sie ein neues Spiel. Das bereits begonnene geht damit unwiederbringlich'+
  944.     ' verloren. Wollen sie dennoch weitermachen?', 'Achtung', 
  945.     MB_YesNo or Mb_IconQuestion)  = id_Yes then
  946.     begin
  947.       jaW:=True;
  948.       jagleiche:=Boolean(IsDlgButtonChecked ( HWindow, 71));
  949.       For x:=51 to 57 do
  950.       IF SendDlgItemMessage ( HWindow, x, BM_GETCHECK, 0, 0) =word ( true)  then Farbz:=x-48;
  951.       For x:=61 to 66 do
  952.       IF SendDlgItemMessage ( HWindow, x, BM_GETCHECK, 0, 0) =word ( true)  then Codez:=x-58;
  953.     end;
  954.     TDialog.OK ( Msg);
  955.   end;
  956.  
  957. Procedure TCodeOpt.SetupWindow;
  958.   begin
  959.     CheckRadioButton ( HWindow, 51, 57, Maxcolor+48);
  960.     CheckRadioButton ( HWindow, 61, 66, anzahl+58);
  961.     CheckDlgButton ( HWindow, 71, Word(id_CheckB));
  962.     jaW:=False;
  963.     jaOK:=False;
  964.   end;
  965.  
  966. Constructor THintergr.Init;
  967. begin
  968.    TDialog.Init ( Fenster, Title);
  969.    RotLL:=New ( PScrollBar, InitResource ( @Self, 61));
  970.    GruenLL:=New ( PScrollBar, InitResource ( @Self, 63));
  971.    BlauLL:=New ( PScrollBar, InitResource ( @Self, 65));
  972. end;
  973.  
  974. Procedure THintergr.SetupWindow;
  975.   var MStr    :String;
  976.   begin
  977.     TDialog.SetupWindow;
  978.     RotES:=HGRot;
  979.     GruenES:=HGGruen;
  980.     BlauES:=HGBlau;
  981.     RotLL^.SetRange ( 0, 255);
  982.     RotLL^.SetPosition ( RotES);
  983.     GruenLL^.SetRange ( 0, 255);
  984.     GruenLL^.SetPosition ( GruenES);
  985.     BlauLL^.SetRange ( 0, 255);
  986.     BlauLL^.SetPosition ( BlauES);
  987.     Str ( RotES:3, MStr);
  988.     StrPCopy ( RES, MStr);
  989.     SetWindowText ( GetDlgItem ( HWindow, 62) , RES);
  990.     Str ( GruenES:3, MStr);
  991.     StrPCopy ( GES, MStr);
  992.     SetWindowText ( GetDlgItem ( HWindow, 64) , GES);
  993.     Str ( BlauES:3, MStr);
  994.     StrPCopy ( BES, MStr);
  995.     SetWindowText ( GetDlgItem ( HWindow, 66) , BES);
  996.     IF HGBitmap=true
  997.       then CheckRadioButton ( HWindow, 50, 60, 50)
  998.       else CheckRadioButton ( HWindow, 50, 60, 60);
  999.   end;
  1000.  
  1001. Procedure THintergr.WMPaint;
  1002.   var Brush, BrushAlt  :HBrush;
  1003.       PaintDC          :HDC;
  1004.       PaintInfo        :TPaintStruct;
  1005.       Client           :TRect;
  1006.       Bit              :HBitmap;
  1007.   begin
  1008.     PaintDC:=BeginPaint ( HWindow, PaintInfo);
  1009.     Bit:=LoadBitMap(HInstance,'BorBack');
  1010.     Brush:=CreatePatternBrush(Bit);
  1011.     BrushAlt:=SelectObject(PaintDC, Brush);
  1012.     GetClientRect(HWindow, Client);
  1013.     Rectangle(PaintDC, 0, 0, Client.Right, Client.bottom);
  1014.     DeleteObject(SelectObject ( PaintDC, CreatePatternBrush ( Haupt.Bit1)));
  1015.     Rectangle ( PaintDC, 30, 62, 300, 102);
  1016.     Brush:=CreateSolidBrush ( RGB ( RotES, GruenES, BlauES));
  1017.     DeleteObject ( SelectObject ( PaintDC, Brush));
  1018.     Rectangle ( PaintDC, 30, 134, 300, 174);
  1019.     DeleteObject ( SelectObject ( PaintDC, BrushAlt));
  1020.     DeleteObject(Bit);
  1021.     EndPaint ( HWindow, PaintInfo);
  1022.   end;
  1023.  
  1024. Procedure THintergr.OK;
  1025.   begin
  1026.     HGBitmap:=Boolean ( IsDlgButtonChecked ( HWindow, 50));
  1027.     HGRot:=RotES;
  1028.     HGGruen:=GruenES;
  1029.     HGBlau:=BlauES;
  1030.     TDialog.OK ( MSG);
  1031.   end;
  1032.  
  1033. Procedure THintergr.RotScroll;
  1034.   var MStr   :String;
  1035.   begin
  1036.     RotES:=RotLL^.GetPosition;
  1037.     Str ( RotES:3, MStr);
  1038.     StrPCopy ( RES, MStr);
  1039.     SetWindowText ( GetDlgItem ( HWindow, 62) , RES);
  1040.     InvalidateRect ( HWindow, NIL, false);
  1041.   end;
  1042.  
  1043. Procedure THintergr.GruenScroll;
  1044.   var MStr   :String;
  1045.   begin
  1046.     GruenES:=GruenLL^.GetPosition;
  1047.     Str ( GruenES:3, MStr);
  1048.     StrPCopy ( GES, MStr);
  1049.     SetWindowText ( GetDlgItem ( HWindow, 64) , GES);
  1050.     InvalidateRect ( HWindow, NIL, false);
  1051.   end;
  1052.  
  1053. Procedure THintergr.BlauScroll;
  1054.   var MStr   :String;
  1055.   begin
  1056.     BlauES:=BlauLL^.GetPosition;
  1057.     Str ( BlauES:3, MStr);
  1058.     StrPCopy ( BES, MStr);
  1059.     SetWindowText ( GetDlgItem ( HWindow, 66) , BES);
  1060.     InvalidateRect ( HWindow, NIL, false);
  1061.   end;
  1062.  
  1063. Constructor TRundenDialog.Init;
  1064. begin
  1065.   TDialog.Init(Fenster, Title);
  1066.   LL:=New(PScrollBar, InitResource(@Self, 100));
  1067. end;
  1068.  
  1069. Procedure TRundenDialog.SetUpWindow;
  1070. var  MStr:String;
  1071. begin
  1072.   TDialog.SetUpWindow;
  1073.   ES:=MaxRunde;
  1074.   LL^.SetRange(10,255);
  1075.   LL^.SetPosition(ES);
  1076.   Str ( ES:3, MStr);
  1077.   StrPCopy(Einstellung, MStr);
  1078.   SetWindowText ( GetDlgItem ( HWindow, 101) , Einstellung);
  1079. end;
  1080.  
  1081. Procedure TRundenDialog.OK;
  1082. begin
  1083.   MaxRunde:=ES;
  1084.   TDialog.OK(Msg);
  1085. end;
  1086.  
  1087. Procedure TRundenDialog.Scroll;
  1088. var MStr:String;
  1089. begin
  1090.   ES:=LL^.GetPosition;
  1091.   Str(ES:3, MStr);
  1092.   StrPCopy(Einstellung, MStr);
  1093.   SetWindowText(GetDlgItem(hWindow, 101), Einstellung);
  1094. end;
  1095.  
  1096. Constructor TShowDialog.Init;
  1097. begin
  1098.   TDialog.Init(Fenster, Titel);
  1099.   Code:=Darstellen;
  1100.   Laenge:=Lang;
  1101. end;
  1102.  
  1103. Procedure TShowDialog.WMPaint;
  1104. var TPS:TPaintStruct;
  1105.     Client:TRect;
  1106.     B:hBrush;
  1107.     Bit:HBitmap;
  1108.     x:Byte;
  1109. begin
  1110.   BeginPaint(HWindow, TPS);
  1111.   Bit:=LoadBitMap(HInstance, 'BorBack');
  1112.   B:=SelectObject(TPS.hDC, CreatePatternBrush(Bit));
  1113.   GetClientRect(HWindow, Client);
  1114.   Rectangle(TPS.hDc, 0, 0, Client.Right, Client.bottom);
  1115.   DeleteObject(SelectObject(TPS.hDC, CreateSolidBrush(RGB(192, 192, 192))));
  1116.   Rectangle (TPS.hDC, 11, 55, 272, 110);
  1117.   For x:=1 to Laenge-1 do
  1118.   begin
  1119.     MoveTo(TPS.hDC, Round(11+((272-11)/Laenge)*x), 55);
  1120.     LineTo(TPS.hDC, Round(11+((272-11)/Laenge)*x), 110);
  1121.   end;
  1122.   For x:=1 to Laenge do
  1123.   begin
  1124.     DeleteObject(SelectObject(TPS.hDC, CreateSolidBrush(Farben[Code[x]])));
  1125.     Ellipse(TPS.hDC, Round(11+5+(x-1)*(272-11)/Laenge), 60, Round(11-5+x*(272-11)/Laenge), 105);
  1126.   end;
  1127.   DeleteObject(SelectObject(TPS.hDC, B));
  1128.   DeleteObject(Bit);
  1129. end;
  1130.  
  1131. begin
  1132.   Haupt.Init ( 'Super Mind');
  1133.   Haupt.Run;
  1134.   Haupt.Done;
  1135. end.