Category: StackOverflow

Control on embedded form not refreshing (Delphi, Firemonkey)

I have a very simple Firemonkey project (RadStudio 10.3.3) that I am building to test certain layout options for a future project. In the past with VCL, I used modal forms. The project I am testing uses panels (Panel1 and Panel2) on the main form (Form1) to embed two additional forms (Form2 and Form3). The two embedded forms consist of a single listbox (ListBox1) on each form. The panels on the main form overlay, so I use the Visibility property to show the embedded form that I want. All the code is on the main form. The issue I have is that when I switch between Form2 and Form3, the strings loaded into the listbox on Form3 never appear. I have tried Repaint on the listbox and panel, InvalidateRect on the listbox, SetFocus on the panel, etc., all followed by Application.ProcessMessages. Nothing works successfully. The main code is: unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.StdCtrls; type TForm1 = class(TForm) Panel1: TPanel; Button1: TButton; Panel2: TPanel; Button2: TButton; procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } procedure EmbedForm(AParent:TControl; AForm:TCustomForm); public { Public declarations } end; var Form1: TForm1; implementation {$R *.fmx} uses Unit2, Unit3; procedure TForm1.FormCreate(Sender: TObject); begin // Embed Form2 in Panel1 Application.CreateForm(TForm2, Form2); EmbedForm(Panel1, Form2); Panel1.Visible := true; // Embed Form3 in Panel2 Application.CreateForm(TForm3, Form3); EmbedForm(Panel2, Form3); Panel2.Visible := false; end; procedure TForm1.Button1Click(Sender: TObject); begin // Populate ListBox1 on Form2 - the LOAD button Form2.ListBox1.Items.Add('Hello'); Form2.ListBox1.Items.Add('World'); end; procedure TForm1.Button2Click(Sender: TObject); begin // Hide Panel1 (Form2) and show Panel2 (Form3) Panel1.Visible := false; Panel2.Visible := true; // Populate ListBox1 on Form3 Form3.ListBox1.Items.Add('Goodbye'); Form3.ListBox1.Items.Add('World'); // Repaint (Here's why I have tried various things to get the listbox strings to show up) //Panel2.Repaint; //Form3.ListBox1.Repaint; //Application.ProcessMessages; end; procedure TForm1.EmbedForm(AParent: TControl; AForm: TCustomForm); begin while AForm.ChildrenCount>0 do AForm.Children[0].Parent:=AParent; end; end. Form2 is as follows: unit Unit2; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Layouts, FMX.ListBox; type TForm2 = class(TForm) ListBox1: TListBox; private { Private declarations } public { Public declarations } end; var Form2: TForm2; implementation {$R *.fmx} end. Form3 is as follows: unit Unit3; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Layouts, FMX.ListBox, FMX.Controls.Presentation, FMX.StdCtrls; type TForm3 = class(TForm) ListBox1: TListBox; private { Private declarations } public { Public declarations } end; var Form3: TForm3; implementation {$R *.fmx} end. The .fmx files are below, as requested. Unit1.fmx (Form1): object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 480 ClientWidth = 640 FormFactor.Width = 320 FormFactor.Height = 480 FormFactor.Devices = [Desktop] OnCreate = FormCreate DesignerMasterStyle = 0 object Button1: TButton Position.X = 232.000000000000000000 Position.Y = 448.000000000000000000 TabOrder = 1 Text = 'Load' OnClick = Button1Click end object Button2: TButton Position.X = 328.000000000000000000 Position.Y = 448.000000000000000000 TabOrder = 2 Text = 'Next' OnClick = Button2Click end object Panel1: TPanel Align = Center Size.Width = 640.000000000000000000 Size.Height = 393.000000000000000000 Size.PlatformDefault = False TabOrder = 0 end object Panel2: TPanel Position.Y = 43.000000000000000000 Size.Width = 640.000000000000000000 Size.Height = 393.000000000000000000 Size.PlatformDefault = False TabOrder = 4 end end Unit2.fmx (Form2): object Form2: TForm2 Left = 0 Top = 0 Caption = 'Form2' ClientHeight = 480 ClientWidth = 640 FormFactor.Width = 320 FormFactor.Height = 480 FormFactor.Devices = [Desktop] DesignerMasterStyle = 0 object ListBox1: TListBox Align = Center TabOrder = 0 DisableFocusEffect = True DefaultItemStyles.ItemStyle = '' DefaultItemStyles.GroupHeaderStyle = '' DefaultItemStyles.GroupFooterStyle = '' Viewport.Width = 200.000000000000000000 Viewport.Height = 200.000000000000000000 end end Unit3.fmx (Form3): object Form3: TForm3 Left = 0 Top = 0 Caption = 'Form3' ClientHeight = 480 ClientWidth = 640 FormFactor.Width = 320 FormFactor.Height = 480 FormFactor.Devices = [Desktop] DesignerMasterStyle = 0 object ListBox1: TListBox Position.X = 8.000000000000000000 Position.Y = 8.000000000000000000 TabOrder = 1 DisableFocusEffect = True DefaultItemStyles.ItemStyle = '' DefaultItemStyles.GroupHeaderStyle = '' DefaultItemStyles.GroupFooterStyle = '' Viewport.Width = 196.000000000000000000 Viewport.Height = 196.000000000000000000 end end Again, Form2 and Form3 each only contain a listbox (Listbox1 on both) and no additional code. I simply run the executable, click Button1 to display Hello World, then click Button2 to switch panels and display the second form and its listbox. As I am new to Firemonkey, I am sure I am missing something simple. Thanks for any and all help! The solution was very simple. I had to remove the CreateForm events for Form2 and Form3 from the project's initialization settings--a dumb mistake on my part. It was losing the reference to those forms during execution.
Read More

can not compile my Android app in 64 bit, I receive DCC Error: cannot find lgnustl_static [closed]

When I try to compile my app in android 64 bit under Delphi Rio 10.3.3 I receive this error message [DCC Error] E2597 C:\SDKs\android-ndk-r17b\toolchains\aarch64-linux-android-4.9\prebuilt\windows\aarch64-linux-android\bin\ld.exe: cannot find -lgnustl_static When I try to compile a new blank application, it's seam to work. Look like it's not working when I try to open an existing project (that was done in a lower version of Delphi) Note: I found, it's look like it's connected to Grijjy.ErrorReporting. Now I let the question open because I would like to find a workaround
Read More

Delphi GIF Firemonkey bugged

