I've got a very simple program that uses DSPack from within Delphi 2010. I have a form with a TFilterGraph and a TVideoWindow. The video plays and renders nicely. I can't seem to figure out how to make the video loop back to the beginning when it ends.
How do you make a video automatically loop using DSPack?
Code
unit Unit21;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DSPack, ExtCtrls;
type
TForm21 = class(TForm)
FilterGraph1: TFilterGraph;
OpenDialog1: TOpenDialog;
Button1: TButton;
Button2: TButton;
Panel1: TPanel;
VideoWindow1: TVideoWindow;
Panel2: TPanel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form21: TForm21;
implementation
{$R *.dfm}
procedure TForm21.Button1Click(Sender: TObject);
begin
OpenDialog1.InitialDir := ExtractFilePath(ParamStr(0));
if OpenDialog1.Execute then
begin
if not FilterGraph1.Active then FilterGraph1.Active:= True;
VideoWindow1.FilterGraph:= FilterGraph1;
FilterGraph1.RenderFile(OpenDialog1.Filename);
FilterGraph1.Play;
end;
end;
procedure TForm21.Button2Click(Sender: TObject);
begin
FilterGraph1.Stop;
end;
procedure TForm21.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
FilterGraph1.ClearGraph;
FilterGraph1.Active:= False;
end;
end.
DFM
object Form21: TForm21
Left = 0
Top = 0
Caption = 'Form21'
ClientHeight = 441
ClientWidth = 644
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCloseQuery = FormCloseQuery
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 644
Height = 384
Align = alClient
Caption = 'Panel1'
TabOrder = 0
object VideoWindow1: TVideoWindow
Left = 1
Top = 1
Width = 642
Height = 382
Mode = vmVMR
FilterGraph = FilterGraph1
VMROptions.Mode = vmrWindowed
Color = clWhite
Align = alClient
end
end
object Panel2: TPanel
Left = 0
Top = 384
Width = 644
Height = 57
Align = alBottom
Caption = 'Panel2'
TabOrder = 1
object Button1: TButton
Left = 24
Top = 16
Width = 75
Height = 25
Caption = 'Play'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 128
Top = 16
Width = 75
Height = 25
Caption = 'Stop'
TabOrder = 1
OnClick = Button2Click
end
end
object FilterGraph1: TFilterGraph
GraphEdit = True
LinearVolume = True
Left = 424
Top = 144
end
object OpenDialog1: TOpenDialog
Left = 344
Top = 128
end
end
There is no built in support for seamless looping. Yes you certainly can receive completion event, seek playback to the beginning and run the graph again, however this would inevitably have a restart delay and possibly flickering.
To implement seamless looping you either a multigraph solution, to restart upstream graph while presentation graph is on a short pause and does not flicker. Or otherwise add custom filters into the pipeline to restart streaming internally and present it as continuous stream.
Related
I hate the title of this question. Anyway:
If you call TForm.Show with a custom theme (Windows10 Dark in this case), then close that form, then change the theme to the system Windows theme, then change back to the Windows10 Dark theme, and finally call TForm.Show on that form again, the border renders incorrectly and certain controls do not render properly, like a TComboBox.
I have a test project below, and a "fix" of sorts. But I do not like my fix and the reason for this question is that I do not really understand what is happening here that causes the form to render incorrectly only if it was hidden while the theme changed, and only if the theme is changed away from, and then back to, Windows10 Dark.
My fix is to track the theme change. If the condition I describe above occurs, I intercept the CM_SHOWINGCHANGED message, ignore it, then force the window to be recreated and then process the inherited CM_SHOWINGCHANGED the next time around. It is a very brittle fix and obviously not the way to go, so I am hoping someone can show me what is actually happening so I can fix it "for real."
Incidentally, I have submitted this as a bug to Embarcadero already. https://quality.embarcadero.com/browse/RSP-33977
Here is the test code. You'll need to add Windows10 Dark to the application's styles, obviously.
unit Unit22;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Unit23, Vcl.Themes;
type
TForm22 = class(TForm)
Panel1: TPanel;
ComboBox1: TComboBox;
RadioGroup1: TRadioGroup;
ButtonShow: TButton;
Memo1: TMemo;
procedure ButtonShowClick(Sender: TObject);
procedure RadioGroup1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
FAllowChange: Boolean;
public
{ Public declarations }
end;
var
Form22: TForm22;
implementation
{$R *.dfm}
procedure TForm22.ButtonShowClick(Sender: TObject);
begin
Form23.Show;
end;
procedure TForm22.FormShow(Sender: TObject);
begin
if StyleServices.Name = 'Windows10 Dark' then
RadioGroup1.ItemIndex := 1
else
RadioGroup1.ItemIndex := 0;
FAllowChange := True;
end;
procedure TForm22.RadioGroup1Click(Sender: TObject);
begin
if not FAllowChange then
exit;
if RadioGroup1.ItemIndex = 0 then
TStyleManager.SetStyle('Windows');
if RadioGroup1.ItemIndex = 1 then
TStyleManager.SetStyle('Windows10 Dark');
end;
end.
Unit 22 DPR:
object Form22: TForm22
Left = 0
Top = 0
ActiveControl = Memo1
Caption = 'Form22'
ClientHeight = 305
ClientWidth = 511
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 511
Height = 305
Align = alClient
BevelEdges = []
BevelOuter = bvNone
Caption = 'Panel1'
ShowCaption = False
TabOrder = 0
object ComboBox1: TComboBox
Left = 16
Top = 8
Width = 145
Height = 21
Style = csDropDownList
ItemIndex = 0
TabOrder = 0
Text = 'one'
Items.Strings = (
'one'
'two'
'three')
end
object RadioGroup1: TRadioGroup
Left = 16
Top = 48
Width = 185
Height = 105
Caption = 'RadioGroup1'
Items.Strings = (
'windows'
'dark')
TabOrder = 1
OnClick = RadioGroup1Click
end
object ButtonShow: TButton
Left = 16
Top = 159
Width = 75
Height = 25
Caption = 'ButtonShow'
TabOrder = 2
OnClick = ButtonShowClick
end
object Memo1: TMemo
Left = 207
Top = 8
Width = 274
Height = 281
Lines.Strings = (
'Always start in dark.'
''
'Steps to reproduce:'
'1.'#9'Click ButtonShow.'
'2.'#9'Close the window that opened.'
'3.'#9'Click Windows (change to system them).'
'4.'#9'Click Dark (change back to dark VCL style).'
'5.'#9'Click ButtonShow again. The controls are '
'not properly painted. Combobox text is black and form '
'is wrong until resize.'
''
'Hacky fix:'
'1.'#9'Click ButtonShow.'
'2.'#9'Check the '#8220'Fix'#8221' button in the window that '
'opened, then close it.'
'3.'#9'Click Windows (change to system)'
'4.'#9'Click Dark (change back to vcl dark)'
'5.'#9'Click ButtonShow. See comments in source.'
'')
ReadOnly = True
TabOrder = 3
end
end
end
Unit23:
unit Unit23;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Themes;
type
TForm23 = class(TForm)
Panel1: TPanel;
ComboBox1: TComboBox;
ComboBox2: TComboBox;
ComboBox3: TComboBox;
Button1: TButton;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
FFixing: Boolean;
FNeedFix: String;
FShowedStyle: String;
protected
procedure DoShow; override;
public
{ Public declarations }
procedure CMStyleChanged(var Message: TMessage); message CM_STYLECHANGED;
procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
end;
var
Form23: TForm23;
implementation
{$R *.dfm}
procedure TForm23.Button1Click(Sender: TObject);
begin
PostMessage(Handle, CM_RECREATEWND, 0, 0);
end;
procedure TForm23.CMShowingChanged(var Message: TMessage);
var
DoFix: Boolean;
begin
if not Showing then
inherited
else
begin
// if the theme changed away from dark, then back to dark, while we were
// not visible, then we need to force the window to be recreated again
// before showing.
// This is a really bad hack but basically I am just preventing the
// normal response to CMShowingChanged and then setting up a message
// queue that will recreate the window and then process the CM_SHOWINGCHANGED
// message again. This will probably break the universe but it appears to work
// in this test.
FShowedStyle := StyleServices.Name;
Panel1.Caption := FShowedStyle;
DoFix := not FFixing and (FNeedFix <> '') and (FNeedFix = FShowedStyle);
FNeedFix := '';
if DoFix and CheckBox1.Checked then
begin
FFixing := True;
// SendMessage(Handle, WM_SETREDRAW, Winapi.Windows.WPARAM(LongBool(False)), 0);
PostMessage(Handle, CM_RECREATEWND, 0, 0);
// PostMessage(Handle, CM_SHOWINGCHANGED, Message.WParam, Message.LParam);
// do not allow inherited.
end else
begin
FFixing := False;
inherited;
end;
end;
end;
procedure TForm23.CMStyleChanged(var Message: TMessage);
begin
FNeedFix := FShowedStyle;
inherited;
end;
procedure TForm23.DoShow;
var
DoFix: Boolean;
begin
inherited;
exit;
end;
end.
Unit23 DPR:
object Form23: TForm23
Left = 0
Top = 0
Caption = 'Form23'
ClientHeight = 253
ClientWidth = 360
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 360
Height = 253
Align = alClient
Alignment = taRightJustify
BevelEdges = []
BevelOuter = bvNone
Caption = 'Panel1'
TabOrder = 0
object ComboBox1: TComboBox
Left = 16
Top = 32
Width = 145
Height = 21
Style = csDropDownList
ItemIndex = 0
TabOrder = 0
Text = 'one'
Items.Strings = (
'one'
'two'
'three')
end
object ComboBox2: TComboBox
Left = 16
Top = 59
Width = 145
Height = 21
Style = csDropDownList
ItemIndex = 1
TabOrder = 1
Text = 'two'
Items.Strings = (
'one'
'two'
'three')
end
object ComboBox3: TComboBox
Left = 16
Top = 86
Width = 145
Height = 21
Style = csDropDownList
ItemIndex = 2
TabOrder = 2
Text = 'three'
Items.Strings = (
'one'
'two'
'three')
end
object Button1: TButton
Left = 16
Top = 136
Width = 75
Height = 25
Caption = 'RecreateWnd'
TabOrder = 3
OnClick = Button1Click
end
object CheckBox1: TCheckBox
Left = 16
Top = 167
Width = 273
Height = 17
Caption = 'Fix with CM_SHOWINGCHANGED hack'
TabOrder = 4
end
end
end
I have written a small test VCL application with a monitor PPI of 96.
The application has a TGridPanel on it with a absolute pixel sized column.
On that column I placed a TComboBox and aligned it alClient.
Here is the DFM code:
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 182
ClientWidth = 514
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object GridPanel1: TGridPanel
Left = 0
Top = 0
Width = 514
Height = 182
Align = alClient
Caption = 'GridPanel1'
ColumnCollection = <
item
Value = 100.000000000000000000
end
item
SizeStyle = ssAbsolute
Value = 150.000000000000000000
end>
ControlCollection = <
item
Column = 0
Control = Button1
Row = 0
end
item
Column = 1
Control = ComboBox1
Row = 0
end
item
Column = 0
Control = Edit1
Row = 1
end>
RowCollection = <
item
Value = 50.000000000000000000
end
item
Value = 50.000000000000000000
end>
TabOrder = 0
object Button1: TButton
Left = 1
Top = 1
Width = 362
Height = 21
Align = alTop
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
object ComboBox1: TComboBox
Left = 363
Top = 1
Width = 150
Height = 21
Align = alClient
TabOrder = 1
Text = 'ComboBox1'
end
object Edit1: TEdit
Left = 1
Top = 91
Width = 362
Height = 21
Align = alTop
TabOrder = 2
Text = 'Edit1'
end
end
end
and the PAS code:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;
type
TForm1 = class(TForm)
GridPanel1: TGridPanel;
Button1: TButton;
ComboBox1: TComboBox;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
PPI: Integer;
begin
PPI := Integer.Parse(Edit1.Text);
GridPanel1.ScaleForPPI(PPI);
end;
procedure TForm1.FormShow(Sender: TObject);
begin
Edit1.Text := Screen.PixelsPerInch.ToString;
end;
end.
I then changed the custom scaling factor to 125 in Windows 10 in the advanced scaling settings.
After signing off and signing on again when I run the application again the drop down button of the combo box is not visible any more.
How do you deal with this problem?
I tried to call GridPanel1.ScaleForPPI(96) which restores the drop down button on the combo box. This kind of defeats the purpose of PPI scaling though, doesn't it?
The problem is gone in Delphi 10.3.1.
So this is a bug in at least Delphi 10.1 (and possible other older versions).
I'm using windows 10 theme in my project, and i've have noticed that: Panels that are positioned on edges of grids, they're shown under the grid scrollbar,
like this image:
I haven't changed any behavior of the VCL, or the grid or scroll behavior.
pas file:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Vcl.StdCtrls,
Datasnap.DBClient, Vcl.Grids, Vcl.DBGrids, Vcl.ExtCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
DbGrid: TDBGrid;
Panel2: TPanel;
ClientDataSet: TClientDataSet;
DataSource1: TDataSource;
ButtonAdd: TButton;
ShowPanel: TButton;
ClientDataSetname: TStringField;
ClientDataSetaddress: TStringField;
procedure ButtonAddClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ShowPanelClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.ButtonAddClick(Sender: TObject);
begin
ClientDataset.Append;
ClientDataSetname.AsString := 'Test name';
ClientDataSetaddress.AsString := 'Test address';
ClientDataset.Insert;
end;
procedure TForm1.ShowPanelClick(Sender: TObject);
begin
if Panel2.Visible then
Panel2.Visible := False
else
Panel2.Visible := True;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ClientDataset.CreateDataSet;
end;
end.
dfm file:
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 201
ClientWidth = 555
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 460
Top = 0
Width = 95
Height = 201
Align = alRight
TabOrder = 0
object ButtonAdd: TButton
Left = 10
Top = 16
Width = 75
Height = 25
Caption = 'ButtonAdd'
TabOrder = 0
OnClick = ButtonAddClick
end
object ShowPanel: TButton
Left = 10
Top = 47
Width = 75
Height = 25
Caption = 'ShowPanel'
TabOrder = 1
OnClick = ShowPanelClick
end
end
object DbGrid: TDBGrid
Left = 0
Top = 0
Width = 460
Height = 201
Align = alClient
DataSource = DataSource1
TabOrder = 1
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'Tahoma'
TitleFont.Style = []
Columns = <
item
Expanded = False
FieldName = 'name'
Visible = True
end
item
Expanded = False
FieldName = 'address'
Visible = True
end>
end
object Panel2: TPanel
Left = 0
Top = 160
Width = 185
Height = 41
Caption = 'panel2'
TabOrder = 2
Visible = False
end
object ClientDataSet: TClientDataSet
Aggregates = <>
Params = <>
Left = 216
Top = 104
object ClientDataSetname: TStringField
FieldName = 'name'
Size = 50
end
object ClientDataSetaddress: TStringField
FieldName = 'address'
Size = 50
end
end
object DataSource1: TDataSource
DataSet = ClientDataSet
Left = 152
Top = 88
end
end
The bug happens after second click on ShowPanel.
You can Define DBgrid as parent of your panel.
procedure TForm1.FormShow(Sender: TObject);
begin
panel1.Parent := dbgrid1;
panel1.align := alBottom;
end;
I've found a way to "solve" this problem just changing grid seBorder to false, i used Notepad++ to locate in all project for ": TDBGrid"¹ and replace to ": TDBGrid StyleElements = [seFont, seClient]"¹. Isn't the better way to solve this problem i think, because changing seBorder to false will make the scrollbars style looks like the scrolls of your windows version.
¹ Ignore the quotes when you try to do it.
In fact, the only way is to work with the parent of the DBgrid.
This example work fine for me :
procedure TForm1.adjustPanelTo(const aPanel: TPanel; aWcontrol: TWinControl);
begin
if aPanel = nil then Exit;
if aWcontrol = nil then Exit;
if aWcontrol.Parent = nil then Exit;
aPanel.Parent := aWcontrol.Parent;
aPanel.Anchors := [akLeft, akTop];
aPanel.Left := aWcontrol.Left + 1;
aPanel.Top := aWcontrol.Top + aWcontrol.ClientHeight - aPanel.Height;
aPanel.BringToFront;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
adjustPanelTo(Panel1, DBGrid1);
end;
I use a TMemo in TScrollBox to show some text, and a TLabel on top as a header info. Sometimes memo is wider than scroll box and of course Horizontal scroll bar can be used to scroll left and right to see text in memo.
I want to have a label as a header always centered to scroll box visible area. I can do this by setting Label1.Left:= (Scrollbox1.Width div 2) - (Label1.Width div 2); and it works but it kind of flickers, shakes when scrolling back and forth. Memo moves smoothly, label doesn't.
Here is unit:
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.
and 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
I tried using DoubleBuffered but doesn't help.
Any suggestions how to make Label1 move without flickering/shaking, as smooth as Memo1 does when scrolling?
EDIT:
The design will eventually be that I have 3 or scrollboxes on form and each one contain up to 3 memos with header. And scrolling needs to be by scrollbox as all memos in same scroll box need to be scrolled at the same time. That means I do not see how it would work with putting label on form or panel and then on form, outside scrollboxes:
EDIT 2:
The answers below do provide good solutions, but they do make necessary to place the Labels, that are centered, out of the Scrollbox and put on the Form itself. And then move either by Scrollbox's scroll bars or by scroll bars directly on Form. This does get desired affect, but it adds a little inconvenience with Labels not being part of Scrollbox, anymore.
-" Memo moves smoothly, label doesn't."
That's because you're trying to prevent it from moving. Detach your OnScrollHorz handler and the label will move smoothly. But that's not what you want, it will not be centered to the form any more.
The problem is, during the inherited call (WM_HSCROLL), the label moves along with the memo. After the default handling, you relocate the label, hence the flicker.
You can expose an additional event handler that will fire before default scrolling (OnBeforeHorzScroll), and hide the label when it fires. While smoothly centered, it will cause a different kind of flicker where the label momentarily disappears. Still may not be satisfactory.
The solution is to use a control that is parented to the form, a sibling to the scroll box. You can't do that with a TLabel as it is a graphic control, but you can use TStaticText. The "structure pane" of the IDE may come handy if the static accidentally goes behind the scroll box at design time.
You can do it like this:
Instead of ScrollBox put a ScrollBar on your form. Set its alignment to bottom (or set its size and position manually if you wish to have more columns or you can put each one in its own panel). Then set the size of your Memos and place Labels to the center of the Form. After setting the size of the Memos (probably dynamically via code) place this code:
ScrollBar1.Min:=0-Memo1.Left;
ScrollBar1.Max:=Memo1.Width-Form1.ClientWidth+Memo1.Left;
The last thing is to set the ScrollBar OnChange event:
procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
Memo1.Left:=0-ScrollBar1.Position;
Memo2.Left:=0-ScrollBar1.Position;
...
MemoXY.Left:=0-ScrollBar1.Position;
end;
Your form should look something like this:
Done! You have a stable centered Labels and smoothly scrollable Memos.
Edit:
Here is a version with 3 columns each in his own Panel and also with vertical scrollbars:
And the whole source code:
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.
And the .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
Why not use two scroll boxes.
You use one for vertical scrolling. On it you place your label and your second scroll box with memo on it.
This second scroll box will then be used for horizontal scrolling when needed.
Or perhaps even a better solution would be to replace TMemo with some other control like TRichEdit which has its own scrollbars implemented. So you have only one scroll box like now and TRichEdit Will take care of its own scrolling when the text is to wide.
It seems that on Win7 changing the TOpenDialog.InitialDir doesn't work, when the new directory is on a different drive, than the current directory.
e.g.: I want to change my InitialDir from 'C:\program files\MyApp' to 'D:\test\MyAppData'
Is that a known issue, or only on my computer?
I already tried the same thing, as mentioned in the following post, but without any success:
Changing the directory of Delphi OpenDialog
EDIT:
I am using DelphiXE on Win7 32 Bit
The path/dir is correct: So, when I copy that path from code and past it into the 'File Name' field of that Dialog itself and I press ENTER, then the Dialog switches to that directory. Only, in my code it is not working.
UPDATE:
I found the problem. If the path contains some path commands like ..\ the TOpenDialog.InitialDir is not able to resolve that. Use TPath.GetFullPath(...) to make it clean.
I have tested on a Delphi XE, it runs fine... I have done this:
Put a new form:
object Form4: TForm4
Left = 0
Top = 0
Caption = 'Form4'
ClientHeight = 204
ClientWidth = 447
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 24
Top = 40
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
object Edit1: TEdit
Left = 120
Top = 42
Width = 121
Height = 21
TabOrder = 1
Text = 'D:\'
end
object OpenDialog1: TOpenDialog
InitialDir = 'C:\'
Left = 120
Top = 72
end
end
And its source code:
unit Unit4;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm4 = class(TForm)
OpenDialog1: TOpenDialog;
Button1: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form4: TForm4;
implementation
{$R *.dfm}
procedure TForm4.Button1Click(Sender: TObject);
begin
OpenDialog1.InitialDir := edit1.text;
OpenDialog1.Execute;
end;
end.
Regards
I don't have any problem changing InitialDir, either through object inspector or runtime (Win7 with Delphi 2010). Try doublechecking if the directory you try to change to is correctly typed.