mmcstdlg.pas

一套及时通讯的原码

               inc(i);
            end;
            LineTo(Left+i, Bottom-Y1-1);
         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.UpdatePlayParams;
begin
   if not FWaveFile.Wave.Empty and (FWaveOut.PWaveFormat <> nil) then
   begin
      { adjust the buffersize for best results }
      case Word(FWaveOut.PWaveFormat^.nSamplesPerSec) of
           00000..15000: FWaveOut.BufferSize := 512;
           15001..24000: FWaveOut.BufferSize := 1024;
           24001..32000: FWaveOut.BufferSize := 2048;
           32001..48000: FWaveOut.BufferSize := 3072;
      end;

      case FWaveOut.PWaveFormat^.wBitsPerSample of
              1: FWaveOut.BufferSize := FWaveOut.BufferSize div 16;
           2..4: FWaveOut.BufferSize := FWaveOut.BufferSize div 8;
           5..7: FWaveOut.BufferSize := FWaveOut.BufferSize div 4;
          9..16: FWaveOut.BufferSize := FWaveOut.BufferSize * 2;
      end;
   end;
end;

{-- TMMWaveOpenDialog ---------------------------------------------------------}
procedure TMMWaveOpenDialog.UpdateWave;
Label CheckDevice;
var
   aBuf: array[0..256] of Char;
   Format,FormatName,Size: String;
   aRect: TRect;
   DC: HDC;

begin
   {$IFDEF WIN32}
   Windows.GetClientRect(FDIBWnd, aRect);
   {$ELSE}
   WinProcs.GetClientRect(FDIBWnd, aRect);
   {$ENDIF}
   DC := GetDC(FDIBWnd);
   try
      DrawDISP(DC, aRect);
   finally
      ReleaseDC(FDIBWnd,DC);
   end;

   EnableWindow(GetDlgItem(Wnd,CB_PREVIEW), False);

   with FWaveFile.Wave do
   if (FileName = '') then
   begin
      Format := LoadResStr(IDS_WAVEUNKNOWN);
      SetDlgItemText(Wnd,LT_FORMAT,StrPCopy(aBuf, Format));
      EnableWindow(GetDlgItem(Wnd,BT_Play), False);
      {$IFDEF WIN32}
      Windows.GetClientRect(FScopeWnd, aRect);
      {$ELSE}
      WinProcs.GetClientRect(FScopeWnd, aRect);
      {$ENDIF}
      InvalidateRect(FScopeWnd, @aRect, False);
   end
   else
   begin
      acmGetFormatDescription(PWaveFormat,FormatName,Format);

      Size := '; ' + IntToStr(FileSize div 1024) + ' KB';
      SetDlgItemText(Wnd,LT_FORMAT,StrPCopy(aBuf, FormatName+'; '+Format+Size));

      {$IFDEF WIN32}
      Windows.GetClientRect(FScopeWnd, aRect);
      {$ELSE}
      WinProcs.GetClientRect(FScopeWnd, aRect);
      {$ENDIF}

      if (FormatTag = 1) and (DataSize > 0) then
      begin
         EnableWindow(GetDlgItem(Wnd,CB_PREVIEW), True);

         if FPreview then
         begin
            DC := GetDC(FScopeWnd);
            try
               CreatePCMData(DC,aRect);
            finally
               ReleaseDC(FScopeWnd, DC);
            end;
            goto CheckDevice;
         end;
      end;
      InvalidateRect(FScopeWnd, @aRect, False);

