如何将自己指定的一片区域镂空？比如心型？

Question

如何将自己指定的一片区域镂空？比如心型？

Answer 1

Unit Main;InterfaceUses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, fcImager, fcButton, fcImgBtn, Buttons, ExtDlgs, Menus;Type
  TForm1 = Class(TForm)
    ImgDisplay: TImage;
    TimerMediaControl: TTimer;
    ImgMediaControl: TfcImageBtn;
    ImgMain: TfcImageBtn;
    ImgPlayListControl: TfcImageBtn;
    TimerPlayListControl: TTimer;
    fcImageBtn1: TfcImageBtn;
    PopupMenu1: TPopupMenu;
    Open1: TMenuItem;
    Exit1: TMenuItem;
    OpenPictureDialog1: TOpenPictureDialog;
    Procedure FormCreate(Sender: TObject);
    Procedure ImgDisplayMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    Procedure ImgDisplayMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    Procedure TimerMediaControlTimer(Sender: TObject);
    Procedure ImgMediaControlClick(Sender: TObject);
    Procedure TimerPlayListControlTimer(Sender: TObject);
    Procedure ImgPlayListControlClick(Sender: TObject);
    Procedure Exit1Click(Sender: TObject);
    Procedure Open1Click(Sender: TObject);
  Private
    Procedure UseMask(Bitmap: TBitmap; TransColor: TColor);
    { Private declarations }
  Public
    { Public declarations }
  End;Var
  Form1             : TForm1;Implementation{$R *.DFM}
Var  StartX, StartY    : Integer; {Declare in interface section of form抯 unit}Procedure TForm1.UseMask(Bitmap: TBitmap; TransColor: TColor);
Var
  x, y              : integer;          //扫描计数器
  RgnSize           : integer;          //区域大小
  Rgndata           : pRgndata;         //区域结构体指针
  Rgn1, Rgn2        : LongWord;         //临时区域变量
  StartPos, EndPos  : integer;          //“线区域”开始、结束位置
Begin
  Rgn1 := 0;
  rgn2 := 0;
  For y := 0 To Bitmap.Height - 1 Do    //扫描一行
    Begin
      x := 0;
      Endpos := x;
      Repeat
        StartPos := x;
        inc(x);
        //当前是背景        While (Bitmap.Canvas.Pixels[x, y] = TransColor) And (x <= Bitmap.Width)
          Do
          Begin
            StartPos := x;
            inc(x);                     //记录像素数目
          End;        //当前不是背景
        While (Bitmap.Canvas.Pixels[x, y] <> TransColor) And (x <= Bitmap.Width)
          Do
          Begin
            inc(x);                     //记录像素数目
          End;
        EndPos := x;
        If StartPos <> Bitmap.Width Then
          Begin
            If EndPos = Bitmap.Width Then dec(EndPos);
            If Rgn1 = 0 Then
              Begin                     //建立第一个“线区域”
                Rgn1 := CreateRectRgn(StartPos + 1, y, EndPos, y + 1);
              End
            Else
              Begin
                Rgn2 := CreateRectRgn(StartPos + 1, y, EndPos, y + 1);
                If Rgn2 <> 0 Then CombineRgn(Rgn1, Rgn1, Rgn2, RGN_OR);  //rgn1,rgn2合并到rgn1中
                DeleteObject(Rgn2);
              End;
          End;
      Until x >= Bitmap.width - 1;
    End;
  If (Rgn1 <> 0) Then
    Begin
      SetWindowRgn(handle, Rgn1, true); //将区域赋给FORM1窗体
    End;
End;
Procedure TForm1.FormCreate(Sender: TObject);
Var
  TransColor        : TColor;
  t1                : TTime;
  diftime           : real;
  ms                : String;
Begin  //  Image1.Picture.LoadFromFile('Main.bmp');
  Width := ImgDisplay.Picture.Width;
  Height := ImgDisplay.Picture.Height;
  TransColor := ImgDisplay.Picture.Bitmap.Canvas.Pixels[0, 0];
  t1 := time;
  UseMask(ImgDisplay.Picture.Bitmap, TransColor);
  diftime := (time - t1) * 10000000;
  ms := FloatToStr(round(diftime));
  showmessage(ms + '/万秒');End;Procedure TForm1.ImgDisplayMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
