jkdvc.pas

程序主要是在监控系统中的车辆检测与其他设备协议的测试程序

unit JKDvc;

interface
uses ExtCtrls,Dialogs,SysUtils,Classes,controls,windows,messages,Graphics,Grids,
     stdctrls, Buttons,cmsitemDefine,forms;

type
  TDvc = class
  private
    FID:string;
    FCName :string;
    FEName :string;
    FLocation :string;
    FFactory  :string;
     
    procedure setID(const Value: string);
    procedure setCName(const Value: string);
    procedure setEName(const Value: string);
    procedure setFactory(const Value: string);
    procedure setLocation(const Value: string);
  public
    property  ID :string read FID write setID;
    property  CName :string read FCName write setCName;
    property  EName :string read FEName write setEName;
    property  Location :string  read FLocation write setLocation;
    property  Factory  :string  read FFactory  write setFactory;
  end;


  //////////////////////////////////////////////////////////////////////////////
  //情报板数据显示面板
  TCMSPanel = class(TPanel)
  private
    pBwidth:integer;
    fCMSwidth :integer;
    fCMSheight :integer;
    Fcmssize:string;
    fDvcinfo    :TDvc;
    PanelCap: TPanel;
    PanelMoNi: TPanel;

    TimerCMSPlay: TTimer;
    bCmsInfoIsNull:boolean;
    CurPlayNo :integer;
    fCMSPubInfo:TCMSPublishInfo;

    oldwinProc: TWndMethod;
    procedure myWindowProc(var msg:TMessage);
    procedure setCMSSize(const Value: string);
    procedure setDvcinfo(const Value: TDvc);
    procedure setCMSPubInfo(const Value: TCMSPublishInfo);
  public
    CMSbmpPath :string;
    gpath      :string;
    Caption    :string;
    Constructor Create(AOwner:TComponent);override;
    destructor  Destroy;override;
    procedure myMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure createPlayText(fcmstxt :TCMSTXT;fNo:integer;fPanel:TPanel);
    procedure createPlayBmp(myCmsbmp :TCMSBMP; fNo: integer;fPanel:TPanel);
    procedure CmsPreviewPlay( fCMSPlayLeaf :TCMSDisplayLeaf;fPanel:TPanel;fModify:boolean);
    procedure FlashPlay(Sender: TObject);
  published
    property  CMSSize  :string  read fCMSSize write setCMSSize ;
    property  CMSwidth  :integer  read fCMSwidth  ;
    property  CMSheight  :integer  read fCMSheight  ;
    property  Dvcinfo:TDvc read fDvcinfo write setDvcinfo;
    property  CMSPubInfo :TCMSPublishInfo read fCMSPubInfo write setCMSPubInfo;
  end;

  //////////////////////////////////////////////////////////////////////////////
  //车检器数据显示面板
  TVDPanel = class(TPanel)
    private
      fDvcinfo :TDvc;
      PanelCap: TPanel;
      SGridVD: TStringGrid;
      oldwinProc: TWndMethod;
      procedure  myWindowProc(var msg:TMessage);
    procedure setDvcinfo(const Value: TDvc);
    public
      Constructor Create(AOwner:TComponent);override;
      destructor Destroy;override;
      procedure  myMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    published
      property  Dvcinfo:TDvc read fDvcinfo write setDvcinfo;
  end;


implementation

{ TDvc }

procedure TDvc.setCName(const Value: string);
begin
  FCName := Value;
end;

procedure TDvc.setEName(const Value: string);
begin
  FEName := Value;
end;

procedure TDvc.setFactory(const Value: string);
begin
  FFactory := Value;
end;

procedure TDvc.setID(const Value: string);
begin
  FID := Value;
end;

procedure TDvc.setLocation(const Value: string);
begin
  FLocation := Value;
end;

{ TCMSDvc }

constructor TCMSPanel.Create(AOwner:TComponent );
begin
  inherited;

   PanelCap :=TPanel.Create(self);
   PanelCap.Parent:=self;
   PanelCap.Color :=clBlue;
   PanelCap.Font.Color :=clWhite;
   PanelCap.Height :=25;
   PanelCap.ShowHint :=true;


   PanelCap.OnMouseDown := myMouseDown;
   oldwinProc:= PanelCap.WindowProc;       //**********************************
   PanelCap.WindowProc:= myWindowProc ;    //*********************************

   PanelMoNi :=TPanel.Create(self);
   PanelMoNi.Parent:=self;
   PanelMoNi.Color :=clBlack;
   PanelMoNi.Left:=0;

   PanelMoNi.OnMouseDown := myMouseDown;

   TimerCMSPlay :=TTimer.create(self);
   TimerCMSPlay.Interval:=2000;
   TimerCMSPlay.Enabled :=false;
   TimerCMSPlay.OnTimer:=   FlashPlay ;

   CurPlayNo:=1;
   self.Hide;
   pBwidth:=  PanelMoNi.BevelWidth;
   fDvcinfo:=TDvc.Create;
