delphi 绘制时间刻度和多通道分段 canvas 和用 TGPGraphics

一台车有多个摄像头，一天时间每天摄像头有断续录像，要可视化显示出来，每个通道（摄像头）那个时间段有录像，鼠标点击能选中通道和对应的时间点并且可视化显示出来。

直观方便。 每选一台车就获取一次数据源，解释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
uJsonTest.dfm 窗体文件
【推广】 免费学中医，健康全家人
原文地址：https://www.cnblogs.com/rogge7/p/13821001.html