标签: graphics32

在Graphics32库中使用ClearType(Delphi)

我在Delphi 2009中使用Graphics32库.是否可以使用带有MS'ClearType技术的TBitmap32.TextOut方法渲染字体?我知道GR32的内置抗锯齿(TBitmap32.RenderText),但整体质量和性能并不令人满意.

[更新]

我遇到了另一个问题-我使用功能从Tondrej的链接评论张贴在TCustomImage32后代类的方法.该类的实例正在以dmBlend模式工作,我使用它的Font.Color属性时遇到问题 - 使用TextOut方法呈现的文本忽略该属性(它将文本呈现为具有颜色值"alpha").使用RenderText时没有出现此问题.显然,绘制TPaintBox32组件时一切正常.

delphi delphi-2009 cleartype graphics32

7
推荐指数
0
解决办法
2030
查看次数

绘制抗锯齿形状

我试图通过提供抗锯齿来改进我在项目中所做的一些绘图.我正在使用Graphics32库而不是标准的delphi Canvas函数来玩一个简单的项目.我正在测试简单的形状,并注意到模糊的影响,并想知道它是否可以修复.

procedure TForm1.FormPaint(Sender: TObject);
var
    Points : TArrayOfFixedPoint;
    ar: array [0 .. 6] of Tpoint;
begin
    // Antialiased Triangle
    SetLength(Points, 3);
    Points[0] := FixedPoint(20, 20);
    Points[1] := FixedPoint(20 + 100, 20 + 20);
    Points[2] := FixedPoint(20, 20 + 20);
    PolygonFS(self.mBitmap, FixedPointToFloatPoint(Points), clYellow32, pfAlternate, nil); // Draw Filled Polygon
    PolylineFS(self.mBitmap, FixedPointToFloatPoint(Points), clBlack32, true, 1); // Draw Outline

    self.mBitmap.DrawTo(self.Canvas.Handle, 0, 0);

    // Normal Triangle
    ar[0] := point(20, 150);
    ar[1] := point(20 + 100, 150 + 20);
    ar[2] := point(20, 150 + …
Run Code Online (Sandbox Code Playgroud)

delphi graphics32 delphi-10-seattle

6
推荐指数
0
解决办法
753
查看次数

有人知道Graphics32的当前状态吗?

Graphics32 1.8.3 的最新版本于2007年3月发布.

何时会有正式的 Delphi 2010兼容版本?

是否有任何Graphics32的公共SCM存储库?

delphi graphics32 delphi-2010

5
推荐指数
1
解决办法
1094
查看次数

Delphi,GR32 + PngObject:转换为Bitmap32无法正常工作

我正在使用GR32绘制多个半透明的PNG图像.到目前为止,我一直在使用以下方法:

  png:= TPNGObject.Create;
  png.LoadFromFile(...);
  PaintBox321.Buffer.Canvas.Draw(120, 20, png);
Run Code Online (Sandbox Code Playgroud)

但我想切换到GR32网站上提出的方法(http://graphics32.org/wiki/FAQ/ImageFormatRelated):

  tmp:= TBitmap32.Create;
  LoadPNGintoBitmap32(tmp, ..., foo);
  tmp.DrawMode:= dmBlend;
  PaintBox321.Buffer.Draw(Rect(20, 20, 20+ tmp.Width, 20+tmp.Height),
   tmp.ClipRect, tmp);
Run Code Online (Sandbox Code Playgroud)

虽然第一种方法完全正常,但第二种方法 - 应该给出相同的结果 - 会导致alpha通道出现非常奇怪的问题,请参阅图像(其中还显示了与Paint.NET中"排列"相同的图像的比较 - 背景和图标在编辑层上打开了).该图像描绘了Bitmap32正确加载或绘制.有小费吗?

TBitmap32 alpha通道出现问题

- 11月22日增加

我发现它不是关于绘图,而是关于将PNG加载到BMP32.从BMP32保存回PNG会生成错误的"白化"(左侧的那个)PNG图像.

delphi png transparency graphics32

5
推荐指数
1
解决办法
2793
查看次数

从TImage32(Graphics32库)中删除垃圾DFM数据

我有一个源自TImage32的控件:

TChromaDisplay = class(TImage32)
Run Code Online (Sandbox Code Playgroud)

一切都很好,除了当我在表单上放下TChromaDisplay时,生成的DFM文件很大(300KB而不是<1KB),因为我在Bitmap.Data字段中保存了垃圾数据(它只是一个灰色图像).每次我将控件放在窗体上时,都会创建位图图像并填充灰色.我不想将图像(垃圾)的内容保存到DFM文件,因为它使EXE更大但我不知道如何.

可能我需要在TChromaDisplay.Create中写一些地方,我没有保存/存储在我的TChromaDisplay中的任何图像数据.但我不知道在哪里/怎么做.

  object Display: TChromaDisplay
    Left = 0
    Top = 0
    Width = 1465
    Height = 246
    Bitmap.Data = {
      C0000000C0000000EBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFF
      EBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFF
      EBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFFEBEBEBFF
      etc
      etc
      etc
Run Code Online (Sandbox Code Playgroud)

我在Create中试过这个但是没有帮助:

Bitmap.Width := 1;
Bitmap.Height:= 1;
Run Code Online (Sandbox Code Playgroud)

delphi graphics32

5
推荐指数
1
解决办法
625
查看次数

TBitmap32.LoadFromStream() 自动识别图片格式

我正在使用 Delphi XE2(更新 3)和 GR32。我无法用于TBitmap32.LoadFromStream()加载图像数据。它引发以下异常:

Project MyApp.exe raised exception class EInvalidGraphic with message 'Bitmap image is not valid'.
Run Code Online (Sandbox Code Playgroud)

代码

uses GR32, GifImg, PngImage, Vcl.Graphics;

var
  pic: TBitmap32;
  bs: TBytesStream;
begin
  bs := TBytesStream.Create(TClientDataSet(cds).FieldByName('filedata').AsBytes);
  try
    pic := TBitmap32.Create;
    try
//      bs.SaveToFile('c:\delme.png');
//      pic.LoadFromFile('c:\delme.png');
      pic.LoadFromStream(bs); // <- EInvalidGraphic exception
      // do something with 'pic'
    finally
      FreeAndNil(pic);
    end;
  finally
    FreeAndNil(bs);
  end;
end;
Run Code Online (Sandbox Code Playgroud)

解决方法

如果我对LoadFromStream()代码进行注释并取消对前两行的注释,它就会起作用——因此它能够在从文件加载图像时确定图像格式。在此示例中,bs包含有效的 PNG 图像。但是,有时它可能是 GIF、JPG、BMP 或其他图形格式。

我也知道我可以使用一个中间对象(例如,TPNGImageTJPEGImage等),加载使用图像数据LoadFromStream()向中间对象,然后Assign()它向 …

delphi image-formats graphics32

5
推荐指数
2
解决办法
6443
查看次数

Delphi如何向TImage32添加透明层

我需要能够将透明的PNG图像作为图层添加到ImgView32(来自graphics32库).有谁知道如何实现这一目标?

基本上,我可以将任何图像作为图层添加到我的Image32,但所有图像(即使它们本质上是透明的)都具有白色背景.我需要解决这个问题.有人有任何想法吗?

这是我将图像添加为图层的方式:

var
  B: TBitmapLayer;
  P: TPoint;
  W, H: Single;
const
  MasterAlpha: SmallInt = 100;
begin
  with OpenPictureDialog do
    if Execute then
    begin
      B := TBitmapLayer.Create(ImgView321.Layers);
      with B do
      try
        Bitmap.LoadFromFile(FileName);
        Bitmap.DrawMode := dmTransparent;
        with ImgView321.GetViewportRect do
          P := ImgView321.ControlToBitmap(GR32.Point((Right + Left) div 2, (Top + Bottom) div 2));
        W := Bitmap.Width * 0.5;
        H := Bitmap.Height * 0.5;

        with ImgView321.Bitmap do
          Location := GR32.FloatRect(P.X - W, P.Y - H, P.X + W, P.Y + H);

        Scaled := True; …
Run Code Online (Sandbox Code Playgroud)

delphi graphics32 delphi-xe

5
推荐指数
0
解决办法
1027
查看次数

Delphi Graphics32 在图层上绘制透明椭圆

我希望能够在 ImgView32 的透明层上绘制一个空的椭圆。知道该怎么做吗?到目前为止我能想到的只有:

 BL := TBitmapLayer.Create(ImgView.Layers);
    BL.Bitmap.DrawMode := dmTransparent;
    BL.Bitmap.SetSize(imwidth,imheight);
    BL.Bitmap.Canvas.Pen.Width := penwidth;
    BL.Bitmap.Canvas.Pen.Color := pencolor;
    BL.Location := GR32.FloatRect(0, 0, imwidth, imheight);
    BL.Scaled := False;
    BL.OnMouseDown := LayerMouseDown;
    BL.OnMouseUp := LayerMouseUp;
    BL.OnMouseMove := LayerMouseMove;
    BL.OnPaint := LayerOnPaint;

...
BL.Bitmap.Canvas.Pen.Color := clBlue;
BL.Bitmap.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
BL.Bitmap.Canvas.Ellipse(FStartPoint.X, FStartPoint.Y,FEndPoint.X, FEndPoint.Y); 
Run Code Online (Sandbox Code Playgroud)

开始点和结束点是通过鼠标事件获取的。

我实际上正在尝试绘制一个动态椭圆(在鼠标事件上)。所以就涉及到onMouseDown(LayerMouseDown)、onMouseUp(LayerMouseUp)和OnMouseMove(LayerMouseMove)事件。作为参考,请检查这个问题,它涉及动态绘制线条。我想做同样的事情,但用椭圆而不是直线。

因此,我没有使用 AddLineToLayer,而是使用 AddCircleToLayer 过程。事件现在如下所示:

procedure TForm5.SwapBuffers32;
begin
    TransparentBlt(
      BL.Bitmap.Canvas.Handle, 0, 0, BL.Bitmap.Width, BL.Bitmap.Height,
      bm32.Canvas.Handle, 0, 0, bm32.Width, bm32.Height, clWhite);
end;

procedure TForm5.ImgViewResize(Sender: TObject);
begin
  OffsX := (ImgView.ClientWidth - imwidth) div …
Run Code Online (Sandbox Code Playgroud)

delphi graphics32 delphi-xe

5
推荐指数
2
解决办法
3310
查看次数

在ImgView32图层上绘制粗虚线

我只想在ImgView32中的一个图层上绘制一条垂直虚线粗线.我还希望我的线条更粗,所以我绘制了多条彼此靠近的线条,因为Canvas.Pen.Width对LineTo方法没有影响.所以我的代码如下:

procedure TMainForm.PaintDottedHandler(Sender: TObject;Buffer: TBitmap32);
var
  Cx, Cy,raza: Single;
  W2, H2: Single;
  I,J: Integer;
  points:TArrayOfFloatPoint;
  Center, Radius:TFloatPoint;
const
  CScale = 1 / 200;
begin

  if Sender is TPositionedLayer then
    with TPositionedLayer(Sender).GetAdjustedLocation do
    begin
      W2 := (Right - Left) * 0.5;
      H2 := (Bottom - Top) * 0.5;

      Cx := Left + W2;
      Cy := Top + H2;
      W2 := W2 * CScale;
      H2 := H2 * CScale;
      Buffer.PenColor := clRed32;

      Buffer.MoveToF(Cx-2,Top);
      Buffer.LineToFSP(Cx-2 , Bottom);

      Buffer.MoveToF(Cx-1,Top);
      Buffer.LineToFSP(Cx-1 , Bottom);

      Buffer.MoveToF(Cx,Top);
      Buffer.LineToFSP(Cx …
Run Code Online (Sandbox Code Playgroud)

delphi graphics32 delphi-xe

5
推荐指数
1
解决办法
834
查看次数

将包含文本的半透明位图与 Graphics32 混合

我正在尝试在我们的一个内部组件中实现分层绘画系统,但在混合包含文本的位图时遇到了问题。

以下代码片段显示了问题:

uses
  GR32;

procedure DrawBitmaps;
var
  bmp1: TBitmap32;
  bmp2: TBitmap32;
begin
  bmp1 := TBitmap32.Create;
  bmp1.Width := 100;
  bmp1.Height := 100;
  bmp1.FillRect(0, 0, 100, 100, clWhite32);
  bmp1.FillRect(0, 0, 80, 80, clTrGreen32);

  bmp1.Font.Size := -16;
  bmp1.Font.Color := clBlack;
  bmp1.TextOut(2, 10, 'Green');

  bmp1.SaveToFile('c:\0\bmp1.bmp');

  bmp2 := TBitmap32.Create;
  bmp2.Width := 80;
  bmp2.Height := 80;
  bmp2.FillRect(0, 0, 80, 80, clTrRed32);

  bmp2.Font.Size := -16;
  bmp2.Font.Color := clBlack;
  bmp2.TextOut(2, 50, 'Red');

  bmp2.SaveToFile('c:\0\bmp2.bmp');

  bmp2.DrawMode := dmBlend;
  bmp2.DrawTo(bmp1, 20, 20);

  bmp1.SaveToFile('c:\0\bmpcombined.bmp');

  bmp1.Free;
  bmp2.Free;
end;
Run Code Online (Sandbox Code Playgroud)

结果图像:

bmp1: bmp1 bmp2: bmp2 bmp组合: 合并

如您所见,文本在 …

delphi graphics32

5
推荐指数
1
解决办法
658
查看次数