home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tvision / gravis / gv / demorez.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-05-23  |  26.1 KB  |  727 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Graphics Vision Demo program                    }
  5. {                                                       }
  6. {       Copyright (c) 1993 Stefan Milius                }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. Program DemoRez;
  11.  
  12. { Diese Program generiert die Resourcendatei für DEMO.PAS.
  13.  
  14.   This program creates the resource file for DEMO.PAS.
  15.   If you wish to create the English version you will have to
  16.   set the conditional define "english". Just remove the comment
  17.   parentheses in the next line and build this program.
  18. }
  19.  
  20. (* {$DEFINE english} *)
  21.  
  22. Uses Dos, Objects, Drivers, ExtGraph, GVDriver, Views, GVViews, GVDialog,
  23.      GVMenus, GVApp, GVStdDlg, GVColor, Graph, Gr, BGI, MetaGr, DemoType,
  24.      Memory, MyMouse, MyFonts, VGAMem, HistList;
  25.  
  26. Var
  27.  
  28. { Dialog variables }
  29.  
  30.   Dialog: PDialog;
  31.   P: PGView;
  32.   R: TRect;
  33.  
  34. (*************************** Resource procedures ****************************)
  35.  
  36. procedure CreateStatusHints;
  37. var HintList: PStrListMaker;
  38. Begin
  39.   HintList:=New (PStrListMaker,Init ($4000,50));
  40.   With HintList^ do Begin
  41.     {$IFDEF english}
  42.     { Menus }
  43.     Put (hcFile, 'Basic file operations (open change directory etc.)');
  44.     Put (hcOpen, 'Opens a file in a text window');
  45.     Put (hcChangeDir, 'Changes the current directory');
  46.     Put (hcInfo, 'Shows version number and copyright information');
  47.     Put (hcColor, 'Changes the application''s colors');
  48.     Put (hcExit, 'Exit this programm');
  49.     Put (hcWindow, 'Commands of the window manager');
  50.     Put (hcGWindow, 'Opens a graphic window');
  51.     Put (hcDialog, 'Opens the demo dialog window');
  52.     Put (hcResize, 'Changes size and/or position of the current window');
  53.     Put (hcZoom, 'Zooms the current window');
  54.     Put (hcTile, 'Arranges all windows by tiling on the desktop');
  55.     Put (hcCascade, 'Arranges all windows by cascading on the desktop');
  56.     Put (hcNext, 'Selects next window');
  57.     Put (hcPrev, 'Selects previous window');
  58.     Put (hcClose, 'Closes the current window');
  59.     Put (hcMusic, 'Commands for sound effects');
  60.     Put (hcEnableMusic, 'Enables or Disables the sound effects');
  61.     Put (hcNormalTune, 'Chooses the standard tune to be current sound effect');
  62.     Put (hcIndyTune, 'Where''s my Indy-Wear(TM)-Hat ???????!');
  63.     Put (hcPlay, 'New in GV - Bitmaps as menu options; Plays the sound effect');
  64.  
  65.     { Dialogs }
  66.     Put (hcOk, 'Accepts the current settings');
  67.     Put (hcCancel, 'Closes the dialog box without making changes');
  68.     Put (hcYes, 'Answers given question with "yes"');
  69.     Put (hcNo, 'Answers given question with "no"');
  70.     Put (hcFOpenInput, 'Please enter directory and file name');
  71.     Put (hcFOpenList, 'Small characters for files / big characters for directories');
  72.     Put (hcFOpenOpBut,'Opens the chosen file');
  73.     Put (hcFChDirInput, 'Please enter drive and/or directory');
  74.     Put (hcFChDirList, 'Use the cursor keys to move');
  75.     Put (hcFChDirChDirBut, 'Changes into the chosen directory');
  76.     Put (hcFChDirRevBut, 'Returns to original directory');
  77.     Put (hcColorGroupList, 'Please choose a group');
  78.     Put (hcColorItemList, 'Please choose the palette entry you want to change');
  79.     Put (hcSelector, 'Please choose a color');
  80.     Put (hcWDlgR1, 'Each item of a radiobutton can have another hint');
  81.     Put (hcWDlgR2, 'Choose 2');
  82.     Put (hcWDlgR3, 'No. 3 for president');
  83.     Put (hcWDlgR4, 'All good things are 4');
  84.     Put (hcWDlgR5, 'Winner of the test');
  85.     Put (hcWDlgR6, 'Last one');
  86.     Put (hcWDlgGButton, 'Only in GV: a graphical button');
  87.     Put (hcWDlgInput, 'An inputline that is connected with a TLabel object');
  88.     Put (hcWDlgTextButton, 'A standard text button (sends a command if you push it)');
  89.     Put (hcWDlgC1, 'Only for POWER USERS');
  90.     Put (hcWDlgC2, 'Cat, dog and other periphery');
  91.     Put (hcWDlgC3, 'Small, quadrangular and always with defect sectors');
  92.     Put (hcWDlgC4, 'Formatted especially pleasant -> scraaaaaaaatch');
  93.     Put (hcWDlgC5, 'Only way out when developing graphical environments');
  94.     Put (hcWDlgC6, 'Please only mark if being in serious danger');
  95.     Put (hcWDlgRegler, 'Only in GV: a controller to change real number');
  96.     Put (hcWDlgList, 'A listbox (connected with scrollbar and icon)');
  97.     Put (hcWDlgNumInput, 'An inputline for integer numbers');
  98.     Put (hcWDlgMC1, 'New in GV: Multicheckboxes');
  99.     Put (hcWDlgMC2, 'Multivitamine nectar');
  100.     Put (hcWDlgMC3, 'Coming soon: Multi - Tasking');
  101.     Put (hcWDlgMC4, 'Multi silly; Multi - Plication');
  102.     {$ELSE}
  103.     { Menus }
  104.     Put (hcFile, 'Dateioperationen (Öffnen Verzeichnis wechseln etc.)');
  105.     Put (hcOpen, 'Öffnen einer Datei in einem Textfenster');
  106.     Put (hcChangeDir, 'Ändern des aktuellen Verzeichnises');
  107.     Put (hcInfo, 'Zeigt Versionsnummer und Copyright Information an');
  108.     Put (hcColor, 'Verändern der Farben der Oberfläche');
  109.     Put (hcExit, 'Beendet dieses Programm');
  110.     Put (hcWindow, 'Kommandos der Fensterverwaltung');
  111.     Put (hcGWindow, 'Öffnen eines grafischen Fensters');
  112.     Put (hcDialog, 'Öffnen eines Demo-Dialog-Fensters');
  113.     Put (hcResize, 'Ändern von Größe bzw. Position des aktuellen Fensters');
  114.     Put (hcZoom, 'Vergrößern bzw. Verkleinern dews aktuellen Fensters');
  115.     Put (hcTile, 'Kachelförmige Anordnung der Fenter');
  116.     Put (hcCascade, 'Kaskadenförmige Anordnung der Fenster');
  117.     Put (hcNext, 'Aktivieren des nächsten Fensters');
  118.     Put (hcPrev, 'Aktivieren des vorherigen Fensters');
  119.     Put (hcClose, 'Schließen des aktiven Fensters');
  120.     Put (hcMusic, 'Kommandos für Soundeffekte');
  121.     Put (hcEnableMusic, 'Schaltet die Soundeffekte an bzw. aus');
  122.     Put (hcNormalTune, 'Wählt den Standard-Soundeffekt aus');
  123.     Put (hcIndyTune, 'Wo ist mein Indy-Wear(TM)-Hut ?????!');
  124.     Put (hcPlay, 'Neu in GV - Bitmaps als Menüoptionen; Spielt die Melodie');
  125.  
  126.     { Dialogs }
  127.     Put (hcOk, 'Akzeptiert die aktuelle Einstellungen');
  128.     Put (hcCancel, 'Schließt die Dialogbox ohne Änderungen');
  129.     Put (hcYes, 'Beantwortet die gestellte Frage mit "ja"');
  130.     Put (hcNo, 'Beantwortet die gestellte Frage mit "nein"');
  131.     Put (hcFOpenInput, 'Geben Sie Verzeichnis- und Dateiname an');
  132.     Put (hcFOpenList, 'kleine Buchstaben-Dateien / große-Verzeichnisse');
  133.     Put (hcFOpenOpBut,'Öffnet die ausgewählte Datei');
  134.     Put (hcFChDirInput, 'Geben Sie Laufwerk und/oder Verzeichnis an');
  135.     Put (hcFChDirList, 'Benutzen Sie die Cursortasten zum bewegen');
  136.     Put (hcFChDirChDirBut, 'Wechselt in das gewählte Verzeichnis');
  137.     Put (hcFChDirRevBut, 'Kehrt zum ursprünglichen Verzeichnis zurück');
  138.     Put (hcColorGroupList, 'Wählen Sie eine Gruppe aus');
  139.     Put (hcColorItemList, 'Wählen Sie den zu ändernden Farbeintrag aus');
  140.     Put (hcSelector, 'Wählen Sie eine Farbe');
  141.     Put (hcWDlgR1, 'Jedes Item eines RadioButtons kann eine anderen Hinweis haben');
  142.     Put (hcWDlgR2, 'Wähle 2');
  143.     Put (hcWDlgR3, 'Nr. 3 for president');
  144.     Put (hcWDlgR4, 'Alle guten Dinge sind 4');
  145.     Put (hcWDlgR5, 'Testsieger');
  146.     Put (hcWDlgR6, 'Schlußlicht');
  147.     Put (hcWDlgGButton, 'Nur in GV: Ein grafischer Schalter');
  148.     Put (hcWDlgInput, 'Eine Eingabezeile, die mit einem Label verbunden ist');
  149.     Put (hcWDlgTextButton, 'Ein Textschalter (sendet bei Betätigung ein Kommando ab)');
  150.     Put (hcWDlgC1, 'Only for POWER USERS');
  151.     Put (hcWDlgC2, 'Katze, Hund und andere Peripherie');
  152.     Put (hcWDlgC3, 'Klein, viereckig und immer mit defekten Sektoren');
  153.     Put (hcWDlgC4, 'Formatiert besonders erfreulich -> Scraaaaaaaatch');
  154.     Put (hcWDlgC5, 'Einziger Ausweg beim entwickeln von grafischen Oberflächen');
  155.     Put (hcWDlgC6, 'Bitte nur im äußersten Notfall ankreuzen');
  156.     Put (hcWDlgRegler, 'Nur in GV: Ein Regler, mit dem eine reelle Zahl verändert wird');
  157.     Put (hcWDlgList, 'Ein Listenfeld (verbunden mit Rollbalken und Icon)');
  158.     Put (hcWDlgNumInput, 'Ein Eingabezeile für ganze Zahlen');
  159.     Put (hcWDlgMC1, 'Neu in GV: Mehrfachstatus-Markierungsfelder');
  160.     Put (hcWDlgMC2, 'Multivitamin Nektar');
  161.     Put (hcWDlgMC3, 'Multi - Tasking kommt bald');
  162.     Put (hcWDlgMC4, 'Multi blödsinnig; Multi - Plizieren');
  163.     {$ENDIF}
  164.   End;
  165.   RezFile.Put (HintList, 'StatusHints');
  166.   Dispose (HintList, Done);
  167. End;
  168.  
  169. procedure CreateMenuBar;
  170. var B: Pointer;
  171.  
  172.  function NewCheckItem(Name, Param: TMenuStr; KeyCode, Command, AHelpCtx: Word;
  173.                ADisabled: Byte; Next: PMenuItem): PMenuItem;
  174.  var Item: PMenuItem;
  175.  Begin
  176.    Item := NewItem(Name, Param, KeyCode, Command, AHelpCtx, Next);
  177.    Item^.Disabled := ADisabled;
  178.    NewCheckItem := Item;
  179.  End;
  180.  
  181.  function GetBitmap: Pointer;
  182.  var i: Integer;
  183.      B: Pointer;
  184.  Begin
  185.    SetFillStyle(SolidFill, White); Bar(0, 0, 70, 30);
  186.    SetColor(Black);
  187.    For i := 1 to 5 do HoriLine(0, i*5, 80);
  188.    SetFillStyle(SolidFill, 0); FillCircle(20, 20, 3);
  189.    VertLine(23, 20, 2);
  190.    Graph.SetColor(Black);
  191.    Arc(23, 8, 330, 90, 5);
  192.  
  193.    FillCircle(50, 10, 3);
  194.    VertLine(47, 10, 28);
  195.    Graph.SetColor(Black);
  196.    Arc(47, 22, 270, 30, 5);
  197.    GetMem(B, ImageSize(0, 0, 70, 30));
  198.    GetImage(0, 0, 70, 30, B^);
  199.    GetBitmap := B;
  200.  End;
  201.  
  202. Begin
  203.   B := GetBitmap;
  204.  
  205.   R.Assign (0,0,SizeX-71,21);
  206.   {$IFDEF english}
  207.   P:=New (PMenuBar, Init (R, NewMenu (
  208.     NewSubMenu ('~F~ile', hcFile, NewMenu (
  209.       NewItem ('~I~nfo...', 'F1', kbF1, cmInfo, hcInfo,
  210.       NewLine (
  211.       NewItem ('~O~pen...', 'F3', kbF3, cmOpen, hcOpen,
  212.       NewItem ('Change ~d~irectory...', 'F4', kbF4, cmChDir, hcChangeDir,
  213.       NewLine (
  214.       NewItem ('Change ~c~olors...', '', kbNoKey, cmColor, hcColor,
  215.       NewLine (
  216.       NewItem ('~E~xit', 'Alt+X', kbAltX, cmQuit, hcExit, nil))))))))),
  217.     NewSubMenu ('~W~indow', hcWindow, NewMenu (
  218.       NewItem ('~G~raphical window', 'F9', kbF9, cmGWindow, hcGWindow,
  219.       NewItem ('~D~emo dialog', 'Alt+F9', kbAltF9, cmDialog, hcDialog,
  220.       NewLine (
  221.       StdWindowMenuItems(nil))))),
  222.     NewSubMenu ('~M~usic', hcMusic, NewMenu (
  223.       NewCheckItem ('~M~usic on/off', 'Shift+F8', kbShiftF8, cmEnableMusic,
  224.             hcEnableMusic, dfMenuCheck + dfCheckState,
  225.       NewLine (
  226.       NewCheckItem ('~N~ormal tune', '', kbNoKey, cmNormalTune, hcNormalTune,
  227.             dfMenuCheck + dfRadio,
  228.       NewCheckItem ('~I~ndy''s tune', '', kbNoKey, cmIndyTune, hcIndyTune,
  229.             dfMenuCheck + dfRadio,
  230.       NewLine (
  231.       NewBitmap (B, kbF8, cmPlay, hcPlay, nil))))))),
  232.     nil))))));
  233.   {$ELSE}
  234.   P:=New (PMenuBar, Init (R, NewMenu (
  235.     NewSubMenu ('~D~atei', hcFile, NewMenu (
  236.       NewItem ('~I~nfo...', 'F1', kbF1, cmInfo, hcInfo,
  237.       NewLine (
  238.       NewItem ('Ö~f~fnen...', 'F3', kbF3, cmOpen, hcOpen,
  239.       NewItem ('~V~erzeichnis wechseln...', 'F4', kbF4, cmChDir, hcChangeDir,
  240.       NewLine (
  241.       NewItem ('Fa~r~ben verändern...', '', kbNoKey, cmColor, hcColor,
  242.       NewLine (
  243.       NewItem ('~E~nde', 'Alt+X', kbAltX, cmQuit, hcExit, nil))))))))),
  244.     NewSubMenu ('~F~enster', hcWindow, NewMenu (
  245.       NewItem ('~G~rafisches Fenster', 'F9', kbF9, cmGWindow, hcGWindow,
  246.       NewItem ('~D~emo Dialog', 'Alt+F9', kbAltF9, cmDialog, hcDialog,
  247.       NewLine (
  248.       StdWindowMenuItems(nil))))),
  249.     NewSubMenu ('~M~usik', hcMusic, NewMenu (
  250.       NewCheckItem ('~M~usik an/aus', 'Umschalt+F8', kbShiftF8, cmEnableMusic,
  251.             hcEnableMusic, dfMenuCheck + dfCheckState,
  252.       NewLine (
  253.       NewCheckItem ('~S~tandardmelodie', '', kbNoKey, cmNormalTune, hcNormalTune,
  254.             dfMenuCheck + dfRadio,
  255.       NewCheckItem ('~I~ndy''s Melodie', '', kbNoKey, cmIndyTune, hcIndyTune,
  256.             dfMenuCheck + dfRadio + dfCheckState,
  257.       NewLine (
  258.       NewBitmap (B, kbF8, cmPlay, hcPlay, nil))))))),
  259.     nil))))));
  260.   {$ENDIF}
  261.   FreeMem(B, ImageSize(0, 0, 70, 30));
  262.   RezFile.Put (P, 'MenuBar');
  263.   Dispose (P, Done);
  264. End;
  265.  
  266. procedure CreateDesktop;
  267. Begin
  268.   R.Assign (0, 21, SizeX, SizeY-21);
  269.   P:=New (PDesktop, Init (R));
  270.   RezFile.Put (P, 'Desktop');
  271.   Dispose (P, Done);
  272. End;
  273.  
  274. procedure CreateStatusLine;
  275. Begin
  276.   R.Assign (0,SizeY-21, SizeX-71, SizeY);
  277.   {$IFDEF english}
  278.   P:=New (PDemoStatusLine, Init (R,
  279.     NewStatusDef (0, 0,
  280.       NewStatusKey ('~F1~ Info', kbF1, cmInfo,
  281.       NewStatusKey ('~F3~ Open', kbF3, cmOpen,
  282.       NewStatusKey ('~F4~ Change directory', kbF4, cmChDir,
  283.       NewStatusKey ('~F10~ Menu', kbF10, cmMenu,
  284.       NewStatusKey ('~Alt+X~ Exit', kbAltX, cmQuit, nil))))),
  285.     NewStatusDef (1, 1,
  286.       NewStatusKey (#2'~'#27#26#25#24'~ Move',kbNoKey,cmError,
  287.       NewStatusKey (#2'~Shift-'#27#26#25#24'~ Size',kbNoKey,cmError,
  288.       NewStatusKey (#2'~'#17'─┘~ Accept',kbNoKey,cmError,
  289.       NewStatusKey (#2'~Esc~ Cancel',kbNoKey,cmError,nil)))),
  290.     NewStatusDef (2, 999,
  291.       NewStatusKey ('~Alt+F3~ Close', kbAltF3, cmClose, nil),
  292.     NewStatusDef (1000, 9999,
  293.       NewStatusKey ('~F1~ Info', kbF1, cmInfo,
  294.       NewStatusKey ('~F3~ Open', kbF3, cmOpen,
  295.       NewStatusKey ('~F4~ Change directory', kbF4, cmChDir,
  296.       NewStatusKey ('~F10~ Menu', kbF10, cmMenu,
  297.       NewStatusKey ('~Alt+F10~ Local menu', kbAltF10, cmLocalMenu, nil))))),
  298.     NewStatusDef (10000, $FFFF,
  299.       NewStatusKey ('~Alt+X~ Exit', kbAltX, cmQuit, nil),nil)))))));
  300.   {$ELSE}
  301.   P:=New (PDemoStatusLine, Init (R,
  302.     NewStatusDef (0, 0,
  303.       NewStatusKey ('~F1~ Info', kbF1, cmInfo,
  304.       NewStatusKey ('~F3~ Öffnen', kbF3, cmOpen,
  305.       NewStatusKey ('~F4~ Verzeichnis wechseln', kbF4, cmChDir,
  306.       NewStatusKey ('~F10~ Menü', kbF10, cmMenu,
  307.       NewStatusKey ('~Alt+X~ Beenden', kbAltX, cmQuit, nil))))),
  308.     NewStatusDef (1, 1,
  309.       NewStatusKey (#2'~'#27#26#25#24+'~ Verschieben',kbNoKey,cmError,
  310.       NewStatusKey (#2'~Umschalt-'#27#26#25#24'~ Größe',kbNoKey,cmError,
  311.       NewStatusKey (#2'~'#17'─┘~ Beenden',kbNoKey,cmError,
  312.       NewStatusKey (#2'~Esc~ Abbruch',kbNoKey,cmError,nil)))),
  313.     NewStatusDef (2, 999,
  314.       NewStatusKey ('~Alt+F3~ Schließen', kbAltF3, cmClose, nil),
  315.     NewStatusDef (1000, 9999,
  316.       NewStatusKey ('~F1~ Info', kbF1, cmInfo,
  317.       NewStatusKey ('~F3~ Öffnen', kbF3, cmOpen,
  318.       NewStatusKey ('~F4~ Verzeichnis wechseln', kbF4, cmChDir,
  319.       NewStatusKey ('~F10~ Menü', kbF10, cmMenu,
  320.       NewStatusKey ('~Alt+F10~ Lokales Menü', kbAltF10, cmLocalMenu, nil))))),
  321.     NewStatusDef (10000, $FFFF,
  322.       NewStatusKey ('~Alt+X~ Beenden', kbAltX, cmQuit, nil),nil)))))));
  323.   {$ENDIF}
  324.   RezFile.Put (P, 'StatusLine');
  325.   Dispose (P, Done);
  326. End;
  327.  
  328. procedure CreateLocalMenu;
  329. Begin
  330.   R.Assign(0, 0, 0, 0);
  331.   {$IFDEF english}
  332.   P := New(PMenuPopup, Init(R, NewMenu(
  333.     NewItem ('~I~nfo...', 'F1', kbF1, cmInfo, hcInfo,
  334.     NewLine (
  335.     NewItem ('~O~pen...', 'F3', kbF3, cmOpen, hcOpen,
  336.     NewItem ('Change ~d~irectory...', 'F4', kbF4, cmChDir, hcChangeDir,
  337.     NewLine (
  338.     NewItem ('~S~ize/Move', 'Ctrl+F5', kbCtrlF5, cmResize, hcResize,
  339.     NewItem ('~Z~oom', 'F5', kbF5, cmZoom, hcZoom,
  340.     NewItem ('~C~lose', 'Alt+F3', kbAltF3, cmClose, hcClose, nil)))))))))));
  341.   {$ELSE}
  342.   P := New(PMenuPopup, Init(R, NewMenu(
  343.     NewItem ('~I~nfo...', 'F1', kbF1, cmInfo, hcInfo,
  344.     NewLine (
  345.     NewItem ('Ö~f~fnen...', 'F3', kbF3, cmOpen, hcOpen,
  346.     NewItem ('~V~erzeichnis wechseln...', 'F4', kbF4, cmChDir, hcChangeDir,
  347.     NewLine (
  348.     NewItem ('~G~röße/Position', 'Strg+F5', kbCtrlF5, cmResize, hcResize,
  349.     NewItem ('~V~ergrößern', 'F5', kbF5, cmZoom, hcZoom,
  350.     NewItem ('~S~chließen', 'Alt+F3', kbAltF3, cmClose, hcClose, nil)))))))))));
  351.   {$ENDIF}
  352.   RezFile.Put (P, 'LocalMenu');
  353.   Dispose (P, Done);
  354. End;
  355.  
  356.  
  357.  
  358. procedure CreateFOpenDlg;
  359. const Help: Array [1..4] Of Word = (hcFOpenInput,hcFOpenList,hcFOpenOpBut,
  360.                     hcCancel);
  361. {$IFDEF english}
  362. const Title = 'Open a file';
  363. {$ELSE}
  364. const Title = 'Öffnen einer Datei';
  365. {$ENDIF}
  366. Begin
  367.   Dialog := New (PFileDialog, Init ('*.PAS',Title,'~N~ame',
  368.     fdOpenButton+fdHelpButton+fdNoLoadDir, 30));
  369.   SetHelpCtx (Dialog, Help);
  370.   RezFile.Put (Dialog,'FOpenDlg');
  371.   Dispose (Dialog,Done);
  372. End;
  373.  
  374. procedure CreateFChDirDlg;
  375. const Help: Array [1..5] Of Word = (hcOk,hcFChDirChDirBut,hcFChDirRevBut,
  376.                     hcFChDirInput,hcFChDirList);
  377. Begin
  378.   Dialog := New (PChDirDialog, Init (cdNoLoadDir+cdHelpButton, 31));
  379.   SetHelpCtx (Dialog, Help);
  380.   RezFile.Put (Dialog,'FChDirDlg');
  381.   Dispose (Dialog,Done);
  382. End;
  383.  
  384. procedure CreateFColorDlg;
  385. const Help: Array [1..5] Of Word = (hcColorGroupList, hcColorItemList,
  386.                     hcSelector, hcOk, hcCancel);
  387. Begin
  388.   {$IFDEF english}
  389.   Dialog := New (PColorDialog, Init ('',
  390.     ColorGroup ('desktop',
  391.       ColorItem ('background', 1, nil),
  392.     ColorGroup ('menu',
  393.       ColorItem ('text normal ', 2,
  394.       ColorItem ('text disabled', 3,
  395.       ColorItem ('text shortcut', 4,
  396.       ColorItem ('selected normal', 5,
  397.       ColorItem ('selected disabled', 6,
  398.       ColorItem ('selected shortcut', 7,
  399.       ColorItem ('normal background', 8,
  400.       ColorItem ('selected background', 9, nil)))))))),
  401.     ColorGroup ('file viewer',
  402.       ColorItem ('text', 50,
  403.       ColorItem ('background', 52, nil)), nil)))));
  404.   {$ELSE}
  405.   Dialog := New (PColorDialog, Init ('',
  406.     ColorGroup ('Desktop',
  407.       ColorItem ('Hintergrund', 1, nil),
  408.     ColorGroup ('Menü',
  409.       ColorItem ('Text normal ', 2,
  410.       ColorItem ('Text deaktiviert', 3,
  411.       ColorItem ('Text shortcut', 4,
  412.       ColorItem ('Selektiert normal', 5,
  413.       ColorItem ('Selektiert deaktiviert', 6,
  414.       ColorItem ('Selektiert shortcut', 7,
  415.       ColorItem ('Normaler Hintergrund', 8,
  416.       ColorItem ('Selekt. Hintergrund', 9, nil)))))))),
  417.     ColorGroup ('Fenstertext',
  418.       ColorItem ('Text', 50,
  419.       ColorItem ('Hintergrund', 52, nil)), nil)))));
  420.   {$ENDIF}
  421.   SetHelpCtx (Dialog, Help);
  422.   RezFile.Put (Dialog, 'ColorDlg');
  423.   Dispose (Dialog, Done);
  424. End;
  425.  
  426. procedure CreateFInfo;
  427. const Help: Word = hcOK;
  428.       Texts: Array [1..2] of String[12] = ('Demo program','Demoprogramm');
  429. Begin
  430.    R.Assign (0,0,300,200);
  431.    Dialog:=New (PDialog, Init (R, 'Info'));
  432.    With Dialog^ do Begin
  433.      Options:=Options or ofCentered;
  434.      R.Assign (100, 45, 290, 61);
  435.      Insert (New (PStaticText, Init (R, 'Graphics Vision')));
  436.      R.Move (0,16);
  437.      Insert (New (PStaticText, Init (R, 'Version '+Version)));
  438.      R.Move (0,20);
  439.      Insert (New (PStaticText, Init (R, Texts[Language])));
  440.      R.Move (0,20);
  441.      Insert (New (PStaticText, Init (R, 'Copyright (c) 1993 by')));
  442.      R.Move (0,16);
  443.      Insert (New (PStaticText, Init (R, 'Stefan Milius')));
  444.      R.Assign (100, 155, 200, 180);
  445.      Insert (New (PButton, Init (R, 'O~k~', cmOk, bfDefault)));
  446.    End;
  447.    SetHelpCtx (Dialog, Help);
  448.    RezFile.Put (Dialog, 'Info');
  449.    Dispose (Dialog, Done);
  450. End;
  451.  
  452. procedure Icons; Assembler;
  453. Asm
  454.     DW      12
  455.     DW      0000000000000000B
  456.     DW      0100000000010000B
  457.     DW      0010000000100000B
  458.     DW      0001000001000000B
  459.     DW      0000100010000000B
  460.     DW      0000010100000000B
  461.     DW      0000000000000000B
  462.     DW      0000010100000000B
  463.     DW      0000100010000000B
  464.     DW      0001000001000000B
  465.     DW      0010000000100000B
  466.     DW      0100000000010000B
  467.     DW      11
  468.     DW      00000000000000000B
  469.     DW      00000000001000000B
  470.     DW      00000000001000000B
  471.     DW      00000000011000000B
  472.     DW      00000000010000000B
  473.     DW      00000000110000000B
  474.     DW      00011000100000000B
  475.     DW      00001101100000000B
  476.     DW      00000101000000000B
  477.     DW      00000111000000000B
  478.     DW      00000010000000000B
  479.     DW      11
  480.     DW      0000000000000000B
  481.     DW      0000000000000000B
  482.     DW      0000001110000000B
  483.     DW      0000011110000000B
  484.     DW      0000110110000000B
  485.     DW      0001000110000000B
  486.     DW      0000000110000000B
  487.     DW      0000000110000000B
  488.     DW      0000000110000000B
  489.     DW      0000000110000000B
  490.     DW      0000000110000000B
  491.     DW      10
  492.     DW      0000000000000000B
  493.     DW      0000000000000000B
  494.     DW      0000011100000000B
  495.     DW      0000110110000000B
  496.     DW      0001100011000000B
  497.     DW      0000000011000000B
  498.     DW      0000000110000000B
  499.     DW      0000011100000000B
  500.     DW      0001110000000000B
  501.     DW      0001111111000000B
  502. End;
  503.  
  504. procedure CreateWDialogDlg;
  505. const Help: Array [1..10] Of Word = (hcWDlgRadio, hcWDlgGButton, hcWDlgInput,
  506.                     hcWDlgTextButton, hcWDlgCheck, hcWDlgRegler,
  507.                     hcWDlgList, hcWDlgNumInput, hcWDlgMultiCheck,
  508.                     hcOk);
  509.       rad  = 12;
  510.       StartX = 15;
  511.       StartY = 13;
  512. {$IFDEF english}
  513.       Str: String = 'the inputline is for comfortable editing of text';
  514. {$ELSE}
  515.       Str: String = 'Die Eingabezeile dient der komfortablen Eingabe von Text';
  516. {$ENDIF}
  517.       Data: LongInt = $E4;
  518.  
  519. var Sign: Pointer;
  520.     S: Word;
  521.     P: PGView;
  522. Begin
  523.   R.Assign (0,0,500,400);
  524.   {$IFDEF english}
  525.   Dialog:=New (PDialog, Init (R, 'Demo dialog'));
  526.   {$ELSE}
  527.   Dialog:=New (PDialog, Init (R, 'Demo-Dialog'));
  528.   {$ENDIF}
  529.   With Dialog^ do Begin
  530.     Options:=Options or ofCentered;
  531.  
  532.     { StaticText }
  533.     R.Assign (0, 45, 360, 65);
  534.     SetTextParams (ftSansSerif, 0, 0, true);
  535.     {$IFDEF english}
  536.     R.A.X:=(Size.X-TextWidth ('Middle')) div 2-5;
  537.     Insert (New (PStaticText, Init (R, 'Middle')));
  538.     {$ELSE}
  539.     R.A.X:=(Size.X-TextWidth ('Mitte')) div 2-5;
  540.     Insert (New (PStaticText, Init (R, 'Mitte')));
  541.     {$ENDIF}
  542.  
  543.     { RadioButtons }
  544.     R.Assign (10, 35, 100, 135);
  545.     Insert (New (PRadioButtons, Init (R,
  546.       NewSItem ('~O~ption 1',
  547.       NewSItem ('O~p~tion 2',
  548.       NewSItem ('Op~t~ion 3',
  549.       NewSItem ('Opt~i~on 4',
  550.       NewSItem ('Opti~o~n 5',
  551.       NewSItem ('Optio~n~ 6', nil)))))))));
  552.  
  553.     { Graphic Button }
  554.     (* Drawsaucer *)
  555.     SetFillStyle (SolidFill, Cyan);
  556.     Bar (0,0,SignX,SignY);
  557.     Graph.SetColor(White);
  558.     Ellipse(StartX, StartY, 0, 360, rad, (rad div 3)+2);
  559.     Ellipse(StartX, StartY-4, 190, 357, rad, rad div 3);
  560.     SetColor (Magenta);
  561.     Line(StartX+8, StartY-4, StartX+10, StartY-10);
  562.     Circle(StartX+10, StartY-10, 2);
  563.     SetColor (Blue);
  564.     Line(StartX-8, StartY-4, StartX-10, StartY-10);
  565.     Circle(StartX-10, StartY-10, 2);
  566.     Graph.SetFillStyle(SolidFill, LightRed);
  567.     FloodFill(StartX+1, StartY+4, White);
  568.     (* ReadSaucerImage *)
  569.     S := ImageSize (0, 0, SignX, SignY);
  570.     Sign := MemAlloc (S);
  571.     GetImage (0, 0, SignX, SignY, Sign^);
  572.     (* MakeButton *)
  573.     R.Assign (120, 35, 180, 75);
  574.     Insert (New (PGButton, Init (R, Sign, cmGButton, bfNormal + bfBroadCast)));
  575.  
  576.     { InputLine }
  577.     R.Assign (120,105,343,125);
  578.     P:=New (PInputLine, Init (R, 80));
  579.     Insert (P);
  580.     P^.SetData (Str);
  581.     R.Assign (120,85,220,105);
  582.     {$IFDEF english}
  583.     Insert (New (PLabel, Init (R, '~I~nputline',P)));
  584.     {$ELSE}
  585.     Insert (New (PLabel, Init (R, '~E~ingabezeile',P)));
  586.     {$ENDIF}
  587.     R.Assign(342, 105, 360, 125);
  588.     Insert(New (PHistory, Init (R, PInputLine(P), 40)));
  589.  
  590.     { Text Button }
  591.     R.Assign (300,35,360,75);
  592.     Insert (New (PButton, Init (R, '~T~ext', cmButton, bfNormal + bfBroadCast)));
  593.  
  594.     { CheckBoxes }
  595.     R.Assign (380, 35, 490, 135);
  596.     {$IFDEF english}
  597.     Insert (New (PCheckBoxes, Init (R,
  598.       NewSItem ('Mouse~p~ad',
  599.       NewSItem ('~M~ouse',
  600.       NewSItem ('~D~iskette',
  601.       NewSItem ('~H~ard disk',
  602.       NewSItem ('~R~eset',
  603.       NewSItem ('~W~hat''s left',nil)))))))));
  604.     {$ELSE}
  605.     Insert (New (PCheckBoxes, Init (R,
  606.       NewSItem ('Mouse~p~ad',
  607.       NewSItem ('~M~ouse',
  608.       NewSItem ('~D~iskette',
  609.       NewSItem ('~F~estplatte',
  610.       NewSItem ('~R~eset',
  611.       NewSItem ('~S~onstiges',nil)))))))));
  612.     {$ENDIF}
  613.  
  614.     { Regler }
  615.     R.Assign (50, 150, 70, 300);
  616.     {$IFDEF english}
  617.     Insert (New (PRegler, Init (R, -500, 500, 'A controller','-500','0','500')));
  618.     {$ELSE}
  619.     Insert (New (PRegler, Init (R, -500, 500, 'Ein Regler','-500','0','500')));
  620.     {$ENDIF}
  621.  
  622.     { ListBox }
  623.     R.Assign (332, 150, 350, 250);
  624.     P:=New (PScrollBar, Init (R));
  625.     Insert (P);
  626.     R.Assign (150, 150, 333, 250);
  627.     Insert (New (PMyListBox, Init (R, PScrollBar (P))));
  628.  
  629.     { Icon }
  630.     R.Assign (232, 260, 267, 286);
  631.     Insert (New (PIcon, Init (R, Sign, First)));
  632.     R.Assign (275, 262, 490, 282);
  633.     {$IFDEF english}
  634.     Insert (New (PStaticText, Init (R, 'This is an icon')));
  635.     {$ElSE}
  636.     Insert (New (PStaticText, Init (R, 'Das ist ein Icon')));
  637.     {$ENDIF}
  638.  
  639.     { StaticSign }
  640.     R.Assign (232, 300, 267, 326);
  641.     Insert (New (PStaticSign, Init (R, Sign)));
  642.     R.Assign (275, 302, 490, 322);
  643.     {$IFDEF english}
  644.     Insert (New (PStaticText, Init (R, 'This is a TStaticSign object')));
  645.     {$ElSE}
  646.     Insert (New (PStaticText, Init (R, 'Das ist ein StaticSign')));
  647.     {$ENDIF}
  648.  
  649.     { PNumInput }
  650.     R.Assign (449, 200, 462, 220);
  651.     P:=New (PArrowField, Init (R));
  652.     Insert (P);
  653.     R.Assign (420, 200, 450, 220);
  654.     Insert (New (PNumInput, Init (R, -100, 100, PArrowField (P))));
  655.     {$IFDEF english}
  656.     R.Assign (405, 180, 485, 200);
  657.     Insert (New (PStaticText, Init (R, 'Inputline')));
  658.     R.Assign (410, 220, 480, 240);
  659.     Insert (New (PStaticText, Init (R, 'for numbers')));
  660.     {$ELSE}
  661.     R.Assign (405, 180, 485, 200);
  662.     Insert (New (PStaticText, Init (R, 'Eingabezeile')));
  663.     R.Assign (410, 220, 480, 240);
  664.     Insert (New (PStaticText, Init (R, 'für Zahlen')));
  665.     {$ENDIF}
  666.  
  667.     { MultiCheckBoxes }
  668.     R.Assign (150, 260, 220, 325);
  669.     P := New (PMultiCheckBoxes, Init (R,
  670.       NewSItem ('Multi ~1~',
  671.       NewSItem ('Multi ~2~',
  672.       NewSItem ('Multi ~3~',
  673.       NewSItem ('Multi ~4~', nil)))), 4, cfTwoBits, @Icons));
  674.     P^.SetData (Data);
  675.     Insert (P);
  676.  
  677.     R.Assign (200, 350, 300, 380);
  678.     Insert (New (PButton, Init (R, 'O~k~', cmOk, bfDefault)));
  679.   End;
  680.   SetHelpCtx (Dialog, Help);
  681.   RezFile.Put (Dialog, 'DemoDialog');
  682.   FreeMem (Sign, S);
  683.   Dispose (Dialog, Done);
  684. End;
  685.  
  686. Begin
  687.   {$IFNDEF VER60}
  688.   PathToDriver := 'C:\BP\BGI';
  689.   {$ELSE}
  690.   PathToDriver := 'C:\TP\BGI';
  691.   {$ENDIF}
  692.  
  693.   {$IFDEF change}
  694.   {$IFDEF english}
  695.   Language := lfEnglish;
  696.   {$ENDIF}
  697.   {$ENDIF}
  698.  
  699.   InitMemory;
  700.   InitVideo;
  701.   InitFonts;
  702.   InitHistory;
  703.  
  704.   RezStream := New(PProtectedStream, Init('DEMO.REZ', stCreate, 4096));
  705.   RezFile.Init (RezStream);
  706.  
  707.   RegisterType (RStrListMaker);
  708.   RegisterDemo;
  709.  
  710.   CreateStatusHints;
  711.   CreateDesktop;
  712.   CreateMenuBar;
  713.   CreateStatusLine;
  714.   CreateLocalMenu;
  715.   CreateFOpenDlg;
  716.   CreateFColorDlg;
  717.   CreateFInfo;
  718.   CreateFChDirDlg;
  719.   CreateWDialogDlg;
  720.  
  721.   RezFile.Done;
  722.   DoneHistory;
  723.   DoneFonts;
  724.   DoneVideo;
  725.   DoneMemory;
  726. End.
  727.