大富翁们救命,着急!急救!失业在家搞点小玩意,撞上老虎,透明窗体上生成Label显示不出来 (300分)

  • 主题发起人 主题发起人 wangnen
  • 开始时间 开始时间
W

wangnen

Unregistered / Unconfirmed
GUEST, unregistred user!
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
FullRgn, lblRgn: THandle;
procedure SetTransparent;

end;


var
Form1: TForm1;


implementation

{$R *.DFM}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
lbl: TLabel;
begin

SetTransparent;
lbl := TLabel.Create(self);
with lbldo

begin

parent := Form1;
left := 100;
top := 100;
Font.Size := 72;
Caption := 'abcdefg';
show;
end;

end;


procedure TForm1.SetTransparent;
var
I: Integer;
ClientRgn, ControlRgn: THandle;
Margin, MarginX, MarginY, X, Y: Integer;
W,H :Integer;
bX,bY :Integer;
c1 :TColor;
lbl: TLabel;
begin


Margin := (Width - ClientWidth) div 2;
FullRgn := CreateRectRgn(0, 0, Width, Height);
MarginX := Margin;
MarginY := Height - ClientHeight - Margin;
ClientRgn := CreateRectRgn(MarginX, MarginY, MarginX + ClientWidth, MarginY + ClientHeight);
CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);
DeleteObject(ClientRgn);
for I:=0 to ControlCount-1do

begin

X := MarginX + Controls.Left;
Y := MarginY + Controls.Top;
W:=Controls.Width;
H:=Controls.Height;
if controls is TLabel then

begin

lbl := controls as TLabel
lblRgn := CreateRectRgn(lbl.Left, lbl.Top, lbl.Width, lbl.Height);
begin

for bX:=0 to lbl.Width-1do
begin

for bY:=0 to lbl.Height-1do
begin

c1 := lbl.Canvas.Pixels[bX,bY];
if c1=16777215 then
begin

ControlRgn := CreateRectRgn(X+bX, Y+bY, X + bX+1, Y + bY+1);
CombineRgn(FullRgn, FullRgn, ControlRgn, RGN_OR);
DeleteObject(ControlRgn);
end;

end;

end;

end;

end else
begin

ControlRgn := CreateRectRgn(X, Y, X + W, Y + H);
CombineRgn(FullRgn, FullRgn, ControlRgn, RGN_OR);
DeleteObject(ControlRgn);
end;

end;


SetWindowRgn(Handle, FullRgn, True);
DeleteObject(FullRgn);

end;


procedure TForm1.Button2Click(Sender: TObject);
var
bX,bY: integer;
begin

for bX:=0 to Label1.Width-1do

begin

sleep(1);
for bY:=0 to Label1.Height-1do

if Label1.Canvas.Pixels[bX,bY]= 16777215 then

begin

Label1.Canvas.Pixels[bX,bY] := 16711680;
end;

end;

end;


procedure TForm1.Button3Click(Sender: TObject);
begin


label1.Caption := '我是中国人';//不能正常显示
end;

 
明天去公司看看
 
如果你生成rgn的语句没错, 那么错在这里
DeleteObject(FullRgn);

注意:
SetWindowRgn里面带的rgn你的程序不能再使用了(也不能释放), 它的操作和释放都由windows接管了。
你就当它已经被SetWindowRgn释放掉了好了

题外话:
生成Label的rgn的语句效率太低了点吧?
下面这个函数应该比你的代码效率高, 你可以把它改一下嵌入你的程序里(直接调用也行, 不过调一次就动态建立一个bmp然后又删除, 浪费了点)
function CreateRgnFromText(AText: string;
Font: TFont;
AtX: Integer=0;
AtY: Integer=0): HRGN;
var
bmp: TBitmap;
OldF: LongInt;
sz: TSize;
r1: HRGN;
begin

if AText = '' then

begin

Result := CreateRectRgn(-10, -10, -9, -9);
Exit;
end;

bmp := TBitmap.Create;
OldF := SelectObject(bmp.Canvas.Handle, Font.Handle);
GetTextExtentPoint32(bmp.Canvas.Handle, PChar(AText), Length(AText), sz);
selectobject(bmp.canvas.handle, oldf);
bmp.width := sz.cx;
bmp.height := sz.cy;
r1 := CreateRectRgn(0,0,sz.cx, sz.cy);
oldf := selectobject(bmp.canvas.handle, font.handle);
begin
path(bmp.canvas.handle);
setbkcolor(bmp.canvas.handle, colortorgb(clWhite));
settextcolor(bmp.canvas.handle, colortorgb(clBlack));
textout(bmp.canvas.handle, 0, 0, PChar(AText), Length(AText));
endpath(bmp.canvas.handle);
result := pathtoregion(bmp.canvas.handle);
combineRgn(Result, r1, Result, RGN_DIFF);
deleteobject(r1);
selectObject(bmp.Canvas.Handle, OldF);
bmp.Free;
offsetrgn(result, AtX, AtY);
end;



 
我最近也在研究这问题,Peral代的码我没有调试好,还请指教
 
晕,如果这样,还不如CANVAS。TEXT呢!:)这样效率太差!
 
to 天真
我要不停的改变Caption,有好方法能提供段源码吗?谢啦
 
好的,但你要实现什么?
 
to 天真
运行是按Button3改变label.caption,再点Button2,但是原Label.caption挡住了刚赋的Caption
 
我已等待了几个日夜了;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
好的,今晚试试
 
运行是按Button3改变label.caption,再点Button2,但是原Label.caption挡住了刚赋的Caption
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Label.SendToBack;
 
to wind2000
我试了下还不能解决问提,我现把Button2,3内容附上
 
不太明白你的要求:(

不过同意 Pearl. 应该用 begin
Path..EndPath..PathToRegion 来处理,不应该用颜色来处理
 
没搞懂你的意思
 
如果要透明要这样吗???
LABEL1不是有一个透明属性的???
 
你的目的是使按钮色彩逐点变化吗
 
to 天真
没用
我要透过这个窗体看见另一个窗体,这个窗体上Label不停的显示不同的内容
 
没有呀,我用得好好的!那就过两天我再试试吧,要不你把源码发到我swnumaochang@hotmail.com
 
to 天真
发了,看看,谢啦
 
后退
顶部