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;
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;