Category: Firemonkey

How to set text alignment for a specific column in firemonkey TGrid/TStringGrid?

In firemonkey (RAD Studio 10.3), I am working with a TStringGrid connected to a database and I want to change the text alignment of a specific column. How can I do that? Changing HorzAlign in TextSettings property, changes the alignment of all columns. I tried the suggested solution in this page and did not work! In newer versions of Firemonkey the below solution code results in an error. type TSpecificColumn = class(TColumn) protected function CreateCellControl: TStyledControl;override; end; There is no CreateCellControl function in TColumn Class anymore to be Overrided! This is the error I got: Method CreateCellControl not found in base class.
Read More

Hide Android softkeys (triangle, circle, rectangle shape) when it appears automatically in Delphi FMX

I set my form on MyApp as a FullScreen. So it means the form will cover all area of Android screen including softkey (In currently android phone) and Info Bar (Battery, simcard, signal info etc). Unfortunately, MyApp uses some default dialog bog comes with fmx (TDialogService.MessageDialog) and it will trigger device to show softkey, and it wont hide automatically when dialog box closed. I tried to hide virtual keyboard by adding new procedure like this : procedure TForm1.HideSoftKeyAndVKeyboard; var FService: IFMXVirtualKeyboardService; begin TPlatformServices.Current.SupportsPlatformService (IFMXVirtualKeyboardService, IInterface(FService)); FService.HideVirtualKeyboard; end; But the softkey, is still there. Do you have any solution for this problem? Thank you so much.
Read More

Segmentation fault with TidHttp in a Android Service

I created a Android local service in delphi that triggers a thread that creates a Tidhhp, if I stop the service through the command JavaService.stopSelf and start the service again without closing the app, a "Segmentation fault(11)" error occurs when the tidhttp component executes a "get". if I close and reopen the app this error does not occur. My code: LThread := TThread.CreateAnonymousThread( procedure var pagina: string; pegar: tidhttp; seguro: TIdSSLIOHandlerSocketOpenSSL; compressor: TIdCompressorZLib; begin try pegar := tidhttp.create(nil); compressor := TIdCompressorZLib.create(nil); seguro := TIdSSLIOHandlerSocketOpenSSL.create(nil); pegar.Request.useragent := 'Mozilla/5.0 (Linux; Android 7.0; PLUS Build/NRD90M) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/75.0.3770.100 Mobile Safari/537.36'; pegar.ReadTimeout := 60000; pegar.ConnectTimeout := 60000; pegar.HTTPOptions := [hoForceEncodeParams]; pegar.IOHandler := seguro; pegar.compressor := compressor; pegar.HandleRedirects := false; pegar.Request.Accept := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8'; pegar.Request.AcceptLanguage := 'pt-BR,en-US;q=0.8,pt;q=0.5,en;q=0.3'; pegar.Request.ContentType := 'application/json'; pegar.Request.Connection := 'keep-alive'; pegar.Request.ContentType := ''; pagina := pegar.Get ('https://meyserver.com/api/versions/count'); finally compressor.Free; seguro.Free; pegar.Free; end; end); LThread.FreeOnTerminate := true; LThread.Start; end; The delhi debug shows that the error occurs in the "System.Generics.Collections" unit in the function: function TThreadList <T> .LockList: TList <T>; begin    TMonitor.Enter (FLock);    Result: = FList; end; Some idea? Update: The command I use to start the service from host app is: procedure Tfrm_principal.Button13Click(Sender: TObject); var LIntent: JIntent; begin LIntent := TJIntent.create; LIntent.setClassName(TAndroidHelper.Activity.getBaseContext, TAndroidHelper.StringToJString('com.embarcadero.services.MyTeste')); LIntent.setAction(StringToJString('IniciaIntent')); TAndroidHelper.Activity.startService(LIntent); end; Update 2: My code in host app: procedure Tfrm_principal.Button13Click(Sender: TObject); var LIntent: JIntent; begin LIntent := TJIntent.create; LIntent.setClassName(TAndroidHelper.Activity.getBaseContext, TAndroidHelper.StringToJString('com.embarcadero.services.MyAppTest')); LIntent.setAction(StringToJString('StartIntent')); TAndroidHelper.Activity.startService(LIntent); end; procedure Tfrm_principal.Button16Click(Sender: TObject); var LIntent: JIntent; begin LIntent := TJIntent.create; LIntent.setClassName(TAndroidHelper.Activity.getBaseContext, TAndroidHelper.StringToJString('com.embarcadero.services.MyAppTest')); LIntent.setAction(StringToJString('StopIntent')); TAndroidHelper.Activity.startService(LIntent); end; My code in service app: function TDM.AndroidServiceStartCommand(const Sender: TObject; const Intent: JIntent; Flags, StartId: Integer): Integer; begin if Assigned(Intent) then begin if Intent.getAction.equalsIgnoreCase(StringToJString('StopIntent')) = true then begin Result := TJService.JavaClass.START_NOT_STICKY; JavaService.stopSelf; end else if Intent.getAction.equalsIgnoreCase(StringToJString('StartIntent')) = true then begin Result := TJService.JavaClass.START_STICKY; start_thread; end; end; end; procedure TDM.start_thread; begin TThread.CreateAnonymousThread( procedure var pagina: string; pegar: tidhttp; seguro: TIdSSLIOHandlerSocketOpenSSL; compressor: TIdCompressorZLib; begin pegar := tidhttp.create(nil); compressor := TIdCompressorZLib.create(nil); seguro := TIdSSLIOHandlerSocketOpenSSL.create(nil); try pegar.Request.useragent := 'Mozilla/5.0 (Linux; Android 7.0; PLUS Build/NRD90M) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/75.0.3770.100 Mobile Safari/537.36'; pegar.ReadTimeout := 60000; pegar.ConnectTimeout := 60000; pegar.HTTPOptions := [hoForceEncodeParams]; pegar.IOHandler := seguro; pegar.compressor := compressor; pegar.HandleRedirects := false; pegar.Request.Accept := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8'; pegar.Request.AcceptLanguage := 'pt-BR,en-US;q=0.8,pt;q=0.5,en;q=0.3'; pegar.Request.ContentType := 'application/json'; pegar.Request.Connection := 'keep-alive'; try pagina := pegar.Get('https://myserver.com/api/versions/count'); except enviar_log('Connection error'); end; finally compressor.Free; seguro.Free; pegar.Free; end; enviar_log('Exit'); end).Start; end;
Read More

FNC Code Gems: Helpers for Base64 encoding and decoding

In the last post, I looked at methods to help you get information about connected displays and determine the path name for common folders. Let’s look at something very valuable when you want to convert binary data into a string: Base64 encoding.This is somewhat tricky if you have to consider all the different platforms and frameworks. FNC makes it very easy!

Again, the class TTMSFNCUtils offers awesome methods to get results quickly:

class function FileToBase64(const AFile: TTMSFNCUtilsFile): string;
   
class function Decode64(const AValue: string; 
                        const AURL: Boolean = False): string;
class function Encode64(const AValue: string; 
                        const AURL: Boolean = False): string; overload;
class function Encode64(const AValue: TBytes; 
                        const AURL: Boolean = False): string; overload;  

Not only are there methods to encode and decode strings, there is also FileToBase64 which allows you to retrieve the Base64 string for a file using a single line of code:

LBase64String := TTMSFNCUtils.FileToBase64( 'mydata.bin' );

Ignore the data type of AFile to specify the filename. In VCL and FMX the type TTMSFNCUtilsFile it is mapped to a string. However, for web applications you cannot specify a local file name and the method has to be invoked differently. There is no inverse function for this as it is already a one-liner in Delphi now to store a string or a byte array into a file using TFile from System.IOUtils.

In order to encode a string, call Encode64; call Decode64 to decode a string:

LMyBase64String := TTMSFNCUtils.Encode64( 'testtest', false );
LMyTestString   := TTMSFNCUtils.Decode64( LMyBase64String, false );

Remember, these methods are available for VCL, FMX, LCL, and TMS Web Core.

Read More

Read More

Error OSStatus -67028 when I run applications for MACOS in Delphi

Delphi 10.3.1, firemonkey, MacOS 32bit I get a message OSStatus error - 67028 on one of MAC when running a new version of my application. (The old version of the application works correctly). On three other MAC, everything is OK. For testing, I made a simple app (form + label) and this application ran without problems on a problematic MAC. Is anyone able to help me solve the problem ?
Read More

firemonkey android crc16 result mismatch with delphi for windows

in two different project i need to use crc16 checksum.one in windows and other in android.i used a code for windows and it worked prefect. showmessage( bin2crc16(HexToBin('1234')) ); //---> 0EC9 here is used function for winsows function Pow(i, k: Integer): Integer; var j, Count: Integer; begin if k>0 then j:=2 else j:=1; for Count:=1 to k-1 do j:=j*2; Result:=j; end; function BinToDec(Str: string): Integer; var Len, Res, i: Integer; Error: Boolean; begin Error:=False; Len:=Length(Str); Res:=0; for i:=1 to Len do if (Str[i]='0')or(Str[i]='1') then Res:=Res+Pow(2, Len-i)*StrToInt(Str[i]) else begin //MessageDlg('It is not a binary number', mtInformation, [mbOK], 0); Error:=True; Break; end; if Error=True then Result:=0 else Result:=Res; end; //------------------------------------------------------------------------------ function CRC16CCITT(bytes: array of Byte): Word; const polynomial = $1021; var crc: Word; I, J: Integer; b: Byte; bit, c15: Boolean; begin crc := $FFFF; for I := 0 to High(bytes) do begin b := bytes[I]; for J := 0 to 7 do begin bit := (((b shr (7-J)) and 1) = 1); c15 := (((crc shr 15) and 1) = 1); crc := crc shl 1; if ((c15 xor bit) <> false) then crc := crc xor polynomial; end; end; Result := crc and $ffff; end; //------------------------------------------------------------------------------ function HexToDec(const Str: string): Integer; begin if (Str <> '') and ((Str[1] = '-') or (Str[1] = '+')) then Result := StrToInt(Str[1] + '$' + Copy(Str, 2, MaxInt)) else Result := StrToInt('$' + Str); end; //------------------------------------------------------------------------------ function bin2crc16(str: string): string; var I:integer; lengthCount : integer; crcByteArr : array of Byte; crcOut : Word; begin lengthCount := Trunc(length(str)/8); setlength(crcByteArr , lengthCount ); for I := 0 to lengthCount-1 do begin crcByteArr[I] := BinToDec(copy(str, I*8+1, 8)); end; crcOut := CRC16CCITT(crcByteArr); result := crcOut.ToHexString; end; //------------------------------------------------------------------------------ function HexToBin(Hexadecimal: string): string; const BCD: array [0..15] of string = ('0000', '0001', '0010', '0011', '0100', '0101', '0110', '0111', '1000', '1001', '1010', '1011', '1100', '1101', '1110', '1111'); var i: integer; begin Result := ''; for i := Length(Hexadecimal) downto 1 do Result := BCD[StrToInt('$' + Hexadecimal[i])] + Result; end; but for android i changed the code to handle zero index string. the result is different memo2.Lines.Add( bin2crc16(HexToBin('1234')) ); //-----> 1AFa here is used functions in android function BinToDec(Str: string): Integer; var Len, Res, i: Integer; Error: Boolean; begin Error:=False; Len:=Length(Str); Res:=0; for i:=0 to Len-1 do if (Str[i]='0')or(Str[i]='1') then Res:=Res+Pow(2, Len-i)*StrToInt(Str[i]) else begin Error:=True; Break; end; if Error=True then Result:=0 else Result:=Res; end; //------------------------------------------------------------------------------ function CRC16CCITT(bytes: array of Byte): Word; const polynomial = $1021; var crc: Word; I, J: Integer; b: Byte; bit, c15: Boolean; begin crc := $FFFF; for I := 0 to High(bytes) do begin b := bytes[I]; for J := 0 to 7 do begin bit := (((b shr (7-J)) and 1) = 1); c15 := (((crc shr 15) and 1) = 1); crc := crc shl 1; if ((c15 xor bit) <> false) then crc := crc xor polynomial; end; end; Result := crc and $ffff; end; //------------------------------------------------------------------------------ function bin2crc16(str: string): string; var I:integer; lengthCount : integer; crcByteArr : array of Byte; crcOut : Word; begin lengthCount := Trunc(length(str)/8); setlength(crcByteArr , lengthCount ); for I := 0 to lengthCount-1 do begin crcByteArr[I] := BinToDec(copy(str, I*8, 8)); end; crcOut := CRC16CCITT(crcByteArr); result := crcOut.ToHexString; end; //----------------------------------------------------------------------------------- function HexToBin(Hexadecimal: string): string; const BCD: array [0..15] of string = ('0000', '0001', '0010', '0011', '0100', '0101', '0110', '0111', '1000', '1001', '1010', '1011', '1100', '1101', '1110', '1111'); var i: integer; begin Result := ''; for i := Length(Hexadecimal)-1 downto 0 do Result := BCD[StrToInt('$' + Hexadecimal[i])] + Result; end; //--------------------------------------------------------------------------------- function Pow(i, k: Integer): Integer; var j, Count: Integer; begin if k>0 then j:=2 else j:=1; for Count:=1 to k-1 do j:=j*2; Result:=j; end; how can i fix my problem !?
Read More

How to format TEdit with car plate (Delphi)

I would like to know how to only allow one Format in TEdit (XXX-0000) ... I searched all day on the Internet and only found very old tutorials for Delphi where EditMask existed, but now (at least in Delphi Tokyo) there is no more EditMask. I tried to write code to format the TEdit, but it did not work. Can anybody help me? I'm developing for Android (using Delphi Tokyo).
Read More

Segmentation fault in THTTPClient

I'm having a strange problem with the THTTPClient component on android. when I put a THTTPClient component in a data module and execute my code everything works perfectly, but if I create the component at runtime a segmentation fault (11) error occurs when I close the application. I am using thread to access my server. This error only occurs when I close the app. I am using Rad Studio 10.3.1. LThread := TThread.CreateAnonymousThread( procedure var pegar: THTTPClient; ts : TStringlist; liberado:string; begin try pegar := THTTPClient.create; ts := TStringlist.create; pegar.Accept := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8'; pegar.AcceptLanguage := 'pt-BR,en-US;q=0.8,pt;q=0.5,en;q=0.3'; pegar.ContentType := 'application/x-www-form-urlencoded'; ts.Add('email=' + username); ts.Add('password=' + senha); liberado := pegar.Post(caminho_api + 'authentication/login', ts).ContentAsString(TEncoding.UTF8); finally ts.free; pegar.free; end; end); LThread.FreeOnTerminate := true; LThread.OnTerminate:=terminate_autenticacao; LThread.Start; But if I put the component in a DataModule and do that other way, this error does not occur: LThread := TThread.CreateAnonymousThread( procedure var ts : TStringlist; liberado:string; begin try ts := TStringlist.create; datamodule.pegar.Accept := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8'; datamodule.pegar.AcceptLanguage := 'pt-BR,en-US;q=0.8,pt;q=0.5,en;q=0.3'; datamodule.pegar.ContentType := 'application/x-www-form-urlencoded'; ts.Add('email=' + username); ts.Add('password=' + senha); liberado := datamodule.pegar.Post(caminho_api + 'authentication/login', ts).ContentAsString(TEncoding.UTF8); finally ts.free; end; end); LThread.FreeOnTerminate := true; LThread.OnTerminate:=terminate_autenticacao; LThread.Start;
Read More

How to get keypress event in listview searchbox

in a mobile application, I have a ListView with searchbox, I would like it when the user types a barcode and presses Enter in the searchbox, the system does a specific search. I don't know how to capture the keypress in the searchbox, can anyone help me please? In the search box the user can search for the description that already works, and can capture through a bar code scanner, so it is necessary to search by code only after the Enter is pressed.
Read More

how to safely access and modify an Array while multithreading in delphi fmx multi device platform?

i'm trying to manipulate a variable array of the record type, by multiple threads, and i'm not sure what i did is the right way or if there is a better safer method? what i did is i declared a boolean variable as a lock, and when some thread want's access to the Array it waits till the lock is off then activate the lock, and when done unlock it and let others have access. the code for this is decalred in the implementation section ... implementation var Data : array of TData; var Data_Lock:Boolean=false; procedure Lock_Data(); begin while Data_Lock = True do sleep(1); Data_Lock := True; end; procedure UnLock_Data(); begin Data_Lock := False; end; procedure ClearAll(); begin Lock_Data(); SetLength( Data, 0 ); UnLock_Data(); end; .... the entire project is still not complete, for now this seems to work but i don't have any knowledge of how this things work at the core, and if two threads start at the exact same time wouldn't there be a problem?
Read More

How can i improve and optimize my customized image class

I have a Manga Viewer which usually has to load a large number of images in a very short time, the dimension for these images are mostly higher than 8096px (mostly only the height is higher than 8096px) which is why i had to load them in a TBitmapSurface and then split it into several TBitmap and finally assign these TBitmaps to several TImages. The problem i currently have is that the loading time for these images is fairly high which is why i am looking to optimize my image class, and my codes and find out if i am doing something wrong, any tips and help is much appreciated. Here are some statics you might wanna know While loading Number of images : 24 Size Images ~ 2048 * 8765 Size (KB) per image ~ 700KB GPU: GTX 980 HardDrive: SSD 250 Samsung CPU: 990X I get a timing of 1- 1.3 second for loading the bitmaps 2- 2.3 second for assigning the bitmaps to TImage 3- 4 ms for sorting and rearranging the TImages. Here is the code for my Image class called TATDLargeImage unit ATDLargeImage; interface uses FMX.Graphics, FMX.Surfaces, FMX.Objects, FMX.Types, System.UITypes, System.Classes, System.Generics.Collections; type TLargeImageMouseUpCallBack = procedure(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single) of object; type TLargeImageKeyUpCallBack = procedure(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState) of object; type TATDLargeImage = class(TObject) private mImageList: Tlist<TImage>; mBitmapSurface, mEmptyBitmapSurface: TBitmapSurface; mX, mY: Single; mParent: TFmxObject; mOnCustomMouseUp: TLargeImageMouseUpCallBack; mOnCustomKeyUp: TLargeImageKeyUpCallBack; mTagString: String; mWidth, mHeight: Single; mTag: Integer; mVisible: boolean; mOpacity: Single; mScale: Single; mMaxWidth: Single; procedure drawBitmapSurfaceOnImages(); procedure legacy_drawBitmapSurfaceOnImages(); procedure reArrangeImages(); procedure setX(value: Single); function getX(): Single; procedure setY(value: Single); function getY(): Single; procedure onMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single); procedure onKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState); procedure setVisible(state: boolean); function getVisible(): boolean; procedure setOpacity(value: single); function getOpacity(): Single; procedure setScale(value: single); function getWidth(): Single; function getHeight(): Single; procedure resizeBitmap(var source: TBitmap; newWidth, newHeight: Single); procedure createImage(); { private declarations } protected { protected declarations } public { public declarations } constructor create(parent: TFmxObject); destructor destroy(); procedure loadFromFile(const AFileName: string); procedure BeginUpdate(); procedure EndUpdate(); procedure EmptyBitmaps; function isEmpty(): boolean; //draws the TBitmap on The TImage, make sure this happens in the UI Thread procedure draw(); procedure resizeByScale(scale: single); property X: Single read getX write setX; property Y: Single read getY write setY; property onCustomMouseUp: TLargeImageMouseUpCallBack read mOnCustomMouseUp write mOnCustomMouseUp; property onCustomKeyUp: TLargeImageKeyUpCallBack read mOnCustomKeyUp write mOnCustomKeyUp; property TagString: String read mTagString write mTagString; property Width: Single read getWidth write mWidth; property Height: Single read getHeight write mHeight; property Tag: integer read mTag write mTag; property Visible: Boolean read getVisible write setVisible; property Opacity: Single read getOpacity write setOpacity; property Scale: Single read mScale write setScale; property MaxWidth: Single read mMaxWidth write mMaxWidth; published { published declarations } end; implementation uses system.types; constructor TATDLargeImage.create(parent: TFmxObject); var I: Integer; maxImageCount: integer; begin mParent := parent; mWidth := 0; mHeight := 0; mTag := 0; mOpacity := 0; mX := 0; mY := 0; mScale := 1; mVisible := true; mMaxWidth := -1; mBitmapSurface := TBitmapSurface.Create; mEmptyBitmapSurface := TBitmapSurface.Create; mImageList := TList<TImage>.create; maxImageCount := 1; for I := 0 to maxImageCount - 1 do begin createImage; end; end; destructor TATDLargeImage.destroy; var I: Integer; begin mBitmapSurface.Free; for I := 0 to mImageList.Count - 1 do begin mImageList[I].Free; end; end; procedure TATDLargeImage.createImage; var image: TImage; begin image := TImage.Create(nil); image.Parent := mParent; image.Width := 0; image.Height := 0; image.OnMouseUp := onMouseUp; image.OnKeyUp := onKeyUp; mImageList.add(image); end; procedure TATDLargeImage.loadFromFile(const AFileName: string); begin TBitmapCodecManager.LoadFromFile(AFileName, mBitmapSurface); mWidth := mBitmapSurface.Width; mHeight := mBitmapSurface.Height; end; procedure TATDLargeImage.draw; begin drawBitmapSurfaceOnImages; reArrangeImages(); end; procedure TATDLargeImage.drawBitmapSurfaceOnImages; var src, dest: TBitmapSurface; partitionCount: integer; w, h, hSum : integer; destIndexCounter: integer; I, scan: Integer; mapSize_H: integer; begin for I := 1 to mImageList.Count - 1 do begin mImageList[I].Bitmap.Assign(mEmptyBitmapSurface); end; mapSize_H := 8096; src := mBitmapSurface; try partitionCount := (src.Height div mapSize_H) + 1; if (partitionCount = 1) then mImageList[0].Bitmap.assign(src) else begin dest := TBitmapSurface.Create; hSum := 0; while (mImageList.Count < partitionCount) do createImage; for I := 0 to partitionCount - 1 do begin w := src.Width; if (I = partitionCount - 1) then h := src.Height - hSum else h := mapSize_H; dest.SetSize(w, h, TPixelFormat.RGBA); destIndexCounter := 0; for scan := hSum to h + hSum - 1 do begin //src.width * 4 means that make space for width * 4 (RGBA?) bytes Move(src.Scanline[scan]^, TBitmapSurface(dest).Scanline[destIndexCounter]^, src.Width * 4); inc(destIndexCounter); end; mImageList[I].Bitmap.Assign(dest); hSum := hSum + h; end; end; except partitionCount := 0; end; end; procedure TATDLargeImage.reArrangeImages; var I: Integer; image: TImage; offset: Single; begin offset := 0; for I := 0 to mImageList.count - 1 do begin image := mImageList[I]; image.width := image.bitmap.width * mScale; if (mMaxWidth <> -1) then begin if (image.Width > mMaxWidth) then begin image.Width := mMaxWidth; mWidth := mMaxWidth; end; end; image.height := image.bitmap.height * mScale; image.Position.X := mX; image.Position.Y := mY + offset; offset := offset + image.Height; end; end; procedure TATDLargeImage.setX(value: Single); begin mX := value; reArrangeImages; end; function TATDLargeImage.getX(): Single; begin Result := mX; end; procedure TATDLargeImage.setY(value: Single); begin mY := value; reArrangeImages; end; function TATDLargeImage.getY(): Single; begin Result := mY; end; procedure TATDLargeImage.onMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single); begin mOnCustomMouseUp(self, button, shift, x, y); end; procedure TATDLargeImage.onKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState); begin mOnCustomKeyUp(self, key, keyChar, shift); end; procedure TATDLargeImage.BeginUpdate; var I: Integer; begin for I := 0 to mImageList.Count - 1 do begin mImageList[I].BeginUpdate; end; end; procedure TATDLargeImage.EndUpdate; var I: Integer; begin for I := 0 to mImageList.Count - 1 do begin mImageList[I].EndUpdate; end; end; procedure TATDLargeImage.EmptyBitmaps; var I: Integer; begin mBitmapSurface.Assign(mEmptyBitmapSurface); {for I := 0 to mImageList.Count - 1 do begin mImageList[I].Bitmap := nil; end;} end; function TATDLargeImage.isEmpty(): boolean; var I: Integer; begin //Result := true; {for I := 0 to mImageList.Count - 1 do begin Result := Result and mImageList[I].Bitmap.IsEmpty; end;} if (mBitmapSurface.Width = 0) and (mBitmapSurface.Height = 0) then Result := true else Result := false; end; procedure TATDLargeImage.setVisible(state: Boolean); var I: Integer; begin mVisible := state; for I := 0 to mImageList.Count - 1 do begin mImageList[I].Visible := mVisible; end; end; function TATDLargeImage.getVisible(): boolean; begin Result := mVisible; end; procedure TATDLargeImage.setOpacity(value: Single); var I: Integer; begin mOpacity := value; for I := 0 to mImageList.Count - 1 do begin mImageList[I].Opacity := mOpacity; end; end; function TATDLargeImage.getOpacity; begin Result := mOpacity; end; procedure TATDLargeImage.resizeBitmap(var source: TBitmap; newWidth, newHeight: Single); var newBitmap: Tbitmap; src, trg: TRectF; targetWidth, targetHeight: integer; begin newBitmap:= TBitmap.Create; try newBitmap.SetSize(targetWidth, targetHeight); src := RectF(0, 0, source.Width, source.Height); trg := RectF(0, 0, targetWidth, targetHeight); newBitmap.Canvas.BeginScene; newBitmap.Canvas.DrawBitmap(source, src, trg, 1); newBitmap.Canvas.EndScene; source.SetSize(targetWidth, targetHeight); source.Assign(newBitmap); finally newBitmap.Free; end; end; procedure TATDLargeImage.setScale(value: Single); begin mScale := value; end; function TATDLargeImage.getWidth(): Single; begin Result := mWidth * mScale; end; function TATDLargeImage.getHeight(): Single; begin Result := mHeight * mScale; end; procedure TATDLargeImage.resizeByScale(scale: Single); var I: Integer; begin mBitmapSurface.SetSize(Trunc(mBitmapSurface.Width * Scale), Trunc(mBitmapSurface.Height * Scale)); mWidth := mBitmapSurface.Width; mHeight := mBitmapSurface.Height; drawBitmapSurfaceOnImages; reArrangeImages(); end; end.
Read More

