displayscr.pas

超级播放器 -- 软件特点 -- 功能齐全 操作简便 绿色环保

unit displayScr;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ExtCtrls, Buttons;
//const
//  CM_MyMsg = WM_USER + 488;

type
  TFrmState=(fstNormal,fstMax,fstFull);
  TFrmDisplayScr = class(TForm)
    MainMenu1: TMainMenu;
    StayOnTop1: TMenuItem;
    dd1: TMenuItem;
    N1: TMenuItem;
    TitleBar: TLabel;
    sbtnClose: TSpeedButton;
    sbtnSmall: TSpeedButton;
    big1: TSpeedButton;
    big2: TSpeedButton;
    rateLb: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    PopupMenu1: TPopupMenu;
    StayOnTop2: TMenuItem;
    N2: TMenuItem;
    mnuFullscr: TMenuItem;
    Image3: TImage;
    TitleLb: TLabel;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    ScrPnl: TPanel;
    N12: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure dd1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TitleBarDblClick(Sender: TObject);
    procedure sbtnCloseClick(Sender: TObject);
    procedure sbtnSmallClick(Sender: TObject);
    procedure TitleBarMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Label3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Label4MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Label2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure StayOnTop2Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure mnuFullscrClick(Sender: TObject);
    procedure Label6MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure N12Click(Sender: TObject);
  private
    { Private declarations }
    procedure WMSysCommand(var message: TWMSysCommand);
           message WM_SYSCOMMAND;
    procedure WMMOVE(var Msg: TMessage); message WM_MOVE;
  public
    { Public declarations }
    // 屏幕显示区域 原始大小
    oldwidth,oldheight:integer;

    //屏幕窗口原始尺寸
    oldFrmWidth,oldFrmHeight:integer;
    //拖动改变窗口时
    winWidth,winHeight,winLeft,winTop:integer;
    //记录满屏前的状态
    fbTop,fbLeft,fbWidth,fbHeight:smallint;
    
    winstate:TFrmState;
    procedure WMEXITSIZEMOVE(var Message: TMessage);
    message WM_EXITSIZEMOVE;
    procedure WMSIZE(var Message: TMessage);
    message WM_SIZE;
//    procedure WMSIZING(var Message: TMessage);
//    message WM_SIZING;
  end;

var
  FrmDisplayScr: TFrmDisplayScr;
const
  idMyFunc=WM_USER + 1;

implementation
uses main,media;
{$R *.dfm}
procedure TFrmDisplayScr.WMSIZE(var Message: TMessage);
//var retstr:string;
begin
{ if message.WParam in [SIZE_MINIMIZED,SIZE_MAXIMIZED] then
 begin
     if MainFrm.Label17.caption ='Label17' then exit;
     if lowercase(extractfileext(MainFrm.Label17.caption)) ='.dat' then
     begin
       if width<>xwidth then
         Height :=Width *oldheight div oldwidth;
       if height<>xheight then
         width :=(Height *oldwidth div oldheight);
       retstr:=PutMultimedia(panel1.Handle,MediaAliasName,0,0,0,0);
       if retstr<>'ok' then
       begin
         showinformation(retstr);
         xwidth:=self.Width;
         xheight:=self.Height;
         exit;
       end;
     end;
     xwidth:=self.Width;
     xheight:=self.Height;
 end;}
 inherited;
end;  
{procedure TFrmDisplayScr.WMSIZING(var Message: TMessage);
begin
end;
}
procedure TFrmDisplayScr.WMEXITSIZEMOVE(var Message: TMessage);
//var retstr:string;
begin
// if message.WParam in [SIZE_MINIMIZED,SIZE_MAXIMIZED,SIZE_RESTORED] then
// begin
{     if MainFrm.Label17.caption ='Label17' then exit;
     if lowercase(extractfileext(MainFrm.Label17.caption)) ='.dat' then
     begin
       if width<>xwidth then
         Height :=Width *oldheight div oldwidth;
       if height<>xheight then
         width :=(Height *oldwidth div oldheight);
       retstr:=PutMultimedia(panel1.Handle,MediaAliasName,0,0,0,0);
       if retstr<>'ok' then
       begin
         showinformation(retstr);
         xwidth:=self.Width;
         xheight:=self.Height;
         exit;
       end;
     end;
     xwidth:=self.Width;
     xheight:=self.Height;
     }
 //end;
