unit frmDisplay;

interface

uses
  XMLdoc, xmldom, XMLIntf, msxmldom, mshtml, activex,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, ExtCtrls;

type
  TPlayPlanData=packed record
    Playarea: Integer;
    StartTime: TTime;
    EndTime: TTime;
    PlayFile: string;
    Playing: Boolean;
  end;

  TPKSTSubTitlePlay = class(TThread)
  private
    Fx,Fy: Integer;
    FSpeed: Integer;
    FSubTitle: string;
    FCurSubTitle: string;
    FPlace: string;
    FDirection: string;
    FDisplayPnl: TPanel;
  protected
    procedure DrawsubTitle;
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;
    property Speed: Integer read FSpeed write FSpeed;
    property SubTitle: string read FSubTitle write FSubTitle;
    property Place: string read FPlace write FPlace;
    property Direction: string read FDirection write FDirection;
    property DisplayPnl: TPanel read FDisplayPnl write FDisplayPnl;
    procedure reset;
  published

  end;

  TDisplayForm = class(TForm)
    pnlMsg: TPanel;
    timerPlan: TTimer;
    pnlDisplay: TPanel;
    wbDisplay: TWebBrowser;
    Timer1: TTimer;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure timerPlanTimer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure pnlDisplayResize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    FSubTitlePlay: TPKSTSubTitlePlay;
    FChecking : Boolean;
    FUpdate : Boolean;
    FSubTitle : string;
    FSubPlace : string;
    FSubDir : string;
    FSubSpeed : Integer;
    FTemplet : string;
    FPlans : array of array of TPlayPlanData;

    { Private declarations }
  public
    procedure initschudle(FileName: string);
    procedure initSubTitle;
    procedure initDisplay;
    procedure ChangeDisplay(playarea: Integer; PlayFile: string);
    procedure ChangesSubTitle(Subtitle: string);
    { Public declarations }
  end;

implementation

uses Main, PKSTutils;


{$R *.dfm}

function FindElement(Collection: IHTMLElementCollection; ElementID: string; var Element: IDispatch): Boolean;
var
  i: Integer;
  C: IHTMLElement;
begin
  Result := false;
  Element := nil;
  Element := Collection.item(ElementID,null);
  if Element<> nil then
  begin
    Result := True;
    exit;
  end;
  for i := 0 to Collection.length-1 do
  begin
    C := Collection.item(i,null) as IHTMLElement;
    if C<>nil then
    begin
      Result := FindElement(c.children as IHTMLElementCollection, ElementID, Element);
      if Result then exit;
    end;
  end;
end;


procedure TDisplayForm.ChangeDisplay(playarea: Integer; PlayFile: string);
var
  HTMLDocument: IHTMLDocument2;
  Collection: IHTMLElementCollection;
  Element: IDispatch;
  function isimg(fn: string): Boolean;
  var
    ext: string;
  begin
    Result := False;
    ext := LowerCase(ExtractFileExt(fn));
    if ext = '.bmp' then
      Result := true;
    if ext = '.jpg' then
      Result := true;
    if ext = '.gif' then
      Result := true;
    if ext = '.png' then
      Result := true;
  end;
