⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.~pas

📁 关于DEPHI7.0的播放器管理系统源代码
💻 ~PAS
📖 第 1 页 / 共 3 页
字号:
begin
Panel_Real.left := Panel_Real.Left -1;
Panel_Real.top := Panel_Real.Top -1;
end;

procedure TFormMain.Image_VideoMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
Image_Video.Hint := '视频';
end;

procedure TFormMain.Image_VideoMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Panel_Video.left := Panel_Video.Left +1;
Panel_Video.top := Panel_Video.Top +1;
end;

procedure TFormMain.Image_VideoMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Panel_Video.left := Panel_Video.Left -1;
Panel_Video.top := Panel_Video.Top -1;
end;

procedure TFormMain.Image_minClick(Sender: TObject);
begin
 // FormMain.WindowState :=  wsMinimized;
 // Application.ShowMainForm := False;
  Application.Minimize;
end;

procedure TFormMain.ActionCloseExecute(Sender: TObject);
begin
 close;
end;

procedure TFormMain.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  POSTMESSAGE(FormMain.handle,WM_LBUTTONUP,0,0);
  POSTMESSAGE(FormMain.handle,274,61458,0);
end;

procedure TFormMain.ActionFlashExecute(Sender: TObject);
begin
 FormFlashPlayer.Show;
end;

procedure TFormMain.ActionRealExecute(Sender: TObject);
begin
 FormRealPlayer.Show;
end;

procedure TFormMain.Image_openClick(Sender: TObject);
begin
 FormFileList.ActionAdd.Execute;
end;

procedure TFormMain.ActionFileListExecute(Sender: TObject);
begin
 FormFileList.Visible := not FormFileList.Visible;
end;

procedure TFormMain.ActionAboutExecute(Sender: TObject);
begin
  FormAbout.Visible := not  FormAbout.Visible;
end;

procedure TFormMain.ActionHelpExecute(Sender: TObject);
begin
  FormHelp.Visible := not FormHelp.Visible;
end;

procedure TFormMain.ActionDisplayExecute(Sender: TObject);
begin
   FormMovie.Visible := not FormMovie.Visible;
end;

procedure TFormMain.Image_aboutClick(Sender: TObject);
begin
  Actionabout.Execute;
end;

procedure TFormMain.Image_helpClick(Sender: TObject);
begin
  ActionHelp.Execute;
end;

procedure TFormMain.Image_listClick(Sender: TObject);
begin
  ActionFileList.Execute;
end;

procedure TFormMain.Image_playClick(Sender: TObject);
begin
  FormFileList.ActionPlay.Execute;
end;

procedure TFormMain.Image_pauseClick(Sender: TObject);
begin
    FormFileList.ActionPause.Execute;
end;

procedure TFormMain.Image_stopClick(Sender: TObject);
begin
  FormFileList.ActionStop.Execute;
end;

procedure TFormMain.Image_nextClick(Sender: TObject);
begin
   FormFileList.ActionNext.Execute;
end;

procedure TFormMain.Image_stepClick(Sender: TObject);
begin
   FormFileList.ActionStep.Execute;
end;

procedure TFormMain.Image_backClick(Sender: TObject);
begin
   FormFileList.ActionBack.Execute;
end;

procedure TFormMain.Image_prevClick(Sender: TObject);
begin
  FormFileList.ActionPrev.Execute;
end;

procedure TFormMain.Image_discardClick(Sender: TObject);
begin
   FormFileList.ActionCd.Execute;
end;

procedure TFormMain.Timer_systemTimer(Sender: TObject);
begin
  Label_systime.Caption :=' '+timetostr(time)+' ';
end;

procedure TFormMain.Timer_playTimer(Sender: TObject);
begin
      with FormFileList.MediaPlayer1 do
        begin
          Edit1.Text := ExtractFileName(FormFileList.MediaPlayer1.FileName);
          Application.Title := Edit1.Text+' 优利媒体播放系统V1.1';
          if Mode in [mpPlaying] then
          begin
            Edit1.Visible := True;
            if FormFilelist.FileChange then
            begin
              TrackBar_play.Max := FormFileList.MediaPlayer1.Length div 1000;
              TrackBar_play.Position := 0;
              Label_totaltime.Caption:='总时间 '+ZeroFill(2,inttostr(TrackBar_play.max div 60))
              +':'+ZeroFill(2,inttostr(TrackBar_play.max mod 60))+'    ';
              FormFileList.FileChange := False;
            end;
            TrackBar_play.Position := Position div 1000;
            Label_playtime.Caption:='播放时间 '+ZeroFill(2,inttostr(TrackBar_play.Position div 60))
              +':'+ZeroFill(2,inttostr(TrackBar_play.Position mod 60))+'    ';
        end;
      end;
end;

procedure TFormMain.TrackBar_playChange(Sender: TObject);
begin
  if (TrackBar_play.Position <> (FormFileList.Mediaplayer1.Position div 1000)) then PositionChange := True
  else PositionChange := False;
  if PositionChange then
   with FormFileList.Mediaplayer1 do
    begin
         if Mode in [mpOpen, mpPlaying] then
         begin
           pause;
           Position := TrackBar_play.Position * 1000;
           Play;
          end
         else if mode in [mpOpen, mpPaused, mpStopped] then
           begin
              Position :=  TrackBar_play.Position * 1000;
           end;
   end;
end;

procedure TFormMain.Image_flashClick(Sender: TObject);
begin
  ActionFlash.Execute;
end;

procedure TFormMain.Image_realClick(Sender: TObject);
begin
  ActionReal.Execute;
end;

procedure TFormMain.PopOpenClick(Sender: TObject);
begin
  FormFileList.ActionAdd.Execute;
end;

procedure TFormMain.ActionNextExecute(Sender: TObject);
begin
 FormFileList.ActionNext.Execute;
end;

procedure TFormMain.ActionPrevExecute(Sender: TObject);
begin
  FormFileList.ActionPrev.Execute;
end;

procedure TFormMain.ActionPlayExecute(Sender: TObject);
begin
FormFileList.ActionPlay.Execute;
end;

procedure TFormMain.ActionPauseExecute(Sender: TObject);
begin
FormFileList.ActionStop.Execute;
end;

procedure TFormMain.ActionOpenFileExecute(Sender: TObject);
begin
FormFileList.ActionAdd.Execute;
end;

procedure TFormMain.ActionStepExecute(Sender: TObject);
begin
FormFileList.ActionStep.Execute;
end;

procedure TFormMain.ActionBackExecute(Sender: TObject);
begin
FormFileList.ActionBack.Execute;
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
 Shell_NotifyIcon(NIM_DELETE,TrayIcon);   //移出任务栏图标
{释放全部资源}
// FormMain.Free;
// FormRealPlayer.Free;
// FormFlashPlayer.Free;
// FormMovie.Free;
// FormFileList.Free;
// FormAbout.Free;
// FormHelp.Free;
// FormRealMng.Free;
end;

procedure TFormMain.Pop_processClick(Sender: TObject);
begin
// if Pop_process.Checked then PositionChange := True
// else  PositionChange := False;
end;

procedure TFormMain.Image_videoClick(Sender: TObject);
begin
   FormMovie.Visible := not FormMovie.Visible;
end;

procedure CaptureControl;//抓图过程
begin
NoWait := True;
//获得图像的矩形区域和句柄
if FormMain.Pop_VideoWin.Checked = True then
    begin
    tmpRect := FormMovie.Panel1.ClientRect;
    HDCScreen := GetDC(FormMovie.Panel1.Handle);
    end
 else if  FormMain.Pop_FlashWin.Checked = True then
    begin
    tmpRect := FormFlashPlayer.ShockwaveFlash1.ClientRect;
    HDCScreen := GetDC(FormFlashPlayer.Panel2.Handle);
    end
 else if  FormMain.Pop_RealWin.Checked = True then
    begin
    tmpRect := FormRealPlayer.RealAudio1.ClientRect;
    HDCScreen := GetDC(FormRealPlayer.Panel2.Handle);
    end
 else if FormMain.Pop_FullDisplayWin.Checked = True then
    begin
    tmpRect := Rect(0,0,Screen.Width,Screen.Height);
    HDCScreen := GetDc(GetDesktopWindow);
    end
 else
    begin
    NoWait := False;
    while not NoWait do
     begin
      FormMain.Timer_Capture.Enabled := True;
      if (Getkeystate(VK_LBUTTON) > 0) or  (Getkeystate(VK_RBUTTON) > 0) then
         begin
          GetCursorPos(P1);
          tmpHWND := WindowFromPoint(P1);
          GetWindowRect(tmpHWND, tmpRect);
          HDCScreen := GetDc(tmpHWND);
          FormMain.Timer_Capture.Enabled := False;
          NoWait := True;
         end;
     end;
   end;
