Geek asks and answers

How to create a raster version of a WMF file loaded in TImage.Picture and move it to TSpeedButton.Glyph

For a minimal complete question, I have a WMF file uploaded to an element TImagein a form. This control contains the Picture property, which is a type TPicture. I am trying to "rasterize" the WMF file that I uploaded to TImage and saved it to TSpeedButton.Glyph.

What is interesting in this process, I can use this technique to create a resolution-independent user control (a button in my case) that will redraw its glyph for any required resolution.

In the real world, I would not have TImage or TSpeedButton, but this question is mainly related to the process of moving content from TPictureto TBitmap.

Here is the corresponding semi-working code:

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;

Is this the right approach? Why is the image inverted during copying?

A sample WMF file, the exact file I am using, is here .

enter image description here

+3
source share
1 answer

Thank you, David, for painting the background. It works.

Please note that during the production process I would modify the code below to use a Vcl.GraphUtilshelper called ScaleImage, as the results are much more beautiful. See the second code example.

// Quick and Dirty : No sub-pixel anti-aliasing.
// Also does not modifies Source, so set Source 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;
+5

More articles:


All Articles