This is Firemonkey Animated GIF library for GIF Delphi Rad Studio. Last frame of the animation glitches when it loops back to the first frame i think. GIF starts to flicker when it goes to the beginning, the first frame from the last. Tried to change everything that you can, nothing helps. Help pls. Code in project for animate GIF using GIFPlayer through Image: uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Effects, FMX.StdCtrls, FMX.Controls.Presentation, FMX.GifUtils, FMX.Objects; procedure FormCreate(Sender: TObject); private { Private declarations } FGifPlayer: TGifPlayer; public { Public declarations } end; var Form1: TForm1; implementation {$R *.fmx} procedure TForm1.FormCreate(Sender: TObject); begin FGifPlayer := TGifPlayer.Create(Self); FGifPlayer.Image := Image1; FGifPlayer.LoadFromFile('youfilename.gif'); FGifPlayer.Play; end; The library .PAS is in the project folder. Code of library: interface uses System.Classes, System.SysUtils, System.Types, System.UITypes, FMX.Types, FMX.Objects, FMX.Graphics, System.Generics.Collections; const alphaTransparent = $00; GifSignature: array [0 .. 2] of Byte = ($47, $49, $46); // GIF VerSignature87a: array [0 .. 2] of Byte = ($38, $37, $61); // 87a VerSignature89a: array [0 .. 2] of Byte = ($38, $39, $61); // 89a GIF_DISPOSAL_UNSPECIFIED = 0; GIF_DISPOSAL_LEAVE = 1; GIF_DISPOSAL_BACKGROUND = 2; GIF_DISPOSAL_PREVIOUS = 3; type TGifVer = (verUnknow, ver87a, ver89a); TInternalColor = packed record case Integer of 0: ( {$IFDEF BIGENDIAN} R, G, B, A: Byte; {$ELSE} B, G, R, A: Byte; {$ENDIF} ); 1: (Color: TAlphaColor; ); end; {$POINTERMATH ON} PInternalColor = ^TInternalColor; {$POINTERMATH OFF} TGifRGB = packed record R: Byte; G: Byte; B: Byte; end; TGIFHeader = packed record Signature: array [0 .. 2] of Byte; // * Header Signature (always "GIF") */ Version: array [0 .. 2] of Byte; // * GIF format version("87a" or "89a") */ // Logical Screen Descriptor ScreenWidth: word; // * Width of Display Screen in Pixels */ ScreenHeight: word; // * Height of Display Screen in Pixels */ Packedbit: Byte; // * Screen and Color Map Information */ BackgroundColor: Byte; // * Background Color Index */ AspectRatio: Byte; // * Pixel Aspect Ratio */ end; TGifImageDescriptor = packed record Left: word; // * X position of image on the display */ Top: word; // * Y position of image on the display */ Width: word; // * Width of the image in pixels */ Height: word; // * Height of the image in pixels */ Packedbit: Byte; // * Image and Color Table Data Information */ end; TGifGraphicsControlExtension = packed record BlockSize: Byte; // * Size of remaining fields (always 04h) */ Packedbit: Byte; // * Method of graphics disposal to use */ DelayTime: word; // * Hundredths of seconds to wait */ ColorIndex: Byte; // * Transparent Color Index */ Terminator: Byte; // * Block Terminator (always 0) */ end; TGifReader = class; TPalette = TArray<TInternalColor>; TGifFrameItem = class; TGifFrameList = TObjectList<TGifFrameItem>; { TGifReader } TGifReader = class(TObject) protected FHeader: TGIFHeader; FPalette: TPalette; FScreenWidth: Integer; FScreenHeight: Integer; FInterlace: Boolean; FBitsPerPixel: Byte; FBackgroundColorIndex: Byte; FResolution: Byte; FGifVer: TGifVer; public function Read(Stream: TStream; var AFrameList: TGifFrameList): Boolean; overload; virtual; function Read(FileName: string; var AFrameList: TGifFrameList): Boolean; overload; virtual; function ReadRes(Instance: THandle; ResName: string; ResType: PChar; var AFrameList: TGifFrameList): Boolean; overload; virtual; function ReadRes(Instance: THandle; ResId: Integer; ResType: PChar; var AFrameList: TGifFrameList): Boolean; overload; virtual; function Check(Stream: TStream): Boolean; overload; virtual; function Check(FileName: string): Boolean; overload; virtual; public constructor Create; virtual; destructor Destroy; override; property Header: TGIFHeader read FHeader; property ScreenWidth: Integer read FScreenWidth; property ScreenHeight: Integer read FScreenHeight; property Interlace: Boolean read FInterlace; property BitsPerPixel: Byte read FBitsPerPixel; property Background: Byte read FBackgroundColorIndex; property Resolution: Byte read FResolution; property GifVer: TGifVer read FGifVer; end; TGifFrameItem = class FDisposalMethod: Integer; FPos: TPoint; FTime: Integer; FDisbitmap: TBitmap; fBackColor : TalphaColor; public destructor Destroy; override; property Bitmap : TBitmap read FDisbitmap; end; TGifPlayer = class(TComponent) private FImage: TImage; FGifFrameList: TGifFrameList; FTimer: TTimer; FActiveFrameIndex: Integer; FSpeedup: Single; FScreenHeight: Integer; FScreenWidth: Integer; procedure SetImage(const Value: TImage); procedure TimerProc(Sender: TObject); function GetIsPlaying: Boolean; procedure SetActiveFrameIndex(const Value: Integer); procedure SetSpeedup(const Value: Single); protected procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure LoadFromFile(AFileName: string); procedure LoadFromStream(AStream: TStream); procedure LoadFromResById(Instance: THandle; ResId: Integer; ResType: PChar); procedure LoadFromResByName(Instance: THandle; ResName: string; ResType: PChar); procedure Play(); procedure Pause(); procedure stop(); // property Image: TImage read FImage write SetImage; property IsPlaying: Boolean read GetIsPlaying; property Speedup: Single read FSpeedup write SetSpeedup; property ActiveFrameIndex: Integer read FActiveFrameIndex write SetActiveFrameIndex; property ScreenWidth: Integer read FScreenWidth; property ScreenHeight: Integer read FScreenHeight; end; implementation uses Math; function swap16(x: UInt16): UInt16; inline; begin Result := ((x and $FF) shl 8) or ((x and $FF00) shr 8); end; function swap32(x: UInt32): UInt32; inline; begin Result := ((x and $FF) shl 24) or ((x and $FF00) shl 8) or ((x and $FF0000) shr 8) or ((x and $FF000000) shr 24); end; function LEtoN(Value: word): word; overload; begin Result := swap16(Value); end; function LEtoN(Value: Dword): Dword; overload; begin Result := swap32(Value); end; procedure MergeBitmap(const Source, Dest: TBitmap; SrcRect: TRect; DestX, DestY: Integer); var I, J, MoveBytes: Integer; SrcData, DestData: TBitmapData; lpColorSrc, lpColorDst: PInternalColor; begin With Dest do begin if Map(TMapAccess.Write, DestData) then try if Source.Map(TMapAccess.Read, SrcData) then try if SrcRect.Left < 0 then begin Dec(DestX, SrcRect.Left); SrcRect.Left := 0; end; if SrcRect.Top < 0 then begin Dec(DestY, SrcRect.Top); SrcRect.Top := 0; end; SrcRect.Right := Min(SrcRect.Right, Source.Width); SrcRect.Bottom := Min(SrcRect.Bottom, Source.Height); if DestX < 0 then begin Dec(SrcRect.Left, DestX); DestX := 0; end; if DestY < 0 then begin Dec(SrcRect.Top, DestY); DestY := 0; end; if DestX + SrcRect.Width > Width then SrcRect.Width := Width - DestX; if DestY + SrcRect.Height > Height then SrcRect.Height := Height - DestY; if (SrcRect.Left < SrcRect.Right) and (SrcRect.Top < SrcRect.Bottom) then begin MoveBytes := SrcRect.Width * SrcData.BytesPerPixel; for I := 0 to SrcRect.Height - 1 do begin lpColorSrc := SrcData.GetPixelAddr(SrcRect.Left, SrcRect.Top + I); lpColorDst := DestData.GetPixelAddr(DestX, DestY + I); for J := 0 to SrcRect.Width - 1 do if lpColorSrc[J].A <> 0 then begin lpColorDst[J] := lpColorSrc[J]; end; end; end; finally Source.Unmap(SrcData); end; finally Unmap(DestData); end; end; end; { TGifReader } function TGifReader.Read(FileName: string; var AFrameList: TGifFrameList): Boolean; var fs: TFileStream; begin Result := False; fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); try Result := Read(fs, AFrameList); except end; fs.DisposeOf; end; function TGifReader.ReadRes(Instance: THandle; ResName: string; ResType: PChar; var AFrameList: TGifFrameList): Boolean; var res: TResourceStream; begin res := TResourceStream.Create(HInstance, ResName, ResType); Result := Read(res, AFrameList); res.DisposeOf; end; function TGifReader.ReadRes(Instance: THandle; ResId: Integer; ResType: PChar; var AFrameList: TGifFrameList): Boolean; var res: TResourceStream; begin res := TResourceStream.CreateFromID(HInstance, ResId, ResType); Result := Read(res, AFrameList); res.DisposeOf; end; function TGifReader.Read(Stream: TStream; var AFrameList: TGifFrameList): Boolean; var LDescriptor: TGifImageDescriptor; LGraphicsCtrlExt: TGifGraphicsControlExtension; LIsTransparent: Boolean; LGraphCtrlExt: Boolean; LFrameWidth: Integer; LFrameHeight: Integer; LLocalPalette: TPalette; LScanLineBuf: TBytes; procedure ReadPalette(Stream: TStream; Size: Integer; var APalette: TPalette); Var RGBEntry: TGifRGB; I: Integer; c: TInternalColor; begin SetLength(APalette, Size); For I := 0 To Size - 1 Do Begin Stream.Read(RGBEntry, SizeOf(RGBEntry)); With APalette[I] do begin R := RGBEntry.R or (RGBEntry.R shl 8); G := RGBEntry.G or (RGBEntry.G shl 8); B := RGBEntry.B or (RGBEntry.B shl 8); A := $FF; end; End; end; function ProcHeader: Boolean; var c: TInternalColor; begin Result := False; With FHeader do begin if (CompareMem(@Signature, @GifSignature, 3)) and (CompareMem(@Version, @VerSignature87a, 3)) or (CompareMem(@Version, @VerSignature89a, 3)) then begin FScreenWidth := FHeader.ScreenWidth; FScreenHeight := FHeader.ScreenHeight; FResolution := Packedbit and $70 shr 5 + 1; FBitsPerPixel := Packedbit and 7 + 1; FBackgroundColorIndex := BackgroundColor; if CompareMem(@Version, @VerSignature87a, 3) then FGifVer := ver87a else if CompareMem(@Version, @VerSignature89a, 3) then FGifVer := ver89a; Result := True; end else Raise Exception.Create('Unknown GIF image format'); end; end; function ProcFrame: Boolean; var LineSize: Integer; LBackColorIndex: Integer; begin Result := False; With LDescriptor do begin LFrameWidth := Width; LFrameHeight := Height; FInterlace := ((Packedbit and $40) = $40); end; if LGraphCtrlExt then begin LIsTransparent := (LGraphicsCtrlExt.Packedbit and $01) <> 0; If LIsTransparent then LBackColorIndex := LGraphicsCtrlExt.ColorIndex; end else begin LIsTransparent := FBackgroundColorIndex <> 0; LBackColorIndex := FBackgroundColorIndex; end; LineSize := LFrameWidth * (LFrameHeight + 1); SetLength(LScanLineBuf, LineSize); If LIsTransparent then begin LLocalPalette[LBackColorIndex].A := alphaTransparent; end; Result := True; end; function ReadAndProcBlock(Stream: TStream): Byte; var Introducer, Labels, SkipByte: Byte; begin Stream.Read(Introducer, 1); if Introducer = $21 then begin Stream.Read(Labels, 1); Case Labels of $FE, $FF: // Comment Extension block or Application Extension block while True do begin Stream.Read(SkipByte, 1); if SkipByte = 0 then Break; Stream.Seek(Int64( SkipByte), soFromCurrent); end; $F9: // Graphics Control Extension block begin Stream.Read(LGraphicsCtrlExt, SizeOf(LGraphicsCtrlExt)); LGraphCtrlExt := True; end; $01: // Plain Text Extension block begin Stream.Read(SkipByte, 1); Stream.Seek(Int64( SkipByte), soFromCurrent); while True do begin Stream.Read(SkipByte, 1); if SkipByte = 0 then Break; Stream.Seek(Int64( SkipByte), soFromCurrent); end; end; end; end; Result := Introducer; end; function ReadScanLine(Stream: TStream; AScanLine: PByte): Boolean; var OldPos, UnpackedSize, PackedSize: longint; I: Integer; Data, Bits, Code: Cardinal; SourcePtr: PByte; InCode: Cardinal; CodeSize: Cardinal; CodeMask: Cardinal; FreeCode: Cardinal; OldCode: Cardinal; Prefix: array [0 .. 4095] of Cardinal; Suffix, Stack: array [0 .. 4095] of Byte; StackPointer: PByte; Target: PByte; DataComp: TBytes; B, FInitialCodeSize, FirstChar: Byte; ClearCode, EOICode: word; begin DataComp := nil; try try Stream.Read(FInitialCodeSize, 1); OldPos := Stream.Position; PackedSize := 0; Repeat Stream.Read(B, 1); if B > 0 then begin Inc(PackedSize, B); Stream.Seek(Int64(B), soFromCurrent); CodeMask := (1 shl CodeSize) - 1; end; until B = 0; SetLength(DataComp, 2 * PackedSize); SourcePtr := @DataComp[0]; Stream.Position := OldPos; Repeat Stream.Read(B, 1); if B > 0 then begin Stream.ReadBuffer(SourcePtr^, B); Inc(SourcePtr, B); end; until B = 0; SourcePtr := @DataComp[0]; Target := AScanLine; CodeSize := FInitialCodeSize + 1; ClearCode := 1 shl FInitialCodeSize; EOICode := ClearCode + 1; FreeCode := ClearCode + 2; OldCode := 4096; CodeMask := (1 shl CodeSize) - 1; UnpackedSize := LFrameWidth * LFrameHeight; for I := 0 to ClearCode - 1 do begin Prefix[I] := 4096; Suffix[I] := I; end; StackPointer := @Stack; FirstChar := 0; Data := 0; Bits := 0; while (UnpackedSize > 0) and (PackedSize > 0) do begin Inc(Data, SourcePtr^ shl Bits); Inc(Bits, 8); while Bits >= CodeSize do begin Code := Data and CodeMask; Data := Data shr CodeSize; Dec(Bits, CodeSize); if Code = EOICode then Break; if Code = ClearCode then begin CodeSize := FInitialCodeSize + 1; CodeMask := (1 shl CodeSize) - 1; FreeCode := ClearCode + 2; OldCode := 4096; Continue; end; if Code > FreeCode then Break; if OldCode = 4096 then begin FirstChar := Suffix[Code]; Target^ := FirstChar; Inc(Target); Dec(UnpackedSize); OldCode := Code; Continue; end; InCode := Code; if Code = FreeCode then begin StackPointer^ := FirstChar; Inc(StackPointer); Code := OldCode; end; while Code > ClearCode do begin StackPointer^ := Suffix[Code]; Inc(StackPointer); Code := Prefix[Code]; end; FirstChar := Suffix[Code]; StackPointer^ := FirstChar; Inc(StackPointer); Prefix[FreeCode] := OldCode; Suffix[FreeCode] := FirstChar; if (FreeCode = CodeMask) and (CodeSize < 12) then begin Inc(CodeSize); CodeMask := (1 shl CodeSize) - 1; end; if FreeCode < 4095 then Inc(FreeCode); OldCode := InCode; repeat Dec(StackPointer); Target^ := StackPointer^; Inc(Target); Dec(UnpackedSize); until StackPointer = @Stack; end; Inc(SourcePtr); Dec(PackedSize); end; finally DataComp := nil; end; except end; Result := True; end; function WriteScanLine(var Img: TBitmap; AScanLine: PByte): Boolean; Var Row, Col: Integer; Pass, Every: Byte; P: PByte; function IsMultiple(NumberA, NumberB: Integer): Boolean; begin Result := (NumberA >= NumberB) and (NumberB > 0) and (NumberA mod NumberB = 0); end; var PLine: PInternalColor; Data: TBitmapData; begin Result := False; P := AScanLine; if Img.Map(TMapAccess.Write, Data) then begin try If FInterlace then begin For Pass := 1 to 4 do begin Case Pass of 1: begin Row := 0; Every := 8; end; 2: begin Row := 4; Every := 8; end; 3: begin Row := 2; Every := 4; end; 4: begin Row := 1; Every := 2; end; end; Repeat PLine := Data.GetScanline(Row); for Col := 0 to Img.Width - 1 do begin PLine[Col] := LLocalPalette[P^]; Inc(P); end; Inc(Row, Every); until Row >= Img.Height; end; end else begin for Row := 0 to Img.Height - 1 do begin PLine := Data.GetScanline(Row); for Col := 0 to Img.Width - 1 do begin PLine[Col] := LLocalPalette[P^]; Inc(P); end; end; end; Result := True; finally Img.Unmap(Data); end; end; end; procedure RenderFrame(const Index : integer; const aFrames : array of TGifFrameItem; const aDisplay : TBitmap); var I, First, Last: Integer; begin Last := Index; First := Max(0, Last); aDisplay.Clear(aFrames[Index].fBackColor); while First > 0 do begin if (fScreenWidth = aFrames[First].Bitmap.Width) and (fScreenHeight = aFrames[First].Bitmap.Height) then begin if (aFrames[First].FDisposalMethod = GIF_DISPOSAL_BACKGROUND) and (First < Last) then Break; end; Dec(First); end; for I := First to Last - 1 do begin case aFrames[I].FDisposalMethod of GIF_DISPOSAL_UNSPECIFIED, GIF_DISPOSAL_LEAVE: begin // Copy previous raw frame onto screen MergeBitmap(aFrames[i].Bitmap, aDisplay, aFrames[i].Bitmap.Bounds, aFrames[i].FPos.X, aFrames[i].FPos.Y); end; GIF_DISPOSAL_BACKGROUND: if (I > First) then begin // Restore background color aDisplay.ClearRect(TRectF.Create(aFrames[i].FPos.X, aFrames[i].FPos.Y, aFrames[i].FPos.X + aFrames[i].Bitmap.Width, aFrames[i].FPos.Y + aFrames[i].Bitmap.Height), aFrames[i].fBackColor); end; GIF_DISPOSAL_PREVIOUS: ; // Do nothing - previous state is already on screen end; end; MergeBitmap(aFrames[Index].Bitmap, aDisplay, aFrames[Index].Bitmap.Bounds, aFrames[Index].FPos.X, aFrames[Index].FPos.Y); end; var Introducer: Byte; ColorTableSize: Integer; tmp: TBitmap; LFrame: TGifFrameItem; FrameIndex: Integer; I: Integer; LBC : integer; LFrames : array of TGifFrameItem; rendered : array of TBitmap; begin Result := False; if not Check(Stream) then Exit; AFrameList.Clear; FGifVer := verUnknow; FPalette := nil; LScanLineBuf := nil; try Stream.Position := 0; Stream.Read(FHeader, SizeOf(FHeader)); {$IFDEF BIGENDIAN} with FHeader do begin ScreenWidth := LEtoN(ScreenWidth); ScreenHeight := LEtoN(ScreenHeight); end; {$ENDIF} if (FHeader.Packedbit and $80) = $80 then begin ColorTableSize := FHeader.Packedbit and 7 + 1; ReadPalette(Stream, 1 shl ColorTableSize, FPalette); end; if not ProcHeader then Exit; FrameIndex := 0; SetLength(LFrames, 0); while True do begin LLocalPalette := nil; Repeat Introducer := ReadAndProcBlock(Stream); until (Introducer in [$2C, $3B]); if Introducer = $3B then Break; Stream.Read(LDescriptor, SizeOf(LDescriptor)); {$IFDEF BIGENDIAN} with FDescriptor do begin Left := LEtoN(Left); Top := LEtoN(Top); Width := LEtoN(Width); Height := LEtoN(Height); end; {$ENDIF} if (LDescriptor.Packedbit and $80) <> 0 then begin ColorTableSize := LDescriptor.Packedbit and 7 + 1; ReadPalette(Stream, 1 shl ColorTableSize, LLocalPalette); end else begin LLocalPalette := Copy(FPalette, 0, Length(FPalette)); end; if not ProcFrame then Exit; LFrame := TGifFrameItem.Create; LFrame.FTime := 10 * LGraphicsCtrlExt.DelayTime; LFrame.FDisbitmap := TBitmap.Create(LFrameWidth, LFrameHeight); LFrame.FPos := Point(LDescriptor.Left, LDescriptor.Top); LFrame.FDisposalMethod := 7 and (LGraphicsCtrlExt.Packedbit shr 2); if not ReadScanLine(Stream, @LScanLineBuf[0]) then Exit; if not WriteScanLine(LFrame.FDisbitmap, @LScanLineBuf[0]) then Exit; if LGraphCtrlExt then begin LIsTransparent := (LGraphicsCtrlExt.Packedbit and $01) <> 0; If LIsTransparent then LBC := LGraphicsCtrlExt.ColorIndex else LBC := FBackgroundColorIndex; end else LBC := FBackgroundColorIndex; LFrame.fBackColor := LLocalPalette[LBC].Color; Inc(FrameIndex); SetLength(LFrames, FrameIndex); LFrames[FrameIndex - 1] := LFrame; end; SetLength(rendered, Length(LFrames)); for I := 0 to Length(LFrames) - 1 do begin tmp := TBitmap.Create(FScreenWidth, FScreenHeight); RenderFrame(I, LFrames, tmp); rendered[i] := tmp; end; for I := 0 to Length(LFrames) - 1 do begin LFrames[i].Bitmap.Assign(rendered[i]); FreeAndNil(rendered[i]); AFrameList.Add(LFrames[i]); end; Result := True; finally LLocalPalette := nil; LScanLineBuf := nil; rendered := nil; LFrames := nil; end; end; function TGifReader.Check(Stream: TStream): Boolean; var OldPos: Int64; begin try OldPos := Stream.Position; Stream.Read(FHeader, SizeOf(FHeader)); Result := (CompareMem(@FHeader.Signature, @GifSignature, 3)) and (CompareMem(@FHeader.Version, @VerSignature87a, 3)) or (CompareMem(@FHeader.Version, @VerSignature89a, 3)); Stream.Position := OldPos; except Result := False; end; end; function TGifReader.Check(FileName: string): Boolean; var fs: TFileStream; begin Result := False; fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); try Result := Check(fs); except end; fs.DisposeOf; end; constructor TGifReader.Create; begin inherited Create; end; destructor TGifReader.Destroy; begin inherited Destroy; end; { TGifFrameItem } destructor TGifFrameItem.Destroy; begin if FDisbitmap <> nil then begin FDisbitmap.DisposeOf; FDisbitmap := nil; end; inherited Destroy; end; { TGifPlayer } constructor TGifPlayer.Create(AOwner: TComponent); begin inherited Create(AOwner); FGifFrameList := TGifFrameList.Create(); FTimer := TTimer.Create(Self); FTimer.Enabled := False; FTimer.OnTimer := TimerProc; FSpeedup := 1.0; end; destructor TGifPlayer.Destroy; begin FTimer.Enabled := False; FGifFrameList.DisposeOf; FGifFrameList := nil; inherited Destroy; end; function TGifPlayer.GetIsPlaying: Boolean; begin Result := FTimer.Enabled; end; procedure TGifPlayer.LoadFromFile(AFileName: string); var gr: TGifReader; begin gr := TGifReader.Create; gr.Read(AFileName, FGifFrameList); FScreenWidth := gr.ScreenWidth; FScreenHeight := gr.ScreenHeight; gr.DisposeOf; ActiveFrameIndex := 0; end; procedure TGifPlayer.LoadFromResById(Instance: THandle; ResId: Integer; ResType: PChar); var gr: TGifReader; begin gr := TGifReader.Create; gr.ReadRes(Instance, ResId, ResType, FGifFrameList); FScreenWidth := gr.ScreenWidth; FScreenHeight := gr.ScreenHeight; gr.DisposeOf; ActiveFrameIndex := 0; end; procedure TGifPlayer.LoadFromResByName(Instance: THandle; ResName: string; ResType: PChar); var gr: TGifReader; begin gr := TGifReader.Create; gr.ReadRes(Instance, ResName, ResType, FGifFrameList); FScreenWidth := gr.ScreenWidth; FScreenHeight := gr.ScreenHeight; gr.DisposeOf; ActiveFrameIndex := 0; end; procedure TGifPlayer.LoadFromStream(AStream: TStream); var gr: TGifReader; begin gr := TGifReader.Create; gr.Read(AStream, FGifFrameList); FScreenWidth := gr.ScreenWidth; FScreenHeight := gr.ScreenHeight; gr.DisposeOf; ActiveFrameIndex := 0; end; procedure TGifPlayer.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if Operation = opRemove then begin if AComponent = FImage then FImage := nil; end; end; procedure TGifPlayer.Pause; begin FTimer.Enabled := False; end; procedure TGifPlayer.Play; begin if not IsPlaying then begin ActiveFrameIndex := FActiveFrameIndex; FTimer.Enabled := True; end; end; procedure TGifPlayer.SetActiveFrameIndex(const Value: Integer); var lInterval: Integer; begin // if (FActiveFrameIndex <> Value) then begin FActiveFrameIndex := Value; if (FActiveFrameIndex < 0) or (FActiveFrameIndex >= FGifFrameList.Count) then FActiveFrameIndex := -1; if (FActiveFrameIndex >= 0) and (FActiveFrameIndex < FGifFrameList.Count) then begin if FImage <> nil then begin FImage.Bitmap.Assign(FGifFrameList[FActiveFrameIndex].FDisbitmap); end; lInterval := FGifFrameList[FActiveFrameIndex].FTime; if lInterval = 0 then lInterval := 100; lInterval := Trunc(lInterval / FSpeedup); if lInterval <= 3 then lInterval := 3; FTimer.Interval := lInterval; end else begin FImage.Bitmap.SetSize(0, 0); FTimer.Interval := 0; end; end; end; procedure TGifPlayer.SetImage(const Value: TImage); begin FImage := Value; if FImage <> nil then FImage.FreeNotification(Self); end; procedure TGifPlayer.SetSpeedup(const Value: Single); begin if FSpeedup <> Value then begin FSpeedup := Value; if FSpeedup <= 0.001 then FSpeedup := 0.001; end; end; procedure TGifPlayer.stop; begin Pause; FActiveFrameIndex := 0; end; procedure TGifPlayer.TimerProc(Sender: TObject); var Interval: Integer; begin if ([csDesigning, csDestroying, csLoading] * ComponentState) <> [] then Exit; FTimer.Enabled := False; if ActiveFrameIndex < (FGifFrameList.Count - 1) then ActiveFrameIndex := FActiveFrameIndex + 1 else ActiveFrameIndex := 0; FTimer.Enabled := True; end; end.
Read More

