home *** CD-ROM | disk | FTP | other *** search
/ Computer Club Elmshorn Atari PD / CCE_PD.iso / pc / 0600 / CCE_0632.ZIP / CCE_0632 / GOBJ_111.ZIP / GOBJECTS.111 / SOURCE / MAKEFAST / MAKEFAST.PAS < prev    next >
Pascal/Delphi Source File  |  1994-03-26  |  14KB  |  382 lines

  1. {$IFDEF DEBUG}
  2.     {$B+,D+,G-,I-,L+,N-,P-,Q+,R+,S+,T-,V-,X+,Z+}
  3. {$ELSE}
  4.     {$B+,D-,G-,I-,L-,N-,P-,Q-,R-,S-,T-,V-,X+,Z+}
  5. {$ENDIF}
  6.  
  7. program MakeFast;
  8.   { Copyright (c)1994 by Softdesign Computer Software
  9.                                written by Thomas Much }
  10.   { wer sich eingehender mit den FastLoad-Flags beschäftigen
  11.     möchte, sollte sich einmal das ST-STE-TT-Profibuch ansehen! }
  12.  
  13. uses
  14.  
  15.     OTypes,OProcs,OWindows,ODialogs;
  16.  
  17. const
  18.  
  19.     {$I makefast.i}  { Konstanten für die Dialogbox }
  20.  
  21.     MVER         = '1.4';
  22.     MDATE        = '26.03.1994';
  23.  
  24.     PH_FASTLOAD  = 1;       { die Fastload-Flags... }
  25.     PH_LOADALT   = 2;
  26.     PH_MALLOCALT = 4;
  27.  
  28. type
  29.  
  30.     PH = record
  31.         ph_branch  : word;     { Programmheader }
  32.         ph_tlen,
  33.         ph_dlen,
  34.         ph_blen,
  35.         ph_slen,
  36.         ph_res1,
  37.         ph_prgflags: longint;
  38.         ph_absflag : word
  39.     end;
  40.  
  41.     TMFApplication = object(TApplication)
  42.         { der neue Anwendungs-Objekt-TYP }
  43.         procedure InitInstance; virtual;
  44.         procedure InitMainWindow; virtual;
  45.     end;
  46.  
  47.     PMFDialog  = ^TMFDialog;
  48.     TMFDialog = object(TDialog)
  49.         { der eigentliche Dialog }
  50.         ttmem          : integer;
  51.         datei,pfad     : string;
  52.         st1,st2,st3    : PStatic;
  53.         cb1,cb2,cb3    : PCheckBox;
  54.         pb1,pb2,pb3,pb4,
  55.         pb5,pb6,pb7,pb8: PButton;
  56.         phrec          : PH;
  57.         f              : file of PH;
  58.         procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  59.         function GetIconTitle: string; virtual;
  60.         procedure SetupWindow; virtual;
  61.         function ExitDlg(AnIndx: integer): boolean; virtual;
  62.         function OK: boolean; virtual;
  63.         function Help: boolean; virtual;
  64.         { neue Routinen... }
  65.         procedure UpdateAmount; virtual;
  66.         procedure DisableAll; virtual;
  67.         procedure Load; virtual;
  68.     end;
  69.  
  70. var
  71.  
  72.     MFApplication: TMFApplication;
  73.                                        { das Anwendungs-Objekt;
  74.                                          dies sollte das EINZIGE statische Objekt
  75.                                          sein, alle anderen werden normalerweise
  76.                                          dynamisch verwaltet! }
  77.  
  78.  
  79. procedure MFResource; external; {$L mfrsc.o}
  80.     { die Resource wird ins Programm eingebunden (wichtig für ACCs) }
  81.  
  82.  
  83. procedure TMFApplication.InitInstance;
  84.  
  85.     begin
  86.         { wird eine Anwendung das erste Mal in den Speicher geladen,
  87.           wird die Methode InitApplication aufgerufen, die u.a. die
  88.           boolean-Variable FirstInstance setzt; danach wird InitInstance
  89.           aufgerufen;
  90.           wird die Anwendung ein zweites Mal geladen (z.B. zuerst als ACC
  91.           und dann als Prg), wird NUR diese Methode InitInstance von
  92.           dem Konstruktor Init aufgerufen! }
  93.         InitResource(@MFResource,nil);
  94.         { die im Prg eingebundene Resource wird initialisiert;
  95.           soll das RSC-File nachgeladen werden, wird statt InitResource()
  96.           einfach LoadResource(datei) aufgerufen }
  97.         TApplication.InitInstance
  98.         { Standard-Initialisierungen, setzt Schnittstellenobjekt für
  99.           <Control>+<Q>-Tastenkombination und ruft InitMainWindow auf }
  100.     end;
  101.  
  102.  
  103. procedure TMFApplication.InitMainWindow;
  104.     var p: PMFDialog;
  105.  
  106.     begin
  107.         { InitMainWindow legt ein "ganz einfaches" GEM-Fenster an und wird
  108.           deshalb eigentlich immer überschrieben, um ein abgeleitetes Fenster-
  109.           objekt zu installieren;
  110.           dieser Aufruf ist insofern besonders, als daß wir kein FENSTER,
  111.           sondern einen DIALOG als "MainWindow" anmelden; dieser wird zwar
  112.           normalerweise in einem Fenster dargestellt, sollte allerdings kein
  113.           Fenster-Handle mehr verfügbar sein, macht ObjectGEM daraus auto-
  114.           matisch (zur Laufzeit) einen MODALEN Dialog! }
  115.         p:=new(PMFDialog,Init(nil,'ObjectGEM MakeFast',MFDLG));
  116.         { der Dialog trägt sich selbständig in die Fensterliste ein;
  117.           MainWindow zeigt immer auf das erste installierte TWindow-Objekt
  118.           (in diesem Fall auf einen Nachfahren);
  119.           dem Konstruktor wird das Parent-Objekt (in diesem Fall nil, es
  120.           existiert also kein Parent), der Fenstertitel und der Index des
  121.           Dialogbaums übergeben }
  122.         if (MainWindow=nil) or (ChkError<em_OK) then Status:=em_InvalidMainWindow
  123.             { irgendwas ist schiefgelaufen => nicht initialisieren;
  124.               ObjectGEM prüft dann, wie und ob (ACCs!) das Programm
  125.               verlassen wird }
  126.         else
  127.             begin
  128.                 { p zeigt auf den Dialog; nun werden die Schnittstellen-
  129.                   objekte initialisiert; diese tragen sich in die Liste
  130.                   der TControl-Objekte im Dialog-Objekt ein und werden
  131.                   dadurch beim freigeben des Dialogs automatisch mitge-
  132.                   löscht }
  133.                 { die Rückgabe-Pointer werden gespeichert, um später die
  134.                   Objekte mit ihren eigenen Methoden zu modifizieren! }
  135.                 p^.st1:=new(PStatic,Init(p,MFMINDT,0,false,'Gibt an, wieviel TT-RAM (Alternate|RAM) dem Programm genügt, wenn mehr|ST-RAM als TT-RAM vorhanden ist.'));
  136.                 p^.st2:=new(PStatic,Init(p,MFAMOUNT,8,false,'Gibt an, wieviel TT-RAM (Alternate|RAM) dem Programm genügt, wenn mehr|ST-RAM als TT-RAM vorhanden ist.'));
  137.                 p^.st2^.Style:=p^.st2^.Style and not(sts_Fill);
  138.                 { einfacher Text, übergeben wird u.a. die max. Länge des Textes+1
  139.                   (Nullbyte), einen boolean-Wert, der angibt, ob der Text unter-
  140.                   strichen wird, und der String für BubbleHelp (!);
  141.                   bringen Sie den Mauscursor doch mal über einen Button und
  142.                   drücken Sie dann <Help> ...!?!!! }
  143.                 { p^.st3:=new(PStatic,Init(p,MFVER,39,false,'ObjectGEM MakeFast ist Freeware,|d.h. Sie dürfen das Programm|kostenlos kopieren und benutzen.|Änderungen am Programm sind|nicht erlaubt!')); ... }
  144.                 p^.st3:=new(PStatic,Init(p,MFVER,39,false,'ObjectGEM MakeFast ist Freeware, d.h. Sie dürfen das Programm kostenlos kopieren und benutzen. Änderungen am Programm sind nicht erlaubt!'));
  145.                 p^.cb1:=new(PCheckBox,Init(p,MFFAST,true,'Bestimmt das FastLoad-Flag.|Ist es gesetzt, wird beim Programm-|start nur die BSS gelöscht. Das|Flag sollte bei mindestens je einem|Auto-Ordner-Programm und Accessory|NICHT gesetzt sein!'));
  146.                 { ankreuzbare Box; der boolean-Wert gibt an, ob die CheckBox
  147.                   im "neuen" Stil gezeichnet wird; ist in der Resource das
  148.                   CROSSED-Attribut gesetzt, wird statt des Häkchens ein
  149.                   Kreuzchen verwendet }
  150.                 p^.cb2:=new(PCheckBox,Init(p,MFPROG,true,'Das Programm darf in das (schnelle)|TT-RAM geladen werden. Vorsicht, wenn|das Programm z.B. den Bildschirm-|speicher verschiebt!'));
  151.                 p^.cb3:=new(PCheckBox,Init(p,MFMEM,true,'Malloc()-Anforderungen des Programms|dürfen aus dem TT-RAM bedient werden.|Vorsicht bei Programmen, die z.B. den|Bildschirmspeicher verschieben!'));
  152.                 p^.pb1:=new(PButton,Init(p,MFDATEI,id_No,true,'Wählt ein neues Programm|zum Bearbeiten aus.'));
  153.                 { ein PushButton }
  154.                 p^.pb2:=new(PButton,Init(p,MFMAKE,id_No,true,'Schreibt die neuen Werte in|das ausgewählte Programm.'));
  155.                 p^.pb3:=new(PButton,Init(p,MFOK,id_OK,true,'Verläßt MakeFast.'));
  156.                 { id_OK bedeutet, daß dies der OK-Button ist;
  157.                   beim Anklicken wird dadurch die TDialog.OK-Methode aufgerufen }
  158.                 p^.pb4:=new(PButton,Init(p,MFLESS,id_No,false,'Vermindert den TT-RAM-Bedarf|um 128 KB.'));
  159.                 p^.pb5:=new(PButton,Init(p,MFMORE,id_No,false,'Erhöht den TT-RAM-Bedarf|um 128 KB.'));
  160.                 p^.pb6:=new(PButton,Init(p,MFHELP,id_Help,false,'Zeigt einen allg. Hilfstext an.'));
  161.                 p^.pb7:=new(PButton,Init(p,MFNAME,id_No,false,'Zeigt den Namen des Programms an.|Durch Anklicken erhält man den|vollen Namen incl. Pfad.'));
  162.                 p^.pb8:=new(PButton,Init(p,MFMINT,id_NoExit,true,'Ändert unter MiNT/MultiTOS|die Memory-Protection-Flags.|Z.Z. noch ohne Wirkung.'));
  163.                 if not(Application^.MiNTActive) then p^.pb8^.Disable;
  164.                 p^.st3^.SetText('VERSION '+MVER+' VOM '+MDATE+' (FREEWARE!)');
  165.                 { Text setzen (TStatic-Methode) }
  166.                 p^.UpdateAmount;
  167.                 p^.DisableAll;
  168.                 if AppFlag then p^.MakeWindow
  169.                 { wenn wir kein ACC sind, wird das Fenster sofort
  170.                   geöffnet, sonst wartet ObjectGEM auf das Eintreffen
  171.                   einer AC_OPEN-Message }
  172.             end
  173.     end;
  174.  
  175.  
  176. procedure TMFDialog.GetWindowClass(var AWndClass: TWndClass);
  177.  
  178.     begin
  179.         TDialog.GetWindowClass(AWndClass);
  180.         { initialisiert die Dialog-Klasse;
  181.           wenn Sie dies vergessen, werden Sie die seltsamsten
  182.           Systemabstürze erleben (vertrauen Sie mir, ich weiß,
  183.           was ich erlebt habe...);
  184.           bei OOP kommt es oft vor, daß Vorfahren aufgerufen
  185.           werden; wann dies geschehen kann, muß oder unterbleiben
  186.           sollte, wird in der ObjectGEM-Dokumentation (bzw. in der
  187.           Online-Help) beschrieben sein }
  188.         AWndClass.Style:=AWndClass.Style or cs_CreateOnAccOpen
  189.         { da wir einen Dialog als "Hauptfenster" verwenden, müssen
  190.           wir ObjectGEM sagen, daß dieser Dialog bei einer AC_OPEN-
  191.           Message (also bei Anwahl des Accessory-Menüeintrags) ge-
  192.           öffnet werden soll; normalerweise werden in diesem Fall nur
  193.           Fenster geöffnet, da es recht störend ist, wenn alle irgend-
  194.           wann verwendeten Dialoge automatisch geöffnet werden;
  195.           andererseits können Sie natürlich auch Fenster vom auto-
  196.           matischen Öffnen ausnehmen, indem Sie das Flag in der Fenster-
  197.           Klasse löschen }
  198.     end;
  199.  
  200.  
  201. function TMFDialog.GetIconTitle: string;
  202.  
  203.     begin
  204.         GetIconTitle:='MAKEFAST'
  205.     end;
  206.  
  207.  
  208. procedure TMFDialog.SetupWindow;
  209.  
  210.     begin
  211.         { diese Methode wird vom Init-Konstruktor des Dialogs aufgerufen }
  212.         TDialog.SetupWindow;
  213.         { initialisiert Schnittstellenobjekte für <Control>+<F>,
  214.           <Control>+<U> und <Control>+<W> }
  215.         ttmem:=0;
  216.         { TT-RAM-Bedarf = minimal }
  217.         datei:='';
  218.         pfad:=''
  219.         { zu Anfang ist keine Datei geladen }
  220.     end;
  221.  
  222.  
  223. function TMFDialog.ExitDlg(AnIndx: integer): boolean;
  224.  
  225.     begin
  226.         { beim Anklicken eines PushButtons wird die EndDlg-Methode
  227.           aufgerufen; diese versucht, den Button einem Schnittstellen-
  228.           objekt zuzuordnen (z.B. wird beim OK-Button [id_OK] auto-
  229.           matisch die OK-Methode [s.u.] aufgerufen);
  230.           konnte kein solches Schnittstellenobjekt gefunden werden,
  231.           wird diese ExitDlg-Methode aufgerufen;
  232.           liefert sie true zurück, wird der Dialog daraufhin verlassen }
  233.         case AnIndx of
  234.             MFNAME: Application^.Alert(@self,1,NO_ICON,'Datei:|"'+pfad+datei+'"','  &OK  ');
  235.             MFLESS: if ttmem>0 then
  236.                                 begin
  237.                                     dec(ttmem);
  238.                                     { TT-RAM-Bedarf um 128 KB verringern... }
  239.                                     UpdateAmount
  240.                                     { ... und Bedarf anzeigen }
  241.                                 end;
  242.             MFMORE: if ttmem<15 then
  243.                                 begin
  244.                                     inc(ttmem);
  245.                                     { TT-RAM-Bedarf erhöhen }
  246.                                     UpdateAmount
  247.                                 end;
  248.             MFDATEI: { neue Datei auswählen, laden und anzeigen... }
  249.                              if FileSelect(@self,'PRG,ACC,TOS ETC. AUSWÄHLEN','',pfad,datei,true) then Load;
  250.             MFMAKE: begin
  251.                                 with phrec do
  252.                                     begin
  253.                                         ph_prgflags:=ph_prgflags and $0ffffff8;
  254.                                         { FastLoad-Flags zunächst ausmaskieren (löschen)... }
  255.                                         if cb1^.GetCheck=bf_Checked then
  256.                                             ph_prgflags:=ph_prgflags or PH_FASTLOAD;
  257.                                         if cb2^.GetCheck=bf_Checked then
  258.                                             ph_prgflags:=ph_prgflags or PH_LOADALT;
  259.                                         if cb3^.GetCheck=bf_Checked then
  260.                                             ph_prgflags:=ph_prgflags or PH_MALLOCALT;
  261.                                         PByte(@ph_prgflags)^:=PByte(@ph_prgflags)^ or (ttmem shl 4)
  262.                                         { ... und dann evtl. wieder setzen }
  263.                                     end;
  264.                                 reset(f);
  265.                                 write(f,phrec);
  266.                                 close(f);
  267.                                 { Datei aktualisieren }
  268.                                 DisableAll
  269.                                 { nun ist keine Datei mehr aktiv }
  270.                             end
  271.         end;
  272.         ExitDlg:=false
  273.         { Dialog NICHT verlassen }
  274.     end;
  275.  
  276.  
  277. function TMFDialog.OK: boolean;
  278.  
  279.     begin
  280.         Application^.Quit;
  281.         { Anwendung beenden (sobald der aktuelle Message-Loop
  282.           beendet ist)... }
  283.         OK:=true
  284.         { ... und vorher den Dialog verlassen }
  285.     end;
  286.  
  287.  
  288. function TMFDialog.Help: boolean;
  289.  
  290.     begin
  291.         Application^.Alert(@self,1,NOTE,'Bringen Sie den Mauscursor über das gewünschte Dialogelement und drücken Sie die <Help>-Taste (oder die rechte Maustaste...).','  &OK  ');
  292.         { dies ist die neue ObjectGEM-Alert-Routine! }
  293.         Help:=false
  294.         { Dialogbox nicht verlassen }
  295.     end;
  296.  
  297.  
  298. procedure TMFDialog.UpdateAmount;
  299.     const atxt : array [0..15] of string[7] =
  300.                             ('128 KB','256 KB','384 KB','512 KB','640 KB','768 KB',
  301.                              '896 KB','1 MB','1152 KB','1280 KB','1408 KB','1536 KB',
  302.                              '1664 KB','1792 KB','1920 KB','2 MB');
  303.  
  304.     begin
  305.         st2^.SetText(atxt[ttmem])
  306.         { TT-RAM-Bedarf anzeigen;
  307.           die TStatic-Methode SetText ruft automatisch die
  308.           von TControl geerbte Paint-Methode auf, die das Dialog-
  309.           element neu zeichnet, wenn der Dialog sichtbar ist }
  310.     end;
  311.  
  312.  
  313. procedure TMFDialog.DisableAll;
  314.  
  315.     begin
  316.         pb7^.SetText('');
  317.         pb7^.Disable;
  318.         { ... Dateinamen löschen }
  319.         st1^.Disable;
  320.         st2^.Disable;
  321.         cb1^.Disable;
  322.         cb2^.Disable;
  323.         cb3^.Disable;
  324.         pb2^.Disable;
  325.         pb4^.Disable;
  326.         pb5^.Disable
  327.         { ... und alle Buttons etc. nicht anwählbar machen }
  328.     end;
  329.  
  330.  
  331. procedure TMFDialog.Load;
  332.     var cmp: string[4];
  333.  
  334.     begin
  335.         { nur bearbeiten, wenn die Datei existiert! }
  336.         cmp:=StrPRight(datei,4);
  337.         { falscher Dateityp? }
  338.         if (cmp<>'.PRG') and (cmp<>'.APP') and (cmp<>'.TOS') and (cmp<>'.TTP') and (cmp<>'.ACC') and (cmp<>'.GTP') then
  339.             if Application^.Alert(@self,WAIT,2,' Sind Sie sicher, daß| "'+pfad+datei+'"| ein ausführbares Programm ist?','&Ja| &Nein ')<>1 then exit;
  340.         pb7^.Enable;
  341.         pb7^.SetText('Date&i: '+datei);
  342.         { Datei öffnen und aktuelle Werte auslesen... }
  343.         assign(f,pfad+datei);
  344.         reset(f);
  345.         read(f,phrec);
  346.         close(f);
  347.         ttmem:=PByte(@phrec.ph_prgflags)^ shr 4;
  348.         st1^.Enable;
  349.         st2^.Enable;
  350.         { Texte aktivieren... }
  351.         UpdateAmount;
  352.         { ... und neue Werte anzeigen }
  353.         cb1^.Enable;
  354.         if bTst(phrec.ph_prgflags,PH_FASTLOAD) then cb1^.Check
  355.         else
  356.             cb1^.Uncheck;
  357.         { es gibt zwar auch eine SetCheck-Methode, aber so
  358.           ist es doch recht übersichtlich! }
  359.         cb2^.Enable;
  360.         if bTst(phrec.ph_prgflags,PH_LOADALT) then cb2^.Check
  361.         else
  362.             cb2^.Uncheck;
  363.         cb3^.Enable;
  364.         if bTst(phrec.ph_prgflags,PH_MALLOCALT) then cb3^.Check
  365.         else
  366.             cb3^.Uncheck;
  367.         pb2^.Enable;
  368.         pb4^.Enable;
  369.         pb5^.Enable
  370.     end;
  371.  
  372.  
  373. begin
  374.   MFApplication.Init('MFST','MakeFast');
  375.   { Anwendung initialisieren;
  376.     übergeben wird eine Programm-Kennung und ein String, der bei
  377.     einem ACC als Menüeintrag verwendet wird }
  378.   MFApplication.Run;
  379.   { Programm ausführen... }
  380.   MFApplication.Done
  381.   { ... und korrekt verlassen! }
  382. end.