end;

procedure TFrmDisplayScr.FormResize(Sender: TObject);
var retstr:string;
  aleft,atop,awidth,aheight:integer;
begin
 if not self.Visible then exit;

 if not MainFrm.fileOpened then exit;

 if mainFrm.isVideoFile(mainFrm.PlayItem) then
 begin
   if winstate<>fstFull then
   begin
     aleft:=3; atop:=titlebar.height;
     awidth:=clientwidth-6;aheight:=clientheight-titlebar.Height-3;

     if awidth>aheight * oldwidth div oldheight then
     begin
       awidth:=aheight * oldwidth div oldheight;
       aleft:=(Clientwidth-6 -awidth) div 2 +3;
     end
     else
     begin
       aheight:=awidth *oldheight div oldwidth;
       atop :=(clientheight-Titlebar.Height-3 -aheight) div  2+TitleBar.height;
     end;
   end
   else
   begin
     aLeft:=0; aTop:=0;
     aWidth:=Clientwidth; aHeight:=ClientHeight;
     if awidth>aheight * oldwidth div oldheight then
     begin
       awidth:=aheight * oldwidth div oldheight;
       aleft:=(Clientwidth -awidth) div 2;
     end
     else
     begin
       aheight:=awidth *oldheight div oldwidth;
       atop :=(clientheight-aheight) div  2;
     end;
   end;

   scrPnl.Left :=aLeft;
   scrPnl.Top :=atop;
   scrPnl.Width :=awidth;
   scrPnl.height:=aHeight;

   retstr:=PutMultimedia(scrPnl.Handle,MediaAliasName,0,0,0,0 );
   if retstr<>'ok' then
   begin
     showinformation(retstr);
     exit;
   end;

   RateLb.Caption :='['+inttostr(awidth *100 div oldwidth) +'%]';
 end;
end;
procedure TFrmDisplayScr.WMSysCommand(var message:TWMSysCommand);
var
//  kk:tagMENUITEMINFO;
  item:TMenuItem;
begin
  inherited;
   item:=MainMenu1.FindItem(message.cmdtype,fkCommand);
   if item<>nil then
     item.Click;

 if message.cmdType =idMyFunc then
 begin
   if getmenuState(GetSystemMenu(Handle,False),idMyFunc,0) and MF_CHECKED <>0 then
   begin
     setwindowPos(self.Handle,HWND_NOTOPMOST,0,0,0,0,SWP_NOSIZE or SWP_NOMOVE or SWP_NOACTIVATE	) ;
     checkMenuItem(GetSystemMenu(Handle,False),idMyFunc,MF_UNCHECKED)
   end
   else
   begin
     checkMenuItem(GetSystemMenu(Handle,False),idMyFunc,MF_CHECKED);
     setwindowPos(self.Handle,HWND_TOPMOST,0,0,0,0,SWP_NOSIZE or SWP_NOMOVE or SWP_NOACTIVATE	);
   end;
 end;
end;

procedure TFrmDisplayScr.FormCreate(Sender: TObject);
var i:integer;
begin
  image3.Picture.Icon :=self.Icon;
  //限制窗口大小
  self.Constraints.minHeight :=140;
  self.Constraints.MinWidth :=150;
  
   winstate:=fstNormal;
  insertmenu (GetSystemMenu(Handle,False), 3,mf_Separator or MF_BYPOSITION, 0, Nil);

  for i:=0 to mainmenu1.Items.Count-1 do
  insertmenu(GetSystemMenu(Handle,False)
                  , 4,MF_STRING or MF_BYPOSITION or mf_popup,mainmenu1.Items[i].handle,pchar(mainmenu1.Items[i].caption));

  insertmenu (GetSystemMenu(Handle,False), 5,mf_Separator or MF_BYPOSITION, 0, Nil);

  AppendMenu (GetSystemMenu(Handle,False), mf_Separator, 0, Nil);
  AppendMenu(GetSystemMenu(Handle,False)
                   ,MF_STRING ,idMyFunc,'Stay On Top');

    fbTop := top;
    fbLeft:=Left;
    fbWidth:=Width;
    fbHeight:=Height;
    
    winWidth:=self.Width ;
    winHeight:=self.Height;
    winTop:=self.Top;
    winLeft:=self.Left;

end;

procedure TFrmDisplayScr.dd1Click(Sender: TObject);