Why uploaded photo is much smaller than saved – Delphi 10.3.2, firemonkey

I have Delphi 10.3.2 I do not understand this situations: 1) Uploading photo about 1M image1.Bitmap.LoadFromFile('test.jpg'); Then I save the same photo image1.Bitmap.SaveToFile('test_new.jpg'); and test_new.jpg is about 3M. Why ??? 2) I want to send a photo from the TImage (test1.jpg - 1MB) object using IdHTTP and POST request to server. I use the function Base64_Encoding_stream to encode image. Image size (string) after encoding the function is 20 MB! ? Why if the original file has 1MB ? function Base64_Encoding_stream(_image:Timage): string; var base64: TIdEncoderMIME; output: string; stream_image : TStream; begin try begin base64 := TIdEncoderMIME.Create(nil); stream_image := TMemoryStream.Create; _image.Bitmap.SaveToStream(stream_image); stream_image.Position := 0; output := TIdEncoderMIME.EncodeStream(stream_image); stream_image.Free; base64.Free; if not(output = '') then begin Result := output; end else begin Result := 'Error'; end; end; except begin Result := 'Error' end; end; end; .... img_encoded := Base64_Encoding_stream(Image1); ..... procedure Send(_json:String ); var lHTTP : TIdHTTP; PostData : TStringList; begin PostData := TStringList.Create; lHTTP := TIdHTTP.Create(nil); try PostData.Add('dane=' + _json ); lHTTP.Request.UserAgent := 'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:12.0) Gecko/20100101 Firefox/12.0'; lHTTP.Request.Connection := 'keep-alive'; lHTTP.Request.ContentType := 'application/x-www-form-urlencoded'; lHTTP.Request.Charset := 'utf-8'; lHTTP.Request.Method := 'POST'; _dane := lHTTP.Post('http://......./add_photo.php',PostData); finally lHTTP.Free; PostData.Free; end;
Read More

