I am using the Open Source Abbrevia Components to Archive some Files into a single Zip, whilst this is happening I am using the TAbMeter Gauge to display the progress.
I would prefer to use the TProgressBar for this purpose instead though (maintaining a standard interface with Windows).
How may I use a TProgressBar instead of the TAbMeter? I know I could code the progress myself, but seeing as the Abbrevia Components already have this done in the TAbMeter, I see no sense in rewriting it.
If I could even access the Position property of the TAbMeter I could simulate the TProgressBar's progress by synchronizing with the TAbMeter.
Here is a snippet, FileNames is a TStringList containing the Filenames to archive..
procedure ArchiveFiles(SaveAs: string; ProgressBar: TAbMeter);
var
AZipper: TAbZipper;
i: Integer;
begin
AZipper := TAbZipper.Create(nil);
try
AZipper.AutoSave := False;
AZipper.BaseDirectory := ExtractFilePath(SaveAs);
AZipper.ArchiveSaveProgressMeter := ProgressBar;
AZipper.FileName := SaveAs;
AZipper.StoreOptions := AZipper.StoreOptions + [soStripDrive, soRemoveDots]
- [soStripPath];
AZipper.TempDirectory := GetTempDirectory;
try
Screen.Cursor := crHourGlass;
ProgressBar.Visible := True;
for i := 0 to FileList.Count - 1 do
begin
AZipper.AddFiles(FileList.Strings[i], 0);
end;
finally
AZipper.Save;
AZipper.CloseArchive;
ProgressBar.Visible := False;
Screen.Cursor := crDefault;
end;
finally
AZipper.Free;
end;
end;
You are presumably setting the ArchiveSaveProgressMeter somewhere in your code. You can simply stop doing this and instead set the OnArchiveSaveProgress event. Then you need to supply an event with this signature:
procedure(Sender: TObject; Progress: Byte; var Abort: Boolean) of object;
You would respond to receipt of such an event by updating the Position value of the progress bar in your UI.
The method that surfaces this progress event also handles the progress meter version:
procedure TAbCustomZipper.DoArchiveSaveProgress(
Sender: TObject; Progress: Byte; var Abort : Boolean);
begin
Abort := False;
if Assigned(FArchiveSaveProgressMeter) then
FArchiveSaveProgressMeter.DoProgress(Progress);
if Assigned(FOnArchiveSaveProgress) then
FOnArchiveSaveProgress(Self, Progress, Abort);
end;
So the designers of the component have simply provided two alternative routes to receiving progress: the meter or a callback.
In order to handle progress from a callback you need to write a method like this:
procedure TMyMainForm.OnArchiveSaveProgress(
Sender: TObject; Progress: Byte; var Abort: Boolean);
begin
FProgressBar.Position := Progress;
end;
You then assign this event handler to OnArchiveSaveProgress, most likely in the IDE. It's an identical procedure to assigning an OnClick event to a button.
Note: I've never used Abbrevia so I may have picked out a different component from the one you are using. However, all the components that interact with meters, also offer progress via a callback so this basic approach will work no matter which component you use.
In case it helps anyone else, I've created a new TAbProgressBar component that can be used instead of TAbMeter. They both implement the same interface, so it works with the same Archive*ProgressMeter properties. Just update Abbrevia from Subversion and recompile the AbbreviaVCL and AbbreviaVCLDesign packages.
Related
I have a Sunmi L2s device, and I'm trying to receive the result of a barcode scan via a broadcast to an Android app. I would like to create an app that, when I push the hardware button for scan (orange button to the side of the phone), shows the barcode on a TLabel.Text in the app.
I've found code here on StackOverflow, but I can't make it receive the results, and I'm getting a message when the app starts that says "External exception 0".
I'm new to Delphi/Android development, so any help is welcome!
implementation
{$R *.fmx}
uses
FMX.Platform.Android, Androidapi.JNI.JavaTypes, Androidapi.JNI.Net,
Androidapi.JNI.Os, Androidapi.Helpers;
procedure TForm4.FormCreate(Sender: TObject);
var
AppEventService: IFMXApplicationEventService;
begin
if TPlatformServices.Current.SupportsPlatformService(IFMXApplicationEventService, AppEventService) then
AppEventService.SetApplicationEventHandler(HandleAppEvent);
MainActivity.registerIntentAction(StringToJString('com.sunmi.scanner.ACTION_DATA_CODE_RECEIVED'));
TMessageManager.DefaultManager.SubscribeToMessage(TMessageReceivedNotification, HandleActivityMessage);
end;
procedure TForm4.HandleActivityMessage(const Sender: TObject; const M: TMessage);
begin
if M is TMessageReceivedNotification then
HandleIntentAction(TMessageReceivedNotification(M).Value);
end;
function TForm4.HandleAppEvent(AAppEvent: TApplicationEvent; AContext: TObject): Boolean;
var
StartupIntent: JIntent;
begin
Result := False;
if AAppEvent = TApplicationEvent.BecameActive then
begin
StartupIntent := MainActivity.getIntent;
if StartupIntent <> nil then
HandleIntentAction(StartupIntent);
end;
end;
function TForm4.HandleIntentAction(const Data: JIntent): Boolean;
var
JStr: JString;
begin
Result := False;
if (Data <> nil) and Data.getAction.equals(StringToJString('com.sunmi.scanner')) then
begin
JStr := Data.getStringExtra(StringToJString('Data'));
Label1.Text := JStringToString(JStr);
Invalidate;
end;
end;
end.
One issue I see that could be causing your "External exception" error is that in HandleIntentAction(), Data.getAction() can potentially return nil, which you are not checking for. Also, you need to compare the complete action name, not a prefix of it.
Change this:
Data.getAction.equals(StringToJString('com.sunmi.scanner'))
To this instead:
StringToJString('com.sunmi.scanner.ACTION_DATA_CODE_RECEIVED').equals(Data.getAction)
Other than that, the only other potential issue I see is in HandleAppEvent(), are you sure BecameActive is the best event to use to handle the StartupIntent? I would think FinishedLaunching would be a more appropriate event. An app can gain and lose focus multiple times during its lifetime, so you wouldn't want to handle the same startup Intent object over and over. Otherwise, at the very least, after you have processed the StartupIntent, you could optionally call MainActivity.setIntent(nil) so that MainActivity.getIntent() won't return the same Intent object anymore on subsequent events. Or, you could simply get rid of HandleAppEvent() and just handle the StartupIntent directly in your Form's OnCreate event.
The post is a bit old, however maybe you are querying the wrong key 'Data' instead of 'data' which seems to be the right default key for sunmi device :
JStr := Data.getStringExtra(StringToJString('Data'));
Replace it by
JStr := Data.getStringExtra(StringToJString('data'));
I would like to create a non visual component (like TTimer for example) that I can drop on the form and that I can set up directly from the Object Inspector, but I don't want to see its icon on the form (it'd just obstruct anything). For example TFloatAnimation works like this but I don't understand how.
The GExperts library (http://www.gexperts.org/) has a plug-in which can toggle the visibility
of non-visual components on a form, and it is apparently not Delphi-version-specific but it is
not exactly trivial.
The method which does this is
procedure THideNonVisualCompsExpert.ToggleNonVisualVisible(Form: TCustomForm);
const
NonVisualClassName = 'TContainer';
var
VisibleState: Boolean;
FormHandle: THandle;
CompHandle: THandle;
WindowClass: string;
FirstCompFound: Boolean;
WinControl: TWinControl;
ChildControl: TWinControl;
i: Integer;
begin
Assert(Assigned(Form));
Assert(Form.Handle > 0);
FirstCompFound := False;
WinControl := Form;
if InheritsFromClass(WinControl.ClassType, 'TWinControlForm') then
begin
for i := WinControl.ComponentCount - 1 downto 0 do
begin
if WinControl.Controls[i] is TWinControl then
begin
ChildControl := WinControl.Controls[i] as TWinControl;
if InheritsFromClass(ChildControl.ClassType, 'TCustomFrame') then
begin
WinControl := ChildControl;
Break;
end;
end;
end;
end;
FormHandle := GetWindow(WinControl.Handle, GW_CHILD);
CompHandle := GetWindow(FormHandle, GW_HWNDLAST);
VisibleState := False;
GxOtaClearSelectionOnCurrentForm;
while (CompHandle <> 0) do
begin
WindowClass := GetWindowClassName(CompHandle);
if AnsiSameText(WindowClass, NonVisualClassName) then
begin
if not FirstCompFound then
begin
VisibleState := not IsWindowVisible(CompHandle);
FirstCompFound := True;
end;
if VisibleState then
ShowWindow(CompHandle, SW_SHOW)
else
ShowWindow(CompHandle, SW_HIDE);
end;
CompHandle := GetWindow(CompHandle, GW_HWNDPREV);
end;
end;
in the unit GX_HideNonVisualComps.Pas.
As written, it toggles the visibility of all the non-visual components on the
target form, but looking at the code of the ToggleNonVisualVisible method it looks like it
ought to be possible (but I have not tried) to adapt it to operate on a selected component class and
force instances of the class to a non-visible state. Once you have done that, you would probably
need to experiment with how and when to invoke the method at design-time; if I was doing it, I would probably start
with somewhere like the target component's Loaded method.
(I would feel more comfortable posting this "answer" as a comment but obviously it would be too long)
I have thought about this. A Non Visual Component does not do any painting, in a Windows environment (like the IDE) it has no Window, and therefore cannot influence how the IDE chooses to render it.
One approach would be to derive from TWinControl, making your component a Visual Component, and then to ensure that it is not drawn. Try setting the positioning properties to be non-published, and when you are parented, always set your position outside the parent window. This means that your control is always clipped and never painted.
I haven't tried this, but I can see no reason why it wouldn't work.
You can also use this approach to have an apparently non visual component that renders information in the IDE at designtime, but not at runtime.
I've created a pop-up loadscreen Form that I want to show above any other form in a Firmonkey Multi device project. Now i've run into the problem that the loadscreen doesn't get updated with the things I do in the background Form. How can I solve this?
In the code below is an example of what i've tried:
procedure TForm1.Button1Click(Sender: TObject);
var
loadScreen:TfrmLoadScreen;
begin
loadScreen := TfrmLoadScreen.Create(nil);
loadScreen.ShowModal(
procedure(ModalResult: TModalResult)
var
i:Integer;
begin
for i := 0 to 200 do
begin
loadScreen.CurrentItem := i;
loadScreen.TextMessage := 'Item:' + loadScreen.CurrentItem.ToString;
Sleep(100);
end;
ModalResult := mrCancel;
end);
end;
I guess I have to do some multi-threading, but I don't have any experience doing this! How should I do this for my loadscreen?
I've also tried the following, but the form doesn't get shown:
procedure TForm1.Button1Click(Sender: TObject);
var
loadScreen:TfrmLoadScreen;
begin
loadScreen := TfrmLoadScreen.Create(nil);
loadScreen.OnShow := FormShowLoadScreen;
loadScreen.Show;
end;
procedure TForm1.FormShowLoadScreen(Sender: TObject);
var
i:Integer;
loadScreen:TfrmLoadScreen;
begin
loadScreen := TfrmLoadScreen(Sender);
for i := 0 to 200 do
begin
loadScreen.CurrentItem := i;
Sleep(100);
end;
loadScreen.Close;
end;
In your first code block, the annonymous method is only called after loadscreen.modalresult is set to something other than 0. This never happens (that we can see)
In your second block, you have 2 different loadscreen instances. They are not the same one. The FormShowLoadScreen handler is called after the firstly loadscreen.show, but it creates a 2nd loadscreen, with it's own displays. In fact, this might happen so fast, you wouldn't see it happen.
You really need to learn more about Delphi multi-threading. To display a "progress" form, you will have to put it's processing (display updates) inside the synchronise event of a separate thread that is started just after the loadscreen form is shown.
Actually... It's actually much easier in FMX to show an animation indicator before starting an annonymous thread, and then hide it again in the thread terminate block.
See Marco Cantu's blog post here Background Operations on Delphi Android, with Threads and Timers
Although I realise that in addition to the included Delphi docking demo there are other and better docking libraries available such as the Developer Express Library and the JVCL Docking Library, but for a specific demonstration project I am restricted to use only the Delphi built-in capability (despite some of the noted flaws).
My question relates to adding persistence to the docking state. I see from examining Controls.pas that TDockTree is the default dock manager and it has Stream I/O routines. Digging around on SO and in various forums though I cant see how anyone has called these routines. I've tried loading and saving to a file from the relevant Create and OnDrop events but I'm stabbing in the dark. I am happy saving and restoring form sizes and states but am struggling with the concepts of what I should be saving. Would any kind person give me a starting place?
I'm using Delphi XE3, so all (?) things are possible!
Many thanks.
I'm using Toolbar 2000 from J. Russels. It is providing panels, toolwindow's and toolbar's.
That one provides functions like TBRegSavePositions and TBRegSavePositions to store the user customization into registry.
Loading a "view" get's easily done by on code line:
TBRegLoadPositions(self, HKEY_CURRENT_USER, c_BaseUserRegKey);
in this case self is my form.
You can load and save your docking configuration with the LoadFromStream and SaveToStream methods by storing the data in a string.
Therefore, the following methods are required:
save the current docking configuration to a string
load the current docking configuration from a string
Here is some code to do this:
function GetDockString(const AManager: IDockManager): AnsiString;
var
LStream: TMemoryStream;
begin
LStream := TMemoryStream.Create();
try
AManager.SaveToStream(LStream);
SetLength(Result, 2 * LStream.Size);
BinToHex(LStream.Memory, PAnsiChar(Result), LStream.Size);
finally
FreeAndNil(LStream);
end;
end;
procedure ReadDockString(const ADockString: AnsiString; const AManager: IDockManager);
var
LStream: TMemoryStream;
begin
LStream := TMemoryStream.Create();
try
LStream.Size := Length(ADockString) div 2;
HexToBin(PAnsiChar(ADockString), LStream.Memory, LStream.Size);
LStream.Position := 0;
AManager.LoadFromStream(LStream);
finally
FreeAndNil(LStream);
end;
end;
I've used such methods in an application to create dockable windows, but the vcl provides only a very basic user experience. You can do something about it, but it is hard to test and debug - I already spent too much time to use and override TCustDockDragObject and TCaptionedTabDockTree, so I would recommend using a docking framework.
Here is a minimal example which creates two forms and reads a docking configuration.
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDblClick(Sender: TObject);
private
FPanel: TPanel;
end;
Implementation:
procedure TForm1.FormCreate(Sender: TObject);
var
LWindow: TForm;
const
LDockExample = '0000080000000000000000000000000000000000000000000000000100000000000000000B0000004368696C6457696E646F77FFFFFFFF';
begin
FPanel := TPanel.Create(Self);
FPanel.Align := alTop;
FPanel.Height := 300;
FPanel.DockSite := true;
FPanel.Parent := Self;
LWindow := TForm.CreateNew(Self);
LWindow.Name := 'ChildWindow';
LWindow.DragKind := dkDock;
LWindow.BoundsRect:=Rect(10, 10, 400, 400);
LWindow.Color := clGreen;
LWindow.Show;
ReadDockString(LDockExample, FPanel.DockManager);
end;
procedure TForm1.FormDblClick(Sender: TObject);
begin
ShowMessage(GetDockString(FPanel.DockManager));
end;
I've got a pretty big setup form which I'd like to populate with data from a class. so I'm doing a lot of
Edt1.text := ASettings.FirstThing;
I'd like to avoid
Edt1.onchange := nil;
Edt1.text := ASettings.FirstThing;
Edt1.onchange := edt1Onchange;
How do I change the text in a text box and sidestep the onchange event.
I have used something like changing the OnChange handler, but more often, I use a flag.
updatingFromCode := true;
Edt1.Text := ASettings.FirstThing;
updatingFromCode := false;
then
procedure TForm1.OnChange(...);
begin
if updatingFromCode then
Exit;
...
Also, rather than hardcoding the OnChange the the actual OnChange procedure, I would store the Edit control's current value, then reset it (which will work if it is not set, or if another place has changed it, etc.)
oldOnChange := Edt1.OnChange;
Edt1.OnChange := nil;
Edt1.Text := ASettings.FirstThing;
Edt1.OnChange := oldOnChange;
You might consider using an object to manage the NIL'ing of the event and restoring the previously installed event handler. It's a little dangerous to assume that the event to be restored just happens to be the one assigned at design-time/which happens to have the "name that fits" - you should always save/restore the currently assigned handler, just to be safe.
This would provide an even more re-usable utility than the SetTextWithoutOnChange() routine:
TSuspendEvent = class
private
fObject: TObject;
fEvent: String;
fHandler: TMethod;
public
constructor Create(const aObject: TObject; aEvent: String);
destructor Destroy; override;
end;
constructor TSuspendEvent.Create(const aObject: TObject; aEvent: String);
const
NILEvent : TMethod = (Code: NIL; Data: NIL);
begin
inherited Create;
fObject := aObject;
fEvent := aEvent;
fHandler := GetMethodProp(aObject, aEvent);
SetMethodProp(aObject, aEvent, NILEvent);
end;
destructor TSuspendEvent.Destroy;
begin
SetMethodProp(fObject, fEvent, fHandler);
inherited;
end;
In usage, this would look something like:
with TSuspendEvent.Create(Edit1, 'OnChange') do
try
Edit1.Text := 'Reset!';
finally
Free;
end;
For the "Thou shalt not use 'with' crowd" - by all means declare yourself an additional local variable and use that if it will help you sleep easier at night. :)
Or, to make it even more convenient to use and eliminate "with", I would make the TSuspendEvent class an interfaced object and wrap its use in a function that yielded an interface reference to it that could be allowed to "live in scope", as exemplified by my AutoFree() implementation. In fact, you could use AutoFree() as-is to manage this already:
AutoFree(TSuspendEvent.Create(Edit1, 'OnChange'));
Edit1.Text := 'Reset!';
Dsabling events for a period that extends beyond the scope of a single procedure requires more management than any helper utilities are likely to be able to provide in a generic fashion I think, at least not without also having specific means for restoring events explicitly, rather than automatically.
If you simply wrapped TSuspendEvent inside it's own interface yielding function, following the same pattern as AutoFree() you could simplify this further to:
SuspendEvent(Edit1, 'OnChange');
Edit1.Text := 'Reset!';
As a final note, I think it should be fairly easy to see how this could be quite simply extended to support suspending multiple events on an object in a single call, if required, for example:
SuspendEvent(Edit1, ['OnChange', 'OnEnter']);
As far as I know if the OnChange of your object is designed to fire when the Text property is changed you have to stick with setting the event to nil temporarly. Myself, I do it this way (in a try finally):
Edt1.onchange := nil;
try
Edt1.text := ASettings.FirstThing;
finally
Edt1.onchange := edt1Onchange;
end;
You could also do some procedure to handle it for you:
procedure SetTextWithoutOnChange(anEdit: TEdit; str: String);
var
anEvent: TNotifyEvent;
begin
anEvent := anEdit.OnChange;
anEdit.OnChange := nil;
try
anEdit.Text := str;
finally
anEdit.OnChange := anEvent;
end;
end;
I know this is an old question but I thought I would add my solution that does not involve any of the complicated procedures outlined in the previous answers in case it comes up in another search.
The problem is the onChange event itself. I don't use it at all for text fields.
remove all OnChange and use the OnExit instead and tie it to the OnKeyUp.
All Edits have a common ancestor TCustomEdit.
I generally use one method called CustomEditKeyUp and point all the edits on a form to this single method (TEdit, TLabeledEdit etc etc.)
type THack = class(TCustomEdit);
procedure TForm1.CustomeEditKeyUP(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key=VK_RETURN) and (Sender is TCustomEdit) then
{This is just to isolate the one occasion when they press the
enter but don't exit immediately}
if Assigned(THack(Sender).OnExit) then THack(Sender).OnExit(Sender);
end;
For some reason, the OnExit is private in a TCustomEdit so the Hack is needed. If you know that the edits are from a different route where the OnExit is public, cast if differently and the Hack is not necessary.
Then For each Edit control, use a specific OnExit
procedure TForm1.MyEditExit(Sender: TObject);
begin
if MyEdit.Modified then
begin
{Do Something here}
MyEdit.Modified := false;
end;
end;
If you want to change the value programmatically without it firing 'OnExit'
....
MyEdit.Text :='I've changed it'
MyEdit.Modified := false;
....
The big advantage for me is that when I am parsing the input for say a valid number, I only have to do this once when editing is completed and not for every single backspace, delete insert etc all surrounded by try except as the various formating functions error out as they don't understand spaces etc.. For database etc, the number of calls will be greatly reduced.
That's my two penneth.
Another way is by using Class Helpers introduced in Delphi 8.
http://docwiki.embarcadero.com/RADStudio/Tokyo/en/Class_and_Record_Helpers_(Delphi)
You could write:
type
TEditHelper = class helper for TEdit
public
procedure SetTextDisableOnChange(const AText: string);
end;
{ TEditHelper }
procedure TEditHelper.SetTextDisableOnChange(const AText: string);
var
OnChangeTmp: TNotifyEvent;
begin
OnChangeTmp:=OnChange;
try
OnChange:=nil;
Text:=AText;
finally
OnChange:=OnChangeTmp;
end;
end;
and then:
EditCtrl.SetTextDisableOnChange('I do not invoke OnChange!');
EditCtrl.Text:='I invoke OnChange';