当前位置: 首页 > 文章分类 > 编程开发 > 其他开发语言 > 文章页面

文章正文:

建立任意图片形状窗口的方法

作者:佚名 时间:2006-12-17 14:45:18 来源:网络

    下面的程序段是一个外国人的原算法!(我最早看到算法,可他是不是抄的我就不知道了)原来是一个控件,不过在我的电脑上不能用。

  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);
  {启动一个路径分支。
  在这个命令后执行的GDI绘图命令会自动成为路径的一部分。
  对线段的连接会结合到一起。并且设备场景中任何现成的路径都会被清除。}
  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;{其实这个X是不用的,因为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);{上面三个LineTo()语句就是画一个2×y的矩形。
  一定要这样才可以画上每个点!并且连在一起的如果你查查Win32 SDK手册你还可以用Rectangle(dc, coord.x, coord.y, x + 2, y)等其他的画图函数代替从MoveToEx()开始的四个语句!也是一样的,只要记住要把点画完而且要重叠地画才可以把路径连在一起!}
  CloseFigure(dc);{描绘到一个路径时,关闭当前打开的图形。万重大侠说不可以少,我不理解,但是多了不错。}
  end;
  end;
  end;
  end;
  EndPath(dc);{结束画路径}
  rgn := PathToRegion(dc);{连接路径为区域的函数。}
  ReleaseDC(hControl, dc);{释放资源,公式化的必须使用。}
  Result := rgn;
  end;

  不过后来看到了罗云彬(http://asm.yeah.net)大侠给出了不同的算法,我以为更好些,源程序可是用100%的汇编写成的(厉害吧!)我改为了Delphi的样子!首先解释两个函数。
  1、原形:function CreateRectRgn(p1, p2, p3, p4: Integer): HRGN; stdcall;创建一个由点p1,p2和p3,p4描述的矩形区域;
  2、原形:function CombineRgn(p1, p2, p3: HRGN; p4: Integer): Integer; stdcall;把p2和p3区域合并为区域p1,p4是合并方式,p4取值如下:RGN_AND 交集合并,RGN_COPY拷贝p2的内容,RGN_DIFF合并p2和p3不相交的地方,RGN_OR并集合并,RGN_XOR不同时在p2和p3中的部分。
  下面给出完整源程序:
  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;

[责任编辑:]
评论列表:
暂无评论
登录名: 密码:匿名发表(无需注册)