Var
  NewX, NewY        : Integer;
Begin
  //当左键按下时，处理移动
  If ssLeft In Shift Then
    Begin
      NewX := Left + x - StartX;
      NewY := Top + y - StartY;
      If NewX < -Width Div 2 Then
        NewX := -Width Div 2
      Else
        If NewX > Screen.Width - Width Div 2 Then
        NewX := Screen.Width - Width Div 2;      If NewY < -Height Div 2 Then
        NewY := -Height Div 2
      Else
        If NewY > Screen.Height - Height Div 2 Then
        NewY := Screen.Height - Height Div 2;      Left := NewX;
      Top := NewY;
    End;
End;Procedure TForm1.ImgDisplayMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
Begin
  If Button = mbLeft Then
    Begin
      StartX := X;
      StartY := Y;
    End
  Else
    Begin
      PopupMenu1.Popup(Left+x,Top+y);
    End;End;Procedure TForm1.TimerMediaControlTimer(Sender: TObject);
Begin
  If TimerMediaControl.tag > 0 Then
    Begin
      ImgMediaControl.Top := ImgMediaControl.Top + 1;
      TimerMediaControl.tag := TimerMediaControl.tag - 1;
      Application.ProcessMessages;
    End
  Else
    Begin
      ImgMediaControl.Top := ImgMediaControl.Top - 1;
      TimerMediaControl.tag := TimerMediaControl.tag + 1;
      Application.ProcessMessages;
    End;
  If TimerMediaControl.tag = 0 Then
    Begin
      TimerMediaControl.Enabled := false;
    End;
End;Procedure TForm1.ImgMediaControlClick(Sender: TObject);
Begin
  ImgMediaControl.DoubleBuffered := true;
  If TimerMediaControl.Enabled Then exit;
  If ImgMediaControl.Tag = 0 Then
    Begin
      TimerMediaControl.Tag := -ImgMediaControl.Height Div 5 * 4;
      ImgMediaControl.Tag := 1;
    End
  Else
    Begin
      TimerMediaControl.Tag := ImgMediaControl.Height Div 5 * 4;
      ImgMediaControl.Tag := 0;
    End;
  TimerMediaControl.Enabled := true;
End;Procedure TForm1.TimerPlayListControlTimer(Sender: TObject);
Begin
  If TimerPlayListControl.tag > 0 Then
    Begin
      ImgPlayListControl.Left := ImgPlayListControl.Left + 1;
      TimerPlayListControl.tag := TimerPlayListControl.tag - 1;
      Application.ProcessMessages;
    End
  Else
    Begin
      ImgPlayListControl.Left := ImgPlayListControl.Left - 1;
      TimerPlayListControl.tag := TimerPlayListControl.tag + 1;
      Application.ProcessMessages;
    End;
  If TimerPlayListControl.tag = 0 Then
    Begin
      TimerPlayListControl.Enabled := false;
    End;
End;Procedure TForm1.ImgPlayListControlClick(Sender: TObject);
Begin
  ImgPlayListControl.DoubleBuffered := true;
  If TimerPlayListControl.Enabled Then exit;
  If ImgPlayListControl.Tag = 0 Then
    Begin
      TimerPlayListControl.Tag := -ImgPlayListControl.Width Div 5 * 2;
      ImgPlayListControl.Tag := 1;
    End
  Else
    Begin
      TimerPlayListControl.Tag := ImgPlayListControl.Width Div 5 * 2;
      ImgPlayListControl.Tag := 0;
    End;
  TimerPlayListControl.Enabled := true;
End;Procedure TForm1.Exit1Click(Sender: TObject);
Begin
  close;
End;Procedure TForm1.Open1Click(Sender: TObject);
Begin
  If OpenPictureDialog1.Execute  Then
    Begin
      imgDisPlay.Picture.LoadFromFile(OpenPictureDialog1.FileName);
       FormCreate(self);
    End;
End;End.