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

Question

为了一个最小的完整问题,我有一个WMF文件加载到TImage窗体上的控件.此控件包含属性Picture,这是一种TPicture类型.我试图"栅格化"我加载到TImage中的WMF文件,并将其存储到TSpeedButton.Glyph.

这个过程有趣的是我能够使用这种技术创建一个独立于分辨率的自定义控件(在我的情况下是一个按钮),它将重绘其字形以获得您喜欢的任何分辨率.

在实际使用中,我不会有TImage或TSpeedButton,但这个问题基本上是关于将内容从TPicturea 移动到a的过程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文件,我正在使用的确切文件.

Answer 1

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

请注意,在生产中我会更改下面的代码以使用Vcl.GraphUtils调用ScaleImage的helper,因为结果更漂亮.请参阅第二个代码示例.

// 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只是a 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;