begin
  PlayFile := StringReplace(PlayFile,':','_',[rfReplaceAll]);
  PlayFile := StringReplace(PlayFile,'\','_',[rfReplaceAll]);
  PlayFile := SlashSep(PKSTClientForm._ClientController.RcvDir, PlayFile);
{}

  HTMLDocument := wbDisplay.Document as IHTMLDocument2;
  Collection := HTMLDocument.body.children as IHTMLElementCollection;
  if FindElement(Collection, 'GCPLAYAREA'+inttostr(playarea), Element) then
  begin
    if not FileExists(PlayFile) then
    begin
      (Element as IHTMLElement).innerHTML := '<table width="100%" height="100%"  '+
        'border="1" align="center" cellpadding="0" cellspacing="0" '+
        'bordercolor="#000000" bgcolor="#000000"><tr>'+
        '<td style="color: #FFFFFF; font-size: 72px;">'+
        '<div align="center">GRIDCOM</div></td></tr></table>';
      exit;
    end;
    if isimg(PlayFile) then
      (Element as IHTMLElement).innerHTML := '<img src="'+PlayFile+'" height="100%" width="100%" ></img>'
    else
      (Element as IHTMLElement).innerHTML := '<embed src="'+PlayFile+'" height="100%" width="100%" '+
        'scale="aspect" maintainaspect="true" '+
        'autoplay="true" controller="false" autostart="true" showcontrols="false" '+
        'controls="imagewindow" loop="true" playcount="0" numloop="0" prefetch="0" '+
        'nolabels="true"  showstatusbar="false" showdisplay="false" bgcolor="#000000" '+
        'showtracker="false" showcaptioning="false"></embed>';
  end;
  HTMLDocument.close;
end;

procedure TDisplayForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caHide;
end;

procedure TDisplayForm.FormCreate(Sender: TObject);
var
  vv: Variant;
  HTMLDocument: IHTMLDocument2;
begin
  OleInitialize(nil);
  wbDisplay.Navigate('about:blank');
  vv := VarArrayCreate([0,0],varVariant);
  vv[0] := '<html><body leftmargin=0 topmargin=0 scroll=no border=no>'+
    '<table width="100%" height="100%"  border="1" align="center" '+
    'cellpadding="0" cellspacing="0" bordercolor="#000000" '+
    'bgcolor="#000000"><tr><td style="color: #FFFFFF; font-size: 72px;">'+
    '<div align="center">GRIDCOM</div></td></tr></table></body></html>';
  HTMLDocument := wbDisplay.Document as IHTMLDocument2;
  HTMLDocument.write(PSafeArray(TVarData(vv).VArray));
  vv := Unassigned;
  HTMLDocument.close;
  FSubPlace := '';
  FSubDir := '';
  FTemplet := '';
  FChecking := false;
  FUpdate := false;
  FSubTitlePlay := TPKSTSubTitlePlay.Create;
  FSubTitlePlay.FDisplayPnl := pnlMsg;
end;

procedure TDisplayForm.initDisplay;
var
  vv: Variant;
  HTMLDocument: IHTMLDocument2;
begin
  wbDisplay.Visible := false;
  pnlDisplay.update;
  Invalidate;
  vv := VarArrayCreate([0,0],varVariant);
  vv[0] := FTemplet;
  HTMLDocument := wbDisplay.Document as IHTMLDocument2;
  HTMLDocument.write(PSafeArray(TVarData(vv).VArray));
  vv := Unassigned;
  HTMLDocument.close;
  wbDisplay.Visible := True;
end;

procedure TDisplayForm.initschudle(FileName: string);
var
  XML: TXMLDocument;
  RootNode: IXMLNode;
  Node: IXMLNode;
  DNode: IXMLNode;
  PNode: IXMLNode;
  style: TFontStyles;
  i,j: Integer;
  place : Integer;
  Count : Integer;
begin
  if Not FileExists(FileName) then exit;
  XML := TXMLDocument.Create(self);
  XML.FileName := FileName;
  XML.Active := true;
  try
    RootNode := XML.ChildNodes.FindNode('scheduler');
    if RootNode=nil then
      Exit;
    Node := RootNode.ChildNodes.FindNode('subtitle');
    if Node<> nil then
    begin
      pnlMsg.Visible := not StrToBoolDef(Node.Attributes['nosubtitle'], True);
      if pnlMsg.Visible then
      begin
        FSubPlace := Node.ChildValues['place'];
        FSubDir := Node.ChildValues['direction'];
        FSubSpeed := StrToInt(Node.ChildValues['speed']);
        Node := Node.ChildNodes.FindNode('font');
        if Node<>nil then
        begin
          pnlMsg.Font.Name := Node.Attributes['name'];
          pnlMsg.Font.Color := Tcolor(StrToInt('$'+Node.Attributes['color']));
          pnlMsg.Font.Size := StrToInt(Node.Attributes['size']);
          style := [];
          if StrToBool(Node.Attributes['bold']) then
            include(style, fsBold);
          if StrToBool(Node.Attributes['italic']) then
            include(style, fsitalic);
          if StrToBool(Node.Attributes['underline']) then
            include(style, fsunderline);
          if StrToBool(Node.Attributes['strikeout']) then
            include(style, fsstrikeout);
          pnlMsg.Font.Style := style;
        end;
        initSubTitle;
      end;
    end;

    Node := RootNode.ChildNodes.FindNode('templet');
    if Node<> nil then
    begin
      FTemplet := Node.ChildNodes.Nodes[0].Text;
      initDisplay;
    end;

    Node := RootNode.ChildNodes.FindNode('plan');
    if Node<> nil then
    begin
      while FChecking do
        Application.ProcessMessages;
      FUpdate := true;
      Count := 0;
      setlength(FPlans, 0);
      setlength(FPlans, Node.ChildNodes.Count);

      for i:= 0 to Node.ChildNodes.Count-1 do
      begin
        DNode := Node.ChildNodes.FindNode('displayarea'+IntToStr(i+1));
        if DNode<>nil then
        begin
          SetLength(FPlans[i], 0);
          SetLength(FPlans[i], DNode.ChildNodes.Count);
          for j:= 0 to Dnode.ChildNodes.Count-1 do
          begin
            PNode := Dnode.ChildNodes.Nodes[j];
            if (PNode<>nil) and (PNode.NodeName<>'planitem') then
              FPlans[i,j].Playarea := 0
            else
            begin
              FPlans[i,j].Playarea := i+1;
              FPlans[i,j].PlayFile := PNode.Attributes['filename'];
              FPlans[i,j].StartTime := StrToTime(PNode.Attributes['start']);
              FPlans[i,j].EndTime := StrToTime(PNode.Attributes['end']);
              FPlans[i,j].Playing := False;
            end;
          end;
        end;
      end;
      FUpdate := False;
    end;
  finally
    XML.Free;
  end;
end;

procedure TDisplayForm.timerPlanTimer(Sender: TObject);
var
  i, j: integer;
  nowtime: TTime;
  HaveChange: Boolean;
begin
  HaveChange := false;
  if FUpdate then
    exit;
  timerPlan.Enabled := false;
  FChecking := true;
  nowtime := Time;
  for i:= low(FPlans) to High(FPlans) do
  begin
    for j:= low(FPlans[i]) to High(FPlans[i]) do
    begin
      if FPlans[i,j].Playarea = 0 then
        Continue;
      if TimeToStr(FPlans[i,j].EndTime) <> '0:00:00' then
      begin
        if FPlans[i,j].EndTime <= nowtime then
        begin
          if FPlans[i,j].Playing then
          begin
            FPlans[i,j].Playing := false
          end;
          Continue;
        end;
      end;
      if FPlans[i,j].StartTime >= nowtime then
        Continue;
      if FPlans[i,j].Playing then continue;
      FPlans[i,j].Playing := true;
      HaveChange := True;
      ChangeDisplay(i+1, FPlans[i,j].PlayFile);
    end;
  end;

  if HaveChange then
  begin
//
  end;
  FChecking := False;
  timerPlan.Enabled := True;
end;

procedure TDisplayForm.FormDestroy(Sender: TObject);
begin
  FSubTitlePlay.Terminate;
  OleunInitialize;
end;

{ TPKSTSubTitlePlay }

constructor TPKSTSubTitlePlay.Create;
begin
  inherited Create(True);
  FreeOnTerminate := True;
  Priority := tpIdle;
end;

destructor TPKSTSubTitlePlay.Destroy;
begin
  inherited;
end;

procedure TPKSTSubTitlePlay.DrawsubTitle;
var
  DC: HDC;
  Canvas: TCanvas;
  Rect: Trect;
//  Tick: Cardinal;
begin
  FDisplayPnl.Brush.Color := clBlack;
  DC := GetDC(FDisplayPnl.Handle);
  Canvas := TCanvas.Create;
  Canvas.Handle := DC;
  Canvas.Font := FDisplayPnl.Font;
  Canvas.Brush := FDisplayPnl.Brush;
  Canvas.Lock;
  Canvas.TextRect(Canvas.ClipRect, Fx, FY, FCurSubTitle);
  Rect := FDisplayPnl.ClientRect;
  ExtTextOut(DC, FX, FY, ETO_OPAQUE, @Rect, Pchar(FCurSubTitle), Length(FCurSubTitle), nil);
  Canvas.Unlock;
  Canvas.Free;
  ReleaseDC(FDisplayPnl.Handle, DC);
//  Tick := GetTickCount;
{  while GetTickCount-Tick<100 do
  begin
    Application.ProcessMessages;
  end;{}
end;

procedure TPKSTSubTitlePlay.Execute;
var
  DC: HDC;
  Size: TSize;
  Tick: Cardinal;
begin
  while not Terminated do
  begin
    if FCurSubTitle='' then
      FCurSubTitle := '欢迎使用GridCom!!';
    DC := GetDC(FDisplayPnl.Handle);
//    SetTextAlign
    GetTextExtentPoint32(DC, PChar(FCurSubTitle), Length(FCurSubTitle), Size);
    ReleaseDC(FDisplayPnl.Handle, DC);
    if (FPlace = '底部') or (FPlace = '顶部') then
    begin
      if FDirection='从左到右' then
      begin
        if FX>FDisplayPnl.Width then
        begin
          FX := -Size.cx;
          Fy := 2;
          FCurSubTitle := FSubTitle;
          Continue;
        end
        else
          Fx := FX + 1 + FSpeed;
      end;

      if FDirection='从右到左' then
      begin
        if (FX < -Size.cx) or (FX=10000) then
        begin
          FX := FDisplayPnl.Width;
          Fy := 2;
          FCurSubTitle := FSubTitle;
          Continue;
        end
        else
          Fx := FX - (1 + FSpeed);
      end;
    end;

    if (FPlace = '左边') or (FPlace = '右边') then
    begin
      if FDirection='从上到下' then
      begin
        if FY>FDisplayPnl.Height then
        begin
          FX := 2;
          Fy := -Size.cy;
          FCurSubTitle := FSubTitle;
          Continue;
        end
        else
          Fy := Fy + 1 + FSpeed;
      end;

      if FDirection='从下到上' then
      begin
        if (Fy < -Size.cy) or (Fy=10000) then
        begin
          FX := 2;
          FY := FDisplayPnl.Height;
          FCurSubTitle := FSubTitle;
          Continue;
        end
        else
          Fy := Fy - (1 + FSpeed);
      end;
    end;
    Synchronize(DrawsubTitle);
    WaitForSingleObject(Handle, 50);
  end;
end;

procedure TPKSTSubTitlePlay.reset;
begin
  FX := 10000;
  FY := 10000;
end;

procedure TDisplayForm.initSubTitle;
begin
  if not pnlMsg.Visible then
  begin
    FSubTitlePlay.Suspend;
    exit;
  end;
  if FSubPlace = '顶部' then
    pnlMsg.Align := alTop;
  if FSubPlace = '底部' then
    pnlMsg.Align := alBottom;
  if FSubPlace = '左边' then
    pnlMsg.Align := alLeft;
  if FSubPlace = '右边' then
    pnlMsg.Align := alRight;

  FSubTitlePlay.Speed := FSubSpeed;
  FSubTitlePlay.SubTitle := FSubTitle;
  FSubTitlePlay.Place := FSubPlace;
  FSubTitlePlay.Direction := FSubDir;
  FSubTitlePlay.reset;
  FSubTitlePlay.Resume;
end;

procedure TDisplayForm.ChangesSubTitle(Subtitle: string);
begin
  if Assigned(FSubTitlePlay) then
    FSubTitlePlay.SubTitle := Subtitle;
end;

procedure TDisplayForm.pnlDisplayResize(Sender: TObject);
begin
  wbDisplay.Width := pnlDisplay.Width+4;
  wbDisplay.Height := pnlDisplay.Height+4;
end;

procedure TDisplayForm.Timer1Timer(Sender: TObject);
var
  DC: HDC;
  Size: TSize;
  Tick: Cardinal;
begin
  with FSubTitlePlay do
  begin
    if FCurSubTitle='' then
      FCurSubTitle := '欢迎使用GridCom!!';
    DC := GetDC(FDisplayPnl.Handle);
//    SetTextAlign
    GetTextExtentPoint32(DC, PChar(FCurSubTitle), Length(FCurSubTitle), Size);
    ReleaseDC(FDisplayPnl.Handle, DC);
    if (FPlace = '底部') or (FPlace = '顶部') then
    begin
      if FDirection='从左到右' then
      begin
        if FX>FDisplayPnl.Width then
        begin
          FX := -Size.cx;
          Fy := 2;
          FCurSubTitle := FSubTitle;
          Timer1Timer(Timer1);
          exit;
        end
        else
          Fx := FX + 1 + FSpeed;
      end;

      if FDirection='从右到左' then
      begin
        if (FX < -Size.cx) or (FX=10000) then
        begin
          FX := FDisplayPnl.Width;
          Fy := 2;
          FCurSubTitle := FSubTitle;
          Timer1Timer(Timer1);
          exit;
        end
        else
          Fx := FX - (1 + FSpeed);
      end;
    end;

    if (FPlace = '左边') or (FPlace = '右边') then
    begin
      if FDirection='从上到下' then
      begin
        if FY>FDisplayPnl.Height then
        begin
          FX := 2;
          Fy := -Size.cy;
          FCurSubTitle := FSubTitle;
          Timer1Timer(Timer1);
          exit;
        end
        else
          Fy := Fy + 1 + FSpeed;
      end;

      if FDirection='从下到上' then
      begin
        if (Fy < -Size.cy) or (Fy=10000) then
        begin
          FX := 2;
          FY := FDisplayPnl.Height;
          FCurSubTitle := FSubTitle;
          Timer1Timer(Timer1);
          exit;
        end
        else
          Fy := Fy - (1 + FSpeed);
      end;
    end;
    DrawsubTitle;
//    WaitForSingleObject(Handle, 100);
  end;   {}
end;

end.
