home *** CD-ROM | disk | FTP | other *** search
- program Beispiel6;
-
- uses GApp,
- GDecl,
- GViews,
- graph;
-
-
- const cmNew = 101; cmRestore = 201;
- cmLoad = 102; cmCut = 202;
- cmSave = 103; cmCopy = 203;
- cmPrint = 104; cmMove = 204;
- cmErase = 105; cmTurn = 204;
-
- cmMagni = 301; cmRoman = 401;
- cmGrid = 302; cmScript = 402;
- cmPencel = 303; cmTimes = 403;
- cmBrush = 304; cmNormal = 404;
- cmBold = 405;
- cmItalic = 406;
- cmUnderline = 407;
-
-
-
- type TApplication=object(TApp)
- procedure SetDesktopFrame(Titel:string);virtual;
- procedure SetDesktopBackground; virtual;
- procedure InitMenuBar; virtual;
- end;
-
- PNewDTBgrd=^TNewDTBgrd;
- TNewDTBgrd=object(TDsktpBgrd)
- procedure Draw;virtual;
- end;
-
- var MyProg:TApplication;
-
- {Implementation TApplication}
-
- procedure TApplication.SetDesktopFrame(Titel:string);
- var R:TRect;
- begin
- with Desktop^ do
- begin
- GetBounds(R);
- Frame:=new(PFrame, Init(R,R,Titel,winDouble+winPanel+winMenu));
- Frame^.Palette:=Palette1;
- List^.InsertItem(Frame);
- end;
- end;
-
- procedure TApplication.SetDesktopBackground;
- var R:TRect;
- NBgrd:PNewDTBgrd;
- begin
- with Desktop^ do
- begin
- R:=Frame^.Area;
- NBgrd:=new(PNewDTBgrd, Init(R));
- NBgrd^.Palette[7]:=#14;
- NBgrd^.Palette[8]:=#7;
- List^.InsertItem(NBgrd);
- end;
- end;
-
- procedure TApplication.InitMenuBar;
- begin
- Palette[1]:=#14;
- Palette[5]:=#14;
- Palette[4]:=#4;
- Palette[12]:=#4;
- MainMenu('~D~atei',1);
- SubMenu('~N~eues Bild',cmNew,0,0,false,false);
- SubMenu('Bild ~L~aden F3',cmLoad,0,kbF3,false,false);
- SubMenu('Bild ~S~peichern F2',cmSave,0,kbF2,false,false);
- NewLine;
- SubMenu('~D~rucken',cmPrint,0,0,false,false);
- SubMenu('Lös~c~hen',cmErase,0,0,false,false);
- NewLine;
- SubMenu('~B~eenden Alt-X',cmCloseApplication,0,altX,false,false);
- MainMenu('~B~earbeiten',2);
- SubMenu('~R~ückgängig',cmRestore,0,0,false,false);
- NewLine;
- SubMenu('~S~chnitt',cmCut,0,0,true,false);
- SubMenu('~K~opieren',cmCopy,0,0,true,false);
- SubMenu('~V~erschieben',cmMove,0,0,true,false);
- SubMenu('~D~rehen',cmTurn,0,0,true,false);
- MainMenu('~W~erkzeuge',3);
- SubMenu('~V~ergrößern',cmMagni,0,0,false,false);
- NewLine;
- SubMenu('~R~aster',cmGrid,0,0,false,false);
- NewLine;
- SubMenu('~P~insel ändern',cmPencel,0,0,false,false);
- SubMenu('~S~pray ändern',cmBrush,0,0,false,false);
- MainMenu('~S~chrift',4);
- SubMenu('~R~oman',cmRoman,0,0,false,true);
- SubMenu('~S~cript',cmScript,0,0,false,false);
- SubMenu('~T~imes',cmTimes,0,0,false,false);
- NewLine;
- SubMenu('~N~ormal',cmNormal,0,0,false,true);
- SubMenu('~F~ett',cmBold,0,0,false,false);
- SubMenu('~K~ursiv',cmItalic,0,0,false,false);
- SubMenu('~U~nterstrichen',cmUnderline,0,0,false,false);
- end;
-
-
- {Implementation TNewDTBgrd}
-
- procedure TNewDTBgrd.Draw;
- begin
- with Border do
- begin
- SetFillStyle(SolidFill,GetPalColor(7));
- Bar(A.x,A.y,B.x,A.y+20);
- SetFillStyle(SolidFill,GetPalColor(8));
- Bar(A.x,A.y+22,B.x,B.y);
- end;
- end;
-
-
- begin
- MyProg.Init('Beispiel 6');
- MyProg.Run;
- MyProg.Done;
- end.