一台车有多个摄像头,一天时间每天摄像头有断续录像,要可视化显示出来,每个通道(摄像头)那个时间段有录像,鼠标点击能选中通道和对应的时间点并且可视化显示出来。
直观方便。 每选一台车就获取一次数据源,解释json一次。 生成对象,每次重绘就去根据对象数据画就好了。
本例子
type Tregion = class public fR: TGPRect; begintime, endtime: TDateTime; //后面要改成整形 int end; TChannel = class public regionList: TList<Tregion>; name: string; order: Integer; end; TCar = class private public // 应该有 宽 高 车牌号,通讯号,和传过来的字符串 ChannelList: TList<TChannel>; REGISTRATIONNO, Commno: string; fCarRect: Trect; end;
出现的问题 在下方描述:
unit uJsonTest; { 有两个情形: 1、如果直接画在窗体的canvas中,窗体拖动屏幕外面再拖回来画面消失(不懂怎么解决)。 如果在FormPaint画会造成画面闪烁。OnResize中画正常。 2、如果画在一个放大的image的canvas中,窗体拖动屏幕外面再拖回来画面不会消失, 不需要在FormPaint中画。但 OnResize中画时却造成iamge右边有一片空白了(异常不知道如何解决)。 模式切换:在FormCreate(Sender: TObject); mode := false; //切换情形 1true 2 false 打开窗体 点击绘制按钮 2020-10-13 09:14:04 情形2 的问题解决了。 } interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons, superobject, Vcl.ExtCtrls, Vcl.Imaging.jpeg, uChannel, System.Generics.Collections, Winapi.GDIPAPI, System.DateUtils, Winapi.GDIPOBJ; type TDrawForm = class(TForm) mmo1: TMemo; img1: TImage; btnreadJson: TButton; btndraw: TButton; pnlLine: TPanel; lbltime: TLabel; tmr1: TTimer; mmo2: TMemo; procedure btnreadJsonClick(Sender: TObject); procedure FormResize(Sender: TObject); procedure btndrawClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure img1Click(Sender: TObject); procedure img1DblClick(Sender: TObject); procedure img1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure img1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure tmr1Timer(Sender: TObject); private // fTop,fbuttom,fLet,fRight:integer; drawWidth, rowCnt: Integer; car: TCar; fLeft: Integer; mode, HaveReadJson: boolean; SelectCommno: string; curDatetime: Tdatetime; pt: TPoint; StartTime, EndTime: cardinal; OnlySingleClick: boolean; public { Public declarations } end; const fTop = 105; fbuttom = 5; fRight = 8; // 绘制区预保留右边空间 drawH = 25; // 绘制每一行通道的高度 TimeLineH = 20; // 刻度区高度包括文字 Part = 24; // 24等分 Graduate = 7; // 刻度高度 var DrawForm: TDrawForm; implementation {$R *.dfm} function Str2ToDatetime(DateStr: string): Tdatetime; // 将yyyymmddhhnnss格式的字符串转为时间格式 var fs: TFormatSettings; begin Insert(':', DateStr, 13); Insert(':', DateStr, 11); Insert(' ', DateStr, 9); Insert('-', DateStr, 7); Insert('-', DateStr, 5); fs.DateSeparator := '-'; fs.TimeSeparator := ':'; fs.ShortDateFormat := 'yyyy-mm-dd'; fs.ShortTimeFormat := 'hh:nn:ss'; Result := StrToDateTimeDef(DateStr, 0, fs); end; procedure TDrawForm.FormCreate(Sender: TObject); begin mode := false; // 切换情形 1 true 2 false fLeft := 8; lbltime.Left := -5; if not mode then begin img1.Align := alclient; end; pnlLine.Width := 1; pnlLine.Visible := false; btnreadJson.Click; end; procedure TDrawForm.btnreadJsonClick(Sender: TObject); var Jsonstr: String; ChannelList: TSuperArray; ACArray: TSuperArray; i, j: Integer; jsonNode: ISuperObject; channel: TChannel; region: Tregion; begin jsonNode := SO(mmo1.Text); ChannelList := jsonNode.A['ChannelList']; car := TCar.Create; car.REGISTRATIONNO := jsonNode.s['REGISTRATIONNO']; car.Commno := jsonNode.s['Commno']; car.ChannelList := TList<TChannel>.Create; rowCnt := ChannelList.Length; drawWidth := self.Width - fLeft - fRight; drawWidth := drawWidth div Part * Part; fLeft := (self.Width - drawWidth) div 2; car.fCarRect.Create(fLeft, fTop, fLeft + drawWidth, fTop + rowCnt * drawH); pnlLine.Height := ChannelList.Length * drawH; pnlLine.Left := -1; pnlLine.Top := fTop; lbltime.Top := fTop; pnlLine.Visible := true; for i := 0 to ChannelList.Length - 1 do begin HaveReadJson := true; // 放这里是为了要有通道 才... channel := TChannel.Create; channel.name := '通道' + ChannelList.O[i].s['name']; channel.order := ChannelList.O[i].i['order']; // channel.fRect:=nil; car.ChannelList.Add(channel); channel.regionList := TList<Tregion>.Create(); ACArray := ChannelList.O[i].A['regionList']; for j := 0 to ACArray.Length - 1 do begin region := Tregion.Create; region.begintime := Str2ToDatetime(ACArray.O[j].s['begintime']); region.EndTime := Str2ToDatetime(ACArray.O[j].s['endtime']); channel.regionList.Add(region); curDatetime := region.begintime; // sss end; end; StartTime := GetTickCount; end; procedure TDrawForm.btndrawClick(Sender: TObject); var i, j: Integer; Graphics: TGPGraphics; opaquePen, semiTransPen: TGPPen; rect: TGPRect; region: Tregion; fCanvas: Tcanvas; Rect1: Trect; begin if mode then begin self.Repaint; fCanvas := self.Canvas; // 情形1 end else begin fCanvas := img1.Canvas; // 情形2 img1.Align := alclient; // 如果用图片绘制会有右边一片空白异常。感谢网友 [布吉]周黔76557298 帮忙 Rect1.Left := 0; Rect1.Top := 0; Rect1.Right := img1.Width; Rect1.Bottom := img1.Height; with img1 do begin Picture.Graphic.Width := Rect1.Right; Picture.Graphic.Height := Rect1.Bottom; Height := Rect1.Bottom; Width := Rect1.Right; end; fCanvas.FillRect(Rect1); fCanvas.Brush.Color := clwhite; { 设置画刷颜色, 也就是填充色 } fCanvas.FillRect(Rect1); { 填充窗体客户区 } end; img1.Width := self.Width; rowCnt := car.ChannelList.Count; // showmessage(inttostr(rowCnt)); self.Height := fTop + fbuttom + TimeLineH + rowCnt * drawH; // showmessage(inttostr(Height)); // 设定窗体高度 drawWidth := self.Width - fLeft - fRight; drawWidth := drawWidth div Part * Part; fLeft := (self.Width - drawWidth) div 2; car.fCarRect.Create(fLeft, fTop, fLeft + drawWidth, fTop + rowCnt * drawH); // 窗体变化的时候需要计算 fCanvas.Font.Size := 8; fCanvas.Font.Style := []; fCanvas.Font.Color := $00464646; // clBlue fCanvas.Brush.Style := bsClear; fCanvas.Pen.Color := clSilver; Graphics := TGPGraphics.Create(fCanvas.Handle); // Picture.Bitmap. opaquePen := TGPPen.Create(MakeColor(255, 153, 204, 255), drawH - 4); // 设定一个笔 和颜色 和画笔的高度 for i := 0 to rowCnt - 1 do begin fCanvas.MoveTo(fLeft, fTop + i * drawH); fCanvas.LineTo(fLeft + drawWidth, fTop + i * drawH); for j := 0 to car.ChannelList[i].regionList.Count - 1 do begin region := car.ChannelList[i].regionList[j]; region.fR := Makerect(fLeft + trunc(SecondOfTheDay(region.begintime) * drawWidth / 86400), fTop + i * drawH, trunc(SecondsBetween(region.begintime, region.EndTime) * drawWidth / 86400), drawH - 4); rect := region.fR; Graphics.DrawLine(opaquePen, rect.X, rect.Y + drawH div 2, rect.X + rect.Width, rect.Y + drawH div 2); // 其实就是画线, // fCanvas.MoveTo(rect.X, rect.Y+8); fCanvas.LineTo(rect.X+rect.Width, rect.Y+8); end; fCanvas.TextOut(fLeft + drawWidth div 2, fTop + i * drawH + 4, car.ChannelList[i].name); end; fCanvas.MoveTo(fLeft, fTop + rowCnt * drawH); fCanvas.LineTo(fLeft + drawWidth, fTop + rowCnt * drawH); // 添加刻度 fCanvas.Font.Color := $00464646; // clBlue clMaroon clSilver clblack for i := 0 to Part do begin fCanvas.MoveTo(fLeft + drawWidth div Part * i, fTop + rowCnt * drawH); fCanvas.LineTo(fLeft + drawWidth div Part * i, fTop + rowCnt * drawH + Graduate); if (i = 0) then begin fCanvas.TextOut(fLeft + drawWidth div Part * i, fTop + rowCnt * drawH + Graduate, inttostr(i)); end else if (i < 10) then begin fCanvas.TextOut(fLeft + drawWidth div Part * i - 2, fTop + rowCnt * drawH + Graduate, inttostr(i)); end else if (i = 24) then begin fCanvas.TextOut(fLeft + drawWidth div Part * i - 10, fTop + rowCnt * drawH + Graduate, inttostr(i)); end else begin fCanvas.TextOut(fLeft + drawWidth div Part * i - 4, fTop + rowCnt * drawH + Graduate, inttostr(i)); end; end; end; procedure TDrawForm.FormResize(Sender: TObject); begin if (car <> nil) then btndraw.Click; end; procedure TDrawForm.img1Click(Sender: TObject); begin // 如果在区域,获取xy坐标,移动panel 计算出时间,显示出来。 if HaveReadJson then begin tmr1.Enabled := true; // StartTime := GetTickCount; OnlySingleClick := true; // mmo1.Lines.Add('单击 ' + inttostr(GetTickCount)); // StartTime := EndTime; // if (EndTime - StartTime) < 700 then // begin // StartTime := EndTime; // exit; // end // else // StartTime := EndTime; end; // mmo1.Lines.Add('*** '+datetimetostr(selectdatetime)); end; procedure TDrawForm.img1DblClick(Sender: TObject); begin // showmessage(datetimetostr(selectdatetime)); // TControl.ControlStyle // mmo1.Lines.Add('双击 '+inttostr(GetTickCount)); // EndTime := GetTickCount; // if (EndTime - StartTime) < 200 then //之前本来想用 计算时间差来判断。但不理想 // begin // OnlySingleClick := false; // end OnlySingleClick := false; end; procedure TDrawForm.img1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var chanelIndex, bb: Integer; selectTime: string; cd: Double; begin if HaveReadJson then begin pt.Create(X, Y); end; end; procedure TDrawForm.img1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var chanelIndex, bb: Integer; selectTime: string; cd: Double; begin if HaveReadJson then // 如果鼠标移动跟着绘制线条会造成 识别不出 单击和双击。 可以试一下改成 定时器或线程执行 begin // pt.Create(X, Y); // // car.fCarRect // if car.fCarRect.Contains(pt) then // // begin // pnlLine.Left := X; // // chanelIndex:=(y-ftop)div drawH; // bb:=(X-fleft)*86400 div drawWidth; // cd:=bb/86400; // selectDatetime:= StartOfTheDay(curdatetime)+cd; // lbltime.Caption:=car.ChannelList[chanelIndex].name+' '+TimeToStr(selectDatetime); // //lbltime.Caption:=car.ChannelList[chanelIndex].name+' '+inttostr(bb); // if (X-fleft)>((20*drawWidth)div 24) then // lbltime.Left:= x-2-lbltime.Width // else // lbltime.Left:= x+2; // end; end; end; procedure TDrawForm.tmr1Timer(Sender: TObject); var chanelIndex, bb: Integer; selectTime: string; cd: Double; selectDatetime: Tdatetime; // 本次点击选择的时间 begin tmr1.Enabled := false; if car.fCarRect.Contains(pt) then // begin pnlLine.Left := pt.X; chanelIndex := (pt.Y - fTop) div drawH; bb := (pt.X - fLeft) * 86400 div drawWidth; cd := bb / 86400; selectDatetime := StartOfTheDay(curDatetime) + cd; lbltime.Caption := car.ChannelList[chanelIndex].name + ' ' + TimeToStr(selectDatetime); if (pt.X - fLeft) > ((20 * drawWidth) div 24) then // 20刻度后把文字显示在竖线左边 lbltime.Left := pt.X - 2 - lbltime.Width else lbltime.Left := pt.X + 2; if OnlySingleClick then //如果是单击 等一下 sleep(50); if not OnlySingleClick then mmo1.Lines.Add(' 双击 ' + datetimetostr(selectDatetime)) else mmo1.Lines.Add(' 单击 ' + datetimetostr(selectDatetime)); end; end; end.
object DrawForm: TDrawForm Left = 335 Top = 344 Caption = #30011#22270#31383#20307 ClientHeight = 294 ClientWidth = 744 Color = clWhite DoubleBuffered = True Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False Visible = True OnCreate = FormCreate OnResize = FormResize PixelsPerInch = 96 TextHeight = 13 object img1: TImage Left = 656 Top = 8 Width = 72 Height = 67 Align = alCustom OnClick = img1Click OnDblClick = img1DblClick OnMouseDown = img1MouseDown OnMouseMove = img1MouseMove end object lbltime: TLabel Left = 253 Top = 170 Width = 3 Height = 13 Color = clActiveCaption ParentColor = False Transparent = False end object mmo1: TMemo Left = 81 Top = 2 Width = 392 Height = 98 ImeName = #20013#25991' ('#31616#20307') - '#25628#29399#25340#38899#36755#20837#27861 Lines.Strings = ( '{"REGISTRATIONNO":"'#31908 '88888","Commno":"18576628275","ChannelList":' '[{"name":"CH1","order":1,"regionList":' '[{"begintime":"20200927164456","endtime":"2020092717125' '6"},' '{"begintime":"20200927012256","endtime":"20200927025556' '"}]},{"name":"CH2","order":2,"regionList":' '[{"begintime":"20200927164456","endtime":"2020092717555' '6"},' '{"begintime":"20200927014456","endtime":"20200927025556' '"}]},{"name":"CH3","order":3,"regionList":' '[{"begintime":"20200927164456","endtime":"2020092717555' '6"},' '{"begintime":"20200927013356","endtime":"20200927022256' '"}]},{"name":"CH4","order":3,"regionList":' '[{"begintime":"20200927012556","endtime":"2020092701485' '6"},' '{"begintime":"20200927015556","endtime":"20200927021256' '"},' '{"begintime":"20200927024456","endtime":"20200927025556' '"},' '{"begintime":"20200927034456","endtime":"20200927035556' '"},' '{"begintime":"20200927035856","endtime":"20200927042556' '"},' '{"begintime":"20200927045856","endtime":"20200927082556' '"},' '{"begintime":"20200927084856","endtime":"20200927182556' '"}]}]}') TabOrder = 0 end object btnreadJson: TButton Left = 0 Top = 8 Width = 75 Height = 25 Caption = #35299#37322'json' TabOrder = 1 OnClick = btnreadJsonClick end object btndraw: TButton Left = 0 Top = 39 Width = 75 Height = 25 Caption = #32472#21046 TabOrder = 2 OnClick = btndrawClick end object pnlLine: TPanel Left = 241 Top = 170 Width = 6 Height = 137 BevelOuter = bvNone Color = clBlue ParentBackground = False TabOrder = 3 end object mmo2: TMemo Left = 479 Top = 8 Width = 130 Height = 81 ImeName = #20013#25991'('#31616#20307') - '#25628#29399#25340#38899#36755#20837#27861 Lines.Strings = ( #21487#20197#33258#24049#20462#25913#19968#27573'json' #27979#35797#65292#28857#20987#35299#37322'json') TabOrder = 4 end object tmr1: TTimer Enabled = False Interval = 100 OnTimer = tmr1Timer Left = 696 Top = 80 end end