Delphi suddenly says that "[Warning Warning] Local file "Android\Debug\classes.dex" not found. Skipping deployment."

This is Delphi 10 Seattle on a LG Phone. I suddenly start getting the above error, after which my program will not load on my phone.This happens for nearly all programs. The programs are all compiled okay, but when I try to deploy them I get this error: paclient command line c:\program files (x86)\embarcadero\studio\17.0\bin\paclient.exe -u8 --put="c:\program files (x86)\embarcadero\studio\17.0\bin\Artwork\Android\FM_LauncherIcon_96x96.png,.\Android\Debug\\CameraTest\res\drawable-xhdpi\,1,ic_launcher.png" paclient command line c:\program files (x86)\embarcadero\studio\17.0\bin\paclient.exe -u8 --put="C:\Program Files (x86)\Embarcadero\Studio\17.0\bin\Artwork\Android\FM_LauncherIcon_48x48.png,.\Android\Debug\\CameraTest\res\drawable-mdpi\,1,ic_launcher.png" [Warning Warning] Local file "Android\Debug\classes.dex" not found. Skipping deployment. After which the deploy is aborted. I can see there are two slashes in the name and I cannot find any reason for that. But that is also the case for the rare programs I can deploy, so apparently that is not the cause of the problem. This works: unit Unit8; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, System.IOUtils, FMX.StdCtrls, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo; type TForm8 = class(TForm) private { Private declarations } public { Public declarations } end; var Form8: TForm8; implementation {$R *.fmx} end. This does not: unit Main; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics; type TFormMain = class(TForm) private public end; var FormMain: TFormMain; implementation end. The code that fails, started out as bigger program, and when it failed I started cutting pieces off expecting it would eventually start functioning and I would be able to localize the problem. But that did not happen. I tried clearing it before compiling, but I still cannot deploy. I assume some files must be the cause of the problem, so I tried deleting the Android folder. And a new folder is created, but the problem still continues. Is it possible that the classes.dex file is just created at specific points in the compilation/link and so only are recreated/updated when you do the same operation? Also, that does not explain why it suddenly starts happening for almost all my programs? I am confused. Hope someone can help.
Read More