unit Unit1; 

interface 

uses 
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
 ExtCtrls, StdCtrls, Buttons; 

type 
 TForm1 = class(TForm) 
 Image1: TImage; 
 Button1: TButton; 
 procedure FormCreate(Sender: TObject); 
 procedure Button1Click(Sender: TObject); 
 procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; 
 Shift: TShiftState; X, Y: Integer); 
 private 
  function CreateRegion(wMask: TBitmap; wColor: TColor;hControl: THandle): HRGN; 
  { Private declarations } 
 public 
  { Public declarations } 
end; 

var 
 Form1: TForm1; 

implementation 

{$R&nbsp;*.DFM}&nbsp;<br /><br />function&nbsp;Tform1.CreateRegion(wMask:TBitmap;wColor:TColor;hControl:THandle):&nbsp;HRGN;&nbsp;<br />var&nbsp;<br /> dc,&nbsp;dc_c:&nbsp;HDC;&nbsp;<br /> rgn:&nbsp;HRGN;&nbsp;<br /> x,&nbsp;y:&nbsp;integer;&nbsp;<br /> coord:&nbsp;TPoint;&nbsp;<br /> line:&nbsp;boolean;&nbsp;<br /> color:&nbsp;TColor;&nbsp;<br />begin&nbsp;<br /> dc&nbsp;:=&nbsp;GetWindowDC(hControl);&nbsp;<br /> dc_c&nbsp;:=&nbsp;CreateCompatibleDC(dc);&nbsp;<br /> SelectObject(dc_c,&nbsp;wMask.Handle);&nbsp;<br /> BeginPath(dc);&nbsp;<br /> for&nbsp;x:=0&nbsp;to&nbsp;wMask.Width-1&nbsp;do&nbsp;<br /> begin&nbsp;<br />  line&nbsp;:=&nbsp;false;&nbsp;<br />  for&nbsp;y:=0&nbsp;to&nbsp;wMask.Height-1&nbsp;do&nbsp;<br />  begin&nbsp;<br />   color&nbsp;:=&nbsp;GetPixel(dc_c,&nbsp;x,&nbsp;y);&nbsp;<br />   if&nbsp;not&nbsp;(color&nbsp;=&nbsp;wColor)&nbsp;then&nbsp;<br />   begin&nbsp;<br />    if&nbsp;not&nbsp;line&nbsp;then&nbsp;<br />    begin&nbsp;<br />     line&nbsp;:=&nbsp;true;&nbsp;<br />     coord.x&nbsp;:=&nbsp;x;&nbsp;<br />     coord.y&nbsp;:=&nbsp;y;&nbsp;<br />    end;&nbsp;<br />   end;&nbsp;<br />   if&nbsp;(color&nbsp;=&nbsp;wColor)&nbsp;or&nbsp;(y=wMask.Height-1)&nbsp;then&nbsp;<br />   begin&nbsp;<br />    if&nbsp;line&nbsp;then&nbsp;<br />    begin&nbsp;<br />     line&nbsp;:=&nbsp;false;&nbsp;<br />     MoveToEx(dc,&nbsp;coord.x,&nbsp;coord.y,&nbsp;nil);&nbsp;<br />     LineTo(dc,&nbsp;coord.x,&nbsp;y);&nbsp;<br />     LineTo(dc,&nbsp;coord.x&nbsp;+&nbsp;1,&nbsp;y);&nbsp;<br />     LineTo(dc,&nbsp;coord.x&nbsp;+&nbsp;1,&nbsp;coord.y);&nbsp;<br />     CloseFigure(dc);&nbsp;<br />    end;&nbsp;<br />   end;&nbsp;<br />  end;&nbsp;<br /> end;<br /> EndPath(dc);&nbsp;<br /> rgn&nbsp;:=&nbsp;PathToRegion(dc);&nbsp;<br /> ReleaseDC(hControl,&nbsp;dc);&nbsp;<br /> Result&nbsp;:=&nbsp;rgn;&nbsp;<br />end;&nbsp;<br /><br />procedure&nbsp;TForm1.FormCreate(Sender:&nbsp;TObject);&nbsp;<br />var&nbsp;<br /> w1:TBitmap;&nbsp;<br /> w2:TColor;&nbsp;<br /> rgn:&nbsp;HRGN;&nbsp;<br />begin&nbsp;<br /> w1:=TBitmap.Create;&nbsp;<br /> w1.Assign(image1.Picture.Bitmap);&nbsp;<br /> w2:=w1.Canvas.Pixels[0,0];&nbsp;<br /> rgn&nbsp;:=&nbsp;CreateRegion(w1,w2,Handle);&nbsp;<br /> if&nbsp;rgn&lt;&gt;0&nbsp;then&nbsp;<br /> begin&nbsp;<br />  SetWindowRgn(Handle,&nbsp;rgn,&nbsp;true);&nbsp;<br /> end;&nbsp;<br /> w1.Free;&nbsp;<br />end;&nbsp;<br /><br />procedure&nbsp;TForm1.Button1Click(Sender:&nbsp;TObject);&nbsp;<br />begin&nbsp;<br /> Close;&nbsp;<br />end;&nbsp;<br /><br />procedure&nbsp;TForm1.Image1MouseDown(Sender:&nbsp;TObject;&nbsp;Button:&nbsp;TMouseButton;&nbsp;<br />Shift:&nbsp;TShiftState;&nbsp;X,&nbsp;Y:&nbsp;Integer);&nbsp;<br />begin&nbsp;<br /> ReleaseCapture;&nbsp;<br /> SendMessage(Handle,&nbsp;WM_SYSCOMMAND,&nbsp;$F012, 0); 
end; 

end. 

文章作者:mantousoft
文章来源:2ccc.com
作者邮箱:root@2ccc.com

Last modification:August 16th, 2009 at 12:30 pm
如果觉得我的文章对你有用,请随意赞赏