We are developing a mobile app written by Delphi 11 FMX, from which we need to print small label to a Bluetooth label printer.
we tested in android phone, the Bluetooth connection is successful, but when we try to send printing command (ESC/POS) to the printer, we can see the printer responded(with beep, and 'waiting for data' is shown on the small screen), then the printer moves the label to the next one, but it doesn't print anything, just blank.
First we thought there are something wrong with the printer, then we downloaded 2 different label printing apps from Google play, both are working, and printed text successfully.
Here is the source code:
const
UUID = '{00001101-0000-1000-8000-00805F9B34FB}';
Var
FSocket: TBluetoothSocket ;
//connect Bluetooth printer
procedure TForm1.Button2Click(Sender: TObject);
function ConnectPrinter(pDeviceName: String): boolean;
var
lDevice: TBluetoothDevice;
begin
Result := False;
lDevice := GetDeviceByName(pDeviceName);
if lDevice <> nil then
begin
FSocket := lDevice.CreateClientSocket(StringToGUID(UUID), False);
if FSocket <> nil then
begin
FSocket.Connect;
Result := FSocket.Connected
end;
end;
end;
begin
if (printerName.Text <> '') then
begin
if ConnectPrinter(printerName.Text) then
begin
Label1.Text := 'Connected';
end
else
begin
Label1.Text := 'Disconnected';
end;
end
else
begin
ShowMessage('No device name provided');
end;
end;
// print text to Bluetooth Printer
procedure TForm1.Button3Click(Sender: TObject);
begin
if (FSocket <> nil) and (FSocket.Connected) then
begin
FSocket.SendData(TEncoding.UTF8.GetBytes(chr(27) + chr(64))); //initial printer
//the printer responds with beep, and 'waiting for data' shown on the small screen`
FSocket.SendData(TEncoding.UTF8.GetBytes(chr(27) + chr(97) + chr(0))); //Left aligned
FSocket.SendData(TEncoding.UTF8.GetBytes(chr(27) + chr(33) + chr(0))); //Character parameter set
FSocket.SendData(TEncoding.UTF8.GetBytes(chr(29) + chr(33) + chr(0))); //default font size
FSocket.SendData(TEncoding.UTF8.GetBytes('Print via Bluetooth ')); // send text to printer
FSocket.SendData(TEncoding.UTF8.GetBytes(chr(27) + chr(100) + chr(1))); // Print and feed paper 1 line
// the printer feeds the paper by 1 line, but nothing printed on the label
end;
end;
Related
I have reviewed the help documentation for IDP and I cannot find any functions for building the memo text of the files to download.
Previously I was using DwinsHs and it has been giving me problems. But I was able to use:
function DwinsHs_MemoDownloadInfo(Space, NewLine: String): String;
var
i: Integer;
begin
Result := '';
for i := 0 to GetArrayLength(DwinsHs_DownloadsList) - 1 do
begin
if DwinsHs_DownloadsList[i].Required then
begin
Result := Result + Space + ExtractFileName(DwinsHs_DownloadsList[i].Filename);
if DwinsHs_DownloadsList[i].Downloaded then
begin
Result := Result + Space + ExpandConstant('{cm:ReadyMemo_Downloaded}');
end;
Result := Result + NewLine;
end;
end;
if Result <> '' then
begin
Result := ExpandConstant('{cm:ReadyMemo_Download}') + NewLine + Result;
end;
end;
So, potentially we have up to 4 items that will be downloaded:
Help Documentation setup
VC Redist x86
VC Redist x64
Dot Net Framework
The relevant files are added using idpAddFile (although I don't specify file sizes so there is a little delay). I have asked it to show the download page after wpPreparing:
idpDownloadAfter(wpPreparing);
Ideally, on the memo page I would like it to list the files that we have determined the user wants to download.
You know what files you are downloading, so collect their names at the time you are calling idpAddFile. You can make a wrapper function as a replacement for idpAddFile.
var
FilesToDownload: string;
procedure AddFileForDownload(Url, Filename: string);
begin
idpAddFile(Url, Filename);
FilesToDownload := FilesToDownload + ' ' + ExtractFileName(FileName) + #13#10;
end;
I'm working on a Firemonkey application in Delphi Tokyo and decided to add a loader screen that does some animation. I have a form with a list animation that is run within one thread, and then my calls to the datasnap server runs within another thread. I'm doing it like this because I couldn't get the animation to work if both calls wasn't within a thread.
Now running this on the windows version works fine. Running it on both my Huawei phone and another samsung tablet works 70% of the time. The other 30% of the time it freezes and I have to kill the app. When the datasnap load is done the loader form is supposed to be freed and closed and the main panels opacity is set to 1 and I enable the panel again. I'm not sure 100% if the app freezes and if the code is not run successfully thats supposed to enable the panel again. I was able to debug it one time while not working which produced an out of memory error, but I'm unable to recreate the issue while debugging on the phone.
The idea was that when the logging button is pressed a loader screen shows some animation while the data is retrieved and then hides it again. Am I doing something wrong in the below code?
ShowLoader;
fThread := TTask.Create
(
procedure ()
begin
try
LoDataset := fmxDataModule.ServerMethods.GetLoginDetails(edtEmail.Text, edtPassword.Text);
except on E:Exception do
begin
TThread.Synchronize(TThread.CurrentThread,
procedure()
begin
ShowMessage('The system could not log you in. Error Details: '+slinebreak+slinebreak+E.Message+slinebreak+slinebreak+'Please try again.');
HideLoader;
end
)
end;
end;
TThread.Synchronize(TThread.CurrentThread,
procedure()
begin
fmxDataModule.LoggedInUser.LoadFromDataset(LoDataset);
if fmxDataModule.LoggedInUser.CompanyID.Value > 0 then
begin
Toolbarheader.Visible := True;
lblLoginInfo.Visible := false;
lblWelcome.Text := 'Welcome ' + fmxDataModule.LoggedInUser.FirstName.Value + ', ' + fmxDataModule.LoggedInUser.LastName.Value;
GoToProfilesTab.Execute;
GenerateProfiles;
pnlButtons.Visible := True;
fLoggedIn := True;
FormResize(nil);
end else
begin
lblLoginInfo.Visible := True;
lblLoginInfo.Text := 'User does not exist, or login details invalid';
end;
end
);
HideLoader;
end
);
fThread.Start;
Here is the code for ShowLoader:
procedure TfrmLogin.CreateLoaderForm;
begin
if Assigned(fLoader) then
FreeAndNil(fLoader);
fLoader := TfrmLoader.Create(Self);
floader.Parent := Self;
fLoader.Left := Self.Left + (Self.Width div 2) - (fLoader.Width div 2);
fLoader.Top := Self.Top + (Self.Height div 2) - (fLoader.Height div 2);
fLoader.Show;
end;
procedure TfrmLogin.ShowLoader;
begin
pnlMain.Enabled := false;
pnlMain.Opacity := 0.4;
TTask.Create (
procedure ()
begin
TThread.Queue(TThread.CurrentThread,
procedure()
begin
CreateLoaderForm
end);
end
).Start;
end;
Hiding the loader:
procedure TfrmLogin.HideLoader;
begin
pnlMain.Enabled := True;
pnlMain.Opacity := 1;
// pnlMain.Repaint;
fLoader.Visible := False;
end;
Am I missing something in the code above?
Another question is why does my form not open in the middle of the screen? I've tried different things, setting the position in the form properties, and manually calculating it. It always opens up top left corner on the device, but works on windows.
After trying a different approach like #nolaspeaker suggested, and syncronising the username and passwords fields like #RemyLebeau suggested, I removed the form loader that was in a different thread, and the problem still persisted. Doing that became obvious that there must be a problem in the below piece of code I posted initially, only a bit refactored:
TThread.CreateAnonymousThread
(
procedure
var
LsUsername,LsPassword:String;
begin
try
TThread.Synchronize(TThread.CurrentThread,
procedure()
begin
LsUsername := edtEmail.Text;
LsPassword := edtPassword.Text;
end
);
LoDataset := fmxDataModule.ServerMethods.GetLoginDetails(LsUsername, LsPassword);
except on E:Exception do
begin
TThread.Synchronize(TThread.CurrentThread,
procedure()
begin
ShowMessage('The system could not log you in. Error Details: '+slinebreak+slinebreak+E.Message+slinebreak+slinebreak+'Please try again.');
HideLoader;
end
)
end;
end;
TThread.Synchronize(TThread.CurrentThread,
procedure()
begin
fmxDataModule.LoggedInUser.LoadFromDataset(LoDataset);
if fmxDataModule.LoggedInUser.CompanyID.Value > 0 then
GoToProfilesTab.Execute
else
begin
lblLoginInfo.Visible := True;
lblLoginInfo.Text := 'User does not exist, or login details invalid';
end;
end
);
HideLoader;
end
).Start;
Trying a couple more times to debug the scenario I ended up in TTabControl.SetActiveTabWithTransition.
The issue occurs on this line
LocalAnimateIntWait(Layout2, 'Position.X', Round(P.X), Duration, TAnimationType.In,
TInterpolationType.Linear);
in this block of code:
procedure TTabControl.SetActiveTabWithTransition(const ATab: TTabItem; ATransition: TTabTransition;
const ADirection: TTabTransitionDirection = TTabTransitionDirection.Normal);
...
begin
case ATransition of
TTabTransition.Slide:
begin
FTransitionRunning := True;
ClipChildren := True;
try
...
if ADirection = TTabTransitionDirection.Normal then
begin
P...
end
else
begin
...
LocalAnimateIntWait(Layout2, 'Position.X', Round(P.X), Duration, TAnimationType.In,
TInterpolationType.Linear);
end;
finally
SetLength(FTransitionTabs, 0);
ClipChildren := False;
FTransitionRunning := False;
Realign;
end;
// Force repaint
Application.ProcessMessages;
end
else
ActiveTab := ATab;
end;
end;
So I remove the tab transitioning for that one click and it finally works as expected. The moment I put the transitioning back to Slide, it freezes again on that line. I'll be sure to report this issue.
I have Inno Setup code to show error message when installing a setup developed using Inno Setup. The error message will shown when date of expire happens.
The code is as follows:
const MY_EXPIRY_DATE_STR = '20171112'; // Date format: yyyymmdd
function InitializeSetup(): Boolean;
begin
// If current date exceeds MY_EXPIRY_DATE_STR then return false and
// exit Installer.
Result :=
CompareStr(GetDateTimeString('yyyymmdd', #0,#0), MY_EXPIRY_DATE_STR) <= 0;
if not Result then
MsgBox('Due to some problem', mbError, MB_OK);
end;
Now my question is that I want verify the date using internet, not by local system date.
Use some online service to retrieve the time (or build your own service).
See Free Rest API to retrieve current datetime as string (timezone irrelevant).
Make sure, you use HTTPS, so that it not easy to bypass the check.
The following example uses TimeZoneDB service.
You have to set your own API key (that you get after a free registration).
const
TimezoneDbApiKey = 'XXXXXXXXXXXX';
function GetOnlineTime: string;
var
Url: string;
XMLDocument: Variant;
XMLNodeList: Variant;
WinHttpReq: Variant;
S: string;
P: Integer;
begin
try
// Retrieve XML from with current time in London
// See https://timezonedb.com/references/get-time-zone
WinHttpReq := CreateOleObject('WinHttp.WinHttpRequest.5.1');
Url :=
'https://api.timezonedb.com/v2/get-time-zone?key=' + TimezoneDbApiKey +
'&format=xml&by=zone&zone=Europe/London';
WinHttpReq.Open('GET', Url, False);
WinHttpReq.Send('');
if WinHttpReq.Status <> 200 then
begin
Log('HTTP Error: ' + IntToStr(WinHttpReq.Status) + ' ' +
WinHttpReq.StatusText);
end
else
begin
Log('HTTP Response: ' + WinHttpReq.ResponseText);
// Parse the XML
XMLDocument := CreateOleObject('Msxml2.DOMDocument.6.0');
XMLDocument.async := False;
XMLDocument.loadXML(WinHttpReq.ResponseText);
if XMLDocument.parseError.errorCode <> 0 then
begin
Log('The XML file could not be parsed. ' + XMLDocument.parseError.reason);
end
else
begin
XMLDocument.setProperty('SelectionLanguage', 'XPath');
XMLNodeList := XMLDocument.selectNodes('/result/formatted');
if XMLNodeList.length > 0 then
begin
S := Trim(XMLNodeList.item[0].text);
// Remove the time portion
P := Pos(' ', S);
if P > 0 then
begin
S := Copy(S, 1, P - 1);
// Remove the dashes to get format yyyymmdd
StringChange(S, '-', '');
if Length(S) <> 8 then
begin
Log('Unexpected date format: ' + S);
end
else
begin
Result := S;
end;
end;
end;
end;
end;
except
Log('Error: ' + GetExceptionMessage);
end;
if Result = '' then
begin
// On any problem, fallback to local time
Result := GetDateTimeString('yyyymmdd', #0, #0);
end;
end;
I want to see the drives combobox so users can choose which drive to install on.
But when I run install I don't see the combobox at all?
Maybe someone can see what's wrong with this code? I copied it from another website but it just doesn't show the drive combobox therefore I can't select the drive to install on.
Here is my code:
var
// combo box for drives
cbDrive : TComboBox ;
// array fo string that keep the drive letters
DrvLetters: array of String;
function GetDriveType( lpDisk: String ): Integer;
external 'GetDriveTypeA#kernel32.dll stdcall';
function GetLogicalDriveStrings( nLenDrives: LongInt; lpDrives: String ): Integer;
external 'GetLogicalDriveStringsA#kernel32.dll stdcall';
const
DRIVE_UNKNOWN = 0; // The drive type cannot be determined.
DRIVE_NO_ROOT_DIR = 1; // The root path is invalid. For example, no volume is mounted at the path.
DRIVE_REMOVABLE = 2; // The disk can be removed from the drive.
DRIVE_FIXED = 3; // The disk cannot be removed from the drive.
DRIVE_REMOTE = 4; // The drive is a remote (network) drive.
DRIVE_CDROM = 5; // The drive is a CD-ROM drive.
DRIVE_RAMDISK = 6; // The drive is a RAM disk.
// function to convert disk type to string
function DriveTypeString( dtype: Integer ): String ;
begin
case dtype of
DRIVE_NO_ROOT_DIR : Result := 'Root path invalid';
DRIVE_REMOVABLE : Result := 'Removable';
DRIVE_FIXED : Result := 'Fixed';
DRIVE_REMOTE : Result := 'Network';
DRIVE_CDROM : Result := 'CD-ROM';
DRIVE_RAMDISK : Result := 'Ram disk';
else
Result := 'Unknown';
end;
end;
// change folder accordigly to the drive letter selected
procedure cbDriveOnClick(Sender: TObject);
begin
WizardForm.DirEdit.Text := DrvLetters[ cbDrive.ItemIndex ] + UpperCase(ExpandConstant('{#MyAppName}'));
end;
procedure FillCombo();
var
n: Integer;
drivesletters: String; lenletters: Integer;
drive: String;
disktype, posnull: Integer;
sd: String;
begin
//get the system drive
sd := UpperCase(ExpandConstant('{sd}'));
//get all drives letters of system
drivesletters := StringOfChar( ' ', 64 );
lenletters := GetLogicalDriveStrings( 63, drivesletters );
SetLength( drivesletters , lenletters );
drive := '';
n := 0;
while ( (Length(drivesletters) > 0) ) do
begin
posnull := Pos( #0, drivesletters );
if posnull > 0 then
begin
drive:= UpperCase( Copy( drivesletters, 1, posnull - 1 ) );
// get number type of disk
disktype := GetDriveType( drive );
// add it only if it is not a floppy
if ( not ( disktype = DRIVE_REMOVABLE ) ) then
begin
cbDrive.Items.Add( drive + ' [' + DriveTypeString( disktype ) + ']' )
SetArrayLength(DrvLetters, N+1);
DrvLetters[n] := drive;
// default select C: Drive
//if ( Copy(drive,1,2) = 'C:' ) then cbDrive.ItemIndex := n;
// or default to system drive
if ( Copy(drive,1,2) = sd ) then cbDrive.ItemIndex := n;
n := n + 1;
end
drivesletters := Copy( drivesletters, posnull+1, Length(drivesletters));
end
end;
cbDriveOnClick( cbDrive );
end;
procedure InitializeWizard();
begin
// create the combo box for drives
cbDrive:= TComboBox.Create(WizardForm.SelectDirPage);
with cbDrive do
begin
Parent := WizardForm.DirEdit.Parent;
Left := WizardForm.DirEdit.Left;
Top := WizardForm.DirEdit.Top + WizardForm.DirEdit.Height * 2;
Width := WizardForm.DirEdit.Width;
Style := csDropDownList;
end;
// hide the Browse button
WizardForm.DirBrowseButton.Visible := true;
// Edit box for folder don't have to be editable
WizardForm.DirEdit.Enabled := true;
// fill combo box with Drives
FillCombo;
// set the event on combo change
cbDrive.OnClick := #cbDriveOnClick ;
end;
procedure MyAfterInstall2(FileName: String);
begin
MsgBox('Just installed ' + FileName + ' as ' + CurrentFileName + '.', mbInformation, MB_OK);
end;
Works for me. At least in Unicode version of Inno Setup, once I make the code compatible with the Unicode version by:
Adding missing ; after end before drivesletters := Copy( drivesletters, posnull+1, Length(drivesletters));
Using Unicode version of GetDriveType and GetLogicalDriveStrings by replacing A# with W#.
procedure TForm1.bFAT1Click(sender: TObject);
var
FAT: Integer;
begin
for FAT := 0 to memo1.lines.Count - 1 do
begin
if AnsiContainsStr(memo1.lines[FAT], 'Olive Oil') then
begin
ShowMessage('Olive Oil exist!');
end;
end;
// But how to show message if integer is empty?
end;
I want to do something if no line contains 'Olive Oil'. How to do it?
What you need is an Exit statement to leave the procedure as soon as you found a matching element. That way, when you reach the end of the procedure, you know that you have not found a matching element:
for FAT := 0 to memo1.lines.Count - 1 do
begin
if AnsiContainsStr(memo1.lines[FAT], 'Olive Oil') then
begin
ShowMessage('Olive Oil exist!')
Exit; // we can stop here since we found it
end;
end;
// we only come here if no line contained 'Olive Oil' (because of the EXIT)
ShowMessage('Olive Oil does not exist!');
Edit: (inspired by #David) It is good practice to separate your logic from the UI / display (for example ShowMessage). To do that you can define a function like this:
function IndexOfLineContaining(const Text : String; Lines : TStrings) : Integer;
begin
for Result := 0 to Lines.Count - 1 do
if AnsiContainsStr(Lines[Result], Text) then
Exit;
Result := -1;
end;
On top of that you could easily define a boolean function:
function HasLineContaining(const Text : String; Lines : TStrings) : Boolean;
begin
Result := (IndexOfLineContaining(Text, Lines) > -1);
end;
and use that to do your message display:
if HasLineContaining('Olive Oil', Memo1.Lines) then
ShowMessage ('foo')
else
ShowMessage ('bar');
I suggest that you work a bit on your terminology to make your questions clearer. An integer cannot be empty and the sentence " do something if [FAT] do not found 'Olive Oil'." with FAT being an integer does not make any sense.