FMX Android TControl.MakeScreenShot or TCanvas.FillText always generate black block around fonts

I want to create a picture with "white background and black labels" and share it using intent. But my picture always generate black block around all fonts. It's been 2 days now I'm stuck on this problems. Anybody has solution or can point me to the right direction? or any workaround if it's still a bug from developer? I'm using 10.2 Thank you. Edit: Adding example Code unit UTest; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls, FMX.Objects, FMX.Controls.Presentation; type TFTest = class(TForm) Rectangle1: TRectangle; Label1: TLabel; Label2: TLabel; Label3: TLabel; Image1: TImage; Button1: TButton; Button2: TButton; Image2: TImage; Button3: TButton; Button4: TButton; procedure Button1Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button4Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var FTest: TFTest; implementation {$R *.fmx} Uses System.IOUtils; procedure TFTest.Button1Click(Sender: TObject); begin Image2.Bitmap := Rectangle1.MakeScreenshot; end; procedure TFTest.Button2Click(Sender: TObject); var mrect:trect; begin Image1.Bitmap.SetSize(Trunc(Image1.Width * Image1.Canvas.Scale), Trunc(Image1.Height * Image1.Canvas.Scale)); Image1.bitmap.Canvas.BeginScene; Image1.Bitmap.canvas.Clear(TAlphaColors.White); Image1.bitmap.Canvas.Stroke.Thickness := 1; Image1.bitmap.Canvas.Stroke.Color := TAlphaColorRec.Black; Image1.Bitmap.canvas.Stroke.Kind := TBrushKind.bkSolid; Image1.bitmap.Canvas.Fill.Color := TAlphaColors.Black; Image1.Bitmap.Canvas.Fill.DefaultColor:=TAlphaColors.White; Image1.Bitmap.Canvas.Font.Size:=10; Image1.Bitmap.Canvas.Font.Family:='Arial'; Image1.Bitmap.Canvas.Font.Style:=[TFontStyle.fsbold]; Image1.bitmap.canvas.Blending:=false; Image1.Bitmap.Canvas.DrawLine(PointF(20, 10), PointF(330, 10), 1); mRect.Create(20, 10, 180, 30); Image1.bitmap.Canvas.filltext(mRect, 'DD:MM:YY HH:MM', false, 0, [],TTextAlign.Leading, TTextAlign.Center); mRect.Create(180, 10, 330, 30); Image1.bitmap.Canvas.filltext(mRect, 'SHID/CNAME', false, 1, [],TTextAlign.Trailing, TTextAlign.Center); Image1.Bitmap.Canvas.DrawLine(PointF(20, 30), PointF(330, 30), 1); Image1.bitmap.Canvas.EndScene; {$IFDEF ANDROID} image1.bitmap.SaveToFile(TPath.GetHomePath() + TPath.DirectorySeparatorChar + 'screenshot.jpg'); image2.Bitmap.LoadFromFile(TPath.GetHomePath() + TPath.DirectorySeparatorChar + 'screenshot.jpg'); {$ENDIF} {$IFDEF MSWINDOWS} image1.Bitmap.SaveToFile('E:\screenshot.jpg'); image2.Bitmap.LoadFromFile('E:\screenshot.jpg'); {$ENDIF} end; procedure TFTest.Button3Click(Sender: TObject); var bmp: TBitmap; begin bmp := TBitmap.Create; bmp.Width := Image2.bitmap.Width; bmp.Height := Image2.bitmap.Height; bmp := Rectangle1.MakeScreenshot; {$IFDEF ANDROID} bmp.SaveToFile(TPath.GetHomePath() + TPath.DirectorySeparatorChar + 'screenshot.jpg'); image2.Bitmap.LoadFromFile(TPath.GetHomePath() + TPath.DirectorySeparatorChar + 'screenshot.jpg'); {$ENDIF} {$IFDEF MSWINDOWS} bmp.SaveToFile('E:\screenshot.jpg'); image2.Bitmap.LoadFromFile('E:\screenshot.jpg'); {$ENDIF} end; procedure TFTest.Button4Click(Sender: TObject); begin image1.Bitmap := nil; image2.Bitmap := nil; end; end. Form object FTest: TFTest Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 530 ClientWidth = 360 FormFactor.Width = 320 FormFactor.Height = 480 FormFactor.Devices = [Desktop] DesignerMasterStyle = 3 object Rectangle1: TRectangle Fill.Color = claWhite Position.X = 8.000000000000000000 Position.Y = 8.000000000000000000 Size.Width = 345.000000000000000000 Size.Height = 121.000000000000000000 Size.PlatformDefault = False Stroke.Kind = None object Label1: TLabel Align = Top Size.Width = 345.000000000000000000 Size.Height = 23.000000000000000000 Size.PlatformDefault = False TextSettings.HorzAlign = Center Text = 'Label1' TabOrder = 0 end object Label2: TLabel Position.X = 23.000000000000000000 Position.Y = 80.000000000000000000 Text = 'Label2' TabOrder = 1 end object Label3: TLabel Position.X = 23.000000000000000000 Position.Y = 48.000000000000000000 Text = 'Label3' TabOrder = 2 end end object Image1: TImage MultiResBitmap = Position.X = 8.000000000000000000 Position.Y = 136.000000000000000000 Size.Width = 345.000000000000000000 Size.Height = 121.000000000000000000 Size.PlatformDefault = False end object Button1: TButton Position.X = 8.000000000000000000 Position.Y = 264.000000000000000000 Size.Width = 345.000000000000000000 Size.Height = 44.000000000000000000 Size.PlatformDefault = False TabOrder = 2 Text = 'TLayout.MakeScreenShot (No Saving)' OnClick = Button1Click end object Button2: TButton Position.X = 8.000000000000000000 Position.Y = 360.000000000000000000 Size.Width = 193.000000000000000000 Size.Height = 44.000000000000000000 Size.PlatformDefault = False TabOrder = 3 Text = 'TCanvas.FillRect' OnClick = Button2Click end object Image2: TImage MultiResBitmap = Position.X = 8.000000000000000000 Position.Y = 408.000000000000000000 Size.Width = 345.000000000000000000 Size.Height = 121.000000000000000000 Size.PlatformDefault = False end object Button3: TButton Position.X = 8.000000000000000000 Position.Y = 312.000000000000000000 Size.Width = 345.000000000000000000 Size.Height = 44.000000000000000000 Size.PlatformDefault = False TabOrder = 5 Text = 'TLayout.MakeScreenShot (Saving)' OnClick = Button3Click end object Button4: TButton Position.X = 208.000000000000000000 Position.Y = 360.000000000000000000 Size.Width = 137.000000000000000000 Size.Height = 44.000000000000000000 Size.PlatformDefault = False TabOrder = 6 Text = 'Image NIL' OnClick = Button4Click end end On windows everything is normal, but when i run it on android: TLayout MakeScreenShot without saving has gray block around fonts. TLayout MakeScreenShot with saving has black block around fonts. TCanvas FillRect has black block around fonts. Canvas FillText
Read More