end;

destructor TCMSPanel.Destroy;
begin
  PanelCap.OnMouseDown :=nil;   //否则在双击关闭的时候， 会报异常。
  PanelMoNi.OnMouseDown :=nil;  //否则会报异常。
  PanelMoNi.Free;
  PanelCap.free;
  fDvcinfo.Free;
  inherited;
end;
 
 



procedure TCMSPanel.myMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 if (button =mbleft) and ( handle >0)  then
 begin
    ReleaseCapture;
    if handle >0 then SendMessage(handle, WM_NCLBUTTONDOWN, HTCAPTION, 0);
 end;
end;



 

procedure TCMSPanel.setDvcinfo(const Value: TDvc);
begin
  fDvcinfo := Value;
  PanelCap.Hint :='设备 ID ：'+ Value.ID+#13#10+
                  '设备名称：'+ Value.CName+#13#10+
                  '设备名称：'+ Value.Location;
  PanelCap.Caption :=Value.Location;
end;

procedure TCMSPanel.setCMSSize(const Value: string);
begin
  if Pos('*',Value)=0 then   exit; 
  if  fCMSSize <> Value  then
  begin
    fCMSSize := Value;
    fCMSwidth := strtoint(copy(fCMSSize,1,pos('*',fCMSSize)-1));
    fCmsHeight := strtoint(copy(fCMSSize,pos('*',fCMSSize)+1,length(fCMSSize)-pos('*',fCMSSize)));
    PanelMoNi.Width := CMSwidth  + pBwidth*2;
    PanelMoNi.Height:= CmsHeight + pBwidth*2;
    
    PanelMoNi.Top :=PanelCap.Height;
    PanelCap.Width := PanelMoNi.Width;
    self.AutoSize :=true;
    
    if CmsHeight=32 then   CMSbmpPath:= gpath+'MCMSBMP\'
    else if CmsHeight=48   then   CMSbmpPath:=gpath+'SCMSBMP\'
    else if CmsHeight=96   then   CMSbmpPath:=gpath+'TCMSBMP\'; 
  end;

end;

procedure TCMSPanel.myWindowProc(var msg: TMessage);
begin
  oldwinProc(msg);
  if  msg.Msg= WM_LBUTTONDBLCLK   then
  begin
      self.Free;
  end;
end;

 
////////////////////////////////////////////////////////////////////////////////
// 函数名称:  createPlayBmp
// 函数参数：  fbmpFile: 图片文件名称; fNo -图片编号     mycmsbmp :TCMSBMP;
// 函数返回值：
// 编写日期:  2006-01-08
// 编写作者:  djh
// 函数功能:  创建一个图片在可变信息标志上
////////////////////////////////////////////////////////////////////////////////
procedure TCMSPanel.createPlayBmp(myCmsbmp :TCMSBMP; fNo: integer;fPanel:TPanel);
var bmpFile:string;
begin
  with Timage.Create(fPanel) do
  begin
    Parent := fPanel;
    Name :='imageCMS'+ inttostr(fNo);
    Left := pBwidth + myCmsbmp.X;
    top  := pBwidth + myCmsbmp.Y ;
   // Transparent :=true;
    AutoSize :=true;
    bmpFile := CMSBmpPath+myCmsbmp.BmpName+'.bmp';
    Picture.LoadFromFile(bmpFile);
    Hint  :=myCmsbmp.BmpName;
  end;
end;


 
////////////////////////////////////////////////////////////////////////////////
// 函数名称:  createPlayText
// 函数参数： fcmstxt : 图片文件名称; fNo -图片编号
// 函数返回值：
// 编写日期:  2006-01-08
// 编写作者:  djh
// 函数功能:  创建一个字符串图 在可变信息标志上
////////////////////////////////////////////////////////////////////////////////
procedure TCMSPanel.createPlayText(fcmstxt :TCMSTXT;fNo:integer;fPanel:TPanel);
var
  i,rows,cols:integer;
  ss,fPlaytxt:string;
begin
  for i :=1  to fcmstxt.Txtcount   do
    fPlaytxt:= fPlaytxt+fcmstxt.Txtstring[i];
  with  TLabel.Create(PanelMoNi) do
  begin
     if fNo>0 then  Name := 'labelCMS'+inttostr(fNo);
     Parent := PanelMoNi;
     Left := pBwidth+ fcmstxt.XPos;
     top  := pBwidth+ fcmstxt.YPos;
     Width := CMSwidth  - Left;
     Height:= CmsHeight - top;
 
     cols := CMSwidth div (fcmstxt.FSize div 2);
     Caption :=fPlaytxt; 

     AutoSize := true;
     ParentFont := false;
     font.Charset :=  DEFAULT_CHARSET;
     Font.Color :=fcmstxt.FColor;
     if fcmstxt.FStype=1 then Font.Name :='黑体'
     else if fcmstxt.FStype=2 then Font.Name :='楷体_GB2312'
     else if fcmstxt.FStype=3 then Font.Name :='宋体';
     Font.Size  := round(fcmstxt.FSize/1.35 );
     Transparent :=true;
     Tag :=fcmstxt.FSize;
  end;
