Amiga ISO Collection/AmigaUtilCD2.iso/Programming/Pascal/MAXONPASCAL3.DMS/in.adf/DEMOS-OS1.3/Graphdemo.p

Text File | 1994-07-23 | 5.3 KB | 146 lines

{ MaxonPascal-Anpassung / Test: Falk Zühlsdorff (PackMAN) 1994 }

PROGRAM Grafikdemo;

Uses Intuition, Graphics;

CONST Breite=640; Hoehe=256; MEMF_CHIP=2;

TYPE IntArr10=Array[1..10] of Integer;
     LongArr16=Array[1..16] of Long;

VAR NeuWindow      :NewWindow;
    MyWindow       :^Window;
    Menu1,Menu2    :Menu;
    Mi1_1,Mi1_2    :MenuItem;
    MiT1_1,MiT1_2,
    Knopftx,
    Textdummy      : IntuiText;
    Knopf,Schieber,
    Textgad        : Gadget;
    KnopfBord,
    TextBord       : Border;
    SchieberInfo   : PropInfo;
    TextInfo       : StringInfo;
    BorderXY,
    TextBordXY     :IntArr10;
    Imageplane     : ^LongArr16;
    Bild           : Image;
    Buffer,
    UndoBuffer     : string[80];
    MoverData      : Array[1..6]of integer;
    Rast           :^RastPort;
    L              :Long;
    i,x2,y2        :Integer;
    MyScreen       : ^Screen;
    Msg,Upt        : ptr;

    help           : boolean;
    GHelp          : word;

