mmcstdlg.pas

一套及时通讯的原码

      FDIBOldProc := SetWindowLong(FDIBWnd,GWL_WNDPROC,
                     Longint(MakeObjectInstance(DIBWndHookProc)));
   end;

   if (FData = nil) then
   begin
      { alloc the data buffer for the scope data }
      {$IFDEF WIN32}
      Windows.GetClientRect(FScopeWnd, aRect);
      {$ELSE}
      WinProcs.GetClientRect(FScopeWnd, aRect);
      {$ENDIF}
      FData := GlobalAllocPtr(GPTR, (aRect.Right-aRect.Left)*sizeOf(TDisplayRec));

      { now create some components }
      FWaveFile := TMMWaveFile.Create(Self);
      FWaveFile.Wave.TimeFormat := tfByte;
      FWaveFile.Wave.IOBufferSize := 4*32768;

      FADPCMConvert := TMMADPCMConverter.Create(Self);
      FADPCMConvert.Input := FWaveFile;

      FWaveOut := TMMWaveOut.Create(Self);
      FWaveOut.Input := FADPCMConvert;
      FWaveOut.OnStart := WaveOutStart;
      FWaveOut.OnStop := WaveOutStop;
      FWaveOut.BufferSize := 32768;
      FWaveOut.NumBuffers := 10;
      FWaveOut.TimeFormat := tfByte;
      if FWaveOut.NumDevs > 0 then
         FWaveOut.DeviceID := FDeviceId
      else EnableWindow(GetDlgItem(Wnd,CB_AutoPlay), False);
      FTimer := TTimer.Create(Self);
      FTimer.Enabled := False;
      FTimer.Interval := 50;
      FTimer.OnTimer := TimerExpired;
   end;

   EnableWindow(GetDlgItem(Wnd,BT_Play), False);
   EnableWindow(GetDlgItem(Wnd,CB_PREVIEW), False);
   SetDlgItemText(Wnd,CB_PREVIEW,StrPCopy(aBuf,LoadResStr(IDS_PREVIEW)));
   SendDlgItemMessage(Wnd,CB_PREVIEW, BM_SETCHECK, Ord(FPReview), 0);
   SendDlgItemMessage(Wnd,CB_AUTOPLAY, BM_SETCHECK, Ord(FAutoPlay), 0);

   {$IFDEF WIN32}
   if not NewStyleControls then
   {$ENDIF}
   begin
      { TODO: hier Texte im Dialog lokalisieren !!!
       oder gleich englische Resource verwenden }
   end;

   inherited DoCreate;
end;

{-- TMMWaveOpenDialog ---------------------------------------------------------}
procedure TMMWaveOpenDialog.DoDestroy;
begin
   if (FData <> nil) then
   begin
      { free the data buffer }
      GlobalFreePtr(FData);
      FData := nil;
   end;

   if (FWaveOut <> nil) then
   begin
      FWaveOut.Close;
      FWaveOut.Free;
      FWaveOut := nil;
   end;

   if (FADPCMConvert <> nil) then
   begin
      FADPCMConvert.Close;
      FADPCMConvert.Free;
      FADPCMConvert := nil;
   end;

   if (FWaveFile <> nil) then
   begin
      FWaveFile.Wave.FreeWave;
      FWaveFile.Free;
      FWaveFile := nil;
   end;

   if (FTimer <> nil) then
   begin
      FTimer.Free;
      FTimer := nil;
   end;

   if (FScopeWnd <> 0) then
   begin
      FreeObjectInstance(Pointer(SetWindowLong(FScopeWnd,GWL_WNDPROC,FScopeOldProc)));
      FScopeWnd := 0;
   end;

   if (FDIBWnd <> 0) then
   begin
      FreeObjectInstance(Pointer(SetWindowLong(FDIBWnd,GWL_WNDPROC,FDIBOldProc)));
      FDIBWnd := 0;
   end;

   inherited DoDestroy;
end;

{-- TMMWaveOpenDialog ---------------------------------------------------------}
procedure TMMWaveOpenDialog.DoFileOK(FName: String; var IsOk: Boolean);
begin
   if not (Self is TMMWaveSaveDialog) then
   begin
      IsOK := wioIsWaveFile(FName, RIFF_FILE);
      if not IsOK then
         MessageDlg(LoadResStr(IDS_WAVEINVALID), mtError, [mbOK], 0)
      else
         inherited DoFileOK(FName, IsOK);
   end
   else inherited DoFileOK(FName, IsOK);
