📄 main.~pas
字号:
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 + -