📄 unit1.pas
字号:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls,ShowDV,DBCtrls, Spin, Buttons, ColorGrd,
ComCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
OpenDialog1: TOpenDialog;
StatusBar1: TStatusBar;
Panelx: TPanel;
Image1: TImage;
Timer1: TTimer;
Panel1: TPanel;
Label5: TLabel;
ScrollBar1: TScrollBar;
Panel2: TPanel;
Label4: TLabel;
ScrollBar2: TScrollBar;
Panel3: TPanel;
Panel4: TPanel;
ScrollBar3: TScrollBar;
Panel5: TPanel;
Label3: TLabel;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
Button4: TButton;
Memo1: TMemo;
ScrollBar4: TScrollBar;
Label6: TLabel;
SaveDialog1: TSaveDialog;
Button5: TButton;
Button6: TButton;
SaveDialog2: TSaveDialog;
Memo2: TMemo;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure ScrollBar1Change(Sender: TObject);
procedure ScrollBar2Change(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ScrollBar3Change(Sender: TObject);
procedure Label1Click(Sender: TObject);
procedure ScrollBar4Change(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
{ Private declarations }
MoveFrameShow :Integer;
ShowDevice :TShowToDevice;
CardNum :Byte;
Procedure ShowOneBigKadr(Index:Integer);
public
{ Public declarations }
nrpoint,scanspeed,framesspeed,portR,portg,portb,portrgb:integer;
MyWidth,
MyHeight:Integer;
MyPolWidth,
MyPolHeight:Integer;
end;
var
Form1: TForm1;
j,xx,yy,fx1,fx2,fy1,fy2,startx,starty,lastx,lasty:integer;
culoare:byte;
implementation
{$R *.DFM}
uses DataUnit,ReadIlda;
Procedure TForm1.ShowOneBigKadr(Index:Integer);
Var
I:Integer;
TotalTime:Int64;
xx,yy:integer;
Begin
With Image1.Canvas do
Begin
//if Index=0 Then StartTime:=Now;
Pen.Color:=ClBlack;
Brush.Color:=ClBlack;
Rectangle(0,0,MyWidth,MyHeight);
Pen.Color:=Rgb(IldaColorTable[MyShow.Frames[Index].Points[0].Color,0],
IldaColorTable[MyShow.Frames[Index].Points[0].Color,1],
IldaColorTable[MyShow.Frames[Index].Points[0].Color,2]);
MoveTo(Round((MyShow.Frames[Index].Points[0].X)*(MyPolWidth/2048)),
(Round((MyShow.Frames[Index].Points[0].Y)*(MyPolHeight/2048))));
For i:=1 To MyShow.Frames[Index].CountPoints-1 do
Begin
Pen.Color:=Rgb(IldaColorTable[MyShow.Frames[Index].Points[i].Color,0],
IldaColorTable[MyShow.Frames[Index].Points[i].Color,1],
IldaColorTable[MyShow.Frames[Index].Points[i].Color,2]);
xx:=Round(((MyShow.Frames[Index].Points[i].X)*(MyPolWidth /2048)));
yy:=Round(((MyShow.Frames[Index].Points[i].Y)*(MyPolHeight/2048)));
if MyShow.Frames[Index].Points[i].I=0 Then
begin
MoveTo(xx,yy);
// memo1.Lines.Strings[index]:=('0 x='+inttostr(xx)+'y='+inttostr(yy));
end
Else
begin
LineTo(xx,yy);
// memo1.Lines.Add('1 x='+inttostr(xx)+'y='+inttostr(yy));
end;
if Show_points_frame Then
Ellipse(Round((MyShow.Frames[Index].Points[i].X)*(MyPolWidth/2048))-3,(Round((MyShow.Frames[Index].Points[i].Y)*(MyPolHeight/2048)))-3,
Round((MyShow.Frames[Index].Points[i].X)*(MyPolWidth/2048))+3,(Round((MyShow.Frames[Index].Points[i].Y)*(MyPolHeight/2048)))+3);
End;
Brush.Style:=bsClear;
Font.Color:=ClWhite;
TextOut(0,0,ShowFileName);
TextOut(0,MyHeight-30,'Frame '+IntTOStr(Index)+' from '+IntTOStr(MyShow.CountFrame));
TextOut(0,MyHeight-15,'points '+IntTOStr(MyShow.Frames[Index].CountPoints));
// TotalTime:=(MyShow.CountPoints*Form2.VrNum1.Value) div 10000;
// TextOut(MyWidth-100,MyHeight-15,'Total time '+IntTOStr((TotalTime div 100) div 60)+':'+IntTOStr((TotalTime div 100) mod 60)+','+IntToStr(TotalTime mod 100));
// TextOut(MyWidth-120,MyHeight-30,'Current time '+TimeToStr(Now-StartTime));
// TextOut(MyWidth-250,MyHeight-15,'Scanrate '+IntToStr(Form2.VrNum2.Value)+'PPS');
TextOut(MyWidth-100,15,'Palette:'+PalleteTxt);
Brush.Style:=bsSolid;
End;
End;
procedure TForm1.FormCreate(Sender: TObject);
var qw:TLargeInteger;
begin
MoveFrameShow:=0;
MyWidth :=Image1.Width;
MyHeight:=Image1.Height;
MyPolWidth:=Image1.Width div 2;
MyPolHeight:=Image1.Height div 2;
With Image1.Canvas do
Begin
Pen.Color:=ClBlack;
Brush.Color:=ClBlack;
Rectangle(0,0,MyWidth,MyHeight);
End;
if not ReadColorPallette ('gtc-ilda.plt') Then
ShowMessage('Can''''t read colors pallete! ');
ShowDevice:=nil;
PalleteTxt:='GTC-ILDA';
end;
procedure TForm1.Button1Click(Sender: TObject);
Var
I:Integer;
Str:String;
T1:TReadIldaFormat;
begin
button3.Click;
Str:=GetCurrentDir;
Try
if OpenDialog1.Execute Then
Begin
MyShow.CountFrame:=0;
T1:=TReadIldaFormat.CreateIt(OpenDialog1.FileName);
T1.WaitFor;
Begin
IF MyShow.CountFrame>0 Then
Begin
ShowOneBigKadr (0);
label6.Caption:=inttostr(myshow.CountFrame);
scrollbar4.Max:=myshow.CountFrame-1;
End;
End;
End;
except
End;
chDir(Str);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if ShowDevice<>nil Then
Begin
if ShowDevice.Suspended Then
Begin
button2.Caption:='PAUSE';
ShowDevice.Resume;
End
Else
Begin
button2.Caption:='Play';
ShowDevice.Suspend;
End;
End
Else
Begin
if MyShow.CountFrame>0 Then
Begin
button2.Caption:='PAUSE';
ShowDevice:=TShowToDevice.Create(True);
ShowDevice.FreeOnTerminate:=True;
ShowDevice.Resume;
End;
End;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
form1.Memo1.lines.Text:='';
if ShowDevice<>nil Then
Begin
if ShowDevice.Suspended Then ShowDevice.Resume;
ShowDevice.Terminate;
// ShowDevice.WaitFor;
button2.Caption:='Play';
ShowDevice:=Nil;
End
end;
procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
panel1.Caption:=inttostr(scrollbar1.Position);
end;
procedure TForm1.ScrollBar2Change(Sender: TObject);
begin
panel2.Caption:=inttostr(scrollbar2.Position);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
form1.panel3.Caption:=inttostr(round(form1.scanspeed/2));
form1.panel4.Caption:=inttostr(round(form1.framesspeed/2));
scanspeed:=0;
framesspeed:=0;
nrpoint:=0
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
if ShowDevice<>nil Then
Begin
if ShowDevice.Suspended Then ShowDevice.Resume;
ShowDevice.Terminate;
ShowDevice:=Nil;
End;
application.Terminate;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if ShowDevice<>nil Then
Begin
if ShowDevice.Suspended Then ShowDevice.Resume;
ShowDevice.Terminate;
ShowDevice:=Nil;
End;
application.Terminate;
end;
procedure TForm1.ScrollBar3Change(Sender: TObject);
begin
panel5.Caption:=inttostr(scrollbar3.Position);
end;
procedure TForm1.Label1Click(Sender: TObject);
begin
if MessageDlg(' GTC ILDA Player by C.C. and G.G. '+#13#10+#10+
' ALL RIGHTS RESERVED. '+#13#10+#10+
' For customizing please call '+#13+#10+#10+
' +40 723 778777 or +40 722 133204 '+#13+#10+#10+
' or use e-mail: sinelgy@yahoo.com ',
mtConfirmation, [mbok], 0) = mrYes then;
end;
procedure TForm1.ScrollBar4Change(Sender: TObject);
begin
ShowOneBigKadr (scrollbar4.Position);
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
if saveDialog1.Execute then
begin
form1.Memo2.lines.Text:='logo:'+form1.Memo1.lines.Text;
memo2.Lines.SaveToFile(SaveDialog1.FileName);
end;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
if saveDialog2.Execute then
begin
form1.Memo2.lines.Text:='frames:'+form1.Memo1.lines.Text;
form1.Memo2.lines.Text:=form1.Memo2.lines.Text+#13+'.dw 0';
memo2.Lines.SaveToFile(SaveDialog2.FileName);
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -