I have developed two procedures of two buttons to for task 1 and task 2. Do you know how to create the new button which can repeat the procedures of two previous buttons to perform task 1 + 2 in assigned number of times ?
Extract the tasks into separate methods:
procedure TForm1.DoTask1;
begin
....
end;
procedure TForm1.DoTask2;
begin
....
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DoTask1;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
DoTask2;
end;
And then add a new button with OnClick handler like this:
procedure TForm1.Button3Click(Sender: TObject);
var
i: Integer;
begin
for i := 1 to N do
begin
DoTask1;
DoTask2;
end;
end;
Related
I have 2 StyleBooks loaded with custom styles and want them to be applied for all forms at once (testing it on windows, Tokyo 10.2.3).
procedure TForm6.Button1Click(Sender: TObject);
begin
StyleBook := StyleBook2;
end;
procedure TForm6.Button2Click(Sender: TObject);
begin
StyleBook := StyleBook1;
end;
If I set UseStyleManager=true, this code doesn't work. If UseStyleManager=false, it works but only for 1 form.
You can use Application.Components[] to get access to each form and set its StyleBook property. Leave UseStyleManager = False for both stylebooks.
Add to the main form:
type
TForm14 = class(TForm)
...
private
procedure ChangeApplicationStyle(sb: TStyleBook);
and implement:
procedure TForm14.ChangeApplicationStyle(sb: TStyleBook);
var
i: integer;
begin
for i := 0 to Application.ComponentCount - 1 do
if Application.Components[i] is TForm then
TForm(Application.Components[i]).StyleBook := sb;
end;
Finally to change, e.g.:
procedure TForm14.Button1Click(Sender: TObject);
begin
ChangeApplicationStyle(StyleBook1);
end;
procedure TForm14.Button2Click(Sender: TObject);
begin
ChangeApplicationStyle(StyleBook2);
end;
Scenario:
User presses Start button random number of times and then has to stop all spawned threads (clicks TerminateButton).
Question:
How to correctly terminate/waitfor/free all executed threads by user?
Normally if I had to run specified number of threads I would just use Array of Threads and then cycle .terminate/.waitfor/free for all items in array.
However in this case I can't do that because number of threads is not determined.
procedure TForm1.StartButtonClick(Sender: TObject);
begin
WorkerThread:=TWorkerThread.Create(true);
WorkerThread.FreeOnTerminate:=false;
WorkerThread.Resume;
end;
procedure TWorkerThread.Execute;
begin
repeat
//some code here
until Terminated=true;
end;
procedure TForm1.TerminateButtonClick(Sender: TObject);
begin
if Assigned(WorkerThread)=true then // <-This will work only for last instance
begin
WorkerThread.terminate; // <-This will work only for last instance
WorkerThread.waitfor; // <-This will work only for last instance
FreeAndNil(WorkerThread); // <-This will work only for last instance
end;
end;
At the moment I'm going to store all threads in TList. This example code seems to work fine.
procedure TForm1.FormCreate(Sender: TObject);
begin
InitializeCriticalSection(CriticalSection);
ThreadList:=TList.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteCriticalSection(CriticalSection);
end;
procedure TForm1.StartButtonClick(Sender: TObject);
begin
EnterCriticalSection(CriticalSection); //<- This will be required in my real multithreaded code
WorkerThread:=TWorkerThread.Create(true);
ThreadList.Add(WorkerThread);
WorkerThread.FreeOnTerminate:=false;
WorkerThread.OnTerminate:=form1.ThreadTerminated;
WorkerThread.Resume;
LeaveCriticalSection(CriticalSection);
end;
procedure TWorkerThread.Execute;
begin
repeat
sleep(random(1000));
until Terminated=true;
end;
procedure TForm1.ThreadTerminated(Sender: TObject);
begin
form1.Memo1.Lines.Add('terminated');
end;
procedure TForm1.TerminateButtonClick(Sender: TObject);
var x:integer;
begin
form1.Memo1.Clear;
EnterCriticalSection(CriticalSection); //<- This will be required in my real multithreaded code
for x:=0 to ThreadList.Count-1 do
begin
if Assigned(ThreadList.Items[x])=true then
begin
WorkerThread:=ThreadList.Items[x];
WorkerThread.Terminate;
WorkerThread.waitfor;
FreeAndNil(WorkerThread);
end;
end;
ThreadList.Clear;
LeaveCriticalSection(CriticalSection);
end;
i've an FTP uploader project that uses a form created on run time to start uploading to multiple FTP Servers ( using Indy ) , my issue is as follows ( and i really need your help ) .
On a Form i put an IdFTP Component + an Upload button + public properties named FTPSrvAdrs and SrcFile + TrgFolder like this way :
type
TFtpUploader = class(TForm)
IdFTP: TIdFTP;
StartUpload:TButton;
UploadProgress:TProgressBar;
procedure StartUploadClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
FFtpSrvAdrs:String;
FSrcFile:String;
FTargetFtpFld:String;
Procedure StartMyUpload();
procedure SetFtpAdrs(const value:string);
procedure SetSrcFile(const value:string);
procedure SetTargetFtpFld(const value:string);
{ Private declarations }
public
{ Public declarations }
property FtpAdrs:string read FFtpSrvAdrs write SetFtpAdrs;
property SourceFile:string read FSrcFile write SetSrcFile;
property TargetFtpFld:string read FTargetFtpFld write SetTargetFtpFld;
end;
var
FtpUploader: TFtpUploader;
implementation
procedure TFtpUploader.StartUploadClick(Sender: TObject);
begin
StartMyUpload();
end;
procedure TFtpUploader.SetFtpAdrs(const value: string);
begin
FFtpSrvAdrs:=value;
end;
procedure TFtpUploader.SetSrcFile(const value: string);
begin
FSrcFile:=value;
end;
procedure TFtpUploader.SetTargetFtpFld(const value: string);
begin
FTargetFtpFld:=value;
end;
procedure TFtpUploader.StartMyUpload;
var
FtpUpStream: TFileStream;
begin
ftpUpStream:= TFileStream.create(FSrcFile, fmopenread)
try
with IdFTP do begin
Host:= FFtpSrvAdrs;
Username:='MyUserName';
Password:='MyPassword';
end;
IdFTP.Connect(true, 1200)
IdFTP.Passive:= true;
IdFTP.ChangeDir(FTargetFtpFld)
IdFTP.Put(ftpUpStream,FSrcFile, false);
finally
ftpUpStream.Free;
end;
end;
procedure TFtpUploader.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
end;
This Form will be created on RunTime ( 4 times = 4 buttons will launch it separately like this way :
in the main form i've this procedure :
Procedure MainForm.UploadTo(FTPSrv,SrcFile,FtpTargetFld:String);
var
FUploadFrm:TFtpUploader;
begin
FUploadFrm:=TFtpUploader.Create(nil);
if assigned(FUploadFrm) then
begin
FUploadFrm.FtpAdrs:=FTPSrv;
FUploadFrm.SourceFile:=SrcFile;
FUploadFrm.TargetFtpFld:=FtpTargetFld;
FUploadFrm.Show;
end;
end;
procedure MainForm.Button1Click(Sender: TObject);
begin
UploadTo('MyFtpSrv_1','MySrcFile_1','MyFtpTargetFld_1');
end;
procedure MainForm.Button2Click(Sender: TObject);
begin
UploadTo('MyFtpSrv_2','MySrcFile_2','MyFtpTargetFld_2');
end;
// same with other 2 buttons
the FtpUploader form is Created / Opened ( 4 instances ) ,The ISSUE IS when i click on StartUpload button the FTP upload process is not started on all these 4 instances , but i've to wait each upload process is done ( finished ) and the other will auto-start , that means not all upload processes are started in same time .
Thank you .
It seems you have to either change Indy library for some non-blocking in-background library (event based or completion port based), or to make your program multi-threading (with it's own bunch of problems like user clicking a button 20 times or closing the form while the process is going, or even closing the program on the run).
Based on http://otl.17slon.com/book/doku.php?id=book:highlevel:async it can look anything like this:
TFtpUploader = class(TForm)
private
CanCloseNow: boolean;
...
procedure TFtpUploader.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Self.CanCloseNow
then Action := caFree
else Action := caIgnore;
end;
procedure TFtpUploader.MyUploadComplete;
begin
Self.CanCloseNow := True;
Self.Close;
end;
procedure TFtpUploader.StartMyUpload;
begin
Self.CanCloseNow := false;
Self.Enabled := False;
Self.Visible := True;
Application.ProcessMessages;
Parallel.Async(
procedure
var
FtpUpStream: TFileStream;
begin
ftpUpStream:= TFileStream.create(FSrcFile, fmopenread)
try
with IdFTP do begin
Host:= FFtpSrvAdrs;
Username:='MyUserName';
Password:='MyPassword';
Connect(true, 1200)
Passive:= true;
ChangeDir(FTargetFtpFld)
// this does not return until uploaded
// thus would not give Delphi a chance to process buttons
// pressed on other forms.
Put(ftpUpStream,FSrcFile, false);
end;
finally
ftpUpStream.Free;
end;
end
,
Parallel.TaskConfig.OnTerminated(
procedure (const task: IOmniTaskControl)
begin
MyUploadComplete;
end;
);
end;
Or you can use simplier AsyncCalls library http://andy.jgknet.de/blog/bugfix-units/asynccalls-29-asynchronous-function-calls/
I made my grid group by date (grabbed the column name and dragged it to where it says 'group by that column'). However, when the grid is displayed all the dates are 'closed' so I must expand them to see data. That is OK but I wonder if it is possible to have current date expanded already (all other should remain closed !) so I do not have to click the expand cross?
try this, you can put the code in other event handler like a TButton for example
procedure TForm1.FormCreate(Sender: TObject);
begin
//aDBTableView1.ViewData.Expand(true); // this is how to expand all records
aDBTableView1.ViewData.Records[YourRecordNumber].Expand(true); // this is how to expand by a given record
end;
OK try the following
procedure TForm1.FormCreate(Sender: TObject);
begin
with cxGrid1DBTableView1 do
begin
DataController.DataSource.DataSet.Locate('YourDateFieldName',DateTimeToStr(Date),
[loPartialKey]);
ViewData.Records[DataController.FocusedRowIndex].Expand(True);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
intLoop,
vValue: Variant;
begin
for intLoop := 0 to self.cxGrid1DBTableView1.DataController.RowCount - 1 do
begin
if self.cxGrid1DBTableView1.ViewData.Rows[IntLoop] is TcxGridGroupRow then
begin
if TcxGridGroupRow(cxGrid1DBTableView1.ViewData.Rows[IntLoop]).Level = cxGrid1DBTableView1MyDate.GroupIndex then
begin
vValue:=TcxGridGroupRow(cxGrid1DBTableView1.ViewData.Rows[IntLoop]).Value ;
if vValue = Date() then
begin
TcxGridGroupRow(cxGrid1DBTableView1.ViewData.Rows[intLoop]).Expand(False);
end;
end;
end;
end;
end;
We have a combo box with more than 100 items.
We want to filter out the items as we enter characters in combo box. For example if we entered 'ac' and click on the drop down option then we want it to display items starting with 'ac' only.
How can I do this?
Maybe you'd be happier using the autocompletion features built in to the OS. I gave an outline of how to do that here previously. Create an IAutoComplete object, hook it up to your combo box's list and edit control, and the OS will display a drop-down list of potential matches automatically as the user types. You won't need to adjust the combo box's list yourself.
To expand on Rob's answer about using the OnChange event, here is an example of how to do what he suggests.
procedure TForm1.FormCreate(Sender: TObject);
begin
FComboStrings := TStringList.Create;
FComboStrings.Add('Altair');
FComboStrings.Add('Alhambra');
FComboStrings.Add('Sinclair');
FComboStrings.Add('Sirius');
FComboStrings.Add('Bernard');
FComboStrings.Sorted := True;
ComboBox1.AutoComplete := False;
ComboBox1.Items.Text := FComboStrings.Text;
ComboBox1.Sorted := True;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(FComboStrings);
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
var
Filter: string;
i: Integer;
idx: Integer;
begin
// Dropping down the list puts the text of the first item in the edit, this restores it
Filter := ComboBox1.Text;
ComboBox1.DroppedDown := True;
ComboBox1.Text := Filter;
ComboBox1.SelStart := Length(Filter);
for i := 0 to FComboStrings.Count - 1 do
if SameText(LeftStr(FComboStrings[i], Length(ComboBox1.Text)), ComboBox1.Text) then
begin
if ComboBox1.Items.IndexOf(FComboStrings[i]) < 0 then
ComboBox1.Items.Add(FComboStrings[i]);
end
else
begin
idx := ComboBox1.Items.IndexOf(FComboStrings[i]);
if idx >= 0 then
ComboBox1.Items.Delete(idx);
end;
end;
My brief contribution working with objects in the combobox:
procedure FilterComboBox(Combo: TComboBox; DefaultItems: TStrings);
function Origin: TStrings;
begin
if Combo.Tag = 0 then
begin
Combo.Sorted := True;
Result := TStrings.Create;
Result := Combo.Items;
Combo.Tag := Integer(Result);
end
else
Result := TStrings(Combo.Tag);
end;
var
Filter: TStrings;
I: Integer;
iSelIni: Integer;
begin
if(Combo.Text <> EmptyStr) then
begin
iSelIni:= Length(Combo.Text);
Filter := TStringList.Create;
try
for I := 0 to Origin.Count - 1 do
if AnsiContainsText(Origin[I], Combo.Text) then
Filter.AddObject(Origin[I], TObject(Origin.Objects[I]));
Combo.Items.Assign(Filter);
Combo.DroppedDown:= True;
Combo.SelStart := iSelIni;
Combo.SelLength := Length(Combo.Text);
finally
Filter.Free;
end;
end
else
Combo.Items.Assign(DefaultItems);
end;
You can handle the combo box's OnChange event. Keep a master list of all items separate from the UI control, and whenever the combo box's edit control changes, adjust the combo box's list accordingly. Remove items that don't match the current text, or re-add items from the master list that you removed previously.
As Rob already answered, you could filter on the OnChange event, see the following code example. It works for multiple ComboBoxes.
{uses}
Contnrs, StrUtils;
type
TForm1 = class(TForm)
ComboBox1: TComboBox;
ComboBox2: TComboBox;
procedure FormCreate(Sender: TObject);
procedure ComboBoxChange(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FComboLists: TList;
procedure FilterComboBox(Combo: TComboBox);
end;
implementation
{$R *.dfm}
procedure TForm1.ComboBoxChange(Sender: TObject);
begin
if Sender is TComboBox then
FilterComboBox(TComboBox(Sender));
end;
procedure TForm1.FilterComboBox(Combo: TComboBox);
function Origin: TStrings;
begin
if Combo.Tag = 0 then
begin
Combo.Sorted := True;
Result := TStringList.Create;
Result.Assign(Combo.Items);
FComboLists.Add(Result);
Combo.Tag := Integer(Result);
end
else
Result := TStrings(Combo.Tag);
end;
var
Filter: TStrings;
I: Integer;
begin
Filter := TStringList.Create;
try
for I := 0 to Origin.Count - 1 do
if AnsiStartsText(Combo.Text, Origin[I]) then
Filter.Add(Origin[I]);
Combo.Items.Assign(Filter);
Combo.SelStart := Length(Combo.Text);
finally
Filter.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FComboLists := TObjectList.Create(True);
// For Each ComboBox, set AutoComplete at design time to false:
ComboBox1.AutoComplete := False;
ComboBox2.AutoComplete := False;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FComboLists.Free;
end;