home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sibdemo3.zip / SOURCE.DAT / SOURCE / SPCC / MMEDIA.PAS < prev    next >
Pascal/Delphi Source File  |  1998-05-17  |  121KB  |  3,752 lines
  1.  
  2. {╔══════════════════════════════════════════════════════════════════════════╗
  3.  ║                                                                          ║
  4.  ║     Sibyl Portable Component Classes                                     ║
  5.  ║                                                                          ║
  6.  ║     Copyright (c) 1995,97 SpeedSoft Germany,   All rights reserved.      ║
  7.  ║                                                                          ║
  8.  ╚══════════════════════════════════════════════════════════════════════════╝}
  9.  
  10. Unit MMedia;
  11.  
  12.  
  13. Interface
  14.  
  15. {$r MMedia}
  16.  
  17. {$IFDEF OS2}
  18. Uses Os2Def,BseDos,PmWin,PmBitmap;
  19. {$ENDIF}
  20. {$IFDEF Win95}
  21. Uses WinDef,WinBase,WinUser,MMSystem;
  22. {$ENDIF}
  23.  
  24. Uses SysUtils,Messages,Classes,Forms,Graphics,StdCtrls,Dialogs,Buttons;
  25.  
  26.  
  27. Type
  28.     {$M+}
  29.     TMCIStatus=(mciPaused,mciPlaying,mciRewind,mciStopped,mciRecording,
  30.                 mciNothing,mciError);
  31.  
  32.     TMCIDeviceMode=(dmNotReady,dmStopped,dmPlaying,dmSeeking,dmRecording,
  33.                     dmPaused,dmOther,dmUnknown);
  34.  
  35.     TMCINotifyEvents=(mciNotifySuperseded,mciNotifyAborted,mciNotifySuccess,
  36.                       mciNotifyError,mciNotifyPositionChange,mciNotifyCuePoint);
  37.  
  38.     TChannel=(chLeft,chRight,chBoth);
  39.  
  40.     TTimeFormat=(tfMilliseconds,tfMMTime,tfMSF,tfTMSF,tfFrames,tfHMS,tfHMSF,tfBytes,tfSamples,
  41.                  tfSMPTE24,tfSMPTE25,tfSMPTE30,tfSP,tfUnknown);
  42.     TTimeFormats=Set Of TTimeFormat;
  43.     {$M-}
  44.  
  45.     TTimeInfo=Record
  46.          Case Format:TTimeFormat Of
  47.            tfMilliSeconds:(MilliSeconds:LONGWORD);
  48.            tfMMTime:(MMTime:LONGWORD);
  49.            tfMSF:(msf_Minutes,msf_Seconds,msf_Frames,msf_Reserved:BYTE);
  50.            tfTMSF:(tmsf_Track,tmsf_Minutes,tmsf_Seconds,tmsf_Frames:BYTE);
  51.            tfFrames:(Frames:LONGWORD);
  52.            tfHMS:(hms_Hours,hms_Minutes,hms_Seconds,hms_reserved:BYTE);
  53.            tfHMSF:(hmsf_Hours,hmsf_Minutes,hmsf_Seconds,hmsf_Frames:BYTE);
  54.            tfBytes:(Bytes:LONGWORD);
  55.            tfSamples:(Samples:LONGWORD);
  56.            tfSMPTE24:(SMPTE24:LONGWORD);
  57.            tfSMPTE25:(SMPTE25:LONGWORD);
  58.            tfSMPTE30:(SMPTE30:LONGWORD);
  59.            tfSP:(SongPointer:LONGWORD);
  60.            tfUnknown:(Unknown:LONGWORD);
  61.     End;
  62.  
  63.     {$M+}
  64.     TMCIPositionChanged=Procedure(Sender:TObject;Const NewPosition:TTimeInfo) Of Object;
  65.     TMCICuePointReached=Procedure(Sender:TObject;Const NewPosition:TTimeInfo;CuEPOintid:LONGWORD) Of Object;
  66.     {$M-}
  67.  
  68.  
  69.     TCueTypes=(cuOutput,cuInput);
  70.  
  71.     TMCIDevice=Class(TComponent)
  72.       Private
  73.          FDeviceOpen:BOOLEAN;
  74.          FAliasName:PSTRING;
  75.          FDeviceName:PSTRING;
  76.          FStatus:TMCIStatus;
  77.          FNotifyControl:TControl;
  78.          FFileLoaded:BOOLEAN;
  79.          FFileName:PString;
  80.          FFileNameRequired:BOOLEAN;
  81.          FLastMCIReturn:String;
  82.          FTimeFormatsAvailable:TTimeFormats;
  83.          FTimeFormat:TTimeFormat;
  84.          FDefaultTimeFormat:TTimeFormat;
  85.          FPositionAdvise:BOOLEAN;
  86.          FPositionAdviseUnits:TTimeInfo;
  87.          FCuePointCount:WORD;
  88.          FOnPlayingCompleted:TNotifyEvent;
  89.          FOnPlayingAborted:TNotifyEvent;
  90.          FOnPositionChanged:TMCIPositionChanged;
  91.          FOnCuePointReached:TMCICuePointReached;
  92.       Private
  93.          Procedure ShowMCIError(Code:LONGWORD);
  94.          Procedure SetDeviceName(NewName:String);
  95.          Function GetDeviceName:String;
  96.          Procedure SetAliasName(NewName:String);
  97.          Function GetAliasName:String;
  98.          Procedure SetTimeFormat(NewFormat:TTimeFormat);
  99.          Function TimeInfoStr(TimeInfo:TTimeInfo;SaveTime:TTimeFormat):String;
  100.  
  101.          Function GetMCIStatusNumber(Const option:String):LONGINT;
  102.          Function GetMCIStatusBoolean(Const option:String):BOOLEAN;
  103.          Function GetMCICapBoolean(Const Option:String):BOOLEAN;
  104.          Function GetMCICapLong(Const Option:String):LONGWORD;
  105.          Function GetMCITimeInfo(Const option:String):TTimeInfo;
  106.  
  107.          Function GetChannels:LONGINT;
  108.          Function GetVolume(Channel:TChannel):LONGINT;
  109.          Procedure SetVolume(Channel:TChannel;NewVolume:LONGINT);
  110.          Function GetCurrentTrack:LONGINT;
  111.          Function GetTrackLength(Track:LONGINT):TTimeInfo;
  112.          Function GetTracks:LONGINT;
  113.          Function GetMediaPresent:BOOLEAN;
  114.          Function GetDeviceReady:BOOLEAN;
  115.          Function GetPosition:TTimeInfo;
  116.          Function GetLength:TTimeInfo;
  117.          Function GetDeviceMode:TMCIDeviceMode;
  118.          Function GetDeviceId:LONGWORD;
  119.          Procedure SetPositionAdvise(NewValue:BOOLEAN);
  120.          Procedure SetPositionAdviseUnits(NewUnits:TTimeInfo);
  121.          Procedure SetFileName(Const NewValue:String);
  122.          Function GetFileName:String;
  123.          Function GetCanEject:BOOLEAN;
  124.          Function GetCanPlay:BOOLEAN;
  125.          Function GetCanRecord:BOOLEAN;
  126.          Function GetCanSave:BOOLEAN;
  127.          Function GetCanLockEject:BOOLEAN;
  128.          Function GetCanSetVolume:BOOLEAN;
  129.          Function GetHasAudio:BOOLEAN;
  130.          Function GetHasVideo:BOOLEAN;
  131.          Function GetUsesFiles:BOOLEAN;
  132.       Protected
  133.          Procedure SetupComponent;Override;
  134.          Procedure HandleMCIError(Const ErrorStr:String);Virtual;
  135.          Procedure MCIEvent(Event:TMCINotifyEvents;ulDeviceId,ulNotifyCode,ulUsErCode:LONGWORD);Virtual;
  136.          Procedure PositionChanged(Const NewPosition:TTimeInfo);Virtual;
  137.          Procedure CuePointReached(Const CuePoint:TTimeInfo;CuePointId:LONGWORD);Virtual;
  138.          Procedure PlayingCompleted;Virtual;
  139.          Procedure PlayingAborted;Virtual;
  140.       Protected
  141.          Property FileNameRequired:BOOLEAN read FFileNameRequired write FFileNameRequired;
  142.       Public
  143.          Procedure GetDefaultFileMask(Var Ext,Description:String);Virtual;
  144.          Procedure Load;Virtual;
  145.          Procedure Play;Virtual;
  146.          Procedure Pause;Virtual;
  147.          Procedure Stop;Virtual;
  148.          Procedure Resume;Virtual;
  149.          Procedure StartRecording;Virtual;
  150.          Procedure SeekToStart;Virtual;
  151.          Procedure SeekToEnd;Virtual;
  152.          Procedure Seek(NewPos:TTimeInfo);Virtual;
  153.          Procedure OpenDevice;Virtual;
  154.          Procedure CloseDevice;Virtual;
  155.          Procedure NextTrack;Virtual;
  156.          Procedure PreviousTrack;Virtual;
  157.          Destructor Destroy;Override;
  158.          Function AddCuePoint(Const CuePoint:TTimeInfo):LONGWORD;
  159.          Function DeleteCuePoint(Const CuePoint:TTimeInfo):BOOLEAN;
  160.          Function SendString(Const s:String;usUserParm:WORD):BOOLEAN;Virtual;
  161.          Function WriteSCUResource(Stream:TResourceStream):BOOLEAN;Override;
  162.          Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LOngint);Override;
  163.          Function Cue(CueFor:TCueTypes):BOOLEAN;
  164.          Procedure Cut(StartPos,EndPos:TTimeInfo);
  165.          Procedure Copy(StartPos,EndPos:TTimeInfo);
  166.          Procedure Paste(StartPos,EndPos:TTimeInfo);
  167.       Public
  168.          Property Status:TMCIStatus read FStatus;
  169.          Property Channels:LONGINT read GetChannels;
  170.          Property Volume[Channel:TChannel]:LONGINT read GetVolume write SetVolume;
  171.          Property CurrentTrack:LONGINT read GetCurrentTrack;
  172.          Property TrackLength[Track:LONGINT]:TTimeInfo read GetTrackLength;
  173.          Property Tracks:LONGINT read GetTracks;
  174.          Property MediaPresent:BOOLEAN read GetMediaPresent;
  175.          Property DeviceReady:BOOLEAN read GetDeviceReady;
  176.          Property Position:TTimeInfo read GetPosition write Seek;
  177.          Property Length:TTimeInfo read GetLength;
  178.          Property DeviceMode:TMCIDeviceMode read GetDeviceMode;
  179.          Property DeviceId:LONGWORD read GetDeviceId;
  180.          Property PositionAdviseUnits:TTimeInfo read FPositionAdviseUnits write SeTpositiOnadviseUNits;
  181.          Property LastMCIReturn:String read FLastMCIReturn;
  182.          Property PositionAdvise:BOOLEAN read FPositionAdvise write SetPositionAdvIse;
  183.          Property TimeFormatsAvailable:TTimeFormats read FTimeFormatsAvailable;
  184.          Property DefaultTimeFormat:TTimeFormat read FDefaultTimeFormat;
  185.          Property DeviceOpen:BOOLEAN read FDeviceOpen;
  186.          Property CanEject:BOOLEAN read GetCanEject;
  187.          Property CanPlay:BOOLEAN read GetCanPlay;
  188.          Property CanRecord:BOOLEAN read GetCanRecord;
  189.          Property CanSave:BOOLEAN read GetCanSave;
  190.          Property CanLockEject:BOOLEAN read GetCanLockEject;
  191.          Property CanSetVolume:BOOLEAN read GetCanSetVolume;
  192.          Property HasAudio:BOOLEAN read GetHasAudio;
  193.          Property HasVideo:BOOLEAN read GetHasVideo;
  194.          Property UsesFiles:BOOLEAN read GetUsesFiles;
  195.       Published
  196.          Property OnPlayingAborted:TNotifyEvent read FOnPlayingAborted write FOnPlAyinGAbOrted;
  197.          Property OnPlayingCompleted:TNotifyEvent read FOnPlayingCompleted write FOnplAyiNgcompLetEd;
  198.          Property OnPositionChanged:TMCIPositionChanged read FOnPositionChanged wrIte FOnPositiOnCHanGed;
  199.          Property OnCuePointReached:TMCICuePointReached read FOnCuePointReached wrIte FOnCuepoiNtREacHed;
  200.          Property FileName:String read GetFileName write SetFileName;
  201.          Property DeviceName:String read GetDeviceName write SetDeviceName;
  202.          Property AliasName:String read GetAliasName write SetAliasName;
  203.          Property TimeFormat:TTimeFormat read FTimeFormat write SetTimeFormat;
  204.     End;
  205.  
  206.     TVideoDeviceCapabilities=Record
  207.          CanDistort:BOOLEAN;
  208.          CanProcessInternal:BOOLEAN;
  209.          CanRecordInsert:BOOLEAN;
  210.          CanStream:BOOLEAN;
  211.          CanStretch:BOOLEAN;
  212.          FastPlayRate:LONGWORD;
  213.          HasTuner:BOOLEAN;
  214.          HorizontalVideoExtent:LONGWORD;
  215.          HorizontalImageExtent:LONGWORD;
  216.          NormalPlayRate:LONGWORD;
  217.          SlowPlayRate:LONGWORD;
  218.          VerticalImageExtent:LONGWORD;
  219.          VerticalVideoExtent:LONGWORD;
  220.     End;
  221.  
  222.  
  223.     TVideoDevice=Class(TMCIDevice)
  224.       Private
  225.          FVideoWindow:TControl;
  226.       Private
  227.          Function GetCapabilities:TVideoDeviceCapabilities;
  228.          Function GetBitsPerSample:LONGINT;
  229.          Function GetImageBitsPerPel:LONGINT;
  230.          Function GetImagePelFormat:String;
  231.          Function GetBrightness:LONGINT;
  232.          Function GetContrast:LONGINT;
  233.          Function GetHue:LONGINT;
  234.          Function GetClipBoardDataAvail:BOOLEAN;
  235.          Function GetSaturation:LONGINT;
  236.          Function GetSamplesPerSec:LONGINT;
  237.          Function GetTunerTVChannel:LONGINT;
  238.          Function GetTunerFineTune:LONGINT;
  239.          Function GetTunerFrequency:LONGINT;
  240.          Function GetValidSignal:BOOLEAN;
  241.          Procedure SetBrightness(NewValue:LONGINT);
  242.          Procedure SetContrast(NewValue:LONGINT);
  243.          Procedure SetHue(NewValue:LONGINT);
  244.          Procedure SetSaturation(NewValue:LONGINT);
  245.          Procedure SetSamplesPerSec(NewValue:LONGINT);
  246.          Procedure SetTunerTVChannel(NewValue:LONGINT);
  247.          Procedure SetTunerFineTune(NewValue:LONGINT);
  248.          Procedure SetTunerFrequency(NewValue:LONGINT);
  249.       Private
  250.          Property DeviceName;
  251.       Protected
  252.          Procedure SetupComponent;Override;
  253.          Procedure GetDefaultFileMask(Var Ext,Description:String);Override;
  254.       Public
  255.          Procedure Seek(NewPos:TTimeInfo);Override;
  256.          Procedure SeekToStart;Override;
  257.          Procedure Load;Override;
  258.          Property Capabilities:TVideoDeviceCapabilities read GetCapabilities;
  259.          Property BitsPerSample:LONGINT read GetBitsPerSample;
  260.          Property ImageBitsPerPel:LONGINT read GetImageBitsPerPel;
  261.          Property ImagePelFormat:String read GetImagePelFormat;
  262.          Property Brightness:LONGINT read GetBrightness write SetBrightness;
  263.          Property Contrast:LONGINT read GetContrast write SetContrast;
  264.          Property Hue:LONGINT read GetHue write SetHue;
  265.          Property ClipBoardDataAvail:BOOLEAN read GetClipBoardDataAvail;
  266.          Property Saturation:LONGINT read GetSaturation write SetSaturation;
  267.          Property SamplesPerSec:LONGINT read GetSamplesPerSec write SetSamplesPerSEc;
  268.          Property TunerTVChannel:LONGINT read GetTunerTVChannel write SetTunerTVChAnneL;
  269.          Property TunerFineTune:LONGINT read GetTunerFineTune write SetTunerFineTuNe;
  270.          Property TunerFrequency:LONGINT read GetTunerFrequency write SetTunerFreqUencY;
  271.          Property ValidSignal:BOOLEAN read GetValidSignal;
  272.       Public
  273.          Property AliasName;
  274.     End;
  275.  
  276.     TAudioDevice=Class(TMCIDevice)
  277.       Private
  278.          Function GetAlignment:LONGINT;
  279.          Function GetBitsPerSample:LONGINT;
  280.          Function GetBytesPerSec:LONGINT;
  281.          Function GetSamplesPerSec:LONGINT;
  282.          Procedure SetBitsPerSample(NewValue:LONGINT);
  283.          Procedure SetBytesPerSec(NewValue:LONGINT);
  284.          Procedure SetSamplesPerSec(NewValue:LONGINT);
  285.       Private
  286.          Property DeviceName;
  287.       Protected
  288.          Procedure SetupComponent;Override;
  289.          Procedure GetDefaultFileMask(Var Ext,Description:String);Override;
  290.       Public
  291.          Property Alignment:LONGINT read GetAlignment;
  292.          Property BitsPerSample:LONGINT read GetBitsPerSample write SetBitsPerSampLe;
  293.          Property BytesPerSec:LONGINT read GetBytesPerSec write SetBytesPerSec;
  294.          Property SamplesPerSec:LONGINT read GetSamplesPerSec write SetSamplesPerSEc;
  295.       Public
  296.          Property AliasName;
  297.     End;
  298.  
  299.  
  300.     TCDMediaTypes=(mtAudio,mtData,mtOther,mtUnknown);
  301.  
  302.     TCDDeviceCapabilities=Record
  303.          CanProcessInternal:BOOLEAN;
  304.          CanStream:BOOLEAN;
  305.     End;
  306.  
  307.     TCDDevice=Class(TMCIDevice)
  308.       Private
  309.          Function GetTrackChannels(Track:LONGINT):LONGINT;
  310.          Function GetTrackPosition(Track:LONGINT):TTimeInfo;
  311.          Function GetPositionInTrack:TTimeInfo;
  312.          Function GetStartPosition:TTimeInfo;
  313.          Function GetMediaType:TCDMediaTypes;
  314.          Function GetTrackType(Track:LONGINT):TCDMediaTypes;
  315.          Function GetCapabilities:TCDDeviceCapabilities;
  316.       Private
  317.          Property DeviceName;
  318.          Property FileName;
  319.       Protected
  320.          Procedure SetupComponent;Override;
  321.       Public
  322.          Procedure Eject;Virtual;
  323.          Procedure Close;Virtual;
  324.          Procedure LockDoor;Virtual;
  325.          Procedure UnlockDoor;Virtual;
  326.          Procedure NextTrack;Override;
  327.          Procedure PreviousTrack;Override;
  328.       Public
  329.          Property TrackChannels[Track:LONGINT]:LONGINT read GetTrackChannels;
  330.          Property TrackPosition[Track:LONGINT]:TTimeInfo read GetTrackPosition;
  331.          Property PositionInTrack:TTimeInfo read GetPositionInTrack;
  332.          Property StartPosition:TTimeInfo read GetStartPosition;
  333.          Property MediaType:TCDMediaTypes read GetMediaType;
  334.          Property TrackType[Track:LONGINT]:TCDMediaTypes read GetTrackType;
  335.          Property Capabilities:TCDDeviceCapabilities read GetCapabilities;
  336.          Property AliasName;
  337.     End;
  338.  
  339.  
  340.     TVideoWindow=Class(TControl)
  341.       Private
  342.          FVideoDevice:TVideoDevice;
  343.          hwndFrame:HWND;
  344.          ulMovieWidth,ulMovieHeight,ulMovieLength:LONGWORD;
  345.          FOnPlayingCompleted:TNotifyEvent;
  346.          FOnPlayingAborted:TNotifyEvent;
  347.          FOnPositionChanged:TMCIPositionChanged;
  348.          FOnCuePointReached:TMCICuePointReached;
  349.       Private
  350.          Function DoesFileExist(pszFileName:String):BOOLEAN;
  351.          Procedure SetVideoDevice(NewDevice:TVideoDevice);
  352.       Protected
  353.          Procedure SetupComponent;Override;
  354.          Procedure PositionChanged(Const NewPosition:TTimeInfo);Virtual;
  355.          Procedure CuePointReached(Const CuePoint:TTimeInfo;CuePointId:LONGWORD);Virtual;
  356.          Procedure PlayingCompleted;Virtual;
  357.          Procedure PlayingAborted;Virtual;
  358.          Procedure Notification(AComponent:TComponent;Operation:TOperation);Override;
  359.          Procedure MCIEvent(Event:TMCINotifyEvents;ulDeviceId,ulNotifyCode,ulUsErcode:LoNGword);Virtual;
  360.       Public
  361.          Procedure Redraw(Const rc:TRect);Override;
  362.          Property XAlign;
  363.          Property XStretch;
  364.          Property YAlign;
  365.          Property YStretch;
  366.       Published
  367.          Property Align;
  368.          Property DragCursor;
  369.          Property DragMode;
  370.          Property Enabled;
  371.          Property ParentShowHint;
  372.          Property ShowHint;
  373.          Property VideoDevice:TVideoDevice read FVideoDevice write SetVideoDeviCe;
  374.          Property Visible;
  375.          Property ZOrder;
  376.  
  377.          Property OnCanDrag;
  378.          Property OnCuePointReached:TMCICuePointReached read FOnCuePointReached wrIte FonCuepoinTreached;
  379.          Property OnDragDrop;
  380.          Property OnDragOver;
  381.          Property OnEndDrag;
  382.          Property OnEnter;
  383.          Property OnExit;
  384.          Property OnMouseClick;
  385.          Property OnMouseDblClick;
  386.          Property OnMouseDown;
  387.          Property OnMouseMove;
  388.          Property OnMouseUp;
  389.          Property OnPlayingAborted:TNotifyEvent read FOnPlayingAborted write FONplAyinGabOrted;
  390.          Property OnPlayingCompleted:TNotifyEvent read FOnPlayingCompleted writE FOnPlAyiNgcomplEted;
  391.          Property OnPositionChanged:TMCIPositionChanged read FOnPositionChanged wrIte FonPositioNchanGed;
  392.          Property OnSetupShow;
  393.          Property OnStartDrag;
  394.     End;
  395.  
  396.     TVolumeControl=Class(TControl)
  397.       Private
  398.          FPosition:BYTE;
  399.          FTimerEndPos:LONGINT;
  400.          FAngleTimer:TTimer;
  401.          FHasCapture:BOOLEAN;
  402.          FOnPositionChanged:TNotifyEvent;
  403.          Procedure DrawSlider;
  404.          Procedure DrawBoxes;
  405.          Procedure SetPosition(NewPosition:BYTE);
  406.          Procedure GetCircleParams(Var MiddleX,MiddleY,CircleRadius:LONGINT);
  407.          Function InsideCircle(MiddleX,MiddleY,Radius:LONGINT;Const pt:TPoint;Var AnglE:LOnginT):BooLEaN;
  408.          Procedure EvTimer(Sender:TObject);
  409.       Protected
  410.          Procedure SetupComponent;Override;
  411.          Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LONGiNT);Override;
  412.          Procedure MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LONGINt);Override;
  413.          Procedure MouseMove(ShiftState:TShiftState;X,Y:LONGINT);Override;
  414.          Procedure PositionChanged;Virtual;
  415.          Property Cursor;
  416.       Public
  417.          Procedure Redraw(Const rec:TRect);Override;
  418.          Destructor Destroy;Override;
  419.          Property XAlign;
  420.          Property XStretch;
  421.          Property YAlign;
  422.          Property YStretch;
  423.       Published
  424.          Property Align;
  425.          Property Color;
  426.          Property PenColor;
  427.          Property DragCursor;
  428.          Property DragMode;
  429.          Property Enabled;
  430.          Property ParentColor;
  431.          Property ParentPenColor;
  432.          Property ParentShowHint;
  433.          Property Position:BYTE read FPosition write SetPosition;
  434.          Property ShowHint;
  435.          Property TabOrder;
  436.          Property TabStop;
  437.          Property Visible;
  438.          Property ZOrder;
  439.  
  440.          Property OnCanDrag;
  441.          Property OnDragDrop;
  442.          Property OnDragOver;
  443.          Property OnEndDrag;
  444.          Property OnEnter;
  445.          Property OnExit;
  446.          Property OnPositionChanged:TNotifyEvent read FOnPositionChanged write FonPOsitionchAnged;
  447.          Property OnSetupShow;
  448.          Property OnStartDrag;
  449.     End;
  450.  
  451.     {$M+}
  452.     TMPBtnType=(btPlay, btPause, btStop, btNext, btPrev, btStep, btBack,
  453.                 btRecord, btEject, btRewind);
  454.     TMPButtonSet=Set Of TMPBtnType;
  455.  
  456.     EMPNotify=Procedure(Sender:TObject;Button:TMPBtnType;Var DoDefault:BOOLEAN) of Object;
  457.  
  458.     TMPDeviceTypes=(dtAutoSelect,dtAVIVideo,dtCDAudio,dtDAT,dtDigitalVideo,
  459.                     dtMMMovie,dtOther,dtOverlay,dtScanner,dtSequencer,
  460.                     dtVCR,dtVideoDisc,dtWaveAudio);
  461.     {$M-}
  462.  
  463.     TMediaPlayer=Class(TControl)
  464.       Private
  465.          FButtons:Array[TMPBtnType] Of TBitBtn;
  466.          FFrames:LONGINT;
  467.          FPlayButton:TAnimatedButton;
  468.          FRecordButton:TAnimatedButton;
  469.          FVisibleButtons:TMPButtonSet;
  470.          FEnabledButtons:TMPButtonSet;
  471.          FFileName:PString;
  472.          FUseAnimation:BOOLEAN;
  473.          FMCIDevice:TMCIDevice;
  474.          FOpened:BOOLEAN;
  475.          FOnClick:EMPNotify;
  476.          FOnPlayingCompleted:TNotifyEvent;
  477.          FOnPlayingAborted:TNotifyEvent;
  478.          FOnPositionChanged:TMCIPositionChanged;
  479.          FOnCuePointReached:TMCICuePointReached;
  480.          FDestroyMCIDev:BOOLEAN;
  481.          FDeviceType:TMPDeviceTypes;
  482.          Procedure SetVisibleButtons(NewState:TMPButtonSet);
  483.          Procedure SetEnabledButtons(NewState:TMPButtonSet);
  484.          Function GetFileName:String;
  485.          Procedure SetFileName(NewName:String);
  486.          Procedure SetMCIDevice(NewDevice:TMCIDevice);
  487.          Function GetButton(Index:TMPBtnType):TBitBtn;
  488.          Procedure EvButtonClick(Sender:TObject);
  489.          Procedure SetDeviceType(NewValue:TMPDeviceTypes);
  490.       Protected
  491.          Procedure SetupComponent;Override;
  492.          Procedure CreateWnd;Override;
  493.          Procedure RealignControls;Override;
  494.          Procedure PositionChanged(Const NewPosition:TTimeInfo);Virtual;
  495.          Procedure CuePointReached(Const CuePoint:TTimeInfo;CuePointId:LONGWORD);Virtual;
  496.          Procedure PlayingAborted;Virtual;
  497.          Procedure PlayingCompleted;Virtual;
  498.          Procedure Notification(AComponent:TComponent;Operation:TOperation);Override;
  499.          Procedure MCIEvent(Event:TMCINotifyEvents;ulDeviceId,ulNotifyCode,ulUsErcode:LoNGWORD);Virtual;
  500.          Property Buttons[Index:TMPBtnType]:TBitBtn read GetButton;
  501.          Property Hint;
  502.          Property Cursor;
  503.       Public
  504.          Destructor Destroy;Override;
  505.          Procedure Open;Virtual;
  506.          Procedure Play;Virtual;
  507.          Procedure StartRecording;Virtual;
  508.          Procedure Stop;Virtual;
  509.          Procedure Pause;Virtual;
  510.          Procedure Close;Virtual;
  511.          Procedure Rewind;Virtual;
  512.          Procedure Next;Virtual;
  513.          Procedure Previous;Virtual;
  514.          Procedure Step;Virtual;
  515.          Procedure Back;Virtual;
  516.          Procedure Eject;Virtual;
  517.          Property XAlign;
  518.          Property XStretch;
  519.          Property YAlign;
  520.          Property YStretch;
  521.       Published
  522.          Property Align;
  523.          Property DragCursor;
  524.          Property DragMode;
  525.          Property Enabled;
  526.          Property DeviceType:TMPDeviceTypes read FDeviceType write SetDeviceTypE;
  527.          Property EnabledButtons:TMPButtonSet read FEnabledButtons write SetEnaBlEdbutTons;
  528.          Property FileName:String read GetFileName write SetFileName;
  529.          Property Frames:LONGINT read FFrames write FFrames;
  530.          Property MCIDevice:TMCIDevice read FMCIDevice write SetMCIDevice;
  531.          Property ParentShowHint;
  532.          Property ShowHint;
  533.          Property TabOrder;
  534.          Property TabStop;
  535.          Property UseAnimation:BOOLEAN read FUseAnimation write FUseAnimation;
  536.          Property Visible;
  537.          Property VisibleButtons:TMPButtonSet read FVisibleButtons write SetVisIbLebutTons;
  538.          Property ZOrder;
  539.  
  540.          Property OnCanDrag;
  541.          Property OnClick:EMPNotify read FOnClick write FOnClick;
  542.          Property OnCuePointReached:TMCICuePointReached read FOnCuePointReached wRite FonCuePoinTreached;
  543.          Property OnDragDrop;
  544.          Property OnDragOver;
  545.          Property OnEndDrag;
  546.          Property OnEnter;
  547.          Property OnExit;
  548.          Property OnPlayingAborted:TNotifyEvent read FOnPlayingAborted write FONPLayinGabortEd;
  549.          Property OnPlayingCompleted:TNotifyEvent  read FOnPlayingCompleted wriTe fonPLayingCompLeted;
  550.          Property OnPositionChanged:TMCIPositionChanged read FOnPositionChanged wRite FonPosItioNchangEd;
  551.          Property OnResize;
  552.          Property OnSetupShow;
  553.          Property OnStartDrag;
  554.     End;
  555.  
  556.  
  557. Function TimeFormatToString(tf:TTimeFormat):String;
  558. Function DeviceModeToString(dm:TMCIDeviceMode):String;
  559. Function MediaTypeToString(mt:TCDMediaTypes):String;
  560. Function ConvertTimeInfo(Var TimeInfo:TTimeInfo;NewFormat:TTimeFormat):BOOLEAN;
  561. Function CompareTimeInfos(TimeInfo1,TimeInfo2:TTimeInfo):LONGINT;
  562. Function TimeInfoToString(Const TimeInfo:TTimeInfo):String;
  563.  
  564. Implementation
  565.  
  566. Type
  567.     TMCINotifyControl=Class(TControl)
  568.       Private
  569.          FDevice:TMCIDevice;
  570.          {$IFDEF WIN95}
  571.          Procedure MMMCINotify(Var Msg:TMessage); Message $3B9; {MM_MCINOTIFY;}
  572.          {PROCEDURE MMMCIPositionChange(VAR Msg:TMessage); message MM_MCIPOSITIONCHANGE; ???
  573.          Procedure MMMCICuePoint(Var Msg:TMessage); Message MM_MCICUEPOINT; ???}
  574.          {$ENDIF}
  575.          {$IFDEF OS2}
  576.          Procedure MMMCINotify(Var Msg:TMessage); Message $0500; {MM_MCINOTIFY;}
  577.          Procedure MMMCIPositionChange(Var Msg:TMessage); Message $0502; {MM_MCIPOSITIONCHANGE;}
  578.          Procedure MMMCICuePoint(Var Msg:TMessage); Message $0503; {MM_MCICUEPOINT;}
  579.          {$ENDIF}
  580.          Procedure CreateWnd;Override;
  581.       Protected
  582.          Procedure SetupComponent;Override;
  583.     End;
  584.  
  585.  
  586. Procedure TMCINotifyControl.CreateWnd; //dummy
  587. Begin
  588.     Inherited CreateWnd;
  589. End;
  590.  
  591. Procedure TMCINotifyControl.SetupComponent;
  592. Begin
  593.      Inherited SetupComponent;
  594.      Include (ComponentState, csDetail);
  595. End;
  596.  
  597. Procedure TMCINotifyControl.MMMCINotify(Var Msg:TMessage);
  598. Var usNotifyCode,usCommandMessage:WORD;
  599.     Event:TMCINotifyEvents;
  600.     usDeviceId:WORD;
  601.     usUserCode:WORD;
  602. {$IFDEF Win95}
  603. Const
  604.      MCI_NOTIFY_SUCCESSFUL  =$0001;
  605.      MCI_NOTIFY_SUPERSEDED  =$0002;
  606.      MCI_NOTIFY_ABORTED     =$0004;
  607. {$ENDIF}
  608. {$IFDEF OS2}
  609. Const
  610.       MCI_NOTIFY_SUCCESSFUL =$0000;
  611.       MCI_NOTIFY_SUPERSEDED =$0001;
  612.       MCI_NOTIFY_ABORTED    =$0002;
  613. {$ENDIF}
  614. Begin
  615.      {$IFDEF OS2}
  616.      usNotifyCode:=Msg.Param1Lo;
  617.      usCommandMessage:=Msg.Param2Hi;
  618.      usDeviceId:=Msg.Param2Lo;
  619.      usUserCode:=Msg.Param1Hi;
  620.  
  621.      Case usNotifyCode Of
  622.         MCI_NOTIFY_SUPERSEDED:Event:=mciNotifySuperseded;
  623.         MCI_NOTIFY_ABORTED:Event:=mciNotifyAborted;
  624.         MCI_NOTIFY_SUCCESSFUL:Event:=mciNotifySuccess;
  625.         Else Event:=mciNotifyError;
  626.      End; {case}
  627.      {$ENDIF}
  628.      {$IFDEF Win95}
  629.      usNotifyCode:=0; {??}
  630.      usDeviceId:=0;   {??}
  631.      usUserCode:=0;   {??}
  632.  
  633.      Case Msg.Param1 Of
  634.          MCI_NOTIFY_SUPERSEDED:Event:=mciNotifySuperseded;
  635.          MCI_NOTIFY_ABORTED:Event:=mciNotifyAborted;
  636.          MCI_NOTIFY_SUCCESSFUL:Event:=mciNotifySuccess;
  637.          Else Event:=mciNotifyError;
  638.      End; {case}
  639.      {$ENDIF}
  640.      FDevice.MCIEvent(Event,usDeviceid,usNotifyCode,usUserCode);
  641.      Msg.Handled:=TRUE;
  642.      Msg.Result:=0;
  643. End;
  644.  
  645.  
  646. {$IFDEF OS2}
  647. Procedure TMCINotifyControl.MMMCIPositionChange(Var Msg:TMessage);
  648. Var usDeviceId:WORD;
  649.     usUserCode:WORD;
  650.     ulmmTime:LONGWORD;
  651. Begin
  652.      {$IFDEF OS2}
  653.      usDeviceId:=Msg.Param1Hi;
  654.      usUserCode:=Msg.Param1Lo;
  655.      ulmmTime:=Msg.Param2;
  656.      {$ENDIF}
  657.      {$IFDEF Win95}
  658.      ???
  659.      {$ENDIF}
  660.      FDevice.MCIEvent(mciNotifyPositionChange,usDeviceid,ulmmTime,usUserCode);
  661.      Msg.Handled:=TRUE;
  662.      Msg.Result:=0;
  663. End;
  664.  
  665.  
  666. Procedure TMCINotifyControl.MMMCICuePoint(Var Msg:TMessage);
  667. Var usDeviceId:WORD;
  668.     ulmmTime:LONGWORD;
  669.     usUserCode:WORD;
  670. Begin
  671.      {$IFDEF OS2}
  672.      usDeviceId:=Msg.Param1Hi;
  673.      ulmmTime:=Msg.Param2;
  674.      usUserCode:=Msg.Param1Lo;
  675.      {$ENDIF}
  676.      {$IFDEF Win95}
  677.      ???
  678.      {$ENDIF}
  679.      FDevice.MCIEvent(mciNotifyCuePoint,usDeviceid,ulmmTime,usUserCode);
  680.      Msg.Handled:=TRUE;
  681.      Msg.Result:=0;
  682. End;
  683. {$ENDIF}
  684.  
  685.  
  686. {$IFDEF OS2}
  687. Const
  688.     MCIERR_SUCCESS=0;
  689.  
  690. Type
  691.     PMMTRACKINFO=^MMTRACKINFO;
  692.     MMTRACKINFO=Record
  693.                       ulTrackID:LONGWORD;
  694.                       ulMediaType:LONGWORD;
  695.                       ulCountry:LONGWORD;
  696.                       ulCodePage:LONGWORD;
  697.                       ulReserved1:LONGWORD;
  698.                       ulReserved2:LONGWORD;
  699.     End;
  700.  
  701.  
  702.     PMMMOVIEHEADER=^MMMOVIEHEADER;
  703.     MMMOVIEHEADER=Record
  704.                         ulStructLen:LONGWORD;
  705.                         ulContentType:LONGWORD;
  706.                         ulMediaType:LONGWORD;
  707.                         ulMovieCapsFlags:LONGWORD;
  708.                         ulMaxBytesPerSec:LONGWORD;
  709.                         ulPaddingGranularity:LONGWORD;
  710.                         ulSuggestedBufferSize:LONGWORD;
  711.                         ulStart:LONGWORD;
  712.                         ulLength:LONGWORD;
  713.                         ulNextTrackID:LONGWORD;
  714.                         ulNumEntries:LONGWORD;
  715.                         pmmTrackInfoList:PMMTRACKINFO;
  716.                         pszMovieTitle:PChar;
  717.                         ulCountry:LONGWORD;
  718.                         ulCodePage:LONGWORD;
  719.                         ulAvgBytesPerSec:LONGWORD;
  720.    End;
  721.  
  722.    PMMTIME=^MMTIME;
  723.    MMTIME=LONGWORD;
  724.  
  725.    PGENPAL=^GENPAL;
  726.    GENPAL=Record
  727.                 ulStartIndex:ULONG;
  728.                 ulNumColors:ULONG;
  729.                 prgb2Entries:PRGB2;
  730.    End;
  731.  
  732.    XDIBHDR_PREFIX=Record
  733.                          ulMemSize:LONGWORD;
  734.                          ulPelFormat:LONGWORD;
  735.                          usTransType:WORD;
  736.                          ulTransVal:LONGWORD;
  737.     End;
  738.  
  739.     PMMXDIBHEADER=^MMXDIBHEADER;
  740.     MMXDIBHEADER=Record
  741.                        XDIBHeaderPrefix:XDIBHDR_PREFIX;
  742.                        BMPInfoHeader2:BITMAPINFOHEADER2;
  743.     End;
  744.  
  745.    PMMVIDEOHEADER=^MMVIDEOHEADER;
  746.    MMVIDEOHEADER=Record
  747.                         ulStructLen:LONGWORD;
  748.                         ulContentType:LONGWORD;
  749.                         ulMediaType:LONGWORD;
  750.                         ulVideoCapsFlags:LONGWORD;
  751.                         ulWidth:LONGWORD;
  752.                         ulHeight:LONGWORD;
  753.                         ulScale:LONGWORD;
  754.                         ulRate:LONGWORD;
  755.                         ulStart:LONGWORD;
  756.                         ulLength:LONGWORD;
  757.                         ulTotalFrames:LONGWORD;
  758.                         ulInitialFrames:LONGWORD;
  759.                         mmtimePerFrame:MMTIME;
  760.                         ulSuggestedBufferSize:LONGWORD;
  761.                         genpalVideo:GENPAL;
  762.                         pmmXDIBHeader:PMMXDIBHEADER;
  763.     End;
  764.  
  765. Const
  766.       CODEC_INFO_SIZE    =8;
  767.       CODEC_HW_NAME_SIZE =32;
  768.       DLLNAME_SIZE       =CCHMAXPATH;
  769.       PROCNAME_SIZE      =32;
  770.       MAX_EXTENSION_NAME =4;
  771.       MMIO_SUCCESS                   = 0;
  772.       MMIO_WARNING                   = 2;
  773.       MMIO_ERROR                     =-1;
  774.       MMIOERR_UNSUPPORTED_MESSAGE    =-2;
  775.       MMIO_TRANSLATEHEADER     =$00000002; /* Translation */
  776.       MMIO_TRACK                =$00000001;
  777.       MMIO_NORMAL_READ          =$00000002;
  778.       MMIO_SCAN_READ            =$00000004;
  779.       MMIO_REVERSE_READ         =$00000008;
  780.       MMIO_CODEC_ASSOC          =$00000100;
  781.       MMIO_READ       =$00000004;       /* Open */
  782.       MMIO_SET_EXTENDEDINFO                   =$0001;
  783.       MMIO_RESETTRACKS          =-1;
  784.  
  785. Type
  786.     MMIOPROC=Function(Var pmmioInfo;wMsg:LONGWORD;lParam1,lParam2:LONG):LONG;APIENTRY;
  787.     PMMIOPROC=^MMIOPROC;
  788.     PCODECPROC=^MMIOPROC;
  789.     HMMIO=LONGWORD;
  790.     HMMCF=LONGWORD;
  791.     FOURCC=LONGWORD;
  792.     PFOURCC=^FOURCC;
  793.  
  794. Type
  795.     PCODECINIFILEINFO=^CODECINIFILEINFO;
  796.     CODECINIFILEINFO=Record
  797.                            ulStructLen:LONGWORD;
  798.                            fcc:FOURCC;
  799.                            szDLLName:Cstring[DLLNAME_SIZE-1];
  800.                            szProcName:Cstring[PROCNAME_SIZE-1];
  801.                            ulCompressType:LONGWORD;
  802.                            ulCompressSubType:LONGWORD;
  803.                            ulMediaType:LONGWORD;
  804.                            ulCapsFlags:LONGWORD;
  805.                            ulFlags:LONGWORD;
  806.                            szHWID:Cstring[CODEC_HW_NAME_SIZE-1];
  807.                            ulMaxSrcBufLen:LONGWORD;
  808.                            ulSyncMethod:LONGWORD;
  809.                            fccPreferredFormat:LONGWORD;
  810.                            ulXalignment:LONGWORD;
  811.                            ulYalignment:LONGWORD;
  812.                            ulSpecInfo:Cstring[CODEC_INFO_SIZE-1];
  813.     End;
  814.  
  815.     PCODECASSOC=^CODECASSOC;
  816.     CODECASSOC=Record
  817.                      pCodecOpen:POINTER;
  818.                      pCodecIniFileInfo:PCODECINIFILEINFO;
  819.     End;
  820.  
  821.     PMMEXTENDINFO=^MMEXTENDINFO;
  822.     MMEXTENDINFO=Record
  823.                        ulStructLen:LONGWORD;
  824.                        ulBufSize:LONGWORD;
  825.                        ulFlags:LONGWORD;
  826.                        ulTrackID:LONGWORD;
  827.                        ulNumCODECs:LONGWORD;
  828.                        pCODECAssoc:PCODECASSOC;
  829.     End;
  830.  
  831.     PMMIOINFO=^MMIOINFO;
  832.     MMIOINFO=Record
  833.                    dwFlags:LONGWORD;
  834.                    fccIOProc:FOURCC;
  835.                    pIOProc:PMMIOPROC;
  836.                    dwErrorRet:LONGWORD;
  837.                    cchBuffer:LONG;
  838.                    pchBuffer:PChar;
  839.                    pchNext:PChar;
  840.                    pchEndRead:PChar;
  841.                    pchEndWrite:PChar;
  842.                    lBufOffset:LONG;
  843.                    lDiskOffset:LONG;
  844.                    adwInfo:Array[0..3] Of LONGWORD;
  845.                    lLogicalFilePos:LONG;
  846.                    ulTranslate:LONGWORD;
  847.                    fccChildIOProc:FOURCC;
  848.                    pExtraInfoStruct:POINTER;
  849.                    hmmio:HMMIO;
  850.     End;
  851.  
  852. Var mciGetDeviceIdAddr:Function(AliasName:Cstring):LONGWORD;APIENTRY; {MDM index 16;}
  853.     mciGetErrorStringAddr:Function(ulError:LONGWORD;
  854.                                    Var pszBuffer:Cstring;
  855.                                    usLength:LONGWORD):LONGWORD;APIENTRY; {MDM index 3;}
  856.     mciSendStringAddr:Function(s:Cstring;Var ret:Cstring;retlen:LONGWORD;
  857.                              ahwnd:HWND;userParam:LONGWORD):LONGWORD;APIENTRY; {MDM index 2;}
  858.     mmioOpenAddr:Function( pszFileName:Cstring;Var apmmioinfo:MMIOINFO;
  859.                          dwOpenFlags:LONGWORD ):HMMIO;APIENTRY;  {MMIO index 27;}
  860.     mmioCloseAddr:Function( ahmmio:HMMIO;wFlags:LONGWORD ):WORD;APIENTRY;  {MMIO index 32;}
  861.     mmioGetHeaderAddr:Function( ahmmio:HMMIO;Var pHeader;lHeaderLength:LONG;
  862.                        Var plBytesRead:LONG;dwReserved:ULONG;dwFlags:ULONG ):LONGWORD;APIENTRY;  {MMIO index 77;}
  863.     mmioSetAddr:Function(ahmmio:HMMIO;Var pUserExtendmminfo:MMEXTENDINFO;
  864.                      ulFlags:ULONG):ULONG;APIENTRY;  {MMIO index 101;}
  865.     mmioQueryHeaderLengthAddr:Function( ahmmio:HMMIO;Var plHeaderLength:LONG;
  866.                                dwReserved:LONGWORD;dwFlags:LONGWORD ):LONGWORD;APIENTRY;  {MMIO index 76;}
  867.  
  868. Const MMPM2Initialized:BOOLEAN=FALSE;
  869.  
  870. Type EProcAddrError=Class(Exception);
  871.  
  872. Function InitMMPM2:BOOLEAN;
  873. Var c:Cstring;
  874.     MdmModHandle:LONGWORD;
  875.     ok:BOOLEAN;
  876.     Function GetProcaddr(Index:LONGWORD):POINTER;
  877.     Begin
  878.          result:=Nil;
  879.          If DosQueryProcAddr(MdmModHandle,Index,Nil,result)<>0 Then
  880.          Begin
  881.               ErrorBox2(LoadNLSStr(SMMAccessError));
  882.               Raise EProcAddrError.Create(tostr(Index));
  883.          End;
  884.     End;
  885. Begin
  886.      result:=MMPM2Initialized;
  887.      If result Then exit;
  888.  
  889.      If DosLoadModule(c,255,'MDM',MdmModHandle)<>0 Then
  890.      Begin
  891.           ErrorBox2(LoadNLSStr(SMDMNotFound));
  892.           exit;
  893.      End;
  894.  
  895.      ok:=TRUE;
  896.      Try
  897.         mciGetDeviceIdAddr:=Pointer(GetProcAddr(16));
  898.         mciGetErrorStringAddr:=Pointer(GetProcAddr(3));
  899.         mciSendStringAddr:=Pointer(GetProcAddr(2));
  900.      Except
  901.           ok:=FALSE;
  902.      End;
  903.  
  904.      If Not ok Then exit;
  905.  
  906.      If DosLoadModule(c,255,'MMIO',MdmModHandle)<>0 Then
  907.      Begin
  908.           ErrorBox2(LoadNLSStr(SMMIONotFound));
  909.           exit;
  910.      End;
  911.  
  912.      ok:=TRUE;
  913.      Try
  914.         mmioOpenAddr:=Pointer(GetProcAddr(27));
  915.         mmioCloseAddr:=Pointer(GetProcAddr(32));
  916.         mmioGetHeaderAddr:=Pointer(GetProcAddr(77));
  917.         mmioSetAddr:=Pointer(GetProcAddr(101));
  918.         mmioQueryHeaderLengthAddr:=Pointer(GetProcAddr(76));
  919.      Except
  920.         ok:=FALSE;
  921.      End;
  922.      MMPM2Initialized:=ok;
  923.      result:=ok;
  924. End;
  925.  
  926. {$ENDIF}
  927.  
  928. {
  929. ╔═══════════════════════════════════════════════════════════════════════════╗
  930. ║                                                                           ║
  931. ║ Speed-Pascal/2 Version 2.0                                                ║
  932. ║                                                                           ║
  933. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  934. ║                                                                           ║
  935. ║ This section: TMCIDevice Class Implementation                             ║
  936. ║                                                                           ║
  937. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  938. ║                                                                           ║
  939. ╚═══════════════════════════════════════════════════════════════════════════╝
  940. }
  941.  
  942. Function TMCIDevice.GetCanEject:BOOLEAN;
  943. Begin
  944.      If Not FDeviceOpen Then OpenDevice;
  945.      result:=GetMCICapBoolean('can eject');
  946. End;
  947.  
  948. Function TMCIDevice.GetCanPlay:BOOLEAN;
  949. Begin
  950.      If Not FDeviceOpen Then OpenDevice;
  951.      result:=GetMCICapBoolean('can play');
  952. End;
  953.  
  954. Function TMCIDevice.GetCanRecord:BOOLEAN;
  955. Begin
  956.      If Not FDeviceOpen Then OpenDevice;
  957.      result:=GetMCICapBoolean('can record');
  958. End;
  959.  
  960. Function TMCIDevice.GetCanSave:BOOLEAN;
  961. Begin
  962.      If Not FDeviceOpen Then OpenDevice;
  963.      result:=GetMCICapBoolean('can save');
  964. End;
  965.  
  966. Function TMCIDevice.GetCanLockEject:BOOLEAN;
  967. Begin
  968.      If Not FDeviceOpen Then OpenDevice;
  969.      result:=GetMCICapBoolean('can lockeject');
  970. End;
  971.  
  972. Function TMCIDevice.GetCanSetVolume:BOOLEAN;
  973. Begin
  974.      If Not FDeviceOpen Then OpenDevice;
  975.      result:=GetMCICapBoolean('can setvolume');
  976. End;
  977.  
  978. Function TMCIDevice.GetHasAudio:BOOLEAN;
  979. Begin
  980.      If Not FDeviceOpen Then OpenDevice;
  981.      result:=GetMCICapBoolean('has audio');
  982. End;
  983.  
  984. Function TMCIDevice.GetHasVideo:BOOLEAN;
  985. Begin
  986.      If Not FDeviceOpen Then OpenDevice;
  987.      result:=GetMCICapBoolean('has video');
  988. End;
  989.  
  990. Function TMCIDevice.GetUsesFiles:BOOLEAN;
  991. Begin
  992.      If Not FDeviceOpen Then OpenDevice;
  993.      result:=GetMCICapBoolean('uses files');
  994. End;
  995.  
  996. Procedure TMCIDevice.SetFileName(Const NewValue:String);
  997. Begin
  998.      Stop;
  999.      CloseDevice;
  1000.      If FFileName<>Nil Then FreeMem(FFileName,System.length(FFileName^)+1);
  1001.      GetMem(FFileName,System.length(NewValue)+1);
  1002.      FFileName^:=NewValue;
  1003.      FFileLoaded:=False;
  1004.      Load;
  1005. End;
  1006.  
  1007. Function TMCIDevice.GetFileName:String;
  1008. Begin
  1009.      If FFileName<>Nil Then result:=FFileName^
  1010.      Else result:='';
  1011. End;
  1012.  
  1013. Procedure TMCIDevice.GetDefaultFileMask(Var Ext,Description:String);
  1014. Begin
  1015.      Ext:='*.*';
  1016.      Description:=LoadNLSStr(SAllFiles);
  1017. End;
  1018.  
  1019. Function TMCIDevice.GetMCIStatusNumber(Const option:String):LONGINT;
  1020. Var c:INTEGER;
  1021. Begin
  1022.      result:=-1;
  1023.      OpenDevice;
  1024.      If Not SendString('status '+AliasName+' '+option+' wait',0) Then exit;
  1025.      VAL(FLastMCIReturn,result,c);
  1026.      If c<>0 Then result:=-1;
  1027. End;
  1028.  
  1029. Function TMCIDevice.GetMCIStatusBoolean(Const option:String):BOOLEAN;
  1030. Var temp:LONGINT;
  1031. Begin
  1032.      temp:=GetMCIStatusNumber(option);
  1033.      result:=FLastMCIReturn='TRUE';
  1034. End;
  1035.  
  1036. Function TMCIDevice.GetMCICapBoolean(Const Option:String):BOOLEAN;
  1037. Begin
  1038.      result:=FALSE;
  1039.      If Not SendString('capability '+AliasName+' '+Option+' wait',0) Then exit;
  1040.      result:=FLastMCIReturn='TRUE';
  1041. End;
  1042.  
  1043. Function TMCIDevice.GetMCICapLong(Const Option:String):LONGWORD;
  1044. Var c:INTEGER;
  1045. Begin
  1046.      result:=0;
  1047.      If Not SendString('capability '+AliasName+' '+Option+' wait',0) Then exit;
  1048.      VAL(FLastMCIReturn,result,c);
  1049.      If c<>0 Then result:=0;
  1050. End;
  1051.  
  1052. Function TMCIDevice.GetDeviceReady:BOOLEAN;
  1053. Begin
  1054.      result:=GetMCIStatusBoolean('ready');
  1055. End;
  1056.  
  1057. Const DeviceModesArray:Array[dmNotReady..dmUnknown] Of String[15]=
  1058.             (
  1059.              'not ready',
  1060.              'stopped',
  1061.              'playing',
  1062.              'seeking',
  1063.              'recording',
  1064.              'paused',
  1065.              'other',
  1066.              'unknown'
  1067.             );
  1068.  
  1069. Function DeviceModeToString(dm:TMCIDeviceMode):String;
  1070. Begin
  1071.      result:=DeviceModesArray[dm];
  1072. End;
  1073.  
  1074. Function TMCIDevice.Cue(CueFor:TCueTypes):BOOLEAN;
  1075. Var s:String[10];
  1076. Begin
  1077.      result:=FALSE;
  1078.      If CueFor=cuOutput Then s:=' output'
  1079.      Else s:=' input';
  1080.      OpenDevice;
  1081.      If Not SendString('cue '+AliasName+s+' wait',0) Then exit;
  1082.      result:=TRUE;
  1083. End;
  1084.  
  1085.  
  1086. Procedure TMCIDevice.SetPositionAdvise(NewValue:BOOLEAN);
  1087. Var SaveFormat:TTimeFormat;
  1088. Begin
  1089.      OpenDevice;
  1090.      If FNotifyControl<>Nil Then
  1091.        If FFileLoaded Then
  1092.      Begin
  1093.           If NewValue Then
  1094.           Begin
  1095.               If Not FPositionAdvise Then
  1096.               Begin
  1097.                    {$IFDEF OS2}
  1098.                    SaveFormat:=TimeFormat;
  1099.                    If SendString('setpositionadvise '+AliasName+' on every '
  1100.                                  +TimeInfoStr(FPositionAdviseUnits,SaveFormat)+' wait',0) Then
  1101.                      FPositionAdvise:=TRUE;
  1102.                    TimeFormat:=SaveFormat;
  1103.                    {$ENDIF}
  1104.                    {$IFDEF WIN95}
  1105.                    FPositionAdvise:=TRUE;
  1106.                    {$ENDIF}
  1107.               End;
  1108.           End
  1109.           Else If FPositionAdvise Then
  1110.           Begin
  1111.                {$IFDEF OS2}
  1112.                If SendString('setpositionadvise '+AliasName+' off wait',0) Then
  1113.                {$ENDIF}
  1114.                FPositionAdvise:=FALSE;
  1115.           End;
  1116.      End;
  1117. End;
  1118.  
  1119. Function TMCIDevice.GetDeviceId:LONGWORD;
  1120. Begin
  1121.      {$IFDEF OS2}
  1122.      result:=0;
  1123.      If Not InitMMPM2 Then exit;
  1124.      result:=mciGetDeviceIdAddr(AliasName);
  1125.      {$ENDIF}
  1126.      {$IFDEF Win95}
  1127.      result:=mciGetDeviceId(AliasName);
  1128.      {$ENDIF}
  1129. End;
  1130.  
  1131. Function TMCIDevice.GetDeviceMode:TMCIDeviceMode;
  1132. Var t:TMCIDeviceMode;
  1133. Begin
  1134.      result:=dmUnknown;
  1135.      OpenDevice;
  1136.      If Not SendString('status '+AliasName+' mode wait',0) Then exit;
  1137.      For t:=dmNotReady To dmOther Do
  1138.        If FLastMCIReturn=DeviceModesArray[t] Then
  1139.        Begin
  1140.             result:=t;
  1141.             exit;
  1142.        End;
  1143.  
  1144. End;
  1145.  
  1146. Function TMCIDevice.GetMediaPresent:BOOLEAN;
  1147. Begin
  1148.      result:=GetMCIStatusBoolean('media present');
  1149. End;
  1150.  
  1151. Function TMCIDevice.GetChannels:LONGINT;
  1152. Begin
  1153.      result:=GetMCIStatusNumber('channels');
  1154. End;
  1155.  
  1156. Function TMCIDevice.GetCurrentTrack:LONGINT;
  1157. Begin
  1158.      result:=GetMCIStatusNumber('current track');
  1159. End;
  1160.  
  1161. Procedure TMCIDevice.NextTrack;
  1162. Begin
  1163. End;
  1164.  
  1165. Procedure TMCIDevice.PreviousTrack;
  1166. Begin
  1167. End;
  1168.  
  1169.  
  1170. Function TMCIDevice.GetTrackLength(Track:LONGINT):TTimeInfo;
  1171. Begin
  1172.      If Track=0 Then Track:=CurrentTrack;
  1173.      result:=GetMCITimeInfo('length track '+tostr(track));
  1174. End;
  1175.  
  1176. Function TMCIDevice.GetMCITimeInfo(Const option:String):TTimeInfo;
  1177. Var s:String;
  1178.     OldTimeFormat:TTimeFormat;
  1179.  
  1180.     Procedure GetNextNumber(Var res:BYTE);
  1181.     Var b:BYTE;
  1182.         s1:String;
  1183.         c:INTEGER;
  1184.     Begin
  1185.          If s='' Then res:=0 //default
  1186.          Else
  1187.          Begin
  1188.               b:=pos(':',s);
  1189.               If b<>0 Then
  1190.               Begin
  1191.                    s1:=System.Copy(s,1,b-1);
  1192.                    delete(s,1,b);
  1193.               End
  1194.               Else
  1195.               Begin
  1196.                    s1:=s;
  1197.                    s:='';
  1198.               End;
  1199.               VAL(s1,res,c);
  1200.               If c<>0 Then res:=0;
  1201.          End;
  1202.     End;
  1203.  
  1204. Begin
  1205.      OldTimeFormat:=TimeFormat;
  1206.      Case OldTimeFormat Of
  1207.         tfTMSF:
  1208.         Begin
  1209.              //we must process strings :-(
  1210.              GetMCIStatusNumber(option);
  1211.              s:=FLastMCIReturn;
  1212.              {lock for tracks}
  1213.              result.Format:=tfTMSF;
  1214.              GetNextNumber(result.tmsf_Track);
  1215.              GetNextNumber(result.tmsf_Minutes);
  1216.              GetNextNumber(result.tmsf_Seconds);
  1217.              GetNextNumber(result.tmsf_Frames);
  1218.         End;
  1219.         tfBytes,tfSamples,tfSP,tfFrames:
  1220.         Begin
  1221.              result.Bytes:=GetMCIStatusNumber(option);
  1222.              If result.Bytes=-1 Then result.Format:=tfUnknown
  1223.              Else result.Format:=OldTimeFormat;
  1224.         End;
  1225.         Else
  1226.         Begin //we can convert to mmtime and vice versa
  1227.              TimeFormat:=tfMMTime;
  1228.              result.mmTime:=GetMCIStatusNumber(option);
  1229.              If result.mmTime=-1 Then result.Format:=tfUnknown
  1230.              Else
  1231.              Begin
  1232.                  {$IFDEF OS2}
  1233.                  result.Format:=tfMMTime;
  1234.                  {$ENDIF}
  1235.                  {$IFDEF Win95}
  1236.                  result.Format:=tfMilliseconds;
  1237.                  {$ENDIF}
  1238.                  ConvertTimeInfo(result,OldTimeFormat);
  1239.              End;
  1240.              TimeFormat:=OldTimeFormat;
  1241.              exit;
  1242.         End;
  1243.      End;
  1244. End;
  1245.  
  1246. Function TMCIDevice.GetPosition:TTimeInfo;
  1247. Begin
  1248.      result:=GetMCITimeInfo('position');
  1249. End;
  1250.  
  1251. Function TMCIDevice.GetLength:TTimeInfo;
  1252. Begin
  1253.      result:=GetMCITimeInfo('length');
  1254. End;
  1255.  
  1256. Function TMCIDevice.GetVolume(Channel:TChannel):LONGINT;
  1257. Var s,s1:String;
  1258.     b:BYTE;
  1259.     c:INTEGER;
  1260.     Temp,Temp1:LONGINT;
  1261. Begin
  1262.      result:=-1;
  1263.      OpenDevice;
  1264.      If Not SendString('status '+AliasName+' volume wait',0) Then exit;
  1265.      s:=LastMCIReturn;
  1266.      b:=pos(':',s);
  1267.      If b=0 Then exit;
  1268.      Case Channel Of
  1269.          chLeft:s[0]:=chr(b-1);
  1270.          chRight:delete(s,1,b);
  1271.          chBoth:
  1272.          Begin
  1273.               s1:=s;
  1274.               s[0]:=chr(b-1);
  1275.               VAL(s,temp,c);
  1276.               If c<>0 Then exit;
  1277.               delete(s1,1,b);
  1278.               VAL(s1,temp1,c);
  1279.               If c<>0 Then exit;
  1280.               result:=(temp+temp1) Div 2;
  1281.               exit;
  1282.          End;
  1283.      End; {case}
  1284.      VAL(s,result,c);
  1285.      If c<>0 Then result:=-1;
  1286. End;
  1287.  
  1288. Procedure TMCIDevice.SetVolume(Channel:TChannel;NewVolume:LONGINT);
  1289. Var s:String;
  1290. Begin
  1291.      OpenDevice;
  1292.      Case Channel Of
  1293.         chLeft:s:='left';
  1294.         chRight:s:='right';
  1295.         chBoth:s:='all';
  1296.      End; {Case}
  1297.      SendString('set '+AliasName+' audio '+s+' volume '+tostr(NewVolume)+' wait',0);
  1298. End;
  1299.  
  1300. Function CompareTimeInfos(TimeInfo1,TimeInfo2:TTimeInfo):LONGINT;
  1301. Label process;
  1302. Begin
  1303.      result:=-2; {cannot compare}
  1304.      Case TimeInfo1.Format Of
  1305.          tfTMSF,tfBytes,tfSamples,tfSP,tfFrames:
  1306.          Begin
  1307.               If TimeInfo2.Format=TimeInfo1.Format Then Goto process
  1308.               Else exit; {cannot compare}
  1309.          End;
  1310.          Else
  1311.          Begin
  1312.               {we can convert to mmtime}
  1313.               ConvertTimeInfo(TimeInfo1,tfMMTime);
  1314.               Case TimeInfo1.Format Of
  1315.                   tfTMSF,tfBytes,tfSamples,tfSP,tfFrames:exit; {cannot compare}
  1316.                   Else
  1317.                   Begin
  1318.                        {we can convert to mmtime}
  1319.                        {$IFDEF OS2}
  1320.                        ConvertTimeInfo(TimeInfo2,tfMMTime);
  1321.                        {$ENDIF}
  1322.                        {$IFDEF Win95}
  1323.                        ConvertTimeInfo(TimeInfo2,tfMilliseconds);
  1324.                        {$ENDIF}
  1325. process:
  1326.                        If TimeInfo1.mmTime>TimeInfo2.mmTime Then result:=1        {first greater}
  1327.                        Else If TimeInfo1.mmTime<TimeInfo2.mmTime Then result:=-1  {second greater}
  1328.                        Else result:=0;                                            {equal}
  1329.                   End;
  1330.                End; {case}
  1331.          End;
  1332.      End; {case}
  1333. End;
  1334.  
  1335. Function ConvertTimeInfo(Var TimeInfo:TTimeInfo;NewFormat:TTimeFormat):BOOLEAN;
  1336. Var OldFormat:LONGWORD;
  1337. Begin
  1338.      result:=TRUE;
  1339.      Case TimeInfo.Format Of
  1340.         tfMSF:TimeInfo.msf_Reserved:=0;
  1341.         tfHMS:TimeInfo.hms_reserved:=0;
  1342.      End;
  1343.      If TimeInfo.Format=NewFormat Then exit;
  1344.  
  1345.      OldFormat:=TimeInfo.Unknown;
  1346.      {Convert format to MMTime, all conversions convert from MMTime format}
  1347.      Case TimeInfo.Format Of
  1348.          tfMilliSeconds:
  1349.          Begin
  1350.               If OldFormat>$FFFFFFFF Div 3 Then OldFormat:=0
  1351.               Else OldFormat:=OldFormat*3;
  1352.          End;
  1353.          tfMMTime:;
  1354.          tfMSF:
  1355.          Begin
  1356.               OldFormat:=(OldFormat And $000000FF)*60*3000;
  1357.               OldFormat:=(OldFormat And $0000FF00) Div $100 * 3000;
  1358.               OldFormat:=(OldFormat And $00FF0000) Div $10000*3000 Div 75;
  1359.          End;
  1360.          tfHMS:
  1361.          Begin
  1362.               OldFormat:=(OldFormat And $000000FF) * 60 * 60 * 3000;
  1363.               OldFormat:=(OldFormat And $0000FF00) Div $100 * 60 * 3000;
  1364.               OldFormat:=(OldFormat And $00FF0000) Div $10000 * 3000;
  1365.          End;
  1366.          tfHMSF:
  1367.          Begin
  1368.               OldFormat:=(OldFormat And $000000FF)*60*3000;
  1369.               OldFormat:=(OldFormat And $0000FF00) Div $100 * 3000;
  1370.               OldFormat:=(OldFormat And $00FF0000) Div $10000*3000 Div 75;
  1371.               OldFormat:=(OldFormat And $FF000000) Div $1000000 Div 60*3000;
  1372.          End;
  1373.          tfSMPTE24:
  1374.          Begin
  1375.               OldFormat:=(OldFormat And $000000FF) * 60 * 60 * 3000;
  1376.               OldFormat:=(OldFormat And $0000FF00) Div $100 * 60 * 3000;
  1377.               OldFormat:=(OldFormat And $00FF0000) Div $10000 * 3000;
  1378.               OldFormat:=(OldFormat And $FF000000) Div $1000000 * 3000 Div 24;
  1379.          End;
  1380.          tfSMPTE25:
  1381.          Begin
  1382.               OldFormat:=(OldFormat And $000000FF) * 60 * 60 * 3000;
  1383.               OldFormat:=(OldFormat And $0000FF00) Div $100 * 60 * 3000;
  1384.               OldFormat:=(OldFormat And $00FF0000) Div $10000 * 3000;
  1385.               OldFormat:=(OldFormat And $FF000000) Div $1000000 * 3000 Div 25;
  1386.          End;
  1387.          tfSMPTE30:
  1388.          Begin
  1389.               OldFormat:=(OldFormat And $000000FF) * 60 * 60 * 3000;
  1390.               OldFormat:=(OldFormat And $0000FF00) Div $100 * 60 * 3000;
  1391.               OldFormat:=(OldFormat And $00FF0000) Div $10000 * 3000;
  1392.               OldFormat:=(OldFormat And $FF000000) Div $1000000 * 3000 Div 30;
  1393.          End;
  1394.          Else
  1395.          Begin
  1396.               //we cannot convert the format (for example tfTMSF) to MMTime
  1397.               result:=FALSE;
  1398.               exit;
  1399.          End;
  1400.      End; {case}
  1401.  
  1402.      {Convert Format to result}
  1403.      Case NewFormat Of
  1404.          tfMilliSeconds:
  1405.          Begin
  1406.               TimeInfo.Unknown:=(OldFormat+1) Div 3;
  1407.          End;
  1408.          tfMMTime:;
  1409.          tfMSF:
  1410.          Begin
  1411.               If (OldFormat+20)>=$100*60*3000 Then TimeInfo.Unknown:=0
  1412.               Else TimeInfo.Unknown:=((((OldFormat)+20) Div (60*3000)) +
  1413.                                       (((OldFormat)+20) Mod (60*3000) Div 3000 Shl 8) +
  1414.                                       (((OldFormat)+20) Div (3000 Div 75) Mod 75 shl 16));
  1415.          End;
  1416.          tfHMS:
  1417.          Begin
  1418.               If (OldFormat+50)>=$100*60*60*3000 Then TimeInfo.Unknown:=0
  1419.               Else TimeInfo.Unknown:=(((((((OldFormat)+50) Div 3000) Mod 60) Shl 16) And $00FF0000) Or
  1420.                                       (((((((OldFormat)+50) Div 3000) Div 60) Mod 60) shl 8) And $0000FF00) Or
  1421.                                       ((((((OldFormat)+50) Div 3000) Div 60) Div 60)  and $000000FF));
  1422.          End;
  1423.          tfHMSF:
  1424.          Begin
  1425.               If (OldFormat+20)>=$100*60*3000 Then TimeInfo.Unknown:=0
  1426.               Else TimeInfo.Unknown:=(((OldFormat)+20) Mod (60*3000) Div 3000*60) +
  1427.                                       ((((OldFormat)+20) Div (60*3000) Shl 8) +
  1428.                                       (((OldFormat)+20) Mod (60*3000) Div 3000 Shl 16) +
  1429.                                       (((OldFormat)+20) Div (3000 Div 75) Mod 75 shl 24));
  1430.          End;
  1431.          tfSMPTE24:
  1432.          Begin
  1433.               If (OldFormat+63)>=$100*60*60*3000 Then TimeInfo.Unknown:=0
  1434.               Else TimeInfo.Unknown:=(((((((OldFormat)+63) Mod 3000)Div(3000 Div 24)) Shl 24) And $FF000000) or
  1435.                                       ((((((OldFormat)+63) Div 3000) Mod 60) Shl 16) And $00FF0000) Or
  1436.                                       (((((((OldFormat)+63) Div 3000) Div 60) Mod 60) shl 8) And $0000FF00) Or
  1437.                                    ((((((OldFormat)+63) Div 3000) Div 60) Div 60)  And $000000FF));
  1438.          End;
  1439.          tfSMPTE25:
  1440.          Begin
  1441.               If (OldFormat+63)>=$100*60*60*3000 Then TimeInfo.Unknown:=0
  1442.               Else TimeInfo.Unknown:=(((((((OldFormat)+63) Mod 3000)Div(3000 Div 25)) shl 24) And $FF000000) or
  1443.                                       ((((((OldFormat)+63) Div 3000) Mod 60) Shl 16) And $00FF0000) Or
  1444.                                       (((((((OldFormat)+63) Div 3000) Div 60) Mod 60) shl 8) And $0000FF00) Or
  1445.                                       ((((((OldFormat)+63) Div 3000) Div 60) Div 60)  and $000000FF));
  1446.          End;
  1447.          tfSMPTE30:
  1448.          Begin
  1449.               If (OldFormat+63)>=$100*60*60*3000 Then TimeInfo.Unknown:=0
  1450.               Else TimeInfo.Unknown:=(((((((OldFormat)+63) Mod 3000)Div(3000 Div 30)) shl 24) And $FF000000) or
  1451.                                       ((((((OldFormat)+63) Div 3000) Mod 60) Shl 16) And $00FF0000) Or
  1452.                                       (((((((OldFormat)+63) Div 3000) Div 60) Mod 60) shl 8) And $0000FF00) Or
  1453.                                       ((((((OldFormat)+63) Div 3000) Div 60) Div 60)  and $000000FF));
  1454.          End;
  1455.          Else
  1456.          Begin
  1457.               result:=FALSE;
  1458.               exit;
  1459.          End;
  1460.      End;
  1461.  
  1462.      TimeInfo.Format:=NewFormat;
  1463.      Case TimeInfo.Format Of
  1464.         tfMSF:TimeInfo.msf_Reserved:=0;
  1465.         tfHMS:TimeInfo.hms_reserved:=0;
  1466.      End;
  1467.      result:=TRUE;
  1468. End;
  1469.  
  1470. Const TimeFormatsArray:Array[tfMilliSeconds..tfUnknown] Of String[30]=
  1471.          (
  1472.           'milliseconds',
  1473.           'mmtime',
  1474.           'msf',
  1475.           'tmsf',
  1476.           'frames',
  1477.           'hms',
  1478.           'hmsf',
  1479.           'bytes',
  1480.           'samples',
  1481.           'smpte 24',
  1482.           'smpte 25',
  1483.           'smpte 30',
  1484.           'song pointer',
  1485.           'unknown'
  1486.          );
  1487.  
  1488. Function TimeFormatToString(tf:TTimeFormat):String;
  1489. Begin
  1490.      result:=TimeFormatsArray[tf];
  1491. End;
  1492.  
  1493. Function TimeInfoToString(Const TimeInfo:TTimeInfo):String;
  1494.    Function ToStr(i:LONGINT):String;
  1495.    Begin
  1496.         result:=System.Tostr(i);
  1497.         If System.length(result)<2 Then result:='0'+result;
  1498.    End;
  1499.  
  1500. Begin
  1501.      With TimeInfo Do
  1502.      Case Format Of
  1503.            tfMilliSeconds:result:=tostr(MilliSeconds);
  1504.            tfMMTime:result:=tostr(MMTime);
  1505.            tfMSF:result:=tostr(msf_Minutes)+':'+tostr(msf_Seconds)+':'+tostr(msF_FramEs);
  1506.            tfTMSF:result:=tostr(tmsf_Track)+':'+tostr(tmsf_Minutes)+':'+tostr(tMsf_SeConds)+':'+tostr(tmsf_FRames);
  1507.            tfFrames:result:=System.tostr(Frames);
  1508.            tfHMS:result:=tostr(hms_Hours)+':'+tostr(hms_Minutes)+':'+tostr(hms_SecondS);
  1509.            tfHMSF:result:=tostr(hmsf_Hours)+':'+tostr(hmsf_Minutes)+':'+tostr(hMsf_SeConds)+':'+tostr(hmsf_FRames);
  1510.            tfBytes:result:=System.tostr(Bytes);
  1511.            tfSamples:result:=System.tostr(Samples);
  1512.            tfSMPTE24:result:=System.tostr(SMPTE24);
  1513.            tfSMPTE25:result:=System.tostr(SMPTE25);
  1514.            tfSMPTE30:result:=System.tostr(SMPTE30);
  1515.            tfSP:result:=System.tostr(SongPointer);
  1516.            tfUnknown:result:='???';
  1517.      End; {case}
  1518. End;
  1519.  
  1520. Procedure TMCIDevice.SetTimeFormat(NewFormat:TTimeFormat);
  1521. Begin
  1522.      If NewFormat=FTimeFormat Then exit;
  1523.      {$IFDEF Win95}
  1524.      If NewFormat=tfMMTime Then NewFormat:=tfMilliseconds;
  1525.      {$ENDIF}
  1526.      If Not (NewFormat In FTimeFormatsAvailable) Then exit;
  1527.      FTimeFormat:=NewFormat;
  1528.      If FDeviceOpen Then
  1529.      Begin
  1530.        SendString('set '+AliasName+' time format '+TimeFormatsArray[NewFormat]+' wait',0);
  1531.      End;
  1532. End;
  1533.  
  1534. Function TMCIDevice.GetTracks:LONGINT;
  1535. Begin
  1536.      result:=GetMCIStatusNumber('number of tracks');
  1537. End;
  1538.  
  1539. Procedure TMCIDevice.HandleMCIError(Const ErrorStr:String);
  1540. Begin
  1541.      ErrorBox(ErrorStr);
  1542.      If FDeviceOpen Then //clear error condition
  1543.      Begin
  1544.           CloseDevice;
  1545.           OpenDevice;
  1546.      End;
  1547. End;
  1548.  
  1549. Procedure TMCIDevice.ShowMCIError(Code:LONGWORD);
  1550. Var
  1551.     ErrBuff:Cstring;
  1552.     s:String;
  1553.     ret:LONGWORD;
  1554. Begin
  1555.      {$IFDEF OS2}
  1556.      If Not InitMMPM2 Then exit;
  1557.      ret:=mciGetErrorStringAddr( Code, ErrBuff,255);
  1558.      Case ret Of
  1559.          MCIERR_SUCCESS:
  1560.          Begin
  1561.                s:=ErrBuff;
  1562.                HandleMCIError(s);
  1563.          End;
  1564.          Else HandleMCIError(LoadNLSStr(SUnknownMCIError));
  1565.      End; {case}
  1566.      {$ENDIF}
  1567.      {$IFDEF Win95}
  1568.      If mciGetErrorString( Code, ErrBuff,255) Then
  1569.      Begin
  1570.           s:=ErrBuff;
  1571.           HandleMCIError(s);
  1572.      End
  1573.      Else HandleMCIError(LoadNLSStr(SUnknownMCIError));
  1574.      {$ENDIF}
  1575. End;
  1576.  
  1577. Procedure TMCIDevice.SeekToStart;
  1578. Begin
  1579.      Load;
  1580.      Stop;
  1581.      SendString('seek '+AliasName+' to start wait',0);
  1582.      PositionChanged(Position);
  1583. End;
  1584.  
  1585. Procedure TMCIDevice.SeekToEnd;
  1586. Begin
  1587.       Load;
  1588.       Stop;
  1589.       SendString('seek '+AliasName+' to End wait',0);
  1590.       PositionChanged(Position);
  1591. End;
  1592.  
  1593. Function TMCIDevice.TimeInfoStr(TimeInfo:TTimeInfo;SaveTime:TTimeFormat):String;
  1594. Begin
  1595.      If SaveTime<>TimeInfo.Format Then
  1596.      Begin
  1597.           TimeFormat:=TimeInfo.Format;
  1598.           SaveTime:=TimeInfo.Format;
  1599.      End;
  1600.  
  1601.      Case SaveTime Of
  1602.         tfTMSF,tfHMSF:
  1603.         Begin
  1604.              result:=tostr(TimeInfo.tmsf_Track)+':'+
  1605.                      tostr(TimeInfo.tmsf_Minutes)+':'+
  1606.                      tostr(TimeInfo.tmsf_Seconds)+':'+
  1607.                      tostr(TimeInfo.tmsf_Frames);
  1608.         End;
  1609.         tfBytes,tfSamples,tfSP,tfFrames,tfMilliSeconds,tfMMTime,
  1610.         tfSMPTE24,tfSMPTE25,tfSMPTE30:
  1611.         Begin
  1612.              result:=tostr(TimeInfo.Bytes);
  1613.         End;
  1614.         tfMSF,tfHMS:
  1615.         Begin
  1616.              result:=tostr(TimeInfo.msf_Minutes)+':'+
  1617.                      tostr(TimeInfo.msf_Seconds)+':'+
  1618.                      tostr(TimeInfo.msf_Frames);
  1619.         End;
  1620.      End; {case}
  1621. End;
  1622.  
  1623. Procedure TMCIDevice.Seek(NewPos:TTimeInfo);
  1624. Var s:String;
  1625.     SaveTime:TTimeFormat;
  1626. Begin
  1627.      Load;
  1628.      Stop;
  1629.      SaveTime:=TimeFormat;
  1630.      s:='seek '+AliasName+' to '+TimeInfoStr(NewPos,SaveTime)+' wait';
  1631.      TimeFormat:=SaveTime;
  1632.      SendString(s,0);
  1633.      PositionChanged(Position);
  1634. End;
  1635.  
  1636. Procedure TMCIDevice.Cut(StartPos,EndPos:TTimeInfo);
  1637. Var s:String;
  1638.     SaveTime:TTimeFormat;
  1639. Begin
  1640.      Load;
  1641.      Stop;
  1642.      SaveTime:=TimeFormat;
  1643.      s:='copy '+AliasName+' from '+TimeInfoStr(StartPos,SaveTime)+
  1644.                           ' to '+TimeInfoStr(EndPos,SaveTime);
  1645.      TimeFormat:=SaveTime;
  1646.      SendString(s,0);
  1647. End;
  1648.  
  1649.  
  1650. Procedure TMCIDevice.Copy(StartPos,EndPos:TTimeInfo);
  1651. Var s:String;
  1652.     SaveTime:TTimeFormat;
  1653. Begin
  1654.      Load;
  1655.      Stop;
  1656.      SaveTime:=TimeFormat;
  1657.      s:='copy '+AliasName+' from '+TimeInfoStr(StartPos,SaveTime)+
  1658.                           ' to '+TimeInfoStr(EndPos,SaveTime);
  1659.      TimeFormat:=SaveTime;
  1660.      SendString(s,0);
  1661. End;
  1662.  
  1663. Procedure TMCIDevice.Paste(StartPos,EndPos:TTimeInfo);
  1664. Var s:String;
  1665.     SaveTime:TTimeFormat;
  1666. Begin
  1667.      Load;
  1668.      Stop;
  1669.      SaveTime:=TimeFormat;
  1670.      s:='paste '+AliasName+' from '+TimeInfoStr(StartPos,SaveTime)+
  1671.                           ' to '+TimeInfoStr(EndPos,SaveTime);
  1672.      TimeFormat:=SaveTime;
  1673.      SendString(s,0);
  1674. End;
  1675.  
  1676.  
  1677. Procedure TMCIDevice.StartRecording;
  1678. Begin
  1679.      OpenDevice;
  1680.      Stop;
  1681.      PositionAdvise:=TRUE;
  1682.      If SendString('record '+AliasName+' overwrite notify',0) Then FStatus:=mciRecording
  1683.      Else
  1684.      Begin
  1685.           PositionAdvise:=FALSE;
  1686.           FStatus:=mciError;
  1687.      End;
  1688. End;
  1689.  
  1690. Procedure TMCIDevice.Play;
  1691. Begin
  1692.      OpenDevice;
  1693.      Case FStatus Of
  1694.        mciStopped,mciNothing:
  1695.        Begin
  1696.             Load;
  1697.             PositionAdvise:=TRUE;
  1698.             If SendString('play '+AliasName+' notify',0)
  1699.             Then FStatus:=mciPlaying
  1700.             Else
  1701.             Begin
  1702.                  PositionAdvise:=FALSE;
  1703.                  FStatus:=mciError;
  1704.             End;
  1705.        End;
  1706.        mciPaused:Resume;
  1707.        mciPlaying:;
  1708.      End;
  1709. End;
  1710.  
  1711. Procedure TMCIDevice.SetPositionAdviseUnits(NewUnits:TTimeInfo);
  1712. Begin
  1713.      If Not (NewUnits.Format In FTimeFormatsAvailable) Then exit;
  1714.      FPositionAdviseUnits:=NewUnits;
  1715.      If FPositionAdvise Then
  1716.      Begin
  1717.           PositionAdvise:=FALSE;
  1718.           PositionAdvise:=TRUE;
  1719.      End;
  1720. End;
  1721.  
  1722. Procedure TMCIDevice.Resume;
  1723. Begin
  1724.      If FStatus<>mciPaused Then exit;
  1725.      {$IFDEF Win95}
  1726.      If Self Is TCDDevice Then //resume not supported for MCICDA Win95
  1727.      Begin
  1728.           FStatus:=mciStopped;  //prevent recursion
  1729.           Play;
  1730.           exit;
  1731.      End;
  1732.      {$ENDIF}
  1733.      If SendString('resume '+AliasName+' wait',0) Then FStatus:=mciPlaying
  1734.      Else FStatus:=mciError;
  1735. End;
  1736.  
  1737. Procedure TMCIDevice.Pause;
  1738. Begin
  1739.      If FStatus=mciPaused Then
  1740.      Begin
  1741.           Resume;
  1742.           exit;
  1743.      End;
  1744.      If FStatus<>mciPlaying Then exit;
  1745.      If SendString('pause '+AliasName+' wait',0) Then FStatus:=mciPaused
  1746.      Else FStatus:=mciError;
  1747. End;
  1748.  
  1749. Procedure TMCIDevice.Stop;
  1750. Begin
  1751.      If Not FDeviceOpen Then exit;
  1752.      PositionAdvise:=FALSE;
  1753.      If Not (FStatus In [mciPlaying,mciPaused,mciRewind]) Then exit;
  1754.      If SendString('stop '+AliasName+' wait',0) Then
  1755.      Begin
  1756.           Repeat
  1757.               Application.HandleMessage;
  1758.           Until Not (FStatus In [mciPlaying,mciPaused,mciRewind]);
  1759.      End
  1760.      Else FStatus:=mciError;
  1761. End;
  1762.  
  1763. Function TMCIDevice.SendString(Const s:String;usUserParm:WORD):BOOLEAN;
  1764. Var
  1765.    lmciSendStringRC:LONG;    /* return value fromm mciSendString    */
  1766.    szReturn:Cstring;
  1767.    c:Cstring;
  1768.    Handle:LONGWORD;
  1769. Begin
  1770.    c:=s;
  1771.  
  1772.    If FNotifyControl<>Nil Then Handle:=FNotifyControl.Handle
  1773.    Else Handle:=0;
  1774.  
  1775.    szReturn:='';
  1776.    {$IFDEF OS2}
  1777.    result:=FALSE;
  1778.    If Not InitMMPM2 Then exit;
  1779.    lmciSendStringRC:=mciSendStringAddr(c,szReturn,255,Handle,usUserParm);
  1780.    {$ENDIF}
  1781.    {$IFDEF Win95}
  1782.    lmciSendStringRC :=
  1783.        mciSendString( c,
  1784.                       szReturn,
  1785.                       255,
  1786.                       Handle);
  1787.    {$ENDIF}
  1788.  
  1789.    FLastMCIReturn:=szReturn;
  1790.    If lmciSendStringRC <> 0 Then
  1791.    Begin
  1792.        ShowMCIError(lmciSendStringRC);
  1793.        FStatus:=mciError;
  1794.        result:=FALSE;
  1795.    End
  1796.    Else result:=TRUE;
  1797. End;
  1798.  
  1799.  
  1800. Function TMCIDevice.AddCuePoint(Const CuePoint:TTimeInfo):LONGWORD;
  1801. Var SaveFormat:TTimeFormat;
  1802. Begin
  1803.      OpenDevice;
  1804.      SaveFormat:=TimeFormat;
  1805.      If SendString('setcuepoint '+AliasName+' on at '+TimeInfoStr(CuePoint,SaveFormat)+
  1806.                    ' return '+tostr(FCuePointCount+1)+' wait',0) Then
  1807.      Begin
  1808.          inc(FCuePointCount);
  1809.          result:=FCuePointCount;
  1810.      End
  1811.      Else result:=0; {error}
  1812.      TimeFormat:=SaveFormat;
  1813. End;
  1814.  
  1815. Function TMCIDevice.DeleteCuePoint(Const CuePoint:TTimeInfo):BOOLEAN;
  1816. Var SaveFormat:TTimeFormat;
  1817. Begin
  1818.      OpenDevice;
  1819.      SaveFormat:=TimeFormat;
  1820.      If SendString('setcuepoint '+AliasName+' off at '+TimeInfoStr(CuePoint,SaveFormat)+
  1821.                    ' wait',0) Then result:=TRUE
  1822.      Else result:=FALSE; {error}
  1823.      TimeFormat:=SaveFormat;
  1824. End;
  1825.  
  1826. Procedure TMCIDevice.CloseDevice;
  1827. Begin
  1828.      If Not FDeviceOpen Then exit;
  1829.      If FFileLoaded Then Stop;
  1830.      PositionAdvise:=FALSE;
  1831.      If SendString('close '+AliasName+' wait',0) Then
  1832.      Begin
  1833.           FStatus:=mciNothing;
  1834.           FDeviceOpen:=FALSE;
  1835.           FFileLoaded:=FALSE;
  1836.      End
  1837.      Else
  1838.      Begin
  1839.           HandleMCIError('Cannot close mci device '+DeviceName);
  1840.           FStatus:=mciError;
  1841.      End;
  1842.      FFileLoaded:=False;
  1843. End;
  1844.  
  1845. Procedure TMCIDevice.OpenDevice;
  1846. Var tf:TTimeFormat;
  1847. Begin
  1848.      If FDeviceOpen Then exit;
  1849.  
  1850.      If SendString(  'open '+DeviceName+' alias '+AliasName+' shareable wait', 0 ) Then
  1851.      Begin
  1852.           /* Open success, set the flag and return true */
  1853.           fDeviceOpen := TRUE;
  1854.           tf:=FTimeFormat;
  1855.           FTimeFormat:=tfUnknown;
  1856.           TimeFormat:=tf;
  1857.           If FTimeFormat=tfUnknown Then FTimeFormat:=DefaultTimeFormat;
  1858.      End
  1859.      Else
  1860.      Begin
  1861.           HandleMCIError('Error opening mci device '+DeviceName);
  1862.           FStatus:=mciError;
  1863.      End;
  1864. End;
  1865.  
  1866.  
  1867. Procedure TMCIDevice.SetupComponent;
  1868. Var PosAdviseUnits:TTimeInfo;
  1869. Begin
  1870.      Inherited SetupComponent;
  1871.  
  1872.      Name:='MCIDevice';
  1873.      DeviceName:='Unknown';
  1874.      AliasName:='Unknown';
  1875.  
  1876.      FNotifyControl:=TMCINotifyControl.Create(Self);
  1877.      TMCINotifyControl(FNotifyControl).FDevice:=Self;
  1878.      TMCINotifyControl(FNotifyControl).CreateWnd;
  1879.  
  1880.      FStatus:=mciNothing;
  1881.      FFileNameRequired:=TRUE;
  1882.      FTimeFormatsAvailable:=[tfMilliseconds,tfMMTime];
  1883.      FDefaultTimeFormat:=tfMilliseconds;
  1884.      FTimeFormat:=FDefaultTimeFormat;
  1885.      Include(ComponentState, csHandleLinks);
  1886.      PosAdviseUnits.Format:=tfMilliseconds;
  1887.      PosAdviseUnits.Milliseconds:=1000;
  1888.      PositionAdviseUnits:=PosAdviseUnits;
  1889. End;
  1890.  
  1891. Procedure TMCIDevice.Load;
  1892. Var  mciStr:String;
  1893. Begin
  1894.      If FileName='' Then
  1895.      Begin
  1896.           If FFileNameRequired Then
  1897.           Begin
  1898.                HandleMCIError(LoadNLSStr(SNoFileName));
  1899.                FStatus:=mciError;
  1900.           End
  1901.           Else FFileLoaded:=TRUE;
  1902.           exit; //no file loaded
  1903.      End
  1904.      Else If Not FFileNameRequired Then exit;
  1905.  
  1906.      Screen.Cursor := crHourglass;
  1907.  
  1908.      OpenDevice;
  1909.  
  1910.      If Not FFileLoaded Then
  1911.      Begin
  1912.           mciStr:='load '+AliasName+' '+FileName+' wait';
  1913.           If Not SendString(mciStr,0) Then
  1914.           Begin
  1915.                Screen.Cursor := crDefault;
  1916.                FStatus:=mciError;
  1917.                exit;
  1918.           End;
  1919.  
  1920.           FFileLoaded:=TRUE;
  1921.      End;
  1922.  
  1923.      Screen.Cursor := crDefault;
  1924. End;
  1925.  
  1926. Procedure TMCIDevice.SetDeviceName(NewName:String);
  1927. Begin
  1928.      If FDeviceName<>Nil Then FreeMem(FDeviceName,System.length(FDeviceName^)+1);
  1929.      getmem(FDeviceName,System.length(NewName)+1);
  1930.      FDeviceName^:=NewName;
  1931. End;
  1932.  
  1933. Function TMCIDevice.GetDeviceName:String;
  1934. Begin
  1935.      If FDeviceName<>Nil Then result:=FDeviceName^
  1936.      Else result:='';
  1937. End;
  1938.  
  1939. Procedure TMCIDevice.SetAliasName(NewName:String);
  1940. Begin
  1941.      If FAliasName<>Nil Then FreeMem(FAliasName,System.length(FAliasName^)+1);
  1942.      getmem(FAliasName,System.length(NewName)+1);
  1943.      FAliasName^:=NewName;
  1944. End;
  1945.  
  1946. Function TMCIDevice.GetAliasName:String;
  1947. Begin
  1948.      If FAliasName<>Nil Then result:=FAliasName^
  1949.      Else result:='';
  1950. End;
  1951.  
  1952. Destructor TMCIDevice.Destroy;
  1953. Begin
  1954.      Stop;
  1955.      CloseDevice;
  1956.      FNotifyControl.Destroy;
  1957.      FNotifyControl:=Nil;
  1958.      If FFileName<>Nil Then FreeMem(FFileName,System.length(FFileName^)+1);
  1959.      FFileName:=Nil;
  1960.  
  1961.      Inherited Destroy;
  1962. End;
  1963.  
  1964. Function TMCIDevice.WriteSCUResource(Stream:TResourceStream):BOOLEAN;
  1965. Var s:String;
  1966. Begin
  1967.      Result := Inherited WriteSCUResource(Stream);
  1968.      If Not Result Then exit;
  1969.  
  1970.      s:=FileName;
  1971.      If s<>'' Then result:=Stream.NewResourceEntry(rnFileName,s,System.length(s)+1);
  1972. End;
  1973.  
  1974. Procedure TMCIDevice.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LONgiNT);
  1975. Var s:String;
  1976. Begin
  1977.      If ResName = rnFileName Then
  1978.      Begin
  1979.           If DataLen<>0 Then
  1980.           Begin
  1981.                move(Data,s,DataLen);
  1982.                FileName:=s;
  1983.           End;
  1984.      End
  1985.      Else Inherited ReadSCUResource(ResName,Data,DataLen);
  1986. End;
  1987.  
  1988. Procedure TMCIDevice.PlayingCompleted;
  1989. Begin
  1990.      If FOnPlayingCompleted<>Nil Then FOnPlayingCompleted(Self);
  1991. End;
  1992.  
  1993. Procedure TMCIDevice.PlayingAborted;
  1994. Begin
  1995.      If FOnPlayingAborted<>Nil Then FOnPlayingAborted(Self);
  1996. End;
  1997.  
  1998. {$HINTS OFF}
  1999. Procedure TMCIDevice.CuePointReached(Const CuePoint:TTimeInfo;CuePointId:LONGWORD);
  2000. Begin
  2001.      If OnCuePointReached<>Nil Then OnCuePointReached(Self,CuePoint,CuePointId);
  2002. End;
  2003.  
  2004. Procedure TMCIDevice.PositionChanged(Const NewPosition:TTimeInfo);
  2005. Begin
  2006.      If OnPositionChanged<>Nil Then OnPositionChanged(Self,NewPosition);
  2007. End;
  2008. {$HINTS ON}
  2009.  
  2010. Procedure TMCIDevice.MCIEvent(Event:TMCINotifyEvents;ulDeviceId,ulNotifyCode,ulUserCOde:LONGWORD);
  2011. Var TimeInfo:TTimeInfo;
  2012.     LinkList:TList;
  2013.     t:LONGINT;
  2014.     Component:TComponent;
  2015. Begin
  2016.      Case Event Of
  2017.          mciNotifySuperseded:;
  2018.          mciNotifyAborted:
  2019.          Begin
  2020.               FStatus:=mciStopped;
  2021.               PlayingAborted;
  2022.               PositionAdvise:=FALSE;
  2023.          End;
  2024.          mciNotifyError:
  2025.          Begin
  2026.               FStatus:=mciError;
  2027.               If ulNotifyCode<>0 Then ShowMCIError(ulNotifyCode)
  2028.               Else ErrorBox(LoadNLSStr(SFatalMCIError));
  2029.               PositionAdvise:=FALSE;
  2030.          End;
  2031.          mciNotifySuccess:
  2032.          Begin
  2033.               FStatus:=mciStopped;
  2034.               PlayingCompleted;
  2035.               PositionAdvise:=FALSE;
  2036.          End;
  2037.          mciNotifyPositionChange:
  2038.          Begin
  2039.               If TimeFormat=tfTMSF Then TimeInfo:=Position
  2040.               Else
  2041.               Begin
  2042.                   TimeInfo.Format:=tfMMTime;
  2043.                   TimeInfo.mmTime:=ulNotifyCode;
  2044.                   ConvertTimeInfo(TimeInfo,TimeFormat);
  2045.               End;
  2046.               PositionChanged(TimeInfo);
  2047.          End;
  2048.          mciNotifyCuePoint:
  2049.          Begin
  2050.               TimeInfo.Format:=tfMMTime;
  2051.               TimeInfo.mmTime:=ulNotifyCode;
  2052.               ConvertTimeInfo(TimeInfo,TimeFormat);
  2053.               CuePointReached(TimeInfo,ulUserCode);
  2054.          End;
  2055.      End; {case}
  2056.  
  2057.      LinkList:=FreeNotifyList;
  2058.      ulDeviceId:=DeviceId;
  2059.      If LinkList<>Nil Then For t:=0 To LinkList.Count-1 Do
  2060.      Begin
  2061.           Component:=LinkList[t];
  2062.           If Component Is TVideoWindow Then
  2063.             TVideoWindow(Component).MCIEvent(Event,ulDeviceId,ulNotifyCode,ulUserCodE)
  2064.           Else If Component Is TMediaPlayer Then
  2065.             TMediaPlayer(Component).MCIEvent(Event,ulDeviceId,ulNotifyCode,ulUserCodE);
  2066.      End;
  2067. End;
  2068.  
  2069. {
  2070. ╔═══════════════════════════════════════════════════════════════════════════╗
  2071. ║                                                                           ║
  2072. ║ Speed-Pascal/2 Version 2.0                                                ║
  2073. ║                                                                           ║
  2074. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2075. ║                                                                           ║
  2076. ║ This section: TVideoDevice Class Implementation                           ║
  2077. ║                                                                           ║
  2078. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2079. ║                                                                           ║
  2080. ╚═══════════════════════════════════════════════════════════════════════════╝
  2081. }
  2082.  
  2083. Function TVideoDevice.GetCapabilities:TVideoDeviceCapabilities;
  2084. Begin
  2085.      OpenDevice;
  2086.      result.CanDistort:=GetMCICapBoolean('can distort');
  2087.      result.CanProcessInternal:=GetMCICapBoolean('can process internal');
  2088.      result.CanRecordInsert:=GetMCICapBoolean('can record insert');
  2089.      result.CanStream:=GetMCICapBoolean('can stream');
  2090.      result.CanStretch:=GetMCICapBoolean('can stretch');
  2091.      result.FastPlayRate:=GetMCICapLong('fast play rate');
  2092.      result.HasTuner:=GetMCICapBoolean('has tuner');
  2093.      result.HorizontalVideoExtent:=GetMCICapLong('horizontal video extent');
  2094.      result.HorizontalImageExtent:=GetMCICapLong('horizontal image extent');
  2095.      result.NormalPlayRate:=GetMCICapLong('normal play rate');
  2096.      result.SlowPlayRate:=GetMCICapLong('slow play rate');
  2097.      result.VerticalImageExtent:=GetMCICapLong('vertical image extent');
  2098.      result.VerticalVideoExtent:=GetMCICapLong('vertical video extent');
  2099. End;
  2100.  
  2101. Procedure TVideoDevice.Seek(NewPos:TTimeInfo);
  2102. Begin
  2103.      OpenDevice;
  2104.      Inherited Seek(NewPos);
  2105.  
  2106.      {$IFDEF OS2}
  2107.      {SendString('step '+AliasName+' wait',0);
  2108.      SendString('step '+AliasName+' reverse wait',0);}
  2109.      {$ENDIF}
  2110. End;
  2111.  
  2112. Procedure TVideoDevice.SeekToStart;
  2113. Begin
  2114.      OpenDevice;
  2115.      Inherited SeekToStart;
  2116.  
  2117.      {$IFDEF OS2}
  2118.      {SendString('step '+AliasName+' wait',0);
  2119.      SendString('step '+AliasName+' reverse wait',0);}
  2120.      {$ENDIF}
  2121. End;
  2122.  
  2123. Procedure TVideoDevice.SetupComponent;
  2124. Var PosAdviseUnits:TTimeInfo;
  2125. Begin
  2126.      Inherited SetupComponent;
  2127.      AliasName:='Sibyl_movie';
  2128.      {$IFDEF OS2}
  2129.      DeviceName:='digitalvideo';
  2130.      {$ENDIF}
  2131.      {$IFDEF Win95}
  2132.      DeviceName:='avivideo';
  2133.      {$ENDIF}
  2134.      Name:='VideoDevice';
  2135.      FTimeFormatsAvailable:=[tfMilliseconds,tfMMtime,tfFrames,tfHMS,tfHMSF];
  2136.      FDefaultTimeFormat:=tfFrames;
  2137.      FTimeFormat:=FDefaultTimeFormat;
  2138.      PosAdviseUnits.Format:=tfFrames;
  2139.      PosAdviseUnits.Frames:=1;
  2140.      PositionAdviseUnits:=PosAdviseUnits;
  2141. End;
  2142.  
  2143. Procedure TVideoDevice.GetDefaultFileMask(Var Ext,Description:String);
  2144. Begin
  2145.      Ext:='*.AVI';
  2146.      Description:=LoadNLSStr(SVideoFiles);
  2147. End;
  2148.  
  2149. Procedure TVideoDevice.Load;
  2150. Var
  2151.    szHandle:Cstring[10];
  2152.    szx:Cstring[5];
  2153.    szy:Cstring[5];
  2154.    szcx:Cstring[5];
  2155.    szcy:Cstring[5];
  2156.    szWindowString:Cstring;
  2157.    szPutString:Cstring;
  2158.    {$IFDEF OS2}
  2159.    swpAppFrame:SWP;
  2160.    {$ENDIF}
  2161.    {$IFDEF Win95}
  2162.    ret:LONG;
  2163.    hwndMovie:HWND;
  2164.    s:String;
  2165.    c:INTEGER;
  2166.    rc:TRect;
  2167.    {$ENDIF}
  2168. Begin
  2169.    If FileName='' Then
  2170.    Begin
  2171.         ErrorBox(LoadNLSStr(SNoFilename));
  2172.         FStatus:=mciError;
  2173.         exit; //no movie loaded
  2174.    End;
  2175.  
  2176.    Screen.Cursor := crHourglass;
  2177.  
  2178.    OpenDevice;
  2179.    {$IFDEF OS2}
  2180.    szWindowString:='window '+AliasName+' handle ';
  2181.    If FVideoWindow<>Nil Then
  2182.    Begin
  2183.         szHandle:=tostr(FVideoWindow.Handle);
  2184.         szWindowString:=szWindowString+szHandle+' wait';
  2185.    End
  2186.    Else szWindowString:=szWindowString+'default';
  2187.  
  2188.    If Not SendString(szWindowString, 0) Then
  2189.    Begin
  2190.         Screen.Cursor := crDefault;
  2191.         FStatus:=mciError;
  2192.         exit;
  2193.    End;
  2194.    {$ENDIF}
  2195.  
  2196.    {$IFDEF Win95}
  2197.    If Not FFileLoaded Then
  2198.    Begin
  2199.         szWindowString:='open '+FileName+
  2200.                         ' alias '+AliasName+' style child parent ';
  2201.         If FVideoWindow<>Nil Then szHandle:=tostr(FVideoWindow.Handle)
  2202.         Else szHandle:='default';
  2203.         szWindowString:=szWindowString+szHandle;
  2204.         If Not SendString(szWindowString, 0) Then
  2205.         Begin
  2206.              Screen.Cursor := crDefault;
  2207.              FStatus:=mciError;
  2208.              exit;
  2209.         End;
  2210.    End;
  2211.    {$ENDIF}
  2212.  
  2213.    {$IFDEF OS2}
  2214.    If Not FFileLoaded Then
  2215.    Begin
  2216.        If SendString('load '+AliasName+' '+FileName+' wait', 0)
  2217.            Then FFileLoaded := TRUE
  2218.        Else
  2219.        Begin
  2220.             Screen.Cursor := crDefault;
  2221.             FStatus:=mciError;
  2222.             exit;
  2223.        End;
  2224.        SeekToStart;
  2225.    End;
  2226.    {$ENDIF}
  2227.  
  2228.    If Not FFileLoaded Then
  2229.    Begin
  2230.         {$IFDEF OS2}
  2231.         If FVideoWindow<>Nil Then
  2232.         Begin
  2233.              WinQueryWindowPos (FNotifyControl.Handle, swpAppFrame);
  2234.  
  2235.              swpAppFrame.x := 0;
  2236.              swpAppFrame.y := 0;
  2237.  
  2238.              szx:=tostr(swpAppFrame.x);
  2239.              szy:=tostr(swpAppFrame.y);
  2240.              szcx:=tostr(swpAppFrame.cx);
  2241.              szcy:=tostr(swpAppFrame.cy);
  2242.  
  2243.              szPutString:='put '+AliasName+' destination at ';
  2244.              szPutString:=szPutString+szx+' '+szy+' '+szcx+' '+szcy+' '+'wait';
  2245.  
  2246.              If Not SendString( szPutString, 0 ) Then
  2247.              Begin
  2248.                   Screen.Cursor := crDefault;
  2249.                   FStatus:=mciError;
  2250.                   exit;
  2251.              End;
  2252.         End;
  2253.  
  2254.         {$ENDIF}
  2255.         {$IFDEF Win95}
  2256.         ret:=mciSendString('status '+AliasName+' window handle',
  2257.                            szPutString,255,0);
  2258.         If ret<>0 Then
  2259.         Begin
  2260.              Screen.Cursor := crDefault;
  2261.              FStatus:=mciError;
  2262.              ShowMCIError(ret);
  2263.              exit;
  2264.         End;
  2265.  
  2266.         s:=szPutString;
  2267.         VAL(s,hwndMovie,c);
  2268.         If c<>0 Then
  2269.         Begin
  2270.              Screen.Cursor := crDefault;
  2271.              FStatus:=mciError;
  2272.              ErrorBox(LoadNLSStr(SWrongMovieHandle));
  2273.              exit;
  2274.         End;
  2275.  
  2276.         If FVideoWindow<>Nil Then
  2277.         Begin
  2278.              rc:=FVideoWindow.ClientRect;
  2279.              {???????+-1}
  2280.              inc(rc.Right);
  2281.              inc(rc.Top);
  2282.              {wo Konverierung ?}
  2283.              MoveWindow(hwndMovie,rc.Left,rc.Bottom,
  2284.                         rc.Right,rc.Top,TRUE);
  2285.         End;
  2286.         {$ENDIF}
  2287.    End;
  2288.  
  2289.    {$IFDEF Win95}
  2290.    If Not FFileLoaded Then
  2291.      If Not SendString('window '+AliasName+' state show',0) Then
  2292.    Begin
  2293.         Screen.Cursor := crDefault;
  2294.         FStatus:=mciError;
  2295.         exit;
  2296.    End;
  2297.    FFileLoaded:=TRUE;
  2298.    {$ENDIF}
  2299.  
  2300.    Screen.Cursor := crDefault;
  2301. End;
  2302.  
  2303. Function TVideoDevice.GetBitsPerSample:LONGINT;
  2304. Begin
  2305.      result:=GetMCIStatusNumber('bitspersample');
  2306. End;
  2307.  
  2308. Function TVideoDevice.GetImageBitsPerPel:LONGINT;
  2309. Begin
  2310.      result:=GetMCIStatusNumber('image bitsperpel');
  2311. End;
  2312.  
  2313. Function TVideoDevice.GetImagePelFormat:String;
  2314. Begin
  2315.      GetMCIStatusNumber('image pelformat');
  2316.      result:=FLastMCIReturn;
  2317. End;
  2318.  
  2319. Function TVideoDevice.GetBrightness:LONGINT;
  2320. Begin
  2321.      result:=GetMCIStatusNumber('brightness');
  2322. End;
  2323.  
  2324. Function TVideoDevice.GetContrast:LONGINT;
  2325. Begin
  2326.      result:=GetMCIStatusNumber('contrast');
  2327. End;
  2328.  
  2329. Function TVideoDevice.GetHue:LONGINT;
  2330. Begin
  2331.      result:=GetMCIStatusNumber('hue');
  2332. End;
  2333.  
  2334. Function TVideoDevice.GetClipBoardDataAvail:BOOLEAN;
  2335. Begin
  2336.      result:=GetMCIStatusBoolean('clipboard');
  2337. End;
  2338.  
  2339. Function TVideoDevice.GetSaturation:LONGINT;
  2340. Begin
  2341.      result:=GetMCIStatusNumber('saturation');
  2342. End;
  2343.  
  2344. Function TVideoDevice.GetSamplesPerSec:LONGINT;
  2345. Begin
  2346.      result:=GetMCIStatusNumber('samplespersec');
  2347. End;
  2348.  
  2349. Function TVideoDevice.GetTunerTVChannel:LONGINT;
  2350. Begin
  2351.      result:=GetMCIStatusNumber('tuner tv channel');
  2352. End;
  2353.  
  2354. Function TVideoDevice.GetTunerFineTune:LONGINT;
  2355. Begin
  2356.      result:=GetMCIStatusNumber('tuner finetune');
  2357. End;
  2358.  
  2359. Function TVideoDevice.GetTunerFrequency:LONGINT;
  2360. Begin
  2361.      result:=GetMCIStatusNumber('tuner frequency');
  2362. End;
  2363.  
  2364. Function TVideoDevice.GetValidSignal:BOOLEAN;
  2365. Begin
  2366.      result:=GetMCIStatusBoolean('valid signal');
  2367. End;
  2368.  
  2369. Procedure TVideoDevice.SetBrightness(NewValue:LONGINT);
  2370. Begin
  2371.      SendString('set '+AliasName+' brightness '+tostr(NewValue)+' wait',0);
  2372. End;
  2373.  
  2374. Procedure TVideoDevice.SetContrast(NewValue:LONGINT);
  2375. Begin
  2376.      SendString('set '+AliasName+' contrast '+tostr(NewValue)+' wait',0);
  2377. End;
  2378.  
  2379. Procedure TVideoDevice.SetHue(NewValue:LONGINT);
  2380. Begin
  2381.      SendString('set '+AliasName+' hue '+tostr(NewValue)+' wait',0);
  2382. End;
  2383.  
  2384. Procedure TVideoDevice.SetSaturation(NewValue:LONGINT);
  2385. Begin
  2386.      SendString('set '+AliasName+' saturation '+tostr(NewValue)+' wait',0);
  2387. End;
  2388.  
  2389. Procedure TVideoDevice.SetSamplesPerSec(NewValue:LONGINT);
  2390. Begin
  2391.      SendString('set '+AliasName+' samplespersec '+tostr(NewValue)+' wait',0);
  2392. End;
  2393.  
  2394. Procedure TVideoDevice.SetTunerTVChannel(NewValue:LONGINT);
  2395. Begin
  2396.      SendString('settuner '+AliasName+' tv channel '+tostr(NewValue)+' wait',0);
  2397. End;
  2398.  
  2399. Procedure TVideoDevice.SetTunerFineTune(NewValue:LONGINT);
  2400. Var Temp:LONGINT;
  2401.     s:String[10];
  2402. Begin
  2403.      Temp:=TunerFineTune;
  2404.      If NewValue=Temp Then exit;
  2405.      If NewValue<Temp Then s:='minus '
  2406.      Else s:='plus ';
  2407.      SendString('settuner '+AliasName+' finetune '+s+tostr(NewValue)+' wait',0);
  2408. End;
  2409.  
  2410. Procedure TVideoDevice.SetTunerFrequency(NewValue:LONGINT);
  2411. Begin
  2412.      SendString('settuner '+AliasName+' frequency '+tostr(NewValue)+' wait',0);
  2413. End;
  2414.  
  2415. {
  2416. ╔═══════════════════════════════════════════════════════════════════════════╗
  2417. ║                                                                           ║
  2418. ║ Speed-Pascal/2 Version 2.0                                                ║
  2419. ║                                                                           ║
  2420. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2421. ║                                                                           ║
  2422. ║ This section: TAudioDevice Class Implementation                           ║
  2423. ║                                                                           ║
  2424. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2425. ║                                                                           ║
  2426. ╚═══════════════════════════════════════════════════════════════════════════╝
  2427. }
  2428.  
  2429. Procedure TAudioDevice.SetBitsPerSample(NewValue:LONGINT);
  2430. Begin
  2431.      SendString('set '+AliasName+' bitspersample '+tostr(NewValue)+' wait',0);
  2432. End;
  2433.  
  2434. Procedure TAudioDevice.SetBytesPerSec(NewValue:LONGINT);
  2435. Begin
  2436.      SendString('set '+AliasName+' bytespersec '+tostr(NewValue)+' wait',0);
  2437. End;
  2438.  
  2439. Procedure TAudioDevice.SetSamplesPerSec(NewValue:LONGINT);
  2440. Begin
  2441.      SendString('set '+AliasName+' samplespersec '+tostr(NewValue)+' wait',0);
  2442. End;
  2443.  
  2444. Function TAudioDevice.GetAlignment:LONGINT;
  2445. Begin
  2446.      result:=GetMCIStatusNumber('alignment');
  2447. End;
  2448.  
  2449. Function TAudioDevice.GetBitsPerSample:LONGINT;
  2450. Begin
  2451.      result:=GetMCIStatusNumber('bitspersample');
  2452. End;
  2453.  
  2454. Function TAudioDevice.GetBytesPerSec:LONGINT;
  2455. Begin
  2456.      result:=GetMCIStatusNumber('bytespersec');
  2457. End;
  2458.  
  2459. Function TAudioDevice.GetSamplesPerSec:LONGINT;
  2460. Begin
  2461.      result:=GetMCIStatusNumber('samplespersec');
  2462. End;
  2463.  
  2464. Procedure TAudioDevice.SetupComponent;
  2465. Begin
  2466.      Inherited SetupComponent;
  2467.      AliasName:='Sibyl_audio';
  2468.      DeviceName:='waveaudio';
  2469.      Name:='AudioDevice';
  2470.      FTimeFormatsAvailable:=[tfMilliseconds,tfMMtime,tfBytes,tfSamples];
  2471. End;
  2472.  
  2473. Procedure TAudioDevice.GetDefaultFileMask(Var Ext,Description:String);
  2474. Begin
  2475.      Ext:='*.WAV';
  2476.      Description:=LoadNLSStr(SWaveFiles);
  2477. End;
  2478.  
  2479. {
  2480. ╔═══════════════════════════════════════════════════════════════════════════╗
  2481. ║                                                                           ║
  2482. ║ Speed-Pascal/2 Version 2.0                                                ║
  2483. ║                                                                           ║
  2484. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2485. ║                                                                           ║
  2486. ║ This section: TCDDevice Class Implementation                              ║
  2487. ║                                                                           ║
  2488. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2489. ║                                                                           ║
  2490. ╚═══════════════════════════════════════════════════════════════════════════╝
  2491. }
  2492.  
  2493.  
  2494. Procedure TCDDevice.NextTrack;
  2495. Var OldStatus:TMCIStatus;
  2496.     trk:LONGINT;
  2497. Begin
  2498.      OpenDevice;
  2499.      Trk:=CurrentTrack;
  2500.      If Trk+1>Tracks Then exit;
  2501.      OldStatus:=FStatus;
  2502.      Stop;
  2503.      Seek(TrackPosition[trk+1]);
  2504.      If OldStatus=mciPlaying Then Play;
  2505. End;
  2506.  
  2507. Procedure TCDDevice.PreviousTrack;
  2508. Var OldStatus:TMCIStatus;
  2509.     trk:LONGINT;
  2510.     ti:TTimeInfo;
  2511. Begin
  2512.      OpenDevice;
  2513.      Trk:=CurrentTrack;
  2514.      OldStatus:=FStatus;
  2515.      Stop;
  2516.      ti:=PositionInTrack;
  2517.      ConvertTimeInfo(ti,tfHMS);
  2518.      If ((ti.Format=tfHMS)And(ti.hms_Seconds<1)) Then dec(trk);
  2519.      If trk=0 Then trk:=1;
  2520.      Seek(TrackPosition[trk]);
  2521.      If OldStatus=mciPlaying Then Play;
  2522. End;
  2523.  
  2524. Procedure TCDDevice.SetupComponent;
  2525. Begin
  2526.      Inherited SetupComponent;
  2527.      AliasName:='Sibyl_CD';
  2528.      DeviceName:='cdaudio';
  2529.      Name:='CDDevice';
  2530.      FFileNameRequired:=FALSE;
  2531.      FTimeFormatsAvailable:=[tfMilliseconds,tfMMtime,tfMSF,tfTMSF];
  2532.      FDefaultTimeFormat:=tfTMSF;
  2533.      FTimeFormat:=FDefaultTimeFormat;
  2534. End;
  2535.  
  2536.  
  2537. Function TCDDevice.GetTrackChannels(Track:LONGINT):LONGINT;
  2538. Begin
  2539.      If Track=0 Then Track:=CurrentTrack;
  2540.      result:=GetMCIStatusNumber('channels track '+tostr(Track));
  2541. End;
  2542.  
  2543.  
  2544. Function TCDDevice.GetTrackPosition(Track:LONGINT):TTimeInfo;
  2545. Begin
  2546.      If Track=0 Then Track:=CurrentTrack;
  2547.      result:=GetMCITimeInfo('position track '+tostr(track));
  2548. End;
  2549.  
  2550. Function TCDDevice.GetPositionInTrack:TTimeInfo;
  2551. Begin
  2552.      result:=GetMCITimeInfo('position in track');
  2553. End;
  2554.  
  2555. Function TCDDevice.GetStartPosition:TTimeInfo;
  2556. Begin
  2557.      result:=GetMCITimeInfo('start position');
  2558. End;
  2559.  
  2560. Const MediaTypesArray:Array[mtAudio..mtUnknown] Of String[8]=
  2561.                  (
  2562.                   'audio',
  2563.                   'data',
  2564.                   'other',
  2565.                   'unknown'
  2566.                  );
  2567.  
  2568. Function MediaTypeToString(mt:TCDMediaTypes):String;
  2569. Begin
  2570.      result:=MediaTypesArray[mt];
  2571. End;
  2572.  
  2573. Function TCDDevice.GetMediaType:TCDMediaTypes;
  2574. Var t:TCDMediaTypes;
  2575. Begin
  2576.      result:=mtUnknown;
  2577.      If Not FDeviceOpen Then OpenDevice;
  2578.      If Not SendString('status '+AliasName+' type wait',0) Then exit;
  2579.      For t:=mtAudio To mtOther Do
  2580.        If FLastMCIReturn=MediaTypesArray[t] Then
  2581.        Begin
  2582.             result:=t;
  2583.             exit;
  2584.        End;
  2585. End;
  2586.  
  2587. Function TCDDevice.GetTrackType(Track:LONGINT):TCDMediaTypes;
  2588. Var t:TCDMediaTypes;
  2589. Begin
  2590.      result:=mtUnknown;
  2591.      If Track=0 Then Track:=CurrentTrack;
  2592.      If Not FDeviceOpen Then OpenDevice;
  2593.      If Not SendString('status '+AliasName+' type track '+tostr(track)+' wait',0) Then exit;
  2594.      For t:=mtAudio To mtOther Do
  2595.        If FLastMCIReturn=MediaTypesArray[t] Then
  2596.        Begin
  2597.             result:=t;
  2598.             exit;
  2599.        End;
  2600. End;
  2601.  
  2602. Function TCDDevice.GetCapabilities:TCDDeviceCapabilities;
  2603. Begin
  2604.      FillChar(result,sizeof(TCDDeviceCapabilities),0);
  2605.      If Not FDeviceOpen Then OpenDevice;
  2606.      result.CanProcessInternal:=GetMCICapBoolean('can process internal');
  2607.      result.CanStream:=GetMCICapBoolean('can stream');
  2608. End;
  2609.  
  2610. Procedure TCDDevice.Eject;
  2611. Begin
  2612.      If Not FDeviceOpen Then OpenDevice;
  2613.      SendString('set '+AliasName+' door open wait',0);
  2614. End;
  2615.  
  2616. Procedure TCDDevice.Close;
  2617. Begin
  2618.      If Not FDeviceOpen Then OpenDevice;
  2619.      SendString('set '+AliasName+' door closed wait',0);
  2620. End;
  2621.  
  2622. Procedure TCDDevice.LockDoor;
  2623. Begin
  2624.      If Not FDeviceOpen Then OpenDevice;
  2625.      SendString('set '+AliasName+' door locked wait',0);
  2626. End;
  2627.  
  2628. Procedure TCDDevice.UnlockDoor;
  2629. Begin
  2630.      If Not FDeviceOpen Then OpenDevice;
  2631.      SendString('set '+AliasName+' door unlocked wait',0);
  2632. End;
  2633.  
  2634. {
  2635. ╔═══════════════════════════════════════════════════════════════════════════╗
  2636. ║                                                                           ║
  2637. ║ Speed-Pascal/2 Version 2.0                                                ║
  2638. ║                                                                           ║
  2639. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2640. ║                                                                           ║
  2641. ║ This section: TVideoWindow Class Implementation                           ║
  2642. ║                                                                           ║
  2643. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2644. ║                                                                           ║
  2645. ╚═══════════════════════════════════════════════════════════════════════════╝
  2646. }
  2647.  
  2648. Procedure TVideoWindow.PlayingCompleted;
  2649. Begin
  2650.      If FOnPlayingCompleted<>Nil Then FOnPlayingCompleted(Self);
  2651. End;
  2652.  
  2653. Procedure TVideoWindow.PlayingAborted;
  2654. Begin
  2655.      If FOnPlayingAborted<>Nil Then FOnPlayingAborted(Self);
  2656. End;
  2657.  
  2658. {$HINTS OFF}
  2659. Procedure TVideoWindow.CuePointReached(Const CuePoint:TTimeInfo;CuePointId:LONGWORD);
  2660. Begin
  2661.      If OnCuePointReached<>Nil Then OnCuePointReached(Self,CuePoint,CuePointId);
  2662. End;
  2663.  
  2664. Procedure TVideoWindow.PositionChanged(Const NewPosition:TTimeInfo);
  2665. Begin
  2666.      If OnPositionChanged<>Nil Then OnPositionChanged(Self,NewPosition);
  2667. End;
  2668. {$HINTS ON}
  2669.  
  2670. Procedure TVideoWindow.MCIEvent(Event:TMCINotifyEvents;ulDeviceId,ulNotifyCode,ulUSerCode:LONGWORD);
  2671. Var TimeInfo:TTimeInfo;
  2672. Begin
  2673.      Case Event Of
  2674.          mciNotifySuperseded:;
  2675.          mciNotifyAborted:
  2676.          Begin
  2677.               VideoDevice.FStatus:=mciStopped;
  2678.               PlayingAborted;
  2679.               VideoDevice.PositionAdvise:=FALSE;
  2680.          End;
  2681.          mciNotifyError:
  2682.          Begin
  2683.               VideoDevice.FStatus:=mciError;
  2684.               If ulNotifyCode<>0 Then VideoDevice.ShowMCIError(ulNotifyCode)
  2685.               Else ErrorBox(LoadNLSStr(SFatalMCIError));
  2686.               VideoDevice.PositionAdvise:=FALSE;
  2687.          End;
  2688.          mciNotifySuccess:
  2689.          Begin
  2690.               VideoDevice.FStatus:=mciStopped;
  2691.               PlayingCompleted;
  2692.               VideoDevice.PositionAdvise:=FALSE;
  2693.          End;
  2694.          mciNotifyPositionChange:
  2695.          Begin
  2696.               If ulDeviceId=VideoDevice.DeviceId Then
  2697.               Begin
  2698.                    TimeInfo.Format:=tfMMTime;
  2699.                    TimeInfo.mmTime:=ulNotifyCode;
  2700.                    ConvertTimeInfo(TimeInfo,VideoDevice.TimeFormat);
  2701.                    PositionChanged(TimeInfo);
  2702.               End;
  2703.          End;
  2704.          mciNotifyCuePoint:
  2705.          Begin
  2706.               If ulDeviceId=VideoDevice.DeviceId Then
  2707.               Begin
  2708.                    TimeInfo.Format:=tfMMTime;
  2709.                    TimeInfo.mmTime:=ulNotifyCode;
  2710.                    ConvertTimeInfo(TimeInfo,VideoDevice.TimeFormat);
  2711.                    CuePointReached(TimeInfo,ulUserCode);
  2712.               End;
  2713.          End;
  2714.      End; {case}
  2715. End;
  2716.  
  2717. Procedure TVideoWindow.SetupComponent;
  2718. Begin
  2719.      Inherited SetupComponent;
  2720.  
  2721.      Name:='VideoWindow';
  2722.      Caption:=Name;
  2723.      Height:=200;
  2724.      Width:=200;
  2725.      ParentPenColor:=FALSE;
  2726.      ParentColor:=TRUE;
  2727. End;
  2728.  
  2729. Procedure TVideoWindow.Redraw(Const rc:TRect);
  2730. Var rec:TRect;
  2731. Begin
  2732.      If Canvas = Nil Then exit;
  2733.      If ((VideoDevice=Nil)Or(Not VideoDevice.DeviceOpen)) Then
  2734.      Begin
  2735.           Inherited Redraw(rc);
  2736.           If Designed Then
  2737.           Begin
  2738.               Canvas.Brush.Color:=Color;
  2739.               Canvas.Pen.Color:=clBlack;
  2740.               Canvas.TextOut(20,20,'Video Window');
  2741.               rec:=ClientRect;
  2742.               Canvas.Pen.Style := psDash;
  2743.               Canvas.Brush.Style := bsClear;
  2744.               Canvas.Rectangle(rec);
  2745.           End;
  2746.      End;
  2747. End;
  2748.  
  2749. Function TVideoWindow.DoesFileExist(pszFileName:String):BOOLEAN;
  2750. {$IFDEF OS2}
  2751. Const
  2752.    bReturn:ULONG=0;
  2753.    rc:ULONG=MMIO_SUCCESS;
  2754. Var
  2755.    hFile:LONGWORD;
  2756.    lHeaderLengthMovie:LONG;
  2757.    lHeaderLengthVideo:LONG;
  2758.    lBytes:LONG;
  2759.    apmmMovieHeader:PMMMOVIEHEADER;
  2760.    ammVideoHeader:MMVIDEOHEADER;
  2761.    ammExtendInfo:MMEXTENDINFO;
  2762.    ammioinfo:MMIOINFO;
  2763. {$ENDIF}
  2764. Begin
  2765.      {$IFDEF OS2}
  2766.      fillchar(ammioinfo, sizeof(MMIOINFO),0);
  2767.      fillchar(ammExtendinfo,sizeof(MMEXTENDINFO),0);
  2768.      fillchar(ammVideoHeader,sizeof(MMVIDEOHEADER),0);
  2769.  
  2770.      ammioinfo.ulTranslate :=  MMIO_TRANSLATEHEADER;
  2771.  
  2772.      ammExtendinfo.ulFlags := MMIO_TRACK;
  2773.  
  2774.      result:=FALSE;
  2775.      If Not InitMMPM2 Then exit;
  2776.  
  2777.      hFile := mmioOpenAddr( pszFileName, ammioinfo, MMIO_READ );
  2778.  
  2779.      If hFile <> 0 Then
  2780.      Begin
  2781.         ammExtendinfo.ulTrackID := -1;
  2782.  
  2783.         bReturn := mmioSetAddr(hFile, ammExtendinfo, MMIO_SET_EXTENDEDINFO);
  2784.         bReturn := mmioQueryHeaderLengthAddr(hFile, lHeaderLengthMovie,0, 0);
  2785.  
  2786.         If bReturn=0 Then
  2787.             getmem(apmmMovieHeader,lHeaderLengthMovie);
  2788.  
  2789.         bReturn := mmioGetHeaderAddr(hFile,
  2790.                                  apmmMovieHeader^,
  2791.                                  lHeaderLengthMovie,
  2792.                                  lBytes,
  2793.                                  0,
  2794.                                  0);
  2795.         If bReturn=0 Then
  2796.         Begin
  2797.             ammExtendinfo.ulTrackID := apmmMovieHeader^.ulNextTrackID;
  2798.             bReturn := mmioSetAddr(hFile, ammExtendinfo, MMIO_SET_EXTENDEDINFO);
  2799.             lHeaderLengthVideo := sizeof(MMVIDEOHEADER);
  2800.             bReturn := mmioGetHeaderAddr(hFile,
  2801.                                     ammVideoHeader,
  2802.                                     lHeaderLengthVideo,
  2803.                                     lBytes,
  2804.                                     0,
  2805.                                     0);
  2806.  
  2807.             ulMovieWidth  := ammVideoHeader.ulWidth;
  2808.  
  2809.             ulMovieHeight := ammVideoHeader.ulHeight;
  2810.  
  2811.             ulMovieLength := ammVideoHeader.ulLength;
  2812.  
  2813.             ammExtendinfo.ulTrackID := MMIO_RESETTRACKS;
  2814.  
  2815.             bReturn := mmioSetAddr(hFile, ammExtendinfo,MMIO_SET_EXTENDEDINFO);
  2816.  
  2817.             mmioCloseAddr( hFile, 0);
  2818.  
  2819.             freemem(apmmMovieHeader,lHeaderLengthMovie);
  2820.             result:=TRUE;
  2821.             exit;
  2822.          End;
  2823.      End;
  2824.      result:=FALSE;
  2825.      {$ENDIF}
  2826.      {$IFDEF Win95}
  2827.      result:=TRUE;
  2828.      {$ENDIF}
  2829. End;
  2830.  
  2831. Procedure TVideoWindow.SetVideoDevice(NewDevice:TVideoDevice);
  2832. Begin
  2833.      If FVideoDevice<>Nil Then FVideoDevice.Notification(Self,opRemove);
  2834.      FVideoDevice := NewDevice;
  2835.      If FVideoDevice <> Nil Then
  2836.      Begin
  2837.           FVideoDevice.FreeNotification(Self);
  2838.           FVideoDevice.FVideoWindow:=Self;
  2839.      End;
  2840. End;
  2841.  
  2842. Procedure TVideoWindow.Notification(AComponent:TComponent;Operation:TOperation);
  2843. Begin
  2844.      Inherited Notification(AComponent,Operation);
  2845.  
  2846.      If Operation = opRemove Then
  2847.        If AComponent = FVideoDevice Then
  2848.        Begin
  2849.             FVideoDevice.Stop;
  2850.             FVideoDevice.FVideoWindow:=Nil;
  2851.             FVideoDevice := Nil;
  2852.        End;
  2853. End;
  2854.  
  2855. {
  2856. ╔═══════════════════════════════════════════════════════════════════════════╗
  2857. ║                                                                           ║
  2858. ║ Speed-Pascal/2 Version 2.0                                                ║
  2859. ║                                                                           ║
  2860. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2861. ║                                                                           ║
  2862. ║ This section: TMediaPlayer Class Implementation                           ║
  2863. ║                                                                           ║
  2864. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2865. ║                                                                           ║
  2866. ╚═══════════════════════════════════════════════════════════════════════════╝
  2867. }
  2868.  
  2869. Procedure TMediaPlayer.SetMCIDevice(NewDevice:TMCIDevice);
  2870. Begin
  2871.      If FMCIDevice=NewDevice Then exit;
  2872.      If FMCIDevice<>Nil Then
  2873.      Begin
  2874.           If FDestroyMCIDev Then FMCIDevice.Destroy
  2875.           Else FMCIDevice.Notification(Self,opRemove);
  2876.      End;
  2877.      FDestroyMCIDev:=FALSE;
  2878.      FMCIDevice := NewDevice;
  2879.      If FMCIDevice <> Nil Then FMCIDevice.FreeNotification(Self);
  2880. End;
  2881.  
  2882.  
  2883. Procedure TMediaPlayer.Notification(AComponent:TComponent;Operation:TOperation);
  2884. Begin
  2885.      Inherited Notification(AComponent,Operation);
  2886.  
  2887.      If Operation = opRemove Then
  2888.        If AComponent = FMCIDevice Then FMCIDevice := Nil;
  2889. End;
  2890.  
  2891.  
  2892. Procedure TMediaPlayer.PlayingAborted;
  2893. Begin
  2894.      EnabledButtons:=EnabledButtons-[btPause,btStop];
  2895.      If FOnPlayingAborted<>Nil Then FOnPlayingAborted(Self);
  2896. End;
  2897.  
  2898. Procedure TMediaPlayer.PlayingCompleted;
  2899. Begin
  2900.      EnabledButtons:=EnabledButtons-[btPause,btStop];
  2901.      If FOnPlayingCompleted<>Nil Then FOnPlayingCompleted(Self);
  2902. End;
  2903.  
  2904. {$HINTS OFF}
  2905. Procedure TMediaPlayer.PositionChanged(Const NewPosition:TTimeInfo);
  2906. Begin
  2907.      If OnPositionChanged<>Nil Then OnPositionChanged(Self,NewPosition);
  2908. End;
  2909.  
  2910. Procedure TMediaPlayer.CuePointReached(Const CuePoint:TTimeInfo;CuePointId:LONGWORD);
  2911. Begin
  2912.      If OnCuePointReached<>Nil Then OnCuePointReached(Self,CuePoint,CuePointId);
  2913. End;
  2914.  
  2915. Procedure TMediaPlayer.MCIEvent(Event:TMCINotifyEvents;ulDeviceId,ulNotifyCode,ulUSerCode:LONGWORD);
  2916. Var TimeInfo:TTimeInfo;
  2917. Begin
  2918.       Case Event Of
  2919.          mciNotifySuperseded:
  2920.          Begin
  2921.               FPlayButton.StopAnimation;
  2922.               FRecordButton.StopAnimation;
  2923.               FPlayButton.ResetAnimation;
  2924.               FRecordButton.ResetAnimation;
  2925.          End;
  2926.          mciNotifyAborted:
  2927.          Begin
  2928.               FPlayButton.StopAnimation;
  2929.               FRecordButton.StopAnimation;
  2930.               FPlayButton.ResetAnimation;
  2931.               FRecordButton.ResetAnimation;
  2932.  
  2933.               MCIDevice.FStatus:=mciStopped;
  2934.               PlayingAborted;
  2935.               MCIDevice.PositionAdvise:=FALSE;
  2936.          End;
  2937.          mciNotifyError:
  2938.          Begin
  2939.               FPlayButton.StopAnimation;
  2940.               FRecordButton.StopAnimation;
  2941.               FPlayButton.ResetAnimation;
  2942.               FRecordButton.ResetAnimation;
  2943.  
  2944.               MCIDevice.FStatus:=mciError;
  2945.               MCIDevice.PositionAdvise:=FALSE;
  2946.          End;
  2947.          mciNotifySuccess:
  2948.          Begin
  2949.               FPlayButton.StopAnimation;
  2950.               FRecordButton.StopAnimation;
  2951.               FPlayButton.ResetAnimation;
  2952.               FRecordButton.ResetAnimation;
  2953.  
  2954.               MCIDevice.FStatus:=mciStopped;
  2955.               PlayingCompleted;
  2956.               MCIDevice.PositionAdvise:=FALSE;
  2957.          End;
  2958.          mciNotifyPositionChange:
  2959.          Begin
  2960.               If ulDeviceId=MCIDevice.DeviceId Then
  2961.               Begin
  2962.                    TimeInfo.Format:=tfMMTime;
  2963.                    TimeInfo.mmTime:=ulNotifyCode;
  2964.                    ConvertTimeInfo(TimeInfo,MCIDevice.TimeFormat);
  2965.                    PositionChanged(TimeInfo);
  2966.               End;
  2967.          End;
  2968.          mciNotifyCuePoint:
  2969.          Begin
  2970.               If ulDeviceId=MCIDevice.DeviceId Then
  2971.               Begin
  2972.                    TimeInfo.Format:=tfMMTime;
  2973.                    TimeInfo.mmTime:=ulNotifyCode;
  2974.                    ConvertTimeInfo(TimeInfo,MCIDevice.TimeFormat);
  2975.                    CuePointReached(TimeInfo,ulUserCode);
  2976.               End;
  2977.          End;
  2978.       End;
  2979. End;
  2980. {$HINTS ON}
  2981.  
  2982.  
  2983. Procedure TMediaPlayer.EvButtonClick(Sender:TObject);
  2984. Var DoDefault:BOOLEAN;
  2985.     BtnType:TMPBtnType;
  2986. Begin
  2987.      DoDefault:=TRUE;
  2988.      BtnType:=TMPBtnType(TComponent(Sender).Tag);
  2989.      If OnClick <> Nil Then OnClick(Self,BtnType,DoDefault);
  2990.      If DoDefault Then
  2991.      Begin
  2992.           Case BtnType Of
  2993.               btPlay: Play;
  2994.               btStop: Stop;
  2995.               btPause: Pause;
  2996.               btBack: Back;
  2997.               btStep: Step;
  2998.               btEject: Eject;
  2999.               btRecord: StartRecording;
  3000.               btNext: Next;
  3001.               btPrev: Previous;
  3002.               btRewind:Rewind;
  3003.           End;
  3004.      End;
  3005. End;
  3006.  
  3007.  
  3008. Function TMediaPlayer.GetButton(Index:TMPBtnType):TBitBtn;
  3009. Begin
  3010.      Result := FButtons[Index];
  3011. End;
  3012.  
  3013.  
  3014. Procedure TMediaPlayer.CreateWnd;
  3015. Begin
  3016.      Inherited CreateWnd;
  3017.  
  3018.      RealignControls;
  3019. End;
  3020.  
  3021.  
  3022. Procedure TMediaPlayer.SetupComponent;
  3023.   Procedure InitBtn(Btn:TBitBtn;BtnTag:TMPBtnType;Const BtnBmp:String);
  3024.   Begin
  3025.        FButtons[BtnTag] := Btn;
  3026.        If BtnBmp <> '' Then Btn.Glyph.LoadFromResourceName(BtnBmp);
  3027.        Btn.YAlign := yaBottom;
  3028.        Btn.YStretch := ysParent;
  3029.        Btn.Visible := FALSE;
  3030.        Include(Btn.ComponentState, csDetail);
  3031.        Btn.SetDesigning(Designed);
  3032.  
  3033.        If Not Designed Then
  3034.        Begin
  3035.             Btn.Tag := LONGINT(BtnTag);
  3036.             Btn.OnClick := EvButtonClick;
  3037.        End;
  3038.   End;
  3039. Var  FNextTrkButton:TBitBtn;
  3040.      FPrevTrkButton:TBitBtn;
  3041.      FPauseButton:TBitBtn;
  3042.      FRewindButton:TBitBtn;
  3043.      FStopButton:TBitBtn;
  3044.      FBackTrkButton:TBitBtn;
  3045.      FStepTrkButton:TBitBtn;
  3046.      FEjectButton:TBitBtn;
  3047. Begin
  3048.      Inherited SetupComponent;
  3049.      Name:='MediaPlayer';
  3050.      Caption:='';
  3051.      Width:=32*4;
  3052.      Height:=32;
  3053.      ParentColor:=TRUE;
  3054.      FFrames:=1;
  3055.      DeviceType:=dtAutoSelect;
  3056.  
  3057.      FPlayButton:=InsertAnimatedButtonName(Self,0,0,32,32,'StdBmpPlay','',LoadNLSStr(SPlAyHInt));
  3058.      InitBtn(FPlayButton,btPlay,'');
  3059.      FPlayButton.Interval:=200;
  3060.      FPlayButton.BitmapList.AddResourceName('StdBmpPlay');
  3061.      FPlayButton.BitmapList.AddResourceName('StdBmpPlay1');
  3062.      FPlayButton.BitmapList.AddResourceName('StdBmpPlay2');
  3063.      FPlayButton.BitmapList.AddResourceName('StdBmpPlay3');
  3064.  
  3065.      FPauseButton:=InsertBitBtn(Self,32,0,32,32, bkCustom,'',LoadNLSStr(SPauseHint));
  3066.      InitBtn(FPauseButton,btPause,'StdBmpPause');
  3067.  
  3068.      FStopButton:=InsertBitBtn(Self,64,0,32,32, bkCustom,'',LoadNLSStr(SStopHint));
  3069.      InitBtn(FStopButton,btStop,'StdBmpStop');
  3070.  
  3071.      FNextTrkButton:=InsertBitBtn(Self,96,0,32,32, bkCustom,'',LoadNLSStr(SNextTraCkHInt));
  3072.      InitBtn(FNextTrkButton,btNext,'StdBmpNextTrk');
  3073.  
  3074.      FPrevTrkButton:=InsertBitBtn(Self,96,0,32,32, bkCustom,'',LoadNLSStr(SPreviouSTrAckHint));
  3075.      InitBtn(FPrevTrkButton,btPrev,'StdBmpPrevTrk');
  3076.  
  3077.      FStepTrkButton:=InsertBitBtn(Self,96,0,32,32, bkCustom,'',LoadNLSStr(SStepTrackHint));
  3078.      InitBtn(FStepTrkButton,btStep,'StdBmpStepTrk');
  3079.  
  3080.      FBackTrkButton:=InsertBitBtn(Self,96,0,32,32, bkCustom,'',LoadNLSStr(SBackTrackHint));
  3081.      InitBtn(FBackTrkButton,btBack,'StdBmpBackTrk');
  3082.  
  3083.      FRecordButton:=InsertAnimatedButtonName(Self,96,0,32,32,'StdBmpRecord','',LoadNLSStR(SRecordHint));
  3084.      InitBtn(FRecordButton,btRecord,'');
  3085.      FRecordButton.Interval:=200;
  3086.      FRecordButton.BitmapList.AddResourceName('StdBmpRecord');
  3087.      FRecordButton.BitmapList.AddResourceName('StdBmpRecord1');
  3088.  
  3089.      FEjectButton:=InsertBitBtn(Self,96,0,32,32, bkCustom,'',LoadNLSStr(SEjectHint));
  3090.      InitBtn(FEjectButton,btEject,'StdBmpEject');
  3091.  
  3092.      FRewindButton:=InsertBitBtn(Self,96,0,32,32, bkCustom,'',LoadNLSStr(SRewindHint));
  3093.      InitBtn(FRewindButton,btRewind,'StdBmpRewind');
  3094.  
  3095.      VisibleButtons:=[btPlay,btPause,btRewind,btStop];
  3096.      EnabledButtons:=[btPlay,btRecord,btNext,btPrev];
  3097.      FUseAnimation:=TRUE;
  3098. End;
  3099.  
  3100.  
  3101. Destructor TMediaPlayer.Destroy;
  3102. Begin
  3103.      If MCIDevice<>Nil Then
  3104.      Begin
  3105.           MCIDevice.CloseDevice;
  3106.           If FDestroyMCIDev Then FMCIDevice.Destroy;
  3107.      End;
  3108.      FPlayButton.StopAnimation;
  3109.      FRecordButton.StopAnimation;
  3110.      If FFileName<>Nil Then FreeMem(FFileName,System.length(FFileName^)+1);
  3111.      FFileName := Nil;
  3112.  
  3113.      Inherited Destroy;
  3114. End;
  3115.  
  3116.  
  3117. Function TMediaPlayer.GetFileName:String;
  3118. Begin
  3119.      If MCIDevice<>Nil Then result:=MCIDevice.FileName
  3120.      Else If FFileName<>Nil Then result:=FFileName^
  3121.      Else Result:='';
  3122. End;
  3123.  
  3124.  
  3125. Procedure TMediaPlayer.SetFileName(NewName:String);
  3126. Begin
  3127.      If MCIDevice<>Nil Then MCIDevice.FileName:=NewName
  3128.      Else
  3129.      Begin
  3130.           If FFileName<>Nil Then FreeMem(FFileName,System.length(FFileName^)+1);
  3131.           GetMem(FFileName,System.length(NewName)+1);
  3132.           FFileName^:=NewName;
  3133.      End;
  3134. End;
  3135.  
  3136.  
  3137. Procedure TMediaPlayer.SetVisibleButtons(NewState:TMPButtonSet);
  3138. Var  idx:TMPBtnType;
  3139. Begin
  3140.      FVisibleButtons := NewState;
  3141.      For idx := Low(TMPBtnType) To High(TMPBtnType) Do
  3142.      Begin
  3143.           If FButtons[idx]<>Nil Then
  3144.             FButtons[idx].Visible := FVisibleButtons * [idx] <> [];
  3145.      End;
  3146.      RealignControls;
  3147. End;
  3148.  
  3149.  
  3150. Procedure TMediaPlayer.SetEnabledButtons(NewState:TMPButtonSet);
  3151. Var  idx:TMPBtnType;
  3152. Begin
  3153.      FEnabledButtons := NewState;
  3154.      For idx := Low(TMPBtnType) To High(TMPBtnType) Do
  3155.      Begin
  3156.           If FButtons[idx]<>Nil Then
  3157.             FButtons[idx].Enabled := FEnabledButtons * [idx] <> [];
  3158.      End;
  3159.      If Handle <> 0 Then Invalidate;
  3160. End;
  3161.  
  3162.  
  3163. Procedure TMediaPlayer.RealignControls;
  3164. Var  x:LONGINT;
  3165.      count,w:LONGINT;
  3166.      idx:TMPBtnType;
  3167. Begin
  3168.      If Handle = 0 Then exit;
  3169.  
  3170.      count := 0;
  3171.      For idx := Low(TMPBtnType) To High(TMPBtnType) Do
  3172.      Begin
  3173.           If FVisibleButtons * [idx] <> [] Then inc(count);
  3174.      End;
  3175.      If count = 0 Then exit;
  3176.  
  3177.      x := 0;
  3178.      w := Width Div count;
  3179.  
  3180.      For idx := Low(TMPBtnType) To High(TMPBtnType) Do
  3181.      Begin
  3182.           If FButtons[idx]<>Nil Then
  3183.           Begin
  3184.               If FVisibleButtons * [idx] <> [] Then
  3185.               Begin
  3186.                    FButtons[idx].SetWindowPos(x,0,w,Height);
  3187.                    inc(x, w);
  3188.               End
  3189.               Else
  3190.               If Designed Then FButtons[idx].SetWindowPos(x,Height,w,Height);
  3191.           End;
  3192.      End;
  3193. End;
  3194.  
  3195. Procedure TMediaPlayer.Open;
  3196. Var s:String;
  3197.     DevType:TMPDeviceTypes;
  3198. Begin
  3199.      If MCIDevice<>Nil Then
  3200.      Begin
  3201.           MCIDevice.OpenDevice;
  3202.           FOpened:=MCIDevice.FDeviceOpen;
  3203.      End
  3204.      Else
  3205.      Begin
  3206.           FDestroyMCIDev:=TRUE;
  3207.  
  3208.           If DeviceType=dtAutoSelect Then
  3209.           Begin
  3210.                DevType:=dtOther;
  3211.                s:=FileName;
  3212.                UpcaseStr(s);
  3213.                If pos('.WAV',s)<>0 Then DevType:=dtWaveAudio
  3214.                Else If pos('.AVI',s)<>0 Then DevType:=dtAVIVideo;
  3215.           End
  3216.           Else DevType:=DeviceType;
  3217.  
  3218.           Case DevType Of
  3219.             dtAVIVideo:FMCIDevice:=TVideoDevice.Create(Nil);
  3220.             dtCDAudio:FMCIDevice:=TCDDevice.Create(Nil);
  3221.             dtDAT:
  3222.             Begin
  3223.                  FMCIDevice:=TMCIDevice.Create(Nil);
  3224.                  MCIDevice.DeviceName:='DAT';
  3225.                  MCIDevice.AliasName:='Sibyl_'+MCIDevice.DeviceName;
  3226.             End;
  3227.             dtDigitalVideo:FMCIDevice:=TVideoDevice.Create(Nil);
  3228.             dtMMMovie:FMCIDevice:=TVideoDevice.Create(Nil);
  3229.             dtOther:
  3230.             Begin
  3231.                  FMCIDevice:=TMCIDevice.Create(Nil);
  3232.                  MCIDevice.DeviceName:='Other';
  3233.                  MCIDevice.AliasName:='Sibyl_'+MCIDevice.DeviceName;
  3234.             End;
  3235.             dtOverlay:
  3236.             Begin
  3237.                  FMCIDevice:=TMCIDevice.Create(Nil);
  3238.                  MCIDevice.DeviceName:='Overlay';
  3239.                  MCIDevice.AliasName:='Sibyl_'+MCIDevice.DeviceName;
  3240.             End;
  3241.             dtScanner:
  3242.             Begin
  3243.                  FMCIDevice:=TMCIDevice.Create(Nil);
  3244.                  MCIDevice.DeviceName:='Scanner';
  3245.                  MCIDevice.AliasName:='Sibyl_'+MCIDevice.DeviceName;
  3246.             End;
  3247.             dtSequencer:
  3248.             Begin
  3249.                  FMCIDevice:=TMCIDevice.Create(Nil);
  3250.                  MCIDevice.DeviceName:='Sequencer';
  3251.                  MCIDevice.AliasName:='Sibyl_'+MCIDevice.DeviceName;
  3252.             End;
  3253.             dtVCR:
  3254.             Begin
  3255.                  FMCIDevice:=TMCIDevice.Create(Nil);
  3256.                  MCIDevice.DeviceName:='VCR';
  3257.                  MCIDevice.AliasName:='Sibyl_'+FMCIDevice.DeviceName;
  3258.             End;
  3259.             dtVideoDisc:
  3260.             Begin
  3261.                  FMCIDevice:=TMCIDevice.Create(Nil);
  3262.                  MCIDevice.DeviceName:='Videodisc';
  3263.                  MCIDevice.AliasName:='Sibyl_'+MCIDevice.DeviceName;
  3264.             End;
  3265.             dtWaveAudio:FMCIDevice:=TAudioDevice.Create(Nil);
  3266.           End; //case
  3267.  
  3268.           MCIDevice.FileName:=FileName;
  3269.           MCIDevice.OpenDevice;
  3270.           FOpened:=MCIDevice.FDeviceOpen;
  3271.      End;
  3272. End;
  3273.  
  3274.  
  3275. Procedure TMediaPlayer.Play;
  3276. Begin
  3277.      If Not FOpened Then Open;
  3278.      If MCIDevice<>Nil Then
  3279.      Begin
  3280.           MCIDevice.Play;
  3281.           If MCIDevice.Status=mciPlaying Then
  3282.           Begin
  3283.                EnabledButtons:=EnabledButtons-[btRecord];
  3284.                EnabledButtons:=EnabledButtons+[btPause,btStop,btRewind];
  3285.                If UseAnimation Then FPlayButton.StartAnimation;
  3286.           End;
  3287.      End;
  3288. End;
  3289.  
  3290.  
  3291. Procedure TMediaPlayer.StartRecording;
  3292. Begin
  3293.      If MCIDevice<>Nil Then
  3294.      Begin
  3295.           MCIDevice.StartRecording;
  3296.           If MCIDevice.Status=mciRecording Then
  3297.           Begin
  3298.                EnabledButtons:=EnabledButtons-[btPlay];
  3299.                EnabledButtons:=EnabledButtons+[btPause,btStop,btRewind];
  3300.                If UseAnimation Then FRecordButton.StartAnimation;
  3301.           End;
  3302.      End;
  3303. End;
  3304.  
  3305.  
  3306. Procedure TMediaPlayer.Stop;
  3307. Begin
  3308.      If MCIDevice<>Nil Then
  3309.      Begin
  3310.           MCIDevice.Stop;
  3311.           EnabledButtons:=EnabledButtons-[btStop,btPause];
  3312.           EnabledButtons:=EnabledButtons+[btPlay,btRecord];
  3313.           FPlayButton.ResetAnimation;
  3314.           FRecordButton.ResetAnimation;
  3315.      End;
  3316. End;
  3317.  
  3318.  
  3319. Procedure TMediaPlayer.Next;
  3320. Var WasPlaying:Boolean;
  3321. Begin
  3322.      If MCIDevice<>Nil Then
  3323.      Begin
  3324.           WasPlaying:=MCIDevice.Status=mciPlaying;
  3325.           Stop;
  3326.           MCIDevice.NextTrack;
  3327.           If WasPlaying Then Play;
  3328.      End;
  3329. End;
  3330.  
  3331.  
  3332. Procedure TMediaPlayer.Previous;
  3333. Var WasPlaying:Boolean;
  3334. Begin
  3335.      If MCIDevice<>Nil Then
  3336.      Begin
  3337.           WasPlaying:=MCIDevice.Status=mciPlaying;
  3338.           Stop;
  3339.           MCIDevice.PreviousTrack;
  3340.           If WasPlaying Then Play;
  3341.      End;
  3342. End;
  3343.  
  3344.  
  3345. Procedure TMediaPlayer.Pause;
  3346. Begin
  3347.      If MCIDevice<>Nil Then
  3348.      Begin
  3349.           If MCIDevice.Status<>mciPlaying Then
  3350.           Begin
  3351.                EnabledButtons:=EnabledButtons+[btStop];
  3352.                MCIDevice.Pause;
  3353.                If MCIDevice.Status=mciPlaying Then
  3354.                  If UseAnimation Then FPlayButton.StartAnimation;
  3355.           End
  3356.           Else
  3357.           Begin
  3358.                EnabledButtons:=EnabledButtons+[btPlay,btRecord];
  3359.                EnabledButtons:=EnabledButtons-[btStop];
  3360.                MCIDevice.Pause;
  3361.                FPlayButton.StopAnimation;
  3362.                FRecordButton.StopAnimation;
  3363.           End;
  3364.      End;
  3365. End;
  3366.  
  3367.  
  3368. Procedure TMediaPlayer.Rewind;
  3369. Begin
  3370.      If MCIDevice<>Nil Then
  3371.      Begin
  3372.           MCIDevice.SeekToStart;
  3373.           EnabledButtons:=EnabledButtons+[btPlay,btRecord];
  3374.           EnabledButtons:=EnabledButtons-[btStop,btPause,btRewind];
  3375.           FPlayButton.ResetAnimation;
  3376.           FRecordButton.ResetAnimation;
  3377.      End;
  3378. End;
  3379.  
  3380.  
  3381. Procedure TMediaPlayer.Close;
  3382. Begin
  3383.      If MCIDevice<>Nil Then
  3384.      Begin
  3385.           MCIDevice.CloseDevice;
  3386.           FOpened:=FALSE;
  3387.           EnabledButtons:=[btPlay,btRecord,btNext,btPrev];
  3388.           FPlayButton.ResetAnimation;
  3389.           FRecordButton.ResetAnimation;
  3390.      End;
  3391. End;
  3392.  
  3393. Procedure TMediaPlayer.Step;
  3394. Var ti:TTimeInfo;
  3395. Begin
  3396.      If MCIDevice<>Nil Then
  3397.      Begin
  3398.          ti:=MCIDevice.Position;
  3399.          ti.Unknown:=ti.Unknown+Frames;
  3400.          MCIDevice.Seek(ti);
  3401.      End;
  3402. End;
  3403.  
  3404. Procedure TMediaPlayer.Back;
  3405. Var ti:TTimeInfo;
  3406. Begin
  3407.      If MCIDevice<>Nil Then
  3408.      Begin
  3409.          ti:=MCIDevice.Position;
  3410.          ti.Unknown:=ti.Unknown-Frames;
  3411.          MCIDevice.Seek(ti);
  3412.      End;
  3413. End;
  3414.  
  3415. Procedure TMediaPlayer.Eject;
  3416. Begin
  3417.      If MCIDevice Is TCDDevice Then
  3418.      Begin
  3419.           TCDDevice(MCIDevice).Eject;
  3420.      End;
  3421. End;
  3422.  
  3423. Procedure TMediaPlayer.SetDeviceType(NewValue:TMPDeviceTypes);
  3424. Var WasOpened:BOOLEAN;
  3425. Begin
  3426.      If NewValue<>DeviceType Then
  3427.      Begin
  3428.           WasOpened:=FOpened;
  3429.           Close;
  3430.           FDeviceType:=NewValue;
  3431.           If WasOpened Then Open;
  3432.      End;
  3433. End;
  3434.  
  3435. {
  3436. ╔═══════════════════════════════════════════════════════════════════════════╗
  3437. ║                                                                           ║
  3438. ║ Speed-Pascal/2 Version 2.0                                                ║
  3439. ║                                                                           ║
  3440. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  3441. ║                                                                           ║
  3442. ║ This section: TVolumeControl Class Implementation                         ║
  3443. ║                                                                           ║
  3444. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  3445. ║                                                                           ║
  3446. ╚═══════════════════════════════════════════════════════════════════════════╝
  3447. }
  3448.  
  3449.  
  3450. Function TVolumeControl.InsideCircle(MiddleX,MiddleY,Radius:LONGINT;Const pt:TPoint;Var Angle:LONGINT):BOOLEAn;
  3451. Var
  3452.     a,b:LONGINT;
  3453.     temp:Extended;
  3454.     OldRad:BOOLEAN;
  3455.     OldToRad:EXTENDED;
  3456.     OldFromRad:EXTENDED;
  3457. Begin
  3458.      result:=FALSE;
  3459.      If pt.X=MiddleX Then
  3460.      Begin
  3461.           If abs(pt.y-MiddleY)<=Radius Then result:=TRUE;
  3462.           Angle:=90;
  3463.      End
  3464.      Else If pt.Y=MiddleY Then
  3465.      Begin
  3466.           If abs(pt.x-MiddleX)<=Radius Then result:=TRUE;
  3467.           If pt.x<MiddleX Then Angle:=180
  3468.           Else Angle:=0;
  3469.      End
  3470.      Else
  3471.      Begin
  3472.           {Zwischenpunkt für rechtwinkliges Dreieck}
  3473.           a:=pt.Y-MiddleY;
  3474.           b:=pt.X-MiddleX;
  3475.           temp:=sqrt(sqr(a)+sqr(b));
  3476.           If round(temp)<=Radius Then result:=TRUE;
  3477.  
  3478.           {Save old trigmode}
  3479.           OldRad:=IsNotRad;
  3480.           OldToRad:=ToRad;
  3481.           OldFromRad:=FromRad;
  3482.  
  3483.           {Set trigmode to degrees}
  3484.           ToRad:=0.01745329262;
  3485.           FromRad:=57.29577951;
  3486.           IsNotRad:=TRUE;
  3487.           Angle:=round(arcsin(abs(b)/temp));
  3488.           If pt.X>MiddleX Then Angle:=90-Angle
  3489.           Else inc(Angle,90);
  3490.  
  3491.           {Restore old trigmode}
  3492.           ToRad:=OldToRad;
  3493.           FromRad:=OldFromRad;
  3494.           IsNotRad:=OldRad;
  3495.  
  3496.           If ((FPosition<50)And(pt.x<MiddleX)And(pt.y<MiddleY)) Then Angle:=180
  3497.           Else If ((FPosition>50)And(pt.x>MiddleX)And(pt.y<MiddleY)) Then Angle:=0;
  3498.      End;
  3499. End;
  3500.  
  3501. {$HINTS OFF}
  3502. Procedure TVolumeControl.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LONgiNT);
  3503. Var MiddleX,MiddleY,CircleRadius:LONGINT;
  3504.     Angle:LONGINT;
  3505.     rec:TRect;
  3506. Label found;
  3507. Begin
  3508.      Inherited MouseDown(Button,ShiftState,X,Y);
  3509.  
  3510.      If Button <> mbLeft Then exit;
  3511.  
  3512.      GetCircleParams(MiddleX,MiddleY,CircleRadius);
  3513.  
  3514.      If InsideCircle(MiddleX,MiddleY,CircleRadius Div 2,Point(X,Y),Angle) Then
  3515.      Begin
  3516. found:
  3517.           MouseCapture:=TRUE;
  3518.           FHasCapture:=TRUE;
  3519.           FTimerEndPos:=100-round((Angle*100) / 180);
  3520.           FAngleTimer.Create(Self);
  3521.           Include(FAngleTimer.ComponentState, csDetail);
  3522.           FAngleTimer.OnTimer:=EvTimer;
  3523.           FAngleTimer.Interval:=30;
  3524.           FAngleTimer.Start;
  3525.      End
  3526.      Else
  3527.      Begin
  3528.           If Y>=MiddleY Then
  3529.            If InsideCircle(MiddleX,MiddleY,(CircleRadius+30) Div 2,Point(X,Y),Angle) then
  3530.              Goto found;
  3531.  
  3532.           If ((Y>=5)And(Y<=20)) Then //test boxes
  3533.           Begin
  3534.                If ((X>=1)And(X<=16)And(FPosition>0)) Then {minus}
  3535.                Begin
  3536.                     rec.Left:=1;
  3537.                     rec.Right:=16;
  3538.                     FTimerEndPos:=0;
  3539.                     Position:=Position-1;
  3540.                End
  3541.                Else If ((X>=Width-16)And(X<=Width-1)And(FPosition<100)) Then {plus}
  3542.                Begin
  3543.                     rec.Left:=Width-16;
  3544.                     rec.Right:=Width-1;
  3545.                     FTimerEndPos:=100;
  3546.                     Position:=Position+1;
  3547.                End
  3548.                Else exit;
  3549.  
  3550.                PositionChanged;
  3551.                rec.Bottom:=5;
  3552.                rec.Top:=20;
  3553.                Canvas.ShadowedBorder(rec,clBlack,clWhite);
  3554.                MouseCapture:=TRUE;
  3555.                FHasCapture:=FALSE;
  3556.                FAngleTimer.Create(Self);
  3557.                Include(FAngleTimer.ComponentState, csDetail);
  3558.                FAngleTimer.OnTimer:=EvTimer;
  3559.                FAngleTimer.Interval:=250;
  3560.                FAngleTimer.Start;
  3561.           End;
  3562.      End;
  3563. End;
  3564.  
  3565. Procedure TVolumeControl.MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LONGInt);
  3566. Begin
  3567.      Inherited MouseUp(Button,ShiftState,X,Y);
  3568.  
  3569.      If Button <> mbLeft Then exit;
  3570.  
  3571.      If MouseCapture Then If FAngleTimer<>Nil Then
  3572.      Begin
  3573.           FAngleTimer.Stop;
  3574.           FAngleTimer.Destroy;
  3575.           FAngleTimer:=Nil;
  3576.           MouseCapture:=FALSE;
  3577.           FHasCapture:=FALSE;
  3578.           DrawBoxes;
  3579.      End;
  3580. End;
  3581.  
  3582.  
  3583. Procedure TVolumeControl.MouseMove(ShiftState:TShiftState;X,Y:LONGINT);
  3584. Var MiddleX,MiddleY,CircleRadius:LONGINT;
  3585.     Angle:LONGINT;
  3586. Begin
  3587.      Inherited MouseMove(ShiftState,X,Y);
  3588.  
  3589.      If FHasCapture Then
  3590.      Begin
  3591.           GetCircleParams(MiddleX,MiddleY,CircleRadius);
  3592.  
  3593.           InsideCircle(MiddleX,MiddleY,CircleRadius Div 2,Point(X,Y),Angle);
  3594.           FAngleTimer.Stop;
  3595.           FTimerEndPos:=100-round((Angle*100) Div 180);
  3596.           If FTimerEndPos<FPosition Then Position:=Position-1
  3597.           Else If FTimerEndPos>FPosition Then Position:=Position+1;
  3598.           PositionChanged;
  3599.           FAngleTimer.Start;
  3600.      End;
  3601. End;
  3602. {$HINTS ON}
  3603.  
  3604. Procedure TVolumeControl.EvTimer(Sender:TObject);
  3605. Var t,Ende:LONGINT;
  3606. Begin
  3607.      If Sender=FAngleTimer Then
  3608.      Begin
  3609.           If FTimerEndPos=FPosition Then
  3610.           Begin
  3611.                FAngleTimer.Stop;
  3612.                exit;
  3613.           End;
  3614.  
  3615.           If MouseCapture Then Ende:=6  //not boxes
  3616.           Else Ende:=1;
  3617.  
  3618.           For t:=1 To Ende Do
  3619.           Begin
  3620.                If FTimerEndPos<FPosition Then Position:=Position-1
  3621.                Else If FTimerEndPos>FPosition Then Position:=Position+1;
  3622.                PositionChanged;
  3623.           End;
  3624.      End;
  3625. End;
  3626.  
  3627. Procedure TVolumeControl.SetupComponent;
  3628. Begin
  3629.      Inherited SetupComponent;
  3630.  
  3631.      Name:='VolumeControl';
  3632.      Width:=75;
  3633.      Height:=75;
  3634.      ParentPenColor:=TRUE;
  3635.      ParentColor:=TRUE;
  3636.      FPosition:=100;
  3637.      FHasCapture:=FALSE;
  3638. End;
  3639.  
  3640. Procedure TVolumeControl.GetCircleParams(Var MiddleX,MiddleY,CircleRadius:LONGINT);
  3641. Begin
  3642.      MiddleX:=Width Div 2;
  3643.      MiddleY:=Height Div 2;
  3644.      If Height>Width Then CircleRadius:=Width-30
  3645.      Else CircleRadius:=Height-30;
  3646.      If CircleRadius And 1<>0 Then inc(CircleRadius);
  3647. End;
  3648.  
  3649. Procedure TVolumeControl.DrawSlider;
  3650. Var  MiddleX,MiddleY:LONGINT;
  3651.      CircleRadius:LONGINT;
  3652.      Angle:EXTENDED;
  3653. Begin
  3654.      GetCircleParams(MiddleX,MiddleY,CircleRadius);
  3655.      Angle:=((100-FPosition)*180) / 100;
  3656.      Canvas.Pen.Style:=psClear;
  3657.      Canvas.Arc(MiddleX,MiddleY,(CircleRadius-6) Div 2,(CircleRadius-6) Div 2,Angle,0);
  3658.      Canvas.Pen.Style:=psSolid;
  3659.      Canvas.LineTo(MiddleX,MiddleY);
  3660. End;
  3661.  
  3662. Procedure TVolumeControl.SetPosition(NewPosition:BYTE);
  3663. Begin
  3664.      If NewPosition=FPosition Then exit;
  3665.      If NewPosition>100 Then NewPosition:=100;
  3666.      If Handle<>0 Then
  3667.      Begin
  3668.           Canvas.Pen.Color:=Color;
  3669.           DrawSlider; {erase old slider}
  3670.           FPosition:=NewPosition;
  3671.           Canvas.Pen.Color:=clBlack;
  3672.           DrawSlider; {draw new slider}
  3673.      End
  3674.      Else FPosition:=NewPosition;
  3675. End;
  3676.  
  3677. Procedure TVolumeControl.DrawBoxes;
  3678. Var rec:TRect;
  3679. Begin
  3680.      rec.Left:=1;
  3681.      rec.Right:=16;
  3682.      rec.Bottom:=5;
  3683.      rec.Top:=20;
  3684.      Canvas.ShadowedBorder(rec,clWhite,clBlack);
  3685.      rec.Left:=Width-16;
  3686.      rec.Right:=Width-1;
  3687.      Canvas.ShadowedBorder(rec,clWhite,clBlack);
  3688.  
  3689.      Canvas.Line(4,12,13,12);
  3690.      Canvas.Line(Width-13,12,Width-4,12);
  3691.      Canvas.Line(Width-8,8,Width-8,17);
  3692. End;
  3693.  
  3694. Procedure TVolumeControl.Redraw(Const rec:TRect);
  3695. Var MiddleX,MiddleY:LONGINT;
  3696.     CircleRadius:LONGINT;
  3697.  
  3698.     Procedure DrawLines(Radius:LONGINT);
  3699.     Var t:LONGINT;
  3700.         ptStart:TPoint;
  3701.         Angle:EXTENDED;
  3702.     Begin
  3703.          Angle:=0;
  3704.          For t:=1 To 34 Do
  3705.          Begin
  3706.               Canvas.Pen.Style:=psClear;
  3707.               Canvas.Arc(MiddleX,MiddleY,Radius Div 2,Radius Div 2,Angle,0);
  3708.               ptStart:=Canvas.PenPos;
  3709.               Canvas.Arc(MiddleX,MiddleY,(Radius+15) Div 2,(Radius+15) Div 2,Angle,0);
  3710.               Canvas.Pen.Style:=psSolid;
  3711.               Canvas.LineTo(ptStart.X,ptStart.Y);
  3712.               Angle:=Angle + 180/33;
  3713.          End;
  3714.     End;
  3715.  
  3716. Begin
  3717.      Canvas.FillRect(rec,Color);
  3718.  
  3719.      GetCircleParams(MiddleX,MiddleY,CircleRadius);
  3720.      Canvas.Pen.Width:=2;
  3721.      Canvas.Pen.Color:=clBlack;
  3722.      Canvas.Circle(MiddleX,MiddleY,CircleRadius Div 2);
  3723.      Canvas.Pen.Color:=clWhite;
  3724.      Canvas.Arc(MiddleX,MiddleY,(CircleRadius-2) Div 2,(CircleRadius-2) Div 2,30,180);
  3725.      Canvas.Pen.Color:=clDkGray;
  3726.      Canvas.Arc(MiddleX,MiddleY,(CircleRadius-2) Div 2,(CircleRadius-2) Div 2,240,130);
  3727.  
  3728.      Canvas.Pen.Width:=1;
  3729.      Canvas.Pen.Color:=PenColor;
  3730.      Canvas.Brush.Color:=Color;
  3731.      DrawLines(CircleRadius+10);
  3732.      DrawSlider;
  3733.      DrawBoxes;
  3734. End;
  3735.  
  3736. Destructor TVolumeControl.Destroy;
  3737. Begin
  3738.      If FAngleTimer<>Nil Then FAngleTimer.Destroy;
  3739.      FAngleTimer:=Nil;
  3740.      Inherited Destroy;
  3741. End;
  3742.  
  3743. Procedure TVolumeControl.PositionChanged;
  3744. Begin
  3745.      If OnPositionChanged<>Nil Then OnPositionChanged(Self);
  3746. End;
  3747.  
  3748.  
  3749. Begin
  3750. End.
  3751.  
  3752.