要制作动画幻灯片,您可以使用如下代码:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
FFeedbackBtn: TPanel;
FFeedbackPanel: TPanel;
procedure OnFeedbackBtnMouseEnter(Sender: TObject);
procedure OnFeedbackPanelMouseLeave(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
FFeedbackBtn := TPanel.Create(Self);
FFeedbackBtn.Parent := Self;
FFeedbackBtn.Anchors := [akLeft, akTop, akBottom];
FFeedbackBtn.Caption := '';
FFeedbackBtn.SetBounds(0, 0, 40, ClientHeight);
FFeedbackBtn.OnMouseEnter := OnFeedbackBtnMouseEnter;
FFeedbackPanel := TPanel.Create(Self);
FFeedbackPanel.Parent := Self;
FFeedbackPanel.Anchors := [akLeft, akTop, akBottom];
FFeedbackPanel.Caption := 'Feedback panel';
FFeedbackPanel.Visible := False;
FFeedbackPanel.SetBounds(0, 0, 250, ClientHeight);
FFeedbackPanel.OnMouseLeave := OnFeedbackPanelMouseLeave;
end;
procedure TForm1.OnFeedbackBtnMouseEnter(Sender: TObject);
begin
AnimateWindow(FFeedbackPanel.Handle, 150, AW_ACTIVATE or AW_SLIDE or
AW_HOR_POSITIVE);
end;
procedure TForm1.OnFeedbackPanelMouseLeave(Sender: TObject);
begin
AnimateWindow(FFeedbackPanel.Handle, 150, AW_HIDE or AW_SLIDE or
AW_HOR_NEGATIVE);
end;
end.
Run Code Online (Sandbox Code Playgroud)
更新:
这是上面的另一个版本,现在有一个垂直文本,就像典型的反馈按钮一样,在按钮面板上拉伸的绘图框上呈现:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
FFeedbackBtn: TPanel;
FFeedbackBtnOverlay: TPaintBox;
FFeedbackPanel: TPanel;
procedure OnFeedbackBtnMouseEnter(Sender: TObject);
procedure OnFeedbackPanelMouseLeave(Sender: TObject);
procedure OnFeedbackBtnOverlayPaint(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
FFeedbackBtn := TPanel.Create(Self);
FFeedbackBtn.Parent := Self;
FFeedbackBtn.Anchors := [akLeft, akTop, akBottom];
FFeedbackBtn.Caption := '';
FFeedbackBtn.Color := $0000B3FF;
FFeedbackBtn.ParentBackground := False;
FFeedbackBtn.SetBounds(0, 0, 40, ClientHeight);
FFeedbackBtnOverlay := TPaintBox.Create(Self);
FFeedbackBtnOverlay.Parent := FFeedbackBtn;
FFeedbackBtnOverlay.Align := alClient;
FFeedbackBtnOverlay.OnPaint := OnFeedbackBtnOverlayPaint;
FFeedbackBtnOverlay.OnMouseEnter := OnFeedbackBtnMouseEnter;
FFeedbackPanel := TPanel.Create(Self);
FFeedbackPanel.Parent := Self;
FFeedbackPanel.Anchors := [akLeft, akTop, akBottom];
FFeedbackPanel.Caption := 'Feedback panel';
FFeedbackPanel.Color := $0000F9FF;
FFeedbackPanel.ParentBackground := False;
FFeedbackPanel.Visible := False;
FFeedbackPanel.SetBounds(0, 0, 250, ClientHeight);
FFeedbackPanel.OnMouseLeave := OnFeedbackPanelMouseLeave;
end;
procedure TForm1.OnFeedbackBtnMouseEnter(Sender: TObject);
begin
AnimateWindow(FFeedbackPanel.Handle, 150, AW_ACTIVATE or AW_SLIDE or
AW_HOR_POSITIVE);
end;
procedure TForm1.OnFeedbackPanelMouseLeave(Sender: TObject);
begin
AnimateWindow(FFeedbackPanel.Handle, 150, AW_HIDE or AW_SLIDE or
AW_HOR_NEGATIVE);
end;
procedure TForm1.OnFeedbackBtnOverlayPaint(Sender: TObject);
var
S: string;
X, Y: Integer;
begin
S := 'Feedback...';
with FFeedbackBtnOverlay do
begin
Canvas.Brush.Color := $0000B3FF;
Canvas.FillRect(ClientRect);
Canvas.Font.Orientation := 900;
X := (ClientWidth - Canvas.TextHeight(S)) div 2;
Y := ClientHeight - (ClientHeight - Canvas.TextWidth(S)) div 2;
Canvas.TextOut(X, Y, S);
end;
end;
end.
Run Code Online (Sandbox Code Playgroud)
结果如下:

您还应该实现一些逻辑,以防止用户在实际填充字段时隐藏反馈面板,但这是这种反馈形式的自然弱点.