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

📄 unit1.pas

📁 ilda file player and converter ilda to hex files for delphi 7
💻 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 + -