CheckDevice:

      if (FWaveOut.NumDevs > 0) and not FWaveFile.Wave.Empty and
          FWaveOut.QueryDevice(FWaveOut.DeviceID,FWaveOut.PWaveFormat) and
          not (wosPlay in FWaveOut.State) then
      begin
         UpdatePlayParams;
         EnableWindow(GetDlgItem(Wnd,BT_Play), True);
         if FAutoPlay then
         try
            FWaveOut.Start;
         except
            { don't raise a exception here }
         end;
      end
      else EnableWindow(GetDlgItem(Wnd,BT_Play), False);
   end;
end;

{-- TMMWaveOpenDialog ---------------------------------------------------------}
procedure TMMWaveOpenDialog.ScopeWndHookProc(var Message: TMessage);
var
   DC: HDC;
   Paint: TPaintStruct;
   aRect: TRect;

begin
   with Message do
   begin
      if (Msg = WM_Paint) then
      begin
         DC := BeginPaint(FScopeWnd,Paint);
         {$IFDEF WIN32}
         Windows.GetClientRect(FScopeWnd,aRect);
         {$ELSE}
         WinProcs.GetClientRect(FScopeWnd,aRect);
         {$ENDIF}
         DrawPCMData(DC,aRect);
         EndPaint(FScopeWnd, Paint);
      end
      else if (Msg = WM_TIMER) then
      begin
         KillTimer(FScopeWnd,wParam);
         FUpdating := False;
         UpdateWave;
      end
      else Result := CallWindowProc(FScopeDefProc,FScopeWnd,Msg,wParam,lParam);
   end;
end;

{-- TMMWaveOpenDialog ---------------------------------------------------------}
procedure TMMWaveOpenDialog.DIBWndHookProc(var Message: TMessage);
var
   DC: HDC;
   Paint: TPaintStruct;
   aRect: TRect;

begin
   with Message do
   begin
      if (Msg = WM_Paint) then
      begin
         DC := BeginPaint(FDIBWnd,Paint);
         {$IFDEF WIN32}
         Windows.GetClientRect(FDIBWnd,aRect);
         {$ELSE}
         WinProcs.GetClientRect(FDIBWnd,aRect);
         {$ENDIF}
         DrawDISP(DC,aRect);
         EndPaint(FDIBWnd, Paint);
      end
      else Result := CallWindowProc(FDIBDefProc,FDIBWnd,Msg,wParam,lParam);
   end;
end;

{== TMMWaveSaveDialog =========================================================}
constructor TMMWaveSaveDialog.Create(aOwner: TComponent);
begin
   inherited Create(aOwner);

   Title := LoadResStr(IDS_WAVESAVE);
end;

{-- TMMWaveSaveDialog ---------------------------------------------------------}
function TMMWaveSaveDialog.Execute: Boolean;
begin
   Result := DoExecute(@GetSaveFileName);
end;

{== TMMPictureOpenDialog ======================================================}
constructor TMMPictureOpenDialog.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);

   Options := Options + [ofHideReadOnly];
   {$IFDEF WIN32}
   Options := Options + [ofNoNetworkButton];
   {$ENDIF}
   FBitmap := TBitmap.Create;
   FPicture := TPicture.Create;
   FPreview := False;
   FColor := clWindow;
   FLastFile := '';

   Title := LoadResStr(IDS_PICTUREOPEN);
   DefaultExt := GraphicExtension(TGraphic);
   Filter := GraphicFilter(TGraphic);
   FilterIndex := 1;
   FHookWnd := 0;

   {$IFNDEF WIN32}
   if _WINNT_ then
      TemplateName := 'CustomPictureOpenDlgNT'
   else
   {$ENDIF}
      TemplateName := 'CustomPictureOpenDlg';
end;

{-- TMMPictureOpenDialog ------------------------------------------------------}
destructor TMMPictureOpenDialog.Destroy;
begin
   FBitmap.Free;
   FPicture.Free;

   inherited Destroy;
end;

{-- TMMPictureOpenDialog ------------------------------------------------------}
procedure TMMPictureOpenDialog.DoCreate;
var
   aBuf: array[0..20] of Char;

begin
   if (FHookWnd = 0) then
   begin
      FHookWnd := GetDlgItem(Wnd,ST_PICTURE);
      FDefProc := Pointer(GetWindowLong(FHookWnd,GWL_WNDPROC));
      FOldProc := SetWindowLong(FHookWnd,GWL_WNDPROC,
                  Longint(MakeObjectInstance(WndHookProc)));
   end;

   SetDlgItemText(Wnd,CB_PREVIEW,StrPCopy(aBuf,LoadResStr(IDS_PREVIEW)));
   SendDlgItemMessage(Wnd,CB_PREVIEW, BM_SETCHECK, Ord(FPReview), 0);
   {$IFDEF WIN32}
   if not NewStyleControls then
   {$ENDIF}
   begin
      { TODO: hier Texte im Dialog lokalisieren !!!
       oder gleich englische Resource verwenden }
   end;

   inherited DoCreate;
end;

{-- TMMPictureOpenDialog ------------------------------------------------------}
procedure TMMPictureOpenDialog.DoDestroy;
begin
   if (FHookWnd <> 0) then
   begin
      FreeObjectInstance(Pointer(SetWindowLong(FHookWnd,GWL_WNDPROC,FOldProc)));
      FHookWnd := 0;
   end;

   inherited DoDestroy;
end;

{-- TMMPictureOpenDialog ------------------------------------------------------}
procedure TMMPictureOpenDialog.DoFileOK(FName: String; var IsOk: Boolean);
begin
   { TODO: hier Format pr黤en ? }
   inherited DoFileOK(FName, IsOK);
end;

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

begin
   if assigned(FPicture) then
   begin
      if (FName <> '') then
      begin
         LastName := FindLastFileName(FName);
         if (LastName <> FLastFile) and FileExists(LastName) then
         begin
            try
               FPicture.LoadFromFile(LastName);
               FLastFile := LastName;
            except
               FPicture.Bitmap.Handle := 0;
               FPicture.Icon.Handle := 0;
               FPicture.Metafile.Handle := 0;
               FLastFile := '';
            end;
            UpdatePicture;
         end;
      end
      else if (FLastFile <> '') then
      begin
         FPicture.Bitmap.Handle := 0;
         FPicture.Icon.Handle := 0;
         FPicture.Metafile.Handle := 0;
         FLastFile := '';
         UpdatePicture;
      end;
   end;

   inherited DoSelChanged(FName);
end;

{-- TMMPictureOpenDialog ------------------------------------------------------}
procedure TMMPictureOpenDialog.DoCommand(Wnd,Parent: Hwnd; cmd: Integer);
begin
   if (Wnd = FHWnd) then
   begin
      if (cmd = CB_PREVIEW) then
      begin
         FPreview := SendDlgItemMessage(Wnd, CB_PREVIEW, BM_GetCheck, 0, 0)<> 0;
         UpdatePicture;
      end;
   end;

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

{-- TMMPictureOpenDialog ------------------------------------------------------}
procedure TMMPictureOpenDialog.DrawPicture(DC: HDC; aRect: TRect);
const
   Space = 5;
var
   aCanvas: TCanvas;
   oldPal: HPalette;
   Factor: Float;
   iWidth,iHeight: integer;

begin
   with FPicture, aRect do
   begin
      aCanvas := TCanvas.Create;
      with aCanvas do
      try
         Handle := DC;
         { clear background }
         Brush.Color := clWindow;
         FillRect(aRect);
         Frame3D(aCanvas,aRect,clBtnShadow,clBtnHighLight,1);
         Frame3D(aCanvas,aRect,clWindowFrame,cl3DLight,1);
         if (Graphic <> nil) and not Graphic.Empty and FPreview then
         begin
            iWidth := FPicture.Width;
            iHeight := FPicture.Height;

            if (Graphic is TIcon) or (Graphic is TMetaFile) then
            begin
               if (iWidth < (Right-Left)-2*Space) and
                  (iHeight < (Bottom-Top)-2*Space) then
               begin
                  aRect := Bounds(((Right-Left) - iWidth) div 2,
                                  ((Bottom-Top) - iHeight) div 2,
                                    iWidth, iHeight);
               end;
               aCanvas.StretchDraw(aRect,Graphic);
            end
            else if (Graphic is TBitmap) then
            begin
               OldPal := SelectPalette(Handle,Bitmap.Palette,False);
               RealizePalette(Handle);

               if (iWidth < (Right-Left)-2*Space) and
                  (iHeight < (Bottom-Top)-2*Space) then
               begin
                  aRect := Bounds(((Right-Left) - iWidth) div 2,
                                  ((Bottom-Top) - iHeight) div 2,
                                    iWidth, iHeight);
               end
               else if (iWidth > iHeight) then
               begin
                  Factor := ((Right-Left)-2*Space)/iWidth;
                  iHeight := Trunc(iHeight * Factor);
                  aRect.Top := Top+((Bottom-Top)-iHeight) div 2;
                  aRect.Bottom := Top + iHeight;
                  aRect.Left := Left+Space;
                  aRect.Right := Right-Space;
               end
               else
               begin
                  Factor := ((Bottom-Top)-2*Space)/iHeight;
                  iWidth := Trunc(iWidth * Factor);
                  aRect.Left := Left+((Right-Left)-iWidth) div 2;
                  aRect.Right := Left + iWidth;
                  aRect.Top := aRect.Top + Space;
                  aRect.Bottom := Bottom - Space;
               end;
               aCanvas.StretchDraw(aRect,Graphic);
               SelectPalette(Handle, OldPal, False);
               RealizePalette(Handle);
            end;
         end;

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

{-- TMMPictureOpenDialog ------------------------------------------------------}
Procedure TMMPictureOpenDialog.UpdatePicture;
var
   aRect: TRect;

begin
   {$IFDEF WIN32}
   Windows.GetClientRect(FHookWnd, aRect);
   {$ELSE}
   WinProcs.GetClientRect(FHookWnd, aRect);
   {$ENDIF}
   InvalidateRect(FHookWnd, @aRect, False);
end;

{-- TMMPictureOpenDialog ------------------------------------------------------}
procedure TMMPictureOpenDialog.WndHookProc(var Message: TMessage);
var
   DC: HDC;
   Paint: TPaintStruct;
   aRect: TRect;

begin
   with Message do
   begin
      if (Msg = WM_Paint) then
      begin
         DC := BeginPaint(FHookWnd,Paint);
         {$IFDEF WIN32}
         Windows.GetClientRect(FHookWnd,aRect);
         {$ELSE}
         WinProcs.GetClientRect(FHookWnd,aRect);
         {$ENDIF}
         DrawPicture(DC,aRect);
         EndPaint(FHookWnd, Paint);
      end
      else Result := CallWindowProc(FDefProc,FHookWnd,Msg,wParam,lParam);
   end;
end;

{== TMMPictureSaveDialog ======================================================}
constructor TMMPictureSaveDialog.Create(aOwner: TComponent);
begin
   inherited Create(aOwner);

   Title := LoadResStr(IDS_PICTURESAVE);
end;

{-- TMMPictureSaveDialog ------------------------------------------------------}
function TMMPictureSaveDialog.Execute: Boolean;
begin
   Result := DoExecute(@GetSaveFileName);
end;

initialization
   {$IFDEF WIN32}
   if not NewStyleControls then
   {$ENDIF}
   InitDialogs;
end.