end;



procedure TCMSPanel.CmsPreviewPlay( fCMSPlayLeaf :TCMSDisplayLeaf;fPanel:TPanel;fModify:boolean);
var i, j:integer;
  mycmstxt :TCMSTXT;
  mycmsbmp :TCMSBMP;
begin
  while fPanel.ComponentCount>0 do  fPanel.Components[0].Free;
  j:=0;
  while j< fCMSPlayLeaf.BmpCount do
  begin
     inc(j);
     mycmsbmp:=  fCMSPlayLeaf.cmsbmpItem[j];
     if fModify then
       createPlayBmp(mycmsbmp,j,fPanel)
     else
       createPlayBmp(mycmsbmp,0,fPanel);
  end;
  ////////////////////////////////////////////////////////
  j:=0;
  while j < fCMSPlayLeaf.TxtCount do
  begin
     inc(j);
     mycmstxt:= fCMSPlayLeaf.cmsTxtItem[j];
     if fModify then
       createPlayText(mycmstxt,j,fPanel)
     else
       createPlayText(mycmstxt,0,fPanel);
  end;
end;


procedure TCMSPanel.setCMSPubInfo(const Value: TCMSPublishInfo);
begin
  fCMSPubInfo := Value;
  if fCMSPubInfo.LeafCount>0 then    TimerCMSPlay.Enabled:=true;
end;


procedure TCMSPanel.FlashPlay(Sender: TObject);
begin
  if  CurPlayNo > fCMSPubInfo.LeafCount then CurPlayNo :=1;
  CmsPreviewPlay( fCMSPubInfo.CMSPlayItems[CurPlayNo],PanelMoNi,false);
  Inc(CurPlayNo );
  Application.ProcessMessages;
end;


/////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////
////////////////////////////车辆检测器显示面板定义///////////////////////////////
/////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////
{ TVDPanel }

constructor TVDPanel.Create(AOwner: TComponent);
var i:integer;
begin
  inherited;
    PanelCap:=TPanel.Create(self);
    PanelCap.Parent:=self;
    PanelCap.Color :=clBlue;
    PanelCap.Font.Color :=clWhite;
    PanelCap.ShowHint :=true;
    PanelCap.SetBounds(0,0,290,26) ;
    PanelCap.OnMouseDown := myMouseDown;

    oldwinProc:= PanelCap.WindowProc;       //**********************************
    PanelCap.WindowProc:= myWindowProc ;    //*********************************

    SGridVD :=TStringGrid.Create( self);
    SGridVD.Parent :=self;
    SGridVD.SetBounds(0,PanelCap.Height,290,110) ;
    SGridVD.Color := clGreen;
    SGridVD.FixedColor := clGreen;
    SGridVD.Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRowSelect];
    SGridVD.Font.Size :=10;
    SGridVD.Font.Color:=clWhite;
    SGridVD.FixedRows :=1;
    SGridVD.FixedCols :=1;
    SGridVD.RowCount:=4;
    SGridVD.ColCount:=4;
    SGridVD.ColWidths[0] :=40 ;
    SGridVD.Cells[0,1] :=' 上行';
    SGridVD.Cells[0,2] :=' 下行';
    SGridVD.Cells[0,3] :=' 合计';

    SGridVD.Cells[1,0] :=' 车流量(辆)';
    SGridVD.Cells[2,0] :=' 平均速度(KM/H)';
    SGridVD.Cells[3,0] :=' 占有率(%)';

    SGridVD.ColWidths[1] := 70;
    SGridVD.ColWidths[2] := 100;
    SGridVD.ColWidths[3] := 70;
    for i:=1 to 3 do
    begin
      SGridVD.Cells[1,i] :=' 10';
      SGridVD.Cells[2,i] :=' 20';
      SGridVD.Cells[3,i] :=' 5';
    end;

    self.AutoSize :=true;
    fDvcinfo:=TDvc.Create;

end;

destructor TVDPanel.Destroy;
begin
  PanelCap.Free;
  SGridVD.Free;
  inherited;
end;



procedure TVDPanel.myMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 if (button =mbleft) and ( handle >0)  then
 begin
    ReleaseCapture;
    if handle >0 then SendMessage(handle, WM_NCLBUTTONDOWN, HTCAPTION, 0);
 end;
end;

procedure TVDPanel.setDvcinfo(const Value: TDvc);
begin
  fDvcinfo := Value;
  PanelCap.Hint :='设备 ID ：'+ Value.ID+#13#10+
                  '设备名称：'+ Value.CName+#13#10+
                  '设备名称：'+ Value.Location;
  PanelCap.Caption :=Value.Location;
end;



procedure TVDPanel.myWindowProc(var msg: TMessage);
begin
  oldwinProc(msg);
  if  msg.Msg= WM_LBUTTONDBLCLK   then
  begin
      self.Free;
  end;
end;


end.