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

2008-02-23 07:21:49来源:互联网 阅读 ()

新老客户大回馈,云服务器低至5折

分  类:窗体
语  种:简体中文
编辑器: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

上一篇: HTML Dialog Boxes (网页对话框)
下一篇: 《Delphi 深度探索》之《自动完成》

标签:

版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com
特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有

上一篇:将汉字反查为拼音的演示程序

下一篇:FastReport 直接打印演示代码