Source Code Delphi Samples with Sources

emailx45 · Nov 16, 2019

My sample based on "FireDAC using connections type", webinar showed by Jens Fudge

FireDAC for Windows 10 Database Access by Jens Fudge MVP Embarcadero - webinar

[SHOWTOGROUPS=4,19,20]https://www.mirrored.to/files/1EVHY4M5/FireDAC_Tipos_de_Conexão_Temporaria_Persistente_Privada.zip_links[/SHOWTOGROUPS]

emailx45 · Jan 15, 2020

Here my example how to use TVirtualImageList and TImageCollection to store and show images in TImage or similar controls!

View attachment 496

[SHOWTOGROUPS=4,19,20]

Code:

unit uFormMain2;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  System.ImageList,
  Vcl.ImgList,
  Vcl.VirtualImageList,
  Vcl.BaseImageCollection,
  Vcl.ImageCollection,
  Vcl.StdCtrls,
  Vcl.ExtCtrls;

type
  TForm2 = class(TForm)
    ImageCollection1: TImageCollection;
    VirtualImageList1: TVirtualImageList;
    btnCountingItems: TButton;
    Memo1: TMemo;
    btnAddImageOnImageCollection: TButton;
    Panel1: TPanel;
    Panel2: TPanel;
    img_My_VirtualImage_ICON: TImage;
    imgBMP_FULL_IMAGE: TImage;
    btnAddImageOnVirtualImageList: TButton;
    Panel3: TPanel;
    img_My_VirtualImage_BITMAP: TImage;
    btnCleaningVirtualImageList_ImageCollection: TButton;
    procedure btnCountingItemsClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnAddImageOnImageCollectionClick(Sender: TObject);
    procedure btnAddImageOnVirtualImageListClick(Sender: TObject);
    procedure btnCleaningVirtualImageList_ImageCollectionClick(Sender: TObject);
  private
    procedure prcLOG(lText: string);
  public
    //
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.prcLOG(lText: string);
begin
  Memo1.Lines.Add(lText);
end;

procedure TForm2.btnAddImageOnVirtualImageListClick(Sender: TObject);
var
  lVILItem:            TVirtualImageListItem;
  lImageIndexOnVIList: Integer;
  //
  lMyImageName: string;
begin
  if not(ImageCollection1.Count > 0) then
  begin
    ShowMessage('There is not image on ImageCollection1');
    exit;
  end;
  //
  if (VirtualImageList1.Count = 1) then
  begin
    ShowMessage('Already there is 1 image on VirtualImageList1 for test!');
    exit;
  end;
  //
  lMyImageName := '2_without_logo';
  //
  lVILItem                := VirtualImageList1.Images.Add;
  lVILItem.CollectionName := lMyImageName;
  //
  lVILItem.Name := lMyImageName;
  //
  btnCountingItems.Click;
  //
  lImageIndexOnVIList := VirtualImageList1.GetIndexByName(lVILItem.Name); // searching by image names...
  //
  if (lImageIndexOnVIList > -1) then
  begin
    VirtualImageList1.GetIcon(lImageIndexOnVIList, img_My_VirtualImage_ICON.Picture.Icon); // myICON_Temp);
    //
    VirtualImageList1.GetBitmap(lImageIndexOnVIList, img_My_VirtualImage_BITMAP.Picture.Bitmap); // myBITMAP_Temp);
    //
    prcLOG('TImage''s resulted!');
  end
  else
    ShowMessage('lImageIndexOnVIList = -1'); // not founded!
  //
  if (VirtualImageList1.Count = 0) then
    ShowMessage('There is not images on VirtualImageList1');
  //
  prcLOG(StringOfChar('-', 80));
end;

procedure TForm2.btnCleaningVirtualImageList_ImageCollectionClick(Sender: TObject);
begin
  VirtualImageList1.Clear;
  ImageCollection1.Images.Clear;
  //
  imgBMP_FULL_IMAGE.Picture          := nil;
  img_My_VirtualImage_ICON.Picture   := nil;
  img_My_VirtualImage_BITMAP.Picture := nil;
  //
  prcLOG('VirtualImageList and ImageCollection was cleaned!');
  prcLOG(StringOfChar('-', 80));
end;

procedure TForm2.btnCountingItemsClick(Sender: TObject);
begin
  prcLOG(Format('ImageCollection1.Count = %d, VirtualImageList1.Count = %d', [ { }
    ImageCollection1.Count,                                                    { }
    VirtualImageList1.Count                                                    { }
    ]));
  prcLOG(StringOfChar('-', 80));
end;

procedure TForm2.btnAddImageOnImageCollectionClick(Sender: TObject);
var
  lICItem:  TImageCollectionItem;
  lICSItem: TImageCollectionSourceItem;
  lVILItem: TVirtualImageListItem;
  //
  lMyImageName:       string;
  lMyPathAndFileName: string;
begin
  //
  lMyPathAndFileName := '..\..\2_without_logo.bmp';
  lMyImageName       := '2_without_logo';
  //
  imgBMP_FULL_IMAGE.Picture.Bitmap.LoadFromFile(lMyPathAndFileName);
  //
  lICItem      := ImageCollection1.Images.Add;
  lICItem.Name := lMyImageName;
  lICSItem     := lICItem.SourceImages.Add;
  lICSItem.Image.LoadFromFile(lMyPathAndFileName);
  //
  prcLOG('lICItem.Name = ' + lICItem.Name);
  prcLOG('lICItem.Index = ' + lICItem.Index.ToString);
  prcLOG('lICItem.ID = ' + lICItem.ID.ToString);
  prcLOG('lICItem.DisplayName = ' + lICItem.DisplayName);
  prcLOG('lICItem.GetNamePath = ' + lICItem.GetNamePath);
  prcLOG('lICItem.DisplayName = ' + lICItem.DisplayName);
  prcLOG('lICItem.SourceImages.GetNamePath = ' + lICItem.SourceImages.GetNamePath);
  //
  btnCountingItems.Click;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  Memo1.Lines.Clear;
end;

end.

[/SHOWTOGROUPS]

emailx45 · Jan 19, 2020

my VCL project Creating Forms MDI using FormStyle fsMDIForm and fsMDIChild and ProgressBar control on runtime - my sample for remember good-times

Forms-MDI-and-Child-with-Control-Created-in-Run-Time.png

[SHOWTOGROUPS=4,19,20]

https://www.mirrored.to/files/1EEKOSYN/VCL_Forms_MDI_and_Creating_Controls_On_RunTime.zip_links

[/SHOWTOGROUPS]

emailx45 · Feb 12, 2020

TEdit accepting only FLOAT values or NOT and some keys from User (NUMBERs, DOT, COMMA, ENTER, BACKSPACE, ESC, etc..)
NOTE: NOT PERFECT OK!

Here my simple TEDIT sample for this, of course, is possible using a code more xpert like create a class to automatize all process, or same, use new functions/procedure on RAD Studio 10.3.3 Rio.

View attachment 525

Code:
[SHOWTOGROUPS=4,19,20]

Code:

unit Unit1;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    lbTextTyped: TLabel;
    lbKeyPressed: TLabel;
    Edit2: TEdit;
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// 0,1,2,3,4,5,6,7,8,9,",", "-", ".", "ENTER", "BACKSPACE", "ESC"
// You can use some like: "0".."9", etc... of course!
const
  lMyCharsAllowed = [Char(48), Char(49), Char(50), Char(51), Char(52), Char(53), { }
  { -------------- } Char(54), Char(55), Char(56), Char(57), Char(44), Char(45), { }
  { -------------- } Char(46), Char(13), Char(8), Char(27)                       { }
    ];
  //
  lDontRepeatThis = [Char(44), Char(45), Char(46)]; // Dont repeat ",-."

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var
  lText: string;
