1. 透明panel
unit uWnTransparentPanel;
interface
uses
Windows,Classes,StdCtrls,ExtCtrls,Messages,Forms;
type
TWnTransparentPanel = class(TPanel)
private
FTransparentPercent: Integer;
procedure SetTransparentPercent(const Value: Integer);
protected
procedure WMPaint(var message : TMessage); message WM_Paint;
public
procedure StepShow(const ALeft,ATop,HStet,VStep:Integer);
published
property TransparentPercent: Integer read FTransparentPercent write SetTransparentPercent;
end;
implementation
{ TWnTransparentPanel }
procedure TWnTransparentPanel.SetTransparentPercent(const Value: Integer);
begin
FTransparentPercent := Value;
end;
procedure TWnTransparentPanel.StepShow(const ALeft, ATop,HStet, VStep: Integer);
var
I: Integer;
begin
Visible := True;
Left := ALeft;
Top := ATop+VStep*10 ;
for I := 0 to 9 do
begin
Top := ATop +(9-I)*VStep;
Self.Parent.Update;
Self.Repaint;
Sleep(100);
Application.HandleMessage;
end;
end;
procedure TWnTransparentPanel.WMPaint(var message: TMessage);
procedure AlphaBlendTabControl;
var
MemBitmap, OldBitmap: HBITMAP;
BF: BLENDFUNCTION;
MemDC, DC: HDC;
begin
if (Parent = nil) or not Parent.HandleAllocated then
Exit;
DC := GetDC(0);
MemBitmap := CreateCompatibleBitmap(DC, Parent.Width, Parent.Height);
ReleaseDC(0, DC);
MemDC := CreateCompatibleDC(0);
OldBitmap := SelectObject(MemDC, MemBitmap);
try
Parent.Perform(WM_ERASEBKGND, MemDC, MemDC);
Parent.Perform(WM_PAINT, MemDC, 0);
BF.SourceConstantAlpha := TransparentPercent;
BF.AlphaFormat := 0;
BF.BlendOp := AC_SRC_OVER;
BF.BlendFlags := 0;
Windows.AlphaBlend(Canvas.Handle, 0, 0, Width, Height, MemDC, Left, Top, Width, Height, BF);
finally
SelectObject(MemDC, OldBitmap);
DeleteDC(MemDC);
DeleteObject(MemBitmap);
end;
end;
begin
inherited;
AlphaBlendTabControl;
end;
end.
interface
uses
Windows,Classes,StdCtrls,ExtCtrls,Messages,Forms;
type
TWnTransparentPanel = class(TPanel)
private
FTransparentPercent: Integer;
procedure SetTransparentPercent(const Value: Integer);
protected
procedure WMPaint(var message : TMessage); message WM_Paint;
public
procedure StepShow(const ALeft,ATop,HStet,VStep:Integer);
published
property TransparentPercent: Integer read FTransparentPercent write SetTransparentPercent;
end;
implementation
{ TWnTransparentPanel }
procedure TWnTransparentPanel.SetTransparentPercent(const Value: Integer);
begin
FTransparentPercent := Value;
end;
procedure TWnTransparentPanel.StepShow(const ALeft, ATop,HStet, VStep: Integer);
var
I: Integer;
begin
Visible := True;
Left := ALeft;
Top := ATop+VStep*10 ;
for I := 0 to 9 do
begin
Top := ATop +(9-I)*VStep;
Self.Parent.Update;
Self.Repaint;
Sleep(100);
Application.HandleMessage;
end;
end;
procedure TWnTransparentPanel.WMPaint(var message: TMessage);
procedure AlphaBlendTabControl;
var
MemBitmap, OldBitmap: HBITMAP;
BF: BLENDFUNCTION;
MemDC, DC: HDC;
begin
if (Parent = nil) or not Parent.HandleAllocated then
Exit;
DC := GetDC(0);
MemBitmap := CreateCompatibleBitmap(DC, Parent.Width, Parent.Height);
ReleaseDC(0, DC);
MemDC := CreateCompatibleDC(0);
OldBitmap := SelectObject(MemDC, MemBitmap);
try
Parent.Perform(WM_ERASEBKGND, MemDC, MemDC);
Parent.Perform(WM_PAINT, MemDC, 0);
BF.SourceConstantAlpha := TransparentPercent;
BF.AlphaFormat := 0;
BF.BlendOp := AC_SRC_OVER;
BF.BlendFlags := 0;
Windows.AlphaBlend(Canvas.Handle, 0, 0, Width, Height, MemDC, Left, Top, Width, Height, BF);
finally
SelectObject(MemDC, OldBitmap);
DeleteDC(MemDC);
DeleteObject(MemBitmap);
end;
end;
begin
inherited;
AlphaBlendTabControl;
end;
end.
2. 设计的时候,panel可以用Anchors = [akLeft, akTop, akRight, akBottom] 加上Align = alCustom达到自动预留边框的目的,就可以避免panel用Align = alClient的时候panel贴边的问题
3. Grid载入数据的时候界面频刷的问题,主要是要Grid paint之初就要设定好高宽,而不是边画边设高宽