谢谢~
我从CSDN上下载的源代码,然后在源图基础上修改了图片大小,结果出来的效果是:四个角没有了。我仔细看了代码,没有找到修改四个角的地方,我只是想画出个长方形,不想让程序修改四个角,不知哪位大侠帮忙看看?代码如下:function WndNewProc(Wnd: HWND; uMsg: UINT; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall;
var Rect: TRect;
begin
Result := 0;
case uMsg of
WM_DESTROY: PostQuitMessage(0);
WM_LBUTTONDOWN: SendMessage(Wnd, WM_SYSCOMMAND, SC_MOVE+2, 0);
else
begin
if ((uMsg = WM_MOVING) or (uMsg = WM_MOVE)) and GetWindowRect(Wnd, Rect) then
SetWindowPos(ComponentForm.Handle, 0, Rect.Left, Rect.Top, 0, 0, SWP_NOSIZE);
Result := DefWindowProc(Wnd, uMsg, wPar, lPar);
end;
end;
end;//Funkcja odmalowuj筩a p蟪przezroczyste okno z uwzgl阣nieniem regionu
procedure PaintLayeredWindow(Hnd: THandle; Region: HRGN);
var blend: BLENDFUNCTION; //该结构控制指定用于源位图和目标位图使用混合功能
P: TPoint;
S: TSize;
X, Y: integer;
bmpRGBA: TBitmap;
Alpha: byte;
Linia32: PRGBQuad;
Linia32RGBA: PRGBQuad;
begin
//Tworzenie warstwy RGB
bmpRGBA:=Form1.img1.Picture.Bitmap;
try
//Sklejenie RGB oraz wygenerowanego A
with TBitmap.Create() do
begin
try
Width := bmpRGBA.Width;
Height := bmpRGBA.Height;
PixelFormat := pf32bit;
for Y := 0 to Height-1 do
begin
Linia32RGBA := bmpRGBA.ScanLine[Y];
Linia32 := ScanLine[Y];
for X := 0 to Width-1 do
begin
if PtInRegion(Region, X, Y) then
Alpha := 0
else
Alpha := Linia32RGBA.rgbReserved;
Linia32.rgbRed := MulDiv(Linia32RGBA.rgbRed, Alpha, 255);
Linia32.rgbGreen := MulDiv(Linia32RGBA.rgbGreen, Alpha, 255);
Linia32.rgbBlue := MulDiv(Linia32RGBA.rgbBlue, Alpha, 255);
Linia32.rgbReserved := Alpha;
inc(Linia32);
inc(Linia32RGBA);
end;
end;//Nak砤danie bitmapy
P := Point(0, 0);
S.cx := bmpRGBA.Width;
S.cy := bmpRGBA.Height;
blend.BlendOp := AC_SRC_OVER;
blend.BlendFlags := 0;
blend.AlphaFormat := AC_SRC_ALPHA;
blend.SourceConstantAlpha := 255;
UpdateLayeredWindow(Hnd, GetDC(0), nil, @S, Canvas.Handle, @P, 0, @blend, ULW_ALPHA);
finally
Free;
end;
end;
finally
end;
end;//Tworzenie region體, wycinanie okna komponent體 i tworzenie okna p蟪przezroczystego
procedure CreateLayered(Form: TForm);
var Region: HRGN;
ComponentRegion: HRGN;
i:Integer;
const LayeredWndClass = 'LayeredWndClass';
begin
ComponentForm := Form;
ComponentForm.BorderStyle := bsNone;
Region := CreateRectRgn(0, 0, 0, 0);
for i := 0 to ComponentForm.ControlCount-1 do
if ComponentForm.Controls[i].Visible then
begin
ComponentRegion := CreateRectRgn(ComponentForm.Controls[i].Left, ComponentForm.Controls[i].Top, ComponentForm.Controls[i].Width+ComponentForm.Controls[i].Left, ComponentForm.Controls[i].Height+ComponentForm.Controls[i].Top);
CombineRgn(Region, Region, ComponentRegion, RGN_OR);
DeleteObject(ComponentRegion);
end;
with Wnd do
begin
lpfnWndProc := @WndNewProc;
hInstance := hInstance;
lpszClassName := LayeredWndClass;
hbrBackground := COLOR_WINDOW;
end;
Windows.RegisterClass(Wnd);
Hnd := CreateWindowEx(WS_EX_LAYERED, LayeredWndClass, PChar(ComponentForm.Caption), WS_VISIBLE, ComponentForm.Left, ComponentForm.Top, ComponentForm.Width, ComponentForm.Height, ComponentForm.Handle, 0, hInstance, NIL);
PaintLayeredWindow(Hnd, Region);
SetWindowRgn(ComponentForm.Handle, Region, TRUE);
DeleteObject(Region);
end;procedure TForm1.FormShow(Sender: TObject);
begin
PostMessage(Handle, WM_SHOWFRAME, 0, 0);
end;procedure TForm1.ShowFrame(var Msg: TMessage);
begin
CreateLayered(self);
end;
我从CSDN上下载的源代码,然后在源图基础上修改了图片大小,结果出来的效果是:四个角没有了。我仔细看了代码,没有找到修改四个角的地方,我只是想画出个长方形,不想让程序修改四个角,不知哪位大侠帮忙看看?代码如下:function WndNewProc(Wnd: HWND; uMsg: UINT; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall;
var Rect: TRect;
begin
Result := 0;
case uMsg of
WM_DESTROY: PostQuitMessage(0);
WM_LBUTTONDOWN: SendMessage(Wnd, WM_SYSCOMMAND, SC_MOVE+2, 0);
else
begin
if ((uMsg = WM_MOVING) or (uMsg = WM_MOVE)) and GetWindowRect(Wnd, Rect) then
SetWindowPos(ComponentForm.Handle, 0, Rect.Left, Rect.Top, 0, 0, SWP_NOSIZE);
Result := DefWindowProc(Wnd, uMsg, wPar, lPar);
end;
end;
end;//Funkcja odmalowuj筩a p蟪przezroczyste okno z uwzgl阣nieniem regionu
procedure PaintLayeredWindow(Hnd: THandle; Region: HRGN);
var blend: BLENDFUNCTION; //该结构控制指定用于源位图和目标位图使用混合功能
P: TPoint;
S: TSize;
X, Y: integer;
bmpRGBA: TBitmap;
Alpha: byte;
Linia32: PRGBQuad;
Linia32RGBA: PRGBQuad;
begin
//Tworzenie warstwy RGB
bmpRGBA:=Form1.img1.Picture.Bitmap;
try
//Sklejenie RGB oraz wygenerowanego A
with TBitmap.Create() do
begin
try
Width := bmpRGBA.Width;
Height := bmpRGBA.Height;
PixelFormat := pf32bit;
for Y := 0 to Height-1 do
begin
Linia32RGBA := bmpRGBA.ScanLine[Y];
Linia32 := ScanLine[Y];
for X := 0 to Width-1 do
begin
if PtInRegion(Region, X, Y) then
Alpha := 0
else
Alpha := Linia32RGBA.rgbReserved;
Linia32.rgbRed := MulDiv(Linia32RGBA.rgbRed, Alpha, 255);
Linia32.rgbGreen := MulDiv(Linia32RGBA.rgbGreen, Alpha, 255);
Linia32.rgbBlue := MulDiv(Linia32RGBA.rgbBlue, Alpha, 255);
Linia32.rgbReserved := Alpha;
inc(Linia32);
inc(Linia32RGBA);
end;
end;//Nak砤danie bitmapy
P := Point(0, 0);
S.cx := bmpRGBA.Width;
S.cy := bmpRGBA.Height;
blend.BlendOp := AC_SRC_OVER;
blend.BlendFlags := 0;
blend.AlphaFormat := AC_SRC_ALPHA;
blend.SourceConstantAlpha := 255;
UpdateLayeredWindow(Hnd, GetDC(0), nil, @S, Canvas.Handle, @P, 0, @blend, ULW_ALPHA);
finally
Free;
end;
end;
finally
end;
end;//Tworzenie region體, wycinanie okna komponent體 i tworzenie okna p蟪przezroczystego
procedure CreateLayered(Form: TForm);
var Region: HRGN;
ComponentRegion: HRGN;
i:Integer;
const LayeredWndClass = 'LayeredWndClass';
begin
ComponentForm := Form;
ComponentForm.BorderStyle := bsNone;
Region := CreateRectRgn(0, 0, 0, 0);
for i := 0 to ComponentForm.ControlCount-1 do
if ComponentForm.Controls[i].Visible then
begin
ComponentRegion := CreateRectRgn(ComponentForm.Controls[i].Left, ComponentForm.Controls[i].Top, ComponentForm.Controls[i].Width+ComponentForm.Controls[i].Left, ComponentForm.Controls[i].Height+ComponentForm.Controls[i].Top);
CombineRgn(Region, Region, ComponentRegion, RGN_OR);
DeleteObject(ComponentRegion);
end;
with Wnd do
begin
lpfnWndProc := @WndNewProc;
hInstance := hInstance;
lpszClassName := LayeredWndClass;
hbrBackground := COLOR_WINDOW;
end;
Windows.RegisterClass(Wnd);
Hnd := CreateWindowEx(WS_EX_LAYERED, LayeredWndClass, PChar(ComponentForm.Caption), WS_VISIBLE, ComponentForm.Left, ComponentForm.Top, ComponentForm.Width, ComponentForm.Height, ComponentForm.Handle, 0, hInstance, NIL);
PaintLayeredWindow(Hnd, Region);
SetWindowRgn(ComponentForm.Handle, Region, TRUE);
DeleteObject(Region);
end;procedure TForm1.FormShow(Sender: TObject);
begin
PostMessage(Handle, WM_SHOWFRAME, 0, 0);
end;procedure TForm1.ShowFrame(var Msg: TMessage);
begin
CreateLayered(self);
end;
解决方案 »
- 多线程的问题,请帮忙看下代码有什么问题。3Q
- 关于在DBGRID绑定数据显示问题,急!
- 如何取ComboBox内容的前几位?
- 简单的问题---用SQLConnection 连接SQL Server 2000 时出现错误"unable to load libmysql.dll"???
- 请高手指点一下,怎样从DLL中返回string型的二维数组
- 为什么我在窗体启动时,控制别的窗体控件是否显示,总是出错?
- 在用delphi6.0+sql server 2000作程序时出现invalid authorization specification 错误,如何解决呀
- 本人现在有QQ号码n个(n>1000),现在放在我的信箱中,而且每天都在增加!!!有人愿意收购吗?价格2000左右。
- 关联数据表--数据增加问题
- 关于用Delphi5编写与Excel软件交换数据的问题
- ComboBox下拉后鼠标停留在哪一项上,就在label中显示该项的text,怎么实现?
- cxgrid 抓取资料库中的图片路径显示图片在cxgrid上
你好。
还有一个后续问题想要请教您,已给您发消息了,感谢。
11月30日