end;

{-- TMMWaveOpenDialog ---------------------------------------------------------}
procedure TMMWaveOpenDialog.DoSelChanged(FName: String);
var
   LastName: String;

begin
   if assigned(FWaveFile) then
   begin
      LastName := FindLastFileName(FName);
      if (LastName <> FWaveFile.Wave.FileName) then
      begin
         FWaveOut.Close;
         if wioIsWaveFile(LastName, RIFF_FILE) then
         begin
            FWaveFile.Wave.FileName := LastName;
            FADPCMConvert.Enabled := FADPCMConvert.CanConvert;
         end
         else
            FWaveFile.Wave.FreeWave;

         FUpdating := True;
         { make sure the item is first selected, then update }
         KillTimer(FScopeWnd,99);
         SetTimer(FScopeWnd,99,50,nil);
      end;
   end;

   inherited DoSelChanged(FName);
end;

{-- TMMWaveOpenDialog ---------------------------------------------------------}
procedure TMMWaveOpenDialog.DoCommand(Wnd,Parent: Hwnd; cmd: Integer);
begin
   if (Wnd = FHWnd) then
   begin
      if (cmd = BT_Play) and (FWaveOut.NumDevs > 0) then
      begin
         if not (wosPlay in FWaveOut.State) then
         begin
            if not FWaveFile.Wave.Empty and
               FWaveOut.QueryDevice(FWaveOut.DeviceID,FWaveOut.PWaveFormat) then
            try
               FWaveOut.Start;
            except
               { don't raise a exception here }
            end;
         end
         else FWaveOut.Close;
      end
      else if (cmd = CB_PREVIEW) then
      begin
         FPreview := SendDlgItemMessage(Wnd, CB_PREVIEW, BM_GetCheck, 0, 0)<> 0;
         if FPreview then FWaveOut.Close;
         UpdateWave;
      end
      else if (cmd = CB_AUTOPLAY) then
      begin
         FAutoPlay := SendDlgItemMessage(Wnd, CB_AUTOPLAY, BM_GetCheck, 0, 0)<> 0;
         if FAutoPlay then
         begin
            if not (wosPlay in FWaveOut.State) and
               not FWaveFile.Wave.Empty and
               FWaveOut.QueryDevice(FWaveOut.DeviceID,FWaveOut.PWaveFormat) then
            try
               FWaveOut.Start;
            except
               { don't raise a exception here }
            end;
         end
         else FWaveOut.Close;
      end;
   end;

   inherited DoCommand(Wnd,Parent,cmd);
end;

{-- TMMWaveOpenDialog ---------------------------------------------------------}
procedure TMMWaveOpenDialog.WaveOutStart(Sender: TObject);
begin
   FOldPos := -1;
   FTimer.Enabled := True;
   SetDlgItemText(Wnd,BT_PLAY,'Stop');
end;

{-- TMMWaveOpenDialog ---------------------------------------------------------}
procedure TMMWaveOpenDialog.WaveOutStop(Sender: TObject);
begin
   FTimer.Enabled := False;
   DrawLocator(FOldPos,-1);
   SetDlgItemText(Wnd,BT_PLAY,'Play');
end;

{-- TMMWaveOpenDialog ---------------------------------------------------------}
procedure TMMWaveOpenDialog.DrawLocator(var OldPos: Longint; NewPos: Longint);
Var
   OldPen: HPen;
   OldMode: integer;
   DC: HDC;
   aRect: TRect;
   X: integer;

begin
   if not FPreview or (FWaveFile.Wave.FormatTag <> 1) then exit;

   {$IFDEF WIN32}
   Windows.GetClientRect(FScopeWnd, aRect);
   {$ELSE}
   WinProcs.GetClientRect(FScopeWnd, aRect);
   {$ENDIF}
   InflateRect(aRect, -2, -2);
   DC := GetDC(FScopeWnd);
   try
      OldPen := SelectObject(DC,CreatePen(PS_SOLID,1,ColorToRGB(FLocatorColor)));
      try
          OldMode := SetROP2(DC, R2_XORPEN);
          try
              if (OldPos <> -1) then
              begin
                 { clear old locator }
                 X := MulDiv32(aRect.Right-aRect.Left,OldPos,FWaveFile.Wave.DataSize);
                 MoveToEx(DC,aRect.Left+X,aRect.Top, nil);
                 LineTo(DC,aRect.Left+X,aRect.Bottom-1);
              end;

              { draw new locator }
              if (NewPos <> -1) then
              begin
                 X := MulDiv32(aRect.Right-aRect.Left,NewPos,FWaveFile.Wave.DataSize);
                 MoveToEx(DC,aRect.Left+X,aRect.Top, nil);
                 LineTo(DC,aRect.Left+X,aRect.Bottom-1);
              end;
              OldPos := NewPos;

          finally
            SetROP2(DC, OldMode);
          end;

      finally
          DeleteObject(SelectObject(DC,OldPen));
      end;

   finally
      ReleaseDC(FScopeWnd,DC);
   end;
end;

{-- TMMWaveOpenDialog ---------------------------------------------------------}
procedure TMMWaveOpenDialog.TimerExpired(Sender: TObject);
begin
   if (wosPlay in FWaveOut.State) then
      DrawLocator(FOldPos,FWaveOut.Position);
end;

{-- TMMWaveOpenDialog ---------------------------------------------------------}
procedure TMMWaveOpenDialog.DrawDISP(DC: HDC; aRect: TRect);
var
   ParentDC: HDC;
   aBitmap: TBitmap;
   R: TRect;
   lpDisp: PDISP;
   hBM: HBITMAP;
   Clr: Longint;

begin
   with FWaveFile.Wave, aRect do
   begin
      aBitmap := TBitmap.Create;
      with aBitmap, aBitmap.Canvas do
      try
         aBitmap.Width := aRect.Right-aRect.Left;
         aBitmap.Height := aRect.Bottom-aRect.Top;
         R := Rect(0,0,aBitmap.Width,aBitmap.Height);
         { find the right background color }
         ParentDC := GetDC(Wnd);
         clr := GetPixel(ParentDC,0,0);
         ReleaseDC(Wnd, ParentDC);
         { clear background }

         Brush.Color := clr;{ clBtnFace; }
         FillRect(R);

         if (FileName <> '') then
         begin
            lpDisp := PWaveIOInfo^.lpDisp^.pHead;
            while (lpDisp <> nil) do
            begin
               if (lpDisp^.cfid = CF_DIB) then break;
               lpDisp := lpDisp^.pNext;
            end;

            if (lpDisp <> nil) then
            begin
               InflateRect(R, -2, -2);
               { Frame3D(Canvas,R,clBtnShadow,clBtnHighLight,1);
                 Frame3D(Canvas,R,clWindowFrame,cl3DLight,1); }
               DIB_Display(PDIB(lpDisp^.lpChunk),Canvas.Handle, R);
            end
            else
            begin
               InflateRect(R, -2, -2);
               hBM := LoadBitmap(HInstance, 'BMP_WAVE');
               DrawTransparentBitmap(Canvas.Handle, hBM,
                                     R.Left,R.Top,
                                     GetTransparentColor(hBM));
               DeleteObject(hBM);
            end;
         end;
         BitBlt(DC,aRect.Left,aRect.Top,aRect.Right-aRect.Left,
                aRect.Bottom-aRect.Top,
                aBitmap.Canvas.Handle, 0,0,SRCCOPY);
      finally
         aBitmap.Free;
      end;
   end;
end;

{-- TMMWaveOpenDialog ---------------------------------------------------------}
procedure TMMWaveOpenDialog.CreatePCMData(DC: HDC; aRect: TRect);
var
   i,aWidth,aHeight,Y1: integer;
   aResult,Bytes: Longint;
   ReadBuffer: PChar;
   Data: PDisplayData;
   Canvas: TCanvas;

begin
   InflateRect(aRect, -2, -2);
   aWidth := aRect.Right-aRect.Left;
   aHeight := aRect.Bottom-aRect.Top;
   FillChar(FData^, aWidth*sizeOf(TDisplayRec),0);
   if not FWaveFile.Wave.Empty and FPreview then
   with FWaveFile.Wave do
   begin
      Canvas := TCanvas.Create;
      with Canvas, aRect do
      try
         Handle := DC;
         Brush.Color := FColor;
         FillRect(aRect);

         Bytes := Max(DataSize div aWidth and not 3,4);
         ReadBuffer := GlobalAllocPtr(GHND, Bytes);
         try
            OpenFile;
            Position := 0;
            Data:= FData;
            Screen.Cursor := crHourGlass;
            Pen.Color := FForeColor;
            MoveTo(Left,Top+(aHeight div 2));
            i := 0;
            while (i < aWidth) do
            begin
               aResult := ReadDataBytes(ReadBuffer, Bytes);
               if aResult <= 0 then break;

               pcmFindMinMax(PWaveFormat,ReadBuffer, aResult,
                             Data^[i].LeftMin,
                             Data^[i].LeftMax,
                             Data^[i].RightMin,
                             Data^[i].RightMax);

               if (BitLength = 8) then
               begin
                  Data^[i].LeftMin := (Word(Data^[i].LeftMin) shl 8) xor $8000;
                  Data^[i].LeftMax := (Word(Data^[i].LeftMax) shl 8) xor $8000;
                  Data^[i].RightMin:= (Word(Data^[i].RightMin) shl 8) xor $8000;
                  Data^[i].RightMax:= (Word(Data^[i].RightMax) shl 8) xor $8000;
               end;

               Brush.Color := FColor;
               FillRect(Rect(Left+i,Top,Left+i+1,Bottom));
               Y1 := MulDiv32(Min(Data^[i].LeftMin,Data^[i].RightMin)+ Long($7FFF),aHeight,$FFFF);
               LineTo(Left+i, Bottom-Y1-1);
               Y1 := MulDiv32(Max(Data^[i].LeftMax,Data^[i].RightMax)+ Long($7FFF),aHeight,$FFFF);
               LineTo(Left+i, Bottom-Y1-1);
               Brush.Color := FLocatorColor;
               if (i < aWidth-1) and (DataSize > 1024*2048) then
                  FillRect(Rect(Left+i+1,Top,Left+i+2,Bottom));
               {$IFDEF WIN32}
               GDIFlush;
               {$ENDIF}
               inc(i);
            end;

            if (i < aWidth-1) then
            begin
               if (i > 0) then dec(i);
               MoveTo(Left+i, Top+(aHeight div 2));
               LineTo(Right, Top+(aHeight div 2));
            end;

         finally
            CloseFile;
            GlobalFreePtr(ReadBuffer);
            Screen.Cursor := crDefault;
         end;

      finally
         Canvas.Handle := 0;
         Canvas.Free;
      end;
   end;
end;

{-- TMMWaveOpenDialog ---------------------------------------------------------}
procedure TMMWaveOpenDialog.DrawPCMData(DC: HDC; aRect: TRect);
var
   i,Y1,aHeight: integer;
   R: TRect;
   Data: PDisplayData;
   aBitmap: TBitmap;

begin
   with FWaveFile.Wave do
   begin
      aBitmap := TBitmap.Create;
      with aBitmap.Canvas, R do
      try
         aBitmap.Width := aRect.Right-aRect.Left;
         aBitmap.Height := aRect.Bottom-aRect.Top;
         R := Rect(0,0,aBitmap.Width,aBitmap.Height);
         { clear background }
         Brush.Color := FColor;
         FillRect(R);
         Frame3D(aBitmap.Canvas,R,clBtnShadow,clBtnHighLight,1);
         Frame3D(aBitmap.Canvas,R,clWindowFrame,cl3DLight,1);
         FOldPos := -1;
         if (FileName = '') or not FPreview or
            (FormatTag <> 1) or (DataSize <= 0) then
         begin
            { only draw a horizontal line }
            Pen.Color := clGray;
            MoveTo(Left+5, Top+(Bottom-Top) div 2);
            LineTo((Right-Left)-5,Top+(Bottom-Top) div 2);
         end
         else if not FUpdating then
         begin
            Data := FData;
            Pen.Color := FForeColor;

            aHeight := Bottom-Top;

            Y1 := MulDiv32(Min(Data^[0].LeftMin,Data^[0].RightMin) + Long($7FFF),aHeight,$FFFF);
            MoveTo(Left, Top+aHeight-Y1-1);
            Y1 := MulDiv32(Max(Data^[0].LeftMax,Data^[0].RightMax) + Long($7FFF),aHeight,$FFFF);
            LineTo(Left, Top+aHeight-Y1-1);
            i := 0;
            while i < Right-Left do
            begin
               Y1 := MulDiv32(Min(Data^[i].LeftMin,Data^[i].RightMin) + Long($7FFF),aHeight,$FFFF);
               LineTo(Left+i, Bottom-Y1-1);
               Y1 := MulDiv32(Max(Data^[i].LeftMax,Data^[i].RightMax) + Long($7FFF),aHeight,$FFFF);
               LineTo(Left+i, Bottom-Y1-1);