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

typeTregion= class
  publicfR: TGPRect;

    begintime, endtime: TDateTime;//后面要改成整形 int
  end;

  TChannel= class
  publicregionList: TList<Tregion>;

    name:string;

    order: Integer;end;

  TCar= class
  private
  public
    //应该有 宽  高    车牌号，通讯号，和传过来的字符串
    ChannelList: TList<TChannel>;

    REGISTRATIONNO, Commno:string;

    fCarRect: Trect;end;

unituJsonTest;{有两个情形：

  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

usesWinapi.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;typeTDrawForm= class(TForm)

    mmo1: TMemo;

    img1: TImage;

    btnreadJson: TButton;

    btndraw: TButton;

    pnlLine: TPanel;

    lbltime: TLabel;

    tmr1: TTimer;

    mmo2: TMemo;procedurebtnreadJsonClick(Sender: TObject);procedureFormResize(Sender: TObject);procedurebtndrawClick(Sender: TObject);procedureFormCreate(Sender: TObject);procedureimg1Click(Sender: TObject);procedureimg1DblClick(Sender: TObject);procedureimg1MouseDown(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);procedureimg1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);proceduretmr1Timer(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;constfTop= 105;

  fbuttom= 5;

  fRight= 8; //绘制区预保留右边空间
  drawH = 25; //绘制每一行通道的高度
  TimeLineH = 20; //刻度区高度包括文字
  Part = 24; //24等分
  Graduate = 7; //刻度高度

varDrawForm: TDrawForm;implementation

{$R *.dfm}

function Str2ToDatetime(DateStr: string): Tdatetime;//将yyyymmddhhnnss格式的字符串转为时间格式
varfs: TFormatSettings;beginInsert(':', 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;procedureTDrawForm.FormCreate(Sender: TObject);beginmode := false; //切换情形 1 true   2 false
  fLeft := 8;

  lbltime.Left := -5;if not mode then
  beginimg1.Align :=alclient;end;

  pnlLine.Width := 1;

  pnlLine.Visible :=false;



  btnreadJson.Click;end;procedureTDrawForm.btnreadJsonClick(Sender: TObject);varJsonstr: String;

  ChannelList: TSuperArray;

  ACArray: TSuperArray;

  i, j: Integer;

  jsonNode: ISuperObject;



  channel: TChannel;

  region: Tregion;beginjsonNode :=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
  beginHaveReadJson := 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
    beginregion := 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;procedureTDrawForm.btndrawClick(Sender: TObject);vari, j: Integer;

  Graphics: TGPGraphics;

  opaquePen, semiTransPen: TGPPen;

  rect: TGPRect;

  region: Tregion;

  fCanvas: Tcanvas;

  Rect1: Trect;begin

  if mode then
  beginself.Repaint;

    fCanvas := self.Canvas; //情形1
  end
  else
  beginfCanvas := img1.Canvas; //情形2
    img1.Align :=alclient;//如果用图片绘制会有右边一片空白异常。感谢网友 [布吉]周黔76557298  帮忙
    Rect1.Left := 0;

    Rect1.Top := 0;

    Rect1.Right :=img1.Width;

    Rect1.Bottom :=img1.Height;with img1 do
    beginPicture.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
  beginfCanvas.MoveTo(fLeft, fTop+ i *drawH);

    fCanvas.LineTo(fLeft+ drawWidth, fTop + i *drawH);for j := 0 to car.ChannelList[i].regionList.Count - 1 do
    beginregion :=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
  beginfCanvas.MoveTo(fLeft+ drawWidth div Part * i, fTop + rowCnt *drawH);

    fCanvas.LineTo(fLeft+ drawWidth div Part * i, fTop + rowCnt * drawH +Graduate);if (i = 0) then
    beginfCanvas.TextOut(fLeft+ drawWidth div Part * i, fTop + rowCnt * drawH +Graduate, inttostr(i));end
    else if (i < 10) then
    beginfCanvas.TextOut(fLeft+ drawWidth div Part * i - 2,

        fTop+ rowCnt * drawH +Graduate, inttostr(i));end
    else if (i = 24) then
    beginfCanvas.TextOut(fLeft+ drawWidth div Part * i - 10,

        fTop+ rowCnt * drawH +Graduate, inttostr(i));end
    else
    beginfCanvas.TextOut(fLeft+ drawWidth div Part * i - 4,

        fTop+ rowCnt * drawH +Graduate, inttostr(i));end;end;end;procedureTDrawForm.FormResize(Sender: TObject);begin
  if (car <> nil) thenbtndraw.Click;end;procedureTDrawForm.img1Click(Sender: TObject);begin
  //如果在区域，获取xy坐标，移动panel 计算出时间，显示出来。
  if HaveReadJson then
  begintmr1.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;procedureTDrawForm.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;procedureTDrawForm.img1MouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);varchanelIndex, bb: Integer;

  selectTime:string;

  cd: Double;begin
  if HaveReadJson then
  beginpt.Create(X, Y);end;end;procedureTDrawForm.img1MouseMove(Sender: TObject; Shift: TShiftState;

  X, Y: Integer);varchanelIndex, 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;procedureTDrawForm.tmr1Timer(Sender: TObject);varchanelIndex, bb: Integer;

  selectTime:string;

  cd: Double;

  selectDatetime: Tdatetime;//本次点击选择的时间
begintmr1.Enabled :=false;if car.fCarRect.Contains(pt) then //  beginpnlLine.Left :=pt.X;

    chanelIndex := (pt.Y - fTop) divdrawH;

    bb := (pt.X - fLeft) * 86400 divdrawWidth;

    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.Widthelselbltime.Left := pt.X + 2;if OnlySingleClick then  //如果是单击 等一下
      sleep(50);if not OnlySingleClick thenmmo1.Lines.Add('双击' +datetimetostr(selectDatetime))elsemmo1.Lines.Add('单击' +datetimetostr(selectDatetime));end;end;end.

objectDrawForm: TDrawForm

  Left= 335Top= 344Caption= #30011#22270#31383#20307ClientHeight= 294ClientWidth= 744Color=clWhite

  DoubleBuffered=True

  Font.Charset=DEFAULT_CHARSET

  Font.Color=clWindowText

  Font.Height= -11Font.Name= 'Tahoma'Font.Style=[]

  OldCreateOrder=False

  Visible=True

  OnCreate=FormCreate

  OnResize=FormResize

  PixelsPerInch= 96TextHeight= 13
  objectimg1: TImage

    Left= 656Top= 8Width= 72Height= 67Align=alCustom

    OnClick=img1Click

    OnDblClick=img1DblClick

    OnMouseDown=img1MouseDown

    OnMouseMove=img1MouseMoveend
  objectlbltime: TLabel

    Left= 253Top= 170Width= 3Height= 13Color=clActiveCaption

    ParentColor=False

    Transparent=Falseend
  objectmmo1: TMemo

    Left= 81Top= 2Width= 392Height= 98ImeName= #20013#25991'('#31616#20307') -'#25628#29399#25340#38899#36755#20837#27861Lines.Strings=('{"REGISTRATIONNO":"'#31908
      '88888","Commno":"18576628275","ChannelList":'
      '[{"name":"CH1","order":1,"regionList":'
      '[{"begintime":"20200927164456","endtime":"2020092717125'
      '6"},'
      '{"begintime":"20200927012256","endtime":"20200927026666666'
      '"}]},{"name":"CH2","order":2,"regionList":'
      '[{"begintime":"20200927164456","endtime":"2020092717666666'
      '6"},'
      '{"begintime":"20200927014456","endtime":"20200927026666666'
      '"}]},{"name":"CH3","order":3,"regionList":'
      '[{"begintime":"20200927164456","endtime":"2020092717666666'
      '6"},'
      '{"begintime":"20200927013356","endtime":"20200927022256'
      '"}]},{"name":"CH4","order":3,"regionList":'
      '[{"begintime":"20200927012556","endtime":"2020092701485'
      '6"},'
      '{"begintime":"20200927016666666","endtime":"20200927021256'
      '"},'
      '{"begintime":"20200927024456","endtime":"20200927026666666'
      '"},'
      '{"begintime":"20200927034456","endtime":"20200927036666666'
      '"},'
      '{"begintime":"20200927035856","endtime":"20200927042556'
      '"},'
      '{"begintime":"20200927045856","endtime":"20200927082556'
      '"},'
      '{"begintime":"20200927084856","endtime":"20200927182556'
      '"}]}]}')

    TabOrder= 0
  end
  objectbtnreadJson: TButton

    Left= 0Top= 8Width= 75Height= 25Caption= #35299#37322'json'TabOrder= 1OnClick=btnreadJsonClickend
  objectbtndraw: TButton

    Left= 0Top= 39Width= 75Height= 25Caption= #32472#21046TabOrder= 2OnClick=btndrawClickend
  objectpnlLine: TPanel

    Left= 241Top= 170Width= 6Height= 137BevelOuter=bvNone

    Color=clBlue

    ParentBackground=False

    TabOrder= 3
  end
  objectmmo2: TMemo

    Left= 479Top= 8Width= 130Height= 81ImeName= #20013#25991'('#31616#20307') -'#25628#29399#25340#38899#36755#20837#27861Lines.Strings=(

      #21487#20197#33258#24049#20462#25913#19968#27573'json'#27979#35797#65292#28857#20987#35299#37322'json')

    TabOrder= 4
  end
  objecttmr1: TTimer

    Enabled=False

    Interval= 100OnTimer=tmr1Timer

    Left= 696Top= 80
  end
end

uJsonTest.dfm 窗体文件