begin
  //
  lbKeyPressed.Caption := 'Key pressed: ' + Ord(Key).ToString;
  //
  lText := Trim((Sender as TEdit).Text); // only help me on tests!
  //
  if not(Key in lMyCharsAllowed) or                         { Accept only my chars, ok! }
    ((Key in lDontRepeatThis) and (Pos(Key, lText) > 0)) or { Don't repeat this chars! }
    ((Key = Char(45)) and (Length(lText) > 0)) or           { Minus, only on first char }
    ((Key = Char(44)) and (Pos(Char(46), lText) > 0)) or    { If it have Comma, dont accept Dot }
    ((Key = Char(46)) and (Pos(Char(44), lText) > 0)) then  { If it have Dot, dont accept Comma }
  begin
    Key := #0;
    Exit;
  end;
  //
  if not(Key = Char(8)) then // BACKSPACE dont appears on my resulted!
    lbTextTyped.Caption := lText + Key;
  //
  if (Key = Chr(13)) then // ENTER... What's happens?
    perform(WM_NEXTDLGCTL, 0, 0);
end;

end.

[/SHOWTOGROUPS]

emailx45 · Feb 29, 2020

My sample to create your "re-TRY" another or same command line: like "try reconnect again my login"

[SHOWTOGROUPS=4,19,20]

Code:

procedure TForm2.Button1Click(Sender: TObject);
var
  lMyCounter: integer;
begin
  lMyCounter := 0;
  //
  while (lMyCounter <= 3) do // or "While True do ...." for exit, use "break" for example!
  begin
    // Here, you can use another value than "WSDL_a" if not needs test 1, 2, and 3 way! Like your "Case test"!
    Inc(lMyCounter); // start in 1... because your Array of options!
    //
    if (lMyCounter <= 3) then // avoid any call unnecessary
    begin
      try
        Label3.Caption := Format('My contador: %d', [lMyCounter]);
        //
        ShowMessage(Format('Counter %d', [lMyCounter])); // for test on screen!
        //
        StrToInt('22a'); // simulating errors and call "except section"!
        //
      except
        // raise; // re-raise the exception if necessary!
        continue;
        {
          Note: "Continue" does not violate the flow of control dictated by a try..finally construct.
          If a call to "Continue" causes the control to leave the try clause, the finally clause is entered.
        }
      end;
      //
      // Inc(wsdl_a); // never... infinite looping!
      //
    end;
  end;
  //
  ShowMessage(Format('End procedure! No more try!'#13#10'Counter: %d', [lMyCounter]));
end;

View attachment 531

[/SHOWTOGROUPS]

emailx45 · Mar 19, 2020

Here my sample to works with Class Helper to Strings to divide it in "before" and "after" Delimiter char! - very easy!

View attachment 579

View attachment 580

Code:

unit uMainForm;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    btnUsinSPLIT_function: TButton;
    ListBox1: TListBox;
    btnUsingListBox: TButton;
    ListBox2: TListBox;
    Memo1: TMemo;
    btnMyNewSplitStrings: TButton;
    procedure btnUsinSPLIT_functionClick(Sender: TObject);
    procedure btnUsingListBoxClick(Sender: TObject);
    procedure btnMyNewSplitStringsClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnUsinSPLIT_functionClick(Sender: TObject);
var
  lMyArraySpplited: TArray<string>;
  lMyRegKey       : string;
  lNewRegKey      : string;
  i               : Integer;
  lLastDelimiter  : integer;
begin
  memo1.Lines.Clear;
  //
  // if lMyRegKey = ''  or '\'  -> it's necessary verify too!
  // But DONT problem if lLastDelimiter <= 0
  // on the end, your "string" resulted can be EMPTY!
  // None exception will be raised!
  //
  lMyRegKey := 'part1\part2\part3\value';
  //
  lMyArraySpplited := lMyRegKey.Split(['\']);
  //
  lLastDelimiter := lMyRegKey.LastDelimiter('\') + 1; // +1 here or below (Rigth substring)
  //
  memo1.Lines.Add('SubString Left  = ' + lMyRegKey.Substring(-lLastDelimiter, lLastDelimiter));
  memo1.Lines.Add('SubString Right = ' + lMyRegKey.Substring(lLastDelimiter));
  //
  memo1.Lines.Add('LastDelimiter = ' + lMyRegKey.LastDelimiter('\').ToString);
  //
  memo1.Lines.Add('');
  //
  lNewRegKey := lMyRegKey.Join('\', lMyArraySpplited, 0, 2); // "part1\part2"
  //
  memo1.Lines.Add('Join 0 to 2 = ' + lNewRegKey);
  //
  lNewRegKey := lMyRegKey.Join('\', lMyArraySpplited, 3, 4); // "value"
  //
  memo1.Lines.Add('Join 3 to 4 = ' + lNewRegKey);
  //
  memo1.Lines.Add('');
  //
  for i := 0 to high(lMyArraySpplited) do
  begin
    if lMyArraySpplited[i] <> '' then
      memo1.Lines.Add(lMyArraySpplited[i]);
  end;
end;

procedure TForm1.btnMyNewSplitStringsClick(Sender: TObject);
var
  lMyRegKey       : string;
  lMyArraySpplited: TArray<string>;
begin
  Memo1.Lines.Clear;
  //
  lMyRegKey := 'part1\part2\part3\value';
  //
  // start from "1" and ending on "3" chars!
  // using "\" like my "Delimiter" to split my string!
  //
  lMyArraySpplited := lMyRegKey.Split(['\'], '1', '3', Length(lMyRegKey));
  //
  Memo1.Lines.Add('How many items SPLITTED = ' + Length(lMyArraySpplited).ToString);
  Memo1.Lines.Add('');
  Memo1.Lines.Add('my items:');
  //
  Memo1.Lines.AddStrings(lMyArraySpplited); // working with my items splitted (my array)
end;

procedure TForm1.btnUsingListBoxClick(Sender: TObject);
var
  lMyRegKey: string;
begin
  lMyRegKey := 'part1\part2\part3\value';
  //
  ListBox1.Items.Delimiter     := '\';
  ListBox1.Items.DelimitedText := lMyRegKey;
  //
  ListBox2.Items.Clear;
  ListBox2.Items.Add(ListBox1.Items[3]);
  //
  // another ways can help too, when using a "List"
  //
  // ListBox1.Items.IndexOf('first position to start')
  // ListBox1.Items.IndexOf('last position to end')
  // ShowMessage(ListBox1.Items.KeyNames[2]);
end;

end.

emailx45 · Mar 25, 2020

Creating a "counter" to close your "Active window", like MessageDLG using SetTimer() and PostMessage() from API Windows
Code by Žarko Gajić (MVP Embarcadero)

[SHOWTOGROUPS=4,19,20]

View attachment 620

Code:

unit uMainForm;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.Menus,
  Vcl.Buttons,
  Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Arquivo1: TMenuItem;
    Opc11: TMenuItem;
    Opc21: TMenuItem;
    Opc31: TMenuItem;
    N1: TMenuItem;
    Opc41: TMenuItem;
    Help1: TMenuItem;
    Opc12: TMenuItem;
    Opc22: TMenuItem;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  System.UITypes, // msg buttons
  Vcl.Consts;     // SMsgDlgInformation

//********************************************************************
// Code by Žarko Gajić  (MVP Embarcadero)
//********************************************************************

function MessageDlgTimed(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint; const closePeriod: integer = 2000): Integer;
var
  timerCloseId: UINT_PTR;

  procedure CloseMessageDlgCallback(AWnd: HWND; AMsg: UINT; AIDEvent: UINT_PTR; ATicks: DWORD); stdcall;
  var
    activeWnd: HWND;
  begin
    KillTimer(AWnd, AIDEvent);

    activeWnd := GetActiveWindow;

    if IsWindow(activeWnd) and IsWindowEnabled(activeWnd) then
      PostMessage(activeWnd, WM_CLOSE, 0, 0);
  end; (* CloseMessageDlgCallback *)

begin
  timerCloseId := SetTimer(0, 0, closePeriod, @CloseMessageDlgCallback);
  //
  result := MessageDlg(Msg + ', ' + closePeriod.ToString + 'ms to destroy itself', DlgType, Buttons, HelpCtx);
  //
  if timerCloseId <> 0 then
    KillTimer(0, timerCloseId);
end;

//********************************************************************
function HookResourceString(ResStringRec: pResStringRec; NewStr: pChar): integer;
var
  OldProtect: DWORD;
begin
  VirtualProtect(ResStringRec, SizeOf(ResStringRec^), PAGE_EXECUTE_READWRITE, @OldProtect);
  result                   := ResStringRec^.Identifier;
  ResStringRec^.Identifier := Integer(NewStr);
  VirtualProtect(ResStringRec, SizeOf(ResStringRec^), OldProtect, @OldProtect);
end;

procedure UnHookResourceString(ResStringRec: pResStringRec; oldData: integer);
var
  OldProtect: DWORD;
begin
  VirtualProtect(ResStringRec, SizeOf(ResStringRec^), PAGE_EXECUTE_READWRITE, @OldProtect);
  ResStringRec^.Identifier := oldData;
  VirtualProtect(ResStringRec, SizeOf(ResStringRec^), OldProtect, @OldProtect);
end;

function MessageDlgTimedAdvanced(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint; const closePeriod: integer = 5000): Integer;
const
  tickPeriod = 250;
var
  timerCloseId, timerTickId: UINT_PTR;
  r                        : integer;
  peekMsg                  : TMsg;

  procedure CloseMessageDlgCallback(AWnd: HWND; AMsg: UINT; AIDEvent: UINT_PTR; ATicks: DWORD); stdcall;
  var
    activeWnd: HWND;
  begin
    KillTimer(AWnd, AIDEvent);

    activeWnd := GetActiveWindow;

    if IsWindow(activeWnd) and IsWindowEnabled(activeWnd) then
      PostMessage(activeWnd, WM_CLOSE, 0, 0);
  end; (* CloseMessageDlgCallback *)

  procedure PingMessageDlgCallback(AWnd: HWND; AMsg: UINT; AIDEvent: UINT_PTR; ATicks: DWORD); stdcall;
  var
    activeWnd     : HWND;
    wCaption      : string;
    wCaptionLength: integer;
  begin
    activeWnd := GetActiveWindow;
    if IsWindow(activeWnd) and IsWindowEnabled(activeWnd) and IsWindowVisible(activeWnd) then
    begin
      wCaptionLength := GetWindowTextLength(activeWnd);
      SetLength(wCaption, wCaptionLength);
      GetWindowText(activeWnd, PChar(wCaption), 1 + wCaptionLength);
      SetWindowText(activeWnd, Copy(wCaption, 1, -1 + Length(wCaption)));
    end
    else
      KillTimer(AWnd, AIDEvent);
  end; (* PingMessageDlgCallback *)

//
begin
  if (DlgType = mtInformation) and ([mbOK] = Buttons) then
  begin
    timerCloseId := SetTimer(0, 0, closePeriod, @CloseMessageDlgCallback);

    if timerCloseId <> 0 then
    begin
      timerTickId := SetTimer(0, 0, tickPeriod, @PingMessageDlgCallback);

      if timerTickId <> 0 then
        r := HookResourceString(@SMsgDlgInformation, PChar(SMsgDlgInformation + ' ' + StringOfChar('.', closePeriod div tickPeriod)));
    end;

    result := MessageDlg(Msg, DlgType, Buttons, HelpCtx);

    if timerTickId <> 0 then
    begin
      KillTimer(0, timerTickId);
      UnHookResourceString(@SMsgDlgInformation, r);
    end;

    if timerCloseId <> 0 then
      KillTimer(0, timerCloseId);
  end
  else
    result := MessageDlg(Msg, DlgType, Buttons, HelpCtx);
end;

//********************************************************************
procedure TForm1.Button2Click(Sender: TObject);
begin
  MessageDlgTimedAdvanced('string', mtInformation, [mbOK], 0, 5000); // ok
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  MessageDlgTimed('string', mtInformation, [mbYes], 0, 4000); // ok
end;

end.

[/SHOWTOGROUPS]

emailx45 · Mar 29, 2020

Memory 3D – Full Source Code Delphi Game
by Žarko Gajić (MVP Embarcadero)

[SHOWTOGROUPS=4,19,20]

View attachment 654

“If you want it to be playable and more interesting you need to jazz it up a bit!”
That’s what’s been cooking in my head from the time I’ve finished implementing the back end for the game of Memory (Match Up, Concentration, or whatever you are used to call it). As a proof of concept, I’ve coded a very simple application, aka the front end for the game – juts to have a workable user interface.

Now, the time has come to finish the series and introduce a more eye candy version of the game, one that’s not using dull buttons with numbers for field display values but that actually looks like card game type of Memory, with nice fancy images/icons for game fields. Why stop there? Why not go a step forward and introduce a new dimension for the game: make it 3D having fields appear on planes/layers, so players need to switch between planes to match a pair.

Memory 3D
Here’s the idea: in the standard Memory game, all fields containing game pairs, would be presented to the player at once. Meaning that if the game has 12 fields, that is 6 pairs, all 12 playable fields are visible and the player can pick from to find a match – so basically 2 dimensions: a number of rows and columns where fields are presented in a grid like fashion (say 4×3 for 12 fields).

What if I would to introduce one more, 3rd, dimension: a plane (a layer). So if the game has 8 pairs (16 fields) and 2 planes – only 8 fields are visible/presented to the player at one time. 8 fields on first plane, 8 more on the second plane. So one field of a pair can be on the first plane and the second field can be on the second plane. Player needs to switch between planes to find a match – remember the row and column but also the plane.

Sounds interesting, so let’s see the UI and some code …
For those living by the TL;DR: mantra: download full source code.

As stated I want to have some graphics displayed on each game field. For this purpose I’ve went to browse the https://www.freepik.com web site hosting some free to use icons and graphics. I was looking for some handy set of icons and have found one from @makyzz:

View attachment 655

There are 10×10 icons/glyphs here – quite enough as that would result in game of Memory of maximum 200 fields (100 pairs). I’ll store the entire image in a hidden “ClipImage” TImage control and will cut out the piece I need for a game field. Since field values would go from 0 to 99 the icon/glyph in second row, third column would have the index of 12. Here’s a function to get the image graphics for a field with the value of “fieldIndex”:

Code:

function TMainForm.GetFieldGraphics(const fieldIndex: integer): TPicture;
var
  clipWidth, clipHeight: Integer;
  srcRect, destRect: TRect;
begin
  clipWidth := ClipImage.Picture.Width div ClipColumns;
  clipHeight := ClipImage.Picture.Height div ClipRows;
  destRect := Rect(0, 0, clipWidth, clipHeight);
  srcRect.Left := (fieldIndex mod ClipColumns) * clipWidth;
  srcRect.Top := (fieldIndex div ClipRows) * clipHeight;
  srcRect.Right := srcRect.Left + clipWidth;
  srcRect.Bottom := srcRect.Top + clipHeight;
  PictureClip.Bitmap.Width := clipWidth;
  PictureClip.Bitmap.Height := clipHeight;
  PictureClip.Bitmap.Canvas.CopyRect(destRect, ClipImage.Canvas, srcRect);
  result := PictureClip;
end;

The UI
The user interface looks pretty much the same as in the 2D version of the game. We need to have a way to switch between planes so 2 more buttons added to the UI. Also, I’ve added some Display options: to display (or not) some field info like what plane are we one, what player has claimed the pair and alike.

View attachment 656

The New Game
Here’s how the game is created and started:

Code:

procedure TMainForm.btnNewGameClick(Sender: TObject);
var
  newGamePairs, newGamePlayers, newGamePlanes: integer;
  newGameFieldValueShift                     : integer;
begin
  Randomize;
  newGamePairs   := StrToInt(ledPairs.Text);
  newGamePlayers := StrToInt(ledPlayers.Text);;
  newGamePlanes  := StrToInt(ledPlanes.Text);;
  fClipImage     := imgImagesGrid100;
  fClipColumns   := 10;
  fClipRows      := 10;
  fMaxPairs      := fClipColumns * fClipRows;
  //
  if newGamePairs > MaxPairs then
  begin
    newGamePairs  := MaxPairs;
    ledPairs.Text := newGamePairs.ToString;
  end;
  //
  newGameFieldValueShift := Random(MaxPairs - newGamePairs + 1);
  //
  try
    MGame.NewGame(newGamePairs, newGamePlayers, newGamePlanes, newGameFieldValueShift);
  except
    on E: Exception do
    begin
      MessageDlg(E.Message, mtError, [mbOk], -1);
      Exit;
    end;
  end;
end;

Set the wanted number of fields, planes and players. The “newGameFieldValueShift” ensures we always pick random range of icons from the available set – so not to always use the same ones.
The MGame.NewGame would raise the OnGameCreate and OnGameStart events I’m using to setup the user interface. If the total number of fields (2 x number of pairs) is not dividable by the number of planes – the game would raise an exception and would not start.
The OnPlaneChaned even handler is the most interesting one as this is where the icons would be extracted:

Code:

procedure TMainForm.PlaneChanged(Sender: TObject);
var
  i     : integer;
  mField: TMField;
  pnl   : TPanel;
  img   : TImage;
  lbl   : TLabel;
begin
  lblCurrentPlane.Caption := Format('Current plane: %d of %d planes.', [MGame.CurrentPlane, MGame.PlanesCount]);
  // set field hosts for current plane
  for i := 0 to -1 + gameGrid.ControlCount do
  begin
    mField := MGame.Fields[i + MGame.FirstFieldIndexOnCurrentPlane];
    pnl    := TPanel(gameGrid.Controls[i]);
    img    := TImage(pnl.Controls[0]);
    lbl    := TLabel(pnl.Controls[1]);
    if chkShowPlaneInfo.Checked then
    begin
      lbl.Caption := Format('%d / %d / %d', [i + 1, MGame.CurrentPlane, MGame.PlanesCount]);
      lbl.Visible := MGame.PlanesCount > 1;
    end
    else
      lbl.Visible := false;
    //
    mField.Host := img;
    //
    if mField = MGame.OpenedField then
    begin
      pnl.BevelKind := bkTile;
      TImage(mField.Host).Picture.Assign(GetFieldGraphics(mField.Value))
    end
    else
      if mField.Player <> nil then
      begin
        pnl.BevelKind := bkNone;
        TImage(mField.Host).Picture.Assign(GetFieldGraphics(mField.Value));
        if chkShowClaimedInfo.Checked then
        begin
          lbl.Caption := Format('%s', [mField.Player.Name]);
          lbl.Visible := true;
        end;
      end
      else
      begin
        pnl.BevelKind := bkTile;
        TImage(mField.Host).Picture.Assign(imgQuestionField.Picture);
        // TImage(mField.Host).Picture.Assign(GetFieldGraphics(mField.Value))
      end;
  end;
  //
  pnlGameGrid.Refresh;
  //
end;

The rest of the code is more or less the same as in the 2D version of the game.
Hope you like it and if you do a FireMonkey version for mobiles – do share

[/SHOWTOGROUPS]

emailx45 · Mar 30, 2020

My sample to simple way to verify some info about your Wifi connection using new way to ask permissions on Android (7.0 - Nougat)
thanks to FMX Express forum!!!

Dont forget mark your permissions used on Project - Option in your project.

View attachment 668

[SHOWTOGROUPS=4,19,20]

Code:

unit uMainForm;

interface

uses
  System.SysUtils,
  System.Types,
  System.UITypes,
  System.Classes,
  System.Variants,
  System.Permissions, {permissions to app}
  FMX.Types,
  FMX.Controls,
  FMX.Forms,
  FMX.Graphics,
  FMX.Dialogs,
  FMX.Controls.Presentation,
  FMX.StdCtrls,
  FMX.ScrollBox,
  FMX.Memo;

type
  TFormMain = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    // FPermissionCamera              : string;
    // FPermissionReadExternalStorage : string;
    // FPermissionWriteExternalStorage: string;
    //
    FPermissionWifiState: string;
    //
    procedure DisplayRationale(Sender: TObject; const APermissions: TArray<string>; const APostRationaleProc: TProc);
    procedure MyPermissionsRequestResult(Sender: TObject; const APermissions: TArray<string>; const AGrantResults: TArray<TPermissionStatus>);
    //
{$IFDEF ANDROID}
    procedure prcWifiInfo;
{$ENDIF}
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

{$R *.fmx}

uses
  FMX.DialogService
{$IFDEF ANDROID},
  FMX.Helpers.Android,
  Androidapi.JNI.JavaTypes,
  AndroidApi.Helpers,
  AndroidApi.JNI.OS,
  AndroidApi.JNI.net,
  Androidapi.JNI.GraphicsContentViewText,
  Androidapi.JNIBridge
{$ENDIF}
    ;

{ How to working with new way when asking permission in Android:
  0 - Always inform to the user that permissions your app needs. When it needs it!
  1 - Define what permissions your app needs!
  2 - Ask the permissions when needs! // Android can help here asking only 1x to user!
  3 - Test if your permissions is allowed!
}

procedure TFormMain.Button1Click(Sender: TObject);
begin
  // ...testing only in Android
{$IFDEF ANDROID}
  // Asking permission to access "YOUR NECESSITY" in your Android...
  PermissionsService.RequestPermissions( { }
    [FPermissionWifiState],              { <--- ... I need this permission [ a, b, c, d, ...] }
    MyPermissionsRequestResult,          { <-- callback function to each permission }
    DisplayRationale                     { <-- to show the message for each permission - Always Non-Modal!!! }
    );
{$ENDIF}
end;

procedure TFormMain.DisplayRationale(Sender: TObject; const APermissions: TArray<string>; const APostRationaleProc: TProc);
var
  I           : Integer;
  RationaleMsg: string;
begin
  for I := 0 to high(APermissions) do
  begin
    if APermissions[I] = FPermissionWifiState then
      RationaleMsg := RationaleMsg + 'The app needs to access your "<<YOUR NECESSITY HERE>>"' + SLineBreak + SLineBreak;
  end;
  //
  // Show an explanation to the user *asynchronously* - don't block this thread waiting for the user's response!
  // After the user sees the explanation, invoke the post-rationale routine to request the permissions
  //
  TDialogService.ShowMessage(RationaleMsg,
    procedure(const AResult: TModalResult)
    begin
      // TProc is defined in System.SysUtils
      //
      APostRationaleProc; // used by System to go-back in before function...
    end)
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
{$IFDEF ANDROID}
  // FPermissionCamera               := JStringToString(TJManifest_permission.JavaClass.CAMERA);
  // FPermissionReadExternalStorage  := JStringToString(TJManifest_permission.JavaClass.READ_EXTERNAL_STORAGE);
  // FPermissionWriteExternalStorage := JStringToString(TJManifest_permission.JavaClass.WRITE_EXTERNAL_STORAGE);
  //
  FPermissionWifiState := JStringToString(TJManifest_permission.JavaClass.ACCESS_WIFI_STATE); // dont need ask permission!
{$ENDIF}
end;

procedure TFormMain.MyPermissionsRequestResult(Sender: TObject; const APermissions: TArray<string>; const AGrantResults: TArray<TPermissionStatus>);
begin
  // 1 permission = ACCESS_WIFI_STATE
  if (Length(AGrantResults) = 1) and               { }
    (AGrantResults[0] = TPermissionStatus.Granted) { }
  then
{$IFDEF ANDROID}
    prcWifiInfo { execute your procedure here if all it's ok }
{$ENDIF}
  else
    TDialogService.ShowMessage('The permission <<YOUR NECESSITY HERE>>  not allowed by user'); // msg to ACCESS_WIFI_STATE, for example
end;

{$IFDEF ANDROID}

procedure TFormMain.prcWifiInfo;
var
  WifiManagerObj: JObject;
  WifiManager   : JWifiManager;
  WifiInfo      : JWifiInfo;
begin
  WifiManagerObj := SharedActivityContext.getSystemService(TJContext.JavaClass.WIFI_SERVICE);
  //
  WifiManager := TJWifiManager.Wrap((WifiManagerObj as ILocalObject).GetObjectID);
  //
  WifiInfo := WifiManager.getConnectionInfo();
  //
  Memo1.Lines.Clear;
  Memo1.Lines.Add('FPermissionWifiState = ' + FPermissionWifiState);
  Memo1.Lines.Add('Wifi Enabled: ' + WifiManager.isWifiEnabled.ToString);
  Memo1.Lines.Add('Wifi State: ' + WifiManager.getWifiState.ToString);
  Memo1.Lines.Add('Ping Supplicant: ' + WifiManager.pingSupplicant.ToString);
  Memo1.Lines.Add('BSSID: ' + JStringToString(WifiInfo.getBSSID));
  Memo1.Lines.Add('HiddenSSID: ' + WifiInfo.getHiddenSSID.ToString);
  Memo1.Lines.Add('IpAddress: ' + WifiInfo.getIpAddress.ToString);
  Memo1.Lines.Add('LinkSpeed: ' + WifiInfo.getLinkSpeed.ToString + 'Mbps');
  Memo1.Lines.Add('MacAddress: ' + JStringToString(WifiInfo.getMacAddress));
  Memo1.Lines.Add('NetworkId: ' + WifiInfo.getNetworkId.ToString);
  Memo1.Lines.Add('Rssi: ' + WifiInfo.getRssi.ToString + 'dBm');
  Memo1.Lines.Add('SSID: ' + JStringToString(WifiInfo.getSSID));
  Memo1.Lines.Add('SupplicantState: ' + JStringToString(WifiInfo.getSupplicantState.toString));
end;
{$ENDIF}

end.

[/SHOWTOGROUPS]

emailx45 · Apr 1, 2020

Auto-start custom Android applications
- Not necessary any change on sources Android!

[SHOWTOGROUPS=4,19,20]
thanks to Digi International Inc. (2019)

Auto-start custom Android applications

When creating customized Android firmware, you must typically launch a specific Android application after system boots. Android has two mechanisms for this:

Start an application after Android boot:
Valid for a standard Android system with multiple applications.
No need to modify and compile Android sources.
Replace the default Android Home application:
Recommended if your system consists only of this application.
May require you to modify and compile Android sources.
Start an application after Android boot

When an Android system boots, it sends out a boot complete event. Android applications can listen and capture this event to take specific actions, such as automatically starting an activity or service.

You can use this mechanism to create an application with the required permissions to listen for the boot complete event and automatically start an activity or service every time Android starts up. To do so, follow these steps:

Declare the permission in AndroidManifest.xml. Add the android.permission.RECEIVE_BOOT_COMPLETED permission to your application's manifest file just before the application declaration node:
AndroidManifest.xml

Code:

<uses-permission android:name="android.permission.RECEIVE_BOOT_COMPLETED" />

Define the Activity that will be auto-started in the AndroidManifest.xml. Place this declaration inside the application node:
AndroidManifest.xml

Code:

<activity
    android:name=".MyActivity"
    android:label="@string/app_name">
    <intent-filter>
        <action android:name="android.intent.action.MAIN" />
        <category android:name="android.intent.category.LAUNCHER" />
    </intent-filter>
</activity>

Register the Receiver listening for the boot complete event in the AndroidManifest.xml. Place this declaration inside the application node:
AndroidManifest.xml

Code:

<receiver
    android:name=".StartMyActivityAtBootReceiver"
    android:label="StartMyServiceAtBootReceiver">
    <intent-filter>
        <action android:name="android.intent.action.BOOT_COMPLETED" />
    </intent-filter>
</receiver>

Create the receiver class to listen for the boot complete event. This class must extend BroadcastReceiver abstract class. Its onReceive() method is called when the device boot is complete. For example, create a Java class called StartMyActivityAtBootReceiver.java and place it in the same package as the activity class to auto-start:

Code:

StartMyActivityAtBootReceiver
public class StartMyActivityAtBootReceiver extends BroadcastReceiver {
    @Override
    public void onReceive(Context context, Intent intent) {
        if (Intent.ACTION_BOOT_COMPLETED.equals(intent.getAction())) {
            Intent activityIntent = new Intent(context, MyActivity.class);
            activityIntent.setFlags(Intent.FLAG_ACTIVITY_NEW_TASK);
            context.startActivity(activityIntent);
        }
    }
}

When this class receives an intent, it checks if it is the ACTION_BOOT_COMPLETE. If so, it creates a new activity intent and fills it with the activity class to be started. Finally, it executes the startActivity() method using the Android context and the activity intent.

Note Due to security reasons, Android does not auto-start any application until you manually launch it at least once. After that, the applications will automatically start on each Android boot.

Replace the default Android Home application
The home screen you see on your Android device after boot is a standard application that reacts to a home event. When Android finishes booting and is ready to start the home activity, the home event is sent and qualifying applications identify themselves as bootable candidates.

The system sends out the android.intent.category.HOME and android.intent.category.DEFAULT intents when it is done initializing.

Android looks for application manifests with these intent filters when it starts up. If there is more than one, Android lists all of them and allows you to select the one to launch.

In order to designate your application as a home application, follow these steps:

Add the intent filters to AndroidManifest.xml. Copy these two lines into the intent filter of your application main activity:

Code:

<category android:name="android.intent.category.HOME" />
<category android:name="android.intent.category.DEFAULT" />

Your main activity definition should look similar to the following:

AndroidManifest.xml

Code:

<activity
    android:name=".MyActivity"
    android:label="@string/app_name">
    <intent-filter>
        <action android:name="android.intent.action.MAIN" />
        <category android:name="android.intent.category.HOME" />
        <category android:name="android.intent.category.DEFAULT" />
        <category android:name="android.intent.category.LAUNCHER" />
    </intent-filter>
</activity>

Install your application in the device. On the next startup, Android displays a dialog box that allows you to choose between the default Android launcher and the application you just modified:

View attachment 684

Note You can set your selection as the default home application for the future.

Replace default Home application with a custom application in sources
The Replacing the default Android Home procedure is only valid for already-deployed Android systems. If you want to deploy an Android system with a custom home application already designated, you must make additional changes to the Android BSP sources:

Create a custom home application and include it in the Android BSP sources. You can directly include the application source code or a pre-compiled version of it.
Note Verify that your custom Android home application includes the android.intent.category.HOME and android.intent.category.DEFAULT intent filters in the application manifest file.

Force your application to override the default launcher applications. Add the following entry in your application's Android.mk file just before the include $(BUILD_PACKAGE) line:

Code:

LOCAL_OVERRIDES_PACKAGES := Home Launcher2 Launcher3

Your application's Android.mk file should look similar to the following:

Android.mk

Code:

LOCAL_PATH := $(call my-dir)
include $(CLEAR_VARS)
LOCAL_MODULE_TAGS := optional
LOCAL_STATIC_JAVA_LIBRARIES := android-common android-support-v13
LOCAL_SRC_FILES := $(call all-java-files-under, src) $(call all-renderscript-files-under, src)
LOCAL_SDK_VERSION := current
LOCAL_PACKAGE_NAME := MyApplication
LOCAL_CERTIFICATE := shared
LOCAL_PRIVILEGED_MODULE := true
LOCAL_OVERRIDES_PACKAGES := Home Launcher2 Launcher3
include $(BUILD_PACKAGE)

Include your application in the Android firmware build. Add your application's module name "MyApplication" (as defined in the LOCAL_PACKAGE_NAME of your Application's Android.mk file) to the list of packages of the firmware at device/digi/imx6_ccimx6_sbc/imx6_ccimx6_sbc.mk:
imx6_ccimx6_sbc.mk

Code:

[...]
PRODUCT_PACKAGES += MyApplication
[...]

Build the Android firmware. Issue this command sequence in the root folder of the Android sources.
Clean the artifacts from the previous build:

Code:

$ make installclean
Build the Android firmware:$ make -j<Number_Of_Jobs>

<Number_Of_Jobs> is the number of cores you want to use for the build process.

The resulting firmware will boot your custom Android home application by default.

[/SHOWTOGROUPS]

emailx45 · Apr 1, 2020

Easy way to save and use your Week Day in BIN format and reversing it to string:
like:

my StrigBin initial:1101010
my ShortDayNames used in Bin string: sun, mon, wed fri
my StringBin recreated: 1101010

View attachment 700

[SHOWTOGROUPS=4,19,20]

Code:

procedure TForm1.Button1Click(Sender: TObject);
var
  lFS                      : TFormatSettings;
  i, z                     : integer;
  lMyStringBin             : string;
  lMyStringShortCutDayNames: string;
  lMyArrayString           : TArray<string>;
  //
begin
  Memo1.Lines.Clear;
  //
  lFS := TFormatSettings.Create('pt-BR');
  //
  // It should accept ONLY THIS FORMAT using  0 and 1 chars OK??? because this is the propose here
  /
  lMyStringBin              := '0101010'; // bin = 8 - 1 = 7 digits {"0" to mostleft is not used if you want!!!}
  lMyStringShortCutDayNames := '';
  //
  Memo1.Lines.Add('my StrigBin initial:' + lMyStringBin);
  //
  for I := 0 to 6 do // char[ is "0" based ]
  begin
    if lMyStringBin.Chars[i] <> '0' then
      lMyStringShortCutDayNames := lMyStringShortCutDayNames + ' ' + lFS.ShortDayNames[i + 1]; // 1..7 else 0 = Month-Name
  end;
  //
  Memo1.Lines.Add('my ShortDayNames used in Bin string: ' + Trim(lMyStringShortCutDayNames));
  //
  lMyArrayString := Trim(lMyStringShortCutDayNames).Split([' ']);
  //
  lMyStringBin := lMyStringBin.Create('0', 7);
  //
  for i := 1 to 7 do
  begin
    for z := 0 to 6 do // high(lMyArrayString)
      if lFS.ShortDayNames[i].Contains(lMyArrayString[z]) then
      begin
        lMyStringBin[i] := '1';
        break;
      end;
  end;
  //
  Memo1.Lines.Add('my StringBin recreated: ' + lMyStringBin);

  // change names order...
  lFS.ShortDayNames[1] := 'Mon';
  Memo1.Lines.Add(lfs.Invariant.ShortDayNames[1]); // Invariant order!!! only English locale!
  Memo1.Lines.Add(lfs.ShortDayNames[1]);
  //
  end;

[/SHOWTOGROUPS]

emailx45 · Apr 3, 2020

Quick Tip: Fixing “Could not convert variant of type (Null) into type…”
thansk to CodeSmithing

...I often use the XML Data Binding wizard in Delphi. However, it doesn’t seem to have been given a lot of attention from Borland/Inprise/Borland/CodeGear/Embarcadero/Idera. And unfortunately, out of the box what it generates is often error prone, apparently not supporting optional elements/attributes.

[SHOWTOGROUPS=4,19,20]
When the generated code tries to read an optional element or attribute, you will get a “Could not convert variant of type (Null) into type” exception.
The offending code usually looks like this:

Code:

function TXMLMyType.Get_OptionalElement: Single;
begin
    Result := ChildNodes['OptionalName'].NodeValue;
end;

If you do a little googling, you will see that people are still asking questions about this even pretty recently. The suggested fix you will often discover is labor intensive if you have a lot of optional elements/attributes and will get wiped out if you rerun the XML Data Binding wizard:

Code:

if VarIsNull(ChildNodes['selected'].NodeValue) then
    Result := 0; // or false or empty string, etc
else
    Result := ChildNodes['selected'].NodeValue;

Hilariously in my mind, there is still an open ticket from 2002 about this issue: http://qc.embarcadero.com/wc/qcmain.aspx?d=2434
However, it seems the <insert-company-name-which-owns-Delphi> addressed this issue, probably years ago, and the fix/workaround is easy. You need to include the Variants unit and set the NullStrictConvert global variable to false:

Code:

    NullStrictConvert := False

As the documentation states:

NullStrictConvert determines the outcome of attempts to convert Null variants to other types.
If NullStrictConvert is true (default), attempting to convert a Null variant raises a EVariantTypeCastError, unless the conversion is to a custom variant that defines a conversion from Null. If NullStrictConvert is false, then conversion from Null follows the following rules

Now, the XML Data Binding code will silently convert NULL to 0, false, or empty string without a problem. I wanted to publicize this fix. I have been bitten by this exception more times than I can count and if I had known of the workaround, it would have made my life much easier.

That’s it for today. I hope everyone is enjoying their Summer (or Winter in the southern hemisphere).

Thanks to CodeSmithing!
[/SHOWTOGROUPS]

emailx45 · Apr 6, 2020

Easy way to change your StatusBar color on Android app by ZuBy
Developer ZuBy has made some demo code available for changing the StatusBar color on Android in your apps.
The status bar is the bar at the top of your device with the various icons and other information in it.

[SHOWTOGROUPS=4,19,20]
In a Java based Android app to change StatusBar color you can do it either by modifying the styles.xml file and adding the following line:

View attachment 746

Code:

<item name=”android:statusBarColor”>@color/color_primary</item>

or by changing at runtime (implementations may differ) through code using:

Code:

window.setStatusBarColor(activity.getResources().getColor(R.color.my_statusbar_color)).

However, in FireMonkey you must use the JNI (Java Native Interface).

JNI enables Java code running in a Java Virtual Machine (JVM) to call and be called by native applications (programs specific to a hardware and operating system platform) and libraries written in other languages.

Thus, you can call JNI Java code from Delphi 10 Berlin with FireMonkey and make the necessary changes.

In order to make use of this change, make sure you are using Android 5 (Lollipop) and above.

This code does not apply to Windows, IOS, or OSX.

Notice that the code bellow is very similar to the Java implementation on Android.

Code:

procedure StatusBarSetColor(const aColor: TAlphaColor);
{$IFDEF ANDROID}
var
  Window: JWindowExt;
{$ENDIF}
begin
{$IFDEF ANDROID}
  CallInUIThread(
    procedure
    begin
      if TOSVersion.Check(5, 0) then
      begin
        Window := GetWindowExt;
        Window.addFlags(TJWindowManager_LayoutParams.JavaClass.FLAG_TRANSLUCENT_STATUS);
        Window.addFlags(TJWindowManager_LayoutParamsExt.JavaClass.FLAG_DRAWS_SYSTEM_BAR_BACKGROUNDS);

        Window.setFlags(TJWindowManager_LayoutParams.JavaClass.FLAG_TRANSLUCENT_STATUS,
          TJWindowManager_LayoutParams.JavaClass.FLAG_TRANSLUCENT_STATUS);
        Window.setFlags(TJWindowManager_LayoutParamsExt.JavaClass.FLAG_DRAWS_SYSTEM_BAR_BACKGROUNDS,
          TJWindowManager_LayoutParamsExt.JavaClass.FLAG_DRAWS_SYSTEM_BAR_BACKGROUNDS);

        Window.setStatusBarColor(TJcolor.JavaClass.TRANSPARENT); );
      end;
    end);
{$ENDIF}
{$IFDEF IOS}
  SetStatusBarBackgroundColor(aColor);
{$ENDIF}
end;

Full Source for Android and iOS on my GitHub
https://github.com/rzaripov1990/StatusBar

updated

https://www31.zippyshare.com/v/UgaaKxst/file.html

[/SHOWTOGROUPS]

emailx45 · Apr 6, 2020

Android ADB Terminator (code source)
If you need terminate ADB for any error while compiling (by Ray Vecchio)

[SHOWTOGROUPS=4,19,20]
Embarcadero - Code Central

ID: 30160, A tool to terminate Android ADB when it locks files in the IDE
by Ray Vecchio

- For Delphi, Version 12.0 (it can works in later editions) - RAD Studo 10.3.3 Arch - It's WORKING for me!!!
- Updated on Fri, 11 Sep 2015 02:58:42 GMT
- Originally uploaded on Tue, 10 Mar 2015 08:28:19 GMT

DESCRIPTION
Under some circumstance it looks as if the Android ADB locks files and prevents the compilation or debugging of an application.

This package will add an option under the "Run" menu that will run adb and allow it to cleanly terminate any servers left running in on your system.

There is full source code to the package so you can modify it as you like, perhaps add call in the finalization code of the package to shut adb down when the IDE is closed too.

I changed the package to check if there is an adb running and NOT read the location from the registry.

Full sources:

https://www75.zippyshare.com/v/KALQJsba/file.html

[/SHOWTOGROUPS]

emailx45 · Apr 11, 2020

GeekAlarm!

GeekAlarm! is a unique way for you to keep track of when you should take a break while using your computer. By taking breaks you can increase your productivity, reduce eye strain, and allay fatigue. GeekAlarm! has varying degrees of break enforcement including passive, medium, and aggressive enforcement. This helpful utility is a must have for anyone that uses a computer for long periods of time.

[SHOWTOGROUPS=4,20]
This is a unique Delphi 25th Anniversary edition.
FMXExpress/GeekAlarm
[/SHOWTOGROUPS]

emailx45 · Apr 16, 2020

My simple way to show FireMonkey Forms in Fade effect - no Animate components!!!

View attachment 882

[SHOWTOGROUPS=4,20]

Code:

unit uFormMain;

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,
  FMX.Objects,
  FMX.Layouts;

type
  TfrmFormMain = class(TForm)
    btnCallFormSecond: TButton;
    Layout1: TLayout;
    btnHowManyFormsCreated: TButton;
    procedure btnCallFormSecondClick(Sender: TObject);
    procedure btnHowManyFormsCreatedClick(Sender: TObject);
  private
  public
  end;

var
  frmFormMain: TfrmFormMain;

implementation

{$R *.fmx}

uses
  uFormSecond;

procedure TfrmFormMain.btnCallFormSecondClick(Sender: TObject);
begin
  //
  btnCallFormSecond.Enabled := False; // avoid create anothers forms here! But dont worry = click many times to test!
  //
  frmFormSecond := TfrmFormSecond.Create(self);
  try
    Layout1.AddObject(frmFormSecond.Layout1);
    // frmFormSecond.Show; {not needs}
  finally
  end;
end;

procedure TfrmFormMain.btnHowManyFormsCreatedClick(Sender: TObject);
var
  i                   : integer;
  sFormsCreateOnMemory: string;
begin
  for I                  := 0 to (Screen.FormCount - 1) do
    sFormsCreateOnMemory := sFormsCreateOnMemory + Screen.Forms[i].ToString + #13#10;
  //
  ShowMessage(sFormsCreateOnMemory);
end;

end.

Code:

unit uFormSecond;

interface

uses
  System.SysUtils,
  System.Types,
  System.UITypes,
  System.Classes,
  System.Variants,
  FMX.Types,
  FMX.Controls,
  FMX.Forms,
  FMX.Graphics,
  FMX.Dialogs,
  FMX.Ani,
  FMX.Controls.Presentation,
  FMX.StdCtrls,
  FMX.ScrollBox,
  FMX.Memo,
  FMX.Objects,
  FMX.Layouts,
  FMX.ListBox,
  FMX.Edit;

type
  TfrmFormSecond = class(TForm)
    Panel1: TPanel;
    Timer1: TTimer;
    Edit1: TEdit;
    btnCloseMe: TButton;
    ListBox1: TListBox;
    Layout1: TLayout;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure btnCloseMeClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    iMyOpacityCount: Single;
  public
  end;

var
  frmFormSecond: TfrmFormSecond;

implementation

{$R *.fmx}

procedure TfrmFormSecond.btnCloseMeClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmFormSecond.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := TCloseAction.caFree;
end;

procedure TfrmFormSecond.FormCreate(Sender: TObject);
begin
  // Self.Visible      := False;
  Self.Transparency := True;                     // start transparent!!!
  Self.BorderStyle  := TFmxFormBorderStyle.None; // no borders!
  //
  Panel1.Opacity  := 0;   // like a transparen!!!
  Timer1.Interval := 100; // 01 sec Div 100 = delay-time to show my form!
  iMyOpacityCount := 0.3; // intervale to opacity!!!
end;

procedure TfrmFormSecond.Timer1Timer(Sender: TObject);
begin
  Panel1.Opacity := Panel1.Opacity + iMyOpacityCount;
  //
  Edit1.Text := TimeToStr(now) + ', ' + Panel1.Opacity.ToString;
  //
  // Single type Use this type for low accuracy floating-point operations!!!
  // if Panel1.Opacity > 1 then ... dont disable my timer!!!
  if Panel1.Opacity > 0.999 then // 0.99 can solve problem with "accuracy" compare
  begin
    Timer1.Enabled := false;
    Edit1.Text     := 'Timer disabled!';
    //
    // Self.Transparency := False; // <---
    // Self.Visible := True;
    //
    Exit;
  end;
end;

end.

code

https://mega.nz/file/ezpXUK6C#3kuDP0oSNJs-Un3yYaVQNDUNHjwlGDnU4PY_r4fv6KE

[/SHOWTOGROUPS]

emailx45 · Apr 19, 2020

Mobile GFX - Creating Icons and Launchers for Delphi Mobile Applications
by TGrubb

If you have ever tried to create the icons, spotlights, settings and launchers for Delphi Android and iOS applications, you have quickly realized that the process is fairly ridiculous.

There are 2 different platforms (iOS and Android), 3 different device types (iPhone, iPad, Android), and 7 different ratios (1:1, 1.33:1, etc) of icon/launcher graphic sizes all combining to require a whopping total of 28 different png files to be created (See Figure 1). Talk about taking the Rapid out of Rapid Application Development!

After doing this once, I realized that I never want to do that again. For my own sanity and yours, I have created a small little utility for quickly creating these 30 different png files and for helping fill in the Application Options page.
The utility works by allowing you to specify base image(s) for each graphic ratio, optionally defining what portion of the image to extract for each ratio, and then generating the png files. You have the option of creating iPhone, iPad, and/or Android files. In addition, the utility will even make the .optset files which Delphi uses to fill in the blanks (Click Apply… for each configuration and select the .optset file).
To use the Mobile Gfx Setup tool:
First, set up your images on the Graphics Tab

For each image ratio, enter or browse to an image file
Select the part of the image to be used for the format (shown in red)
Move the image selection around by Ctrl Dragging the red rectangle

Next, set up the output options from the Setup tab

Enter a base filename for the generated images. The tool will append the Width and Height of an image to this filename (e.g., ‘c:\junk.png’ becomes ‘c:\junk114x114.png’
Select which devices you want to generate images for
Finally, check the ‘Generate .optset file(s)’ checkbox if you want the .optset file generated which you can then later import into Delphi

Finally, generate your images from the Generate tab

When you go to the Generate tab, the tool will verify you have entered everything correctly
If validation has passed, click the Generate button to generate the images and, optionally, the .optset files (which will be called basename.android.optset and basename.ios.optset)

Finished!
If you generated the .optset file, do the following steps:

Load your Delphi project
Select Project->Options to show the project options (See Figure 1)
Click Application on the left to show application options
Change the Target configuration
Click the Apply… button
Browse to the .optset file
Modify the configuration and click OK!

[SHOWTOGROUPS=4,20]
I hope this is as useful to you as it is to me. Source and compiled executable: MobileGFXSetup.

Requests/comments/bug fixes can be sent to me at tgrubb AT RiverSoftAVG DOT com.

Happy CodeSmithing!

TGrubb

[/SHOWTOGROUPS]

emailx45 · Apr 19, 2020

Single File Data Storage (storing data-file in zip file like in SQLite way)
by coyoteelabs

Hi all, I've updated the library Single File Data Storage to work with all Delphi versions

About the library:

The Single File Data Storage library provides an efficient solution for an application to store many different types of data inside one file
able to access this data very fast and easily, without bothering about creating temporary files or streams (when requesting to read, the compressed data is decompressed on the fly directly from the source stream).

Look at the samples and in the help file to see how easy it is to use SFDS.

Features:

Single-file Virtual File System (read-only): SFDS files are ZIP like archive files (not really ZIP files) with enhanced functionality (see below). One or more SFDS files can be "mounted" in the application. Searching or requesting to open a stream for read will query all "mounted" files or you can just specify a single one.
Transparent streaming compression/decompression with full TStream compatibility.
Thread-safe (When reading from files): Read from multiple streams (located in the same SFDS file archive) at the same time (Just create a new clone of the stream in each thread - see demo).
High performance: SFDS is perfect for Games(and other applications such as backup, etc) which need to store many (usually small) files in just a small number of (big) archives. Storing data in a small number of SFDS files results in faster access time to data (When opening a SFDS file the list of streams inside is cached in memory), and also makes it harder to modify files inside.
Large file support (64-bit size) lets you store all the data you need in SFDS files of virtually unlimited size.
Supported compression types: none (stored), zlib, bzip2. New formats can easily be added.
Compression support is modular. Each application can chose to add only the compression it needs (if you need zlib compression/decompression simply add sfds_compressorzlib to the uses clause somewhere inside your project; add sfds_compressorbzip2 for BZip2).
Per stream compression option; store one stream uncompressed, another compressed with zlib, another with bzip2, etc.
No DLLs required.
No file name restrictions (including unicode file names allowed - strings are stored UTF-8 encoded, just like in .dfm files). If the file name is an empty string, then you can still access the data via file index.
Reading from compressed streams is just like reading from any other stream (even full seeking in any direction is allowed).
You can create links to streams inside SFDS files (the new entries will point to the same data).
Includes a list of opened reader objects, which are automatically destroyed if you forget about them (you only need to free the streams you open).
It has lots of routines for adding/extracting, testing (MD5 error checking) files to/from the SFDS file format.
It also has search routines, to easily find files inside SFDS archives (SFDS_FindFirst, SFDS_FindNext, SFDS_FindClose).
Supports metadata information: you can set any fields: string, number, date, boolean, binary (Metadata Editor Form included).
You can write/read SFDS files directly to/from any data source. Already implemented: Disk File [R/W], Memory Stream [R/W], Resource Stream [R]. Make a descendent of TSFDSCustomReader to read from any other custom source and a descendent of TSFDSCustomWriter to write to any other custom source. Once written, a SFDS file cannot have more data appended to it.
There are no components to install, so this library also works with the free Turbo Delphi.
Best of all: it's completely free (Even for commercial use).

I've made 2 versions:

1st version (version 1.4.2) simply updates the library to work with the newest Delphi versions. Should still be compatible with sfds files created with original version but doesn't have unicode support. Use this one if you need to use files created in versions 1.4.1 or older.
2nd version (version 1.5.0) also updates the library to support unicode (now uses string instead of ansistring). This version won't work with sfds files created with older versions (1.4.1 or older). Note that I only updated the demo .sfds files for the "Basic SFDS File Creator" demo only

[SHOWTOGROUPS=4,20]
Download v1.4.2 (no unicode support, works with older sfds files)

https://mega.nz/file/OdMxyKRD#1KhgSvUtkCmLflZlqJFmiPOhJ_-qaXdjCEmliMfwMzs

Download v1.5.0 (with unicode support, won't work with older sfds files)

https://mega.nz/file/6QcxjS7C#ZY8UELIj91YRrEejiuBFaOb-yh4i6OMJRv7sGoRABMo

all files together

https://mega.nz/file/GqwDBLqY#lA1rSbn0KaiIP12Q46HQdnwwWlhcdb0cyq8IeQKzTVo

[/SHOWTOGROUPS]

emailx45 · Apr 20, 2020

How to add Android "app shortcuts" to a FMX application
by Andrea Magni

[SHOWTOGROUPS=4,20]

Starting with Android 7.1 (API Level 25, supported out of the box by Delphi 10.3 Rio version) there is a new functionality supported by the OS (specifically by the OS app launcher and most of alternative launchers as well): app shortcuts.

You can find all details about this Android capability at this location of the Android’s official documentation.

Screenshot showing app shortcuts (from Android’s official documentation)

Why deal with app shortcuts?
Shortcuts can be very helpful when the application includes one or more main activity and the user may benefit having a specific shortcut to start your application and jump to that specific activity within your app. Also consider that most launchers (starting with the default one) will let the user have this shortcuts at hand by long-pressing the app’s icon, with an opportunity to create app-like icons on the home screen to trigger the shortcuts.

Example of popular apps with shortcuts: GMail, Google Maps, WhatsApp, Hangout, Slack and many more (and starting today, maybe yours too

…

During a one-to-one training session on FMX mobile development, one of my customers asked for this specific functionality (introduced with Android 7.1 Nougat, late 2016) to be implemented in a FMX app, so I delved a bit into this topic (that also has a sibling on the iOS side named “3D touch”, introduced in 2015 with iOS9).

In this blog post we’ll see how to add static shortcuts to your Android FMX application, through 4 simple steps. I plan to expand more on this topic (probably in my coming FMX book or during some of my mobile development workshops, held in my office in Italy or at Delphi events like Delphi Code Camp, scheduled for next May 8th in Koln, Germany), covering dynamic shortcut generation and the iOS side as well.

For now, we’ll start with an empty FMX app and we’ll add one static shortcut to the app.

Step 1: Edit your Manifest.xml file
Better said, edit your AndroidManifest.template.xml file, adding the following line inside the activity tag, just after the closing tag of the intent-filter element.
(...)

Code:

</intent-filter>
<meta-data android:name="android.app.shortcuts" android:resource="@xml/shortcuts" />
</activity>

The AndroidManifest.template.xml file will be used by the IDE to compile the actual Manifest.xml file that will be shipped within the final APK. The app launcher of your user device will look for this piece of information in order to describe app shortcuts for your app.

Basically we are just introducing a reference to an other XML file (shortcuts.xml) we are going to create in a proper folder as we’ll see in the next step.

Step 2: Create your shortcuts.xml file
As we’ll see later, it does not really matter where on your file system, but for example you can place it in your project root folder, just aside of the AndroidManifest.template.xml that IDE should have created for you.

Code:

<?xml version="1.0" encoding="utf-8"?>
<shortcuts xmlns:android="http://schemas.android.com/apk/res/android">
<shortcut
android:shortcutId="myshortcut1"
android:enabled="true"
android:icon="@drawable/andreamagni_128"
android:shortcutShortLabel="@string/my_shortcut1"
android:shortcutLongLabel="@string/my_shortcut1"
android:shortcutDisabledMessage="@string/my_shortcut1_disabled">
<intent
android:action="android.intent.action.MYACTION1"
android:targetPackage="com.embarcadero.Project1"
android:targetClass="com.embarcadero.firemonkey.FMXNativeActivity"/>
<categories android:name="android.shortcut.conversation"/>
</shortcut>
</shortcuts>

Please note:

You’ll need to provide a unique (within your app) shortcutId value, a string literal (not a re;
The values for the shortcutShortLabel (preferably less than 10 characters) and shortcutLongLabel (preferable less than 25 characters) are references to resource strings (we’ll see in next step of this blog post how to provide a value for these entries);
there is an intent element, where you can specify the action attribute. This information will be then included in the intent information your app may inspect to determine which shortcut has been triggered;
again the same intent element has a targetPackage attribute that must match the application package name (so please be sure to change this value accordingly to your Delphi project’s name);
the categories element is a bit of a mistery to me so far: as far as I understood (see this page) there is only one admitted value (conversation) and it has been introduced with API level 25 (there should be more values available in later API levels).
the icon attribute has a value “@drawable/andreamagni_128”: I am going to use a 128×128 PNG file (with one of my profile pictures) as icon for our shortcut, we’ll see later how to include the actual PNG in the APK.

Step 3: create your strings.xml file
Again, it does not really matter where on your file system, but for example you can place it in your project root folder, just aside of the AndroidManifest.template.xml that IDE should have created for you and the shortcuts.xml file created at step 2.

Code:

<?xml version="1.0" encoding="utf-8"?>
<resources>
<string name="my_shortcut1">Andrea</string>
<string name="my_shortcut1_disabled">Shortcut is disabled</string>
</resources>

Step 4: configure Deployment
Now that we have created these two additional xml files (shortcuts.xml and strings.xml) we need to correctly include them in the final deploy (build of the APK). We can add them in the Deployment page of the IDE (Project –> Deployment) and manage their deployment for the Android platform.

Please note:

the platform/configuration combo box shows “Debug configuration – Android platform” (you may want to select “All configurations – Android platform” entry) before adding the two xml files and the PNG file to the deployment file list (using the second toolbutton);
I’ve edited the “Remote Path” value specifying “res\values\” for the strings.xml file and “res\xml\” for the shortcuts.xml file (no quotes);
the entry for the andreamagni_128.png picture has “res\drawable\” as “Remote Path” value.

That’s all… really?
No, not really. But it is all that is required to actually define (static) shortcuts for your app.
If you build&deploy this application on an Android 7.1+ device, with a shortcut-enabled launcher (my Nexus 5X with the default launcher for example) you’ll be able to long-tap on the app icon and have shortcuts displayed.

You can even drag the shortcut on the home screen to have a separate icon on the screen to trigger your shortcut.
Here is a short video showing how to display the shortcut list and drag one of the shortcuts to the home screen in order to create a permanent icon for the shortcut.

Now you may be asking yourself how to handle shortcuts at the application level, meaning how to know if your app has been started normally or through a certain shortcut.

Handling the shortcut in the app
In order to know how your app was started (with or without a shortcut triggered), you can check the action value of the intent called by the OS to launch your app. It will contain the value specified as action attribute for the triggered shortcut (if the app has been started through a shortcut), in our case it would be “android.intent.action.MYACTION1”. The following code is a very basic example how to reach this value:

Code:

uses
Androidapi.JNI.App, Androidapi.JNI.JavaTypes,
Androidapi.Helpers;

procedure TForm1.FormCreate(Sender: TObject);
begin
Label1.Text := 'S: ' + JStringToString( TAndroidHelper.Activity.getIntent.getAction );
end;

It’s up to you then to handle the situation from an application point of view. If your app has multiple views (i.e. has a tab control on it, you may want to show a specific item, load some specific data, perform an action…).

Conclusion
App shortcut are a powerful functionality of Android operating system and can be very useful in business applications. They can improve general usability of your app as you can provide a handy and quick way to get to some functionality built-in your app.

There are a number of topics around this first/basic example I’d like to delve a bit more into but time is limited and my working schedule hard. So I hope you enjoyed this and please let me know if you have any questions about this.

Sincerely,
Andrea

[/SHOWTOGROUPS]

emailx45 · Apr 20, 2020

Introducing mORMot-JWT: a "new"” JWT implementation
JWT stands for JSON Web Tokens and it is a very popular technology used to implement custom-content tokens across REST services.

[SHOWTOGROUPS=4,20]

The JWT logo https://jwt.io/

Even if it is generally much over-rated and have its own drawbacks (especially when dealing with security), it is becoming something like a de facto standard for Web and REST applications authorization/authorization mechanisms.

You can read a nice introduction to JWT here.

I have used JWT since the end of 2015 as a default implementation for authentication/authorization mechanisms in MARS-Curiosity (a REST library for Embarcadero Delphi). The central topic of a JWT library is of course about token signing (through HMAC SHA256, for example) and so far I used (a fork of mine of) a library named JOSE JWT that relies on OpenSSL to implement cryptographic functions and thus forces you to distribute OpenSSL with your software.

Given deploying OpenSSL is becoming more and more a burden to match security requirements and given the Synopse team implemented JWT in mORMot project a while ago (link), I decided (after having discussed this a couple of times with Arnaud) to “steal” a mORMot JWT subset implementing JWT

If you have been to some of my sessions about MARS, you surely have seen me struggling with OpenSSL DLLs missing here and there… well, this is the day this will come to an end! Apart from this, there are a number of reasons this is a move forward for the MARS projects:

as I said, one less external dependency for your application servers (on Windows platform);
the mORMot implementation is faster (at least 5 times faster in some scenarios even I didn’t do serious benchmarking yet);
the mORMot implementation has a stronger community behind and so I am more confident about feature and bugfixes;
this is not the first piece of mORMot I integrate to MARS (see the dMustache integration covered by the “mustache” demo in MARS) and maybe it will not be the last (I always wanted to have MARS running on top of the mORMot’s http server http.sys implementation [as well as on top of TMS Sparkle, BTW] and I am also considering adding built-in compression for MARS using mORMot highly optimized compression utilities).

So I created the mORMot-JWT repository on github.com with a relatively small subset of mORMot files needed to implement JWT in any Windows application (feel free to use it wherever you may need! I will soon ask jwt.io to inlcude it in the library list for Delphi). Obviously all the code is by Synopse team and I did nothing else than copying some files in the new repository, trying to get the smallest part (but not tampering too much with the original files, in order to ease upgrading to newer versions).
Here is an example of use (link):

Code:

uses (...)
, SynCommons, SynCrypto, SynEcc, SynLZ;
var
LJWT: TJWTAbstract;
LToken: string;
begin
LJWT := TJWTHS256.Create(StringToUTF8(ASecret), 0, [jrcIssuer, jrcSubject], [], 60);
try
LToken := UTF8ToString( LJWT.Compute(['LanguageId', 'IT', 'CurrencyId', 'EUR'], 'MyApp', 'TheUser') );
WriteLn('Token: ' + LToken);
finally
LJWT.Free;
end;
end;

Then I refactored MARS to support both JOSE and mORMot-JWT library in a manner that mORMot-JWT will be the default implementation for all Windows platforms and still keeping JOSE for non-Windows ones (mORMot does not currently support Delphi Linux compiler and ARC-enabled Delphi compilers) and also added tests to ensure the two libraries would have a coherent behavior throughout MARS.

Please upgrade your MARS projects by adding the following units inclusion IFDEF (in the Server.Ignition.pas file or wherever you are defining your TMARSEngine instance):

Code:

{$IFDEF MSWINDOWS}
, MARS.mORMotJWT.Token
{$ELSE}
, MARS.JOSEJWT.Token
{$ENDIF}

And also remember to add ‘(…)MARS/ThirdParty/mORMot/Source’ to your library path before recompiling the MARS package groups.
Enjoy!

PS: this is not the only new feature I added to MARS recently (more blog posts will come)
[/SHOWTOGROUPS]