?? 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;
//////////////////////////////////////////////////////////////////////////////
//情報板數(shù)據(jù)顯示面板
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;
//////////////////////////////////////////////////////////////////////////////
//車檢器數(shù)據(jù)顯示面板
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; //否則在雙擊關(guān)閉的時候， 會報異常。
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 :='設(shè)備 ID ：'+ Value.ID+#13#10+
'設(shè)備名稱：'+ Value.CName+#13#10+
'設(shè)備名稱：'+ 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;
////////////////////////////////////////////////////////////////////////////////
// 函數(shù)名稱: createPlayBmp
// 函數(shù)參數(shù)： fbmpFile: 圖片文件名稱; fNo -圖片編號 mycmsbmp :TCMSBMP;
// 函數(shù)返回值：
// 編寫日期: 2006-01-08
// 編寫作者: djh
// 函數(shù)功能: 創(chuàng)建一個圖片在可變信息標志上
////////////////////////////////////////////////////////////////////////////////
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;
////////////////////////////////////////////////////////////////////////////////
// 函數(shù)名稱: createPlayText
// 函數(shù)參數(shù)： fcmstxt : 圖片文件名稱; fNo -圖片編號
// 函數(shù)返回值：
// 編寫日期: 2006-01-08
// 編寫作者: djh
// 函數(shù)功能: 創(chuàng)建一個字符串圖 在可變信息標志上
////////////////////////////////////////////////////////////////////////////////
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 :='設(shè)備 ID ：'+ Value.ID+#13#10+
'設(shè)備名稱：'+ Value.CName+#13#10+
'設(shè)備名稱：'+ 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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -