// Hiermit kann man Images andere Formen geben, ohne auf
// Regionen zurückgreifen zu müssen. Es werden beispielsweise
// 3 verschiedene Formen angeboten.

Original welche=0 weche=1 welche=2

// Getestet mit D4 unter XP

procedure 
  ImgForm(mask: TBitmap; img: TImage; welche: integer; negativ: boolean); 
var 
  bm: TBitmap; 
  x, y: integer; 
begin 
  bm := TBitmap.create; 
  bm.assign(Img.Picture.Graphic); 
  Img.Picture.Bitmap.assign(bm); 
  bm.free; 
  Img.transparent := true; 
  mask.width := Img.Picture.Bitmap.width; 
  mask.height := Img.Picture.Bitmap.height; 
  mask.pixelformat := Img.Picture.Bitmap.pixelformat; 
  Img.Picture.Bitmap.ReleaseMaskHandle; 
  with mask, canvas do begin 
    brush.color := clwhite; 
    fillrect(cliprect); 
    brush.color := clblack; 
    case welche of 
      0: ellipse(0, 0, width, height); 
      1: polygon([point(0, height div 2), point(width div 2, 0), 
          point(width, height div 2), point(width div 2, 
            height)]); 
      2: begin 
          for y := 0 to height div 10 do 
            for x := 0 to width div 10 do 
              ellipse(x * 10, y * 10, x * 10 + 10, y * 10 + 10); 
        end; 
    end; 
    if negativ then 
      transparentcolor := clblack else 
      transparentcolor := clwhite; 
  end; 
  Img.Picture.Bitmap.MaskHandle := mask.MaskHandle; 
  Img.refresh; 
end; 
 
// Beispielaufruf 
 
var 
  mask1, mask2: TBitmap; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  mask1 := TBitmap.create; 
  mask2 := TBitmap.create; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  mask2.free; 
  mask1.free; 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
var x: integer; 
begin 
  Image1.Picture.loadfromfile('c:\test.bmp'); 
  Image2.Picture.loadfromfile('c:\test.jpg'); 
  ImgForm(mask1, Image1, 0, false); 
  for x := 0 to 2 do begin 
    ImgForm(mask2, Image2, x, false); 
    sleep(500); 
  end; 
end;



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke