delphi 改变窗口形状(图片)

Question

现有一张图片，让窗口 抠掉图片的指定颜色。。来改变窗口形状？
代码要怎样写？能不能上传一个完整的 源码？

Answer 1

很早以前见过一个根据bmp+掩码bmp生成不规则form的控件

Answer 2

procedure CrateGraphicRGN(hWnd : Cardinal ;mGraphic:   TBitmap;   mTransPoint:   TPoint);
var
    I,   J:   Integer; 
    vStart:   Integer; 
    vHandle:   HRGN;
    vTransColor,nColor :   TColor;
    hResult : HRGN;
    Row : PByteArray;
    R,G,B : Byte;
    nsize : Integer;
begin  if not  Assigned(mGraphic) then Exit;
  if mGraphic.PixelFormat = pf24bit then nsize := 3
  else if mGraphic.PixelFormat = pf32bit then nsize := 4;
  hResult := CreateRectRgn(0,0,0,0);
  vTransColor := mGraphic.Canvas.Pixels[mTransPoint.X, mTransPoint.Y];
  for I :=  0 to  mGraphic.Height -  1  do
  begin
    vStart := 0;
    Row := mGraphic.ScanLine[i];
    for J := 0 to mGraphic.Width - 1 do
    begin
      R := Row[j * nsize + 2];
      G := Row[j * nsize + 1];
      B := Row[j * nsize ];
      nColor := RGB(R,G,b);
      if (nColor <> vTransColor) and (J < mGraphic.Width) then
      begin
        if vStart < 0   then
          vStart := J;
      end
      else
      if vStart >= 0 then
      begin
        vHandle := CreateRectRgn(vStart, I, J, I + 1);
        try
          CombineRgn(hResult,   hResult,   vHandle,   RGN_OR);
        finally
          DeleteObject(vHandle);
        end;
        vStart := -1;
      end;
    end;
  end;
  try
    SetWindowRgn(hWnd,   hResult,   True);
  finally
     DeleteObject(hResult);
  end;
end;CrateGraphicRGN(form1.handle,img1.picture.bitmap,point(0,0));

Answer 3

CrateGraphicRGN(form1.handle,img1.picture.bitmap,point(0,0));就这么调用啊
在窗体上扔个image，然后用image载入bmp 图片，以关键色透明(0,0)点的像素颜色
不过这样会有锯齿。。

Answer 4

比如 扣掉 图片 颜色 RGB 为 255 0 255的颜色要程序中怎样使用这段代码？

Answer 5

unit mian;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;type
  TForm1 = class(TForm)
    Image1: TImage;
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}CrateGraphicRGN (Form1.Handle,Image1.Picture.Bitmap);
end.
procedure CrateGraphicRGN(hWnd : Cardinal ;mGraphic:   TBitmap;   mTransPoint:   TPoint);
var
    I,   J:   Integer;
    vStart:   Integer;
    vHandle:   HRGN;
    vTransColor,nColor :   TColor;
    hResult : HRGN;
    Row : PByteArray;
    R,G,B : Byte;
    nsize : Integer;
begin  if not  Assigned(mGraphic) then Exit;
  if mGraphic.PixelFormat = pf24bit then nsize := 3
  else if mGraphic.PixelFormat = pf32bit then nsize := 4;
  hResult := CreateRectRgn(0,0,0,0);
  vTransColor := mGraphic.Canvas.Pixels[mTransPoint.X, mTransPoint.Y];
  for I :=  0 to  mGraphic.Height -  1  do
  begin
    vStart := 0;
    Row := mGraphic.ScanLine[i];
    for J := 0 to mGraphic.Width - 1 do
    begin
      R := Row[j * nsize + 2];
      G := Row[j * nsize + 1];
      B := Row[j * nsize ];
      nColor := RGB(R,G,b);
      if (nColor <> vTransColor) and (J < mGraphic.Width) then
      begin
        if vStart < 0   then
          vStart := J;
      end
      else
      if vStart >= 0 then
      begin
        vHandle := CreateRectRgn(vStart, I, J, I + 1);
        try
          CombineRgn(hResult,   hResult,   vHandle,   RGN_OR);
        finally
          DeleteObject(vHandle);
        end;
        vStart := -1;
      end;
    end;
  end;
  try
    SetWindowRgn(hWnd,   hResult,   True);
  finally
     DeleteObject(hResult);
  end;
我在 From的 窗体中加了
但是是报 缺少 END. 

Answer 6

image1.setbound(0,0,width,height);
图片必须以（0，0）点的颜色为关键色
控件大小和窗体大小一样。。

Answer 7

这么写的还是 窗口全部透明了
unit mian;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm} procedure CrateGraphicRGN(hWnd : Cardinal ;mGraphic:   TBitmap;   mTransPoint:   TPoint);
var
    I,   J:   Integer; 
    vStart:   Integer; 
    vHandle:   HRGN;
    vTransColor,nColor :   TColor;
    hResult : HRGN;
    Row : PByteArray;
    R,G,B : Byte;
    nsize : Integer;
begin  if not  Assigned(mGraphic) then Exit;
  if mGraphic.PixelFormat = pf24bit then nsize := 3
  else if mGraphic.PixelFormat = pf32bit then nsize := 4;
  hResult := CreateRectRgn(0,0,0,0);
  vTransColor := mGraphic.Canvas.Pixels[mTransPoint.X, mTransPoint.Y];
  for I :=  0 to  mGraphic.Height -  1  do
  begin
    vStart := 0;
    Row := mGraphic.ScanLine[i];
    for J := 0 to mGraphic.Width - 1 do
    begin
      R := Row[j * nsize + 1];
      G := Row[j * nsize + 2];
      B := Row[j * nsize ];
      nColor := RGB(255,0,255);
      if (nColor <> vTransColor) and (J < mGraphic.Width) then
      begin
        if vStart < 0   then
          vStart := J;
      end
      else
      if vStart >= 0 then
      begin
        vHandle := CreateRectRgn(vStart, I, J, I + 1);
        try
          CombineRgn(hResult,   hResult,   vHandle,   RGN_OR);
        finally
          DeleteObject(vHandle);
        end;
        vStart := -1;
      end;
    end;
  end;
  try
    SetWindowRgn(hWnd,   hResult,   True);
  finally
     DeleteObject(hResult);
  end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.brush.bitmap:=image1.picture.bitmap ;
CrateGraphicRGN(Form1.Handle,Form1.brush.bitmap,Point(0,0));end;end.

Answer 8

CrateGraphicRGN(Form1.Handle,image1.picture.bitmap,Point(0,0));

Answer 9

unit Unit1;interfaceuses
  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.
不知道是不是这个意思