home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / pstoolbx / kaldemo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-07-28  |  4.1 KB  |  150 lines
  1. PROGRAM KalDemo;
  2. {$X+}
  3. USES App, Objects, Views, Drivers, Menus, KalDef, KalList, KalComs, KalWin,
  4.      Memory, MsgBox, Dialogs;
  5.  
  6. TYPE
  7.  
  8.   KalDemoApp = OBJECT(TApplication)
  9.     PROCEDURE InitMenuBar; VIRTUAL;
  10.     PROCEDURE HandleEvent(VAR Event: TEvent); VIRTUAL;
  11.     FUNCTION GetPalette: PPalette; VIRTUAL;
  12.     PROCEDURE Idle; VIRTUAL;
  13.     PROCEDURE OutOfMemory; VIRTUAL;
  14.   END;
  15.  
  16. CONST CNewColor = CColor     +CStdKalColor+CKalInfoColor+CCalcKalColor;
  17.       CNewBW    = CBlackWhite+CStdKalBW   +CKalInfoBW   +CCalcKalBW;
  18.       CNewMono  = CMonoChrome+CStdKalMono +CKalInfoMono +CCalcKalMono;
  19.   PApp: ARRAY[apColor..apMonochrome] OF STRING[Length(CNewColor)] =
  20.      (CNewColor,CNewBW,CNewMono);
  21. { 64 - 76: StdKalWin }
  22. { 77 - 85: KalInfoWin}
  23. { 86 - 94: CalcKalWin}
  24.  
  25. PROCEDURE KalDemoApp.InitMenuBar;
  26. VAR R: TRect;
  27. BEGIN
  28.   GetExtent(R);
  29.   R.B.Y := Succ(R.A.Y);
  30.   MenuBar := New(PMenuBar,INIT(R, NewMenu(
  31.     NewSubMenu('~'#240'~', hcNoContext, NewMenu(
  32.       NewItem('Ü~b~er KalDemo', '', kbNoKey, DcmUeber, hcNoContext,
  33.     NIL)),
  34.     NewSubMenu('~K~alender', hcNoContext, NewMenu(
  35.       NewItem('~L~aden', '', kbNoKey, DcmLadeKalender, hcNoContext,
  36.       NewItem('~E~ntfernen', '', kbNoKey, DcmEntferneKalender, hcNoContext,
  37.       NewLine(
  38.       NewItem('~A~nzeigen', '', kbNoKey, DcmZeigeKalender, hcNoContext,
  39.       NewItem('~I~nformationen','',kbNoKey, DcmKalInfo, hcNoContext,
  40.       NewItem('~B~erechnungen','', kbNoKey, DcmCalcKal, hcNoContext,
  41.       NewLine(
  42.       NewItem('~N~eues Datum','', kbNoKey, DcmEditKalDate, hcNoContext,
  43.     NIL))))))))),
  44.     NewSubMenu('~O~berfläche', hcNoContext, NewMenu(
  45.       NewItem('~S~peichern','', kbNoKey, DcmSaveDeskTop, hcNoContext,
  46.       NewItem('~L~aden','', kbNoKey, DcmRetrieveDeskTop, hcNoContext,
  47.     NIL))),
  48.   NIL))))))
  49. END;
  50.  
  51. PROCEDURE KalDemoApp.HandleEvent(VAR Event: TEvent);
  52.  
  53.   PROCEDURE SaveDeskTop;
  54.   VAR s: TDosStream;
  55.  
  56.     PROCEDURE WriteView(P: PView); FAR;
  57.     BEGIN
  58.       IF p <> DeskTop^.Last THEN s.Put(p)
  59.     END;
  60.  
  61.   BEGIN
  62.     s.INIT('KALDEMO.DSK',stCreate);
  63.     IF s.ErrorInfo <> stOk THEN EXIT;
  64.     KalenderListe^.Store(s);
  65.     DeskTop^.ForEach(@WriteView);
  66.     S.put(NIL);
  67.     s.DONE
  68.   END;
  69.  
  70.   PROCEDURE RetrieveDeskTop;
  71.   VAR s: TDosStream;
  72.       P: PView;
  73.  
  74.     PROCEDURE CloseView(P: PView); FAR;
  75.     BEGIN
  76.       Message(P, evCommand, cmClose, NIL)
  77.     END;
  78.  
  79.   BEGIN
  80.     s.INIT('KALDEMO.DSK',stOpenRead);
  81.     IF s.ErrorInfo <> stOk THEN EXIT;
  82.     IF KalenderListe <> NIL THEN Dispose(KalenderListe,DONE);
  83.     KalenderListe := New(PKList,Load(S));
  84.     IF DeskTop^.Valid(cmClose) THEN BEGIN
  85.       DeskTop^.ForEach(@CloseView);
  86.       REPEAT
  87.         p := PView(S.Get);
  88.         DeskTop^.insertBefore(ValidView(p), DeskTop^.Last)
  89.       UNTIL p = NIL
  90.     END;
  91.     s.DONE;
  92.   END;
  93.  
  94. BEGIN { KalDemoApp.HandleEvent }
  95.   TApplication.HandleEvent(Event);
  96.   IF Event.What = evCommand THEN BEGIN
  97.     CASE Event.Command OF
  98.       DcmLadeKalender: LadeKalender;
  99.       DcmEntferneKalender: EntferneKalender;
  100.       DcmZeigeKalender: ZeigeKalender;
  101.       DcmKalInfo: KalInfo;
  102.       DcmCalcKal: CalcKal;
  103.       DcmSaveDeskTop: SaveDeskTop;
  104.       DcmRetrieveDeskTop: RetrieveDeskTop;
  105.     ELSE EXIT
  106.     END;
  107.     ClearEvent(Event)
  108.   END
  109. END;
  110.  
  111. FUNCTION KalDemoApp.GetPalette: PPalette;
  112. BEGIN
  113.   GetPalette := @PApp[AppPalette]
  114. END;
  115.  
  116. PROCEDURE KalDemoApp.Idle;
  117. BEGIN
  118.   TApplication.Idle;
  119.   IF (DeskTop^.Current <> NIL) AND (TypeOf(DeskTop^.Current^) = TypeOf(StdKalWin))
  120.     THEN EnableCommands(KalWinCommands) ELSE
  121.          DisAbleCommands(KalWinCommands)
  122. END;
  123.  
  124. PROCEDURE KalDemoApp.OutOfMemory;
  125. BEGIN
  126.   MessageBox(^c'Der Hauptspeicher reicht für diese Operation nicht aus!',NIL,mfError+mfOkButton)
  127. END;
  128.  
  129. PROCEDURE RegisterAllTypes;
  130. BEGIN
  131.   RegisterType(RKalList);
  132.   RegisterKalWinTypes;
  133.   RegisterType(RScrollBar);
  134.   RegisterType(RScroller);
  135.   RegisterType(RStaticText);
  136.   RegisterType(RFrame);
  137.   RegisterType(RButton)
  138. END;
  139.  
  140. VAR DemoApp: KalDemoApp;
  141. BEGIN
  142.   DemoApp.INIT;
  143.   KalenderListe := New(PKList,INIT);
  144.   IF LowMemory THEN DemoApp.OutOfMemory ELSE BEGIN
  145.     RegisterAllTypes;
  146.     DemoApp.Run
  147.   END;
  148.   DemoApp.DONE
  149. END.
  150.