分 类：窗体
语 种：简体中文
编辑器：Delphi5
平 台：Win9x,Win2k/NT
作品源代码： 本地下载
软件或演示： -
代码大小： 231.1K
软件大小： -
2000年看到一篇文章做的演示代码，可以根据位图做出漂亮的不规则FORM，大家可以下载演示程序研究一下，包含DELPHI版和VC版。
//
// -'`'_ -'`'
// / / '
// / /__ / ___
// | | -'`.-( |
// | | | | ' | |
// | / / '-' |
// ___/ / (o o) (__/
// __| _ _ |__
// ( ( ) )
// _.-.___.-./_/
// __ | | __
// | .| |./ |
// | '#. .#' |
// |__/ ''' __|
// -/ -
//
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.
文章作者：mantousoft
文章来源：2ccc.com
作者邮箱：root@2ccc.com
|