uaccessoriesmenu.pas

来自「FMA is a free1 powerful phone editing to」· PAS 代码 · 共 610 行 · 第 1/2 页

unit uAccessoriesMenu;

{
*******************************************************************************
* Descriptions: Accessories Menu for Ericsson Phone Implementation
* $Source: /cvsroot/fma/fma/uAccessoriesMenu.pas,v $
* $Locker:  $
*
* Todo:
*
* Change Log:
* $Log: uAccessoriesMenu.pas,v $
*
*******************************************************************************
}

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  ComObj, ActiveX, MobileAgent_TLB, StdVcl, Classes, TntClasses, SysUtils, TntSysUtils, TntSystem, uThreadSafe;

const
  DLG_OPTION      = $01;
  DLG_MSGBOX      = $02;
  DLG_YESNO       = $03;
  DLG_ONOFF       = $04;
  DLG_PERCENT     = $05;
  DLG_INPUTSTR    = $06;
  DLG_INPUTINT    = $07;
  DLG_INFORMATION = $08;
  DLG_FEEDBACK    = $09;
  DLG_SUBMENU     = $0a;
  DLG_LIST_1      = $0b;
  DLG_LIST_N      = $0c;
  DLG_INPUTERR    = $80;

type
  TAccessoriesMenu = class(TAutoObject, IAccessoriesMenu)
  private
    FTitle: WideString;
    FMenuList: TTntStrings;
    FMenuListOptions: TStrings;
    FUIOpen: Boolean;
    function UseSEcommands: Boolean;
  protected
    { Protected declarations }
    procedure Init; safecall;
    procedure Clear; safecall;
    procedure AddItem(const Caption, Event: WideString); safecall;
    procedure AddItemEx(const Caption: WideString; Disabled, Selected, CanDelete: WordBool; ImgIndex: Integer; const Event: WideString); safecall;
    procedure Set_MenuType(Value: Integer); safecall;
    procedure Set_Title(const Value: WideString); safecall;
    procedure Set_Selected(Value: Integer); safecall;
    procedure Update; safecall;
    procedure Set_Back(const Value: WideString); safecall;
    procedure ClearMenu; safecall;
    procedure Set_NextState(Value: Integer); safecall;
    procedure DlgOption; safecall;
    procedure DlgMsgBox(const Msg: WideString; TimeoutS: Integer); safecall;
    procedure DlgYesNo(const Msg, Event: WideString; TimeoutS: Integer); safecall;
    procedure DlgOnOff(const Title, Event: WideString; Default: Integer); safecall;
    procedure DlgPercent(const Title, Event: WideString; Steps, Pos: Integer); safecall;
    procedure DlgInputStr(const Title, Prompt: WideString; MaxLen: Integer;
      const DefaultStr: WideString; const Event: WideString); safecall;
    procedure DlgInputInt(const Title, Prompt: WideString; MinVal, MaxVal,
      DefaultVal: Integer; const event: WideString); safecall;
    procedure DlgInformation(const Title, Msg: WideString); safecall;
    procedure DlgFeedback(const Title, event: WideString); safecall;
  public
    FSelected: Integer;
    FBack: String;
    FEventList: TTntStrings;
    FNextState: Integer;
    FGeneralEvent: String;
    FType: Integer;
    FPercentSteps: Integer;
    FPercentPos: Integer;
    FMenuEntryEvent: String;
    FInputMax: Integer;
    FInputMin: Integer;
    property SessionOpened: boolean read FUIOpen;
    procedure OpenUI; safecall;
    procedure CloseUI; safecall;
    procedure Initialize; override;
    destructor Destroy; override;
  end;

implementation

uses
  gnugettext, gnugettexthelpers, cUnicodeCodecs,
  ComServ, Unit1, uLogger;

{*******************************************************************************
Init() [Called on connect. Initialises FUIOpen property and inserts
        FMA into (Settings/)Connectivity/Accessories menu]
*******************************************************************************}
procedure TAccessoriesMenu.Init;
var
  sl: TTntStringList;
  i: Integer;
begin
  FUIOpen:=False;
  if Form1.FConnected then begin
    if UseSEcommands then begin
      Form1.TxAndWait('AT*SEAM="FMA",13'); // do not localize
      sl := TTntStringList.Create;
      try
        sl.Text := ThreadSafe.RxBuffer.Text;
        for i := 0 to sl.Count - 1 do
          if pos('*SEAM:', sl[i]) = 1 then // do not localize
            FMenuEntryEvent:='*SEAAI'+Copy(sl[i],6,MaxInt);
      finally
        sl.free
      end;
    end
    else begin
      FMenuEntryEvent:='';
      Form1.ScheduleTxAndWait('AT*EAM="FMA"'); // do not localize
    end;
  end;
  Log.AddCommunicationMessage('AccessoriesMenu.Init: Event="'+FMenuEntryEvent+'"'); // do not localize debug
  Clear;
end;

{*******************************************************************************
Clear() [Clear all properties of the menu: Menu items, Abort command, Title,
         and sets Index of selected item and NextState to 1.
*******************************************************************************}
procedure TAccessoriesMenu.Clear;
begin
  Log.AddScriptMessage('AccessoriesMenu.Clear', lsDebug); // do not localize debug
  ClearMenu;
  FTitle := '';
  FSelected := 1;
  FNextState := 1;
end;

{*******************************************************************************
AddItem(
  WideString Caption  [Text to be inserted into item],
  WideString  Event   [Command to be executed on item select])
*******************************************************************************}
procedure TAccessoriesMenu.AddItem(const Caption, Event: WideString);
begin
  FMenuList.Add(Caption);
  FMenuListOptions.Add('0,0,0,0');
  FEventList.Add(Event);
end;

procedure TAccessoriesMenu.AddItemEx(const Caption: WideString; Disabled, Selected, CanDelete: WordBool; ImgIndex: Integer; const Event: WideString);
var
  s: string;
begin
  if Disabled and (not UseSEcommands) then Exit;
  FMenuList.Add(Caption);
  s := IntToStr(ImgIndex) + ',';
  if Disabled then
    s := s + '1,'
  else
    s := s + '0,';
  if Selected then
    s := s + '1,'
  else
    s := s + '0,';
  if CanDelete then
    s := s + '1'
  else
    s := s + '0';
  FMenuListOptions.Add(s);
  FEventList.Add(Event);
end;

procedure TAccessoriesMenu.Set_MenuType(Value: Integer);
begin
  if Value <= DLG_LIST_N then
    FType := Value;
end;

{*******************************************************************************
Set_Title(
  WideString Value  [Text to be displayed as menu title])
*******************************************************************************}
procedure TAccessoriesMenu.Set_Title(const Value: WideString);
begin
  FTitle := Value;
end;

{*******************************************************************************
Set_Selected(
  Integer Value [Index of item to be preselected on menu update])
*******************************************************************************}
procedure TAccessoriesMenu.Set_Selected(Value: Integer);
begin
  FSelected := Value;
end;

{*******************************************************************************
Update() [Shows the menu on the phone]
*******************************************************************************}
procedure TAccessoriesMenu.Update;
var
  Com: String;
  Buf, TempBuf: String;
  ComLen, ComCount: Integer;
  W: WideString;
  i: Integer;
begin
  { AT*EASM=<title>,<next_state>,<selected_item>,<number_of_menu_items>[,<menu_item>[,<menu_item>, ...]][,<final_flag>] }

  // Prepare start of AT command
  OpenUI;
  if FType and $0f < DLG_SUBMENU then
    FType := DLG_SUBMENU;
  Log.AddScriptMessage('AccessoriesMenu.Update', lsDebug); // do not localize debug

  if UseSEcommands then begin
    Com := 'AT*SELIST="' + WideStringToUTF8String(FTitle) + '",'; // do not localize
    if FType = DLG_LIST_1 then
      Com := Com + '1,'
    else if FType = DLG_LIST_N then
      Com := Com + '2,'
    else
      Com := Com + '3,';
    If FSelected>0 Then
      Com := Com + IntToStr(FSelected-1) + ',' // do not localize
    else
      Com := Com + '0,';  // do not localize
  end
  else
    Com := 'AT*EASM="' + WideStringToUTF8String(Copy(FTitle,1,15)) + '",' + IntToStr(FNextState) + ',' + IntToStr(FSelected) + ','; // do not localize
  ComLen := Length(Com);

  // Reset all flags and buffers
  ComCount := 0;
  Buf := '';
  TempBuf := '';

  // Build menu
  for i := 0 to FMenuList.Count - 1 do begin
    // Add menu item
    W := FMenuList.Strings[i];
    repeat
      TempBuf := WideStringToUTF8String(W);
      if Length(TempBuf) <= 200 then break; // normally break in first test
      // Remove last char in W. In next iteration this will remove last UTF-8 encoded char in TempBuf (from 1 to 3 bytes)
      SetLength(W, Length(W)-1);
    until false;
    if UseSEcommands then
      TempBuf := ',"' + TempBuf + '",' + FMenuListOptions[i]
    else
      TempBuf := ',"' + TempBuf + '"';

    // Check if AT command is not too long
    if ((ComLen + Length(Buf) + Length(TempBuf)) > 200) and not UseSEcommands then begin
      // It is too long, set final_flag to 0, we will continue
      Buf := Com + IntToStr(ComCount) + Buf + ',0';
      // Send AT command
      Form1.TxAndWait(Buf);

      // Store last item to buffer
      Buf := TempBuf;
      ComCount := 1;
    end
    else begin
      // Add menu item and increase counter of items in one command
      Buf := Buf + TempBuf;
      Inc(ComCount);
    end;
  end;

  // Send rest of menu to phone with final_flag set to 1
  if UseSEcommands then
    Buf := Com + IntToStr(ComCount) + ',1,1' + Buf 
  else
    Buf := Com + IntToStr(ComCount) + Buf + ',1'; 
  Form1.TxAndWait(Buf);
end;

{*******************************************************************************
Set_Back(
  WideString Value  [Command to be executed on menu abort])
*******************************************************************************}
procedure TAccessoriesMenu.Set_Back(const Value: WideString);
begin
  FBack := Value;
end;

{*******************************************************************************
ClearMenu() [Clears menu items and abort command]
*******************************************************************************}
procedure TAccessoriesMenu.ClearMenu;
begin
  Log.AddScriptMessage('AccessoriesMenu.ClearMenu', lsDebug); // do not localize debug
  FType := DLG_SUBMENU;
  FMenuList.Clear;
  FMenuListOptions.Clear;
  FEventList.Clear;
  FBack := '';
end;

{*******************************************************************************
Set_NextState(