如何使标签在滚动框中平滑居中?

时间:2016-06-18 22:30:41

标签: delphi delphi-xe7 tlabel tscrollbox

我在TMemo中使用TScrollBox来显示一些文字,并在顶部使用TLabel作为标题信息。有时备忘录比滚动框宽,当然Horizontal scroll bar可用于向左和向右滚动以查看备忘录中的文本。 我希望标签总是以滚动框可见区域为中心。我可以通过设置Label1.Left:= (Scrollbox1.Width div 2) - (Label1.Width div 2);来实现这一点,它可以工作,但它有点闪烁,在来回滚动时摇晃。备忘录顺利进行,标签没有。

enter image description here

这是单位:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type

  TScrollBox=Class(VCL.Forms.TScrollBox)
    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
  private
    FOnScrollHorz: TNotifyEvent;
  public
   Property OnScrollHorz:TNotifyEvent read FOnScrollHorz Write FonScrollHorz;
  End;

  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    Label1: TLabel;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure ScrollBox1Resize(Sender: TObject);
  private
    procedure MyScrollHorz(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TScrollBox.WMHScroll(var Message: TWMHScroll);
begin
   inherited;
   if Assigned(FOnScrollHorz) then  FOnScrollHorz(Self);
end;

procedure TForm1.MyScrollHorz(Sender: TObject);
begin
    Label1.Left:= (Scrollbox1.Width div 2) - (Label1.Width div 2);
end;

procedure TForm1.ScrollBox1Resize(Sender: TObject);
begin
  Label1.Left:= (Scrollbox1.Width div 2) - (Label1.Width div 2);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ScrollBox1.OnScrollHorz := MyScrollHorz;
end;

end.

和dfm:

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 212
  ClientWidth = 458
  Color = clBtnFace
  DoubleBuffered = True
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object ScrollBox1: TScrollBox
    Left = 0
    Top = 0
    Width = 458
    Height = 212
    HorzScrollBar.Smooth = True
    HorzScrollBar.Tracking = True
    Align = alClient
    BiDiMode = bdLeftToRight
    DoubleBuffered = True
    ParentBiDiMode = False
    ParentDoubleBuffered = False
    TabOrder = 0
    OnResize = ScrollBox1Resize
    ExplicitHeight = 337
    object Label1: TLabel
      Left = 192
      Top = 30
      Width = 69
      Height = 13
      BiDiMode = bdLeftToRight
      Caption = 'Details header'
      ParentBiDiMode = False
    end
    object Memo1: TMemo
      Left = 24
      Top = 70
      Width = 700
      Height = 89
      Lines.Strings = (
        'Details...')
      TabOrder = 0
    end
  end
end

我尝试使用DoubleBuffered,但没有帮助。

有关如何让Label1在没有闪烁/摇晃的情况下移动的任何建议,与滚动时Memo1一样顺畅吗?

修改

设计最终将是我在表单上有3个或滚动框,每个包含最多3个带标题的备忘录。滚动需要通过滚动框,因为同一滚动框中的所有备忘录需要同时滚动。这意味着我不知道如何将标签放在表单或面板上,然后放在表单上,​​滚动框外:

enter image description here

编辑2:

以下答案确实提供了良好的解决方案,但他们确实需要将Labels置于Scrollbox之外,并放在Form本身。然后直接在Scrollbox's上按scroll bars scroll barsForm移动。这确实会产生预期效果,但是Labels不再属于Scrollbox,会给您带来一些不便。

3 个答案:

答案 0 :(得分:2)

- “备忘录顺利进行,标签没有。

那是因为你试图阻止它移动。分离您的OnScrollHorz处理程序,标签将顺利移动。但这不是你想要的,它不会再以形式为中心。

问题是,在inherited调用(WM_HSCROLL)期间,标签随备忘录一起移动。在默认处理之后,您重新定位标签,因此闪烁。

您可以公开在默认滚动(OnBeforeHorzScroll)之前将触发的其他事件处理程序,并在触发时隐藏标签。当平滑地居中时,它会导致标签瞬间消失的不同类型的闪烁。仍然可能不太令人满意。

解决方案是使用一个控件,该控件是表单的父级,是滚动框的兄弟。您不能使用TLabel这样做,因为它是图形控件,但您可以使用TStaticText。如果 static 在设计时意外地落在滚动框后面,IDE的“结构窗格”可能会派上用场。

答案 1 :(得分:2)

你可以这样做:

而不是ScrollBox在表单上放置ScrollBar。将其对齐方式设置为底部(或者如果您希望拥有更多列,则可以手动设置其大小和位置,或者您可以将每个列放在其自己的面板中)。然后设置备忘录的大小并将标签放置在表单的中心。设置备忘录的大小(可能是通过代码动态)后,请输入以下代码:

ScrollBar1.Min:=0-Memo1.Left;
ScrollBar1.Max:=Memo1.Width-Form1.ClientWidth+Memo1.Left;

最后一件事是设置ScrollBar OnChange事件:

procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
  Memo1.Left:=0-ScrollBar1.Position;
  Memo2.Left:=0-ScrollBar1.Position;
  ...
  MemoXY.Left:=0-ScrollBar1.Position;
end;

您的表单应如下所示:

Scrollable memos

完成!您有一个稳定的居中标签和平滑可滚动的备忘录。

修改

这是一个版本,在他自己的Panel中各有3列,还有垂直滚动条:

Vertical scroll

整个源代码:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Memo1: TMemo;
    Memo2: TMemo;
    Memo3: TMemo;
    Memo4: TMemo;
    Memo5: TMemo;
    Memo6: TMemo;
    ScrollBar1: TScrollBar;
    ScrollBar2: TScrollBar;
    ScrollBar3: TScrollBar;
    ScrollBar4: TScrollBar;
    ScrollBar5: TScrollBar;
    ScrollBar6: TScrollBar;
    procedure FormCreate(Sender: TObject);
    procedure ScrollBarHChange(Sender: TObject);
    procedure ScrollBarVChange(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var cycle: Integer;
begin
  //GENERATE YOUR COMPONENTS HERE

  //sets every components tag to its default top position
  //(you can do this in any other way for example using array)
  for cycle:=0 to Form1.ComponentCount-1 do
  begin
    if(Form1.Components[cycle] is TControl)then
      Form1.Components[cycle].Tag:=(Form1.Components[cycle] as TControl).Top
  end;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  //changes the panels sizes and positions
  Panel1.Width:=Form1.ClientWidth div 3;
  Panel2.Width:=Form1.ClientWidth div 3;
  Panel3.Width:=Form1.ClientWidth div 3;
  Panel2.Left:=Panel1.Width+1;
  Panel3.Left:=Panel1.Width+Panel2.Width+1;

  //if you dont want all scrollbars to reset on window resize, you need to handle the positioning of elements when window (and panels) size is changing
  ScrollBar1.Position:=ScrollBar1.Min;
  ScrollBar2.Position:=ScrollBar2.Min;
  ScrollBar3.Position:=ScrollBar3.Min;
  ScrollBar4.Position:=ScrollBar4.Min;
  ScrollBar5.Position:=ScrollBar5.Min;
  ScrollBar6.Position:=ScrollBar6.Min;

  //make these tests on the widest element of each panel (8 is just a margin so the memo has some space on the right)
  if((Memo1.Left+Memo1.Width)>(Panel1.ClientWidth-ScrollBar4.Width-8))then
  begin
    ScrollBar1.Enabled:=true;
    ScrollBar1.Max:=Memo1.Width-Panel1.ClientWidth+Memo1.Left+ScrollBar4.Width+8;
  end
  else
    ScrollBar1.Enabled:=false;

  if((Memo3.Left+Memo3.Width)>(Panel2.ClientWidth-ScrollBar5.Width-8))then
  begin
    ScrollBar2.Enabled:=true;
    ScrollBar2.Max:=Memo3.Width-Panel1.ClientWidth+Memo3.Left+ScrollBar5.Width+8;
  end
  else
  begin
    ScrollBar2.Position:=ScrollBar2.Min;
    ScrollBar2.Enabled:=false;
  end;

  if((Memo5.Left+Memo5.Width)>(Panel3.ClientWidth-ScrollBar6.Width-8))then
  begin
    ScrollBar3.Enabled:=true;
    ScrollBar3.Max:=Memo5.Width-Panel1.ClientWidth+Memo5.Left+ScrollBar6.Width+8;
  end
  else
    ScrollBar3.Enabled:=false;

  //make these tests on the bottom element of each panel (16 is just a margin so the memo has some space on the bottom)
  if((Memo2.Top+Memo2.Height)>(Panel1.ClientHeight-ScrollBar1.Height-16))then
  begin
    ScrollBar4.Enabled:=true;
    ScrollBar4.Max:=Memo2.Top+Memo2.Height-Panel1.ClientHeight+ScrollBar1.Height+16;
  end
  else
    ScrollBar4.Enabled:=false;

  if((Memo4.Top+Memo4.Height)>(Panel2.ClientHeight-ScrollBar2.Height-16))then
  begin
    ScrollBar5.Enabled:=true;
    ScrollBar5.Max:=Memo4.Top+Memo4.Height-Panel2.ClientHeight+ScrollBar2.Height+16;
  end
  else
    ScrollBar5.Enabled:=false;

  if((Memo6.Top+Memo6.Height)>(Panel3.ClientHeight-ScrollBar3.Height-16))then
  begin
    ScrollBar6.Enabled:=true;
    ScrollBar6.Max:=Memo6.Top+Memo6.Height-Panel3.ClientHeight+ScrollBar3.Height+16;
  end
  else
    ScrollBar6.Enabled:=false;
end;

procedure TForm1.ScrollBarHChange(Sender: TObject);
var cycle: Integer;
begin
  for cycle:=0 to ((Sender as TScrollBar).Parent as TPanel).ControlCount-1 do
  begin
    if(((Sender as TScrollBar).Parent as TPanel).Controls[cycle] is TMemo)then
      (((Sender as TScrollBar).Parent as TPanel).Controls[cycle] as TMemo).Left:=0-(Sender as TScrollBar).Position+8;
  end;
end;

procedure TForm1.ScrollBarVChange(Sender: TObject);
var cycle: Integer;
begin
  for cycle:=0 to ((Sender as TScrollBar).Parent as TPanel).ControlCount-1 do
  begin
    if(not (((Sender as TScrollBar).Parent as TPanel).Controls[cycle] is TScrollBar))then
      (((Sender as TScrollBar).Parent as TPanel).Controls[cycle] as TControl).Top:=(((Sender as TScrollBar).Parent as TPanel).Controls[cycle] as TControl).Tag-(Sender as TScrollBar).Position;
  end;
end;

end.

和.dfm:

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 473
  ClientWidth = 769
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnResize = FormResize
  DesignSize = (
    769
    473)
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 257
    Height = 473
    Anchors = [akLeft, akTop, akBottom]
    BevelOuter = bvNone
    BorderStyle = bsSingle
    TabOrder = 0
    object Label1: TLabel
      Left = 104
      Top = 16
      Width = 31
      Height = 13
      Caption = 'Label1'
    end
    object Label2: TLabel
      Left = 104
      Top = 152
      Width = 31
      Height = 13
      Caption = 'Label2'
    end
    object Memo1: TMemo
      Left = 8
      Top = 32
      Width = 497
      Height = 89
      Lines.Strings = (
        'Memo1')
      TabOrder = 0
    end
    object Memo2: TMemo
      Left = 8
      Top = 168
      Width = 497
      Height = 89
      Lines.Strings = (
        'Memo2')
      TabOrder = 1
    end
    object ScrollBar1: TScrollBar
      AlignWithMargins = True
      Left = 0
      Top = 452
      Width = 236
      Height = 17
      Margins.Left = 0
      Margins.Top = 0
      Margins.Right = 17
      Margins.Bottom = 0
      Align = alBottom
      PageSize = 0
      TabOrder = 2
      OnChange = ScrollBarHChange
      ExplicitWidth = 253
    end
    object ScrollBar4: TScrollBar
      Left = 236
      Top = 0
      Width = 17
      Height = 452
      Align = alRight
      Enabled = False
      Kind = sbVertical
      PageSize = 0
      TabOrder = 3
      OnChange = ScrollBarVChange
      ExplicitTop = 248
      ExplicitHeight = 121
    end
  end
  object Panel2: TPanel
    Left = 256
    Top = 0
    Width = 257
    Height = 473
    Anchors = [akLeft, akTop, akBottom]
    BevelOuter = bvNone
    BorderStyle = bsSingle
    TabOrder = 1
    object Label3: TLabel
      Left = 104
      Top = 16
      Width = 31
      Height = 13
      Caption = 'Label3'
    end
    object Label4: TLabel
      Left = 104
      Top = 152
      Width = 31
      Height = 13
      Caption = 'Label4'
    end
    object Memo3: TMemo
      Left = 8
      Top = 32
      Width = 497
      Height = 89
      Lines.Strings = (
        'Memo3')
      TabOrder = 0
    end
    object Memo4: TMemo
      Left = 8
      Top = 168
      Width = 497
      Height = 89
      Lines.Strings = (
        'Memo4')
      TabOrder = 1
    end
    object ScrollBar2: TScrollBar
      AlignWithMargins = True
      Left = 0
      Top = 452
      Width = 236
      Height = 17
      Margins.Left = 0
      Margins.Top = 0
      Margins.Right = 17
      Margins.Bottom = 0
      Align = alBottom
      PageSize = 0
      TabOrder = 2
      OnChange = ScrollBarHChange
      ExplicitWidth = 253
    end
    object ScrollBar5: TScrollBar
      Left = 236
      Top = 0
      Width = 17
      Height = 452
      Align = alRight
      Enabled = False
      Kind = sbVertical
      PageSize = 0
      TabOrder = 3
      OnChange = ScrollBarVChange
      ExplicitTop = 248
      ExplicitHeight = 121
    end
  end
  object Panel3: TPanel
    Left = 512
    Top = 0
    Width = 257
    Height = 473
    Anchors = [akLeft, akTop, akBottom]
    BevelOuter = bvNone
    BorderStyle = bsSingle
    TabOrder = 2
    object Label5: TLabel
      Left = 104
      Top = 16
      Width = 31
      Height = 13
      Caption = 'Label5'
    end
    object Label6: TLabel
      Left = 104
      Top = 152
      Width = 31
      Height = 13
      Caption = 'Label6'
    end
    object Memo5: TMemo
      Left = 8
      Top = 32
      Width = 497
      Height = 89
      Lines.Strings = (
        'Memo5')
      TabOrder = 0
    end
    object Memo6: TMemo
      Left = 8
      Top = 168
      Width = 497
      Height = 89
      Lines.Strings = (
        'Memo6')
      TabOrder = 1
    end
    object ScrollBar3: TScrollBar
      AlignWithMargins = True
      Left = 0
      Top = 452
      Width = 236
      Height = 17
      Margins.Left = 0
      Margins.Top = 0
      Margins.Right = 17
      Margins.Bottom = 0
      Align = alBottom
      PageSize = 0
      TabOrder = 2
      OnChange = ScrollBarHChange
      ExplicitWidth = 253
    end
    object ScrollBar6: TScrollBar
      Left = 236
      Top = 0
      Width = 17
      Height = 452
      Align = alRight
      Enabled = False
      Kind = sbVertical
      PageSize = 0
      TabOrder = 3
      OnChange = ScrollBarVChange
      ExplicitTop = 248
      ExplicitHeight = 121
    end
  end
end

答案 2 :(得分:1)

为什么不使用两个滚动框。

您可以使用一个进行垂直滚动。在它上面放置标签和第二个滚动框,上面有备忘录。

此第二个滚动框将在需要时用于水平滚动。

或许甚至更好的解决方案是将TMemo替换为其他控件,如TRichEdit,它实现了自己的滚动条。所以你只有一个像现在这样的滚动框,当文本变宽时,TRichEdit会自己滚动它。