source: 2.19_branch/Sibyl/SPCC/MMEDIA.PAS@ 376

Last change on this file since 376 was 7, checked in by RBRi, 19 years ago

+ sibyl staff

  • Property svn:eol-style set to native
File size: 114.9 KB
Line 
1
2{ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
3 º º
4 º Sibyl Portable Component Classes º
5 º º
6 º Copyright (c) 1995,97 SpeedSoft Germany, All rights reserved. º
7 º º
8 ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ}
9
10Unit MMedia;
11
12
13Interface
14
15{$r MMedia}
16
17{$IFDEF OS2}
18Uses Os2Def,BseDos,PmWin,PmBitmap;
19{$ENDIF}
20{$IFDEF Win95}
21Uses WinDef,WinBase,WinUser,MMSystem;
22{$ENDIF}
23
24Uses SysUtils,Messages,Classes,Forms,Graphics,StdCtrls,Dialogs,Buttons;
25
26
27Type
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
557Function TimeFormatToString(tf:TTimeFormat):String;
558Function DeviceModeToString(dm:TMCIDeviceMode):String;
559Function MediaTypeToString(mt:TCDMediaTypes):String;
560Function ConvertTimeInfo(Var TimeInfo:TTimeInfo;NewFormat:TTimeFormat):BOOLEAN;
561Function CompareTimeInfos(TimeInfo1,TimeInfo2:TTimeInfo):LONGINT;
562Function TimeInfoToString(Const TimeInfo:TTimeInfo):String;
563
564Implementation
565
566Type
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
586Procedure TMCINotifyControl.CreateWnd; //dummy
587Begin
588 Inherited CreateWnd;
589End;
590
591Procedure TMCINotifyControl.SetupComponent;
592Begin
593 Inherited SetupComponent;
594 Include (ComponentState, csDetail);
595End;
596
597Procedure TMCINotifyControl.MMMCINotify(Var Msg:TMessage);
598Var usNotifyCode,usCommandMessage:WORD;
599 Event:TMCINotifyEvents;
600 usDeviceId:WORD;
601 usUserCode:WORD;
602{$IFDEF Win95}
603Const
604 MCI_NOTIFY_SUCCESSFUL =$0001;
605 MCI_NOTIFY_SUPERSEDED =$0002;
606 MCI_NOTIFY_ABORTED =$0004;
607{$ENDIF}
608{$IFDEF OS2}
609Const
610 MCI_NOTIFY_SUCCESSFUL =$0000;
611 MCI_NOTIFY_SUPERSEDED =$0001;
612 MCI_NOTIFY_ABORTED =$0002;
613{$ENDIF}
614Begin
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;
643End;
644
645
646{$IFDEF OS2}
647Procedure TMCINotifyControl.MMMCIPositionChange(Var Msg:TMessage);
648Var usDeviceId:WORD;
649 usUserCode:WORD;
650 ulmmTime:LONGWORD;
651Begin
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;
663End;
664
665
666Procedure TMCINotifyControl.MMMCICuePoint(Var Msg:TMessage);
667Var usDeviceId:WORD;
668 ulmmTime:LONGWORD;
669 usUserCode:WORD;
670Begin
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;
682End;
683{$ENDIF}
684
685
686{$IFDEF OS2}
687Const
688 MCIERR_SUCCESS=0;
689
690Type
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
765Const
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
785Type
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
794Type
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
852Var 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
868Const MMPM2Initialized:BOOLEAN=FALSE;
869
870Type EProcAddrError=Class(Exception);
871
872Function InitMMPM2:BOOLEAN;
873Var 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;
885Begin
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;
924End;
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
942Function TMCIDevice.GetCanEject:BOOLEAN;
943Begin
944 If Not FDeviceOpen Then OpenDevice;
945 result:=GetMCICapBoolean('can eject');
946End;
947
948Function TMCIDevice.GetCanPlay:BOOLEAN;
949Begin
950 If Not FDeviceOpen Then OpenDevice;
951 result:=GetMCICapBoolean('can play');
952End;
953
954Function TMCIDevice.GetCanRecord:BOOLEAN;
955Begin
956 If Not FDeviceOpen Then OpenDevice;
957 result:=GetMCICapBoolean('can record');
958End;
959
960Function TMCIDevice.GetCanSave:BOOLEAN;
961Begin
962 If Not FDeviceOpen Then OpenDevice;
963 result:=GetMCICapBoolean('can save');
964End;
965
966Function TMCIDevice.GetCanLockEject:BOOLEAN;
967Begin
968 If Not FDeviceOpen Then OpenDevice;
969 result:=GetMCICapBoolean('can lockeject');
970End;
971
972Function TMCIDevice.GetCanSetVolume:BOOLEAN;
973Begin
974 If Not FDeviceOpen Then OpenDevice;
975 result:=GetMCICapBoolean('can setvolume');
976End;
977
978Function TMCIDevice.GetHasAudio:BOOLEAN;
979Begin
980 If Not FDeviceOpen Then OpenDevice;
981 result:=GetMCICapBoolean('has audio');
982End;
983
984Function TMCIDevice.GetHasVideo:BOOLEAN;
985Begin
986 If Not FDeviceOpen Then OpenDevice;
987 result:=GetMCICapBoolean('has video');
988End;
989
990Function TMCIDevice.GetUsesFiles:BOOLEAN;
991Begin
992 If Not FDeviceOpen Then OpenDevice;
993 result:=GetMCICapBoolean('uses files');
994End;
995
996Procedure TMCIDevice.SetFileName(Const NewValue:String);
997Begin
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;
1005End;
1006
1007Function TMCIDevice.GetFileName:String;
1008Begin
1009 If FFileName<>Nil Then result:=FFileName^
1010 Else result:='';
1011End;
1012
1013Procedure TMCIDevice.GetDefaultFileMask(Var Ext,Description:String);
1014Begin
1015 Ext:='*.*';
1016 Description:=LoadNLSStr(SAllFiles);
1017End;
1018
1019Function TMCIDevice.GetMCIStatusNumber(Const option:String):LONGINT;
1020Var c:INTEGER;
1021Begin
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;
1027End;
1028
1029Function TMCIDevice.GetMCIStatusBoolean(Const option:String):BOOLEAN;
1030Var temp:LONGINT;
1031Begin
1032 temp:=GetMCIStatusNumber(option);
1033 result:=FLastMCIReturn='TRUE';
1034End;
1035
1036Function TMCIDevice.GetMCICapBoolean(Const Option:String):BOOLEAN;
1037Begin
1038 result:=FALSE;
1039 If Not SendString('capability '+AliasName+' '+Option+' wait',0) Then exit;
1040 result:=FLastMCIReturn='TRUE';
1041End;
1042
1043Function TMCIDevice.GetMCICapLong(Const Option:String):LONGWORD;
1044Var c:INTEGER;
1045Begin
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;
1050End;
1051
1052Function TMCIDevice.GetDeviceReady:BOOLEAN;
1053Begin
1054 result:=GetMCIStatusBoolean('ready');
1055End;
1056
1057Const 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
1069Function DeviceModeToString(dm:TMCIDeviceMode):String;
1070Begin
1071 result:=DeviceModesArray[dm];
1072End;
1073
1074Function TMCIDevice.Cue(CueFor:TCueTypes):BOOLEAN;
1075Var s:String[10];
1076Begin
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;
1083End;
1084
1085
1086Procedure TMCIDevice.SetPositionAdvise(NewValue:BOOLEAN);
1087Var SaveFormat:TTimeFormat;
1088Begin
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;
1117End;
1118
1119Function TMCIDevice.GetDeviceId:LONGWORD;
1120Begin
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}
1129End;
1130
1131Function TMCIDevice.GetDeviceMode:TMCIDeviceMode;
1132Var t:TMCIDeviceMode;
1133Begin
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
1144End;
1145
1146Function TMCIDevice.GetMediaPresent:BOOLEAN;
1147Begin
1148 result:=GetMCIStatusBoolean('media present');
1149End;
1150
1151Function TMCIDevice.GetChannels:LONGINT;
1152Begin
1153 result:=GetMCIStatusNumber('channels');
1154End;
1155
1156Function TMCIDevice.GetCurrentTrack:LONGINT;
1157Begin
1158 result:=GetMCIStatusNumber('current track');
1159End;
1160
1161Procedure TMCIDevice.NextTrack;
1162Begin
1163End;
1164
1165Procedure TMCIDevice.PreviousTrack;
1166Begin
1167End;
1168
1169
1170Function TMCIDevice.GetTrackLength(Track:LONGINT):TTimeInfo;
1171Begin
1172 If Track=0 Then Track:=CurrentTrack;
1173 result:=GetMCITimeInfo('length track '+tostr(track));
1174End;
1175
1176Function TMCIDevice.GetMCITimeInfo(Const option:String):TTimeInfo;
1177Var 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
1204Begin
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;
1244End;
1245
1246Function TMCIDevice.GetPosition:TTimeInfo;
1247Begin
1248 result:=GetMCITimeInfo('position');
1249End;
1250
1251Function TMCIDevice.GetLength:TTimeInfo;
1252Begin
1253 result:=GetMCITimeInfo('length');
1254End;
1255
1256Function TMCIDevice.GetVolume(Channel:TChannel):LONGINT;
1257Var s,s1:String;
1258 b:BYTE;
1259 c:INTEGER;
1260 Temp,Temp1:LONGINT;
1261Begin
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;
1286End;
1287
1288Procedure TMCIDevice.SetVolume(Channel:TChannel;NewVolume:LONGINT);
1289Var s:String;
1290Begin
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);
1298End;
1299
1300Function CompareTimeInfos(TimeInfo1,TimeInfo2:TTimeInfo):LONGINT;
1301Label process;
1302Begin
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}
1325process:
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}
1333End;
1334
1335Function ConvertTimeInfo(Var TimeInfo:TTimeInfo;NewFormat:TTimeFormat):BOOLEAN;
1336Var OldFormat:LONGWORD;
1337Begin
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;
1468End;
1469
1470Const 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
1488Function TimeFormatToString(tf:TTimeFormat):String;
1489Begin
1490 result:=TimeFormatsArray[tf];
1491End;
1492
1493Function 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
1500Begin
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}
1518End;
1519
1520Procedure TMCIDevice.SetTimeFormat(NewFormat:TTimeFormat);
1521Begin
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;
1532End;
1533
1534Function TMCIDevice.GetTracks:LONGINT;
1535Begin
1536 result:=GetMCIStatusNumber('number of tracks');
1537End;
1538
1539Procedure TMCIDevice.HandleMCIError(Const ErrorStr:String);
1540Begin
1541 ErrorBox(ErrorStr);
1542 If FDeviceOpen Then //clear error condition
1543 Begin
1544 CloseDevice;
1545 OpenDevice;
1546 End;
1547End;
1548
1549Procedure TMCIDevice.ShowMCIError(Code:LONGWORD);
1550Var
1551 ErrBuff:Cstring;
1552 s:String;
1553 ret:LONGWORD;
1554Begin
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}
1575End;
1576
1577Procedure TMCIDevice.SeekToStart;
1578Begin
1579 Load;
1580 Stop;
1581 SendString('seek '+AliasName+' to start wait',0);
1582 PositionChanged(Position);
1583End;
1584
1585Procedure TMCIDevice.SeekToEnd;
1586Begin
1587 Load;
1588 Stop;
1589 SendString('seek '+AliasName+' to End wait',0);
1590 PositionChanged(Position);
1591End;
1592
1593Function TMCIDevice.TimeInfoStr(TimeInfo:TTimeInfo;SaveTime:TTimeFormat):String;
1594Begin
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}
1621End;
1622
1623Procedure TMCIDevice.Seek(NewPos:TTimeInfo);
1624Var s:String;
1625 SaveTime:TTimeFormat;
1626Begin
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);
1634End;
1635
1636Procedure TMCIDevice.Cut(StartPos,EndPos:TTimeInfo);
1637Var s:String;
1638 SaveTime:TTimeFormat;
1639Begin
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);
1647End;
1648
1649
1650Procedure TMCIDevice.Copy(StartPos,EndPos:TTimeInfo);
1651Var s:String;
1652 SaveTime:TTimeFormat;
1653Begin
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);
1661End;
1662
1663Procedure TMCIDevice.Paste(StartPos,EndPos:TTimeInfo);
1664Var s:String;
1665 SaveTime:TTimeFormat;
1666Begin
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);
1674End;
1675
1676
1677Procedure TMCIDevice.StartRecording;
1678Begin
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;
1688End;
1689
1690Procedure TMCIDevice.Play;
1691Begin
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;
1709End;
1710
1711Procedure TMCIDevice.SetPositionAdviseUnits(NewUnits:TTimeInfo);
1712Begin
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;
1720End;
1721
1722Procedure TMCIDevice.Resume;
1723Begin
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;
1735End;
1736
1737Procedure TMCIDevice.Pause;
1738Begin
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;
1747End;
1748
1749Procedure TMCIDevice.Stop;
1750Begin
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;
1761End;
1762
1763Function TMCIDevice.SendString(Const s:String;usUserParm:WORD):BOOLEAN;
1764Var
1765 lmciSendStringRC:LONG; /* return value fromm mciSendString */
1766 szReturn:Cstring;
1767 c:Cstring;
1768 Handle:LONGWORD;
1769Begin
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;
1797End;
1798
1799
1800Function TMCIDevice.AddCuePoint(Const CuePoint:TTimeInfo):LONGWORD;
1801Var SaveFormat:TTimeFormat;
1802Begin
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;
1813End;
1814
1815Function TMCIDevice.DeleteCuePoint(Const CuePoint:TTimeInfo):BOOLEAN;
1816Var SaveFormat:TTimeFormat;
1817Begin
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;
1824End;
1825
1826Procedure TMCIDevice.CloseDevice;
1827Begin
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;
1843End;
1844
1845Procedure TMCIDevice.OpenDevice;
1846Var tf:TTimeFormat;
1847Begin
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;
1864End;
1865
1866
1867Procedure TMCIDevice.SetupComponent;
1868Var PosAdviseUnits:TTimeInfo;
1869Begin
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;
1889End;
1890
1891Procedure TMCIDevice.Load;
1892Var mciStr:String;
1893Begin
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;
1924End;
1925
1926Procedure TMCIDevice.SetDeviceName(NewName:String);
1927Begin
1928 If FDeviceName<>Nil Then FreeMem(FDeviceName,System.length(FDeviceName^)+1);
1929 getmem(FDeviceName,System.length(NewName)+1);
1930 FDeviceName^:=NewName;
1931End;
1932
1933Function TMCIDevice.GetDeviceName:String;
1934Begin
1935 If FDeviceName<>Nil Then result:=FDeviceName^
1936 Else result:='';
1937End;
1938
1939Procedure TMCIDevice.SetAliasName(NewName:String);
1940Begin
1941 If FAliasName<>Nil Then FreeMem(FAliasName,System.length(FAliasName^)+1);
1942 getmem(FAliasName,System.length(NewName)+1);
1943 FAliasName^:=NewName;
1944End;
1945
1946Function TMCIDevice.GetAliasName:String;
1947Begin
1948 If FAliasName<>Nil Then result:=FAliasName^
1949 Else result:='';
1950End;
1951
1952Destructor TMCIDevice.Destroy;
1953Begin
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;
1962End;
1963
1964Function TMCIDevice.WriteSCUResource(Stream:TResourceStream):BOOLEAN;
1965Var s:String;
1966Begin
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);
1972End;
1973
1974Procedure TMCIDevice.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LONgiNT);
1975Var s:String;
1976Begin
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);
1986End;
1987
1988Procedure TMCIDevice.PlayingCompleted;
1989Begin
1990 If FOnPlayingCompleted<>Nil Then FOnPlayingCompleted(Self);
1991End;
1992
1993Procedure TMCIDevice.PlayingAborted;
1994Begin
1995 If FOnPlayingAborted<>Nil Then FOnPlayingAborted(Self);
1996End;
1997
1998{$HINTS OFF}
1999Procedure TMCIDevice.CuePointReached(Const CuePoint:TTimeInfo;CuePointId:LONGWORD);
2000Begin
2001 If OnCuePointReached<>Nil Then OnCuePointReached(Self,CuePoint,CuePointId);
2002End;
2003
2004Procedure TMCIDevice.PositionChanged(Const NewPosition:TTimeInfo);
2005Begin
2006 If OnPositionChanged<>Nil Then OnPositionChanged(Self,NewPosition);
2007End;
2008{$HINTS ON}
2009
2010Procedure TMCIDevice.MCIEvent(Event:TMCINotifyEvents;ulDeviceId,ulNotifyCode,ulUserCOde:LONGWORD);
2011Var TimeInfo:TTimeInfo;
2012 LinkList:TList;
2013 t:LONGINT;
2014 Component:TComponent;
2015Begin
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;
2067End;
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
2083Function TVideoDevice.GetCapabilities:TVideoDeviceCapabilities;
2084Begin
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');
2099End;
2100
2101Procedure TVideoDevice.Seek(NewPos:TTimeInfo);
2102Begin
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}
2110End;
2111
2112Procedure TVideoDevice.SeekToStart;
2113Begin
2114 OpenDevice;
2115 Inherited SeekToStart;
2116
2117 {$IFDEF OS2}
2118 {SendString('step '+AliasName+' wait',0);
2119 SendString('step '+AliasName+' reverse wait',0);}
2120 {$ENDIF}
2121End;
2122
2123Procedure TVideoDevice.SetupComponent;
2124Var PosAdviseUnits:TTimeInfo;
2125Begin
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;
2141End;
2142
2143Procedure TVideoDevice.GetDefaultFileMask(Var Ext,Description:String);
2144Begin
2145 Ext:='*.AVI';
2146 Description:=LoadNLSStr(SVideoFiles);
2147End;
2148
2149Procedure TVideoDevice.Load;
2150Var
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}
2168Begin
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;
2301End;
2302
2303Function TVideoDevice.GetBitsPerSample:LONGINT;
2304Begin
2305 result:=GetMCIStatusNumber('bitspersample');
2306End;
2307
2308Function TVideoDevice.GetImageBitsPerPel:LONGINT;
2309Begin
2310 result:=GetMCIStatusNumber('image bitsperpel');
2311End;
2312
2313Function TVideoDevice.GetImagePelFormat:String;
2314Begin
2315 GetMCIStatusNumber('image pelformat');
2316 result:=FLastMCIReturn;
2317End;
2318
2319Function TVideoDevice.GetBrightness:LONGINT;
2320Begin
2321 result:=GetMCIStatusNumber('brightness');
2322End;
2323
2324Function TVideoDevice.GetContrast:LONGINT;
2325Begin
2326 result:=GetMCIStatusNumber('contrast');
2327End;
2328
2329Function TVideoDevice.GetHue:LONGINT;
2330Begin
2331 result:=GetMCIStatusNumber('hue');
2332End;
2333
2334Function TVideoDevice.GetClipBoardDataAvail:BOOLEAN;
2335Begin
2336 result:=GetMCIStatusBoolean('clipboard');
2337End;
2338
2339Function TVideoDevice.GetSaturation:LONGINT;
2340Begin
2341 result:=GetMCIStatusNumber('saturation');
2342End;
2343
2344Function TVideoDevice.GetSamplesPerSec:LONGINT;
2345Begin
2346 result:=GetMCIStatusNumber('samplespersec');
2347End;
2348
2349Function TVideoDevice.GetTunerTVChannel:LONGINT;
2350Begin
2351 result:=GetMCIStatusNumber('tuner tv channel');
2352End;
2353
2354Function TVideoDevice.GetTunerFineTune:LONGINT;
2355Begin
2356 result:=GetMCIStatusNumber('tuner finetune');
2357End;
2358
2359Function TVideoDevice.GetTunerFrequency:LONGINT;
2360Begin
2361 result:=GetMCIStatusNumber('tuner frequency');
2362End;
2363
2364Function TVideoDevice.GetValidSignal:BOOLEAN;
2365Begin
2366 result:=GetMCIStatusBoolean('valid signal');
2367End;
2368
2369Procedure TVideoDevice.SetBrightness(NewValue:LONGINT);
2370Begin
2371 SendString('set '+AliasName+' brightness '+tostr(NewValue)+' wait',0);
2372End;
2373
2374Procedure TVideoDevice.SetContrast(NewValue:LONGINT);
2375Begin
2376 SendString('set '+AliasName+' contrast '+tostr(NewValue)+' wait',0);
2377End;
2378
2379Procedure TVideoDevice.SetHue(NewValue:LONGINT);
2380Begin
2381 SendString('set '+AliasName+' hue '+tostr(NewValue)+' wait',0);
2382End;
2383
2384Procedure TVideoDevice.SetSaturation(NewValue:LONGINT);
2385Begin
2386 SendString('set '+AliasName+' saturation '+tostr(NewValue)+' wait',0);
2387End;
2388
2389Procedure TVideoDevice.SetSamplesPerSec(NewValue:LONGINT);
2390Begin
2391 SendString('set '+AliasName+' samplespersec '+tostr(NewValue)+' wait',0);
2392End;
2393
2394Procedure TVideoDevice.SetTunerTVChannel(NewValue:LONGINT);
2395Begin
2396 SendString('settuner '+AliasName+' tv channel '+tostr(NewValue)+' wait',0);
2397End;
2398
2399Procedure TVideoDevice.SetTunerFineTune(NewValue:LONGINT);
2400Var Temp:LONGINT;
2401 s:String[10];
2402Begin
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);
2408End;
2409
2410Procedure TVideoDevice.SetTunerFrequency(NewValue:LONGINT);
2411Begin
2412 SendString('settuner '+AliasName+' frequency '+tostr(NewValue)+' wait',0);
2413End;
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
2429Procedure TAudioDevice.SetBitsPerSample(NewValue:LONGINT);
2430Begin
2431 SendString('set '+AliasName+' bitspersample '+tostr(NewValue)+' wait',0);
2432End;
2433
2434Procedure TAudioDevice.SetBytesPerSec(NewValue:LONGINT);
2435Begin
2436 SendString('set '+AliasName+' bytespersec '+tostr(NewValue)+' wait',0);
2437End;
2438
2439Procedure TAudioDevice.SetSamplesPerSec(NewValue:LONGINT);
2440Begin
2441 SendString('set '+AliasName+' samplespersec '+tostr(NewValue)+' wait',0);
2442End;
2443
2444Function TAudioDevice.GetAlignment:LONGINT;
2445Begin
2446 result:=GetMCIStatusNumber('alignment');
2447End;
2448
2449Function TAudioDevice.GetBitsPerSample:LONGINT;
2450Begin
2451 result:=GetMCIStatusNumber('bitspersample');
2452End;
2453
2454Function TAudioDevice.GetBytesPerSec:LONGINT;
2455Begin
2456 result:=GetMCIStatusNumber('bytespersec');
2457End;
2458
2459Function TAudioDevice.GetSamplesPerSec:LONGINT;
2460Begin
2461 result:=GetMCIStatusNumber('samplespersec');
2462End;
2463
2464Procedure TAudioDevice.SetupComponent;
2465Begin
2466 Inherited SetupComponent;
2467 AliasName:='Sibyl_audio';
2468 DeviceName:='waveaudio';
2469 Name:='AudioDevice';
2470 FTimeFormatsAvailable:=[tfMilliseconds,tfMMtime,tfBytes,tfSamples];
2471End;
2472
2473Procedure TAudioDevice.GetDefaultFileMask(Var Ext,Description:String);
2474Begin
2475 Ext:='*.WAV';
2476 Description:=LoadNLSStr(SWaveFiles);
2477End;
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
2494Procedure TCDDevice.NextTrack;
2495Var OldStatus:TMCIStatus;
2496 trk:LONGINT;
2497Begin
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;
2505End;
2506
2507Procedure TCDDevice.PreviousTrack;
2508Var OldStatus:TMCIStatus;
2509 trk:LONGINT;
2510 ti:TTimeInfo;
2511Begin
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;
2522End;
2523
2524Procedure TCDDevice.SetupComponent;
2525Begin
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;
2534End;
2535
2536
2537Function TCDDevice.GetTrackChannels(Track:LONGINT):LONGINT;
2538Begin
2539 If Track=0 Then Track:=CurrentTrack;
2540 result:=GetMCIStatusNumber('channels track '+tostr(Track));
2541End;
2542
2543
2544Function TCDDevice.GetTrackPosition(Track:LONGINT):TTimeInfo;
2545Begin
2546 If Track=0 Then Track:=CurrentTrack;
2547 result:=GetMCITimeInfo('position track '+tostr(track));
2548End;
2549
2550Function TCDDevice.GetPositionInTrack:TTimeInfo;
2551Begin
2552 result:=GetMCITimeInfo('position in track');
2553End;
2554
2555Function TCDDevice.GetStartPosition:TTimeInfo;
2556Begin
2557 result:=GetMCITimeInfo('start position');
2558End;
2559
2560Const MediaTypesArray:Array[mtAudio..mtUnknown] Of String[8]=
2561 (
2562 'audio',
2563 'data',
2564 'other',
2565 'unknown'
2566 );
2567
2568Function MediaTypeToString(mt:TCDMediaTypes):String;
2569Begin
2570 result:=MediaTypesArray[mt];
2571End;
2572
2573Function TCDDevice.GetMediaType:TCDMediaTypes;
2574Var t:TCDMediaTypes;
2575Begin
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;
2585End;
2586
2587Function TCDDevice.GetTrackType(Track:LONGINT):TCDMediaTypes;
2588Var t:TCDMediaTypes;
2589Begin
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;
2600End;
2601
2602Function TCDDevice.GetCapabilities:TCDDeviceCapabilities;
2603Begin
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');
2608End;
2609
2610Procedure TCDDevice.Eject;
2611Begin
2612 If Not FDeviceOpen Then OpenDevice;
2613 SendString('set '+AliasName+' door open wait',0);
2614End;
2615
2616Procedure TCDDevice.Close;
2617Begin
2618 If Not FDeviceOpen Then OpenDevice;
2619 SendString('set '+AliasName+' door closed wait',0);
2620End;
2621
2622Procedure TCDDevice.LockDoor;
2623Begin
2624 If Not FDeviceOpen Then OpenDevice;
2625 SendString('set '+AliasName+' door locked wait',0);
2626End;
2627
2628Procedure TCDDevice.UnlockDoor;
2629Begin
2630 If Not FDeviceOpen Then OpenDevice;
2631 SendString('set '+AliasName+' door unlocked wait',0);
2632End;
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
2648Procedure TVideoWindow.PlayingCompleted;
2649Begin
2650 If FOnPlayingCompleted<>Nil Then FOnPlayingCompleted(Self);
2651End;
2652
2653Procedure TVideoWindow.PlayingAborted;
2654Begin
2655 If FOnPlayingAborted<>Nil Then FOnPlayingAborted(Self);
2656End;
2657
2658{$HINTS OFF}
2659Procedure TVideoWindow.CuePointReached(Const CuePoint:TTimeInfo;CuePointId:LONGWORD);
2660Begin
2661 If OnCuePointReached<>Nil Then OnCuePointReached(Self,CuePoint,CuePointId);
2662End;
2663
2664Procedure TVideoWindow.PositionChanged(Const NewPosition:TTimeInfo);
2665Begin
2666 If OnPositionChanged<>Nil Then OnPositionChanged(Self,NewPosition);
2667End;
2668{$HINTS ON}
2669
2670Procedure TVideoWindow.MCIEvent(Event:TMCINotifyEvents;ulDeviceId,ulNotifyCode,ulUSerCode:LONGWORD);
2671Var TimeInfo:TTimeInfo;
2672Begin
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}
2715End;
2716
2717Procedure TVideoWindow.SetupComponent;
2718Begin
2719 Inherited SetupComponent;
2720
2721 Name:='VideoWindow';
2722 Caption:=Name;
2723 Height:=200;
2724 Width:=200;
2725 ParentPenColor:=FALSE;
2726 ParentColor:=TRUE;
2727End;
2728
2729Procedure TVideoWindow.Redraw(Const rc:TRect);
2730Var rec:TRect;
2731Begin
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;
2747End;
2748
2749Function TVideoWindow.DoesFileExist(pszFileName:String):BOOLEAN;
2750{$IFDEF OS2}
2751Const
2752 bReturn:ULONG=0;
2753 rc:ULONG=MMIO_SUCCESS;
2754Var
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}
2764Begin
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}
2829End;
2830
2831Procedure TVideoWindow.SetVideoDevice(NewDevice:TVideoDevice);
2832Begin
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;
2840End;
2841
2842Procedure TVideoWindow.Notification(AComponent:TComponent;Operation:TOperation);
2843Begin
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;
2853End;
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
2869Procedure TMediaPlayer.SetMCIDevice(NewDevice:TMCIDevice);
2870Begin
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);
2880End;
2881
2882
2883Procedure TMediaPlayer.Notification(AComponent:TComponent;Operation:TOperation);
2884Begin
2885 Inherited Notification(AComponent,Operation);
2886
2887 If Operation = opRemove Then
2888 If AComponent = FMCIDevice Then FMCIDevice := Nil;
2889End;
2890
2891
2892Procedure TMediaPlayer.PlayingAborted;
2893Begin
2894 EnabledButtons:=EnabledButtons-[btPause,btStop];
2895 If FOnPlayingAborted<>Nil Then FOnPlayingAborted(Self);
2896End;
2897
2898Procedure TMediaPlayer.PlayingCompleted;
2899Begin
2900 EnabledButtons:=EnabledButtons-[btPause,btStop];
2901 If FOnPlayingCompleted<>Nil Then FOnPlayingCompleted(Self);
2902End;
2903
2904{$HINTS OFF}
2905Procedure TMediaPlayer.PositionChanged(Const NewPosition:TTimeInfo);
2906Begin
2907 If OnPositionChanged<>Nil Then OnPositionChanged(Self,NewPosition);
2908End;
2909
2910Procedure TMediaPlayer.CuePointReached(Const CuePoint:TTimeInfo;CuePointId:LONGWORD);
2911Begin
2912 If OnCuePointReached<>Nil Then OnCuePointReached(Self,CuePoint,CuePointId);
2913End;
2914
2915Procedure TMediaPlayer.MCIEvent(Event:TMCINotifyEvents;ulDeviceId,ulNotifyCode,ulUSerCode:LONGWORD);
2916Var TimeInfo:TTimeInfo;
2917Begin
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;
2979End;
2980{$HINTS ON}
2981
2982
2983Procedure TMediaPlayer.EvButtonClick(Sender:TObject);
2984Var DoDefault:BOOLEAN;
2985 BtnType:TMPBtnType;
2986Begin
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;
3005End;
3006
3007
3008Function TMediaPlayer.GetButton(Index:TMPBtnType):TBitBtn;
3009Begin
3010 Result := FButtons[Index];
3011End;
3012
3013
3014Procedure TMediaPlayer.CreateWnd;
3015Begin
3016 Inherited CreateWnd;
3017
3018 RealignControls;
3019End;
3020
3021
3022Procedure 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;
3039Var FNextTrkButton:TBitBtn;
3040 FPrevTrkButton:TBitBtn;
3041 FPauseButton:TBitBtn;
3042 FRewindButton:TBitBtn;
3043 FStopButton:TBitBtn;
3044 FBackTrkButton:TBitBtn;
3045 FStepTrkButton:TBitBtn;
3046 FEjectButton:TBitBtn;
3047Begin
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;
3098End;
3099
3100
3101Destructor TMediaPlayer.Destroy;
3102Begin
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;
3114End;
3115
3116
3117Function TMediaPlayer.GetFileName:String;
3118Begin
3119 If MCIDevice<>Nil Then result:=MCIDevice.FileName
3120 Else If FFileName<>Nil Then result:=FFileName^
3121 Else Result:='';
3122End;
3123
3124
3125Procedure TMediaPlayer.SetFileName(NewName:String);
3126Begin
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;
3134End;
3135
3136
3137Procedure TMediaPlayer.SetVisibleButtons(NewState:TMPButtonSet);
3138Var idx:TMPBtnType;
3139Begin
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;
3147End;
3148
3149
3150Procedure TMediaPlayer.SetEnabledButtons(NewState:TMPButtonSet);
3151Var idx:TMPBtnType;
3152Begin
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;
3160End;
3161
3162
3163Procedure TMediaPlayer.RealignControls;
3164Var x:LONGINT;
3165 count,w:LONGINT;
3166 idx:TMPBtnType;
3167Begin
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;
3193End;
3194
3195Procedure TMediaPlayer.Open;
3196Var s:String;
3197 DevType:TMPDeviceTypes;
3198Begin
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;
3272End;
3273
3274
3275Procedure TMediaPlayer.Play;
3276Begin
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;
3288End;
3289
3290
3291Procedure TMediaPlayer.StartRecording;
3292Begin
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;
3303End;
3304
3305
3306Procedure TMediaPlayer.Stop;
3307Begin
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;
3316End;
3317
3318
3319Procedure TMediaPlayer.Next;
3320Var WasPlaying:Boolean;
3321Begin
3322 If MCIDevice<>Nil Then
3323 Begin
3324 WasPlaying:=MCIDevice.Status=mciPlaying;
3325 Stop;
3326 MCIDevice.NextTrack;
3327 If WasPlaying Then Play;
3328 End;
3329End;
3330
3331
3332Procedure TMediaPlayer.Previous;
3333Var WasPlaying:Boolean;
3334Begin
3335 If MCIDevice<>Nil Then
3336 Begin
3337 WasPlaying:=MCIDevice.Status=mciPlaying;
3338 Stop;
3339 MCIDevice.PreviousTrack;
3340 If WasPlaying Then Play;
3341 End;
3342End;
3343
3344
3345Procedure TMediaPlayer.Pause;
3346Begin
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;
3365End;
3366
3367
3368Procedure TMediaPlayer.Rewind;
3369Begin
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;
3378End;
3379
3380
3381Procedure TMediaPlayer.Close;
3382Begin
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;
3391End;
3392
3393Procedure TMediaPlayer.Step;
3394Var ti:TTimeInfo;
3395Begin
3396 If MCIDevice<>Nil Then
3397 Begin
3398 ti:=MCIDevice.Position;
3399 ti.Unknown:=ti.Unknown+Frames;
3400 MCIDevice.Seek(ti);
3401 End;
3402End;
3403
3404Procedure TMediaPlayer.Back;
3405Var ti:TTimeInfo;
3406Begin
3407 If MCIDevice<>Nil Then
3408 Begin
3409 ti:=MCIDevice.Position;
3410 ti.Unknown:=ti.Unknown-Frames;
3411 MCIDevice.Seek(ti);
3412 End;
3413End;
3414
3415Procedure TMediaPlayer.Eject;
3416Begin
3417 If MCIDevice Is TCDDevice Then
3418 Begin
3419 TCDDevice(MCIDevice).Eject;
3420 End;
3421End;
3422
3423Procedure TMediaPlayer.SetDeviceType(NewValue:TMPDeviceTypes);
3424Var WasOpened:BOOLEAN;
3425Begin
3426 If NewValue<>DeviceType Then
3427 Begin
3428 WasOpened:=FOpened;
3429 Close;
3430 FDeviceType:=NewValue;
3431 If WasOpened Then Open;
3432 End;
3433End;
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
3450Function TVolumeControl.InsideCircle(MiddleX,MiddleY,Radius:LONGINT;Const pt:TPoint;Var Angle:LONGINT):BOOLEAn;
3451Var
3452 a,b:LONGINT;
3453 temp:Extended;
3454 OldRad:BOOLEAN;
3455 OldToRad:EXTENDED;
3456 OldFromRad:EXTENDED;
3457Begin
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;
3499End;
3500
3501{$HINTS OFF}
3502Procedure TVolumeControl.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LONgiNT);
3503Var MiddleX,MiddleY,CircleRadius:LONGINT;
3504 Angle:LONGINT;
3505 rec:TRect;
3506Label found;
3507Begin
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
3516found:
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;
3563End;
3564
3565Procedure TVolumeControl.MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LONGInt);
3566Begin
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;
3580End;
3581
3582
3583Procedure TVolumeControl.MouseMove(ShiftState:TShiftState;X,Y:LONGINT);
3584Var MiddleX,MiddleY,CircleRadius:LONGINT;
3585 Angle:LONGINT;
3586Begin
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;
3601End;
3602{$HINTS ON}
3603
3604Procedure TVolumeControl.EvTimer(Sender:TObject);
3605Var t,Ende:LONGINT;
3606Begin
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;
3625End;
3626
3627Procedure TVolumeControl.SetupComponent;
3628Begin
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;
3638End;
3639
3640Procedure TVolumeControl.GetCircleParams(Var MiddleX,MiddleY,CircleRadius:LONGINT);
3641Begin
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);
3647End;
3648
3649Procedure TVolumeControl.DrawSlider;
3650Var MiddleX,MiddleY:LONGINT;
3651 CircleRadius:LONGINT;
3652 Angle:EXTENDED;
3653Begin
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);
3660End;
3661
3662Procedure TVolumeControl.SetPosition(NewPosition:BYTE);
3663Begin
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;
3675End;
3676
3677Procedure TVolumeControl.DrawBoxes;
3678Var rec:TRect;
3679Begin
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);
3692End;
3693
3694Procedure TVolumeControl.Redraw(Const rec:TRect);
3695Var 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
3716Begin
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;
3734End;
3735
3736Destructor TVolumeControl.Destroy;
3737Begin
3738 If FAngleTimer<>Nil Then FAngleTimer.Destroy;
3739 FAngleTimer:=Nil;
3740 Inherited Destroy;
3741End;
3742
3743Procedure TVolumeControl.PositionChanged;
3744Begin
3745 If OnPositionChanged<>Nil Then OnPositionChanged(Self);
3746End;
3747
3748
3749Begin
3750End.
3751
Note: See TracBrowser for help on using the repository browser.