📄 playdlg_frm.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 + -