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

📄 unit_frmvideo.pas

📁 局域网VCD影院 用DELPHI 编写的 局域网VCD影院
💻 PAS
字号:
unit Unit_FrmVideo;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ExtCtrls;

type
  TFrmVideo = class(TForm)
    PopupMenu1: TPopupMenu;
    FullScreen: TMenuItem;
    WindowScreen: TMenuItem;
    N1: TMenuItem;
    Image1: TImage;
    Panel1: TPanel;
    Image2: TImage;
    N2: TMenuItem;
    Sound: TMenuItem;
    procedure FormResize(Sender: TObject);
    procedure FullScreenClick(Sender: TObject);
    procedure WindowScreenClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SoundClick(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    //---下面是窗口粘贴函数----------
    m_bMouseDown: Boolean;
    m_nOldMouseX, m_nOldMouseY: integer;
  //------------------------------
    iLeft, iTop: integer;
 // procedure WMMOVE(var Msg: TMessage); message WM_MOVE;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmVideo: TFrmVideo;

implementation
uses Mpeg1DecodeDll, MyDef, Unit_FrmMain,
{$IFDEF Language_GB32}
  Language_GB32
{$ENDIF}
{$IFDEF Language_BIG5}
  Language_BIG5
{$ENDIF}
{$IFDEF Language_English}
  Language_English
{$ENDIF};
{$R *.dfm}

procedure TFrmVideo.FormResize(Sender: TObject);
begin
  FrmMain.btFull.Down := WindowState = wsMaximized;
//Mpeg1Decode_ReSizeWindowRect(ClientRect);
end;

procedure TFrmVideo.FullScreenClick(Sender: TObject);
begin
//Mpeg1Decode_FullScreenVideo(True);
  if WindowState = wsMaximized then Exit;
  iLeft := FrmMain.Left;
  iTop := FrmMain.Top;
  WindowState := wsMaximized;
  ShowWindow(Handle, SW_SHOW);
  Mpeg1Decode_SetNewHWND(Handle);
  Mpeg1Decode_ReSizeWindowRect(ClientRect);
  Panel1.Visible := False;
end;

procedure TFrmVideo.WindowScreenClick(Sender: TObject);
begin
  if WindowState = wsNormal then Exit;
  WindowState := wsNormal;
  Panel1.Visible := True;
  ShowWindow(Handle, SW_SHOW);
  Mpeg1Decode_SetNewHWND(Panel1.Handle);
  Mpeg1Decode_ReSizeWindowRect(Panel1.ClientRect);
  FrmMain.Left := iLeft;
  FrmMain.Top := iTop;
//Mpeg1Decode_FullScreenVideo(False);
end;

procedure TFrmVideo.FormCreate(Sender: TObject);
begin
  Width := VideoFormWidth;
  Height := VideoFormHeight;
//EnableMenuItem(GetSystemMenu(Handle, FALSE), SC_CLOSE,MF_BYCOMMAND or MF_GRAYED);
  iLeft := FrmMain.Left;
  iTop := FrmMain.Top;
//Self.ParentWindow:=GetDesktopWindow; //任务栏有两个任务
  Self.Font.Name := StrFontName;
  Self.Font.Charset := Charset;
  Self.Font.Size := FontSize;
  FullScreen.Caption := VideoForm_MenFull;
  WindowScreen.Caption := VideoForm_MenWin;
  Sound.Caption := VideoForm_MenSound;
end;

procedure TFrmVideo.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := CanOne;
end;

procedure TFrmVideo.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then Mpeg1Decode_FullScreenVideo(True);
  if key = #27 then Mpeg1Decode_FullScreenVideo(False);

end;

procedure TFrmVideo.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if WindowState <> wsNormal then Exit;
  if Button = mbleft then
  begin
    m_bMouseDown := TRUE;
    m_nOldMouseX := x;
    m_nOldMouseY := y;
  end;
end;

procedure TFrmVideo.SoundClick(Sender: TObject);
begin
  Mpeg1Decode_PopupAudioPropDlg(Handle);
end;

{procedure TForm2.WMMOVE(var Msg: TMessage);
begin
    inherited;
        if Assigned(Form1) then
      if (FrmMain.Top-(Top+Image1.Height)<=8) then
                FrmMain.Top:=Top+Image1.Height;
    if (Left < 10) and (Top < 10) and
      (Left <> 0) and (Top <> 0) then // 设定移动到左上角 10 点范围内时贴到边上去
      begin
        Left := 0;
        Top := 0;
        Msg.Result := 0;
      end;
end;  }

procedure TFrmVideo.FormDblClick(Sender: TObject);
begin
{if WindowState=wsMaximized then  WindowScreen.Click
                           else  FullScreen.Click;  }
end;

procedure TFrmVideo.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if WindowState <> wsNormal then Exit;
  if Button = mbleft then
  begin
    m_bMouseDown := FALSE;
//ReleaseCapture();
    if (FrmMain.m_bHLinked) or (FrmMain.m_bVLinked) then
      FrmMain.m_bCombined := TRUE;
    if (not (FrmMain.m_bHLinked)) and (not (FrmMain.m_bVLinked)) then FrmMain.m_bCombined := FALSE;
  end;
end;

procedure TFrmVideo.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
//rect:TRect;
//point:TPoint;
  MoveX, MoveY: integer;
  rectPane, rectTv: TRect;
begin
{rect.left:= 54;
rect.top:= 29;
rect.right:= 377+54;
rect.bottom := 302+29;
point.x:=x;point.y:=y;
if(PtInRect(rect,point)) then Exit; }

  if (m_bMouseDown) then
  begin
    if (WindowState = wsMaximized) then Exit;
/////////////////////////////
/////////先移动自己的窗口
//////////////////////////////
    MoveX := x - m_nOldMouseX;
    MoveY := y - m_nOldMouseY;
    if (FrmMain.m_bHLinked) then
    begin
      if (abs(MoveX) <= WSPAN) then MoveX := 0
      else
      begin
        FrmMain.m_bHLinked := FALSE;
        FrmMain.m_bVLinked := FALSE;
      end;
    end;

    if (FrmMain.m_bVLinked) then
    begin
      if (abs(MoveY) <= WSPAN) then MoveY := 0
      else
      begin
        FrmMain.m_bVLinked := FALSE;
        FrmMain.m_bHLinked := FALSE;
      end;
    end;

    GetWindowRect(Handle, rectTv);
    rectTv.left := rectTv.left + MoveX;
    rectTv.right := rectTv.right + MoveX;
    rectTv.top := rectTv.top + MoveY;
    rectTv.bottom := rectTv.bottom + MoveY;
    MoveWindow(Handle, rectTv.Left, rectTv.Top, Self.Width, Self.Height, True);
/////////////////////////////////////
//再判断是否相吸
////////////////////////////////////
    GetWindowRect(FrmMain.Handle, rectPane);
    GetWindowRect(Handle, rectTv);
    MoveX := 0;
    MoveY := 0;
////////////////////////////////////////
//先判断上,下边
//if((rectTv.left>=rectPane.left) and (rectTv.left<=rectPane.right))or ((rectTv.right>=rectPane.left)and (rectTv.right<=rectPane.right)) then
    begin
      if (rectTv.top - WSPAN <= rectPane.bottom) and (rectTv.top >= rectPane.bottom) then //判断上边
      begin
        MoveY := rectPane.bottom - rectTv.top;
        FrmMain.m_bVLinked := TRUE;
      end
      else
        if (rectTv.bottom + WSPAN >= rectPane.top) and (rectTv.bottom <= rectPane.top) then //判断下边
        begin
          MoveY := rectPane.top - rectTv.bottom;
          FrmMain.m_bVLinked := TRUE;
        end;
    end;

    if (FrmMain.m_bVLinked) then
    begin
      GetWindowRect(Handle, rectTv);
      rectTv.top := rectTv.top + MoveY;
      rectTv.bottom := rectTv.bottom + MoveY;
      MoveWindow(Handle, rectTv.Left, rectTv.Top, Self.Width, Self.Height, True);
    end;

    GetWindowRect(Handle, rectTv);
    GetWindowRect(FrmMain.Handle, rectPane);
    MoveX := 0;
    MoveY := 0;
 //////////////////////////////////////////
 //再判断左,右边
    if ((rectTv.top >= rectPane.top) and (rectTv.top <= rectPane.bottom)) or ((rectTv.bottom >= rectPane.top) and (rectTv.bottom <= rectPane.bottom)) then
    begin
      if (rectTv.left - WSPAN <= rectPane.right) and (rectTv.left >= rectPane.right) then //判断左边
      begin
        MoveX := rectPane.right - rectTv.left;
        FrmMain.m_bHLinked := TRUE;
      end
      else
        if (rectTv.right + WSPAN >= rectPane.left) and (rectTv.right <= rectPane.left) then //判断右边
        begin
          MoveX := rectPane.left - rectTv.right;
          FrmMain.m_bHLinked := TRUE;
        end;
    end;
    if (FrmMain.m_bHLinked) then
    begin
      GetWindowRect(Handle, rectTv);
      rectTv.left := rectTv.left + MoveX;
      rectTv.right := rectTv.right + MoveX;
      MoveWindow(Handle, rectTv.Left, rectTv.Top, Self.Width, Self.Height, True);
    end;

  /////////////////////////////////////////////////
  //如果有一边吸在一起
    if (FrmMain.m_bVLinked) then
    begin
      if (abs(rectPane.left - rectTv.left) <= WSPAN) then
      begin
        FrmMain.m_bHLinked := TRUE;
        GetWindowRect(Handle, rectTv);
        MoveX := rectPane.left - rectTv.left;
        rectTv.left := rectTv.left + MoveX;
        rectTv.right := rectTv.right + MoveX;
        MoveWindow(Handle, rectTv.Left, rectTv.Top, Self.Width, Self.Height, True);
      end
      else if (abs(rectPane.right - rectTv.right) <= WSPAN) then
      begin
        FrmMain.m_bHLinked := TRUE;
        GetWindowRect(Handle, rectTv);
        MoveX := rectPane.right - rectTv.right;
        rectTv.left := rectTv.left + MoveX;
        rectTv.right := rectTv.right + MoveX;
        MoveWindow(Handle, rectTv.Left, rectTv.Top, Self.Width, Self.Height, True);
      end;
    end
    else if (FrmMain.m_bHLinked) then
    begin
      if (abs(rectPane.top - rectTv.top) <= WSPAN) then
      begin
        FrmMain.m_bVLinked := TRUE;
        GetWindowRect(Handle, rectTv);
        MoveY := rectPane.top - rectTv.top;
        rectTv.top := rectTv.top + MoveY;
        rectTv.bottom := rectTv.bottom + MoveY;
        MoveWindow(Handle, rectTv.Left, rectTv.Top, Self.Width, Self.Height, True);
      end
      else
        if (abs(rectPane.bottom - rectTv.bottom) <= WSPAN) then
        begin
          FrmMain.m_bVLinked := TRUE;
          GetWindowRect(Handle, rectTv);
          MoveY := rectPane.bottom - rectTv.bottom;
          rectTv.top := rectTv.top + MoveY;
          rectTv.bottom := rectTv.bottom + MoveY;
          MoveWindow(Handle, rectTv.Left, rectTv.Top, Self.Width, Self.Height, True);
        end;
    end;
  end;
end;

end.

⌨️ 快捷键说明

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