delphi - 如何制作加载到 TImage.Picture 中的 WMF 文件的位图版本并将其移动到 TSpeedButton.Glyph

Question

为了解决一个最简单的完整问题，我将一个 WMF 文件加载到表单上的 TImage 控件中。该控件包含 Picture 属性，它是一个 TPicture 类型。我正在尝试“光栅化”加载到 TImage 中的 WMF 文件，并将其存储到 TSpeedButton.Glyph 中。

这个过程的有趣之处在于，我能够使用这种技术来创建一个独立于分辨率的自定义控件(在我的例子中是一个按钮)，它将根据您喜欢的任何分辨率重新绘制其字形。

在现实世界中，我不会有 TImage 或 TSpeedButton，但这个问题从根本上讲是关于将内容从 TPicture 移动到 TBitmap 的过程。

这是相关的半工作代码:

procedure CopyBitmap(  Source:TImage;  DestSpeedButton:TSpeedButton );
var
   bmp: TBitmap;
begin
   bmp:=TBitmap.Create;
   try
     // note: with WMF loaded, Source.Picture.Bitmap.Width and Height are 0.
     bmp.Width := Source.Width; // originally I had Source.Picture.Bitmap.Width, which didn't work.
     bmp.Height := Source.Height; //because Source.Picture.Bitmap.Height, doesn't work.
     bmp.Canvas.Draw(0,0, Source.Picture.Graphic );
     DestSpeedButton.Glyph:=bmp;
   finally
     bmp.Free;
   end;
end;

这是正确的方法吗？为什么复印时图像会反转？

找到了一个示例 WMF 文件，正是我正在使用的文件 here .

Answer 1

谢谢大卫建议我画背景。这有效。

请注意，在生产中我会更改下面的代码以使用名为 ScaleImage 的 Vcl.GraphUtils 帮助程序，因为结果更漂亮。请参阅第二个代码示例。

// Quick and Dirty : No sub-pixel anti-aliasing.
// Also does not modifies Source, so set Source's size before you 
// call this. 
procedure CopyBitmap(  Source:TImage;  DestSpeedButton:TSpeedButton );
var
   bmp: TBitmap;
begin
   bmp:=TBitmap.Create;
   try
     bmp.SetSize( Source.Width, Source.Height);
     bmp.Canvas.Pen.Style := psClear;
     bmp.Canvas.Brush.Style := bsSolid;
     bmp.Canvas.Brush.Color := clFuchsia;
     bmp.Canvas.Rectangle(0,0, Source.Width+1,Source.Height+1 );
     bmp.Canvas.Draw(0,0, Source.Picture.Graphic );
     bmp.TransparentColor := clFuchsia;
     DestSpeedButton.Glyph:=bmp;
   finally
     bmp.Free;
   end;
end;

使用更多内存的替代方案，并使用 TPicture 类型而不是 TImage 因为在实际使用中我什至没有 TImage > 只是一个TPicture，而且这看起来更好。请注意，它是围绕我自己设计(或您的)的一些自定义控件编写的，该控件具有某些属性类型 TBitmap。您必须替换自己的控件，或者将 TMyControlWithAGlyph 更改为 TSpeedButton(如果您想要这样做):

// A Bit Better Looking. Uses Vcl.GraphUtils function ScaleImage
procedure CopyBitmap(  Source:TPicture;
                       Dest:TMyControlWithAGlyph;
                       DestType:TCopyDestTypeEnum;
                       AWidth,AHeight:Integer;
                       DoInvert:Boolean;
                       TransparentColor:TColor=clFuchsia );
var
   bmp,bmpFullSize: TBitmap;
   ARect:TRect;
   ScaleAmount:Double;
begin
   if not Assigned(Source) then
      exit;
   if not Assigned(Dest) then
      exit;

   if not Assigned(Source.Graphic) then
      exit;


   bmp:=TBitmap.Create;
   bmpFullSize := TBitmap.Create;
   try
     bmpFullSize.SetSize(  Source.Width, Source.Height );
     bmpFullSize.PixelFormat := pf24bit;
     bmpFullSize.Canvas.Pen.Style := psClear;
     bmpFullSize.Canvas.Brush.Style := bsSolid;
     bmpFullSize.Canvas.Brush.Color := TransparentColor;
     bmpFullSize.Canvas.Rectangle(0,0, Source.Width+1,Source.Height+1 );
     bmpFullSize.Canvas.Draw(0,0, Source.Graphic );


     bmp.SetSize( AWidth, AHeight);
     bmp.PixelFormat := pf24bit;

     // Vcl.GraphiUtil version needs a floating point scale.
     ScaleAmount := AWidth / Source.Width;
     ScaleImage(bmpFullSize,bmp,ScaleAmount );

     // This lets me have a white icon and turn it black if I want to
     // or vice versa
     if DoInvert then
       InvertBitmap(bmp); 

     if DestType=DestLargeGlyph then
     begin
          Dest.LargeGlyph := bmp;
     end
     else
     begin
          Dest.Glyph:=bmp;
     end;
   finally
     bmp.Free;
     bmpFullSize.Free;
   end;
end;

上面的代码还调用了这个小助手:

function InvertBitmap(ABitmap: TBitmap): TBitmap;
var
   x, y: Integer;
   ByteArray: PByteArray;
begin
   ABitmap.PixelFormat := pf24Bit;
   for y := 0 to ABitmap.Height - 1 do
   begin
      ByteArray := ABitmap.ScanLine[y];
      for x := 0 to ABitmap.Width * 3 - 1 do
      begin
         ByteArray[x] := 255 - ByteArray[x];
      end;
   end;
   Result := ABitmap;
end;