I'm using Sir Rufo's TStateless framework in Delphi 10.1 Berlin Update 2.
I'm trying to adapt this kind of workflow:
Here is how I have set my classes:
Some of my states does have an "OnEntry" event or an "OnExit" event :
type
TWarehouseCheckInState = (New, OrderChecked, ProductChecked, CartonAdded,
Validated, Canceled);
TWarehouseCheckInTrigger = (SetOrder, SetProduct, AddCarton, Validate, Cancel);
TWarehouseCheckInStateMachine = TStateMachine<TWarehouseCheckInState,
TWarehouseCheckInTrigger>;
FState.Configure(TWarehouseCheckInState.New).OnEntry(
procedure
begin
FOrder := '';
FProduct := '';
FScannedBarCode := '';
end
).Permitif(TWarehouseCheckInTrigger.SetOrder,
TWarehouseCheckInState.OrderChecked,IsOrderValid);
FState.Configure(TWarehouseCheckInState.OrderChecked).OnExit(
procedure
begin
GetCommandeFournisseur;
end
).Permitif(TWarehouseCheckInTrigger.SetProduct,
TWarehouseCheckInState.ProductChecked,IsProductValid );
FState.Configure(TWarehouseCheckInState.ProductChecked)
.PermitReentryif(TWarehouseCheckInTrigger.AddCarton,IsNeverAdded);
FState.Configure(TWarehouseCheckInState.CartonAdded).OnEntry(
procedure
begin
if ProductNotAdded(FScannedBarCode) then
AddProduct(TProduct.Create(FScannedBarCode));
end
);
Here is how I'm using my class:
WarehouseCheckIn := TWarehouseCheckIn.Create;
WarehouseCheckIn.State.OnTransitioned(WarehouseCheckInTransitioned);
WarehouseCheckIn.Order := '49469';
WarehouseCheckIn.State.Fire(TWarehouseCheckInTrigger.SetOrder);
WarehouseCheckIn.Product := 'F0055';
WarehouseCheckIn.State.Fire(TWarehouseCheckInTrigger.SetProduct);
WarehouseCheckIn.ScanedBarCode := '1';
WarehouseCheckIn.State.Fire(TWarehouseCheckInTrigger.AddCarton);
WarehouseCheckIn.ScanedBarCode := '2';
WarehouseCheckIn.State.Fire(TWarehouseCheckInTrigger.AddCarton);
WarehouseCheckIn.ScanedBarCode := '3';
WarehouseCheckIn.State.Fire(TWarehouseCheckInTrigger.AddCarton);
WarehouseCheckIn.ScanedBarCode := '1';
WarehouseCheckIn.State.Fire(TWarehouseCheckInTrigger.AddCarton); /* <=== should throw an exception because '1' was previously added */
I have mainly two problems:
OnEntry events are never fired.
I don't know how to add multiple conditions to the "AddCarton" state (check that carton was never added AND check that there is remaining carton to be picked).
This looks pretty simple, but I don't know how to achieve it.
i'm creating a application who reads a txt file, and send for a second form, then i printscreen the form, and print then
code above:
count := form1.Memo1.Lines.Count;
gerarcodigo create a barcode.
var y,i : integer;
begin
begin
for i := 0 to count do
begin
button1.visible := false;
label1.caption := form1.memo1.lines[i];
label2.Caption := form1.memo7.lines[i] ;
label9.Caption := form1.memo2.lines[i];
label10.Caption := form1.memo3.lines[i];
label11.Caption := form1.memo4.lines[i];
label13.Caption := form1.memo5.lines[i];
label14.Caption := form1.memo6.lines[i];
GerarCodigo(label1.caption, Image1.Canvas);
PrintScale := poNone;
Print;
end;
but the problem is after print the frist one, the print left 2 paper blank, so then print the right infomation, and repeat until finish.
For more explication, i try to draw something.
when i try to print,
What can i do, to solve this problem?
i'm using argox printer for now.
I can't found any sample in the online documentation, or in the demos included with Delphi XE2, for adding nodes to a FMX.TreeView.TTreeView control at runtime. So, how can I add, remove, and traverse nodes of a FireMonkey TreeView at runtime?
I think we are all learning at this point...
But from what I have seen the TTreeView use the principle that any control can parent another control.
All you need to do is set the Parent Property to get the item to show up as a child.
var
Item1 : TTreeViewItem;
Item2 : TTreeViewItem;
begin
Item1 := TTreeViewItem.Create(Self);
Item1.Text := 'My First Node';
Item1.Parent := TreeView1;
Item2 := TTreeViewItem.Create(Self);
Item2.Text := 'My Child Node';
Item2.Parent := Item1;
end;
Because of this you can do things never possible before, such as placing any control in the TreeView. For example this code will add a button to the area used by Item2, and the button won't be visible until the Item2 is visible.
Button := TButton.Create(self);
Button.Text := 'A Button';
Button.Position.X := 100;
Button.Parent := Item2;
With AddObject(FmxObject) you can add any Object (Button etc.) as well...
I have another idea. The first answer helped me get it.
So Add the following code
Var
TempItem:TTreeViewItem;
Begin
TempItem := TTreeViewItem.Create(Self);
TempItem.Text := 'Enter Caption Here';
TempItem.Parent := TreeView;
End
Now the actual trick comes when you have to free the item so that it doesn't use unnecessary memory. So lets say you use it in a loop, like I did here:
ADOTable.Connection := ADOConnection;
ADOTable.TableName := 'MenuTree';
ADOTable.Open;
ADOTable.First;
ADOTable.Filter := '(CHFlag=''CURRENT'') AND (Parent=''Tree'')';
ADOTable.Filtered := True;
While NOT ADOTable.Eof Do
Begin
TempItem := TTreeViewItem.Create(Self);
TempItem.Text := ADOTable['ItemName'];
TempItem.Parent := TreeView;
// TempItem.Free;
ADOTable.Next;
End;
TempItem.Free;
ADOTable.Close;
Your code isn't secure. If ADOTable is empty, TempItem is never created and the 'free' will generate an access violation.
And even if the table is not empty, you will only free the last TempItem created.
I use CoolTrayIcon component,but I can modify it by hand.What I want to accomplish is to update the text in the balloon i just created without actually creating another balloon.Problem is:
function TCoolTrayIcon.ShowBalloonHint(Title: String; Text: String;
IconType: TBalloonHintIcon; TimeoutSecs: TBalloonHintTimeOut): Boolean;
// Show balloon hint. Return false if error.
const
aBalloonIconTypes: array[TBalloonHintIcon] of Byte =
(NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR);
begin
// Remove old balloon hint
HideBalloonHint;
// Display new balloon hint
with IconData do
begin
uFlags := uFlags or NIF_INFO;
StrLCopy(szInfo, PChar(Text), SizeOf(szInfo)-1);
StrLCopy(szInfoTitle, PChar(Title), SizeOf(szInfoTitle)-1);
TimeoutOrVersion.uTimeout := TimeoutSecs * 1000;
dwInfoFlags := aBalloonIconTypes[IconType];
end;
Result := ModifyIcon;
{ Remove NIF_INFO before next call to ModifyIcon (or the balloon hint will
redisplay itself) }
with IconData do
uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
end;
function TCoolTrayIcon.HideBalloonHint: Boolean;
// Hide balloon hint. Return false if error.
begin
with IconData do
begin
uFlags := uFlags or NIF_INFO;
StrPCopy(szInfo, '');
end;
Result := ModifyIcon;
end;
function TCoolTrayIcon.ModifyIcon: Boolean;
// Change icon or tooltip if icon already placed
begin
Result := False;
if InitIcon then
Result := Shell_NotifyIcon(NIM_MODIFY, #IconData);
end;
I thought the problem is in the function HideBalloonHint,but I was wrong.I commented the call to HideBalloonHint at ShowBalloonHint in other to update the text,but it didn't work.
Question:How to only update the text in the tray balloon without creating another balloon?
It appears that your icon is only set if InitIcon is true. Change your modifyIcon procedure to read:
function TCoolTrayIcon.ModifyIcon: Boolean;
// Change icon or tooltip if icon already placed
begin
Result := Shell_NotifyIcon(NIM_MODIFY, #IconData);
end;
or set InitIcon to true before calling ModifyIcon.
EDIT--
The record format used for #IconData is documented on the MSDN website along with the shell_NotifyIcon call. From what the specifications read, you should be able to pass the same record as originally sent to update, since that is not working you might have to take another approach.
Create your "own" balloon hint form, and position it just over your task icon, and update it directly. This would eliminate the multiple balloon windows.
I am using this method to send a MAPI email with a PDF attachment from inside a Delphi application.
It brings up an MS Outlook "new message" window with the pdf document already attached, and a blank recipient.
If you type in a normal email contact, then it goes through fine.
However, if you select a fax recipient, it appears in my "Sent Items" folder, but delivery fails silently (no error, no MS Outlook "delivery failed" message, and no delivery of the message).
The "fax recipient" is set up in MS Outlook with nothing but a fax number. No email or anything. We use a faxcore server to route these "faxes" to the outlook inbox.
If you look at this image, the only field I've filled in for this contact is the one labeled "Business Fax".
If I manually (i.e., outside of my application) create a standard MS Outlook email and choose the very same fax recipient, and manually attach the very same PDF, then it goes through fine.
So it seems that something about using MAPI to send to a fax number causes it to fail.
This post sounds similar, except they get a "message undeliverable" error and I don't.
Can anyone give me some pointers on this?
Thanks
Update: If I use MAPI to create the email, but then I manually delete the attachment, then it does work. So from within outlook, I can email an attachment to a fax recipient, but using MAPI it fails.
Complete source code follows:
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
function SendEMailUsingMAPI(const Subject, Body, FileName, SenderName,
SenderEMail, RecipientName, RecipientEMail: string): integer;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
Mapi;
procedure TForm1.Button1Click(Sender: TObject);
begin
//this will bring up an MS Outlook dialog.
//inside that dialog, if i choose a normal email recipient, it works.
// if i choose a fax recipient, it fails silently.
//if i create the email from w/in outlook, it can go to *either* with success.
SendEmailUsingMAPI(
'Subject', //subject of email
'Body', //body of email text
'c:\my_doc.pdf', //attachment file name
'My name', //sender email name
'myemail#mydomain.com', //sender email address
'', //recipient email name
''); //recipient email address
end;
function TForm1.SendEMailUsingMAPI(const Subject, Body, FileName, SenderName,
SenderEMail, RecipientName, RecipientEMail: string): Integer;
var
Message: TMapiMessage;
lpSender, lpRecipient: TMapiRecipDesc;
FileAttach: TMapiFileDesc;
SM: TFNMapiSendMail;
MAPIModule: HModule;
FileType: TMapiFileTagExt;
begin
FillChar(Message,SizeOf(Message),0);
if (Subject <> '') then begin
Message.lpszSubject := PChar(Subject);
end;
if (Body <> '') then begin
Message.lpszNoteText := PChar(Body);
end;
if (SenderEmail <> '') then
begin
lpSender.ulRecipClass := MAPI_ORIG;
if (SenderName = '') then begin
lpSender.lpszName := PChar(SenderEMail);
end
else begin
lpSender.lpszName := PChar(SenderName);
end;
lpSender.lpszAddress := PChar(SenderEmail);
lpSender.ulReserved := 0;
lpSender.ulEIDSize := 0;
lpSender.lpEntryID := nil;
Message.lpOriginator := #lpSender;
end;
if (RecipientEmail <> '') then begin
lpRecipient.ulRecipClass := MAPI_TO;
if (RecipientName = '') then begin
lpRecipient.lpszName := PChar(RecipientEMail);
end
else begin
lpRecipient.lpszName := PChar(RecipientName);
end;
lpRecipient.lpszAddress := PChar(RecipientEmail);
lpRecipient.ulReserved := 0;
lpRecipient.ulEIDSize := 0;
lpRecipient.lpEntryID := nil;
Message.nRecipCount := 1;
Message.lpRecips := #lpRecipient;
end
else begin
Message.lpRecips := nil;
end;
if (FileName = '') then begin
Message.nFileCount := 0;
Message.lpFiles := nil;
end
else begin
FillChar(FileAttach,SizeOf(FileAttach),0);
FileAttach.nPosition := Cardinal($FFFFFFFF);
FileAttach.lpszPathName := PChar(FileName);
FileType.ulReserved := 0;
FileType.cbEncoding := 0;
FileType.cbTag := 0;
FileType.lpTag := nil;
FileType.lpEncoding := nil;
FileAttach.lpFileType := #FileType;
Message.nFileCount := 1;
Message.lpFiles := #FileAttach;
end;
MAPIModule := LoadLibrary(PChar(MAPIDLL));
if MAPIModule = 0 then begin
Result := -1;
end
else begin
try
#SM := GetProcAddress(MAPIModule,'MAPISendMail');
if #SM <> nil then begin
Result := SM(0,Application.Handle,Message,
MAPI_DIALOG or MAPI_LOGON_UI,0);
end
else begin
Result := 1;
end;
finally
FreeLibrary(MAPIModule);
end;
end;
if Result <> 0 then begin
MessageDlg('Error sending mail ('+IntToStr(Result)+').',mtError,[mbOK],0);
end;
end;
end.
Ok, your update points towards the attachment, so I'm going to put in another guess: try setting the filetype of the attachment explicitly to 'application/pdf' (your current code doesn't set the lpFileType field). The fax handling might be dependent on that. You can just leave the encoding parts of the MapiFileTagExt (the type lpFileType points to) blank, simply FillChar the record and set cbTag and lpTag fields.
If you need code (the mapi structures can be a bit dazzling at times) just yell, but it'll take me some time to find a moment to type it up.. And anyway, again, I'm just guessing. I don't have a fax setup in my home environment, otherwise I'd do some proper testing.
EDIT
Illustrating bit of code below. However, I've since then checked with Outlook Spy, and with neither method, nor when attaching a file manually, the PR_ATTACH_MIME_TAG property seems to be set on the sent item, only on the resulting incoming message.
FillChar(FileAttach,SizeOf(FileAttach),0);
FileAttach.nPosition := Cardinal($FFFFFFFF);
FileAttach.lpszPathName := PChar(FileName);
//
MimeType := 'application/pdf';
//
FileType.ulReserved := 0;
FileType.cbTag := Length( MimeType );
FileType.lpTag := PByte(MimeType);
FileType.cbEncoding := 0;
FileType.lpEncoding := nil;
//
FileAttach.lpFileType := #FileType;
Message.nFileCount := 1;
Message.lpFiles := #FileAttach;
(code-formatter is not being particularly helpful).
Could it be the fax addresses are not available in the 0 (temporary) session? In other words, does logging into a session using MAPILogon first, then providing the hSession in the MAPISendMail call help?
You could try enabling Outlook Transport Logging, hopefully some (any) error message will turn up there. Make sure to log a manual fax (working situation) first, to check if anything related actually does show up in this log.
Unfortunately, my personal success rate in solving issues through this log is zilch, but trying to get more information never hurts, right?