I am trying to create a Previewlist where i add an image and a remove button on top of it in TFramedVertScrollbar with this code:
var
PreviewList: TFramedVertScrollBox;
i: integer;
...
procedure TDashboard.AddClick(Sender: TObject);
var
sImg: TImage;
sBtn: TButton;
sbit: TBitmap;
begin
sbit := TBitmap.Create;
try
with sbit do
begin
Width := Image1.Bitmap.Width;
Height := Image1.Bitmap.Height;
Assign(Image1.Bitmap);
end;
sImg := TImage.Create(PreviewList);
with sImg do
begin
Align := TAlignLayout.Top;
Position.X := i * Height;
Height := 60;
Margins.Bottom := 2;
Bitmap.Assign(sbit);
Parent := PreviewList;
WrapMode := TImageWrapMode.Stretch;
onClick := PreviewItemClick;
end;
sBtn := TButton.Create(sImg);
with sBtn do
begin
StyleLookup := 'listboxdeleteitem';
Position.X := sImg.Width - 25;
Position.Y := 5;
Width := 15;
Height := 15;
Text := 'X';
Parent := sImg;
onClick := PreviewItemClick;
end;
i := i + 1;
finally
sbit.Free;
Image1.Bitmap.Assign(nil);
end;
end;
The Creation of PreviewItem works but not removal as on removing the PreviewItem the SystemBar does not responds(ex can't move or close or click) or don't takes mouse events and i have to click on other components in the form to make it responsive again.
I tried to two version of PreviewListClick first is below:
begin
PreviewList.BeginUpdate;
Obj := TButton(Sender).Parent;
FreeAndNil(Obj);
PreviewList.EndUpdate;
end;
The Above Makes the SystemBar Not Responding so i did like this :
begin
PreviewList.BeginUpdate;
PreviewList.RemoveObject(TButton(Sender).Parent);
PreviewList.EndUpdate;
end;
SystemBar is responding in this case and item is removed but there is one problem, after clicking on the Remove button of PreviewItem the PreviewList items are not updated.
For Ex. if there are four item in list and if i remove second one then item is removed but the list is not updated as the position of second item is still kept. now the PreviewList Looks like this:
Item1->BlankSPace->Item2->Item3
how to correctly add and remove items ?
Removing Object from content worked fine
PreviewList.Content.RemoveObject(TButton(Sender).Parent);
Related
I am working with Delphi 10.4.2 in Windows 10 (virtualized in Parallels) on a dual monitor system. To recreate the problem on a multi-monitor system, create a new Windows VCL Application and place two buttons on the form: btnPrimaryMonitor and btnSecondaryMonitor. Then insert this code by creating click handlers for the two buttons:
procedure TForm1.btnPrimaryMonitorClick(Sender: TObject);
begin
RepositionFormToMonitor(0);
EnableDisableButtons;
end;
procedure TForm1.RepositionFormToMonitor(const aMonitor: Integer);
const
offset = 2;
begin
Self.Width := Screen.Monitors[aMonitor].Width - offset;
Self.Height := Screen.Monitors[aMonitor].Height - offset;
Self.Top := Screen.Monitors[aMonitor].Top;
Self.Left := Screen.Monitors[aMonitor].Left;
end;
procedure TForm1.btnSecondaryMonitorClick(Sender: TObject);
begin
RepositionFormToMonitor(1);
EnableDisableButtons;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
EnableDisableButtons;
Self.BorderStyle := bsNone;
Self.FormStyle := fsStayOnTop;
RepositionFormToMonitor(0);
end;
procedure TForm1.EnableDisableButtons;
begin
btnPrimaryMonitor.Enabled := (Self.Monitor.MonitorNum = 1);
btnSecondMonitor.Enabled := (Self.Monitor.MonitorNum = 0);
end;
This works perfectly, but as soon as I set offset = 1 or offset = 0 the screen becomes black!
The purpose of the code is to reposition the maximized stay-on-top Form from the primary monitor to the secondary monitor by clicking on the btnSecondMonitor button and then back to the primary monitor by clicking on the btnPrimaryMonitor button.
How can this problem be avoided?
A few issues:
You should not set WindowState to wsMaximized. In fact, you shouldn't touch this property at all.
Setting BoundsRect will set Left, Top, Width, and Height, so there is no need to set Left and Top separately.
To go back to the primary monitor, just set the form's BoundsRect.
Here's an example:
Create a new VCL project. Set the main form's BorderStyle to bsNone.
Then add the following code:
procedure TForm1.FormCreate(Sender: TObject);
begin
for var i := 0 to Screen.MonitorCount - 1 do
begin
var btn := TButton.Create(Self);
btn.Parent := Self;
btn.Caption := i.ToString;
btn.Tag := i;
btn.OnClick := MonitorButtonClick;
btn.Top := 8;
btn.Left := 8 + (btn.Width + 8) * i;
end;
end;
procedure TForm1.MonitorButtonClick(Sender: TObject);
begin
BoundsRect := Screen.Monitors[(Sender as TButton).Tag].BoundsRect;
end;
If this code doesn't work properly on your system, you probably have some problem with that Windows system. This should work flawlessly.
I'm attempting to create a custom TToolbar at run-time that floats over the form (below the control it is associated with).
My issue is that the process of floating and positioning the toolbar at creation creates a hideous flicker where it is initially drawn at the top-left of the monitor before being moved to my desired position on the form.
I cannot find a way to avoid this. Is there a way?
procedure TMainForm.Button3Click(Sender: TObject);
var
newToolbar : TToolbar;
newButton : TToolButton;
begin
newToolbar := TToolbar.Create(Self);
newToolbar.Visible := False;
newToolbar.ManualFloat( Rect( 0, 0, newToolbar.Width, newToolbar.Height ));
newToolbar.Parent := Self;
newToolbar.left := 100;
newToolbar.Top := 100;
newToolbar.ShowCaptions := True;
newButton := TToolButton.Create(Self);
newButton.Parent := newToolbar;
newButton.Caption := 'Test';
newToolbar.Visible := True;
end;
References:
- Create TToolbutton runtime
- toolbutton with action created at runtime
- Delphi - Create a custom TToolBar component
I am a little puzzled with your solution, so I provide my two takes on the subject. Specifically I don't understand why you are using ManualFloat() and few lines later set the parent of the toolbar, which makes it non-floating.
Here is a solution for a floating toolbar, using ManualFloat().
The toolbar is floating above the form in its own temporary TCustomDockForm,
at the given location.
The record needed by ManualFloat() is setup for the final location, thus no flicker in the wrong place, and the control
is immediately correctly positioned.
procedure TForm1.Button3Click(Sender: TObject);
var
newToolbar : TToolbar;
newButton : TToolButton;
p: TPoint;
begin
newToolbar := TToolbar.Create(Self);
// calculate position in screen coordinates for the floating toolbar
p := ClientOrigin;
p.Offset(100, 100);
// and make it floating in final position
newToolbar.ManualFloat( Rect(p.X, p.Y, p.X+NewToolbar.Width, p.Y+newToolbar.Height) );
newToolbar.Visible := False; // really needed ?
// Then create the toolbar buttons
newToolbar.ShowCaptions := True;
newButton := TToolButton.Create(self);
newButton.Parent := newToolbar;
newButton.Caption := 'Test';
newToolbar.Visible := True;
end;
However, since you actually seem to want a non-floating toolbar, that is just
located anywhere you like on the form (and not in the default top of the form),
a better solution is to skip the ManualFloat() altogether and just set the
Align property of the toolbar to alNone. This enables it to be moved anywhere
on the parent form.
procedure TForm1.Button4Click(Sender: TObject);
var
newToolbar : TToolbar;
newButton : TToolButton;
begin
newToolbar := TToolbar.Create(Self);
newToolbar.Align := alNone; // constructor sets it to alTop
newToolbar.Visible := False; // really needed ?
newToolbar.Parent := Self;
newToolbar.Left := 100;
newToolbar.Top := 200;
newToolbar.ShowCaptions := True;
newButton := TToolButton.Create(self);
newButton.Parent := newToolbar;
newButton.Caption := 'Test';
newToolbar.Visible := True; //
end;
This gives you the same appearance as your own code, but omits the ManualFloat().
Finally, an image to show the appearances:
The bottom toolbar is created with Button4Click()
Thanks #TomBrunberg for your suggestion.
What was needed to make it position over the form without any pre-drawing:
Position it off-screen when ManualFloat is called
Set Visible to false after call to ManualFloat (because ManualFloat sets it true)
Revised code:
procedure TMainForm.Button3Click(Sender: TObject);
var
newToolbar : TToolbar;
newButton : TToolButton;
begin
newToolbar := TToolbar.Create(Self);
// Float with off-screen position
newToolbar.ManualFloat( Rect( 0, -200, newToolbar.Width, newToolbar.Height - 200 ));
// Must hide after ManualFloat call, as it resets Visible to true
newToolbar.Visible := False;
// Set parent so we can add buttons, sets props, etc.
newToolbar.Parent := Self;
// Move to desired position over form
newToolbar.left := 100;
newToolbar.Top := 100;
// Add our button content...
newToolbar.ShowCaptions := True;
newButton := TToolButton.Create(Self);
newButton.Parent := newToolbar;
newButton.Caption := 'Test';
// Now we can show it
newToolbar.Visible := True;
end;
I am a newbie to this Delphi. I have been given an assignment that to create buttons dynamically. But the problem is that all buttons have to be aligned in a manner that it should fit inside the whole screen. i.e, if 10 buttons created the whole screen should be filled. Or if 9 is given 9 should be present and filled in the screen. Is it possible to do that? I tried and searched everywhere. But was helpless.
Please help me if its possible. A good example is also appreciated since I mentioned earlier I am really new to this. The code I did follows here.
procedure TfrmMovieList.PnlMovieClick(Sender: TObject);
begin
for i := 0 to 9 do
begin
B := TButton.Create(Self);
B.Caption := Format('Button %d', [i]);
B.Parent := Panel1;
B.Height := 23;
B.Width := 100;
B.Left := 10;
B.Top := 10 + i * 25;
end;
end;
This looks workable to me:
procedure TForm1.CreateButtons(aButtonsCount, aColCount: Integer; aDestParent: TWinControl);
var
rowCount, row, col, itemWidth, itemHeight: Integer;
item: TButton;
begin
if aColCount>aButtonsCount then
aColCount := aButtonsCount;
rowCount := Ceil(aButtonsCount / aColCount);
itemHeight := aDestParent.Height div rowCount;
itemWidth := aDestParent.Width div aColCount;
for row := 0 to rowCount-1 do begin
for col := 0 to aColCount-1 do begin
item := TButton.Create(Self);
item.Caption := Format('Button %d', [(row*aColCount)+col+1]);
item.Left := itemWidth*col;
item.Top := itemHeight*row;
item.Width := itemWidth;
item.Height := itemHeight;
item.Parent := aDestParent;
Dec(aButtonsCount);
if aButtonsCount=0 then
Break;
end; // for cols
end; // for rows
end;
An example of usage is:
procedure TForm1.Button1Click(Sender: TObject);
begin
CreateButtons(10, 4, Panel1);
end;
The function Ceil requires the uses of unit Math.
The method receives the count of buttons and the numbers of columns to calculate the number of rows. It also receives the destination parent where the buttons will be located.
I'm trying to add a column between existing columns in a TListView. Therefor I add the new column at the end and move it by setting it`s index to the designated value. This works, until adding another new column.
What I did:
Add the column at last position (Columns.Add) and add the subitem at the last position (Subitems.Add) too. Afterwards I move the column by setting it's index to the correct position.
This works fine as long as it's just one column that gets added. When adding a second new column, the subitems get screwed up. The new subitem of the first column is moved to the last position, e.g. like this:
0 | 1 | new A | new B | 3
Caption | old sub 1 | old sub 3 | new Sub B | new sub A
I would be very happy if someone could help!
For example, is there maybe a command or message I can send to the ListView so it refreshes or saves it's Column --> Subitem mapping that I could use after adding the first new column and it's subitems so I can handle the second new column the same way as the first.
Or is this just a bug of TListViews column-->subitem handling or TListColumns...?
example code for a vcl forms application (assign the Form1.OnCreate event):
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
listview: TListView;
initButton: TButton;
addColumn: TButton;
editColumn: TEdit;
subItemCount: Integer;
procedure OnInitClick(Sender: TObject);
procedure OnAddClick(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
listview := TListView.Create(self);
with listview do
begin
Left := 8;
Top := 8;
Width := self.Width - 30;
Height := self.Height - 100;
Anchors := [akLeft, akTop, akRight, akBottom];
TabOrder := 0;
ViewStyle := vsReport;
Parent := self;
end;
initButton := TButton.Create(self);
with initButton do
begin
left := 8;
top := listview.Top + listview.Height + 20;
Width := 75;
Height := 25;
TabOrder := 1;
Caption := 'init';
OnClick := OnInitClick;
Parent := self;
end;
editColumn := TEdit.Create(self);
with editColumn do
begin
left := initButton.Left + initButton.Width + 30;
top := listview.Top + listview.Height + 20;
Width := 120;
Height := 25;
TabOrder := 2;
Parent := self;
Caption := '';
end;
addColumn := TButton.Create(self);
with addColumn do
begin
left := editColumn.Left + editColumn.Width + 10;
top := listview.Top + listview.Height + 20;
Width := 75;
Height := 25;
TabOrder := 1;
Enabled := true;
Caption := 'add';
OnClick := OnAddClick;
Parent := self;
end;
end;
procedure TForm1.OnInitClick(Sender: TObject);
var col: TListColumn;
i, j: integer;
item: TListItem;
begin
listview.Items.Clear;
listview.Columns.Clear;
// add items
for I := 0 to 2 do
begin
col := ListView.Columns.Add;
col.Caption := 'column ' + IntToStr(i);
col.Width := 80;
end;
// add columns
for I := 0 to 3 do
begin
item := ListView.Items.Add;
item.Caption := 'ItemCaption';
// add subitems for each column
for j := 0 to 1 do
begin
item.SubItems.Add('subitem ' + IntToStr(j+1));
end;
end;
subItemCount := 5;
end;
procedure TForm1.OnAddClick(Sender: TObject);
var number: integer;
col: TListColumn;
i: Integer;
ascii: char;
begin
listview.Columns.BeginUpdate;
number := StrToInt(editColumn.Text);
ascii := Chr(65 + number);
// create the new column
col := TListColumn(ListView.Columns.add());
col.Width := 80;
col.Caption := ascii;
// add the new subitems
for I := 0 to ListView.Items.Count-1 do
begin
ListView.Items[i].SubItems.Add('subitem ' + ascii);
end;
// move it to the designated position
col.Index := number;
listview.Columns.EndUpdate;
Inc(subItemCount);
end;
end.
Thank you!
Edit: The suggested fix from Sertac Akyuz works fine, though I can't use it because changing the Delphi sourcecode is no solution for my project. Bug is reported.
Edit: Removed the second question that was unintended included in the first post and opened new question (See linked question and Question-revision).
Update: The reported bug is now closed as fixed as of Delphi XE2 Update 4.
Call the UpdateItems method after you've arranged the columns. E.g.:
..
col.Index := number;
listview.UpdateItems(0, MAXINT);
..
Update:
In my tests, I still seem to need the above call in some occasion. But the real problem is that "there is a bug in the Delphi list view control".
Duplicating the problem with a simple project:
Place a TListView control on a VCL form, set its ViewStyle to 'vsReport' and set FullDrag to 'true'.
Put the below code to the OnCreate handler of the form:
ListView1.Columns.Add.Caption := 'col 1';
ListView1.Columns.Add.Caption := 'col 2';
ListView1.Columns.Add.Caption := 'col 3';
ListView1.AddItem('cell 1', nil);
ListView1.Items[0].SubItems.Add('cell 2');
ListView1.Items[0].SubItems.Add('cell 3');
Place a TButton on the form, and put the below code to its OnClick handler:
ListView1.Columns.Add.Caption := 'col 4';
Run the project and drag the column header of 'col 3' to in-between 'col 1' and 'col 2'. The below picture is what you'll see at this moment (everything is fine):
Click the button to add a new column, now the list view becomes:
Notice that 'cell 2' has reclaimed its original position.
Bug:
The columns of a TListView (TListColumn) holds its ordering information in its FOrderTag field. Whenever you change the order of a column (either by setting the Index property or by dragging the header), this FOrderTag gets updated accordingly.
Now, when you add a column to the TListColumns collection, the collection first adds the new TListColumn and then calls the UpdateCols method. The below is the code of the UpdateCols method of TListColumns in D2007 VCL:
procedure TListColumns.UpdateCols;
var
I: Integer;
LVColumn: TLVColumn;
begin
if not Owner.HandleAllocated then Exit;
BeginUpdate;
try
for I := Count - 1 downto 0 do
ListView_DeleteColumn(Owner.Handle, I);
for I := 0 to Count - 1 do
begin
with LVColumn do
begin
mask := LVCF_FMT or LVCF_WIDTH;
fmt := LVCFMT_LEFT;
cx := Items[I].FWidth;
end;
ListView_InsertColumn(Owner.Handle, I, LVColumn);
Items[I].FOrderTag := I;
end;
Owner.UpdateColumns;
finally
EndUpdate;
end;
end;
The above code removes all columns from the underlying API list-view control and then inserts them anew. Notice how the code assigns each inserted column's FOrderTag the index counter:
Items[I].FOrderTag := I;
This is the order of the columns from left to right at that point in time. If the method is called whenever the columns are ordered any different than at creation time, then that ordering is lost. And since items do not change their positions accordingly, it all gets mixed up.
Fix:
The below modification on the method seemed to work for as little as I tested, you need to carry out more tests (evidently this fix does not cover all possible cases, see 'torno's comments below for details):
procedure TListColumns.UpdateCols;
var
I: Integer;
LVColumn: TLVColumn;
ColumnOrder: array of Integer;
begin
if not Owner.HandleAllocated then Exit;
BeginUpdate;
try
SetLength(ColumnOrder, Count);
for I := Count - 1 downto 0 do begin
ColumnOrder[I] := Items[I].FOrderTag;
ListView_DeleteColumn(Owner.Handle, I);
end;
for I := 0 to Count - 1 do
begin
with LVColumn do
begin
mask := LVCF_FMT or LVCF_WIDTH;
fmt := LVCFMT_LEFT;
cx := Items[I].FWidth;
end;
ListView_InsertColumn(Owner.Handle, I, LVColumn);
end;
ListView_SetColumnOrderArray(Owner.Handle, Count, PInteger(ColumnOrder));
Owner.UpdateColumns;
finally
EndUpdate;
end;
end;
If you are not using packages you can put a modified copy of 'comctrls.pas' to your project folder. Otherwise you might pursue run-time code patching, or file a bug report and wait for a fix.
Sorry if there is already made such question earlier, but I have no time at the moment to dig in stackoverflow db ...
So, I have this code:
procedure TForm1.GraphPrevBtnMouseEnter(Sender: TObject);
var frm_PrevBtn : TForm;
begin
GraphPrevBtn.Width := 75;
if z = 0 then begin
frm_PrevBtn := TForm.Create(nil);
with frm_PrevBtn do begin
Name := 'frm_PrevBtn';
BorderStyle := bsNone;
Position := poDesigned;
Top := Form1.Top + GraphprevBtn.Top + (form1.Height - Form1.ClientHeight) - 3;
Left := Form1.Left + GraphprevBtn.Left + 3;
Width := GraphprevBtn.Width; Height := GraphprevBtn.Height; transparentColor := True; TransparentColorValue := clbtnFace;
Show;
end;
GraphPrevBtn.Parent := frm_PrevBtn;
if GetLastError = 0 then z := frm_prevBtn.GetHashCode;
end;
end;
procedure TForm1.GraphPrevBtnMouseLeave(Sender: TObject);
var frm_PrevBtn_H : THandle;
begin
// if form is created then- if mouse is under button then- if z = formshashcode ( form is on creatin stage )
if not (FindVCLWindow(Mouse.CursorPos) = GraphPrevBtn) and ((FindControl(FindWindow('TForm','frm_PrevBtn')) as TForm).Visible = True) and (GraphPrevBtn.Parent = FindControl(FindWindow('TForm','frm_PrevBtn')) as TForm) then begin // if mouse is not under graphprevBtn
ShowMessage(FindVCLWindow(Mouse.CursorPos).Name); //
if z = 112 // then if form is created
then begin
GraphPrevBtn.Parent := Form1;
GraphPrevBtn.bringtoFront;
GraphPrevBtn.Top := 29; GraphPrevBtn.Left := 226;
(FindControl(FindWindow('TForm','frm_PrevBtn')) as TForm).Free;
if GetLastError = 0 then z := 0;
end;
end;
end;
So, my wish is the following:
When I enter this GraphPrevBtn with mouse, form is created. As for is created, the focus goes from Control to new form. As focus is to new form, the OnMouseLeave event is fired. As event is fired, it should destroy the form, BUT ONLY IF user ( NOT active control / focus ) actually leaves control by mouse.
What happens now is that either new forms is not destroyed at all or both events goes infinite loop ( *frm_PrevBtn* is created and destroyed again and again and again...).
What would be best solution?
My idea is to get new forms rect and check whenever mouse is inside this rect. If it is, then perform allow OnMouseLeave event, otherwise deattach it ... would it work?
As much I tried with these samples:
http://delphi.about.com/od/windowsshellapi/a/get-active-ctrl.htm
http://delphi.about.com/od/delphitips2010/qt/is-some-delphi-tcontrol-under-the-mouse.htm
No luck. Where is the problem ... ?
Remarks: global var z : byte;
P.S. Thanks for negative votes ... great motivation to use this site in future ...
Mouse enters on 'GraphPrevBtn', you create a form over the button. As soon as this form becomes visible, since mouse is not anymore over 'GraphPrevBtn', 'OnMouseLeave' is fired. You destroy the new form and now mouse is again on the button so 'OnMouseEnter' is fired, hence the infinite loop.
As a solution, you can move the form disposing code to 'OnMouseEnter' of Form1:
procedure TForm1.FormMouseEnter(Sender: TObject);
begin
if z = 112
then begin
GraphPrevBtn.Parent := Form1;
[...]
.. and what's with the 'GetLastError', it seems fully irrelevant. If you're going to use it, at least set last error to '0' by calling GetLastError or SetLastErrorbefore beginning your operation.
Maybe something more like this will help you:
var
frm_PrevBtn : TForm = nil;
procedure TForm1.GraphPrevBtnMouseEnter(Sender: TObject);
var
P: TPoint;
begin
GraphPrevBtn.Width := 75;
if frm_PrevBtn = nil then begin
P := GraphPrevBtn.ClientOrigin;
frm_PrevBtn := TForm.Create(nil);
with frm_PrevBtn do begin
BorderStyle := bsNone;
Position := poDesigned;
SetBounds(P.X, P.Y, GraphPrevBtn.Width, GraphPrevBtn.Height);
TransparentColor := True;
TransparentColorValue := clBtnFace;
GraphPrevBtn.Parent := frm_PrevBtn;
GraphPrevBtn.Top := 0;
GraphPrevBtn.Left := 0;
Show;
end;
end;
end;
procedure TForm1.GraphPrevBtnMouseLeave(Sender: TObject);
begin
if (FindVCLWindow(Mouse.CursorPos) <> GraphPrevBtn) and (frm_PrevBtn <> nil) then begin
GraphPrevBtn.Parent := Self;
GraphPrevBtn.BringToFront;
GraphPrevBtn.Top := 29;
GraphPrevBtn.Left := 226;
FreeAndNil(frm_PrevBtn);
end;
end;
Why don't you do it like this:
MainForm.OnMouseOver: Create a secondary form.
SecondaryForm.OnMouseOver: Set FLAG_ON_SECONDARY.
SecondaryForm.OnMouseLeave: Clear FLAG_ON_SECONDARY.
MainForm.OnMouseLeave: if not FLAG_ON_SECONDARY then destroy the secondary form.
This might not work in case SecondaryForm.OnMouseOver fires after MainForm.OnMouseLeave. Well, think of something similar. Another solution is to start a timer which destroys SecondaryForm and disables itself if mouse is neither on Main nor on SecondaryForm.