Problem displaying items in Listbox and Memo in Firemonkey Android application

I am at my first experiences with Android development using Delphi/Firemonkey 10.3.1 and have encountered the following problem with populating and displaying items in a TListbox component and a TMenu component at run time. I have placed TListbox and TMenu components on a panel, together with a button to trigger the generation of a sequence of random numbers and display them in these components. The TListbox component contains objects of class TListboxItemRandomNo descending from TListboxItem. The code for this class is: TListboxItemRandomNo= class(TListboxItem) private FRandomNo: integer; {Number displayed by Listbox item} protected procedure HandlePaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF); function GetItemText: string; public constructor Create(Owner: TComponent; RandomNoValue: integer); property RandomNo: integer read FRandomNo; end; constructor TListboxItemRandomNo.Create(Owner: TComponent; RandomNoValue: integer); var Listbox: TListbox; begin Listbox:= Owner as TListbox; inherited Create(Owner); Listbox.AddObject(Self); {Save RandonNo:} FRandomNo:= RandomNoValue; {Assign OnPaint event handler:} OnPaint:= HandlePaint; end; procedure TListboxItemRandomNo.HandlePaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF); var Text: string; TextSize: TSizeF; TextPosn: TPointF; TextRect: TRectF; begin {Calculate item text:} Text:= GetItemText; {Set colour for text:} Canvas.Fill.Color:= TAlphaColorRec.Black; {Determine text image size, position and bounding rectangle:} TextSize.cx:= Canvas.TextWidth(Text); TextSize.cy:= Canvas.TextHeight(Text); TextPosn.x:= ARect.Left + 5; TextPosn.y:= (ARect.Top + ARect.Bottom - TextSize.cy)/2; TextRect.TopLeft:= TextPosn; TextRect.Right:= ARect.Right; TextRect.Bottom:= TextRect.Top + TextSize.cy; {Draw item text:} Canvas.FillText(TextRect, Text, False, 1.0, [], TTextAlign.Leading, TTextAlign.Center); end; function TListboxItemRandomNo.GetItemText: string; begin Result:= IntToStr(Index) + ': ' + IntToStr(FRandomNo); end; Initially I put the code to generate and display the random numbers in the OnClick event handler of the button. Whilst this approach worked on the Windows 32-bit platform, on the Android platform in both the TListbox and the TMemo components the items were not displayed. I then created an Action called ActionCalcRandomNos and moved the code to generate and display the random numbers from the button’s OnClick event handler into the OnExecute event handler of the action. I disconnected the OnClick event handler of the button and assigned ActionCalcRandomNos to it instead. After these changes I found that the items in both the TListbox and the TMemo components were displayed on both the Windows-32 and the Android platforms. The code in question is: procedure TForm1.ActionCalcRandomNosExecute(Sender: TObject); {Calculates a random sequence of numbers and displays them in TListbox and TMemo components} var i: integer; xi: integer; ListboxItemRandomNo: TListboxItemRandomNo; LineI: string; begin {Read number of random numbers required:} FRandomNoCount:= StrToInt(EditItemCount.Text); SetLength(FRandomNoSequence, FRandomNoCount); {Generate random number sequence:} Randomize; for i := 0 to FRandomNoCount-1 do begin xi:= Random(FRandomNoCount); FRandomNoSequence[i]:= xi; end; {Generate Listbox items dislaying random numbers:} ListBoxRandomSequence.Clear; ListBoxRandomSequence.BeginUpdate; for i:= 0 to FRandomNoCount-1 do begin ListboxItemRandomNo:= TListboxItemRandomNo.Create(ListBoxRandomSequence, FRandomNoSequence[i]); end; ListBoxRandomSequence.EndUpdate; {Write random numbers to TMemo:} MemoRandomNos.Lines.Clear; MemoRandomNos.BeginUpdate; for i:= 0 to FRandomNoCount-1 do begin LineI:= (ListBoxRandomSequence.ListItems[i] as TListboxItemRandomNo).GetItemText; MemoRandomNos.Lines.Add(LineI); end; MemoRandomNos.EndUpdate; end; Why did this code not work when called directly from the button OnClick event handler, but did work when called indirectly via the action ActionCalcRandomNos connected to the button? The only remaining minor problem with the TListbox is this. The item height, which is set as 0 in the Object Inspector, on the Android platform version only is being displayed much too great. This started after I changed the ItemHeight property back to 0 after previously having set it at 20. Any light shed on any of these problems would be helpful.
Read More

