• Delphi 11.1 在FMX Image上画图遇到坑


    上图是运行后的结果,正常左右两图应该是一样的结果,都在图上画出一个红框。

    下图是实现的代码:

    unit Unit1;
    
    interface
    
    uses
      System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
      FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
      FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects;
    
    type
      TForm1 = class(TForm)
        Image1: TImage;
        Image2: TImage;
        Button1: TButton;
        Button2: TButton;
        procedure Button1Click(Sender: TObject);
        procedure Button2Click(Sender: TObject);
      private
        procedure DrawRect(aBitMap: TBitMap);
        { Private declarations }
      public
        { Public declarations }
      end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.fmx}
    
    procedure TForm1.Button1Click(Sender: TObject);
    begin
    //左图的算法
    //在Image.Bitmap上直接画,结果不对
      Image1.Bitmap.LoadFromFile('.\5.jpg');
      DrawRect(Image1.Bitmap);
    end;
    
    procedure TForm1.Button2Click(Sender: TObject);
    var
      aBitmap:TBitmap;
      aImage:TImage;
    begin
    //右图的算法
    //在右图上,正确的画出红框
      aBitmap:=TBitmap.Create;
      aBitmap.LoadFromFile('.\5.jpg');
      DrawRect(aBitmap);
      Image2.Bitmap.Assign(abitmap);
      aBitmap.Free;
    
    // 这样也可以
    //  aImage:=TImage.Create(Self);
    //  aImage.Bitmap.LoadFromFile('.\5.jpg');
    //  DrawRect(aImage.Bitmap);
    //  Image2.Bitmap.Assign(aImage.Bitmap);
    //  aImage.Free;
    end;
    
    procedure TForm1.DrawRect(aBitMap: TBitMap);
    var
      r: TRectF;
      aLeft, aTop, aHeight, aWidth, aRight, aBottom: single;
      i: Integer;
    begin
    
      aTop:=217;
      aLeft:= 767;
      aHeight:= 258;
      aWidth:= 198;
      aBottom:=aTop+aHeight;
      aRight:=aLeft+aWidth;
    
      aBitMap.Canvas.BeginScene;
      try
        r := TRectF.Create(aLeft, aTop, aRight, aBottom);
        with aBitMap.Canvas do
        begin
          Stroke.Kind := TBrushKind.Solid;
          Stroke.Color := TAlphaColors.red;
          Stroke.Thickness := 8;
          DrawRect(r, 0, 0, AllCorners, 1.0);
        end;
      finally
        aBitMap.Canvas.EndScene;
      end;
    end;
    
    end.

    也问了朋友,说可能是bug,正在帮我检查问题,我感觉两种写法应该是一样的结果,确实是问题,害得我好几个小时怀疑自己的写法问题。

    说白了,直接在Image上画,结果不对,而建立一个Bitmap,在上面画,再调入image就正常,这算什么事啊?!

    在朋友们的帮助下,又搞了半宿,结果更离奇了!!!

    朋友们在他们的环境运行,结果是正常的。

    Aone老师真是强,帮我查出原因,原来是high-dpi的问题,DrawRect代码改成这样,解决了!

    procedure TForm1.DrawRect(aBitMap: TBitMap);
    var
      r: TRectF;
      aLeft, aTop, aHeight, aWidth, aRight, aBottom: single;
      i: Integer;
    begin
    
      aTop:=217;
      aLeft:= 767;
      aHeight:= 258;
      aWidth:= 198;
      aBottom:=aTop+aHeight;
      aRight:=aLeft+aWidth;
    
      aBitMap.Canvas.BeginScene;
      try
        r := TRectF.Create(aLeft/aBitMap.Canvas.Scale, aTop/aBitMap.Canvas.Scale, aRight/aBitMap.Canvas.Scale, aBottom/aBitMap.Canvas.Scale);
        with aBitMap.Canvas do
        begin
          Stroke.Kind := TBrushKind.Solid;
          Stroke.Color := TAlphaColors.red;
          Stroke.Thickness := 8/aBitMap.Canvas.Scale;
          DrawRect(r, 0, 0, AllCorners, 1.0);
        end;
      finally
        aBitMap.Canvas.EndScene;
      end;
    end;
    
    end.

    上面代码我标红的地方,问题解决,如下图:

    最后,感谢昨晚一起帮助我的朋友们!

    继续居家隔离,期待疫情早日过去,更期待11.2早点发布!

  • 相关阅读:
    查看mysql日志
    Redis配置和常用命令
    任务
    如何让maven 将工程依赖的jar 复制到WEB-INF/lib 目录下
    Tomcat8安装, 安全配置与性能优化(转)
    Web.xml详解(转)
    php精度比较函数bccomp
    php找到字符数组里最左匹配长度的字符(最长公共前缀匹配算法)
    PHP实现curl post和get
    Jquery 跨Dom窗口操作
  • 原文地址:https://www.cnblogs.com/kinglandsoft/p/16079045.html
Copyright © 2020-2023  润新知