//建立位图
tmpBitmap :=TBitmap.Create;
iWidth := tmpRect.Right-tmpRect.Left;
iHeight := tmpRect.Bottom-tmpRect.Top;
tmpBitmap.Width := iWidth;
tmpBitmap.Height := iHeight;
iBitmapValide := True;
//复制窗口矩形区域到位图中
Bitblt(tmpBitmap.Canvas.Handle,0,0,iWidth,iHeight,
             HDCScreen,tmpRect.Left,tmpRect.Top, SRCCOPY);
//释放句柄
if FormMain.Pop_VideoWin.Checked = True then
    begin
    ReleaseDC(FormMovie.Panel1.Handle,HDCScreen);
    end
 else if  FormMain.Pop_FlashWin.Checked = True then
    begin
    ReleaseDC(FormFlashPlayer.Panel2.Handle,HDCScreen);
    end
 else if  FormMain.Pop_RealWin.Checked = True then
    begin
    ReleaseDC(FormRealPlayer.Panel2.Handle,HDCScreen);
    end
 else if FormMain.Pop_FullDisplayWin.Checked = True then
    begin
    ReleaseDC(GetDesktopWindow, HDCScreen);
    end
 else
    begin
    ReleaseDC(tmpHWND, HDCScreen);
    FormMain.Timer_Capture.Enabled := False;
    end;
end;

procedure TFormMain.Image_authorClick(Sender: TObject);
begin
   //访问作者主页
   //HlinkNavigateString(Nil,'http://journer.yeah.net');
  ActionCaptureExecute(Sender);
end;

procedure TFormMain.PopAudioClick(Sender: TObject);
begin
  Image_audioClick(Sender);
end;

procedure TFormMain.ActionImgRepaintExecute(Sender: TObject);
begin

 //Image_author.ReFresh;
 //Panel_author.ReFresh;
end;

procedure TFormMain.ActionCaptureExecute(Sender: TObject);
var FileExt : String[4];
  tmpJPEG : Tjpegimage;
begin
  if iBitmapValide then
   begin
    tmpBitmap.FreeImage;
    tmpBitmap.Free;
    iBitmapValide := False;
   end;
  CaptureControl;
  SavePic.Title := '请输入要保存的文件名,以.JPG或.BMP结束';
  SavePic.Filter:='JPEG格式(*.JPG)|*.jpg|位图格式(*.BMP)|*.bmp';
  SavePic.DefaultExt:= 'JPG';
  if SavePic.Execute then
  begin
    FileExt := UpperCase(ExtractFileExt(SavePic.FileName));
    if FileExt = '.BMP' then
        tmpBitmap.SaveToFile(SavePic.FileName)
    else
       begin
         SavePic.FileName := ChangeFileExt(SavePic.FileName,'.JPG');
         tmpJPEG := Tjpegimage.Create;
         tmpJPEG.Assign(tmpBitmap);
         tmpJPEG.CompressionQuality := 100;
         tmpJPEG.Compress;
         try
           tmpJPEG.Savetofile(SavePic.FileName);
         finally
           tmpJPEG.Free;
         end;
       end;
  end;
  //保存完图象后删除位图
  tmpBitmap.FreeImage;
  tmpBitmap.Free;
  iBitmapValide := False;
end;

procedure TFormMain.Timer_captureTimer(Sender: TObject);
begin
   GetCursorPos(P1);
   tmpHWND := WindowFromPoint(P1);
   GetWindowRect(tmpHWND, tmpRect);
   HDCScreen := GetDc(tmpHWND);
   NoWait := True;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -