unit MCLMain; {$I options.inc} interface uses Windows, Graphics, Classes, Controls, Forms, SysUtils, MMSystem, BasicDef, MclDef; // registers the library; in source code this has no function function MclRegister (regCode: QcharP): Qbool; stdcall; // for simple conversions only function MclSimpleConvert (outputFile, inputVideo, inputAudio: QcharP; resX, resY: Qint; frameRate: Qfloat): Qresult; stdcall; // simple loading and saving of images // mImg must be previously created with ImgCreate and released with ImgFree when not needed anymore function MclSimpleReadFirstImage (fileName: QcharP; mImg: QmclImg): Qresult; stdcall; function MclSimpleReadImage (fileName: QcharP; frameNum: Qint; mImg: QmclImg): Qresult; stdcall; function MclSimpleWriteImage (mImg: QmclImg; fileName: QcharP; codecId: Qint; quality: Qfloat): Qresult; stdcall; // allocate and free conversion-handle function MclCreate: QmclOut; stdcall; procedure MclFree (mOut: QmclOut); stdcall; // video output format procedure MclVideoSetFileName (mOut: QmclOut; fileName: QcharP); stdcall; procedure MclVideoGetFileName (mOut: QmclOut; fileName: QcharP); stdcall; procedure MclVideoSetFileFormat (mOut: QmclOut; fileFmtId: Qint); stdcall; function MclVideoGetFileFormat (mOut: QmclOut): Qint; stdcall; procedure MclVideoSetFormat (mOut: QmclOut; resX, resY, bpp: Qint); stdcall; procedure MclVideoGetFormat (mOut: QmclOut; var resX, resY, bpp: Qint); stdcall; procedure MclVideoSetDpi (mOut: QmclOut; dpiX, dpiY: Qint); stdcall; procedure MclVideoGetDpi (mOut: QmclOut; var dpiX, dpiY: Qint); stdcall; procedure MclVideoSetCodec (mOut: QmclOut; codecId: Qint); stdcall; function MclVideoGetCodec (mOut: QmclOut): Qint; stdcall; function MclVideoGetCodecName (mOut: QmclOut): QcharP; stdcall; procedure MclVideoSetCodecData (mOut: QmclOut; codecDataP: pointer; codecDataSize: Qint); stdcall; function MclVideoGetCodecData (mOut: QmclOut; codecDataP: pointer): Qint; stdcall; procedure MclVideoSetBitRate (mOut: QmclOut; kbps, minKbps, maxKbps: Qint); stdcall; procedure MclVideoGetBitRate (mOut: QmclOut; var kbps, minKbps, maxKbps: Qint); stdcall; procedure MclVideoSetQuality (mOut: QmclOut; quality: Qfloat); stdcall; function MclVideoGetQuality (mOut: QmclOut): Qfloat; stdcall; function MclVideoHasCodecDlg (mOut: QmclOut): Qbool; stdcall; function MclVideoShowCodecDlg (mOut: QmclOut): Qbool; stdcall; function MclVideoAviCodecConfigDlg (mOut: QmclOut): Qbool; stdcall; procedure MclVideoMpegSetClosedGOP (mOut: QmclOut; closeGOP: Qbool); stdcall; function MclVideoMpegGetClosedGOP (mOut: QmclOut): Qbool; stdcall; procedure MclVideoSetDithering (mOut: QmclOut; ditheringType: Qint); stdcall; function MclVideoGetDithering (mOut: QmclOut): Qint; stdcall; procedure MclVideoSetFrameRate (mOut: QmclOut; frameRate: Qfloat); stdcall; function MclVideoGetFrameRate (mOut: QmclOut): Qfloat; stdcall; procedure MclVideoSetKeepDuration (mOut: QmclOut; keepDuration: Qbool); stdcall; function MclVideoGetKeepDuration (mOut: QmclOut): Qbool; stdcall; procedure MclVideoSetKeyFrameRate (mOut: QmclOut; keyFrameEvery: Qint); stdcall; function MclVideoGetKeyFrameRate (mOut: QmclOut): Qint; stdcall; procedure MclVideoSetAspectRatio (mOut: QmclOut; aspectRatioCode: Qint); stdcall; function MclVideoGetAspectRatio (mOut: QmclOut): Qint; stdcall; // audio output format procedure MclAudioSetFileName (mOut: QmclOut; fileName: QcharP); stdcall; procedure MclAudioGetFileName (mOut: QmclOut; fileName: QcharP); stdcall; procedure MclAudioSetFileFormat (mOut: QmclOut; fileFmtId: Qint); stdcall; function MclAudioGetFileFormat (mOut: QmclOut): Qint; stdcall; procedure MclAudioSetFormat (mOut: QmclOut; sampleRate, channels, bitsPerChannel: Qint); stdcall; procedure MclAudioGetFormat (mOut: QmclOut; var sampleRate, channels, bitsPerChannel: Qint); stdcall; procedure MclAudioSetCodec (mOut: QmclOut; codecId: Qint); stdcall; function MclAudioGetCodec (mOut: QmclOut): Qint; stdcall; function MclAudioGetCodecName (mOut: QmclOut): QcharP; stdcall; procedure MclAudioSetCodecData (mOut: QmclOut; codecDataP: pointer); stdcall; function MclAudioGetCodecData (mOut: QmclOut; codecDataP: pointer): Qint; stdcall; procedure MclAudioSetBitRate (mOut: QmclOut; kbps: Qint); stdcall; function MclAudioGetBitRate (mOut: QmclOut): Qint; stdcall; procedure MclAudioSetQuality (mOut: QmclOut; quality: Qfloat); stdcall; function MclAudioGetQuality (mOut: QmclOut): Qfloat; stdcall; function MclAudioHasCodecDlg (mOut: QmclOut): Qbool; stdcall; function MclAudioShowCodecDlg (mOut: QmclOut): Qbool; stdcall; procedure MclAudioSetTruncateToVideo (mOut: QmclOut; truncateAudio: Qbool); stdcall; function MclAudioGetTruncateToVideo (mOut: QmclOut): Qbool; stdcall; // video and audio output parameters procedure MclSetFormatPreset (mOut: QmclOut; presetId, tvStandard: Qint); stdcall; procedure MclAviClearCustomInfo (mOut: QmclOut); stdcall; procedure MclAviAddCustomInfo (mOut: QmclOut; tagId, value: QcharP); stdcall; procedure MclSetUserData (mOut: QmclOut; userDataP: pointer); stdcall; function MclGetUserData (mOut: QmclOut): pointer; stdcall; // MclConvert: callbacks procedure MclAssignVideoSource (mOut: QmclOut; funcPtr: QmclMediaSourceCBF); stdcall; procedure MclAssignVideoFunc (mOut: QmclOut; funcPtr: QmclVideoFuncCBF); stdcall; procedure MclAssignVideoFuncEx (mOut: QmclOut; funcPtr: QmclVideoFuncExCBF); stdcall; procedure MclAssignAudioSource (mOut: QmclOut; funcPtr: QmclMediaSourceCBF); stdcall; procedure MclAssignAudioFunc (mOut: QmclOut; funcPtr: QmclAudioFuncCBF); stdcall; procedure MclAssignProgress (mOut: QmclOut; funcPtr: QmclProgressCBF); stdcall; procedure MclAssignError (mOut: QmclOut; funcPtr: QmclErrorCBF); stdcall; // MclConvert: functions used inside VideoSource and AudioSource callback procedure MclSourceSetFile (mOut: QmclOut; fileName: QcharP); stdcall; procedure MclSourceSetImage (mOut: QmclOut; mImg: QmclImg); stdcall; procedure MclSourceSetDIB (mOut: QmclOut; DIBhandle: HBITMAP); stdcall; procedure MclSourceSetPixels (mOut: QmclOut; pixPtr, palPtr: pointer; resX, resY, bpp: Qint); stdcall; procedure MclSourceSetPixelsRect (mOut: QmclOut; pixPtr, palPtr: pointer; resX, resY, bpp, posX, posY, copyX, copyY: Qint); stdcall; procedure MclSourceSetSamples (mOut: QmclOut; sndPtr: pointer; numOfSamples, sampleRate, channels, bitsPerChannel: Qint); stdcall; procedure MclSourceSetFrameRate (mOut: QmclOut; frameRate: Qfloat); stdcall; procedure MclSourceSetDirection (mOut: QmclOut; direction: Qint); stdcall; procedure MclSourceSetSound (mOut: QmclOut; mSnd: QmclSnd); stdcall; procedure MclSourceSetStart (mOut: QmclOut; quant: Qint); stdcall; procedure MclSourceSetLen (mOut: QmclOut; quants: Qint); stdcall; procedure MclSourceSetStartTime (mOut: QmclOut; sec: Qfloat); stdcall; procedure MclSourceSetLenTime (mOut: QmclOut; secs: Qfloat); stdcall; procedure MclSourceSkip (mOut: QmclOut); stdcall; procedure MclSourceFinished (mOut: QmclOut); stdcall; // MclConvert: functions used inside VideoFunction callback procedure MclImgSkip (mImg: QmclImg); stdcall; // MclConvert: functions used inside Progress callback function MclVideoGetBytesWritten (mOut: QmclOut): Qfloat; stdcall; function MclAudioGetBytesWritten (mOut: QmclOut): Qfloat; stdcall; function MclGetElapsedTime (mOut: QmclOut): Qfloat; stdcall; function MclGetRemainingTime (mOut: QmclOut; totalFrames, totalSamples: Qint): Qfloat; stdcall; procedure MclMakeTimeStr (seconds: Qfloat; timeStr: QcharP); stdcall; // conversion start and stop function MclConvert (mOut: QmclOut): Qresult; stdcall; procedure MclAbort (mOut: QmclOut); stdcall; function MclGetStatus (mOut: QmclOut): Qint; stdcall; // error checking function MclGetError: Qint; stdcall; function MclGetErrorStr: QcharP; stdcall; procedure MclClearErrors; stdcall; // file information procedure MclGetFileInfo (fileName: QcharP; seqDetect: Qint; var info: QmclFileInfo; fileInfoProgressCBF: QmclFileInfoProgressCBF; userDataP: pointer); stdcall; // alternative file input function MclReadOpen (fileName: QcharP; seqDetect: Qint; progressCBF: QmclFileInfoProgressCBF; userDataP: pointer): QmclRead; stdcall; procedure MclReadClose (mRead: QmclRead); stdcall; procedure MclReadInfo (mRead: QmclRead; var info: QmclFileInfo); stdcall; function MclReadImage (mRead: QmclRead; frameNum: Qint; mImg: QmclImg): Qresult; stdcall; function MclReadAlpha (mRead: QmclRead; frameNum: Qint; mImg: QmclImg): Qresult; stdcall; function MclReadSound (mRead: QmclRead; startSample, numSamples: Qint; mSnd: QmclSnd): Qresult; stdcall; // alternative file output function MclWriteImage (mOut: QmclOut; mImg: QmclImg): Qresult; stdcall; function MclWriteSound (mOut: QmclOut; mSnd: QmclSnd): Qresult; stdcall; procedure MclWriteClose (mOut: QmclOut); stdcall; procedure MclWriteCloseEx (mOut: QmclOut; progressCBF: QmclMuxProgressCBF; userDataP: pointer); stdcall; // video and audio codec functions used to create a custom codec-selection dialog function MclCodecsVideoCreate (fileFmtId, resX, resY, bpp: Qint): QmclCodecs; stdcall; function MclCodecsAudioCreate (fileFmtId, sampleRate, channels, bitsPerChannel: Qint): QmclCodecs; stdcall; function MclCodecsGetCount (mCodecs: QmclCodecs): Qint; stdcall; procedure MclCodecsGetInfo (mCodecs: QmclCodecs; var info: QmclCodecsInfo; codecNum: Qint); stdcall; procedure MclCodecsFree (mCodecs: QmclCodecs); stdcall; // image handling function MclImgCreate: QmclImg; stdcall; procedure MclImgFree (mImg: QmclImg); stdcall; procedure MclImgCopy (mImgDest, mImgSrc: QmclImg); stdcall; procedure MclImgRedim (mImg: QmclImg; resX, resY, bpp: Qint); stdcall; procedure MclImgClear (mImg: QmclImg; color: Qint); stdcall; // image pixel access and conversion procedure MclImgGetInfo (mImg: QmclImg; var resX, resY, bpp, dpiX, dpiY, totalBytes: Qint; var pixPtr, palPtr: pointer); stdcall; procedure MclImgSetPixels (mImg: QmclImg; resX, resY, bpp: Qint; pixPtr, palPtr: pointer); stdcall; procedure MclImgGetPixels (mImg: QmclImg; pixPtr, palPtr: pointer); stdcall; procedure MclImgSetPixelsRect (mImg: QmclImg; resX, resY, bpp, posX, posY, copyX, copyY: Qint; pixPtr, palPtr: pointer); stdcall; procedure MclImgGetPixelsRect (mImg: QmclImg; posX, posY, copyX, copyY: Qint; pixPtr, palPtr: pointer); stdcall; procedure MclImgSetPixelRGB (mImg: QmclImg; x, y: Qint; r, g, b: Qint); stdcall; procedure MclImgGetPixelRGB (mImg: QmclImg; x, y: Qint; var r, g, b: Qint); stdcall; function MclImgToDIB (mImg: QmclImg): HBITMAP; stdcall; function MclReleaseDIB (DIBhandle: HBITMAP): Qbool; stdcall; function MclImgToDIBWin3 (mImg: QmclImg): HBITMAP; stdcall; function MclReleaseDIBWin3 (DIBhandle: HBITMAP): Qbool; stdcall; procedure MclDIBToImg (mImg: QmclImg; DIBhandle: HBITMAP); stdcall; function MclBayerLoad (mImg: QmclImg; fileName: QcharP; resX, resY: Qint; colorType, pixelOrder: Qint): Qresult; stdcall; procedure MclBayerToImg (mImg: QmclImg; pixPtr: pointer; resX, resY: Qint; colorType, pixelOrder: Qint); stdcall; procedure MclPixelReorder (inData: pointer; inBpp, inOrg: Qint; outData: pointer; numPixels: Qint); stdcall; // image display procedure MclClearCanvas (dc: HDC; x, y, w, h, color: Qint); stdcall; procedure MclImgShow (mImg: QmclImg; dc: HDC; x, y: Qint); stdcall; procedure MclImgShowInRect (mImg: QmclImg; dc: HDC; x, y, w, h: Qint; enlarge: Qbool); stdcall; // image geometry procedure MclImgResize (mImg: QmclImg; resX, resY: Qint); stdcall; procedure MclImgResample (mImg: QmclImg; resX, resY: Qint); stdcall; procedure MclImgResampleToFit (mImg: QmclImg; rectResX, rectResY: Qint; addBorder: Qbool; borderColor: Qint); stdcall; procedure MclImgRotate (mImg: QmclImg; direction: Qint); stdcall; procedure MclImgCrop (mImg: QmclImg; newX, newY, resX, resY: Qint); stdcall; procedure MclImgBorder (mImg: QmclImg; left, top, right, bottom, color: Qint); stdcall; procedure MclImgInsert (mImgDest, mImgSrc: QmclImg; destX, destY: Qint); stdcall; procedure MclImgFlipVertical (mImg: QmclImg); stdcall; procedure MclImgFlipHorizontal (mImg: QmclImg); stdcall; procedure MclImgDeinterlace (mImg: QmclImg; keepEven, interpolate: Qbool); stdcall; // image color and transparency procedure MclImgBrightness (mImg: QmclImg; pctR, pctG, pctB: Qint); stdcall; procedure MclImgContrast (mImg: QmclImg; pctR, pctG, pctB: Qint); stdcall; procedure MclImgGamma (mImg: QmclImg; gammaR, gammaG, gammaB: Qfloat); stdcall; procedure MclImgHue (mImg: QmclImg; degrees: Qint); stdcall; procedure MclImgSaturation (mImg: QmclImg; pct: Qint); stdcall; procedure MclImgWhiteBalance (mImg: QmclImg; referenceR, referenceG, referenceB: Qint); stdcall; procedure MclImgSolarize (mImg: QmclImg; thresholdR, thresholdG, thresholdB: Qint); stdcall; procedure MclImgRemap (mImg: QmclImg; var redTable, greenTable, blueTable: QmclRemapTable); stdcall; procedure MclImgRemapToCustomPalette (mImg: QmclImg; palPtr: pointer; numColors: Qint); stdcall; procedure MclImgAddAlpha (mImg, mImgAlpha: QmclImg); stdcall; // convolution and other filters procedure MclImgPixelize (mImg: QmclImg; blockWidth, blockHeight: Qint); stdcall; procedure MclImgSoften (mImg: QmclImg); stdcall; procedure MclImgSharpen (mImg: QmclImg); stdcall; procedure MclImgEdgeEnhance (mImg: QmclImg); stdcall; procedure MclImgFindEdges (mImg: QmclImg); stdcall; procedure MclImgTraceContour (mImg: QmclImg); stdcall; procedure MclImgChaos (mImg: QmclImg; chaosLevel: Qint); stdcall; procedure MclImgAverageClear; stdcall; procedure MclImgAverageAdd (mImg: QmclImg); stdcall; procedure MclImgAverageGet (mImg: QmclImg); stdcall; // image text, write text over the picture function MclTextCreate: QmclText; stdcall; procedure MclTextFree (mText: QmclText); stdcall; procedure MclTextSetFont (mText: QmclText; fontName: QcharP; fontHeight, fontStyle, fontCharSet: Qint); stdcall; procedure MclTextSetColor (mText: QmclText; foreColor, shadowColor, backColor: Qint; transparent: Qbool); stdcall; procedure MclTextShadow (mText: QmclText; shadowMode, Xoffset, Yoffset: Qint); stdcall; procedure MclTextGetExtents (mText: QmclText; textStr: QcharP; var resX, resY: Qint); stdcall; procedure MclImgText (mImg: QmclImg; mText: QmclText; x, y: Qint; textStr: QcharP); stdcall; // image mixing/transition effects procedure MclImgEffectWipe (mImgDest, mImgOld, mImgNew: QmclImg; direction, percent: Qint); stdcall; procedure MclImgEffectSlideIn (mImgDest, mImgOld, mImgNew: QmclImg; direction, percent: Qint); stdcall; procedure MclImgEffectSlideOut (mImgDest, mImgOld, mImgNew: QmclImg; direction, percent: Qint); stdcall; procedure MclImgEffectCrossFade (mImgDest, mImgOld, mImgNew: QmclImg; percent: Qint); stdcall; procedure MclImgEffectPush (mImgDest, mImgOld, mImgNew: QmclImg; direction, percent: Qint); stdcall; procedure MclImgEffectPixelize (mImgDest, mImgOld, mImgNew: QmclImg; percent: Qint); stdcall; procedure MclImgEffectZoom (mImgDest, mImgOld, mImgNew: QmclImg; direction, percent: Qint); stdcall; procedure MclImgEffectWipeLines (mImgDest, mImgOld, mImgNew: QmclImg; direction, lineWidth, percent: Qint); stdcall; procedure MclImgEffectSlideCorners (mImgDest, mImgOld, mImgNew: QmclImg; direction, percent: Qint); stdcall; // sound handling function MclSndCreate: QmclSnd; stdcall; procedure MclSndFree (mSnd: QmclSnd); stdcall; procedure MclSndCopy (mSndDest, mSndSrc: QmclSnd); stdcall; procedure MclSndResample (mSnd: QmclSnd; sampleRate, channels, bitsPerChannel: Qint); stdcall; procedure MclSndGetInfo (mSnd: QmclSnd; var sampleRate, channels, bitsPerChannel, totalBytes: Qint; var sndPtr: pointer); stdcall; procedure MclSndSetSamples (mSnd: QmclSnd; numSamples, sampleRate, channels, bitsPerChannel: Qint; sndPtr: pointer); stdcall; procedure MclSndGetSamples (mSnd: QmclSnd; sndPtr: pointer); stdcall; // file list functions, used to collect input file names function MclListCreate: QmclList; stdcall; procedure MclListFree (mList: QmclList); stdcall; function MclListAdd (mList: QmclList; fileSpec: QcharP; fileType: Qint; fileInfoProgressCBF: QmclFileInfoProgressCBF; userDataP: pointer): Qint; stdcall; procedure MclListMove (mList: QmclList; indexFrom, indexTo, numFiles: Qint); stdcall; procedure MclListDelete (mList: QmclList; indexFrom, numFiles: Qint); stdcall; procedure MclListSort (mList: QmclList; ascending, justFileName: Qbool); stdcall; function MclListGetName (mList: QmclList; fileIndex: Qint; fileName: QcharP): Qbool; stdcall; function MclListGetFileCount (mList: QmclList): Qint; stdcall; function MclListGetFrameCount (mList: QmclList): Qint; stdcall; procedure MclListGetVideoFormat (mList: QmclList; var resX, resY, bpp: Qint); stdcall; function MclListGetFrameRate (mList: QmclList): Qfloat; stdcall; function MclListGetSampleCount (mList: QmclList): Qint; stdcall; procedure MclListGetAudioFormat (mList: QmclList; var sampleRate, channels, bitsPerChannel: Qint); stdcall; function MclListGetFileInfo (mList: QmclList; fileIndex: Qint; var info: QmclFileInfo): Qbool; stdcall; // file format specific function MclTiffGetTag (fileName: QcharP; tagId: Qint; bufferPtr: pointer; bufferSize: Qint): Qint; stdcall; procedure MclTiffSet16to8bitGrayRange (minValue, maxValue: Qint); stdcall; function MclBayerGetHdr (fileName: QcharP; bufferPtr: pointer; bufferSize: Qint): Qint; stdcall; function MclAviGetCustomInfo (fileName: QcharP; tagId: QcharP; strPtr: QcharP; strSize: Qint): Qint; stdcall; function MclMpegMultiplex (outputFile, videoFile, audioFile: QcharP; codecId: Qint; progressCBF: QmclMuxProgressCBF; userDataP: pointer): Qbool; stdcall; function MclMpegDemultiplex (inputFile, videoFile, audioFile: QcharP; progressCBF: QmclMuxProgressCBF; userDataP: pointer): Qbool; procedure MclMpegInternalDecoder (enable: Qbool); stdcall; function MclMpegGetAspectRatio (fileName: pchar): Qfloat; stdcall; // translation procedure MclTranslateClear; stdcall; procedure MclTranslate (original, translated: QcharP); stdcall; // logging procedure MclLogStart (fileName: QcharP); stdcall; procedure MclLogExtra (extraInfo: Qbool); stdcall; procedure MclLogStop; stdcall; // helper functions function MclGetFileFmt (fileName: QcharP): Qint; stdcall; function MclRGB (r, g, b: Qint): Qint; stdcall; procedure MclSplitColor (color: Qint; var r, g, b: Qint); stdcall; function MclFourCC (fourCharCode: QcharP): Qint; stdcall; function MclBytesToBits (bytes: Qint): Qint; stdcall; function MclBitsToBytes (bits: Qint): Qint; stdcall; implementation uses FileFmtDef, Basic, QConst, ImgBasic, SndBasic, Errors, Impress, MiscProcs, ConForm, PalOpt, FFBasic, Predict, VCLUtils, Common, FF_AVI, FF_HAV, FF_MPG, FF_TIF, FF_BAY, FF_OGG, FF_GIF, Translator, TextGen, ImgHelper; // utils procedure CreateBlankImage (var img: Qimg; resX, resY, bpp, color: Qint); var r, g, b : Qint; begin ImgAlloc (img, resX, resY, bpp ); if (bpp = BITS_8) then begin // for 8-bit images create blank palette with fill color on index 1 FillChar (img.pal256, SizeOf (img.pal256), 0); MclSplitColor (color, r, g, b); img.pal256[1].r := r; img.pal256[1].g := g; img.pal256[1].b := b; PicFillColor (img, 0, resX * resY, 1); end else PicFillColor (img, 0, resX * resY, color); end; // end utils function MclRegister (regCode: QcharP): Qbool; stdcall; begin result := TRUE; end; // ===== QUICK CONVERT BEGIN ============================================ var qcMcl : QmclOut; qcVideoList : QmclList; qcAudioList : QmclList; procedure QConv_VideoSource_ (mOut: QmclOut; blockNum: Qint); stdcall; var pName : QcharP; begin MemStrAlloc (pName, MCL_STRLEN_FILENAME ); MclListGetName (qcVideoList, blockNum, pName); if StrLen (pName) > 0 then MclSourceSetFile (mOut, pName) else MclSourceFinished (mOut); MemFree (pName); end; procedure QConv_AudioSource_ (mOut: QmclOut; blockNum: Qint); stdcall; var pName : QcharP; begin MemStrAlloc (pName, MCL_STRLEN_FILENAME ); MclListGetName (qcAudioList, blockNum, pName); if StrLen (pName) > 0 then MclSourceSetFile (mOut, pName) else MclSourceFinished (mOut); MemFree (pName); end; procedure QConv_Error_ (mOut: QmclOut; inputFile: QcharP; var action: Qint); stdcall; begin action := MCL_ACTION_FINISH; ErrSet_ (MCLRES_INVALID_INPUT); end; function MclSimpleConvert (outputFile, inputVideo, inputAudio: QcharP; resX, resY: Qint; frameRate: Qfloat): Qresult; stdcall; var maxFps : Qfloat; maxResX, maxResY, maxBpp : Qint; maxFreq, maxChan, maxBits : Qint; vidOut, audOut : QcharP; inputVidFile, inputAudFile : Qstring; label FREE_LISTS_AND_EXIT; begin ErrReset_; result := MCLRES_OK; try if gLogEx then begin TraceWrite ('MclSimpleConvert'); TraceWrite (' outputFile=' + outputFile); TraceWrite (' inputVideo=' + inputVideo); TraceWrite (' inputAudio=' + inputAudio); TraceWrite (' resX=' + IStr_ (resX)); TraceWrite (' resY=' + IStr_ (resY)); TraceWrite (' frameRate=' + FStr_ (frameRate)); end; inputVidFile := inputVideo; inputAudFile := inputAudio; qcVideoList := MclListCreate; qcAudioList := MclListCreate; MclListAdd (qcVideoList, inputVideo, MCL_MEDIA_VIDEO, NIL, NIL); MclListAdd (qcAudioList, inputAudio, MCL_MEDIA_AUDIO, NIL, NIL); if (MclListGetFileCount (qcVideoList) = 0) and (MclListGetFileCount (qcAudioList) = 0) then begin ErrSet_ (MCLRES_INVALID_INPUT); GOTO FREE_LISTS_AND_EXIT; end; MclListGetVideoFormat (qcVideoList, maxResX, maxResY, maxBpp); maxFps := MclListGetFrameRate (qcVideoList); if resX = K_AUTO then resX := maxResX; if resY = K_AUTO then resY := maxResY; if FloatsEqual (frameRate, K_AUTO) then frameRate := maxFPS; MclListGetAudioFormat (qcAudioList, maxFreq, maxChan, maxBits); qcMcl := MclCreate; MclVideoSetFrameRate (qcMcl, frameRate); MclVideoSetKeepDuration (qcMcl, FALSE); MclVideoSetFormat (qcMcl, resX, resY, maxBpp); MclAudioSetFormat (qcMcl, maxFreq, maxChan, maxBits); if inputVidFile <> '' then begin vidOut := outputFile; MclAssignVideoSource (qcMcl, QConv_VideoSource_); end else vidOut := NIL; if inputAudFile <> '' then begin audOut := outputFile; MclAssignAudioSource (qcMcl, QConv_AudioSource_); end else audOut := NIL; MclAssignError (qcMcl, QConv_Error_); MclVideoSetFileName (qcMcl, vidOut); MclAudioSetFileName (qcMcl, audOut); result := MclConvert (qcMcl); MclFree (qcMcl); FREE_LISTS_AND_EXIT: MclListFree (qcVideoList); MclListFree (qcAudioList); if gLogEx then TraceWrite (' result=' + IStr_ (result)); except result := ErrExcept_; end; end; // ===== QUICK CONVERT END ============================================== function MclSimpleReadFirstImage (fileName: QcharP; mImg: QmclImg): Qresult; stdcall; // opens a file, loads the first image as fast as it can and closes the file var imgP : QimgP; ui : QuniInfo; uf : QuniFile; fileIsOpen : Qbool; ffId: Qint; gf: GifFile; begin ErrReset_; fileIsOpen := FALSE; try if gLogEx then begin TraceWrite ('MclSimpleReadFirstImage'); TraceWrite (' mImg=' + IStr_ (mImg)); TraceWrite (' fileName=' + fileName); end; if (mImg <> K_ZERO) then begin imgP := pointer (mImg); ffId := FFGetId (string(fileName), K_READ); case ffId of FILEFMT_MPG: MpgGetFirstFrame (imgP^, string(fileName)); FILEFMT_GIF: begin GIFOpen (gf, string(fileName), TRUE); GIFLoadNext (gf, imgP^, NIL); GIFClose (gf); end; else begin UniInfo (fileName, ui, MCL_SEQ_IGNORE, NIL, NIL); UniOpen (uf, ui); fileIsOpen := TRUE; UniImgLoad (uf, imgP^, 1, 0); end; end; end; result := MCLRES_OK; except result := ErrExcept_; end; if fileIsOpen then begin try UniClose (uf); except end; end; end; function MclSimpleReadImage (fileName: QcharP; frameNum: Qint; mImg: QmclImg): Qresult; stdcall; // opens a file, loads an image and closes the file // is zero based var imgP : QimgP; ui : QuniInfo; uf : QuniFile; fileIsOpen : Qbool; begin ErrReset_; fileIsOpen := FALSE; try if gLogEx then begin TraceWrite ('MclSimpleReadImage'); TraceWrite (' mImg=' + IStr_ (mImg)); TraceWrite (' fileName=' + fileName); TraceWrite (' frameNum=' + IStr_ (frameNum)); end; if (mImg <> K_ZERO) then begin imgP := pointer (mImg); UniInfo (fileName, ui, MCL_SEQ_IGNORE, NIL, NIL); UniOpen (uf, ui); fileIsOpen := TRUE; frameNum := InRange (frameNum, 0, ui.video.vLen - 1); UniImgLoad (uf, imgP^, frameNum + 1, 0); end; result := MCLRES_OK; except result := ErrExcept_; end; if fileIsOpen then begin try UniClose (uf); except end; end; end; function MclSimpleWriteImage (mImg: QmclImg; fileName: QcharP; codecId: Qint; quality: Qfloat): Qresult; stdcall; // creates a file, saves an image and closes it var mOut : QmclOut; begin ErrReset_; try if gLogEx then begin TraceWrite ('MclSimpleWriteImage'); TraceWrite (' mImg=' + IStr_ (mImg)); TraceWrite (' fileName=' + Qstring (fileName)); TraceWrite (' codecId=' + IStr_ (codecId)); end; if (mImg <> K_ZERO) then begin mOut := MclCreate; MclVideoSetFileName (mOut, PChar (fileName)); MclVideoSetFrameRate (mOut, MCL_FPS_DEFAULT); MclVideoSetKeepDuration (mOut, FALSE); MclVideoSetCodec (mOut, codecId); MclVideoSetQuality (mOut, quality); MclWriteImage (mOut, mImg); MclWriteClose (mOut); MclFree (mOut); end; result := MCLRES_OK; except result := ErrExcept_; end; end; function MclCreate: QmclOut; stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := MclOut_Create; result := QmclOut (dataP); if gLogEx then begin TraceWrite ('MclCreate'); TraceWrite (' result=' + PStr_ (dataP)); end; except result := 0; ErrExcept_; end; end; procedure MclFree (mOut: QmclOut); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclFree'); TraceWrite (' mOut=' + PStr_ (dataP)); end; if Assigned (dataP) then if (dataP^.pgsStatus = MCL_STATUS_READY) then // don't release the handle during conversion MclOut_Free (dataP); except ErrExcept_; end; end; procedure MclVideoSetFileName (mOut: QmclOut; fileName: QcharP); stdcall; var dataP : QmclOutputP; ext : Qstring; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclVideoSetFileName'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' fileName=' + fileName); end; dataP^.outFile.vFileName := Qstring (fileName); MclOut_UpdateVideoFF (dataP); // MPEG-2 specific: autoselect MPEG2 if file extension is ".m2v" if gMpeg2Enabled then begin ext := ExtractFileExt (dataP^.outFile.vFileName); if (CompareText (ext, '.m2v') = 0) then begin MclVideoSetCodec (mOut, MCL_MPG_MPEG2); MclVideoSetBitRate (mOut, KBITS_VIDEO_MPEG2_VBR, 0, 0); end; end; except ErrExcept_; end; end; procedure MclVideoGetFileName (mOut: QmclOut; fileName: QcharP); stdcall; // fileName must be allocated, length=MCL_STRLEN_FILENAME var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); StrPCopy (fileName, dataP^.outFile.vFileName); if gLogEx then begin TraceWrite ('MclVideoGetFileName'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' fileName=' + fileName); end; except ErrExcept_; end; end; procedure MclVideoSetFileFormat (mOut: QmclOut; fileFmtId: Qint); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclVideoSetFileFormat'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' fileFmtId=' + FmtStr_ (fileFmtId)); end; if (fileFmtId <> K_AUTO) then dataP^.outFile.vFFindex := FFVideoGetIndex (dataP^.outFile.vParams, fileFmtId); except ErrExcept_; end; end; function MclVideoGetFileFormat (mOut: QmclOut): Qint; stdcall; var dataP : QmclOutputP; videoP : PQFFVideoParams; begin ErrReset_; try dataP := pointer (mOut); videoP := MclOut_GetVideoP (dataP); if Assigned (videoP) then result := videoP^.vFileFmtId else result := K_AUTO; if gLogEx then begin TraceWrite ('MclVideoGetFileFormat'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' result=' + FmtStr_ (result)); end; except result := K_AUTO; ErrExcept_; end; end; procedure MclVideoSetFormat (mOut: QmclOut; resX, resY, bpp: Qint); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclVideoSetFormat'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' resX=' + IStr_ (resX)); TraceWrite (' resY=' + IStr_ (resY)); TraceWrite (' bpp=' + IStr_ (bpp)); end; if (resX <> K_AUTO) or (resY <> K_AUTO) or (bpp <> K_AUTO) then begin dataP^.outFile.vAutoRes := FALSE; if (resX <> K_AUTO) then dataP^.outFile.vResX := InRange (resX, K_IMGMINRES, K_IMGMAXRES); if (resY <> K_AUTO) then dataP^.outFile.vResY := InRange (resY, K_IMGMINRES, K_IMGMAXRES); if (bpp <> K_AUTO) then begin if not (bpp in [BITS_8, BITS_15, BITS_16, BITS_24, BITS_32]) then bpp := BITS_24; dataP^.outFile.vBpp := bpp; end; end; except ErrExcept_; end; end; procedure MclVideoGetFormat (mOut: QmclOut; var resX, resY, bpp: Qint); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); MclOut_PrepareVideo (dataP); resX := dataP^.outFile.vResX; resY := dataP^.outFile.vResY; bpp := dataP^.outFile.vBpp; if gLogEx then begin TraceWrite ('MclVideoGetFormat'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' resX=' + IStr_ (resX)); TraceWrite (' resY=' + IStr_ (resY)); TraceWrite (' bpp=' + IStr_ (bpp)); end; except ErrExcept_; end; end; procedure MclVideoSetDpi (mOut: QmclOut; dpiX, dpiY: Qint); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclVideoSetDpi'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' dpiX=' + IStr_ (dpiX)); TraceWrite (' dpiY=' + IStr_ (dpiY)); end; if (dpiX <> K_AUTO) then dataP^.outFile.vDpiX := dpiX; if (dpiY <> K_AUTO) then dataP^.outFile.vDpiY := dpiY; except ErrExcept_; end; end; procedure MclVideoGetDpi (mOut: QmclOut; var dpiX, dpiY: Qint); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); MclOut_PrepareVideo (dataP); dpiX := dataP^.outFile.vDpiX; dpiY := dataP^.outFile.vDpiY; if gLogEx then begin TraceWrite ('MclVideoGetDpi'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' dpiX=' + IStr_ (dpiX)); TraceWrite (' dpiY=' + IStr_ (dpiY)); end; except ErrExcept_; end; end; procedure MclVideoSetCodec (mOut: QmclOut; codecId: Qint); stdcall; var dataP : QmclOutputP; videoP : PQFFVideoParams; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclVideoSetCodec'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' codecId=' + IStr_ (codecId)); end; videoP := MclOut_GetVideoP (dataP); if Assigned (videoP) and (codecId <> K_AUTO) then FFVideoSetCodecId (videoP^, codecId); except ErrExcept_; end; end; function MclVideoGetCodec (mOut: QmclOut): Qint; stdcall; var dataP : QmclOutputP; videoP : PQFFVideoParams; begin ErrReset_; try dataP := pointer (mOut); videoP := MclOut_GetVideoP (dataP); if Assigned (videoP) then result := FFVideoGetCodecId (videoP^) else result := K_AUTO; if gLogEx then begin TraceWrite ('MclVideoGetCodec'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' result=' + IStr_ (result)); end; except result := K_AUTO; ErrExcept_; end; end; function MclVideoGetCodecName (mOut: QmclOut): QcharP; stdcall; var dataP : QmclOutputP; videoP : PQFFVideoParams; begin ErrReset_; try dataP := pointer (mOut); videoP := MclOut_GetVideoP (dataP); if Assigned (videoP) then dataP^.outFile.vCodecName := FFVideoGetCodecName (videoP^) else dataP^.outFile.vCodecName := ''; result := PChar (dataP^.outFile.vCodecName); if gLogEx then begin TraceWrite ('MclVideoGetCodecName'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' result=' + result); end; except result := NIL; ErrExcept_; end; end; procedure MclVideoSetCodecData (mOut: QmclOut; codecDataP: pointer; codecDataSize: Qint); stdcall; var dataP : QmclOutputP; videoP : PQFFVideoParams; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclVideoSetCodecData'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' codecData=' + PStr_ (codecDataP)); TraceWrite (' codecDataSize=' + IStr_ (codecDataSize)); end; videoP := MclOut_GetVideoP (dataP); if Assigned (videoP) then FFVideoSetCodecData (videoP^, codecDataP, codecDataSize); except ErrExcept_; end; end; function MclVideoGetCodecData (mOut: QmclOut; codecDataP: pointer): Qint; stdcall; const cdP: Pointer = NIL; var dataP : QmclOutputP; videoP : PQFFVideoParams; begin ErrReset_; try dataP := pointer (mOut); videoP := MclOut_GetVideoP (dataP); if Assigned (videoP) then begin if (codecDataP = NIL) then begin if (videoP^.vFileFmtId = FILEFMT_AVI) then begin FFVideoGetCodecData (videoP^, codecDataP, result); MemFree (codecDataP); end else result := videoP^.vCodecDataSize; end else begin if (videoP^.vCodecDataP = NIL) then begin if (videoP^.vFileFmtId = FILEFMT_AVI) then begin FFVideoGetCodecData (videoP^, cdP, result); if Assigned (cdP) then begin move (cdP^, codecDataP^, result); MemFree (cdP); end; end else result := 0 end else begin result := videoP^.vCodecDataSize; move (videoP^.vCodecDataP^, codecDataP^, videoP^.vCodecDataSize); end; end; end else result := K_AUTO; if gLogEx then begin TraceWrite ('MclVideoGetCodecData'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' codecDataP=' + PStr_ (dataP)); TraceWrite (' result=' + IStr_ (result)); end; except result := K_AUTO; ErrExcept_; end; end; procedure MclVideoSetBitRate (mOut: QmclOut; kbps, minKbps, maxKbps: Qint); stdcall; var dataP : QmclOutputP; videoP : PQFFVideoParams; kbpsOld, minKbpsOld, maxKbpsOld : Qint; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclVideoSetBitRate'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' kbps=' + IStr_ (kbps)); TraceWrite (' minKbps=' + IStr_ (minKbps)); TraceWrite (' maxKbps=' + IStr_ (maxKbps)); end; videoP := MclOut_GetVideoP (dataP); if Assigned (videoP) then begin FFVideoGetBitRate (videoP^, kbpsOld, minKbpsOld, maxKbpsOld); if (kbps = K_AUTO) then kbps := kbpsOld; if (minKbps = K_AUTO) then minKbps := minKbpsOld; if (maxKbps = K_AUTO) then maxKbps := maxKbpsOld; FFVideoSetBitRate (videoP^, kbps, minKbps, maxKbps); end; except ErrExcept_; end; end; procedure MclVideoGetBitRate (mOut: QmclOut; var kbps, minKbps, maxKbps: Qint); stdcall; var dataP : QmclOutputP; videoP : PQFFVideoParams; begin ErrReset_; try dataP := pointer (mOut); videoP := MclOut_GetVideoP (dataP); if Assigned (videoP) then FFVideoGetBitRate (videoP^, kbps, minKbps, maxKbps) else begin kbps := K_AUTO; minKbps := K_AUTO; maxKbps := K_AUTO; end; if gLogEx then begin TraceWrite ('MclVideoGetBitRate'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' kbps=' + IStr_ (kbps)); TraceWrite (' minKbps=' + IStr_ (minKbps)); TraceWrite (' maxKbps=' + IStr_ (maxKbps)); end; except ErrExcept_; end; end; procedure MclVideoSetQuality (mOut: QmclOut; quality: Qfloat); stdcall; var dataP : QmclOutputP; videoP : PQFFVideoParams; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclVideoSetQuality'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' quality=' + FStr_ (quality)); end; videoP := MclOut_GetVideoP (dataP); if Assigned (videoP) and (not FloatsEqual (quality, K_AUTO)) then FFVideoSetQuality (videoP^, quality); except ErrExcept_; end; end; function MclVideoGetQuality (mOut: QmclOut): Qfloat; stdcall; var dataP : QmclOutputP; videoP : PQFFVideoParams; begin ErrReset_; try dataP := pointer (mOut); videoP := MclOut_GetVideoP (dataP); if Assigned (videoP) then result := FFVideoGetQuality (videoP^) else result := K_AUTO; if gLogEx then begin TraceWrite ('MclVideoGetQuality'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' result=' + FStr_ (result)); end; except result := K_AUTO; ErrExcept_; end; end; function MclVideoHasCodecDlg (mOut: QmclOut): Qbool; stdcall; var dataP : QmclOutputP; videoP : PQFFVideoParams; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclVideoHasCodecDlg'); TraceWrite (' mOut=' + PStr_ (dataP)); end; videoP := MclOut_GetVideoP (dataP); result := Assigned (videoP) and videoP^.vHasDlg; if gLogEx then TraceWrite (' result=' + BStr_ (result)); except result := FALSE; ErrExcept_; end; end; function MclVideoShowCodecDlg (mOut: QmclOut): Qbool; stdcall; var dataP : QmclOutputP; videoP : PQFFVideoParams; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclVideoShowCodecDlg'); TraceWrite (' mOut=' + PStr_ (dataP)); end; videoP := MclOut_GetVideoP (dataP); result := Assigned (videoP) and (videoP^.vHasDlg); if result then begin FFVideoSetFormat (videoP^, dataP^.outFile.vResX, dataP^.outFile.vResY, dataP^.outFile.vBpp); result := FFSaveDlgVideo (dataP^.outFile.saveInfo, videoP^); end; if gLogEx then TraceWrite (' result=' + BStr_ (result)); except result := FALSE; ErrExcept_; end; end; function MclVideoAviCodecConfigDlg (mOut: QmclOut): Qbool; stdcall; var dataP : QmclOutputP; videoP : PQFFVideoParams; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclVideoAviCodecConfigDlg'); TraceWrite (' mOut=' + PStr_ (dataP)); end; videoP := MclOut_GetVideoP (dataP); result := Assigned (videoP) and VfwCodecConfigure (videoP^.vCodecId, videoP^.vCodecDataP, videoP^.vCodecDataSize); if gLogEx then TraceWrite (' result=' + BStr_ (result)); except result := FALSE; ErrExcept_; end; end; procedure MclVideoMpegSetClosedGOP (mOut: QmclOut; closeGOP: Qbool); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclVideoMpegSetClosedGOP'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' closeGOP=' + BStr_ (closeGOP)); end; FFSaveSetMpgClosedGOP (dataP^.outFile.saveInfo, closeGOP); except ErrExcept_; end; end; function MclVideoMpegGetClosedGOP (mOut: QmclOut): Qbool; stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); result := FFSaveGetMpgClosedGOP (dataP^.outFile.saveInfo); if gLogEx then begin TraceWrite ('MclVideoMpegGetClosedGOP'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' result=' + BStr_ (result)); end; except result := FALSE; ErrExcept_; end; end; procedure MclVideoSetDithering (mOut: QmclOut; ditheringType: Qint); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclVideoSetDithering'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' ditheringType=' + IStr_ (ditheringType)); end; if (ditheringType <> K_AUTO) then dataP^.outFile.vDither := ditheringType; except ErrExcept_; end; end; function MclVideoGetDithering (mOut: QmclOut): Qint; stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); result := dataP^.outFile.vDither; if gLogEx then begin TraceWrite ('MclVideoGetDithering'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' result=' + IStr_ (result)); end; except result := K_AUTO; ErrExcept_; end; end; procedure MclVideoSetFrameRate (mOut: QmclOut; frameRate: Qfloat); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclVideoSetFrameRate'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' frameRate=' + FStr_ (frameRate)); end; if not FloatsEqual (frameRate, K_AUTO) then dataP^.outFile.vFps := frameRate; except ErrExcept_; end; end; function MclVideoGetFrameRate (mOut: QmclOut): Qfloat; stdcall; var dataP : QmclOutputP; begin result := 0; ErrReset_; try dataP := pointer (mOut); result := dataP^.outFile.vFps; if gLogEx then begin TraceWrite ('MclVideoGetFrameRate'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' result=' + FStr_ (result)); end; except ErrExcept_; end; end; procedure MclVideoSetKeepDuration (mOut: QmclOut; keepDuration: Qbool); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclVideoSetKeepDuration'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' keepDuration=' + BStr_ (keepDuration)); end; dataP^.outFile.vKeepDuration := keepDuration; except ErrExcept_; end; end; function MclVideoGetKeepDuration (mOut: QmclOut): Qbool; stdcall; var dataP : QmclOutputP; begin result := FALSE; ErrReset_; try dataP := pointer (mOut); result := dataP^.outFile.vKeepDuration; if gLogEx then begin TraceWrite ('MclVideoGetKeepDuration'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' result=' + BStr_ (result)); end; except ErrExcept_; end; end; procedure MclVideoSetKeyFrameRate (mOut: QmclOut; keyFrameEvery: Qint); stdcall; var dataP : QmclOutputP; videoP : PQFFVideoParams; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclVideoSetKeyFrameRate'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' keyFrameEvery=' + IStr_ (keyFrameEvery)); end; videoP := MclOut_GetVideoP (dataP); if Assigned (videoP) and (keyFrameEvery <> K_AUTO) then FFVideoSetKeyFrameRate (videoP^, keyFrameEvery); except ErrExcept_; end; end; function MclVideoGetKeyFrameRate (mOut: QmclOut): Qint; stdcall; var dataP : QmclOutputP; videoP : PQFFVideoParams; begin ErrReset_; try dataP := pointer (mOut); videoP := MclOut_GetVideoP (dataP); if Assigned (videoP) then result := FFVideoGetKeyFrameRate (videoP^) else result := K_AUTO; if gLogEx then begin TraceWrite ('MclVideoGetKeyFrameRate'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' result=' + IStr_ (result)); end; except result := K_AUTO; ErrExcept_; end; end; procedure MclVideoSetAspectRatio (mOut: QmclOut; aspectRatioCode: Qint); stdcall; var dataP : QmclOutputP; videoP : PQFFVideoParams; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclVideoSetAspectRatio'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' aspectRatioCode=' + IStr_ (aspectRatioCode)); end; videoP := MclOut_GetVideoP (dataP); if Assigned (videoP) and (aspectRatioCode <> K_AUTO) then FFVideoSetAsr (videoP^, aspectRatioCode); except ErrExcept_; end; end; function MclVideoGetAspectRatio (mOut: QmclOut): Qint; stdcall; var dataP : QmclOutputP; videoP : PQFFVideoParams; begin ErrReset_; try dataP := pointer (mOut); videoP := MclOut_GetVideoP (dataP); if Assigned (videoP) then result := FFVideoGetAsr (videoP^) else result := K_AUTO; if gLogEx then begin TraceWrite ('MclVideoGetAspectRatio'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' result=' + IStr_ (result)); end; except result := K_AUTO; ErrExcept_; end; end; procedure MclAudioSetFileName (mOut: QmclOut; fileName: QcharP); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclAudioSetFileName'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' fileName=' + fileName); end; dataP^.outFile.aFileName := Qstring (fileName); MclOut_UpdateAudioFF (dataP); except ErrExcept_; end; end; procedure MclAudioGetFileName (mOut: QmclOut; fileName: QcharP); stdcall; // fileName must be allocated, length=MCL_STRLEN_FILENAME var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); StrPCopy (fileName, dataP^.outFile.aFileName); if gLogEx then begin TraceWrite ('MclAudioGetFileName'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' fileName=' + fileName); end; except ErrExcept_; end; end; procedure MclAudioSetFileFormat (mOut: QmclOut; fileFmtId: Qint); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclAudioSetFileFormat'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' fileFmtId=' + FmtStr_ (fileFmtId)); end; if (fileFmtId <> K_AUTO) then dataP^.outFile.aFFindex := FFAudioGetIndex (dataP^.outFile.aParams, fileFmtId); except ErrExcept_; end; end; function MclAudioGetFileFormat (mOut: QmclOut): Qint; stdcall; var dataP : QmclOutputP; audioP : PQFFAudioParams; begin ErrReset_; try dataP := pointer (mOut); audioP := MclOut_GetAudioP (dataP); if Assigned (audioP) then result := audioP^.aFileFmtId else result := K_AUTO; if gLogEx then begin TraceWrite ('MclAudioGetFileFormat'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' result=' + FmtStr_ (result)); end; except result := K_AUTO; ErrExcept_; end; end; procedure MclAudioSetFormat (mOut: QmclOut; sampleRate, channels, bitsPerChannel: Qint); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclAudioSetFormat'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' sampleRate=' + IStr_ (sampleRate)); TraceWrite (' channels=' + IStr_ (channels)); TraceWrite (' bitsPerChannel=' + IStr_ (bitsPerChannel)); end; if (sampleRate <> K_AUTO) or (channels <> K_AUTO) or (bitsPerChannel <> K_AUTO) then begin dataP^.outFile.aAutoFormat := FALSE; if (sampleRate = K_AUTO) then sampleRate := dataP^.outFile.aFormat.nSamplesPerSec; if (channels = K_AUTO) then channels := dataP^.outFile.aFormat.nChannels; if (bitsPerChannel = K_AUTO) then bitsPerChannel := dataP^.outFile.aFormat.wBitsPerSample; SndWaveFmtPCMSet (dataP^.outFile.aFormat, sampleRate, channels, bitsPerChannel); end; except ErrExcept_; end; end; procedure MclAudioGetFormat (mOut: QmclOut; var sampleRate, channels, bitsPerChannel: Qint); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); sampleRate := dataP^.outFile.aFormat.nSamplesPerSec; channels := dataP^.outFile.aFormat.nChannels; bitsPerChannel := dataP^.outFile.aFormat.wBitsPerSample; if gLogEx then begin TraceWrite ('MclAudioGetFormat'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' sampleRate=' + IStr_ (sampleRate)); TraceWrite (' channels=' + IStr_ (channels)); TraceWrite (' bitsPerChannel=' + IStr_ (bitsPerChannel)); end; except ErrExcept_; end; end; procedure MclAudioSetCodec (mOut: QmclOut; codecId: Qint); stdcall; var dataP : QmclOutputP; audioP : PQFFAudioParams; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclAudioSetCodec'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' codecId=' + IStr_ (codecId)); end; audioP := MclOut_GetAudioP (dataP); if Assigned (audioP) and (codecId <> K_AUTO) then FFAudioSetCodecId (audioP^, codecId); except ErrExcept_; end; end; function MclAudioGetCodec (mOut: QmclOut): Qint; stdcall; var dataP : QmclOutputP; audioP : PQFFAudioParams; begin ErrReset_; try dataP := pointer (mOut); audioP := MclOut_GetAudioP (dataP); if Assigned (audioP) then result := FFAudioGetCodecId (audioP^) else result := K_AUTO; if gLogEx then begin TraceWrite ('MclAudioGetCodec'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' result=' + IStr_ (result)); end; except result := K_AUTO; ErrExcept_; end; end; function MclAudioGetCodecName (mOut: QmclOut): QcharP; stdcall; var dataP : QmclOutputP; audioP : PQFFAudioParams; begin ErrReset_; try dataP := pointer (mOut); audioP := MclOut_GetAudioP (dataP); if Assigned (audioP) then dataP^.outFile.aCodecName := FFAudioGetCodecName (audioP^) else dataP^.outFile.aCodecName := ''; result := PChar (dataP^.outFile.aCodecName); if gLogEx then begin TraceWrite ('MclAudioGetCodecName'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' result=' + result); end; except result := NIL; ErrExcept_; end; end; procedure MclAudioSetCodecData (mOut: QmclOut; codecDataP: pointer); stdcall; var dataP : QmclOutputP; audioP : PQFFAudioParams; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclAudioSetCodecData'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' codecData=' + PStr_ (codecDataP)); end; audioP := MclOut_GetAudioP (dataP); if Assigned (audioP) then FFAudioSetOutputFormat (audioP^, codecDataP); except ErrExcept_; end; end; function MclAudioGetCodecData (mOut: QmclOut; codecDataP: pointer): Qint; stdcall; var dataP : QmclOutputP; audioP : PQFFAudioParams; begin ErrReset_; try dataP := pointer (mOut); audioP := MclOut_GetAudioP (dataP); if Assigned (audioP) then begin if (codecDataP = NIL) then begin FFAudioGetOutputFormat (audioP^, PWaveFormatEx(codecDataP), result); MemFree (codecDataP); end else if (assigned (audioP^.aWaveFmtOutP)) then begin result := sizeof(TWaveFormatEx) + audioP^.aWaveFmtOutP^.cbSize;; move (audioP^.aWaveFmtOutP^, codecDataP^, result); end else result := 0; end else result := K_AUTO; if gLogEx then begin TraceWrite ('MclAudioGetCodecData'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' codecDataP=' + PStr_ (dataP)); TraceWrite (' result=' + IStr_ (result)); end; except result := K_AUTO; ErrExcept_; end; end; procedure MclAudioSetBitRate (mOut: QmclOut; kbps: Qint); stdcall; var dataP : QmclOutputP; audioP : PQFFAudioParams; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclAudioSetBitRate'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' kbps=' + IStr_ (kbps)); end; audioP := MclOut_GetAudioP (dataP); if Assigned (audioP) and (kbps <> K_AUTO) then FFAudioSetBitRate (audioP^, kbps); except ErrExcept_; end; end; function MclAudioGetBitRate (mOut: QmclOut): Qint; stdcall; var dataP : QmclOutputP; audioP : PQFFAudioParams; begin ErrReset_; try dataP := pointer (mOut); audioP := MclOut_GetAudioP (dataP); if Assigned (audioP) then result := FFAudioGetBitRate (audioP^) else result := K_AUTO; if gLogEx then begin TraceWrite ('MclAudioGetBitRate'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' result=' + IStr_ (result)); end; except result := K_AUTO; ErrExcept_; end; end; procedure MclAudioSetQuality (mOut: QmclOut; quality: Qfloat); stdcall; var dataP : QmclOutputP; audioP : PQFFAudioParams; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclAudioSetQuality'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' quality=' + FStr_ (quality)); end; audioP := MclOut_GetAudioP (dataP); if Assigned (audioP) and (quality <> K_AUTO) then FFAudioSetQuality (audioP^, quality); except ErrExcept_; end; end; function MclAudioGetQuality (mOut: QmclOut): Qfloat; stdcall; var dataP : QmclOutputP; audioP : PQFFAudioParams; begin ErrReset_; try dataP := pointer (mOut); audioP := MclOut_GetAudioP (dataP); if Assigned (audioP) then result := FFAudioGetQuality (audioP^) else result := K_AUTO; if gLogEx then begin TraceWrite ('MclAudioGetQuality'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' result=' + FStr_ (result)); end; except result := K_AUTO; ErrExcept_; end; end; function MclAudioHasCodecDlg (mOut: QmclOut): Qbool; stdcall; var dataP : QmclOutputP; audioP : PQFFAudioParams; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclAudioHasCodecDlg'); TraceWrite (' mOut=' + PStr_ (dataP)); end; audioP := MclOut_GetAudioP (dataP); result := Assigned (audioP) and audioP^.aHasDlg; if gLogEx then TraceWrite (' result=' + BStr_ (result)); except result := FALSE; ErrExcept_; end; end; function MclAudioShowCodecDlg (mOut: QmclOut): Qbool; stdcall; var dataP : QmclOutputP; audioP : PQFFAudioParams; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclAudioShowCodecDlg'); TraceWrite (' mOut=' + PStr_ (dataP)); end; audioP := MclOut_GetAudioP (dataP); result := Assigned (audioP) and (audioP^.aHasDlg); if result then result := FFSaveDlgAudio (dataP^.outFile.saveInfo, audioP^, dataP^.outFile.aFormat); if gLogEx then TraceWrite (' result=' + BStr_ (result)); except result := FALSE; ErrExcept_; end; end; procedure MclAudioSetTruncateToVideo (mOut: QmclOut; truncateAudio: Qbool); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclAudioSetTruncateToVideo'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' truncateAudio=' + BStr_ (truncateAudio)); end; dataP^.outFile.aTruncate := truncateAudio; except ErrExcept_; end; end; function MclAudioGetTruncateToVideo (mOut: QmclOut): Qbool; stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); result := dataP^.outFile.aTruncate; if gLogEx then begin TraceWrite ('MclAudioGetTruncateToVideo'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' result=' + BStr_ (result)); end; except result := FALSE; ErrExcept_; end; end; procedure MclSetFormatPreset (mOut: QmclOut; presetId, tvStandard: Qint); stdcall; type QfmtPreset = record vFileFmt, vCodec : Qint; vBitRate, vBitMin, vBitMax : Qint; vResX_PAL, vResY_PAL, vResX_NTSC, vResY_NTSC : Qint; aFileFmt, aCodec : Qint; aBitRate, aFreq, aChan, aRes : Qint; end; const PRESET_COUNT = 8; presets : array [0..PRESET_COUNT-1] of QfmtPreset = ( // VCD (vFileFmt: FILEFMT_MPG; vCodec: MCL_MPG_VCD; vBitRate: KBITS_VIDEO_VCD_CBR; vBitMin: KBITS_VIDEO_VCD_CBR; vBitMax: KBITS_VIDEO_VCD_CBR; vResX_PAL: RES_X_PAL_VCD; vResY_PAL: RES_Y_PAL_VCD; vResX_NTSC: RES_X_NTSC_VCD; vResY_NTSC: RES_Y_NTSC_VCD; aFileFmt: FILEFMT_MPG; aCodec: MCL_MPG_LAYER2; aBitRate: KBITS_AUDIO_MP2_VCD; aFreq: AUDIO_44KHZ; aChan: AUDIO_STEREO; aRes: AUDIO_16BIT), // SVCD (vFileFmt: FILEFMT_MPG; vCodec: MCL_MPG_SVCD; vBitRate: KBITS_VIDEO_SVCD_VBR; vBitMin: KBITS_VIDEO_SVCD_MIN; vBitMax: KBITS_VIDEO_SVCD_MAX; vResX_PAL: RES_X_PAL_SVCD; vResY_PAL: RES_Y_PAL_SVCD; vResX_NTSC: RES_X_NTSC_SVCD; vResY_NTSC: RES_Y_NTSC_SVCD; aFileFmt: FILEFMT_MPG; aCodec: MCL_MPG_LAYER2; aBitRate: KBITS_AUDIO_MP2_SVCD; aFreq: AUDIO_44KHZ; aChan: AUDIO_STEREO; aRes: AUDIO_16BIT), // DVD (vFileFmt: FILEFMT_MPG; vCodec: MCL_MPG_DVD; vBitRate: KBITS_VIDEO_DVD_VBR; vBitMin: KBITS_VIDEO_DVD_MIN; vBitMax: KBITS_VIDEO_DVD_MAX; vResX_PAL: RES_X_PAL_DVD; vResY_PAL: RES_Y_PAL_DVD; vResX_NTSC: RES_X_NTSC_DVD; vResY_NTSC: RES_Y_NTSC_DVD; aFileFmt: FILEFMT_MPG; aCodec: MCL_MPG_AC3; aBitRate: KBITS_AUDIO_AC3_STEREO; aFreq: AUDIO_48KHZ; aChan: AUDIO_STEREO; aRes: AUDIO_16BIT), // XVID (vFileFmt: FILEFMT_AVI; vCodec: AVI_XVID; vBitRate: 700; vBitMin: 0; vBitMax: 700*2; vResX_PAL: RES_X_PAL_DVD; vResY_PAL: RES_Y_PAL_DVD; vResX_NTSC: RES_X_NTSC_DVD; vResY_NTSC: RES_Y_NTSC_DVD; aFileFmt: FILEFMT_AVI; aCodec: AVI_MP3; aBitRate: 128; aFreq: AUDIO_44KHZ; aChan: AUDIO_STEREO; aRes: AUDIO_16BIT), // DIVX (vFileFmt: FILEFMT_AVI; vCodec: AVI_DIVX; vBitRate: 780; vBitMin: 0; vBitMax: 780*2; vResX_PAL: RES_X_PAL_DVD; vResY_PAL: RES_Y_PAL_DVD; vResX_NTSC: RES_X_NTSC_DVD; vResY_NTSC: RES_Y_NTSC_DVD; aFileFmt: FILEFMT_AVI; aCodec: AVI_MP3; aBitRate: 128; aFreq: AUDIO_44KHZ; aChan: AUDIO_STEREO; aRes: AUDIO_16BIT), // MPEG-1 (vFileFmt: FILEFMT_MPG; vCodec: MCL_MPG_MPEG1; vBitRate: KBITS_VIDEO_MPEG1_VBR; vBitMin: 0; vBitMax: 0; vResX_PAL: RES_X_PAL_MPEG1; vResY_PAL: RES_Y_PAL_MPEG1; vResX_NTSC: RES_X_NTSC_MPEG1; vResY_NTSC: RES_Y_NTSC_MPEG1; aFileFmt: FILEFMT_MPG; aCodec: MCL_MPG_LAYER2; aBitRate: KBITS_AUDIO_MP2_MPEG1; aFreq: AUDIO_44KHZ; aChan: AUDIO_STEREO; aRes: AUDIO_16BIT), // MPEG-2 (vFileFmt: FILEFMT_MPG; vCodec: MCL_MPG_MPEG2; vBitRate: KBITS_VIDEO_MPEG2_VBR; vBitMin: 0; vBitMax: 0; vResX_PAL: RES_X_PAL_MPEG2; vResY_PAL: RES_Y_PAL_MPEG2; vResX_NTSC: RES_X_NTSC_MPEG2; vResY_NTSC: RES_Y_NTSC_MPEG2; aFileFmt: FILEFMT_MPG; aCodec: MCL_MPG_LAYER2; aBitRate: KBITS_AUDIO_MP2_MPEG2; aFreq: AUDIO_44KHZ; aChan: AUDIO_STEREO; aRes: AUDIO_16BIT), // MPEG-4 (vFileFmt: FILEFMT_MP4; vCodec: MCL_MPG_MPEG4; vBitRate: KBITS_VIDEO_MPEG4; vBitMin: 0; vBitMax: 0; vResX_PAL: RES_X_PAL_DVD; vResY_PAL: RES_Y_PAL_DVD; vResX_NTSC: RES_X_NTSC_DVD; vResY_NTSC: RES_Y_NTSC_DVD; aFileFmt: FILEFMT_MP4; aCodec: MCL_MPG_AAC; aBitRate: KBITS_AUDIO_AAC_NORMAL; aFreq: AUDIO_44KHZ; aChan: AUDIO_STEREO; aRes: AUDIO_16BIT) ); var p : ^QfmtPreset; begin ErrReset_; try if gLogEx then begin TraceWrite ('MclSetFormatPreset'); TraceWrite (' presetId=' + ns(presetId,0)); TraceWrite (' tvStandard=' + ns(tvStandard,0)); end; if (presetId >= 0) and (presetId < PRESET_COUNT) then begin // get pointer to data p := @presets[presetId]; // video MclVideoSetFileFormat (mOut, p^.vFileFmt); MclVideoSetCodec (mOut, p^.vCodec); MclVideoSetBitRate (mOut, p^.vBitRate, p^.vBitMin, p^.vBitMax); if (tvStandard = MCL_TV_PAL) then begin MclVideoSetFormat (mOut, p^.vResX_PAL, p^.vResY_PAL, BITS_24); MclVideoSetFrameRate (mOut, FPS_PAL); end else begin // NTSC MclVideoSetFormat (mOut, p^.vResX_NTSC, p^.vResY_NTSC, BITS_24); MclVideoSetFrameRate (mOut, FPS_NTSC); end; MclVideoSetKeepDuration (mOut, TRUE); MclVideoSetAspectRatio (mOut, ASR_SQUARE); // audio MclAudioSetFileFormat (mOut, p^.aFileFmt); MclAudioSetCodec (mOut, p^.aCodec); MclAudioSetBitRate (mOut, p^.aBitRate); MclAudioSetFormat (mOut, p^.aFreq, p^.aChan, p^.aRes); end; except ErrExcept_; end; end; procedure MclAviClearCustomInfo (mOut: QmclOut); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclAviClearCustomInfo'); TraceWrite (' mOut=' + PStr_ (dataP)); end; FFSaveClearAviCustomInfo (dataP^.outFile.saveInfo); except ErrExcept_; end; end; procedure MclAviAddCustomInfo (mOut: QmclOut; tagId, value: QcharP); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclAviAddCustomInfo'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' tagId=' + tagId); TraceWrite (' value=' + value); end; FFSaveSetAviCustomInfo (dataP^.outFile.saveInfo, tagId, value); except ErrExcept_; end; end; procedure MclSetUserData (mOut: QmclOut; userDataP: pointer); stdcall; var dataP : QmclOutputP; begin dataP := pointer (mOut); if Assigned (dataP) then dataP^.customDataP := userDataP; end; function MclGetUserData (mOut: QmclOut): pointer; stdcall; var dataP : QmclOutputP; begin dataP := pointer (mOut); if Assigned (dataP) then result := dataP^.customDataP else result := NIL; end; procedure MclAssignVideoSource (mOut: QmclOut; funcPtr: QmclMediaSourceCBF); stdcall; var dataP : QmclOutputP; begin dataP := pointer (mOut); if Assigned (dataP) then dataP^.videoSourceCBF := funcPtr; end; procedure MclAssignVideoFunc (mOut: QmclOut; funcPtr: QmclVideoFuncCBF); stdcall; var dataP : QmclOutputP; begin dataP := pointer (mOut); if Assigned (dataP) then dataP^.videoFuncCBF := funcPtr; end; procedure MclAssignVideoFuncEx (mOut: QmclOut; funcPtr: QmclVideoFuncExCBF); stdcall; var dataP : QmclOutputP; begin dataP := pointer (mOut); if Assigned (dataP) then dataP^.videoFuncExCBF := funcPtr; end; procedure MclAssignAudioSource (mOut: QmclOut; funcPtr: QmclMediaSourceCBF); stdcall; var dataP : QmclOutputP; begin dataP := pointer (mOut); if Assigned (dataP) then dataP^.audioSourceCBF := funcPtr; end; procedure MclAssignAudioFunc (mOut: QmclOut; funcPtr: QmclAudioFuncCBF); stdcall; var dataP : QmclOutputP; begin dataP := pointer (mOut); if Assigned (dataP) then dataP^.audioFuncCBF := funcPtr; end; procedure MclAssignProgress (mOut: QmclOut; funcPtr: QmclProgressCBF); stdcall; var dataP : QmclOutputP; begin dataP := pointer (mOut); if Assigned (dataP) then dataP^.progressCBF := funcPtr; end; procedure MclAssignError (mOut: QmclOut; funcPtr: QmclErrorCBF); stdcall; var dataP : QmclOutputP; begin dataP := pointer (mOut); if Assigned (dataP) then dataP^.errorCBF := funcPtr; end; procedure MclSourceSetFile (mOut: QmclOut; fileName: QcharP); stdcall; var dataP : QmclOutputP; destStrP : QcharP; len : Qint; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclSourceSetFile'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' fileName=' + fileName); end; if dataP^.CBFType = K_CBF_VIDEO then destStrP := gSrcVideoFile else destStrP := gSrcAudioFile; if Assigned (destStrP) then MemFree (destStrP); len := StrLen (fileName) + 1; MemStrAlloc (destStrP, len ); StrCopy (destStrP, fileName); dataP^.srcInfoP^.src := destStrP; dataP^.srcInfoP^.srcType := CON_SRC_PATH; dataP^.srcInfoP^.useFPS := K_AUTO; if dataP^.CBFType = K_CBF_VIDEO then gSrcVideoFile := destStrP else gSrcAudioFile := destStrP; except ErrExcept_; end; end; procedure MclSourceSetImage (mOut: QmclOut; mImg: QmclImg); stdcall; var dataP : QmclOutputP; imgP : QimgP; begin ErrReset_; try dataP := pointer (mOut); imgP := pointer (mImg); if gLogEx then begin TraceWrite ('MclSourceSetImage'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' mImg=' + ImgStr_ (imgP)); end; ImgCopy (imgP^, gImg); dataP^.srcInfoP^.src := @gImg; dataP^.srcInfoP^.srcType := CON_SRC_QHANDLE; except ErrExcept_; end; end; procedure MclSourceSetDIB (mOut: QmclOut; DIBhandle: HBITMAP); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclSourceSetDIB'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' DIBhandle=' + IStr_ (DIBhandle)); end; if HBitmapToQimg (DIBhandle, gImg) then begin if gLogEx then TraceWrite (' img=' + ImgStr_ (@gImg)); dataP^.srcInfoP^.src := @gImg; dataP^.srcInfoP^.srcType := CON_SRC_QHANDLE; end; except ErrExcept_; end; end; procedure MclSourceSetPixels (mOut: QmclOut; pixPtr, palPtr: pointer; resX, resY, bpp: Qint); stdcall; // sets raw pixels as the source, if = NIL generates a blank image begin ErrReset_; try if gLogEx then TraceWrite ('MclSourceSetPixels'); MclSourceSetPixelsRect (mOut, pixPtr, palPtr, resX, resY, bpp, 0, 0, resX, abs(resY)); except ErrExcept_; end; end; procedure MclSourceSetPixelsRect (mOut: QmclOut; pixPtr, palPtr: pointer; resX, resY, bpp, posX, posY, copyX, copyY: Qint); stdcall; // sets raw pixels as the source, if = NIL generates a blank image var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclSourceSetPixelsRect'); TraceWrite (' mData=' + PStr_ (dataP)); TraceWrite (' pixPtr=' + PStr_ (pixPtr)); TraceWrite (' palPtr=' + PStr_ (palPtr)); TraceWrite (' resX=' + IStr_ (resX)); TraceWrite (' resY=' + IStr_ (resY)); TraceWrite (' bpp=' + IStr_ (bpp)); TraceWrite (' posX=' + IStr_ (posX)); TraceWrite (' posY=' + IStr_ (posY)); TraceWrite (' copyX=' + IStr_ (copyX)); TraceWrite (' copyY=' + IStr_ (copyY)); end; if Assigned (pixPtr) then RawToQimg (gImg, pixPtr, palPtr, resX, resY, bpp, posX, posY, copyX, copyY) else begin // blank image ImgAlloc (gImg, copyX, copyY, bpp ); FillChar (gImg.imgData^, gImg.sizeBytes, 0); if (bpp = BITS_8) then if Assigned (palPtr) then Move (palPtr^, gImg.pal256, SizeOf (gImg.pal256)) else FillChar (gImg.pal256, SizeOf (gImg.pal256), 0); end; dataP^.srcInfoP^.src := @gImg; dataP^.srcInfoP^.srcType := CON_SRC_QHANDLE; except ErrExcept_; end; end; procedure MclSourceSetFrameRate (mOut: QmclOut; frameRate: Qfloat); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclSourceSetFrameRate'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' frameRate=' + FStr_ (frameRate)); end; dataP^.srcInfoP^.useFPS := frameRate; except ErrExcept_; end; end; procedure MclSourceSetDirection (mOut: QmclOut; direction: Qint); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclSourceSetDirection'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' direction=' + IStr_ (direction)); end; dataP^.srcInfoP^.saveDirection := direction; except ErrExcept_; end; end; procedure MclSourceSetSound (mOut: QmclOut; mSnd: QmclSnd); stdcall; var dataP : QmclOutputP; sndP : QsndP; begin ErrReset_; try dataP := pointer (mOut); sndP := pointer (mSnd); if gLogEx then begin TraceWrite ('MclSourceSetSound'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' mSnd=' + SndStr_ (sndP)); end; SndMove (sndP^, gSnd, 0, sndP^.samples); dataP^.srcInfoP^.src := @gSnd; dataP^.srcInfoP^.srcType := CON_SRC_QHANDLE; except ErrExcept_; end; end; procedure MclSourceSetSamples (mOut: QmclOut; sndPtr: pointer; numOfSamples, sampleRate, channels, bitsPerChannel: Qint); stdcall; var dataP : QmclOutputP; byteSize : Qint; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclSourceSetSamples'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' sndPtr=' + PStr_ (sndPtr)); TraceWrite (' numOfSamples=' + IStr_ (numOfSamples)); TraceWrite (' sampleRate=' + IStr_ (sampleRate)); TraceWrite (' channels=' + IStr_ (channels)); TraceWrite (' bitsPerChannel=' + IStr_ (bitsPerChannel)); end; if Assigned (sndPtr) then begin byteSize := numOfSamples * channels * ((bitsPerChannel + 7) div 8); dataP^.srcInfoP^.srcType := CON_SRC_QHANDLE; SndAlloc (gSnd, byteSize ); SndWaveFmtPCMSet (gSnd.PCMFormat, sampleRate, channels, bitsPerChannel); gSnd.samples := numOfSamples; Move (sndPtr^, gSnd.sndData^, byteSize); dataP^.srcInfoP^.src := @gSnd; end else begin // silence dataP^.srcInfoP^.srcType := CON_SRC_BLANK; if sampleRate > 0 then dataP^.srcInfoP^.numSecs := numOfSamples / sampleRate else dataP^.srcInfoP^.numSecs := 1; end; except ErrExcept_; end; end; procedure MclSourceSetStart (mOut: QmclOut; quant: Qint); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclSourceSetStart'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' quant=' + IStr_ (quant)); end; dataP^.srcInfoP^.startSample := quant + 1; except ErrExcept_; end; end; procedure MclSourceSetLen (mOut: QmclOut; quants: Qint); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclSourceSetLen'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' quants=' + IStr_ (quants)); end; dataP^.srcInfoP^.numSamples := quants; except ErrExcept_; end; end; procedure MclSourceSetStartTime (mOut: QmclOut; sec: Qfloat); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclSourceSetStartTime'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' sec=' + FStr_ (sec)); end; dataP^.srcInfoP^.startSec := sec; except ErrExcept_; end; end; procedure MclSourceSetLenTime (mOut: QmclOut; secs: Qfloat); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclSourceSetLenTime'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' secs=' + FStr_ (secs)); end; dataP^.srcInfoP^.numSecs := secs; except ErrExcept_; end; end; procedure MclSourceSkip (mOut: QmclOut); stdcall; var dataP : QmclOutputP; begin ErrReset_; try if gLogEx then TraceWrite ('MclSourceSkip'); dataP := pointer (mOut); dataP^.srcInfoP^.srcType := CON_SRC_SKIP; except ErrExcept_; end; end; procedure MclSourceFinished (mOut: QmclOut); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclSourceFinished'); TraceWrite (' mOut=' + PStr_ (dataP)); end; dataP^.srcInfoP^.finished := TRUE; except ErrExcept_; end; end; procedure MclImgSkip (mImg: QmclImg); stdcall; var imgP : QimgP; begin ErrReset_; try imgP := pointer (mImg); if gLogEx then begin TraceWrite ('MclImgSkip'); TraceWrite (' mImg=' + ImgStr_ (imgP)); end; ImgFree (imgP^); ImgInitHandle (imgP^); except ErrExcept_; end; end; function MclVideoGetBytesWritten (mOut: QmclOut): Qfloat; stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if Assigned (dataP^.vidBytesWrittenP) then result := dataP^.vidBytesWrittenP^ else result := 0; except ErrExcept_; result := 0; end; end; function MclAudioGetBytesWritten (mOut: QmclOut): Qfloat; stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if Assigned (dataP^.audBytesWrittenP) then result := dataP^.audBytesWrittenP^ else result := 0; except ErrExcept_; result := 0; end; end; function MclGetElapsedTime (mOut: QmclOut): Qfloat; stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclGetElapsedTime'); TraceWrite (' mOut=' + PStr_ (dataP)); end; result := dataP^.pgsVideoTime + dataP^.pgsAudioTime; if gLogEx then TraceWrite (' result=' + FStr_ (result)); except result := 0; ErrExcept_; end; end; function MclGetRemainingTime (mOut: QmclOut; totalFrames, totalSamples: Qint): Qfloat; stdcall; var dataP : QmclOutputP; videoTime, audioTime : Qfloat; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclGetRemainingTime'); TraceWrite (' mOut=' + PStr_ (dataP)); TraceWrite (' totalFrames=' + IStr_ (totalFrames)); TraceWrite (' totalSamples=' + IStr_ (totalSamples)); end; videoTime := Predict_GetRemainingEx (dataP^.pgsVideoPred, dataP^.pgsVideoQuant, totalFrames, dataP^.pgsVideoTime); audioTime := Predict_GetRemainingEx (dataP^.pgsAudioPred, dataP^.pgsAudioQuant, totalSamples, dataP^.pgsAudioTime); result := Predict_TimeGranulate (videoTime + audioTime); if gLogEx then TraceWrite (' result=' + FStr_ (result)); except result := 0; ErrExcept_; end; end; procedure MclMakeTimeStr (seconds: Qfloat; timeStr: QcharP); stdcall; var temp : Qstring; begin ErrReset_; try if gLogEx then TraceWrite ('MclMakeTimeStr'); temp := SecToStr (seconds, K_TIME_HMS); StrPCopy (timeStr, temp); if gLogEx then TraceWrite (' timeStr=' + timeStr); except ErrExcept_; end; end; // ===== MCL CONVERT BEGIN ============================================== procedure MclSwapImgPtr_ (var p1, p2: QimgP); var p3 : QimgP; begin p3 := p1; p1 := p2; p2 := p3; end; procedure MclSwapSndPtr_ (var p1, p2: QsndP); var p3 : QsndP; begin p3 := p1; p1 := p2; p2 := p3; end; function MclGetRealDitherType_ (mclDitherType: Qint): Qint; // convert to PalOpt constants begin case mclDitherType of MCL_DITHER_NONE: result := DITHER_NONE; MCL_DITHER_LITE: result := DITHER_LITE; MCL_DITHER_HEAVY: result := DITHER_HEAVY; else result := DITHER_NONE; end; end; procedure CallUserProgress_; var dataP : QmclOutputP; begin try if Assigned (gProgressCBF) then begin dataP := pointer (gCurMclOut); if gLogEx then TraceWrite (' MclCallUserProgress_'); gProgressCBF (gCurMclOut, dataP^.pgsStatus, dataP^.pgsVideoQuant, dataP^.pgsAudioQuant, dataP^.pgsPercentMux); if (dataP^.doAbort) then ConStop (K_CON_FINISH); end; except ErrExcept_; end; end; procedure MclProgressCBF_ (var progressInfo: QFFProgressInfo); cdecl; var dataP : QmclOutputP; begin dataP := pointer (gCurMclOut); // video dataP^.pgsVideoQuant := progressInfo.curFrame; dataP^.pgsVideoTime := progressInfo.imgSecsElapsed; dataP^.vidBytesWrittenP := @progressInfo.imgBytesOut; // audio dataP^.pgsAudioQuant := progressInfo.curSample; dataP^.pgsAudioTime := progressInfo.sndSecsElapsed; dataP^.audBytesWrittenP := @progressInfo.sndBytesOut; if (progressInfo.multiplexing) then begin dataP^.pgsStatus := MCL_STATUS_MULTIPLEXING; dataP^.pgsPercentMux := round (progressInfo.percentMux); end; CallUserProgress_; if (dataP^.doAbort) then progressInfo.stopAbort := K_CON_FINISH; end; procedure MclErrorCBF_ (path: Qstring; var action: Qint); var dataP : QmclOutputP; begin try ErrSet_ (MCLRES_EXCEPTION); ErrSetStr_ (ErrMessageLast); if gLogEx then begin TraceWrite ('ERROR: ' + ErrGetStr_); TraceWrite (' MclErrorCBF_'); TraceWrite (' path=' + path); end; dataP := pointer (gCurMclOut); action := K_CON_ABORT; if Assigned (dataP^.errorCBF) then begin dataP^.errorCBF (integer (dataP), QcharP (path), action); if gLogEx then TraceWrite (' action=' + IStr_ (action)); end; except end; end; procedure MclVideoSourceCBF_ (var srcInfo: QconSrcInfo); // called when adding video files or frames var dataP : QmclOutputP; begin try dataP := pointer (gCurMclOut); if gLogEx then TraceWrite (' MclVideoSourceCBF_'); if dataP^.doAbort then begin srcInfo.finished := TRUE; ConStop (K_CON_FINISH); end else begin dataP^.srcInfoP := @srcInfo; dataP^.srcInfoP^.src := NIL; dataP^.srcInfoP^.srcType := K_INVALID; dataP^.srcInfoP^.startSample := K_AUTO; dataP^.srcInfoP^.numSamples := K_AUTO; dataP^.srcInfoP^.startSec := K_AUTO; dataP^.srcInfoP^.numSecs := K_AUTO; dataP^.srcInfoP^.numRepeats := 1; dataP^.srcInfoP^.useFPS := dataP^.outFile.vFps; dataP^.srcInfoP^.saveDirection := K_FORWARD; dataP^.srcInfoP^.detectSequence := MCL_SEQ_IGNORE; dataP^.CBFType := K_CBF_VIDEO; if Assigned (dataP^.videoSourceCBF) then begin dataP^.videoSourceCBF (integer (dataP), dataP^.srcInfoP^.blockNum); // call user function if gLogEx then TraceWrite (' srcNum=' + IStr_ (dataP^.srcInfoP^.blockNum)); end; if (dataP^.srcInfoP^.srcType <> CON_SRC_SKIP) then Inc (dataP^.srcInfoP^.blockNum); if dataP^.srcInfoP^.srcType = K_INVALID then srcInfo.finished := TRUE; end; except ErrExcept_; end; end; procedure MclVideoFuncCBF_ (var funcInfo: QconFuncInfo); // called when each image is loaded var dataP : QmclOutputP; img1P, img2P : QimgP; label EXIT_PROC; begin dataP := pointer (gCurMclOut); try if gLogEx then begin TraceWrite (' MclVideoFuncCBF_'); TraceWrite (' curFrame=' + IStr_ (dataP^.curFrame)); end; if dataP^.doAbort then begin ConStop (K_CON_FINISH); img1P := NIL; GOTO EXIT_PROC; end; img1P := funcInfo.img1P; img2P := funcInfo.img2P; // rescale before calling user functions; // only if size is explicitly set via MclVideoSetFormat function if (not dataP^.outFile.vAutoRes) and ((img1P^.resX <> dataP^.outFile.vResX) or (img1P^.resY <> dataP^.outFile.vResY)) then begin ImgResample (img1P^, img2P^, dataP^.outFile.vResX, dataP^.outFile.vResY); MclSwapImgPtr_ (img1P, img2P); end else if Assigned (dataP^.videoFuncExCBF) then begin ImgCopy (img1P^, img2P^); MclSwapImgPtr_ (img1P, img2P); end; // user functions if Assigned (dataP^.videoFuncExCBF) or Assigned (dataP^.videoFuncCBF) then begin dataP^.funcInfoP := @funcInfo; dataP^.CBFType := K_CBF_VIDEO; if Assigned (dataP^.videoFuncExCBF) then // call user function dataP^.videoFuncExCBF (integer (dataP), integer (img2P), funcInfo.framePosIn, integer (img1P), dataP^.curFrame) else dataP^.videoFuncCBF (integer (dataP), integer (img1P), dataP^.curFrame); end; // if the image isn't skipped... if (img1P^.sizeBytes > 0) then begin // show commercial // color depth if (dataP^.outFile.vBpp <> BITS_8) and (img1P^.bpp <> dataP^.outFile.vBpp) then begin ImgConvBpp (img1P^, img2P^, dataP^.outFile.vBpp); MclSwapImgPtr_ (img1P, img2P); end; case dataP^.pgsStatus of MCL_STATUS_COUNTING: PalCountColors (img1P^); MCL_STATUS_SAVING: if dataP^.reduceTo8bit then begin PalRemap (img1P^, img2P^, MclGetRealDitherType_ (dataP^.outFile.vDither)); MclSwapImgPtr_ (img1P, img2P); end; end; end else begin // if skipped img1P := NIL; end; EXIT_PROC: except ErrExcept_; end; funcInfo.imgResultP := img1P; Inc (dataP^.curFrame); end; procedure MclAudioSourceCBF_ (var srcInfo: QconSrcInfo); var dataP : QmclOutputP; begin try dataP := pointer (gCurMclOut); if gLogEx then begin TraceWrite (' MclAudioSourceCBF_'); TraceWrite (' srcNum=' + IStr_ (dataP^.srcInfoP^.blockNum)); end; if dataP^.doAbort then begin srcInfo.finished := TRUE; ConStop (K_CON_FINISH); end else begin dataP^.srcInfoP := @srcInfo; dataP^.srcInfoP^.src := NIL; dataP^.srcInfoP^.srcType := K_INVALID; dataP^.srcInfoP^.startSample := K_AUTO; dataP^.srcInfoP^.numSamples := K_AUTO; dataP^.srcInfoP^.startSec := K_AUTO; dataP^.srcInfoP^.numSecs := K_AUTO; dataP^.srcInfoP^.numRepeats := 1; dataP^.srcInfoP^.useFPS := K_AUTO; dataP^.srcInfoP^.saveDirection := K_FORWARD; dataP^.srcInfoP^.detectSequence := MCL_SEQ_IGNORE; dataP^.CBFType := K_CBF_AUDIO; if Assigned (dataP^.audioSourceCBF) then dataP^.audioSourceCBF (integer (dataP), dataP^.srcInfoP^.blockNum); // call user function if (dataP^.srcInfoP^.srcType <> CON_SRC_SKIP) then Inc (dataP^.srcInfoP^.blockNum); if dataP^.srcInfoP^.srcType = K_INVALID then srcInfo.finished := TRUE; end; except ErrExcept_; end; end; procedure MclAudioFuncCBF_ (var funcInfo: QconFuncInfo); var dataP : QmclOutputP; snd1P, snd2P : QsndP; numSamples : Qint; label EXIT_PROC; begin dataP := pointer (gCurMclOut); try if gLogEx then begin TraceWrite (' MclAudioFuncCBF_'); TraceWrite (' curSample=' + IStr_ (dataP^.curSample)); end; numSamples := 0; if dataP^.doAbort then begin ConStop (K_CON_FINISH); snd1P := NIL; GOTO EXIT_PROC; end; snd1P := funcInfo.snd1P; snd2P := funcInfo.snd2P; if Assigned (snd1P) then numSamples := snd1P^.samples; // format conversion if (dataP^.outFile.aAutoFormat) then begin // if output format is undefined, copy from input Move (snd1P^.PCMFormat, dataP^.outFile.aFormat, sizeof(snd1P^.PCMFormat)); // check the format, make it compatible to current codec MclOut_PrepareAudio (dataP); dataP^.outFile.aAutoFormat := FALSE; end; if SndWaveFmtCompare (@snd1P^.PCMFormat, @dataP^.outFile.aFormat) <> 0 then begin SndConvert (snd1P^, snd2P^, dataP^.outFile.aFormat); MclSwapSndPtr_ (snd1P, snd2P); end; // user functions if Assigned (dataP^.audioFuncCBF) then begin dataP^.funcInfoP := @funcInfo; dataP^.CBFType := K_CBF_AUDIO; dataP^.audioFuncCBF (integer (dataP), integer (snd1P), dataP^.curSample); // call user function end; // if sound block is skipped... if snd1P^.sizeBytes = 0 then snd1P := NIL; EXIT_PROC: except numSamples := 0; ErrExcept_; end; funcInfo.sndResultP := snd1P; Inc (dataP^.curSample, numSamples); end; function MclPrepareOutput_ (dataP: QmclOutputP): Qbool; var videoP : PQFFVideoParams; audioP : PQFFAudioParams; begin ErrReset_; try if gLogEx then TraceWrite (' MclPrepareOutput_'); // video videoP := MclOut_GetVideoP (dataP); if Assigned (videoP) then begin if (videoP^.vFileFmtId = FILEFMT_MPG) then dataP^.outFile.vFps := MpgCalcFrameRate (dataP^.outFile.vFps); FFVideoSetFrameRate (videoP^, dataP^.outFile.vFps, dataP^.outFile.vKeepDuration); MclOut_PrepareVideo (dataP); dataP^.reduceTo8bit := (dataP^.outFile.vBpp = BITS_8); end else dataP^.outFile.vFileName := ''; // audio audioP := MclOut_GetAudioP (dataP); if Assigned (audioP) then begin MclOut_PrepareAudio (dataP); ConTruncateAudioToVideo (dataP^.outFile.aTruncate); end else dataP^.outFile.aFileName := ''; // common result := (Assigned (videoP) or Assigned (audioP)) and ErrOK_; except result := FALSE; ErrExcept_; end; end; function MclConvert (mOut: QmclOut): Qresult; stdcall; var dataP : QmclOutputP; report : QconReport; videoP : PQFFVideoParams; audioP : PQFFAudioParams; firstError : Qint; firstErrorStr : Qstring; label EXIT_PROCESSING; begin ErrReset_; firstError := MCLRES_OK; dataP := pointer (mOut); try if gLogEx then begin TraceWrite ('===== MclConvert: Init ====='); TraceWrite (' mData=' + PStr_ (dataP)); end; // signalize that we're using MclConvert with this output handle gCurMclOut := mOut; gProgressCBF := dataP^.progressCBF; dataP^.doAbort := FALSE; dataP^.pgsStatus := MCL_STATUS_PREPARING; // progress vars Predict_Init (dataP^.pgsVideoPred); dataP^.pgsVideoQuant := 0; dataP^.pgsVideoTime := 0; Predict_Init (dataP^.pgsAudioPred); dataP^.pgsAudioQuant := 0; dataP^.pgsAudioTime := 0; // start try CallUserProgress_; if (not dataP^.doAbort) then begin if not MclPrepareOutput_ (dataP) then GOTO EXIT_PROCESSING; // get codec pointers if (dataP^.outFile.vFileName = '') then videoP := NIL else videoP := MclOut_GetVideoP (dataP); if (dataP^.outFile.aFileName = '') then audioP := NIL else audioP := MclOut_GetAudioP (dataP); // video callbacks if Assigned (dataP^.videoSourceCBF) then begin ConImgSrcInfoCBF (MclVideoSourceCBF_); ConImgFunc (MclVideoFuncCBF_); end else begin ConImgSrcInfoCBF (NIL); ConImgFunc (NIL); end; // audio callbacks if Assigned (dataP^.audioSourceCBF) then begin ConSndSrcInfoCBF (MclAudioSourceCBF_); ConSndFunc (MclAudioFuncCBF_); end else begin ConSndSrcInfoCBF (NIL); ConSndFunc (NIL); end; // other callbacks ConSetCBF (MclProgressCBF_, MclErrorCBF_); // color reduction if dataP^.reduceTo8bit then begin if gLogEx then TraceWrite (' computing palette'); PalInit; PalClearVars; dataP^.pgsStatus := MCL_STATUS_COUNTING; dataP^.curFrame := 0; ConStart ('', '', dataP^.outFile.saveInfo, videoP, audioP, report); if (not dataP^.doAbort) then PalReduce (256); end; // saving if (not dataP^.doAbort) then begin if gLogEx then TraceWrite (' writing to file'); dataP^.pgsStatus := MCL_STATUS_SAVING; dataP^.curFrame := 0; dataP^.curSample := 0; ConStop (K_FALSE); // because MclCallUserProgress resets it to invalid value ConStart (dataP^.outFile.vFileName, dataP^.outFile.aFileName, dataP^.outFile.saveInfo, videoP, audioP, report); end; // free palette buffer after processing if dataP^.reduceTo8bit then PalDone; end; ConDone; EXIT_PROCESSING: except ErrExcept_; end; firstError := ErrGet_; firstErrorStr := ErrGetStr_; dataP^.pgsStatus := MCL_STATUS_READY; CallUserProgress_; if Assigned (gSrcVideoFile) then MemFree (gSrcVideoFile); if Assigned (gSrcAudioFile) then MemFree (gSrcAudioFile); ImgFree (gImg); SndFree (gSnd); except ErrExcept_; end; // handle special cases of errors if ErrOK_ then begin if (firstError <> MCLRES_OK) then begin ErrSet_ (firstError); ErrSetStr_ (firstErrorStr); end else if (dataP^.doAbort) then ErrSet_ (MCLRES_USER_ABORTED); end; dataP^.pgsStatus := MCL_STATUS_READY; result := ErrGet_; if gLogEx then TraceWrite ('===== MclConvert: Done ====='); end; // ===== MCL CONVERT END ================================================ procedure MclAbort (mOut: QmclOut); stdcall; var dataP : QmclOutputP; begin ErrReset_; try dataP := pointer (mOut); if gLogEx then begin TraceWrite ('MclAbort'); TraceWrite (' mOut=' + PStr_ (dataP)); end; dataP^.doAbort := TRUE; except ErrExcept_; end; end; function MclGetStatus (mOut: QmclOut): Qint; stdcall; var dataP : QmclOutputP; begin try if gLogEx then TraceWrite ('MclGetStatus'); dataP := pointer (mOut); result := dataP^.pgsStatus; if gLogEx then TraceWrite (' result=' + IStr_ (result)); except result := MCL_STATUS_READY; ErrExcept_; end; end; function MclGetError: Qint; stdcall; begin result := ErrGet_; end; function MclGetErrorStr: QcharP; stdcall; const errorStr : Qstring = ''; begin errorStr := ErrGetStr_; result := PChar (errorStr); end; procedure MclClearErrors; stdcall; begin ErrReset_; end; procedure MclConvFileInfo_ (var ui: QUniInfo; var info: QmclFileInfo); begin FillChar (info, SizeOf (info), 0); StrPCopy (info.fName, ui.fpath); StrPCopy (info.fFmtName, ui.ffName); info.fSize := ui.fsize; // video info.vExists := ui.video.vExists; info.vSupported := ui.video.vSupported; info.vCodec := ui.video.vCodec; StrPCopy (info.vFmtName, ui.video.vFmtName); info.vLen := ui.video.vLen; info.vTimeLen := ui.video.vTimeLen; info.vBytesLen := ui.video.vBytesLen; info.vFreq := ui.video.vFreq; info.resX := ui.video.resX; info.resY := ui.video.resY; info.resB := ui.video.resB; info.bpp := ui.video.bpp; info.dpiX := ui.video.vDpiX; info.dpiY := ui.video.vDpiY; // audio info.aExists := ui.audio.aExists; info.aSupported := ui.audio.aSupported; info.aCodec := ui.audio.aCodec; StrPCopy (info.aFmtName, ui.audio.aFmtName); info.aLen := ui.audio.aLen; info.aTimeLen := ui.audio.aTimeLen; info.aBytesLen := ui.audio.aBytesLen; info.aFreq := ui.audio.aFreq; info.aChannels := ui.audio.aChannels; info.aBitsChn := ui.audio.aBitsChn; info.aSampleSize := ui.audio.aSampleSize; end; procedure MclGetFileInfo (fileName: QcharP; seqDetect: Qint; var info: QmclFileInfo; fileInfoProgressCBF: QmclFileInfoProgressCBF; userDataP: pointer); stdcall; var ui : QUniInfo; begin ErrReset_; try if gLogEx then begin TraceWrite ('MclGetFileInfo'); TraceWrite (' fileName=' + fileName); TraceWrite (' seqDetect=' + IStr_ (seqDetect)); end; UniInfo (Qstring (fileName), ui, seqDetect, @fileInfoProgressCBF, userDataP); MclConvFileInfo_ (ui, info); except ErrExcept_; end; end; function MclReadOpen (fileName: QcharP; seqDetect: Qint; progressCBF: QmclFileInfoProgressCBF; userDataP: pointer): QmclRead; stdcall; var fileP : QmclInputP; begin ErrReset_; try if gLogEx then begin TraceWrite ('MclReadOpen'); TraceWrite (' fileName=' + fileName); TraceWrite (' seqDetect=' + IStr_ (seqDetect)); end; fileP := MclInput_Create; UniInfo (fileName, fileP^.ui, seqDetect, @progressCBF, userDataP); if fileP^.ui.video.vSupported or fileP^.ui.audio.aSupported then begin UniOpen (fileP^.uf, fileP^.ui); fileP^.isOpen := TRUE; if gLogEx then begin TraceWrite (' mRead=' + PStr_ (fileP)); TraceWrite (' file is open'); end; end else begin MclInput_Free (fileP); if gLogEx then TraceWrite (' file not supported'); end; result := integer (fileP); except result := K_ZERO; ErrExcept_; end; end; procedure MclReadClose (mRead: QmclRead); stdcall; var fileP : QmclInputP; begin ErrReset_; try if (mRead <> K_ZERO) then begin fileP := pointer (mRead); if gLogEx then begin TraceWrite ('MclReadClose'); TraceWrite (' mRead=' + PStr_ (fileP)); end; if fileP^.isOpen then begin UniClose (fileP^.uf); ImgFree (fileP^.prevImg); fileP^.isOpen := FALSE; end; MclInput_Free (fileP); end; except ErrExcept_; end; end; procedure MclReadInfo (mRead: QmclRead; var info: QmclFileInfo); stdcall; var fileP : QmclInputP; begin ErrReset_; try if (mRead <> K_ZERO) then begin fileP := pointer (mRead); if gLogEx then begin TraceWrite ('MclReadInfo'); TraceWrite (' mRead=' + PStr_ (fileP)); end; MclConvFileInfo_ (fileP^.ui, info); // return file information end else FillChar (info, SizeOf (info), 0); except ErrExcept_; end; end; function MclFileAndImageOK_ (outP, imgP: pointer): Qbool; // sets appropriate error if file or image pointers are invalid, // returns TRUE if both are ok begin result := FALSE; if (outP = NIL) then ErrSet_ (MCLRES_MCL_HANDLE_NOT_CREATED) else if (imgP = NIL) then ErrSet_ (MCLRES_IMAGE_HANDLE_NOT_CREATED) else result := TRUE; end; function MclFileAndSoundOK_ (fileP, sndP: pointer): Qbool; // sets appropriate error if file or image pointers are invalid, // returns TRUE if both are ok begin result := FALSE; if (fileP = NIL) then ErrSet_ (MCLRES_MCL_HANDLE_NOT_CREATED) else if (sndP = NIL) then ErrSet_ (MCLRES_SOUND_HANDLE_NOT_CREATED) else result := TRUE; end; function MclReadImage (mRead: QmclRead; frameNum: Qint; mImg: QmclImg): Qresult; stdcall; // is zero based var fileP : QmclInputP; imgP : QimgP; begin ErrReset_; try fileP := pointer (mRead); imgP := pointer (mImg); if gLogEx then begin TraceWrite ('MclReadImage'); TraceWrite (' mRead=' + PStr_ (fileP)); TraceWrite (' frameNum=' + IStr_ (frameNum)); end; if MclFileAndImageOK_ (fileP, imgP) then begin UniImgLoad (fileP^.uf, fileP^.prevImg, frameNum + 1, K_FASTLOAD); ImgCopy (fileP^.prevImg, imgP^); if gLogEx then TraceWrite (' mImg=' + ImgStr_ (imgP)); end; result := ErrGet_; except result := ErrExcept_; end; if gLogEx then TraceWrite (' result=' + ErrStr_ (result)); end; function MclReadAlpha (mRead: QmclRead; frameNum: Qint; mImg: QmclImg): Qresult; stdcall; // is zero based var fileP : QmclInputP; imgP : QimgP; begin ErrReset_; try fileP := pointer (mRead); imgP := pointer (mImg); if gLogEx then begin TraceWrite ('MclReadAlpha'); TraceWrite (' mRead=' + PStr_ (fileP)); TraceWrite (' frameNum=' + IStr_ (frameNum)); end; if MclFileAndImageOK_ (fileP, imgP) then begin UniImgLoadAlpha (fileP^.uf, imgP^, frameNum + 1); if gLogEx then TraceWrite (' mImg=' + ImgStr_ (imgP)); end; result := ErrGet_; except result := ErrExcept_; end; end; function MclReadSound (mRead: QmclRead; startSample, numSamples: Qint; mSnd: QmclSnd): Qresult; stdcall; // is zero based var fileP : QmclInputP; sndP : QsndP; begin ErrReset_; try fileP := pointer (mRead); sndP := pointer (mSnd); if gLogEx then begin TraceWrite ('MclReadSound'); TraceWrite (' mRead=' + PStr_ (fileP)); TraceWrite (' startSample=' + IStr_ (startSample)); TraceWrite (' numSamples=' + IStr_ (numSamples)); end; if MclFileAndSoundOK_ (fileP, sndP) then begin UniSndLoad (fileP^.uf, sndP^, startSample, numSamples, K_FASTLOAD); // must be K_FASTLOAD if gLogEx then TraceWrite (' mSnd=' + SndStr_ (sndP)); end; result := ErrGet_; except result := ErrExcept_; end; end; procedure MclFileCheckCreate_ (dataP: QmclOutputP); // if file is not already created, creates a new one var videoP : PQFFVideoParams; audioP : PQFFAudioParams; begin if Assigned (dataP) and (not (dataP^.outFile.videoFileCreated or dataP^.outFile.audioFileCreated)) then begin if gLogEx then TraceWrite (' MclFileCheckCreate_'); // prepare output if (dataP^.outFile.vFileName = '') then videoP := NIL else begin MclOut_PrepareVideo (dataP); videoP := MclOut_GetVideoP (dataP); end; if (dataP^.outFile.aFileName = '') then audioP := NIL else begin MclOut_PrepareAudio (dataP); audioP := MclOut_GetAudioP (dataP); end; // single or two files dataP^.outFile.singleFile := (dataP^.outFile.vFileName = dataP^.outFile.aFileName); // video try if (dataP^.outFile.vFileName <> '') then UniCreate (dataP^.outFile.videoUf, dataP^.outFile.vFileName); UniSetFormat (dataP^.outFile.videoUf, dataP^.outFile.saveInfo, videoP, audioP); dataP^.outFile.videoFileCreated := TRUE; except ErrExcept_; end; // audio try if (dataP^.outFile.aFileName <> '') and (not dataP^.outFile.singleFile) then begin UniCreate (dataP^.outFile.audioUf, dataP^.outFile.aFileName); UniSetFormat (dataP^.outFile.audioUf, dataP^.outFile.saveInfo, videoP, audioP); dataP^.outFile.audioFileCreated := TRUE; end; except ErrExcept_; end; // assigns pointers to real files used for video and audio output dataP^.vidBytesWrittenP := @dataP^.outFile.videoUf.imgBytesOut; if (dataP^.outFile.singleFile) then dataP^.audBytesWrittenP := @dataP^.outFile.videoUf.sndBytesOut else dataP^.audBytesWrittenP := @dataP^.outFile.audioUf.sndBytesOut; end; end; function MclWriteImage (mOut: QmclOut; mImg: QmclImg): Qresult; stdcall; var outP : QmclOutputP; imgP : QimgP; begin ErrReset_; try outP := pointer (mOut); imgP := pointer (mImg); if gLogEx then begin TraceWrite ('MclWriteImage'); TraceWrite (' mOut=' + PStr_ (outP)); TraceWrite (' mImg=' + ImgStr_ (imgP)); end; if MclFileAndImageOK_ (outP, imgP) then begin MclFileCheckCreate_ (outP); if (not outP^.outFile.vAutoRes) and (imgP^.bpp <> outP^.outFile.vBpp) then ImgConvBpp (imgP^, imgP^, outP^.outFile.vBpp); UniImgSave (outP^.outFile.videoUf, imgP^); end; result := ErrGet_; except result := ErrExcept_; end; end; function MclWriteSound (mOut: QmclOut; mSnd: QmclSnd): Qresult; stdcall; var outP : QmclOutputP; sndP : QsndP; sndTemp : Qsnd; begin ErrReset_; try outP := pointer (mOut); sndP := pointer (mSnd); if gLogEx then begin TraceWrite ('MclWriteSound'); TraceWrite (' mOut=' + PStr_ (outP)); TraceWrite (' mSnd=' + SndStr_ (sndP)); end; if MclFileAndSoundOK_ (outP, sndP) then begin MclFileCheckCreate_ (outP); if (not outP^.outFile.aAutoFormat) and (SndWaveFmtCompare (@sndP^.PCMFormat, @outP^.outFile.aFormat) <> 0) then begin SndAlloc (sndTemp, sndP^.samples * outP^.outFile.aFormat.nBlockAlign ); SndConvert (sndP^, sndTemp, outP^.outFile.aFormat); sndP := @sndTemp; end; if outP^.outFile.singleFile then UniSndSave (outP^.outFile.videoUf, sndP^) else UniSndSave (outP^.outFile.audioUf, sndP^); if (sndP <> pointer (mSnd)) then SndFree (sndP^); end; result := ErrGet_; except result := ErrExcept_; end; end; procedure MuxProgress_ (var progressInfo: QFFProgressInfo); cdecl; var progressData: QmclMuxProgressData; begin fillchar (progressData, sizeof(progressData), 0); progressData.fileName := progressInfo.fileName; progressData.percent := progressInfo.percentMux; progressData.userDataP := progressInfo.userData2P; QmclMuxProgressCBF(progressInfo.userData1P) (progressData); if (progressData.cancel) then progressInfo.stopAbort := K_CON_FINISH; end; procedure MclWriteCloseEx (mOut: QmclOut; progressCBF: QmclMuxProgressCBF; userDataP: pointer); stdcall; var outP : QmclOutputP; progressInfo: QFFProgressInfo; progressData: QmclMuxProgressData; begin ErrReset_; try outP := pointer (mOut); if gLogEx then begin TraceWrite ('MclWriteCloseEx'); TraceWrite (' mOut=' + PStr_ (outP)); end; if Assigned (outP) then begin // close video if outP^.outFile.videoFileCreated then try if (@progressCBF = NIL) then UniClose (outP^.outFile.videoUf) else begin fillchar (progressInfo, sizeof(progressInfo), 0); progressInfo.fileName := pchar(outP^.outFile.vFileName); progressInfo.userData1P := @progressCBF; progressInfo.userData2P := userDataP; UniCloseEx (outP^.outFile.videoUf, FALSE, MuxProgress_, @progressInfo); if (progressInfo.stopAbort = 0) then begin fillchar (progressData, sizeof(progressData), 0); progressData.fileName := progressInfo.fileName; progressData.percent := 100; progressData.userDataP := userDataP; progressData.finished := TRUE; progressCBF (progressData); end; end; outP^.outFile.videoFileCreated := FALSE; if gLogEx then TraceWrite (' video file closed'); except ErrExcept_; end else if gLogEx then TraceWrite (' video file was already closed'); // close audio if outP^.outFile.audioFileCreated then try UniClose (outP^.outFile.audioUf); outP^.outFile.audioFileCreated := FALSE; if gLogEx then TraceWrite (' audio file closed'); except ErrExcept_; end else if gLogEx then TraceWrite (' audio file was already closed'); end else ErrSet_ (MCLRES_MCL_HANDLE_NOT_CREATED); except ErrExcept_; end; end; procedure MclWriteClose (mOut: QmclOut); stdcall; begin MclWriteCloseEx (mOut, NIL, NIL); end; type QmclCodecsRec = packed record fileFmtId: Qint; isAudio: Qbool; numCodecs: Qint; vfwCodecs: QvfwCodecs; acmCodecs: QacmCodecs; acmFormats: QacmFormats; end; function MclCodecsVideoCreate (fileFmtId, resX, resY, bpp: Qint): QmclCodecs; stdcall; var numCodecs, n: Qint; hndP: ^QmclCodecsRec; vfwCodecsTempP: PQvfwCodecs; begin ErrReset_; result := 0; try if gLogEx then begin TraceWrite ('MclCodecsVideoCreate'); TraceWrite (' fileFmtId=' + IStr_ (fileFmtId)); TraceWrite (' resX=' + IStr_ (resX)); TraceWrite (' resY=' + IStr_ (resY)); TraceWrite (' bpp=' + IStr_ (bpp)); end; if (FFCanSave (fileFmtId)) then begin MemAllocNew (hndP, sizeof(QmclCodecsRec) ); result := Qint (hndP); fillchar (hndP^, sizeof(QmclCodecsRec), 0); hndP^.fileFmtId := fileFmtId; case fileFmtId of FILEFMT_TGA, FILEFMT_SGI, FILEFMT_RAS, FILEFMT_PNM, FILEFMT_HAV: hndP^.numCodecs := 2; FILEFMT_PCX, FILEFMT_JP2, FILEFMT_JPG, FILEFMT_PNG, FILEFMT_FLC, FILEFMT_GIF, FILEFMT_XPM{, FILEFMT_OGG}, FILEFMT_MP4: hndP^.numCodecs := 1; FILEFMT_TIF: hndP^.numCodecs := 8; FILEFMT_AVI: begin numCodecs := VfwCodecsRecFilter (vfwCodecsTempP, resX, resY, bpp); for n := 0 to numCodecs-1 do if (vfwCodecsTempP^[n].cIsResSupported) then begin MemAlloc (hndP^.vfwCodecs[hndP^.numCodecs], sizeof(hndP^.vfwCodecs[hndP^.numCodecs]^) ); hndP^.vfwCodecs[hndP^.numCodecs]^ := vfwCodecsTempP^[n]^; inc (hndP^.numCodecs); end; end; FILEFMT_MPG: if (gMpeg2Enabled) then hndP^.numCodecs := 5 else hndP^.numCodecs := 2; end; if gLogEx then TraceWrite (' numCodecs=' + IStr_ (hndP^.numCodecs)); end; except ErrExcept_; end; end; function MclCodecsAudioCreate (fileFmtId, sampleRate, channels, bitsPerChannel: Qint): QmclCodecs; stdcall; var numCodecs, n: Qint; waveFilter: TWaveFormatEx; hndP: ^QmclCodecsRec; acmCodecsTempP: PQacmCodecs; acmFormatsTempP: PQacmFormats; begin ErrReset_; result := 0; try if gLogEx then begin TraceWrite ('MclCodecsAudioCreate'); TraceWrite (' fileFmtId=' + IStr_ (fileFmtId)); TraceWrite (' sampleRate=' + IStr_ (sampleRate)); TraceWrite (' channels=' + IStr_ (channels)); TraceWrite (' bitsPerChannel=' + IStr_ (bitsPerChannel)); end; if (FFCanSave (fileFmtId)) then begin MemAllocNew (hndP, sizeof(QmclCodecsRec) ); result := Qint (hndP); fillchar (hndP^, sizeof(QmclCodecsRec), 0); hndP^.fileFmtId := fileFmtId; hndP^.isAudio := TRUE; case fileFmtId of FILEFMT_HAV, FILEFMT_WAV, FILEFMT_MPA, FILEFMT_AC3, FILEFMT_OGG: hndP^.numCodecs := 1; FILEFMT_AVI: begin SndWaveFmtPcmSet (waveFilter, sampleRate, channels, bitsPerChannel); numCodecs := AcmCodecsRecFilter (acmCodecsTempP, acmFormatsTempP, waveFilter); for n := 0 to numCodecs-1 do if (acmCodecsTempP^[n].cFormatsSupported > 0) then begin MemAlloc (hndP^.acmCodecs[hndP^.numCodecs], sizeof(hndP^.acmCodecs[hndP^.numCodecs]^) ); hndP^.acmCodecs[hndP^.numCodecs]^ := acmCodecsTempP^[n]^; MemAlloc (hndP^.acmFormats[hndP^.numCodecs], sizeof(hndP^.acmFormats[hndP^.numCodecs]^) ); hndP^.acmFormats[hndP^.numCodecs]^ := acmFormatsTempP^[acmCodecsTempP^[n].cFormatsPos]^; inc (hndP^.numCodecs); end; end; FILEFMT_MPG: if (gMpeg2Enabled) then hndP^.numCodecs := 2 else hndP^.numCodecs := 1; end; if gLogEx then TraceWrite (' numCodecs=' + IStr_ (hndP^.numCodecs)); end; except ErrExcept_; end; end; function MclCodecsGetCount (mCodecs: QmclCodecs): Qint; stdcall; var hndP: ^QmclCodecsRec; begin ErrReset_; result := 0; try if gLogEx then begin TraceWrite ('MclCodecsGetCount'); TraceWrite (' mCodecs=' + IStr_ (mCodecs)); end; hndP := Ptr (mCodecs); if Assigned (hndP) then result := hndP^.numCodecs; except ErrExcept_; end; end; procedure MclCodecsGetInfo (mCodecs: QmclCodecs; var info: QmclCodecsInfo; codecNum: Qint); stdcall; var hndP: ^QmclCodecsRec; begin ErrReset_; try if gLogEx then begin TraceWrite ('MclCodecsGetInfo'); TraceWrite (' mCodecs=' + IStr_ (mCodecs)); TraceWrite (' codecNum=' + IStr_ (codecNum)); end; hndP := Ptr (mCodecs); fillchar (info, sizeof(info), 0); if Assigned (hndP) then begin info.fileFmtId := hndP^.fileFmtId; info.codecId := codecNum; if (hndP^.isAudio) then with info do begin codecUsed := TRUE; codecName := 'PCM, uncompressed'; case fileFmtId of FILEFMT_AVI: begin codecUsed := hndP^.numCodecs > 0; if (codecNum < hndP^.numCodecs) then begin codecID := hndP^.acmFormats[codecNum]^.fWaveFmtP^.wFormatTag; move (hndP^.acmCodecs[codecNum]^.cName[1], codecName, length(hndP^.acmCodecs[codecNum]^.cName)); byteRateUsed := TRUE; byteRate := hndP^.acmFormats[codecNum]^.fWaveFmtP^.nAvgBytesPerSec; end; end; FILEFMT_MPG, FILEFMT_MPA: case codecNum of 0: begin codecName := 'MPEG audio layer-II'; codecId := MCL_MPG_LAYER2; bitRateUsed := TRUE; bitRate := KBITS_AUDIO_MP2_MPEG1; bitRateMin := KBITS_MPA_MIN; bitRateMax := KBITS_MPA_MAX; end; 1: begin codecName := 'AC3 compatible'; codecId := MCL_MPG_AC3; bitRateUsed := TRUE; bitRate := KBITS_AUDIO_AC3_STEREO; end; end; FILEFMT_OGG: begin codecName := 'Ogg Vorbis audio compression'; qualityUsed := TRUE; quality := 4; qualityMin := -1; qualityMax := 10; end; FILEFMT_AC3: begin codecName := 'AC3 compatible'; codecId := MCL_MPG_AC3; bitRateUsed := TRUE; bitRate := KBITS_AUDIO_AC3_STEREO; end; else codecUsed := FALSE; end; end else with info do begin codecUsed := TRUE; case codecNum of 0: codecName := 'Uncompressed, full frames'; 1: codecName := 'Run length encoded (RLE)'; end; case fileFmtId of FILEFMT_PCX: codecName := 'Run length encoded (RLE)'; FILEFMT_GIF: codecName := 'Variable-Length-Code LZW (Lempel-Ziv & Welch)'; FILEFMT_TIF: case codecNum of 0: codecID := TIFF_RAW; 1: begin codecID := TIFF_CCITTRLE; codecName := 'CCITT modified Huffman RLE'; end; 2: begin codecID := TIFF_CCITTFAX3; codecName := 'CCITT Group 3 fax encoding'; end; 3: begin codecID := TIFF_CCITTFAX4; codecName := 'CCITT Group 4 fax encoding'; end; 4: begin codecID := TIFF_JPEG; codecName := 'JPEG DCT compression'; end; 5: begin codecID := TIFF_PACKBITS; codecName := 'PackBits (Macintosh RLE)'; end; 6: begin codecID := TIFF_DEFLATE; codecName := 'Deflate compression (ZIP)'; end; 7: begin codecID := TIFF_LZW; codecName := 'Variable-Length-Code LZW'; end; end; FILEFMT_FLC: codecName := 'RLE + pixel difference from previous frame'; FILEFMT_AVI: if (codecNum < hndP^.numCodecs) then with hndP^.vfwCodecs[codecNum]^ do begin codecID := cFccHandler; move (cLongName[1], codecName, length(cLongName)); codecPrivDataP := cLpParms; codecPrivDataSize := cCbParms; qualityUsed := cHasQuality; quality := cQuality; qualityMin := 0; qualityMax := 100; byteRateUsed := TRUE; byteRate := 300; byteRateMin := 0; byteRateMax := MAXLONGINT div 8; keyFrameRateUsed := cHasKeyFrameRate; keyFrameRate := cKeyFrameRate; keyFrameRateMin := 0; keyFrameRateMax := MAXLONGINT; end; FILEFMT_HAV: begin case codecNum of 0: begin codecID := HAV_VIDEO_CODEC_FAST; codecName := 'HAV-FAST compression'; end; 1: begin codecID := HAV_VIDEO_CODEC_BEST; codecName := 'HAV-BEST compression'; end; end; keyFrameRateUsed := TRUE; keyFrameRate := 25; keyFrameRateMin := 0; keyFrameRateMax := MAXLONGINT; end; FILEFMT_JPG: begin codecName := 'JPEG DCT compression'; qualityUsed := TRUE; quality := 85; qualityMin := 0; qualityMax := 100; end; FILEFMT_JP2: begin codecName := 'JPEG-2000 compression'; qualityUsed := TRUE; quality := 1000; qualityMin := 0; qualityMax := 10000; end; FILEFMT_PNG: begin codecMin := 0; codecMax := 9; codecName := 'Deflate compression (modified LZ77)'; end; FILEFMT_MPG: begin qualityUsed := TRUE; quality := 0; qualityMin := 0; qualityMax := 1; bitRateUsed := TRUE; bitRateMin := 0; if (codecNum < 2) then bitRateMax := KBITS_VIDEO_MPEG1_ABSOLUTE_MAX else bitRateMax := KBITS_VIDEO_MPEG2_ABSOLUTE_MAX; case (codecNum) of 0: begin codecName := 'MPEG-1 format'; bitRate := KBITS_VIDEO_MPEG1_VBR; end; 1: begin codecName := 'MPEG-VCD format'; bitRate := KBITS_VIDEO_VCD_CBR; end; 2: if (gMpeg2Enabled) then begin codecName := 'MPEG-2 format'; bitRate := KBITS_VIDEO_MPEG2_VBR; end; 3: if (gMpeg2Enabled) then begin codecName := 'MPEG-SVCD format'; bitRate := KBITS_VIDEO_SVCD_VBR; end; 4: if (gMpeg2Enabled) then begin codecName := 'MPEG-DVD format'; bitRate := KBITS_VIDEO_DVD_VBR; end; end; end; FILEFMT_MP4: codecName := 'MPEG-4 video codec'; FILEFMT_WAV: codecName := 'PCM, uncompressed'; FILEFMT_PNM: case codecNum of 0: codecName := 'Binary encoded'; 1: codecName := 'ASCII encoded'; end; FILEFMT_MPA: begin codecName := 'MPEG audio compression'; bitRateUsed := TRUE; bitRate := KBITS_AUDIO_MP2_MPEG1; bitRateMin := KBITS_MPA_MIN; bitRateMax := KBITS_MPA_MAX; end; FILEFMT_OGG: begin codecName := 'Ogg Theora video compression'; qualityUsed := TRUE; quality := 4; qualityMin := -1; qualityMax := 10; end; else codecUsed := FALSE; end; end; if (info.bitRateUsed) then begin info.byteRateUsed := TRUE; info.byteRate := info.bitRate div 8; info.byteRateMin := info.bitRateMin div 8; info.byteRateMax := info.bitRateMax div 8; end else if (info.byteRateUsed) then begin info.bitRateUsed := TRUE; info.bitRate := info.byteRate * 8; info.bitRateMin := info.byteRateMin * 8; info.bitRateMax := info.byteRateMax * 8; end; end; except ErrExcept_; end; end; procedure MclCodecsFree (mCodecs: QmclCodecs); stdcall; var hndP: ^QmclCodecsRec; n: Qint; begin ErrReset_; try if gLogEx then begin TraceWrite ('MclCodecsFree'); TraceWrite (' mCodecs=' + IStr_ (mCodecs)); end; hndP := Ptr (mCodecs); if Assigned (hndP) then begin for n := 0 to hndP^.numCodecs-1 do begin if (hndP^.isAudio) then begin MemFree (hndP^.acmCodecs[n]); MemFree (hndP^.acmFormats[n]); end else MemFree (hndP^.vfwCodecs[n]) end; MemFree (hndP); end; except ErrExcept_; end; end; function MclImgCreate: QmclImg; stdcall; var imgP : QimgP; begin ErrReset_; try if gLogEx then TraceWrite ('MclImgCreate'); MemAllocNew (imgP, SizeOf (imgP^) ); ImgInitHandle (imgP^); result := integer (imgP); if gLogEx then TraceWrite (' result=' + PStr_ (imgP)); except result := K_ZERO; ErrExcept_; end; end; procedure MclImgFree (mImg: QmclImg); stdcall; var imgP : QimgP; begin ErrReset_; try imgP := pointer (mImg); if gLogEx then begin TraceWrite ('MclImgFree'); TraceWrite (' mImg=' + ImgStr_ (imgP)); end; if Assigned (imgP) then begin ImgFree (imgP^); MemFree (imgP); end; except ErrExcept_; end; end; procedure MclImgCopy (mImgDest, mImgSrc: QmclImg); stdcall; var srcP, destP : QimgP; begin ErrReset_; try srcP := pointer (mImgSrc); if gLogEx then begin TraceWrite ('MclImgCopy'); TraceWrite (' mImgSrc=' + ImgStr_ (srcP)); end; if ImgValid (srcP^) then begin destP := pointer (mImgDest); ImgCopy (srcP^, destP^); if gLogEx then TraceWrite (' mImgDest=' + ImgStr_ (destP)); end; except ErrExcept_; end; end; procedure MclImgRedim (mImg: QmclImg; resX, resY, bpp: Qint); stdcall; // reallocates image, resulting contents is undefined var imgP : QimgP; begin ErrReset_; try imgP := pointer (mImg); if gLogEx then begin TraceWrite ('MclImgRedim'); TraceWrite (' mImg=' + ImgStr_ (imgP)); end; if Assigned (imgP) then begin if (resX = K_AUTO) then resX := imgP^.resX; if (resY = K_AUTO) then resY := imgP^.resY; if (bpp = K_AUTO) then bpp := imgP^.bpp; if gLogEx then begin TraceWrite (' resX=' + IStr_ (resX)); TraceWrite (' resY=' + IStr_ (resY)); TraceWrite (' bpp=' + IStr_ (bpp)); end; ImgAlloc (imgP^, resX, resY, bpp ); end; except ErrExcept_; end; end; procedure MclImgClear (mImg: QmclImg; color: Qint); stdcall; // clears the content of the image with a given color var imgP : QimgP; begin ErrReset_; try imgP := pointer (mImg); if gLogEx then begin TraceWrite ('MclImgClear'); TraceWrite (' mImg=' + ImgStr_ (imgP)); TraceWrite (' color=' + RGBStr_ (color)); end; if Assigned (imgP) then PicFillColor (imgP^, 0, imgP^.resX * imgP^.resY, color); except ErrExcept_; end; end; procedure MclImgGetInfo (mImg: QmclImg; var resX, resY, bpp, dpiX, dpiY, totalBytes: Qint; var pixPtr, palPtr: pointer); stdcall; var imgP : QimgP; begin ErrReset_; try imgP := pointer (mImg); if gLogEx then begin TraceWrite ('MclImgGetInfo'); TraceWrite (' mImg=' + ImgStr_ (imgP)); end; resX := imgP^.resX; resY := imgP^.resY; bpp := imgP^.bpp; dpiX := imgP^.dpiX; dpiY := imgP^.dpiY; totalBytes := imgP^.resX * imgP^.resY * imgP^.resB; pixPtr := imgP^.imgData; palPtr := @imgP^.pal256; if gLogEx then begin TraceWrite (' resX=' + IStr_ (resX)); TraceWrite (' resY=' + IStr_ (resY)); TraceWrite (' bpp=' + IStr_ (bpp)); TraceWrite (' dpiX=' + IStr_ (dpiX)); TraceWrite (' dpiY=' + IStr_ (dpiY)); TraceWrite (' totalBytes=' + IStr_ (totalBytes)); TraceWrite (' pixPtr=' + PStr_ (pixPtr)); TraceWrite (' palPtr=' + PStr_ (palPtr)); end; except ErrExcept_; end; end; procedure MclImgSetPixels (mImg: QmclImg; resX, resY, bpp: Qint; pixPtr, palPtr: pointer); stdcall; begin ErrReset_; try if gLogEx then TraceWrite ('MclImgSetPixels'); MclImgSetPixelsRect (mImg, resX, resY, bpp, 0, 0, resX, abs(resY), pixPtr, palPtr); except ErrExcept_; end; end; procedure MclImgGetPixels (mImg: QmclImg; pixPtr, palPtr: pointer); stdcall; var imgP : QimgP; begin ErrReset_; try imgP := pointer (mImg); if gLogEx then TraceWrite ('MclImgGetPixels'); MclImgGetPixelsRect (mImg, 0, 0, imgP^.resX, imgP^.resY, pixPtr, PalPtr); except ErrExcept_; end; end; procedure MclImgSetPixelsRect (mImg: QmclImg; resX, resY, bpp, posX, posY, copyX, copyY: Qint; pixPtr, palPtr: pointer); stdcall; var imgP : QimgP; begin ErrReset_; try imgP := pointer (mImg); if gLogEx then begin TraceWrite ('MclImgSetPixels'); TraceWrite (' mImg=' + ImgStr_ (imgP)); TraceWrite (' resX=' + IStr_ (resX)); TraceWrite (' resY=' + IStr_ (resY)); TraceWrite (' bpp=' + IStr_ (bpp)); TraceWrite (' posX=' + IStr_ (posX)); TraceWrite (' posY=' + IStr_ (posY)); TraceWrite (' copyX=' + IStr_ (copyX)); TraceWrite (' copyY=' + IStr_ (copyY)); TraceWrite (' pixPtr=' + PStr_ (pixPtr)); TraceWrite (' palPtr=' + PStr_ (palPtr)); end; if Assigned (pixPtr) then RawToQimg (imgP^, pixPtr, palPtr, resX, resY, bpp, posX, posY, copyX, copyY) else begin // blank image ImgAlloc (imgP^, copyX, copyY, bpp ); FillChar (imgP^.imgData^, imgP^.sizeBytes, 0); if (bpp = BITS_8) then if Assigned (palPtr) then Move (palPtr^, imgP^.pal256, SizeOf (imgP^.pal256)) else FillChar (imgP^.pal256, SizeOf (imgP^.pal256), 0); end; except ErrExcept_; end; end; procedure MclImgGetPixelsRect (mImg: QmclImg; posX, posY, copyX, copyY: Qint; pixPtr, palPtr: pointer); stdcall; var imgP : QimgP; y, lineSize, lineSizeCopy, imgOfs1, imgOfs2: Qint; pixPtr2: ^QMaxBuf; begin ErrReset_; try imgP := pointer (mImg); if gLogEx then begin TraceWrite ('MclImgGetPixelsRect'); TraceWrite (' mImg=' + ImgStr_ (imgP)); TraceWrite (' posX=' + IStr_ (posX)); TraceWrite (' posY=' + IStr_ (posY)); TraceWrite (' copyX=' + IStr_ (copyX)); TraceWrite (' copyY=' + IStr_ (copyY)); TraceWrite (' pixPtr=' + PStr_ (pixPtr)); TraceWrite (' palPtr=' + PStr_ (palPtr)); end; if Assigned (pixPtr) then begin pixPtr2 := pixPtr; lineSize := imgP^.resX * imgP^.resB; lineSizeCopy := copyX * imgP^.resB; imgOfs1 := posX * imgP^.resB; imgOfs2 := 0; for y := 1 to copyY do begin Move (imgP^.imgData^[imgOfs1], pixPtr2^[imgOfs2], lineSizeCopy); inc (imgOfs1, lineSize); inc (imgOfs2, lineSizeCopy); end; end; if Assigned (palPtr) then Move (imgP^.pal256, palPtr^, SizeOf (imgP^.pal256)); except ErrExcept_; end; end; procedure MclImgSetPixelRGB (mImg: QmclImg; x, y: Qint; r, g, b: Qint); stdcall; var imgP : QimgP; pixAdr, palIndex : Qint; rgb: Qint; begin ErrReset_; try imgP := pointer (mImg); if gLogEx then begin TraceWrite ('MclImgSetPixelRGB'); TraceWrite (' mImg=' + ImgStr_ (imgP)); TraceWrite (' x=' + IStr_ (x)); TraceWrite (' y=' + IStr_ (y)); TraceWrite (' r=' + IStr_ (r)); TraceWrite (' g=' + IStr_ (g)); TraceWrite (' b=' + IStr_ (b)); end; if (x >= 0) and (x < imgP^.resX) and (y >= 0) and (y < imgP^.resY) then begin pixAdr := (imgP^.resX * y + x) * imgP^.resB; case imgP^.bpp of BITS_8: begin palIndex := FindNearestColor (r, g, b, imgP^.pal256, 256); imgP^.imgData^[pixAdr] := palIndex; end; BITS_15: begin rgb := MclRGB (r, g, b); Conv32or24to15 (rgb, imgP^.imgData^[pixAdr], 1, 3); end; BITS_16: begin rgb := MclRGB (r, g, b); Conv32or24to16 (rgb, imgP^.imgData^[pixAdr], 1, 3); end; BITS_24, BITS_32: begin imgP^.imgData^[pixAdr + K_R] := r; imgP^.imgData^[pixAdr + K_G] := g; imgP^.imgData^[pixAdr + K_B] := b; end; end; end; except ErrExcept_; end; end; procedure MclImgGetPixelRGB (mImg: QmclImg; x, y: Qint; var r, g, b: Qint); stdcall; var imgP : QimgP; pixAdr, palIndex : Qint; rgbaRec : array [0..3] of byte; begin ErrReset_; try imgP := pointer (mImg); if gLogEx then begin TraceWrite ('MclImgGetPixelRGB'); TraceWrite (' mImg=' + ImgStr_ (imgP)); TraceWrite (' x=' + IStr_ (x)); TraceWrite (' y=' + IStr_ (y)); end; if (x >= 0) and (x < imgP^.resX) and (y >= 0) and (y < imgP^.resY) then begin pixAdr := (imgP^.resX * y + x) * imgP^.resB; case imgP^.bpp of BITS_8: begin palIndex := imgP^.imgData^[pixAdr]; r := imgP^.pal256 [palIndex].r; g := imgP^.pal256 [palIndex].g; b := imgP^.pal256 [palIndex].b; end; BITS_15: begin Conv15to24 (imgP^.imgData^[pixAdr], rgbaRec, 1); r := rgbaRec [K_R]; g := rgbaRec [K_G]; b := rgbaRec [K_B]; end; BITS_16: begin Conv16to24 (imgP^.imgData^[pixAdr], rgbaRec, 1); r := rgbaRec [K_R]; g := rgbaRec [K_G]; b := rgbaRec [K_B]; end; BITS_24: begin r := imgP^.imgData^[pixAdr + K_R]; g := imgP^.imgData^[pixAdr + K_G]; b := imgP^.imgData^[pixAdr + K_B]; end; BITS_32: begin Conv32to24 (imgP^.imgData^[pixAdr], rgbaRec, 1); r := rgbaRec [K_R]; g := rgbaRec [K_G]; b := rgbaRec [K_B]; end; end; end else begin // indicate bad parameters r := -1; g := -1; b := -1; end; if gLogEx then begin TraceWrite (' r=' + IStr_ (r)); TraceWrite (' g=' + IStr_ (g)); TraceWrite (' b=' + IStr_ (b)); end; except ErrExcept_; end; end; function MclImgToDIB (mImg: QmclImg): HBITMAP; stdcall; var imgP : QimgP; begin ErrReset_; try imgP := pointer (mImg); if gLogEx then begin TraceWrite ('MclImgToDIB'); TraceWrite (' mImg=' + ImgStr_ (imgP)); end; QimgToHBitmap (imgP^, result); if gLogEx then TraceWrite (' result=' + IStr_ (result)); except result := 0; ErrExcept_; end; end; function MclReleaseDIB (DIBhandle: HBITMAP): Qbool; stdcall; begin ErrReset_; try if gLogEx then begin TraceWrite ('MclReleaseDIB'); TraceWrite (' DIBhandle=' + IStr_ (DIBhandle)); end; result := DeleteObject (DIBhandle); if gLogEx then TraceWrite (' result=' + BStr_ (result)); except result := FALSE; ErrExcept_; end; end; function MclImgToDIBWin3 (mImg: QmclImg): HBITMAP; stdcall; var imgP : QimgP; begin ErrReset_; try imgP := pointer (mImg); if gLogEx then begin TraceWrite ('MclImgToDIBWin3'); TraceWrite (' mImg=' + ImgStr_ (imgP)); end; QimgToHBitmapWin3 (imgP^, result); if gLogEx then TraceWrite (' result=' + IStr_ (result)); except result := 0; ErrExcept_; end; end; function MclReleaseDIBWin3 (DIBhandle: HBITMAP): Qbool; stdcall; begin ErrReset_; try if gLogEx then begin TraceWrite ('MclReleaseDIBWin3'); TraceWrite (' DIBhandle=' + IStr_ (DIBhandle)); end; result := (GlobalFree (DIBhandle) = 0); if gLogEx then TraceWrite (' result=' + BStr_ (result)); except result := FALSE; ErrExcept_; end; end; procedure MclDIBToImg (mImg: QmclImg; DIBhandle: HBITMAP); stdcall; var imgP : QimgP; begin ErrReset_; try if gLogEx then begin TraceWrite ('MclDIBToImg'); TraceWrite (' DIBhandle=' + IStr_ (DIBhandle)); end; imgP := pointer (mImg); HBitmapToQimg (DIBhandle, imgP^); if gLogEx then TraceWrite (' mImg=' + ImgStr_ (imgP)); except ErrExcept_; end; end; function MclBayerLoad (mImg: QmclImg; fileName: QcharP; resX, resY: Qint; colorType, pixelOrder: Qint): Qresult; stdcall; var imgP : QimgP; begin ErrReset_; try imgP := pointer (mImg); if gLogEx then begin TraceWrite ('MclBayerLoad'); TraceWrite (' fileName=' + fileName); TraceWrite (' resX=' + IStr_ (resX)); TraceWrite (' resY=' + IStr_ (resY)); TraceWrite (' colorType=' + IStr_ (colorType)); TraceWrite (' pixelOrder=' + IStr_ (pixelOrder)); end; BayLoadCustom (fileName, imgP^, resX, resY, colorType, pixelOrder); if gLogEx then TraceWrite (' mImg=' + ImgStr_ (imgP)); result := MCLRES_OK; except result := ErrExcept_; end; end; procedure MclBayerToImg (mImg: QmclImg; pixPtr: pointer; resX, resY: Qint; colorType, pixelOrder: Qint); stdcall; var imgP : QimgP; bpp : Qint; begin ErrReset_; try if gLogEx then begin TraceWrite ('MclBayerToImg'); TraceWrite (' pixPtr=' + PStr_ (pixPtr)); TraceWrite (' resX=' + IStr_ (resX)); TraceWrite (' resY=' + IStr_ (resY)); TraceWrite (' colorType=' + IStr_ (colorType)); TraceWrite (' pixelOrder=' + IStr_ (pixelOrder)); end; imgP := poi