home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 13 / CDA13.ISO / cdactual / demobin / share / program / Pascal / AS21P.ZIP / ARTSHOW.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-10-31  |  22.9 KB  |  890 lines
  1. {************************************************}
  2. {   ArtShow 2.1                                  }
  3. {   Copyright 1991 Doug Overmyer                 }
  4. {************************************************}
  5.  
  6. program ArtShow;
  7.  
  8. {$R ARTSHoW.RES}
  9.  
  10. uses OGL1,OGL2,OGL3,WinTypes, WinProcs, WObjects, StdDlgs,
  11.     Strings,WOPlus,StdWnds;
  12.  
  13. const
  14.   AS_Name =  'ArtShow';
  15.   cm_FileOpen =   101;
  16.   cm_FileWin  =   199;
  17.   cm_Start    =   201;
  18.   cm_Stop      =     301;
  19.   cm_Back   =     351;
  20.   cm_Help      =     401;
  21.   cm_ZoomOn  =    501;
  22.   cm_ZoomOff =    502;
  23.   cm_BPSolid =    601;
  24.   cm_BP10  =      603;
  25.   cm_BP15  =      604;
  26.   cm_BP30 =       605;
  27.   cm_BP50 =       606;
  28.   cm_BP70   =     607;
  29.   cm_BPHorizontal=609;
  30.   cm_BPVertical=  611;
  31.   cm_BPDiagonal=  613;
  32.   cm_BPHatch=     615;
  33.   cm_BPPebble=    617;
  34.   cm_BPBrick=     619;
  35.  
  36.   cm_BCBlack =    700;
  37.   cm_BCWhite =    701;
  38.   cm_BCRed  =     702;
  39.   cm_BCGreen =    703;
  40.   cm_BCBlue =     704;
  41.   cm_BCCyan =     705;
  42.   cm_BCMagenta =  706;
  43.   cm_BCYellow  =  707;
  44.   cm_FullScreen = 801;
  45.   id_BN1 =        901;
  46.   id_BN2 =        902;
  47.   id_BN3 =        903;
  48.   id_BN4 =        904;
  49.   id_BN5 =        905;
  50.   id_BN6 =        906;
  51.   cm_BPPSolid =    1001;
  52.   cm_BPP10  =      1003;
  53.   cm_BPP15  =      1004;
  54.   cm_BPP30 =       1005;
  55.   cm_BPP50 =       1006;
  56.   cm_BPP70   =     1007;
  57.   cm_BPPHorizontal=1009;
  58.   cm_BPPVertical=  1011;
  59.   cm_BPPDiagonal=  1013;
  60.   cm_BPPHatch=     1015;
  61.   cm_BPPPebble=    1017;
  62.   cm_BPPBrick=     1019;
  63.  
  64.   cm_BCPBlack =    1100;
  65.   cm_BCPWhite =    1101;
  66.   cm_BCPRed  =     1102;
  67.   cm_BCPGreen =    1103;
  68.   cm_BCPBlue =     1104;
  69.   cm_BCPCyan =     1105;
  70.   cm_BCPMagenta =  1106;
  71.   cm_BCPYellow  =  1107;
  72.   idm_RunCP   =    1201;
  73.   idm_About =      1202;
  74.   idm_IconBar =    1203;
  75.   idm_MenuBar =    1204;
  76.   cm_FileBye  =    1301;
  77.  
  78.   fsPathName =    79;
  79. {*****************************************************************}
  80. {T Y P E S }
  81. {*****************************************************************}
  82. type
  83.   TASApp = object(TApplication)
  84.   procedure InitMainWindow; virtual;
  85. end;
  86.  
  87. PASFileWin = ^TASFileWin;
  88. TASFileWin = object(TFileWindow)
  89.     constructor Init(AParent:PWindowsObject;ATitle,AFileName:PChar);
  90.     procedure CMFileBye(var Msg:TMessage);virtual cm_First+cm_FileBye;
  91.   destructor Done;virtual;
  92. end;
  93.  
  94. PASIconBar = ^TASIconBar;
  95. TASIconBar = object(TGWindow)
  96.     BN1,BN2,BN3,BN4,BN5,BN6:PODButton;
  97.   HFloatMenu:hMenu;
  98.   HPopUpMenu:hMenu;
  99.   constructor Init(AParent:PWindowsObject;ATitle:PChar);
  100.   destructor Done;virtual;
  101.   procedure SetupWindow;virtual;
  102.   procedure WMDrawItem(var Msg:TMessage);virtual wm_First+wm_DrawItem;
  103.     procedure WMSize(var Msg: TMessage); virtual wm_First + wm_Size;
  104.   procedure WMMove(var Msg:TMessage); virtual wm_First+wm_Move;
  105.   procedure WMNCLButtonDown(var Msg:TMessage);virtual wm_First+wm_NCLButtonDown;
  106.   procedure DefChildProc(var Msg: TMessage); virtual;
  107.     procedure IDBN1(Var Msg:TMessage);virtual id_First+id_BN1;
  108.   procedure IDBN2(Var Msg:TMessage);virtual id_First+id_BN2;
  109.   procedure IDBN3(Var Msg:TMessage);virtual id_First+id_BN3;
  110.   procedure IDBN4(Var Msg:TMessage);virtual id_First+id_BN4;
  111.   procedure IDBN5(Var Msg:TMessage);virtual id_First+id_BN5;
  112.   procedure IDBN6(Var Msg:TMessage);virtual id_First+id_BN6;
  113.   procedure WMCommand(Var Msg:TMessage);virtual wm_First+wm_Command;
  114. end;
  115.  
  116. PASWindow = ^TASWindow;
  117. TASWindow = object(TGWindow)
  118.         IconBar:PASIconBar;
  119.       FileWin:PASFileWin;
  120.     FileName: array[0..fsPathName] of Char;
  121.     Bitmap:PGBitmap;
  122.     Timer_Set :Boolean;
  123.     Is_Running :Boolean;
  124.     Slide_Ptr :Integer;
  125.     Slides :PCollection;
  126.     TheIcon : HIcon;
  127.     hPal:HPalette;
  128.     IsFullScreen:Boolean;
  129.     constructor Init(ATitle: PChar);
  130.     destructor Done; virtual;
  131.     procedure SetupWindow;virtual;
  132.     procedure CMFileOpen(var Msg: TMessage); virtual cm_First + cm_FileOpen;
  133.     procedure WMSize(var Msg: TMessage); virtual wm_First + wm_Size;
  134.         function  OpenFile(Name:Pchar):Boolean;virtual;
  135.     function  DrawToWindow:Boolean;virtual;
  136.     procedure ShowNext;virtual;
  137.     procedure WMTimer(var Msg:TMessage);virtual wm_First+wm_Timer;
  138.     procedure CMStart(var Msg:TMessage);virtual cm_First+cm_Start;
  139.     procedure CMStop(var Msg:TMessage);virtual cm_First+cm_Stop;
  140.     procedure CMBack(var Msg:TMessage);virtual cm_first+cm_Back;
  141.     procedure WMRButtonDown(var Msg:TMessage);virtual wm_First+wm_RButtonDown;
  142.     procedure WMLButtonDown(var Msg:TMessage);virtual wm_First+wm_LButtonDown;
  143.     procedure WMMButtonDown(var Msg:TMessage);virtual wm_First+wm_MButtonDown;
  144.     procedure CMHelp(var Msg:TMessage);virtual cm_First + cm_Help;
  145.     procedure CMBPSolid(var Msg:TMessage);virtual cm_First+cm_BPSolid;
  146.       procedure CMBP10(var Msg:TMessage);virtual cm_First+cm_BP10;
  147.       procedure CMBP15(var Msg:TMessage);virtual cm_First+cm_BP15;
  148.       procedure CMBP30(var Msg:TMessage);virtual cm_First+cm_BP30;
  149.       procedure CMBP50(var Msg:TMessage);virtual cm_First+cm_BP50;
  150.       procedure CMBP70(var Msg:TMessage);virtual cm_First+cm_BP70;
  151.       procedure CMBPHorizontal(var Msg:TMessage);virtual cm_First+cm_BPHorizontal;
  152.       procedure CMBPVertical(var Msg:TMessage);virtual cm_First+cm_BPVertical;
  153.       procedure CMBPDiagonal(var Msg:TMessage);virtual cm_First+cm_BPDiagonal;
  154.       procedure CMBPHatch(var Msg:TMessage);virtual cm_First+cm_BPHatch;
  155.       procedure CMBPPebble(var Msg:TMessage);virtual cm_First+cm_BPPebble;
  156.       procedure CMBPBrick(var Msg:TMessage);virtual cm_First+cm_BPBrick;
  157.     procedure CMBCBlack(var Msg:TMessage);virtual cm_First+cm_BCBlack;
  158.     procedure CMBCWhite(var Msg:TMessage);virtual cm_First+cm_BCWhite;
  159.     procedure CMBCRed(var Msg:TMessage);virtual cm_First+cm_BCRed;
  160.     procedure CMBCGreen(var Msg:TMessage);virtual cm_First+cm_BCGreen;
  161.     procedure CMBCBlue(var Msg:TMessage);virtual cm_First+cm_BCBlue;
  162.     procedure CMBCCyan(var Msg:TMessage);virtual cm_First+cm_BCCyan;
  163.     procedure CMBCMagenta(var Msg:TMessage);virtual cm_First+cm_BCMagenta;
  164.     procedure CMBCYellow(var Msg:TMessage);virtual cm_First+cm_BCYellow;
  165.     procedure CMFullScreen(var Msg:TMessage);virtual cm_First+cm_FullScreen;
  166.     procedure CMFileWin(var Msg:TMessage);virtual cm_First + cm_FileWin;
  167.     procedure WMChar(Var Msg:TMessage);virtual wm_First+wm_Char;
  168.       procedure WMSysCommand(var Msg:TMessage);virtual wm_First+wm_SysCommand;
  169. end;
  170.  
  171. type
  172. PSlideRec = ^TSlideRec;
  173. TSlideRec = object(TObject)
  174.     FileName : PChar;
  175.   Duration: Integer;
  176.     constructor Init(NewFileName:PChar;NewDuration:Integer);
  177.     destructor  Done;virtual;
  178. end;
  179. {*****************************************************************}
  180. {G L O B A L S }
  181. {*****************************************************************}
  182. var
  183.     MainWin:PASWindow;
  184. {*****************************************************************}
  185. {M E T H O D S }
  186. {*****************************************************************}
  187.  
  188. { Construct the TASApp's MainWindow of type TASWindow }
  189. {InitMainWindow}
  190. procedure TASApp.InitMainWindow;
  191. begin
  192.     CmdShow := sw_Maximize;
  193.   MainWindow := New(PASWindow, Init(AS_Name));
  194.   MainWin := PASWindow(MainWindow);
  195. end;
  196.  
  197. {*****************************************************************}
  198. {Init}
  199. constructor TASWindow.Init(ATitle: PChar);
  200. var
  201.     ARect:TMathRect;
  202.   BackColor:TSystemColor;
  203.   aPalette:TPalette ;
  204. begin
  205.   TGWindow.Init(nil, ATitle);
  206.   Attr.Style := Attr.Style or ws_DlgFrame  ;
  207.   BackColor.Init(sc_Window);
  208.   Brush := New(PBrush,Init(@BackColor));
  209.   Brush^.Pattern := bp_Nil;
  210.   BackColor.Done;
  211.   Bitmap := New(PGBitmap,Init(0,0,0,0,tc_NoTools));
  212.   Picture^.Add(Bitmap);
  213.   Timer_Set := False;
  214.   Slide_Ptr := 0;
  215.   Is_Running := False;
  216.   IsFullScreen := False;
  217.   Slides := New(PCollection,Init(100,100));
  218.   BitMap^.LoadBmpResource('AS_LOGO',Space);
  219.     DrawToWindow;
  220.   IconBar := New(PASIconBar,Init(@Self,'Control Bar'));
  221.   FileWin := nil;
  222. end;
  223.  
  224. {Done}
  225. destructor TASWindow.Done;
  226. var
  227.     Msg:TMessage;
  228. begin
  229.   Dispose(Slides,Done);
  230.     If (FileWin <> nil) and (FileWin^.HWindow <> 0) then
  231.       FileWin^.CMFileBye(Msg);
  232.   if Timer_Set then
  233.       begin
  234.        KillTimer(HWindow,1);
  235.        Timer_Set := False;
  236.       end;
  237.   TGWindow.Done;
  238. end;
  239.  
  240. procedure TASWindow.SetupWindow;
  241. var
  242.     SysMenu:HMenu;
  243. begin
  244.     TGWindow.SetupWindow;
  245.   SetClassWord(HWindow,GCW_HIcon,LoadIcon(HInstance,'AS_Icon'));
  246.   Sysmenu := GetSystemMenu(hWindow,false);
  247.   AppendMenu(SysMenu,MF_Separator,0,nil);
  248.   AppendMenu(SysMenu,0,idm_IconBar,'Control Bar');
  249.   AppendMenu(SysMenu,0,idm_MenuBar,'Menu Bar');
  250.   AppendMenu(SysMenu,0,idm_RunCP,'Control Panel');
  251.   AppendMenu(SysMenu,MF_Separator,0,nil);
  252.   AppendMenu(Sysmenu,0,idm_About,'About...');
  253. end;
  254.  
  255. {CMFileOpen}
  256. procedure TASWindow.CMFileOpen(var Msg: TMessage);
  257. var
  258.   TempName: array[0..fsPathName] of Char;
  259.   CaptionBuffer: array [0..fsPathName+12{AS_Name} +2{': '} +1{#0}] of Char;
  260.   TheFile :PTextStream;
  261.   BPtr : PChar;
  262.   NewFileName:Array[0..50] of Char;
  263.   NewDuration:Integer;
  264.   Err1:Integer ;
  265. begin
  266.     SetWindowText(HWindow, AS_Name);
  267.   Is_Running := False;
  268.   If Slides^.Count > 0 then
  269.        begin
  270.     Dispose(Slides,Done);
  271.     Slides := New(PCollection,Init(100,100));
  272.     Slide_Ptr := 0;
  273.     end;
  274.   if Application^.ExecDialog(New(PFileDialog,
  275.             Init(@Self, PChar(sd_FileOpen), StrCopy(TempName, '*.shw'))))
  276.             = id_Ok then
  277.     begin
  278.     StrCopy(FileName, TempName);
  279.     StrCopy(CaptionBuffer, 'Art Show:');
  280.     StrCat(CaptionBuffer, ': ');
  281.     StrCat(CaptionBuffer, AnsiLower(FileName));
  282.     SetWindowText(HWindow, CaptionBuffer);
  283.  
  284.     TheFile := New(PTextStream,Init(FileName,stOpen,1024));
  285.     While TheFile^.IsEOF = False  do
  286.             begin
  287.       StrCopy(NewFileName,TheFile^.GetNext);
  288.       BPtr := TheFile^.GetNext;
  289.       If BPtr <> nil then
  290.           Val(BPtr,NewDuration,Err1)
  291.       else
  292.           Err1 := 1;
  293.       if Err1 = 0 then
  294.             Slides^.Insert(New(PSlideRec,Init(NewFileName,NewDuration)));
  295.       end;
  296.     Dispose(TheFile,Done);
  297.     end;
  298. end;
  299.  
  300. function TASWindow.OpenFile(Name: PChar): Boolean;
  301. var
  302.   aPoint:TGPoint;
  303. begin
  304.      Bitmap^.LoadBMPFile(Name, Space) ;
  305.   aPoint.InitDefault;
  306.   BitMap^.PositionAt(@aPoint);
  307.   aPoint.Done;
  308.   OpenFile := True;
  309.     DrawtoWindow;
  310. end;
  311.  
  312. function TASWindow.DrawToWindow: Boolean;
  313. var
  314.   OutRect,ClipRect,MapRect: TMathRect;
  315.   SMCYSCREEN,SMCXSCREEN:Integer;
  316.   CenterPt:TGPoint;
  317.   APalette:TPalette;
  318. begin
  319.   APalette.Init(256,10);
  320.   Bitmap^.GetPalette(APalette);
  321.   Port^.SetPalette(@APalette);
  322.   APalette.Done;
  323.   SMCYSCREEN  := GetSystemMetrics(sm_CYScreen);
  324.   SMCXSCREEN := GetSystemMetrics(sm_CXScreen);
  325.  
  326.   OutRect.InitDefault;ClipRect.InitDefault;MapRect.InitDefault;CenterPt.InitDefault;
  327.   if IsFullScreen then
  328.     OutRect.Build(0,0,SMCXSCREEN,SMCYSCREEN)    {set output to screen size}
  329.   else
  330.       GetDisplayRect(OutRect);       {set output size to window client size}
  331.  
  332.   Space^.SetWorldRect(@OutRect);
  333.   OutRect.GetCenter(CenterPt);
  334.   Bitmap^.CenterAt(@CenterPt);       {alter bm's orign,corner so centered}
  335.   MapRect.CopyFrom(@OutRect);        {set mapR to output size, }
  336.   Space^.SetMappingRect(@MapRect);   
  337.   Space^.FitToRectangle(@OutRect);   {adjust zoom}
  338.     CenterPt.Done;OutRect.Done;ClipRect.Done;MapRect.Done;
  339.  
  340.      Invalidate;
  341.   UpdateWindow(HWindow);
  342.   DrawToWindow := True;
  343. end;
  344.  
  345. { Reset mapping rectangle }
  346. {WMSize}
  347. procedure TASWindow.WMSize(var Msg: TMessage);
  348. var
  349.     DispRect:TMathRect;
  350.   MapRect:TMathRect;
  351.   CenterPt:TGPoint;
  352.   Palette:TPalette;
  353. begin
  354.   TWindow.WMSize(Msg);
  355.   {if IsFullScreen then Exit;}
  356.   DrawToWindow;
  357.   if IconBar <> nil then
  358.         SendMessage(IconBar^.HWindow,wm_Size,0,0);
  359. end;
  360.  
  361. {ShowNext}
  362. procedure TASWindow.ShowNext;
  363. var
  364.     Slide:PSlideRec;
  365.   Msg:TMessage;
  366.   Dur:Word;
  367. begin
  368. if Timer_Set then
  369.     begin
  370.       KillTimer(HWindow,1);
  371.       Timer_Set := False;
  372.     end;
  373. if Slide_Ptr < (Slides^.Count ) then
  374.     begin
  375.   Slide := Slides^.At(Slide_Ptr);
  376.   if StrIComp(Slide^.FileName,'loop') = 0 then
  377.       begin
  378.        Slide_Ptr := 0 ;
  379.     CMStart(Msg) ;
  380.       end
  381.     else
  382.         begin
  383.         Dur := Slide^.Duration ;
  384.       if Dur < 62 then
  385.           Dur := Dur * 1000
  386.       else
  387.           Dur := 60000;
  388.       OpenFile(Slide^.FileName);
  389.       SetTimer(HWindow,1,Dur,nil);
  390.       Timer_Set := True;
  391.       Inc(Slide_Ptr);
  392.       end;
  393.     end;
  394. end;
  395.  
  396. {WMTimer}
  397. procedure TASWindow.WMTimer(var Msg:TMessage);
  398. begin
  399.     KillTimer(HWindow,1);
  400.   Timer_Set := False;
  401.   ShowNext;
  402. end;
  403.  
  404. {CMStart}
  405. procedure TASWindow.CMStart(var Msg:TMessage);
  406. begin
  407.   Is_Running := True;
  408.     ShowNext;
  409. end;
  410.  
  411. {CMStop}
  412. procedure TASWindow.CMStop(var Msg:TMessage);
  413. begin
  414.     if Timer_Set = True then
  415.        begin
  416.        KillTimer(HWindow,1);
  417.     Timer_Set := False;
  418.     end;
  419.   Is_Running := False;
  420. end;
  421.  
  422. {CMBack} {Previous Slide}
  423. procedure TASWindow.CMBack(var Msg:TMessage);
  424. begin
  425.         Slide_Ptr :=Max( Slide_Ptr - 2,0);
  426.     Is_Running := True;
  427.     ShowNext;
  428. end;
  429.  
  430. {WMRButtonDown} {Previous Slide}
  431. procedure TASWindow.WMRButtonDown(var Msg:TMessage);
  432. begin
  433.     SendMessage(HWindow,wm_command,cm_Back,0);
  434. end;
  435.  
  436. {WMLButtonDown} {Next Slide, pls!}
  437. procedure TASWindow.WMLButtonDown(var Msg:TMessage);
  438. begin
  439.     If not Is_Running then
  440.        CMStart(Msg)
  441.   else
  442.        ShowNext;
  443. end;
  444.  
  445. {WMMButtonDown} {Stop Show, pls!}
  446. procedure TASWindow.WMMButtonDown(var Msg:TMessage);
  447. begin
  448.   CMStop(Msg);
  449. end;
  450.  
  451. {CMHelp}
  452. procedure TASWindow.CMHelp(var Msg:TMessage);
  453. var
  454.     HelpDlg : PDialog;
  455. begin
  456.     HelpDlg := New(PDialog,Init(@Self,'AS_ABOUTBOX'));
  457.    Application^.ExecDialog(HelpDlg);
  458. end;
  459.  
  460. procedure TASWindow.CMBPSolid(var Msg:TMessage);
  461. begin
  462.   Brush^.Pattern := bp_Solid;
  463. end;
  464.  
  465. procedure TASWindow.CMBP10(var Msg:TMessage);
  466. begin
  467.   Brush^.Pattern := bp_Ten;
  468. end;
  469.  
  470. procedure TASWindow.CMBP15(var Msg:TMessage);
  471. begin
  472.   Brush^.Pattern := bp_Fifteen;
  473. end;
  474.  
  475. procedure TASWindow.CMBP30(var Msg:TMessage);
  476. begin
  477.   Brush^.Pattern := bp_Thirty;
  478. end;
  479.  
  480. procedure TASWindow.CMBP50(var Msg:TMessage);
  481. begin
  482.   Brush^.Pattern := bp_Fifty
  483. end;
  484.  
  485. procedure TASWindow.CMBP70(var Msg:TMessage);
  486. begin
  487.   Brush^.Pattern := bp_Seventy;
  488. end;
  489.  
  490. procedure TASWindow.CMBPHorizontal(var Msg:TMessage);
  491. begin
  492.   Brush^.Pattern := bp_Horizontal;
  493. end;
  494.  
  495. procedure TASWindow.CMBPVertical(var Msg:TMessage);
  496. begin
  497.   Brush^.Pattern := bp_Vertical;
  498. end;
  499.  
  500. procedure TASWindow.CMBPDiagonal(var Msg:TMessage);
  501. begin
  502.   Brush^.Pattern := bp_Diagonal;
  503. end;
  504.  
  505. procedure TASWindow.CMBPHatch(var Msg:TMessage);
  506. begin
  507.   Brush^.Pattern := bp_Hatch;
  508. end;
  509.  
  510. procedure TASWindow.CMBPPebble(var Msg:TMessage);
  511. begin
  512.   Brush^.Pattern := bp_Pebble;
  513. end;
  514.  
  515. procedure TASWindow.CMBPBrick(var Msg:TMessage);
  516. begin
  517.   Brush^.Pattern := bp_Brick;
  518. end;
  519.  
  520. procedure TASWindow.CMBCBlack(var Msg:TMessage);
  521. var
  522. NewColor:TColor;
  523. begin
  524.     NewColor.Init(ps_Black);
  525.   Brush^.SetColor(@NewColor);
  526.   NewColor.Done;
  527. end;
  528.  
  529. procedure TASWindow.CMBCWhite(var Msg:TMessage);
  530. var
  531. NewColor:TColor;
  532. begin
  533.     NewColor.Init(ps_White);
  534.   Brush^.SetColor(@NewColor);
  535.   NewColor.Done;
  536. end;
  537.  
  538. procedure TASWindow.CMBCRed(var Msg:TMessage);
  539. var
  540. NewColor:TColor;
  541. begin
  542.     NewColor.Init(ps_Red);
  543.   Brush^.SetColor(@NewColor);
  544.   NewColor.Done;
  545. end;
  546.  
  547. procedure TASWindow.CMBCGreen(var Msg:TMessage);
  548. var
  549. NewColor:TColor;
  550. begin
  551.     NewColor.Init(ps_Green);
  552.   Brush^.SetColor(@NewColor);
  553.   NewColor.Done;
  554. end;
  555.  
  556. procedure TASWindow.CMBCBlue(var Msg:TMessage);
  557. var
  558. NewColor:TColor;
  559. begin
  560.     NewColor.Init(ps_Blue);
  561.   Brush^.SetColor(@NewColor);
  562.   NewColor.Done;
  563. end;
  564.  
  565. procedure TASWindow.CMBCCyan(var Msg:TMessage);
  566. var
  567. NewColor:TColor;
  568. begin
  569.     NewColor.Init(ps_Cyan);
  570.   Brush^.SetColor(@NewColor);
  571.   NewColor.Done;
  572. end;
  573.  
  574. procedure TASWindow.CMBCMagenta(var Msg:TMessage);
  575. var
  576. NewColor:TColor;
  577. begin
  578.     NewColor.Init(ps_Magenta);
  579.   Brush^.SetColor(@NewColor);
  580.   NewColor.Done;
  581. end;
  582.  
  583. procedure TASWindow.CMBCYellow(var Msg:TMessage);
  584. var
  585. NewColor:TColor;
  586. begin
  587.     NewColor.Init(ps_Yellow);
  588.   Brush^.SetColor(@NewColor);
  589.   NewColor.Done;
  590. end;
  591.  
  592. procedure TASWindow.CMFullScreen(var Msg:TMessage);
  593. var
  594.     Style:LongInt;
  595. begin
  596.     If IsFullScreen then
  597.       begin
  598.     Style := GetWindowLong(HWindow,gwl_Style);
  599.     Style := Style or ws_Caption;
  600.     SetWindowLong(HWindow,gwl_Style,Style);
  601.     ShowWindow(HWindow,sw_ShowNormal);
  602.          ShowWindow(hWindow,sw_ShowMaximized);
  603.       IsFullScreen := False;
  604.         end
  605.   else
  606.       begin
  607.     if Attr.Menu > 0 then
  608.         begin
  609.       Setmenu(HWindow,0);
  610.       DestroyMenu(Attr.Menu);
  611.       Attr.Menu := 0;
  612.       end;
  613.     Style := GetWindowLong(HWindow,gwl_Style);
  614.     Style := Style and not ws_Caption;
  615.     SetWindowLong(HWindow,gwl_Style,Style);
  616.       ShowWindow(HWindow,sw_ShowNormal);
  617.          ShowWindow(hWindow,sw_ShowMaximized);
  618.       IsFullScreen := True;
  619.         end;
  620. end;
  621.  
  622. procedure TASWindow.WMChar(var Msg:TMessage);
  623. begin
  624.      case Msg.wParamlo of
  625.       $1B:
  626.         begin
  627.       SendMessage(HWindow,wm_Command,cm_FullScreen,0);
  628.         end;
  629.     67,99:
  630.         begin
  631.       if IconBar = nil then
  632.           begin
  633.           IconBar := New(PASIconBar,Init(@Self,'Control Bar'));
  634.         Application^.MakeWindow(IconBar);
  635.         SetFocus(HWindow);
  636.         end
  637.       else
  638.           begin
  639.         SendMessage(IconBar^.HWindow,wm_Close,0,0);
  640.         IconBar := nil;
  641.         end;
  642.       end;
  643.     end;
  644. end;
  645.  
  646. {WMSysCommand}
  647. procedure    TASWindow.WMSysCommand(var Msg:TMessage);
  648. begin
  649.     case Msg.Wparam of
  650.         idm_About:
  651.             Application^.ExecDialog(New(PDialog,Init(@Self,'AS_About')));
  652.     idm_RunCP:
  653.             begin
  654.         WinExec('Control',1);
  655.         end;
  656.     idm_IconBar:
  657.         begin
  658.       if IconBar = nil then
  659.           begin
  660.           IconBar := New(PASIconBar,Init(@Self,'Control Bar'));
  661.         Application^.MakeWindow(IconBar);
  662.         SetFocus(HWindow);
  663.         end
  664.       else
  665.           begin
  666.         SendMessage(IconBar^.HWindow,wm_Close,0,0);
  667.         IconBar := nil;
  668.         end;
  669.       end;
  670.     idm_MenuBar:
  671.         begin
  672.       if Attr.Menu =  0 then
  673.           begin
  674.             Attr.Menu := loadMenu(HInstance,'AS_Menu');
  675.         SetMenu(HWindow,Attr.Menu);
  676.         end
  677.       else
  678.           begin
  679.         Setmenu(HWindow,0);
  680.           DestroyMenu(Attr.Menu);
  681.         Attr.Menu := 0;
  682.         end;
  683.       end;
  684.        else
  685.            DefWndProc(Msg);
  686.        end;
  687. end;
  688.  
  689. procedure TASWindow.CMFileWin(var Msg:TMessage);
  690. begin
  691.     if (FileWin <> nil) and (FileWin^.HWindow > 0) then
  692.       FileWin^.CMFileBye(Msg);
  693.     FileWin := New(PASFileWin,Init(MainWin,'ArtShow Editor',nil));
  694.   Application^.MakeWindow(FileWin);
  695. end;
  696.  
  697. {*****************************************************************}
  698. {TSlideRec Methods}
  699. constructor TSlideRec.Init(NewFileName:PChar;NewDuration:Integer);
  700. begin
  701.     FileName := StrNew(NewFileName);
  702.   Duration := NewDuration;
  703. end;
  704.  
  705. destructor TSlideRec.Done;
  706. begin
  707.     StrDispose(FileName);
  708. end;
  709.  
  710. {*****************************************************************}
  711. {TASIconBar Methods}
  712.  
  713. constructor TASIconBar.Init(AParent:PWindowsObject;ATitle:PChar);
  714. begin
  715.     TGWindow.Init(AParent,Atitle);
  716.   Attr.Style :=  ws_PopUpWindow or ws_Visible or ws_Caption;
  717.   Bn1 := New(PODButton,Init(@Self,id_Bn1,'Start',0,0,32,20,false,'AS_Bn1'));
  718.   Bn2 := New(PODButton,Init(@Self,id_Bn2,'Stop',32,0,32,20,false,'AS_Bn2'));
  719.   Bn3 := New(PODButton,Init(@Self,id_Bn3,'Back',64,0,32,20,false,'AS_Bn3'));
  720.   Bn4 := New(PODButton,Init(@Self,id_Bn4,'Full Screen',96,0,32,20,false,'AS_Bn4'));
  721.   Bn5 := New(PODButton,Init(@Self,id_Bn5,'Color/Pattern',128,0,32,20,false,'AS_BN5'));
  722.   Bn6 := New(PODButton,Init(@Self,id_Bn6,'FileEdit',160,0,32,20,false,'AS_BN6'));
  723.   HFloatMenu := LoadMenu(HInstance,'AS_FloatMenu');
  724.   HPopUpMenu := GetSubMenu(HFloatMenu,0);
  725. end;
  726.  
  727. destructor TASIconBar.Done;
  728. begin
  729.      Dispose(Bn1,Done);
  730.   Dispose(Bn2,Done);
  731.   Dispose(Bn3,Done);
  732.   Dispose(Bn4,Done);
  733.   Dispose(Bn5,Done);
  734.   Dispose(Bn6,Done);
  735.   DestroyMenu(HFloatMenu);
  736.      TGWindow.Done;
  737.   MainWin^.IconBar := nil;
  738. end;
  739.  
  740. procedure TASIconBar.SetupWindow;
  741. var
  742.   WR,CR:TRect;
  743. begin
  744.   GetClientRect(Parent^.HWindow,CR);
  745.     TGWindow.SetupWindow;
  746. end;
  747.  
  748. procedure TASIconBar.WMSize(var Msg:TMessage);
  749. var
  750.   WR,CR:TRect;
  751.   aPt:TPoint;
  752. begin
  753.   GetClientRect(Parent^.HWindow,CR);
  754.   aPt.X := CR.Right;aPt.Y := CR.Top;
  755.   ClientToScreen(Parent^.HWindow,aPt);
  756.   SetWindowPos(HWindow,0,aPt.X-194,aPt.Y,194,GetSystemMetrics(sm_CYSize)+23,swp_NoZOrder);
  757.   SetFocus(Parent^.HWindow);
  758. end;
  759.  
  760. procedure TASIconBar.WMMove(var Msg:TMessage);
  761. begin
  762.     InvalidateRect(HWindow,nil,True);
  763.   DefWndProc(Msg);
  764. end;
  765.  
  766. procedure TASIconBar.WMNCLButtonDown(var Msg:TMessage);
  767. begin
  768.     DefWndProc(Msg);
  769.   SetFocus(Parent^.HWindow);
  770. end;
  771.  
  772. procedure TASIconBar.WMDrawItem(var Msg:TMessage);
  773. var
  774.     PDIS : ^TDrawItemStruct;
  775. begin
  776.     PDIS := Pointer(Msg.lParam);
  777.     case PDIS^.CtlType of
  778.         odt_Button:
  779.         case PDIS^.CtlID of
  780.             id_Bn1 :Bn1^.DrawItem(Msg);
  781.             id_Bn2 :Bn2^.DrawItem(Msg);
  782.             id_Bn3 :Bn3^.DrawItem(Msg);
  783.              id_Bn4 :Bn4^.DrawItem(Msg);
  784.              id_Bn5 :Bn5^.DrawItem(Msg);
  785.              id_Bn6 :Bn6^.DrawItem(Msg);
  786.         end;
  787.     end;
  788. end;
  789.  
  790. procedure TASIconBar.DefChildProc(var Msg: TMessage);
  791. begin
  792.   TGWindow.DefChildProc(Msg);
  793. end;
  794.  
  795. procedure TASIconBar.WMCommand(var Msg:TMessage);
  796. begin
  797.     case Msg.WParam of
  798.       id_Bn1:IDBN1(Msg);
  799.     id_Bn2:IDBN2(Msg);
  800.     id_Bn3:IDBN3(Msg);
  801.     id_Bn4:IDBn4(Msg);
  802.     id_Bn5:IDBn5(Msg);
  803.     id_Bn6:IDBN6(Msg);
  804.     cm_BPPSolid..cm_BCPYellow:SendMessage(Parent^.HWindow,
  805.             wm_Command,Msg.WParam-400,0);
  806.   end;
  807. end;
  808.  
  809.  
  810. procedure TASIconBar.IDBN1(var Msg:TMessage);
  811. begin
  812.    SetFocus(Parent^.HWindow);  
  813.   if MainWin^.Slides^.Count > 0 then
  814.         SendMessage(Parent^.HWindow,wm_command,cm_Start,0)
  815.   else
  816.       SendMessage(Parent^.HWindow,wm_Command,cm_FileOpen,0);
  817. end;
  818.  
  819. procedure TASIconBar.IDBN2(var Msg:TMessage);
  820. begin
  821.   SetFocus(Parent^.HWindow);
  822.     SendMessage(Parent^.HWindow,wm_command,cm_Stop,0);
  823. end; 
  824.  
  825. procedure TASIconBar.IDBN3(var Msg:TMessage);
  826. begin
  827.   SetFocus(Parent^.HWindow);
  828.     SendMessage(Parent^.HWindow,wm_RButtonDown,0,0);
  829. end;
  830.  
  831. procedure TASIconBar.IDBN4(var Msg:TMessage);
  832. begin
  833.   SetFocus(Parent^.HWindow);
  834.     SendMessage(Parent^.HWindow,wm_command,cm_FullScreen,0);
  835. end;
  836.  
  837. procedure TASIconBar.IDBN5(var Msg:TMessage);
  838. var
  839.     aPoint:TPoint;
  840.   aRect:TRect;
  841. begin
  842.   SetFocus(Parent^.HWindow);
  843.     aPoint.X := 0;
  844.   aPoint.Y := 25;
  845.   ClientToScreen(HWindow,aPoint);
  846.   TrackPopupMenu(HPopUpMenu,0,aPoint.x,aPoint.Y,0,HWindow,nil);
  847. end;
  848.  
  849. procedure TASIconBar.IDBN6(var Msg:TMessage);
  850. begin
  851.     SendMessage(Parent^.HWindow,wm_Command,cm_FileWin,0);
  852. end;
  853.  
  854.  
  855. {*****************************************************************}
  856. constructor TASFileWin.Init(AParent:PWindowsObject;Atitle,AFileName:Pchar);
  857. begin
  858.     TFileWindow.Init(AParent,ATitle,AFileName);
  859.   Attr.X := 100;Attr.Y := 100;
  860.   Attr.W := 500;Attr.H := 300;
  861.   Attr.Style :=  Attr.Style or ws_TiledWindow;
  862.   Attr.Menu := loadMenu(HInstance,'AS_FileCmds');
  863. end;
  864.  
  865. procedure TASFileWin.CMFileBye(var Msg:TMessage);
  866. begin
  867.     SendMessage(HWindow,wm_Close,0,0);
  868. end;
  869.  
  870. destructor TASFileWin.Done;
  871. var
  872.     Msg:TMessage;
  873. begin
  874.     SetFocus(Parent^.HWindow);
  875.   TFileWindow.Done;
  876.   MainWin^.FileWin := nil;
  877.     MainWin^.Slides^.FreeAll;
  878. end;
  879.  
  880. {*****************************************************************}
  881. {M A I N    L I N E }
  882. {*****************************************************************}
  883. var
  884.   ASApp: TASApp;
  885. begin
  886.   ASApp.Init(AS_Name);
  887.   ASApp.Run;
  888.   ASApp.Done;
  889. end.
  890.