怎样为DELPHI窗体加上阴影? ( 积分: 100 )

  • 主题发起人 主题发起人 sbepl1983
  • 开始时间 开始时间
S

sbepl1983

Unregistered / Unconfirmed
GUEST, unregistred user!
怎样为DELPHI窗体加上阴影?不知各位有没有什么好方法
 
转贴:
来自: BrainYang, 时间: 2006/01/27 8:55:19, ID: 3341779
以下来自YourBase 2003 资料管理软件 + 完部源代码,很漂亮的ShadowForm,
不过用到了第三方控件Developer ExpressBar 5.1
http://www.2ccc.com/article.asp?articleid=265
http://downloads.2ccc.com/general/database/YourBase2003.rar
-----------------------------------------------------------
unit CAbout;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, RzPanel, StdCtrls, RzLabel, dxBar, RzStatus;
type
TfAbout = class(TForm)
RzPanel1: TRzPanel;
Image1: TImage;
RzLabel1: TRzLabel;
RzLabel2: TRzLabel;
Label1: TLabel;
VerInfoLabel: TLabel;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormActivate(Sender: TObject);
private
FormShadow : TdxBarShadow;
HShadowCtrl : TdxBarShadowPart;
VShadowCtrl : TdxBarShadowPart;
procedure pUpdateShadowPos;
protected
procedure WMMoving(var Message: TWMMoving); message WM_MOVING;
public
end;
var
fAbout: TfAbout;
implementation
{$R *.dfm}

procedure TfAbout.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
{ 关闭 }
Close;
end;

procedure TfAbout.FormCreate(Sender: TObject);
begin
{ 创建窗口 }
Image1.Picture.LoadFromFile(pGetCurDir+'Graphics/AboutBitmap.bmp');

FormShadow := TdxBarShadow.Create(Self);
FormShadow.Visible := True;
HShadowCtrl := TdxBarShadowPart.CreateEx(FormShadow,spHorizontal,[scRight,scTop,scLeft]);
VShadowCtrl := TdxBarShadowPart.CreateEx(FormShadow,spVertical,[scRight,scTop,scLeft]);

VerInfoLabel.Caption := '简体中文语系(Builder '+VI.FileVersion+')';
end;

procedure TfAbout.FormClose(Sender: TObject; var Action: TCloseAction);
begin
{ 关闭窗口 }
HShadowCtrl.Free;
VShadowCtrl.Free;
FormShadow.Free;
end;

procedure TfAbout.pUpdateShadowPos;
var
R : TRect;
begin
inherited;
{ 更新影子位置 }
R.Left := Left + Width;
R.Top := Top + 3;
R.Right := R.Left + 5;
R.Bottom := R.Top + Height - 2;
VShadowCtrl.UpdateBounds(R);

R.Left := Left + 5;
R.Top := Top + Height;
R.Right := R.Left + Width - 2;
R.Bottom := R.Top + 5;
HShadowCtrl.UpdateBounds(R);
end;

procedure TfAbout.WMMoving(var Message: TWMMoving);
begin
{ 移动窗口时也移动影子 }
inherited;
pUpdateShadowPos;
end;

procedure TfAbout.FormActivate(Sender: TObject);
begin
{ 初始化窗口 }
pUpdateShadowPos;
end;

end.
 
上面的代码不错,或者自己用个TImage画个阴影贴上去。
 
XP下有效

type
TForm1 = class(TForm)
protected
procedure CreateParams(var Params: TCreateParams); override;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.CreateParams(var Params: TCreateParams);
const
CS_DROPSHADOW = $00020000;
begin
inherited;
Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
end;
 
后退
顶部