BEGIN
  Imageplane:=ptr(Alloc_mem(SizeOf(LongArr16),MEMF_CHIP));
  Bild:=Image(0,0,32,16,1,imageplane,1,0,Nil);
  Imageplane^:=LongArr16(
    %00011111111111111111111111111000,
    %01110000000000000000000000001110,
    %11100011110011110001111111000111,
    %11000001100001100011100000000011,
    %11000001111111100001111110000011,
    %11000001100001100000000111000011,
    %11000011110011110011111110000011,
    %11000000000000000000000000000011,
    %11000000000000000000000000000011,
    %11000001111111000011111110000011,
    %11000011100000000111000111000011,
    %11000001111110000110000000000011,
    %11000000000111000111000111000011,
    %11100011111110000011111110000111,
    %01110000000000000000000000001110,
    %00011111111111111111111111111000);
  MyScreen:=Open_Screen(0,0,Breite,Hoehe,2,0,1,HIRES or GENLOCK_VIDEO,'Himpelpascal Demo');
  SetRGB4(^MyScreen^.ViewPort,1,15,15,15);
  SetRGB4(^MyScreen^.ViewPort,2,0,0,15);
  SetRGB4(^MyScreen^.ViewPort,3,15,15,15);
  Menu1:=Menu(^Menu2,10,0,80,10,MENUENABLED,'Menü 1',^Mi1_1,0,0,0,0);
  Mi1_1:=MenuItem(^Mi1_2,0,0,80,10,ITEMTEXT or ITEMENABLED or HIGHCOMP,0,
                  ^MiT1_1,Nil,chr(0),Nil,0);
  MiT1_1:=IntuiText(0,1,0,5,3,Nil,'Punkt 1',Nil);
  Mi1_2:=MenuItem(Nil,0,12,80,12,ITEMTEXT or ITEMENABLED or HIGHCOMP or COMMSEQ,
                  0,^MiT1_2,Nil,'2',Nil,0);
  MiT1_2:=IntuiText(0,1,0,5,3,Nil,'Punkt 2',Nil);
  Menu2:=Menu(Nil,100,0,80,10,MENUENABLED,'Menü 2',Nil,0,0,0,0);
  Knopf:=Gadget(Nil,-121,-23,100,20,GADGHCOMP or GRELBOTTOM or GRELRIGHT,
                RELVERIFY or TOGGLESELECT,BOOLGADGET,^KnopfBord,Nil,
                ^Knopftx,0,Nil,1,NIL); {NIL nicht 0}
  Knopftx:=Intuitext(1,0,0,(100-11*8)div 2,6,Nil,'Klick here!',Nil);
  KnopfBord:=Border(0,0,1,0,1,5,^BorderXY,Nil);
  BorderXY:=IntArr10(-3,-2,102,-2,102,21,-3,21,-3,-2);
  Schieber:=Gadget(Nil,-16,12,16,-18,GADGHCOMP or GRELHEIGHT or GRELRIGHT,
                   RELVERIFY or GADGIMMEDIATE,PROPGADGET,^Moverdata,Nil,
                   Nil,0,^Schieberinfo,2,NIL);
  SchieberInfo:=Propinfo(FREEVERT or AUTOKNOB,$8000,$8000,0,$8000 div 5,
                         0,0,0,0,0,0);
  TextGad:=Gadget(Nil,8,64,120,8,GADGHCOMP,GADGIMMEDIATE,STRGADGET,^TextBord,
                  Nil,Nil,0,^TextInfo,3,NIL);
  TextInfo:=StringInfo(^Buffer,^Undobuffer,0,76,0,0,0,0,0,0,Nil,0,Nil);
  TextBord:=Border(0,0,1,0,1,5,^TextbordXY,Nil);
  TextBordXY:=IntArr10(-3,-3,123,-3,123,10,-3,10,-3,-3);
  Buffer:='Hallo'; UndoBuffer:='';
  NeuWindow:=NewWindow(125,50,400,120,0,1,GADGETUP or GADGETDOWN,
           ACTIVATE or WINDOWSIZING or WINDOWDRAG or WINDOWDEPTH or WINDOWCLOSE,
           Nil,Nil,'Intuitiondemo',MyScreen,Nil,100,80,Breite,Hoehe,CUSTOMSCREEN);
  MyWindow:=OpenWindow(^Neuwindow);
  IF MyWindow=Nil THEN Error('Fenster kann nicht geöffnet werden!');
  Rast:=MyWindow^.RPort;
  Upt:=MyWindow^.Userport;
  TextDummy:=Intuitext(1,0,0,0,0,Nil,'© by        Himpelsoft & PackMAN',Nil);
  PrintIText(Rast,^TextDummy,10,16);
  help:=SetMenuStrip(MyWindow,^Menu1);
  GHelp:=AddGadget(MyWindow,^Knopf,0);
  GHelp:=AddGadget(MyWindow,^Schieber,1);
  GHelp:=AddGadget(MyWindow,^TextGad,2);
  RefreshGadgets(^Knopf,MyWindow,Nil);
  DrawImage(Rast,^Bild,50,12);
  While Knopf.flags and SELECTED=0 do
    BEGIN
      Msg:=Wait_Port(Upt);
      IF Msg<>Nil THEN
        BEGIN
          Msg:=Get_Msg(Upt);
          Reply_Msg(Msg)
        END
    END;
  GHelp:=RemoveGadget(MyWindow,^Knopf);
  GHelp:=RemoveGadget(MyWindow,^Schieber);
  GHelp:=RemoveGadget(MyWindow,^TextGad);
  ClearMenuStrip(MyWindow);
  For l:=12 to MyWindow^.Height do
    ScrollRaster(Rast,(32-l) div 10,-1,2,12,MyWindow^.Width-4,MyWindow^.Height-2);
  Rast:=^MyScreen^.Rastport;
  x2:=1+MyWindow^.LeftEdge+MyWindow^.Width;
  y2:=1+MyWindow^.TopEdge+MyWindow^.Height;
  For i:=12 to MyWindow^.LeftEdge Do
    ScrollRaster(Rast,1,1+i div 20,0,12,x2,y2);
  CloseWindow(MyWindow);
  For L:=80 to 800 do
    BEGIN
      SetAPen(Rast,1+(L mod 3));
      Move(Rast,Round(320-315*sin(L/50)),Round(130+115*cos(L/80)));
      Draw(Rast,Round(320+315*cos(L/100)),Round(130-115*sin(L/120)));
    END;
  Delay(4*50);
  For L:=1 to Breite div 12 Do
    ScrollRaster(Rast,12,0,0,12,Breite,Hoehe);
  ClearScreen(Rast);
  For i:=1 to Hoehe Do
    BEGIN
      MoveScreen(MyScreen,0,1);
      For L:=1 to 200 do
    END;
  help:=CloseScreen(MyScreen);
  Free_Mem(long(Imageplane),SizeOf(LongArr16));
  writeln; writeln('Text: ',Buffer)
END.