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