根据位图做出漂亮的不规则FORM

时间： 2021-07-31 作者：daque

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 *.dfm} function tform1.createregion(wmask:tbitmap;wcolor:tcolor;hcontrol:thandle): hrgn; var dc, dc_c: hdc; rgn: hrgn; x, y: integer; coord: tpoint; line: boolean; color: tcolor; begin dc := getwindowdc(hcontrol); dc_c := createcompatibledc(dc); selectobject(dc_c, wmask.handle); beginpath(dc); for x:=0 to wmask.width-1 do begin line := false; for y:=0 to wmask.height-1 do begin color := getpixel(dc_c, x, y); if not (color = wcolor) then begin if not line then begin line := true; coord.x := x; coord.y := y; end; end; if (color = wcolor) or (y=wmask.height-1) then begin if line then begin line := false; movetoex(dc, coord.x, coord.y, nil); lineto(dc, coord.x, y); lineto(dc, coord.x + 1, y); lineto(dc, coord.x + 1, coord.y); closefigure(dc); end; end; end; end; endpath(dc); rgn := pathtoregion(dc); releasedc(hcontrol, dc); result := rgn; end; procedure tform1.formcreate(sender: tobject); var w1:tbitmap; w2:tcolor; rgn: hrgn; begin w1:=tbitmap.create; w1.assign(image1.picture.bitmap); w2:=w1.canvas.pixels[0,0]; rgn := createregion(w1,w2,handle); if rgn<>0 then begin setwindowrgn(handle, rgn, true); end; w1.free; end; procedure tform1.button1click(sender: tobject); begin close; end; procedure tform1.image1mousedown(sender: tobject; button: tmousebutton; shift: tshiftstate; x, y: integer); begin releasecapture; sendmessage(handle, wm_syscommand, $f012, 0); end; end.

根据位图做出漂亮的不规则FORM

相关推荐

推荐下载

热门阅览

最新排行