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

📄 playdlg_frm.pas

📁 unit Video interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, stdctrl
💻 PAS
字号:
unit playdlg_frm;

interface
uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  FXLBL50GLib_TLB,
  StdCtrls,
  Dialogs,
  ExtCtrls,
  FXVID50GLib_TLB,
  VrBlotter,
  Video,
  mmsystem,
  VrControls,
  MASFLCLib_TLB,
  OleCtrls,
  DbOleCtl,
  AxCtrls;

type
  Tplaydlg = class(TForm)
    FXLabel1: TFXLabel;
    EditText: TFXLabel;
    Image1: TImage;
    Image2: TImage;
    VCD: TFXVid;
    Video1: TVideo;
    Flc: TMasFLCPlayer;
    procedure EditTextNotify(Sender: TObject);
    procedure FXLabel1Notify(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure VCDNotify(Sender: TObject);
    procedure Video1Status(Sender: TObject);
    procedure EditTextMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure EditTextMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure Image1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure EditTextDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure EditTextDragDrop(Sender, Source: TObject; X, Y: Integer);
  private
    { Private declarations }
  public
    xx: integer;
    yy: integer;
    { Public declarations }
    procedure BackBmp();
    procedure BackBmpPrv;
    procedure SaveBack;
    procedure SaveBackPrv;
    procedure WMNCLBUTTONDOWN(var Message: TMessage); message WM_NCLBUTTONDOWN;
    procedure WMNCLBUTTONUP(var Message: TMessage); message WM_NCLBUTTONUP;
  end;

var
  playdlg: Tplaydlg;
  clsflag: shortint;

implementation

uses fontdlg_frm,
  MainPlay;

{$R *.DFM}

procedure Tplaydlg.BackBmp;
begin
  with fxlabel1 do
    begin
      Update := False;
      Visible := False;
    end;
  Image2.Visible := False;
  Image1.Visible := True;
end;

procedure Tplaydlg.EditTextNotify(Sender: TObject);
begin
  edittext.FXEnabled := false;
  fontdlg.btnTest.caption := '测试';
end;

procedure Tplaydlg.FXLabel1Notify(Sender: TObject);
begin
  MainForm.Sim_Grid;
end;

procedure Tplaydlg.BackBmpPrv;
begin
  with fxlabel1 do
    begin
      Update := False;
      Visible := False;
    end;
  Image1.Visible := False;
  Image2.Visible := True;
end;

procedure Tplaydlg.SaveBack;
var
  Dc: HDC;
begin
  Image1.Picture := nil;
  Dc := GetDC(FxLabel1.Handle);
  BitBlt(Image1.Canvas.Handle, 0, 0, FXLabel1.Width,
    FXLabel1.Height, Dc, 0, 0, SRCCOPY);
  ReleaseDC(FXLabel1.Handle, dc);
end;

procedure Tplaydlg.SaveBackPrv;
var
  Dc: HDC;
begin
  Image2.Picture := nil;
  Dc := GetDC(FXLabel1.Handle);
  BitBlt(Image2.Canvas.Handle, 0, 0, FXLabel1.Width,
    FXLabel1.Height, Dc, 0, 0, SRCCOPY);
  ReleaseDC(FXLabel1.Handle, dc);
end;

procedure Tplaydlg.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  Stepdr: Integer;
begin
  if (EditText.Visible = True) then
    begin
      EditText.AutoSize := False;
      if ssshift in Shift then
        Stepdr := 10
      else
        Stepdr := 1;
      case key of
        38: edittext.Height := edittext.Height - Stepdr;
        40: edittext.Height := edittext.Height + Stepdr;
        39: edittext.width := edittext.Width + Stepdr;
        37: edittext.width := edittext.width - Stepdr;
      end;
    end;
  if (EditText.Visible = True) then
    begin
      EditText.AutoSize := False;
      if ssCtrl in Shift then
        Stepdr := 10
      else
        Stepdr := 1;
      case key of
        38: edittext.top := edittext.top - Stepdr;
        40: edittext.top := edittext.top + Stepdr;
        39: edittext.left := edittext.left + Stepdr;
        37: edittext.left := edittext.left - Stepdr;
      end;
    end;
end;

procedure Tplaydlg.VCDNotify(Sender: TObject);
begin
  if (MainForm.VcdCount = MainForm.ListBox1.Items.Count - 1) then
    begin
      MainForm.VcdCount := 0;
      MainForm.btnVcdPlayclick(Self);
    end
  else
    begin
      MainForm.VcdCount := MainForm.VcdCount + 1;
      MainForm.btnVcdPlayclick(Self);
    end;
end;

procedure Tplaydlg.Video1Status(Sender: TObject);
begin
  if Video1.DriverIndex = -1 then
    Video1.VideoPreview := false;
end;

procedure Tplaydlg.EditTextMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin

  if ssRight in shift then
    begin
      if EditText.Cursor = crSizeNS then
        begin
          editText.AutoSize := False;
          EditText.Height := y;
        end;
      if EditText.Cursor = crSizeWE then
        begin
          editText.AutoSize := False;
          EditText.Width := x;
        end;
    end;
  if (y >= Edittext.Height - 2) and (y <= Edittext.Height - 2) then
    EditText.Cursor := crSizeNS;
  if (x >= Edittext.Width - 2) and (x <= Edittext.Width - 2) then
    EditText.Cursor := crSizeWE;
end;

procedure Tplaydlg.EditTextMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  fontdlg.d_y.value := edittext.top;
  fontdlg.d_x.value := edittext.left;
  fontdlg.d_y1.value := edittext.top;
  fontdlg.d_x1.value := edittext.left;
  fontdlg.d_x2.value := edittext.width;
  fontdlg.d_y2.value := edittext.Height;
end;

procedure Tplaydlg.Image1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := Source is TFXLabel;
end;

procedure Tplaydlg.Image1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  EditText.top := y;
  EditText.Left := x;
  fontdlg.d_y.value := edittext.top;
  fontdlg.d_x.value := edittext.left;
  fontdlg.d_y1.value := edittext.top;
  fontdlg.d_x1.value := edittext.left;
  fontdlg.d_x2.value := edittext.width;
  fontdlg.d_y2.value := edittext.Height;
end;

procedure Tplaydlg.EditTextDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := True
end;

procedure Tplaydlg.EditTextDragDrop(Sender, Source: TObject; X,
  Y: Integer);
begin
  EditText.top := EditText.top + y;
  EditText.Left := EditText.Left + x;
  EditText.Cursor := crDefault;
  fontdlg.d_y.value := edittext.top;
  fontdlg.d_x.value := edittext.left;
  fontdlg.d_y1.value := edittext.top;
  fontdlg.d_x1.value := edittext.left;
  fontdlg.d_x2.value := edittext.width;
  fontdlg.d_y2.value := edittext.Height;
end;

procedure Tplaydlg.WMNCLBUTTONDOWN(var Message: TMessage);
begin
  if MainForm.PosPanel.Visible then
    inherited;
end;

procedure Tplaydlg.WMNCLBUTTONUP(var Message: TMessage);
begin
  if MainForm.PosPanel.Visible then
    inherited;
end;
end.

⌨️ 快捷键说明

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