Перейти к содержанию
Fire Monkey от А до Я

Евгений Корепов

Пользователи
  • Постов

    738
  • Зарегистрирован

  • Посещение

  • Победитель дней

    100

Активность репутации

  1. Like
    Евгений Корепов отреагировална bigjorj в InAppPurchase.IsProductPurchased   
    Вот пример. У меня работает. Был один неприятный момент - после использования тестовых продуктов проверка покупки заработала примерно через день, сама по себе.
     
    При старте приложения вызываем    
     
    PurchaseDataModule.InAppPurchase1.SetupInAppPurchase;
    procedure TPurchaseDataModule.DataModuleCreate(Sender: TObject); begin fisPurchased := true; {$IFDEF ANDROID} InAppPurchase1.ApplicationLicenseKey :=''; //Присваиваем ключ InAppPurchase1.ProductIDs.Add(ProductId); // Добавляем наш продукт InAppPurchase1.OnSetupComplete := InAppPurchase1SetupComplete; {$ENDIF} end; procedure TPurchaseDataModule.InAppPurchase1ProductsRequestResponse( Sender: TObject; const Products: TIAPProductList; const InvalidProductIDs: TStrings); var Product: TProduct; begin fisPurchased := false; for Product in Products do begin if ProductId = Product.ProductID then begin FProductIsValid := True; if InAppPurchase1.IsProductPurchased(ProductId) then begin fisPurchased := true; // КУПЛЕНО!!!! end end; end; end; procedure TPurchaseDataModule.InAppPurchase1PurchaseCompleted(Sender: TObject; const ProductID: string; NewTransaction: Boolean); begin MainDataModule.ShowToast('Премиум версия активирована'); fisPurchased := True end; procedure TPurchaseDataModule.InAppPurchase1SetupComplete(Sender: TObject); begin fisPurchased := False; try InAppPurchase1.QueryProducts; except on E:Exception do MainDataModule.ShowToast(e.Message); end; end; procedure TPurchaseDataModule.Purchase; begin {$IFDEF ANDROID} if InAppPurchase1.IsSetupComplete and InAppPurchase1.CanMakeInAppPurchases then begin InAppPurchase1.PurchaseProduct(ProductId); end else MainDataModule.ShowToast('В данный момент приобретение не возможно. Попробуйте позже'); {$ENDIF} end;
  2. Like
    Евгений Корепов отреагировална bigjorj в InAppPurchase   
    Заметил еще одну особенность использования InAppPurchase:
    Если использовать тестовые товары google, то проверка isAppPurchased работает только на следующие сутки. Ошибка при этом что-то про неверную подпись.
  3. Like
    Евгений Корепов отреагировална Alexander в ScrollBox.ViewportPosition анимация   
    У Floatanimation есть событие Process. В его обработчике пропишите изменение image.position пропорционально увеличению image
  4. Like
    Евгений Корепов отреагировална ophion в Как получить IMEI?   
    Дам вам подсказку из Android доков...
     
     
    public String getDeviceId ()   Added in API level 1 Returns the unique device ID, for example, the IMEI for GSM and the MEID or ESN for CDMA phones. Return null if device ID is not available.
    Requires Permission: READ_PHONE_STATE

    public String getDeviceId (int slotId)   Added in API level 23 Returns the unique device ID of a subscription, for example, the IMEI for GSM and the MEID for CDMA phones. Return null if device ID is not available.
    Requires Permission: READ_PHONE_STATE
    Parameters slotId of which deviceID is returned  
  5. Like
    Евгений Корепов получил реакцию от Vitaldj в PushEvents без Provider   
    Var HDevicePushParams : TDevicePushParams;        APushService : TPushService;       AServiceConnection : TPushServiceConnection;       SQuery : String; begin     APushService:=TPushServiceManager.Instance.GetServiceByName(TPushService.TServiceNames.GCM);     APushService.AppProps[TPushService.TAppPropNames.GCMAppID]:='ХХХХХХХХХХХХХХХХ';     AServiceConnection:=TPushServiceConnection.Create(APushService);     AServiceConnection.Active:=True;     AServiceConnection.OnChange:=ServiceConnectionOnChange;     AServiceConnection.OnReceiveNotification:=ServiceConnectionOnReceiveNotification;     HDevicePushParams.DeviceID:=APushService.DeviceIDValue[TPushService.TDeviceIDNames.DeviceID];     HDevicePushParams.DeviceToken:=APushService.DeviceTokenValue[TPushService.TDeviceTokenNames.DeviceToken];   SQuery:=APIURL+'?DeviceID='+HDevicePushParams.DeviceID+'&DeviceToken='+HDevicePushParams.DeviceToken;     HTTPThread:=THTTPThread.Create(SQuery,FQueue);  // Здесь просто отправка на сервер в потоке. Сервер принимает стоку и складывает в базу пары "DeviceID - DeviceToken", можно еще что нибудь отправлять, чтоб точно идентифицировать клиента.
    А на сервере все еще проще. Вот php: $title = 'Это заголовок'; $message = 'Это текст сообщения.' $devices = 'DeviceToken - один конкретный получатель'; $apiKey = "AIzaХХХХХХХХХХХХХХХХХХХХХХХХХХХХХХХХХХХХ"; $gcpm = new GCMPushMessage($apiKey); $gcpm->setDevices($devices); $response = $gcpm->send($message, array('title' => $title)); Лениво было писать велосипед, использовал готовую отсылалку https://github.com/mattg888/GCM-PHP-Server-Push-Message . Там все просто, она заворачивает все в json и отправляет  на http
  6. Like
    Евгений Корепов отреагировална Равиль Зарипов (ZuBy) в Еще раз про разбор JSON - массива   
    function JSONParse(const aJSONData: string; const aMemo: TMemo): boolean; var   aJSValue: TJSONValue;   aJSObject: TJSONObject;   aJSArray: TJSONArray;   I, J: integer; begin Result := false; aJSValue := TJSONObject.ParseJSONValue(aJSONData) as TJSONValue; if Assigned(aJSValue) then begin aJSObject := aJSValue as TJSONObject; if Assigned(aJSObject) then begin for I := 0 to aJSObject.Count - 1 do begin aMemo.Lines.Add(aJSObject.Pairs[I].JsonString.Value + '=' + aJSObject.Pairs[I].JsonValue.Value); if aJSObject.GetValue(aJSObject.Pairs[I].JsonString.Value) is TJSONArray then begin aJSArray := aJSObject.GetValue(aJSObject.Pairs[I].JsonString.Value) as TJSONArray; if Assigned(aJSArray) then begin for J := 0 to aJSArray.Count - 1 do aMemo.Lines.Add(aJSArray.Items[J].Value); end; end; end; end; end; Result := true; end; JSONParse('{"desc":"Описания...","otdel":["1","12","300"],"manufacturer":"ООО \"Привет\""}', Memo1)
  7. Like
    Евгений Корепов получил реакцию от rakhmet в Сообщения чата в виде сообщений в iphone.   
    Для одного проекта писал такое пару месяцев назад, пользуйтесь.Под windows, при клике на сообщение, оно превращается в readonly TMemo - дабы можно было скопировать нужное из сообщения. При наличии URL в сообщении, сбоку появляется кнопка открыть - лучше ничего для открытия ссылок не придумал. Надо бы сделать диалог выбора для открытия одной из нескольких ссылок, но руки пока не доходят. Пощупать чат вживую можно в приложении https://play.google.com/store/apps/details?id=ru.flintnet.InternetAgent , для активации и загрузки примера чата отсканируйте  приложением qr-код с страницы  http://internetagent.flintnet.ru/
     

    unit ChatBox; interface uses   System.SysUtils, System.Classes, FMX.Types, FMX.Controls, FMX.Layouts,System.Types,   FMX.StdCtrls,FMX.Edit,FMX.Memo,FMX.TextLayout,System.UITypes,FMX.Graphics,FMX.Objects,   FMX.Effects,FMX.Styles.Objects; type   TMessagePos = (msgLeft,msgRight);   TEventText = procedure(PURL: String) of object;   TChatBox = class(TVertScrollBox)   private     FTextLyout : TTextLayout;     FLastMessageId : Integer;     FMsgWidthPercentage : Integer;     FOnURLButtonClick : TEventText;     FCalloutLength : Single;     FCalloutXRadius : Single;     FCalloutYRadius : Single;     FMessageFontSize : Single;     FMemo : TMemo;     procedure ButtonClick(Sender: TObject);     procedure MyMsgContainerOnClick(Sender: TObject);     procedure MyMsgContainerOnExit(Sender: TObject);     function FCreateMsgBlock(AOwner: TComponent; PMessageId : Integer;       PDate, PAutor, PMessage : String; PMessagePos : TMessagePos) : TLayout;     function CalculateTextItemHeight(Sender: TObject) : Single;     procedure LayoutResize(Sender: TObject);     function ExtractURL(pString : String) : String;     procedure Memo1ApplyStyleLookup(Sender: TObject);   public     property LastMessageId : Integer read FLastMessageId;     property MsgWidthPercentage : Integer read FMsgWidthPercentage write FMsgWidthPercentage default 80;     constructor Create(AOwner: TComponent); override;     destructor Destroy; override;     Procedure AddMessage(pMessageId : Integer; PDate, PAutor, PMessage : String; PMessagePos : TMessagePos);     procedure ClearChildren(AChatBox: TChatBox);     procedure ScrollBottomSmoothly;     procedure ScrollBottom;   published     property OnURLButtonClick : TEventText read FonURLButtonClick write FonURLButtonClick;     property CalloutLength : Single read FCalloutLength write FCalloutLength;     property CalloutXRadius : Single read FCalloutXRadius write FCalloutXRadius;     property CalloutYRadius : Single read FCalloutYRadius write FCalloutYRadius;     property MessageFontSize : Single read FMessageFontSize write FMessageFontSize;   end;   TOpenChatBox = class(TChatBox); Procedure Register; implementation procedure Register; begin   RegisterComponents('EKorepov', [TChatBox]); end; constructor TChatBox.Create(AOwner: TComponent); begin   inherited create(Aowner);   FLastMessageId:=-1;   FTextLyout := TTextLayoutManager.DefaultTextLayout.Create;   FMemo:=TMemo.Create(Aowner);   FMemo.TextSettings.WordWrap:=True;   FMemo.ReadOnly:=True;   FMemo.Align:=TAlignLayout.Client;   FMemo.OnExit:=MyMsgContainerOnExit;   FMemo.OnApplyStyleLookup:=Memo1ApplyStyleLookup;   FMemo.StyledSettings:=FMemo.StyledSettings-[TStyledSetting.Size];   With Self as TVertScrollBox do   begin     AniCalculations.Animation := True;     AniCalculations.BoundsAnimation := True;     AniCalculations.TouchTracking := [ttVertical];   end; end; destructor TChatBox.Destroy; begin   FreeAndNil(FMemo);   FreeAndNil(FTextLyout);   inherited Destroy; end; procedure TChatBox.ScrollBottomSmoothly; begin   AniCalculations.MouseWheel(0, ContentBounds.Height+5); end; procedure TChatBox.ScrollBottom; begin   ScrollBy(0, -ContentBounds.Height); end; procedure TChatBox.ButtonClick(Sender: TObject); Var URL : String; begin   URL:=TButton(Sender).HelpKeyword;   if Assigned(FonURLButtonClick) then     FonURLButtonClick(URL); end; procedure TChatBox.Memo1ApplyStyleLookup(Sender: TObject); begin end; procedure TChatBox.MyMsgContainerOnClick(Sender: TObject); begin   FMemo.TextSettings:=TLabel(Sender).TextSettings;   FMemo.Lines.Text:=TLabel(Sender).Text;   TLabel(Sender).AddObject(FMemo); end; procedure TChatBox.MyMsgContainerOnExit(Sender: TObject); begin   if (Sender is TMemo) then     if Assigned(TMemo(Sender).Parent) then       if (TMemo(Sender).Parent is TLabel) then         TLabel(TMemo(Sender).Parent).RemoveObject(TMemo(Sender)); end; procedure TChatBox.ClearChildren(AChatBox: TChatBox); begin   Assert(AChatBox <> nil);   TOpenChatBox(AChatBox).Content.DeleteChildren;   AChatBox.Repaint; end; function TChatBox.CalculateTextItemHeight(Sender: TObject) : Single; var Item: TLabel; begin   Result:=0;   if (Sender is TLabel) then   begin     Item := TLabel(Sender);     FTextLyout.BeginUpdate;     try       FTextLyout.Text := Item.Text;       FTextLyout.MaxSize := TPointF.Create(Item.Width-Item.Margins.Left-Item.Margins.Right-10, 1000);       FTextLyout.Font := Item.Font;       FTextLyout.WordWrap:= Item.WordWrap;       FTextLyout.HorizontalAlign:= Item.TextSettings.HorzAlign;       FTextLyout.VerticalAlign:= Item.TextSettings.VertAlign;     finally       FTextLyout.EndUpdate;     end;     Result:= FTextLyout.Height+10;   end; end; procedure TChatBox.LayoutResize(Sender: TObject); Var Item : TLabel;     CalloutRectangle : TCalloutRectangle;     Layout : TLayout;     I : Integer; begin   Layout:=TLayout(Sender);   for I := 0 to Layout.Children.Count-1 do   begin     If Layout.Children.Items[I] is TCalloutRectangle Then     begin       CalloutRectangle:=TCalloutRectangle(Layout.Children.Items[I]);       Item:=TLabel(CalloutRectangle.Children.Items[0]);       CalloutRectangle.Width:=(Layout.Width / 100) * FMsgWidthPercentage;       Layout.Height:=CalculateTextItemHeight(Item);     end;     If Layout.Children.Items[I] is TButton Then     begin       TButton(Layout.Children.Items[I]).Width:=(Layout.Width / 100) * (100-FMsgWidthPercentage-5);     end;   end; end; Procedure TChatBox.AddMessage(pMessageId : Integer; PDate, PAutor, PMessage : String; PMessagePos : TMessagePos); Var lcLayout : TLayout; begin   PDate:=Trim(PDate);   PAutor:=Trim(PAutor);   PMessage:=Trim(PMessage);   FLastMessageId:=PMessageId;   lcLayout:=FCreateMsgBlock((Self as TVertScrollBox), PMessageId, PDate, PAutor, PMessage, PMessagePos);   Self.AddObject(lcLayout); end; function TChatBox.FCreateMsgBlock(AOwner: TComponent; PMessageId : Integer; PDate, PAutor, PMessage : String;                                   PMessagePos : TMessagePos) : TLayout; Var lcLayout,lcLayout2 : TLayout;     Item : TLabel;     Button : TButton;     CalloutRectangle : TCalloutRectangle;     lcHeight : Single;     URL : String; begin   lcLayout:=TLayout.Create(AOwner);   lcLayout.Tag:=pMessageId;   lcLayout.Align:=TAlignLayout.Top;   lcLayout.Width:=200;   lcLayout.Position.X:=0;   lcLayout.Position.Y:= ((AOwner as TVertScrollBox).ContentBounds.Height+10);   lcLayout.Margins.Bottom:=10;   CalloutRectangle:=TCalloutRectangle.Create(lcLayout);   CalloutRectangle.XRadius:=FCalloutXRadius;   CalloutRectangle.YRadius:=FCalloutYRadius;   CalloutRectangle.CalloutWidth:=10;   CalloutRectangle.CalloutOffset:=-3-FCalloutYRadius-CalloutRectangle.CalloutWidth;   CalloutRectangle.Width:=((AOwner as TVertScrollBox).Width / 100) * FMsgWidthPercentage;   CalloutRectangle.HitTest:=False;   case PMessagePos of     msgRight :     begin       CalloutRectangle.Align:=TAlignLayout.Right;       CalloutRectangle.CalloutPosition:=TCalloutPosition.Right;       CalloutRectangle.Padding.Right:=CalloutRectangle.CalloutLength+CalloutRectangle.XRadius;       CalloutRectangle.Padding.Left:=CalloutRectangle.XRadius;     end;     msgLeft :     begin       CalloutRectangle.Align:=TAlignLayout.Left;       CalloutRectangle.CalloutPosition:=TCalloutPosition.Left;       CalloutRectangle.Padding.Left:=CalloutRectangle.CalloutLength+CalloutRectangle.XRadius;       CalloutRectangle.Padding.Right:=CalloutRectangle.XRadius;     end;   end;   CalloutRectangle.Padding.Top:=1;   CalloutRectangle.Padding.Bottom:=1;   lcLayout.AddObject(CalloutRectangle);   Item:=TLabel.Create(CalloutRectangle);   Item.TextSettings.Font.Size:=MessageFontSize;   CalloutRectangle.AddObject(Item);   Item.Align:=TAlignLayout.Client; {$IFDEF MSWINDOWS}   Item.OnClick:=MyMsgContainerOnClick; {$ENDIF MSWINDOWS}   Item.Text:=PDate+' '+PAutor+#10+PMessage;   Item.HitTest:=True;   Item.WordWrap:=True;   lcHeight:=CalculateTextItemHeight(Item);   lcLayout.Height:=lcHeight;   URL:=ExtractURL(pMessage);   Item.StyledSettings:=Item.StyledSettings- [TStyledSetting.Size,TStyledSetting.Style];   if Not URL.IsEmpty then   begin     lcLayout2:=TLayout.Create(lcLayout);     lcLayout2.Align:=TAlignLayout.Client;     lcLayout2.Margins.Left:=5;     lcLayout2.Margins.Right:=5;     lcLayout.AddObject(lcLayout2);     Button:=TButton.Create(lcLayout2);     Button.Text:='Открыть';     Button.Align:=TAlignLayout.Center;     Button.HelpKeyword:=URL;     Button.OnClick:=ButtonClick;     lcLayout2.AddObject(Button);   end;   lcLayout.OnResize:=LayoutResize;   Result:=lcLayout; end; function TChatBox.ExtractURL(pString : String) : String; Var S : String; begin   Result:='';   if Not pString.Contains('http') then     Exit;   S:=pString.Substring(Pos('http',pString)-1);   S:=S.Remove(S.IndexOfAny([' ',',']));   Result:=S.TrimRight(['.']); end; end.
  8. Like
    Евгений Корепов получил реакцию от Алмаз Амангельды в Сообщения чата в виде сообщений в iphone.   
    Для одного проекта писал такое пару месяцев назад, пользуйтесь.Под windows, при клике на сообщение, оно превращается в readonly TMemo - дабы можно было скопировать нужное из сообщения. При наличии URL в сообщении, сбоку появляется кнопка открыть - лучше ничего для открытия ссылок не придумал. Надо бы сделать диалог выбора для открытия одной из нескольких ссылок, но руки пока не доходят. Пощупать чат вживую можно в приложении https://play.google.com/store/apps/details?id=ru.flintnet.InternetAgent , для активации и загрузки примера чата отсканируйте  приложением qr-код с страницы  http://internetagent.flintnet.ru/
     

    unit ChatBox; interface uses   System.SysUtils, System.Classes, FMX.Types, FMX.Controls, FMX.Layouts,System.Types,   FMX.StdCtrls,FMX.Edit,FMX.Memo,FMX.TextLayout,System.UITypes,FMX.Graphics,FMX.Objects,   FMX.Effects,FMX.Styles.Objects; type   TMessagePos = (msgLeft,msgRight);   TEventText = procedure(PURL: String) of object;   TChatBox = class(TVertScrollBox)   private     FTextLyout : TTextLayout;     FLastMessageId : Integer;     FMsgWidthPercentage : Integer;     FOnURLButtonClick : TEventText;     FCalloutLength : Single;     FCalloutXRadius : Single;     FCalloutYRadius : Single;     FMessageFontSize : Single;     FMemo : TMemo;     procedure ButtonClick(Sender: TObject);     procedure MyMsgContainerOnClick(Sender: TObject);     procedure MyMsgContainerOnExit(Sender: TObject);     function FCreateMsgBlock(AOwner: TComponent; PMessageId : Integer;       PDate, PAutor, PMessage : String; PMessagePos : TMessagePos) : TLayout;     function CalculateTextItemHeight(Sender: TObject) : Single;     procedure LayoutResize(Sender: TObject);     function ExtractURL(pString : String) : String;     procedure Memo1ApplyStyleLookup(Sender: TObject);   public     property LastMessageId : Integer read FLastMessageId;     property MsgWidthPercentage : Integer read FMsgWidthPercentage write FMsgWidthPercentage default 80;     constructor Create(AOwner: TComponent); override;     destructor Destroy; override;     Procedure AddMessage(pMessageId : Integer; PDate, PAutor, PMessage : String; PMessagePos : TMessagePos);     procedure ClearChildren(AChatBox: TChatBox);     procedure ScrollBottomSmoothly;     procedure ScrollBottom;   published     property OnURLButtonClick : TEventText read FonURLButtonClick write FonURLButtonClick;     property CalloutLength : Single read FCalloutLength write FCalloutLength;     property CalloutXRadius : Single read FCalloutXRadius write FCalloutXRadius;     property CalloutYRadius : Single read FCalloutYRadius write FCalloutYRadius;     property MessageFontSize : Single read FMessageFontSize write FMessageFontSize;   end;   TOpenChatBox = class(TChatBox); Procedure Register; implementation procedure Register; begin   RegisterComponents('EKorepov', [TChatBox]); end; constructor TChatBox.Create(AOwner: TComponent); begin   inherited create(Aowner);   FLastMessageId:=-1;   FTextLyout := TTextLayoutManager.DefaultTextLayout.Create;   FMemo:=TMemo.Create(Aowner);   FMemo.TextSettings.WordWrap:=True;   FMemo.ReadOnly:=True;   FMemo.Align:=TAlignLayout.Client;   FMemo.OnExit:=MyMsgContainerOnExit;   FMemo.OnApplyStyleLookup:=Memo1ApplyStyleLookup;   FMemo.StyledSettings:=FMemo.StyledSettings-[TStyledSetting.Size];   With Self as TVertScrollBox do   begin     AniCalculations.Animation := True;     AniCalculations.BoundsAnimation := True;     AniCalculations.TouchTracking := [ttVertical];   end; end; destructor TChatBox.Destroy; begin   FreeAndNil(FMemo);   FreeAndNil(FTextLyout);   inherited Destroy; end; procedure TChatBox.ScrollBottomSmoothly; begin   AniCalculations.MouseWheel(0, ContentBounds.Height+5); end; procedure TChatBox.ScrollBottom; begin   ScrollBy(0, -ContentBounds.Height); end; procedure TChatBox.ButtonClick(Sender: TObject); Var URL : String; begin   URL:=TButton(Sender).HelpKeyword;   if Assigned(FonURLButtonClick) then     FonURLButtonClick(URL); end; procedure TChatBox.Memo1ApplyStyleLookup(Sender: TObject); begin end; procedure TChatBox.MyMsgContainerOnClick(Sender: TObject); begin   FMemo.TextSettings:=TLabel(Sender).TextSettings;   FMemo.Lines.Text:=TLabel(Sender).Text;   TLabel(Sender).AddObject(FMemo); end; procedure TChatBox.MyMsgContainerOnExit(Sender: TObject); begin   if (Sender is TMemo) then     if Assigned(TMemo(Sender).Parent) then       if (TMemo(Sender).Parent is TLabel) then         TLabel(TMemo(Sender).Parent).RemoveObject(TMemo(Sender)); end; procedure TChatBox.ClearChildren(AChatBox: TChatBox); begin   Assert(AChatBox <> nil);   TOpenChatBox(AChatBox).Content.DeleteChildren;   AChatBox.Repaint; end; function TChatBox.CalculateTextItemHeight(Sender: TObject) : Single; var Item: TLabel; begin   Result:=0;   if (Sender is TLabel) then   begin     Item := TLabel(Sender);     FTextLyout.BeginUpdate;     try       FTextLyout.Text := Item.Text;       FTextLyout.MaxSize := TPointF.Create(Item.Width-Item.Margins.Left-Item.Margins.Right-10, 1000);       FTextLyout.Font := Item.Font;       FTextLyout.WordWrap:= Item.WordWrap;       FTextLyout.HorizontalAlign:= Item.TextSettings.HorzAlign;       FTextLyout.VerticalAlign:= Item.TextSettings.VertAlign;     finally       FTextLyout.EndUpdate;     end;     Result:= FTextLyout.Height+10;   end; end; procedure TChatBox.LayoutResize(Sender: TObject); Var Item : TLabel;     CalloutRectangle : TCalloutRectangle;     Layout : TLayout;     I : Integer; begin   Layout:=TLayout(Sender);   for I := 0 to Layout.Children.Count-1 do   begin     If Layout.Children.Items[I] is TCalloutRectangle Then     begin       CalloutRectangle:=TCalloutRectangle(Layout.Children.Items[I]);       Item:=TLabel(CalloutRectangle.Children.Items[0]);       CalloutRectangle.Width:=(Layout.Width / 100) * FMsgWidthPercentage;       Layout.Height:=CalculateTextItemHeight(Item);     end;     If Layout.Children.Items[I] is TButton Then     begin       TButton(Layout.Children.Items[I]).Width:=(Layout.Width / 100) * (100-FMsgWidthPercentage-5);     end;   end; end; Procedure TChatBox.AddMessage(pMessageId : Integer; PDate, PAutor, PMessage : String; PMessagePos : TMessagePos); Var lcLayout : TLayout; begin   PDate:=Trim(PDate);   PAutor:=Trim(PAutor);   PMessage:=Trim(PMessage);   FLastMessageId:=PMessageId;   lcLayout:=FCreateMsgBlock((Self as TVertScrollBox), PMessageId, PDate, PAutor, PMessage, PMessagePos);   Self.AddObject(lcLayout); end; function TChatBox.FCreateMsgBlock(AOwner: TComponent; PMessageId : Integer; PDate, PAutor, PMessage : String;                                   PMessagePos : TMessagePos) : TLayout; Var lcLayout,lcLayout2 : TLayout;     Item : TLabel;     Button : TButton;     CalloutRectangle : TCalloutRectangle;     lcHeight : Single;     URL : String; begin   lcLayout:=TLayout.Create(AOwner);   lcLayout.Tag:=pMessageId;   lcLayout.Align:=TAlignLayout.Top;   lcLayout.Width:=200;   lcLayout.Position.X:=0;   lcLayout.Position.Y:= ((AOwner as TVertScrollBox).ContentBounds.Height+10);   lcLayout.Margins.Bottom:=10;   CalloutRectangle:=TCalloutRectangle.Create(lcLayout);   CalloutRectangle.XRadius:=FCalloutXRadius;   CalloutRectangle.YRadius:=FCalloutYRadius;   CalloutRectangle.CalloutWidth:=10;   CalloutRectangle.CalloutOffset:=-3-FCalloutYRadius-CalloutRectangle.CalloutWidth;   CalloutRectangle.Width:=((AOwner as TVertScrollBox).Width / 100) * FMsgWidthPercentage;   CalloutRectangle.HitTest:=False;   case PMessagePos of     msgRight :     begin       CalloutRectangle.Align:=TAlignLayout.Right;       CalloutRectangle.CalloutPosition:=TCalloutPosition.Right;       CalloutRectangle.Padding.Right:=CalloutRectangle.CalloutLength+CalloutRectangle.XRadius;       CalloutRectangle.Padding.Left:=CalloutRectangle.XRadius;     end;     msgLeft :     begin       CalloutRectangle.Align:=TAlignLayout.Left;       CalloutRectangle.CalloutPosition:=TCalloutPosition.Left;       CalloutRectangle.Padding.Left:=CalloutRectangle.CalloutLength+CalloutRectangle.XRadius;       CalloutRectangle.Padding.Right:=CalloutRectangle.XRadius;     end;   end;   CalloutRectangle.Padding.Top:=1;   CalloutRectangle.Padding.Bottom:=1;   lcLayout.AddObject(CalloutRectangle);   Item:=TLabel.Create(CalloutRectangle);   Item.TextSettings.Font.Size:=MessageFontSize;   CalloutRectangle.AddObject(Item);   Item.Align:=TAlignLayout.Client; {$IFDEF MSWINDOWS}   Item.OnClick:=MyMsgContainerOnClick; {$ENDIF MSWINDOWS}   Item.Text:=PDate+' '+PAutor+#10+PMessage;   Item.HitTest:=True;   Item.WordWrap:=True;   lcHeight:=CalculateTextItemHeight(Item);   lcLayout.Height:=lcHeight;   URL:=ExtractURL(pMessage);   Item.StyledSettings:=Item.StyledSettings- [TStyledSetting.Size,TStyledSetting.Style];   if Not URL.IsEmpty then   begin     lcLayout2:=TLayout.Create(lcLayout);     lcLayout2.Align:=TAlignLayout.Client;     lcLayout2.Margins.Left:=5;     lcLayout2.Margins.Right:=5;     lcLayout.AddObject(lcLayout2);     Button:=TButton.Create(lcLayout2);     Button.Text:='Открыть';     Button.Align:=TAlignLayout.Center;     Button.HelpKeyword:=URL;     Button.OnClick:=ButtonClick;     lcLayout2.AddObject(Button);   end;   lcLayout.OnResize:=LayoutResize;   Result:=lcLayout; end; function TChatBox.ExtractURL(pString : String) : String; Var S : String; begin   Result:='';   if Not pString.Contains('http') then     Exit;   S:=pString.Substring(Pos('http',pString)-1);   S:=S.Remove(S.IndexOfAny([' ',',']));   Result:=S.TrimRight(['.']); end; end.
  9. Like
    Евгений Корепов отреагировална Brovin Yaroslav в [Android] Как отключить программную кнопку Меню?   
    Чтобы при повороте приложение не вылетало на версиях среды до XE8 включительно дополнительно нужно добавить значение screenSize для атрибута android:configChanges в манифест. Так как 14 версия требует обязательного наличия этого значения.
    Начиная с XE10 правок вносить не надо.
    Было:
    <activity android:name="com.embarcadero.firemonkey.FMXNativeActivity" android:label="%activityLabel%" android:configChanges="orientation|keyboard|keyboardHidden" android:launchMode="singleTask"> Стало:
    <activity android:name="com.embarcadero.firemonkey.FMXNativeActivity" android:label="%activityLabel%" android:configChanges="orientation|keyboard|keyboardHidden|screenSize" android:launchMode="singleTask">
  10. Like
    Евгений Корепов отреагировална magicxor в RAD XE9 (RAD X Seattle)   
    http://docwiki.embarcadero.com/RADStudio/Seattle/en/What's_New#Support_for_Internationalized_Domain_Names
     
    Заявленная TURI.UnicodeToIDNA выдаёт какой-то бред. Завёл багрепорт https://quality.embarcadero.com/browse/RSP-12099
  11. Like
    Евгений Корепов отреагировална Равиль Зарипов (ZuBy) в узнать расстояние между 2 точками   
    uses Math, FMX.Maps
    function TMapsEngine.GetDistance(const aStart, aEnd: TMapCoordinate): Real; const   Radius = 6372795;   PiDiv180 = Pi / 180; var   CosLatStart, SinLatStart, CosLatEnd, SinLatEnd, Delta, CosDelta, SinDelta, X, Y: Real; begin   try     CosLatStart := Cos(aStart.Latitude * PiDiv180);     CosLatEnd := Cos(aEnd.Latitude * PiDiv180);     SinLatStart := Sin(aStart.Latitude * PiDiv180);     SinLatEnd := Sin(aEnd.Latitude * PiDiv180);     Delta := (aEnd.Longitude * PiDiv180) - (aStart.Longitude * PiDiv180);     CosDelta := Cos(Delta);     SinDelta := Sin(Delta);     Y := Sqrt(((CosLatEnd * SinDelta) * (CosLatEnd * SinDelta)) + ((CosLatStart * SinLatEnd - SinLatStart * CosLatEnd * CosDelta)       * (CosLatStart * SinLatEnd - SinLatStart * CosLatEnd * CosDelta)));     X := SinLatStart * SinLatEnd + CosLatStart * CosLatEnd * CosDelta;     Result := Round(ArcTan2(Y, X) * Radius);   except     Result := -1;   end; end; рассчитывает отрезок по прямой, не по дороге!
  12. Like
    Евгений Корепов отреагировална Andrey Efimov в транслировать изображение экрана Андроид-смартфона   
    Можно использовать App Tethering. В демках студии есть готовый пример: C:\Users\Public\Documents\Embarcadero\Studio\16.0\Samples\Object Pascal\RTL\Tethering\DesktopCast
     
    Подробности по использованию App Tethering можно почитать в справке(на англ. Using App Tethering), либо у меня в блоге (на русском):
    App Tethering #1: Поиск и подключение к удалённым приложениям App Tethering #2: Используем удалённые действия (Actions) App Tethering #3: Передача и получение данных
  13. Like
    Евгений Корепов отреагировална Brovin Yaroslav в [TfgRichEdit]- компонент редактирования текста с поддержкой форматирования   
    Новые вести с полей.
    Проверена работа на Андроиде. Рендеринг прошел нормально.  Добавлена возможность указывать межстрочный интервал для параграфов. Значительно переработаны настройки. Теперь можно задавать настройки для всех элементов в целом, для всех параграфов, так и локально для одного параграфа.
  14. Like
    Евгений Корепов отреагировална Brovin Yaroslav в [TfgRichEdit]- компонент редактирования текста с поддержкой форматирования   
    Приступил к созданию компонента по отображению текста с поддержкой форматирования для настольной версии клиента, чтобы отображать HTML разметку постов.
    На текущий момент уже поддерживаются следующие возможности:
    Параграфы и просто блоки текста (<p>, <span>) Изменение цвета для любого текста (color) Изменение параметров шрифта (размер, название, стиль) (font-size, font-style, font-weight, font-family, <b>, <strong>) Разрыв строки (<br/>)  



  15. Like
    Евгений Корепов отреагировална bigjorj в TSearchBox кнопка очистки   
    procedure TMainForm.SearchChanelEditChangeTracking(Sender: TObject); var Lower: string; begin Lower := SearchChanelEdit.Text.Trim.ToLower; if Lower = '' then begin if Assigned(listView.Items.Filter) then begin // Clear filter listView.Items.Filter := nil; end; end else begin // Start or update filter listView.ItemIndex := -1; listView.Items.Filter := function(X: string): Boolean begin Result := Lower.IsEmpty or X.ToLower.Contains(Lower); end; end; end; Передача фильтра в ListView
  16. Like
    Евгений Корепов отреагировална ruslan в Можно ли программно передать фокус на SearchBox и очистить строку?   
    проще
     
      TCustomListView_helper = class helper for TCustomListView     function SearchEdit: TSearchBox;   end; { TCustomListView_helper } function TCustomListView_helper.SearchEdit: TSearchBox; begin   Result:= Self.FSearchEdit; end;
  17. Like
    Евгений Корепов отреагировална ggravee в InAppPurchase   
    Проблему решил. Тему можно закрывать или удалять (если неинтересная).
    Забыл поставить
    FInAppPurchase.QueryProducts;
    после сетапа.
    Хотя странное поведение Memo это не объясняет...
  18. Like
    Евгений Корепов отреагировална zonik в [Android] Обработка приложением неявного намерения (Intent)   
    Для получения «content» я сделал так
     

    var Intent: JIntent; Uri: Jnet_Uri; INStream: JInputStream; OUTStream: JOutputStream; outputfile: string; FFF: JFile; NumRead, NumWritten: Longint; Buffer: TJavaArray<Byte>; begin ... Intent := SharedActivity.getIntent; if (Pos('image/', JStringToString(Intent.getType))>0) or (Pos('audio/', JStringToString(Intent.getType))>0) or (Pos('video/', JStringToString(Intent.getType))>0) or (Pos('application/', JStringToString(Intent.getType))>0) or ('*/*' = JStringToString(Intent.getType)) then begin if JStringToString(Intent.getType) <> '' then begin Parcel := Intent.getParcelableExtra(TJIntent.JavaClass.EXTRA_STREAM); Uri := TJnet_Uri.Wrap(Parcel); if JStringToString(Uri.getScheme) = 'content' then begin if Pos('/mpeg', JStringToString(Intent.getType)) > 0 then outputfile := 'my.mp3' else if Pos('/jpeg', JStringToString(Intent.getType)) > 0 then outputfile := 'my.jpg' else outputfile := 'my.' + copy(JStringToString(Intent.getType), Pos('/', JStringToString(Intent.getType))+1, Length(JStringToString(Intent.getType)));//выдергиваем имя типа для того чтобы сделать его расширением //на случай если в Intent не уточнен тип, а указана *, например image/* if Pos('.*', outputfile) > 0 then outputfile := StringReplace(outputfile, '.*', '.tmp', [rfReplaceAll]); Buffer := TJavaArray<Byte>.Create(4096); INStream := SharedActivityContext.getContentResolver.openInputStream(Uri); try FFF := TJFile.JavaClass.init(StringToJString(<ИМЯ_ПАПКИ>), StringToJString(outputfile)); FFF.setWritable(true, false); OUTStream := TJFileOutputStream.JavaClass.init(FFF); repeat NumRead := inStream.read(buffer); if (NumRead <= 0) then Break; outStream.write(buffer, 0, NumRead); application.ProcessMessages; until NumRead <= 0; outStream.close; inStream.close; except on e: exception do raise Exception.CReate('Error. Can''t copy file'); end; end end end end может не самое оптимальное, но работает, в итоге у вас файл с именем outputfile и в папке <ИМЯ_ПАПКИ>
  19. Like
    Евгений Корепов отреагировална Belov.V. в [Android] Обработка приложением неявного намерения (Intent)   
    Регистрируем намерение через файл манифеста (ниже для файлов с типом xml). Для Android 3.2 адекватнее работал второй фильтр:
    <activity … <intent-filter> <action android:name="android.intent.action.VIEW" /> <category android:name="android.intent.category.DEFAULT" /> <data android:scheme="file" /> <data android:mimeType="text/xml" /> <data android:mimeType="application/xhtml+xml" /> </intent-filter> <!-- Для 3.2 --> <intent-filter> <action android:name="android.intent.action.VIEW" /> <category android:name="android.intent.category.DEFAULT" /> <data android:scheme="file" /> <data android:mimeType="*/*" /> <data android:host="*" /> <data android:pathPattern=".*\\.xml" /> <data android:pathPattern=".*\\..*\\.xml" /> <data android:pathPattern=".*\\..*\\..*\\.xml" /> <data android:pathPattern=".*\\..*\\..*\\..*\\.xml" /> <data android:pathPattern=".*\\..*\\..*\\..*\\..*\\.xml" /> </intent-filter> Регистрируем свой обработчик события для на событие смены состояния приложения:
    procedure TForm1.FormCreate(Sender: TObject); var ApplicationService: IFMXApplicationEventService; begin if TPlatformServices.Current.SupportsPlatformService(IFMXApplicationEventService, ApplicationService) then ApplicationService.SetApplicationEventHandler(ApplicationEventChanged); end; Оформляем обработчик.
    Получение файла можно перенести в Form1.onCreate, но я для экспериментов с activity делал тут:
    function TForm1.ApplicationEventChanged(AAppEvent: TApplicationEvent; AContext: TObject): Boolean; var intent : JIntent; fileFullPath : String; begin intent := SharedActivity.getIntent; // BecameActive if AAppEvent = TApplicationEvent.BecameActive then begin if Assigned(intent) and TJIntent.JavaClass.ACTION_VIEW.equals(intent.getAction) then begin fileFullPath := JStringToString(intent.getData.getPath); if FileExists(fileFullPath) then begin // обработка файла fileFullPath // ... end; end; end // завершаем Activity при переводе приложения в "Background" else if AAppEvent = TApplicationEvent.EnteredBackground then SharedActivity.finish; // Result := True; end; Хочу обратить внимание, что привел только сам принцип. Очень важно корректно завершить активность (при сворачивании приложения, отключении экрана и т.д. ), т.к. при повторном вызове активности будет вызываться последний из стека. И если его не закрывать будем получить предыдущий, не закрытый activity. А если за приложением зарегистрировано несколько Activity (приложение можно вызвать из ланчера или как в примере, для обработки файла по типу).... в общем тут есть с чем поиграться.   Для желающих посмотреть поведение и последовательность выкладываю пример, который формирует лог обработки. Нужно закоментировать:    else if AAppEvent = TApplicationEvent.EnteredBackground then SharedActivity.finish; И посмотреть что и когда приложение получает в SharedActivity и AAppEvent.   Ссылка в тему: http://developer.android.com/guide/topics/manifest/activity-element.html#     Что не получилось: 1) Некоторые программы отдают файл в схеме «content» (к примеру Gmail v5.1 отдает). Как в этом случае получить содержание файла не разобрался. Поэтому в фильтре ограничил вид контента "file" 2) Не смог добраться до стека Activity. Если приложение в памяти и повторно вызывается с новой activity - возможно вот тут это могло пригодиться. (activity ... android:launchMode="singleTop" в этом случае не помог).   ADD: было обсуждение, кто как закрывает приложения на андроид, чтобы не оставалось в памяти. Если добавлять SharedActivity.finish приложение 100% убирается из памяти.    
    Intent_Get-File.zip
  20. Like
    Евгений Корепов отреагировална Равиль Зарипов (ZuBy) в [Android] Как можно изменить стиль кнопки в TListViewItem?   
    ListView1.DeleteButtonText := 'Удалить'; // меняем текст ListView1.CanSwipeDelete := false; // отключить появление кнопки
  21. Like
    Евгений Корепов отреагировална Brovin Yaroslav в Как разместить программно TTimeEdit в ListView?   
    Главные отличия TListView от TListBox в:
    TListBoxItem - контрол, TListViewItem - нет В TListBoxItem можно добавлять любые контролы, используя Parent. В TListVIewItem - нет. TListVIewItem хранит только данные для отображения TListVIewItem сам выполняет отрисовку хранимых данных через метод Render За счет собственно ручной отрисовки в TListVIewItem достигается прирост скорости и малое потребление памяти (хранение только актуальных данных) Чтобы создать свой вариант TListViewItem, нужно создать свой класс итема, в нем реализовать требуемые данные (например время) и создать in-place редактор для редактирования времени, зарегистрировать его и тд. P.S. В вашем случае, проще использовать Master-Detail подход. При котором по нажатию на итем, будет открываться вкладка для редактирования информации об итеме, в том числе время через TTimeEdit. Это будет быстрее и проще.
     
    P.S.P.S. Если же вы все-таки хотите создать свой итем, будьте готовы, что придется детально изучить, как это делается в самом TListVew.
  22. Like
  23. Like
    Евгений Корепов отреагировална BurcevD в Как установить свойство Max   
    Уважаемые разработчики, скажите пожалуйста, а будет ли у компонента свойство Max?
    А то получается с левой стороны проценты, а с правой те же самые проценты, только в количественном эквиваленте.
     
    Поясню:
    Если бы было например максимальное значение 200, а текущее положение 150, то слева было бы написано 75%, а с правой стороны 150/200. 
    Сейчас такого установить невозможно.
  24. Like
    Евгений Корепов отреагировална Andrey Efimov в Delphi XE8 автозагрузка приложения в Android   
    Я, другого способа не знаю, может уже и есть, но мне на глаза не попадался, поэтому написал способ, который точно должен сработать.   Про компонент: Ресейвер можно прописывать через манифест, а можно регистрировать во время работы приложения. Отличия в том: что через манифест ресейвер статичен, т.е. он всегда будет существовать и принимать сообщения, даже когда приложение закрыто а регистрация во время работы приложения, позволяет создать временный ресейвер, который будет работать, только если приложение уже запущено По поводу ошибки, точно не подскажу, возможно, это из-за того, что в манифесте указан не существующий java-класс.     p.s. В XE7-XE8 задача склеивания с файлом classes.dex значительно упрощена.   Полезные статьи: Как добавить jar библиотеку в проект (XE7-XE8) Как подключить и использовать свой JAVA-класс (общая инфа) Как создавать обёртки для JAVA-кода (ручной способ, ещё до появления утилиты)
  25. Like
    Евгений Корепов отреагировална Andrey Efimov в Delphi XE8 автозагрузка приложения в Android   
    Да-да. Пишите java-класс с событием onReceive, в котором пишем код, запускающий приложение. В манифесте подписываемся на сообщения системы, указывая имя java-класса .
     
    Работает так:
    1) Система запустилась и послала всем подписанным приложениям сообщение об окончании запуска
    2) Ваше приложение, а точнее класс который вы написали, с событием onReceive, получает сообщение и запускает ваше приложение
×
×
  • Создать...