Why isn’t InputQuery returning bool?

I've followed the clear documentation to implement an input dialog box. It works fine. But, now i want to ignore the user input if they click cancel. Below is quote from that documentation. "If the user clicks the OK button, InputQuery returns True; InputQuery returns False otherwise." So, i tried the following code and the error i'm getting is E2034 Cannot convert void to bool when i run on Win32 and bccaarm error 1711 value of type void is not contextually convertible to bool on Android. if (InputQuery(caption, Prompts, sizeof(Prompts)/sizeof(Prompts[0]) - 1, Defaults, sizeof(Defaults)/sizeof(Defaults[0]) - 1, (TInputCloseQueryProc *)Met)){ // clicked OK } else { // clicked cancel } How can i test if OK or Cancel clicked? Below is the declaration for InputQuery and it should be bool. I'm confused. extern DELPHI_PACKAGE bool __fastcall InputQuery _DEPRECATED_ATTRIBUTE1("Use FMX.DialogService methods") (const System::UnicodeString ACaption, const System::UnicodeString *APrompts, const int APrompts_High, System::UnicodeString *AValues, const int AValues_High, const _di_TInputCloseQueryFunc ACloseQueryFunc = _di_TInputCloseQueryFunc())/* overload */;
Read More

Using the GetClass function with VCL / FMX not found

I have the following situation, project in *.bpl VCL structure. I want to adapt a screen made in FMX in this structure using LoadPackage and GetClass.

When I run form VCL after running FMX it loses reference in the GetClass function. But it can return the address that was allocated in the LoadPackage function. I couldn’t see what might be going on.

If anyone has an idea of ​​what might be happening or has been through it.

Code:

In untFormFMX.pas

initialization
  RegisterClass(TForm1);

finalization
  UnRegisterClass(TForm1);

In VCLForms.pas

initialization
  RegisterClass(TForm2);

finalization
  UnRegisterClass(TForm2);

In untPrinc.pas

procedure OpenFMXForm;
var
  oFMXForm: TForm;
  oFMXClass: TPersistentClass;
begin
  LoadPackage('pctFMXForms.bpl');
  oFMXClass := GetClass('TForm1');
  Application.CreateForm(TFormClass(oFMXClass) ,oFMXForm );
  TForm(oFMXForm).ShowModal
end;

procedure OpenVCLForm;
var
  oVCLForm: TForm;
  oVCLClass: TPersistentClass;
begin
  LoadPackage('pctVCLForms.bpl');
  oVCLClass := GetClass('TForm2');
  Application.CreateForm(TFormClass(oVCLClass) ,oVCLForm );
  TForm(oVCLForm).ShowModal
end;

Process:

1° Open VCL Form: OK
2° Open FMX Form: OK
3° Open VCL Form: not found return nil

Read More

Read More

Hardware Locked Licensing Delphi RIO

i want my user to use my software only in one system or login once at a time for that i want to know how can i create such keys that's effected by changes in other hardware. I am using that key to check in server and return true if the key generated by user hardware is same as key stored at first login from my desktop app. and at logout i am deleting that key from server and saving the key which will be fetched from next login hardware.. I've read all the related question but they are useless when any part of hardware is changed(such as hdd changed). and i know that this thing is not 100%. Is key based on bios is good alternative to hdd cpu and other components as they may change anytime ? https://www.azsdk.com/hardwareid.html i found this for delphi but this is way back updated and supported in windows 7 don't know about Windows 10.
Read More

how to configure tls on Delphi TRestClient component

Helo, I typed the code as follows and this code works well. By using an https connection I hope that the Packet Data received cannot be read by applications such as Wireshark or the Packet Capture application on Android. how do you configure the client side? this my code procedure TForm1.Button1Click(Sender: TObject); var MyCompletionHandler: TCompletionHandler; MyErrorCompletionHandler: TCompletionHandlerWithError; begin ShowLoadingIndicator(Self, True); Memo1.Lines.Clear; RESTClient1.BaseURL := 'https://reqres.in/'; RESTClient1.RaiseExceptionOn500 := False; RESTClient1.SecureProtocols := [THTTPSecureProtocol.TLS12]; RESTRequest1.ClearBody; RESTRequest1.Resource := 'api/users'; MyCompletionHandler := procedure var i: Integer; tJson: TJSONValue; begin Label1.Text := 'Complete!'; Memo1.Lines.Append('Header: '); for I := 0 to RESTResponse1.Headers.Count-1 do Memo1.Lines.Append(RESTResponse1.Headers.Strings[I]); Memo1.Lines.Append(''); Memo1.Lines.Append('Body:'); tJson := TJSONObject.ParseJSONValue(RESTResponse1.Content); try memo1.Lines.Append(REST.Json.TJson.Format(tJson)); finally FreeAndNil(tJson); end; HideLoadingIndicator(Self); end; MyErrorCompletionHandler := procedure(AObject: TObject) begin Label1.Text := 'Error!'; HideLoadingIndicator(Self); end; RESTRequest1.ExecuteAsync(MyCompletionHandler, True, True, MyErrorCompletionHandler); end; result packet capture using app and this simple apps made with firemonkey: Simple Apps
Read More

Restrict user input to digits only with InputQuery

I've followed the Embarcadero documentation to provide an input dialog to let user give keyboard input (I followed the C++ example exactly). I know this is implemented with TEdit boxes internally, is it possible to restrict user input in the dialog to digits only (0-9)? I'm thinking something like we can do with regular TEdit boxes using the FilterChar property or somehow specify the KeyboardType property to NumberPad.
Read More

Android apps migration from Delphi 10.3.1 to 10.3.2

I have two problems after switching to 10.3.2 from 10.3.1 1) When I install the APK on the phone I get information "Google protect blocked APP.... " I have the same SDK version in 10.3.1 and 10.3.2. I get information only for APK under 10.3.2. What I should change ? 2) I can't run android projects created in 10.3.1 after compile in 10.3.2. I cleaned the library directory in my project. The application compiles, installs and then app stops on the default splash. UPDATE FOR POINT 2 - Problem solved
Read More