Class App Inherits MobileApplication

Const useSentry = False

EventHandler Sub Opening() //Do some initialization AppStoreModule.Init call AppStoreModule.CheckSubscriptions //RevenueCat is optional but highly recommended to manage users and subscriptions Dim rvc As new RevenueCat rvc.Init End EventHandler

End Class

Class Screen1 Inherits MobileScreen

End Class

Class LaunchScreen Inherits MobileScreen

End Class

Sign

End Sign

Sign

End Sign

Class myPaymentQueue Inherits SKPaymentQueueMBS

Delegate Sub RestoreFailedDelegate(Error as NSErrorMBS)

Delegate Sub UpdatedTransactionsDelegate(transactions() as SKPaymentTransactionMBS)

Event restoreCompletedTransactionsFailedWithError(Error as NSErrorMBS) End Event

Event updatedTransactions(transactions() as SKPaymentTransactionMBS) End Event

EventHandler Sub restoreCompletedTransactionsFailedWithError(Error as NSErrorMBS) 'MessageBox "Restoring completed transactions failed with Error: "+Error.localizedDescription call AppStoreModule.CheckSubscriptions RaiseEvent restoreCompletedTransactionsFailedWithError(Error) if RestoreFailedCallback <> nil then RestoreFailedCallback.Invoke(Error) end if End EventHandler

EventHandler Sub updatedTransactions(transactions() as SKPaymentTransactionMBS) #if DebugBuild System.DebugLog CurrentMethodName #endif // Implement the updatedTransactions method // The observer’s updatedTransactions method is called whenever new transactions are created or updated. for each transaction as SKPaymentTransactionMBS in transactions Select case transaction.transactionState case SKPaymentTransactionMBS.StatePurchased #if app.useSentry app.sentry.AddExtraKeyValue("transactionState", "Purchased") #endif completeTransaction Transaction case SKPaymentTransactionMBS.StateFailed #if app.useSentry app.sentry.AddExtraKeyValue("transactionState", "Failed") #endif failedTransaction transaction case SKPaymentTransactionMBS.StateRestored #if app.useSentry app.sentry.AddExtraKeyValue("transactionState", "Restored") #endif restoreTransaction transaction end Select next RaiseEvent updatedTransactions(transactions) if UpdatedTransactionsCallback <> nil then UpdatedTransactionsCallback.Invoke(transactions) end if call AppStoreModule.CheckSubscriptions #if app.useSentry app.sentry.RemoveExtraKeyValue("transactionState") #endif End EventHandler

Sub completeTransaction(transaction as SKPaymentTransactionMBS) System.DebugLog CurrentMethodName // Your observer provides the product when the user successfully purchases an item. #if DebugBuild MessageBox "Transaction is now complete"+EndOfLine+EndOfLine+Transaction.payment.productIdentifier #endif // todo recordTransaction transaction provideContent transaction.payment.productIdentifier // Remove the transaction from the payment queue. self.finishTransaction Transaction // A successful transaction includes a transactionIdentifier property and a transactionReceipt // property that record the details of the processed payment. Your application is not required // to do anything with this information. You may wish to record this information to establish // an audit trail for the transaction. If your application uses a server to deliver content, // the receipt can be sent to your server and validated by the App Store. // It is critical that your application take whatever steps are necessary to provide the // product that the user purchased. Payment has already been collected, so the user expects // to receive the new purchase. See “Feature Delivery” for suggestions on how you might implement this. // Once you’ve delivered the product, your application must call finishTransaction // to complete the transaction. When you call finishTransaction, the transaction // is removed from the payment queue. To ensure that products are not lost, your // application should deliver the product before calling finishTransaction. End Sub

Sub failedTransaction(transaction as SKPaymentTransactionMBS) System.DebugLog CurrentMethodName // Finish the transaction for a failed purchase. if transaction.error.code <> StoreKitMBS.SKErrorPaymentCancelled then // Optionally, display an error here. 'MessageBox "Transaction is failed."+EndOfLine+EndOfLine+Transaction.error.localizedDescription end if self.finishTransaction Transaction // Usually a transaction fails because the user decided not to purchase the item. // Your application can read the error field on a failed transaction to learn // exactly why the transaction failed. // The only requirement for a failed purchase is that your application remove // it from the queue. If your application chooses to put up an dialog displaying // the error to the user, you should avoid presenting an error when the user // cancels a purchase. End Sub

Sub provideContent(identifier as string) #if DebugBuild System.DebugLog CurrentMethodName #endif 'MessageBox "Provide Content for "+identifier //Save the identifier in NSUserDefaults NSUserDefaults.SetBoolForKey(True, identifier) dim userInfo as new Dictionary userInfo.Value("productID") = identifier Notification_Center.JK_NotificationCenter.MainCenter.PostNotification(_ new Notification_Center.JK_Notification(AppStoreModule.SKProvideContentForProductNotification, self, userInfo)) End Sub

Sub recordTransaction(Transaction as SKPaymentTransactionMBS) //This method can be ignored if you do not need to send the successful payment to your database if Transaction is nil then Return Dim transactionDate As DateTime Dim price As String Dim success As Boolean Dim identifier As String = transaction.transactionIdentifier transactionDate = Transaction.transactionDateTime Dim productID As String Dim quantity As Integer Dim appUserName As String dim payment as SKPaymentMBS = Transaction.payment if payment <> nil then productID = payment.productIdentifier quantity = payment.quantity appUserName = payment.applicationUsername Else productID = "Payment is nil" end if Dim state As String Dim restored As Boolean Select case transaction.transactionState case SKPaymentTransactionMBS.StatePurchased state = "Purchased" success = True if AppStoreModule.firstPurchase is nil then AppStoreModule.firstPurchase = DateTime.Now end if case SKPaymentTransactionMBS.StateFailed state = "Failed" case SKPaymentTransactionMBS.StateRestored state = "Restored" restored = True case SKPaymentTransactionMBS.StateDeferred state = "Deferred" else state = "unknown state" end Select //This is where you can record the transaction in an online database #if False Dim js As new Dictionary try js.Value("transactionID") = identifier if transactionDate <> Nil Then js.Value("transactionDate") = transactionDate.SQLDateTime end if js.Value("productID") = productID js.Value("quantity") = quantity js.Value("appUsername") = appUserName js.Value("origin") = "iOS" js.Value("store") = "AppStore" js.Value("state") = state if productID.Contains("yearly") or productID.Contains("monthly") or productID.Contains("subscription") then js.Value("subscription") = 1 Else js.Value("subscription") = 0 end if 'js.Value("userID") = Session.userID js.Value("user_uuid") = Globals.user_uuid 'js.Value("internalProduct") = "" js.Value("purchase_uuid") = Module1.RandomUUID Dim hValue As String Select case AppStoreModule.highlight case cIAPController.Highlights.None hValue = "none" case cIAPController.Highlights.Ads hValue = "ads" case cIAPController.Highlights.categories hValue = "categories" case cIAPController.Highlights.quotes hValue = "quotes" case cIAPController.Highlights.reminders hValue = "reminders" case cIAPController.Highlights.themes hValue = "themes" Else Break End Select js.Value("internalProduct") = hValue //Find the product Dim purchasedProduct As SKProductMBS if AppStoreModule.ProductRequest <> nil then for each p as SKProductMBS in AppStoreModule.ProductRequest.validProducts if p.productIdentifier = productID then purchasedProduct = p exit end if next if purchasedProduct <> nil then js.Value("price") = purchasedProduct.price js.Value("locale") = purchasedProduct.priceLocale.Identifier js.Value("currencySymbol") = purchasedProduct.priceLocale.CurrencySymbol try price = purchasedProduct.price.ToString(locale.Current, "0.00") + " " + purchasedProduct.priceLocale.Identifier.Right(3) Catch End Try end if end if //And finally send the json to your database Globals.OnlineDatabase.PostJS("purchases", js) Catch err #if app.useSentry app.sentry.AddExtraKeyValue("js", GenerateJSON(js)) app.sentry.SubmitException(err, CurrentMethodName + "_err") #endif end try #endif if success then //Do something special on success End If Exception err #if app.useSentry app.sentry.SubmitException(err, CurrentMethodName) #endif End Sub

Sub restoreTransaction(transaction as SKPaymentTransactionMBS) // Finish the transaction for a restored purchase. System.DebugLog CurrentMethodName recordTransaction transaction if transaction.originalTransaction <> nil and transaction.originalTransaction.payment <> nil then provideContent transaction.originalTransaction.payment.productIdentifier end if self.finishTransaction transaction 'AppStoreModule.PaymentQueue.finishTransaction Transaction // This routine is similar to that for a purchased item. // A restored purchase provides a new transaction, including a different transaction // identifier and receipt. You can save this information separately as part of any // audit trail if you desire. However, when it comes time to complete the transaction, // you’ll want to recover the original transaction that holds the actual payment object // and use its product identifier. End Sub

Property RestoreFailedCallback As RestoreFailedDelegate

Property UpdatedTransactionsCallback As UpdatedTransactionsDelegate

End Class

Module AppStoreModule

ComputedProperty Protected firstPurchase As DateTime

Sub Set() NSUserDefaults.SetTextForKey(value.sqldatetime, "firstPurchase") End Set

Sub Get() Try Dim t As String = NSUserDefaults.TextForKey("firstPurchase") If t.isEmpty = False Then Dim d As DateTime = DateTime.FromString(t) Return d End If Catch End Try End Get

End ComputedProperty

Const SKProvideContentForProductNotification = skprovidecontent

Const kIAPPrefix = ""

Const localAnnualy = "Annually"

Const localBestDeal = "Best deal"

Const localCancelAnytime = "Cancel anytime"

Const localContinue = "Continue "

Const localFamilySharing = "Purchase can be shared with family group."

Const localLifetime = "Lifetime"

Const localMonthly = "Monthly "

Const localMostPopular = "Most popular"

Const localPerMonth = "per month"

Const localPerYear = "per year"

Const localPricePerMonth = "2.99 / month"

Const localPricePerYear = "2.99 / year"

Const localPrivacyPolicy = "Privacy policy"

Const localRestore = Already purchased? Restore

Const localSavePercent = "Save %1"

Const localTermsOfUse = "Terms of use"

Const localTotalReviews = "Based on over 2,000 reviews"

Protected Function CheckPurchase(ID as string) As boolean var receipt as AppReceiptMBS Receipt = AppReceiptMBS.bundleReceipt if receipt=nil then return false var ar() as AppReceiptIAPMBS = receipt.inAppPurchases for i as integer= 0 to ar.LastIndex if ar(i).productIdentifier = id then if ar(i).cancellationDateTime = nil then return true end if end if next i return false End Function

Protected Function CheckSubscriptions() As String() #if not DebugBuild #Pragma Error "Need to change subscription identifiers" #endif //Add all identifiers for your subscriptions subscriptionIDs.Add "<<app.premium.month.3" subscriptionIDs.Add "<<app.premium.year.10" subscriptions.removeall var receipt as AppReceiptMBS Receipt = AppReceiptMBS.bundleReceipt var active() as String if receipt = nil then return active var ar() as AppReceiptIAPMBS = receipt.inAppPurchases var dt as datetime = datetime.now for each identifier as String in subscriptionIDs identifier = identifier.Lowercase.Trim var valid as boolean for i as integer = 0 to ar.LastIndex if ar(i).productIdentifier.Lowercase.Trim <> identifier then continue if ar(i).subscriptionExpirationDateTime = nil then subscriptions.AddRow ar(i) active.Add ar(i).productIdentifier exit end if if ar(i).isActiveAutoRenewableSubscriptionForDate( dt ) then subscriptions.AddRow ar(i) active.Add ar(i).productIdentifier end if next i next identifier Return active() End Function

Protected Sub GetAllKnownProducts() Dim productIDs() As String //Add all identifiers for your subscriptions and one-time purchases #if not DebugBuild #Pragma error "Change your productIDs here" #endif productIDs.Add "<<app.premium.month.3" productIDs.Add "<<app.premium.year.10" GetProductInfoWithCallback(nil, productIDs) End Sub

Protected Function GetPrice(productID As String, divide12 As Boolean = False) As String For Each p As SKProductMBS In ProductRequest.validProducts If p.productIdentifier = productID Then Dim loc As new Locale( p.priceLocale.localeIdentifier ) Dim c As Currency = p.price if divide12 then c = Round(c/12*100)/100 End If Dim price As String = c.ToString(loc) Return price End If Next End Function

Protected Function GetProduct(productID As String) As SKProductMBS For Each p As SKProductMBS In ProductRequest.validProducts If p.productIdentifier = productID Then Return p End If Next End Function

Protected Sub GetProductInfo(list As iOSMobileTable, Identifiers() As String) // Your application creates an SKProductsRequest object and initializes it with a set // of product identifiers for the items you wish to sell, attaches a delegate to the // request, and then starts it. The response holds the localized product information // for all valid product identifiers. Your application cannot create a payment request // unless you have first retrieved the product information for that product. Dim ids() as String for each id as String in Identifiers if kIAPPrefix.IsEmpty = False and id.BeginsWith(kIAPPrefix) = False then ids.Add kIAPPrefix + id else ids.Add id end if next ProductRequest = New myProductsRequest(ids) ProductRequest.list = list ProductRequest.Start End Sub

Protected Sub GetProductInfo(list As iOSMobileTable, paramarray Identifier As String) // Your application creates an SKProductsRequest object and initializes it with a set // of product identifiers for the items you wish to sell, attaches a delegate to the // request, and then starts it. The response holds the localized product information // for all valid product identifiers. Your application cannot create a payment request // unless you have first retrieved the product information for that product. GetProductInfo(list, Identifier) End Sub

Protected Sub GetProductInfoWithCallback(callback As myProductsRequest.ReceivedResponseDelegate, Identifiers() As String) // Your application creates an SKProductsRequest object and initializes it with a set // of product identifiers for the items you wish to sell, attaches a delegate to the // request, and then starts it. The response holds the localized product information // for all valid product identifiers. Your application cannot create a payment request // unless you have first retrieved the product information for that product. For i as Integer = 0 to Identifiers.lastindex Dim id As String = Identifiers(i) if kIAPPrefix.IsEmpty = False and id.BeginsWith(kIAPPrefix) = False then id = kIAPPrefix + "." + id Identifiers(i) = id end if Next ProductRequest = New myProductsRequest(Identifiers) ProductRequest.callback = callback ProductRequest.Start End Sub

Protected Sub GetProductInfoWithCallback(callback As myProductsRequest.ReceivedResponseDelegate, paramarray Identifier As String) // Your application creates an SKProductsRequest object and initializes it with a set // of product identifiers for the items you wish to sell, attaches a delegate to the // request, and then starts it. The response holds the localized product information // for all valid product identifiers. Your application cannot create a payment request // unless you have first retrieved the product information for that product. GetProductInfoWithCallback(callback, Identifier) End Sub

Protected Function GetSavingsPercent(prodYear As SKProductMBS, prodMonth As SKProductMBS) As String Dim percent As Double = ((prodYear.price - prodMonth.price * 12)/(prodMonth.price * 12)) Dim savings As String = localSavePercent if savings <> "%1" then percent = percent * -1 end if savings = savings.Replace("%1", percent.ToString(locale.Current, "0%")) Return savings End Function

Protected Sub Init() // Register a transaction observer with the payment queue. // Your application should instantiate a transaction observer and add it as an observer of the payment queue. // Your application should add the observer when your application launches. // The App Store remembers queued transactions even if your application exited before completing // all transactions. Adding an observer during initialization ensures that all previously // queued transactions are seen by your application. PaymentQueue = new myPaymentQueue End Sub

Protected Sub PurchaseProduct(p as SKProductMBS, callback as myPaymentQueue.UpdatedTransactionsDelegate) Dim t As New SKPaymentMBS(p) PaymentQueue.UpdatedTransactionsCallback = callback PaymentQueue.addPayment t End Sub

Protected Sub PurchaseProduct(productID as String, callback as myPaymentQueue.UpdatedTransactionsDelegate) dim found As Boolean For Each p As SKProductMBS In ProductRequest.validProducts If p.productIdentifier = productID Then PurchaseProduct(p, callback) found = true exit End If Next #if app.useSentry if not found then break try Dim err As new RuntimeException err.Message = productID + " not found" raise err Catch err2 app.sentry.SubmitException(err2, CurrentMethodName + " not found") end try end if #endif End Sub

Protected Sub RestoreTransactions(updateCallback as myPaymentQueue.updatedTransactionsDelegate, failedCallback as myPaymentQueue.RestoreFailedDelegate) if PaymentQueue is nil then init() end if PaymentQueue.UpdatedTransactionsCallback = updateCallback PaymentQueue.RestoreFailedCallback = failedCallback PaymentQueue.restoreCompletedTransactions End Sub

Protected Function getSubscriptionInfo(forID as String) As AppReceiptIAPMBS var a() as AppReceiptIAPMBS for i as integer = 0 to subscriptions.LastIndex if subscriptions(i).productIdentifier.trim.Lowercase=forID.trim.Lowercase then a.add subscriptions(i) end if next i if a.Count=0 then return nil if a.Count=1 then return a(0) var newest as AppReceiptIAPMBS for i as integer = 0 to a.LastIndex if newest = nil then newest = a(i) continue end if if a(i).subscriptionExpirationDateTime > newest.subscriptionExpirationDateTime then newest=a(i) continue end if next i if newest<>nil then var dt as DateTime = newest.cancellationDateTime break end if return newest Exception return nil End Function

Protected Function isSubscriptionValid(id as String) As boolean var a as AppReceiptIAPMBS = getSubscriptionInfo(id) if a = nil then return false if a.cancellationDateTime<>nil then var d as datetime = datetime.now return a.subscriptionExpirationDateTime > d and a.cancellationDateTime > d else return a.subscriptionExpirationDateTime >= datetime.now end if Exception return false End Function

Property Protected PaymentQueue As myPaymentQueue

Property Protected ProductRequest As myProductsRequest

Property Protected highlight As cIAPController.Highlights

Property Private mfirstPurchase As DateTime

Property Protected subscriptionIDs() As String

Property Protected subscriptions() As AppReceiptIAPMBS

End Module

Class cIAPController

Const localBuyNow = Buy Now %1

Const localErrorAppStoreConnection = Cannot connect to the iTunes/App Store. Please try again.

Const localIAPAlreadyPurchased = Already purchased?

Const localIAPBlockedPayments = In-App payments seem to be restricted

Const localIAPNotFound = In-App product not found

Const localIAPNotPurchased = You haven’t purchased "%t" yet

Const localIAPRestoredPurchase = Your previous purchase has been restored

Const localIAPSpecialOffer = Special offer ends in %T

Const localIAPSpecialOfferSimple = 🎁 Special offer 🎁

Const localNotAvailable = Not available

Const localOneTimePurchase = One time purchase %1

Const localPurchaseFailed = Purchase Failed

Const localRecentReviews = Recent Reviews

Const localRestore = Already purchased? Restore

Const localXPriceInsteadOfY = instead of %Y

Enum Highlights None quotes categories reminders themes ads welcome End Enum

Protected Sub Destructor() End Sub

Sub LogPurchase(productID As String) //This method is used to log a purchase in your global database if necessary End Sub

Sub LogPurchaseView(products() As String, variation As String, highlight As cIAPController.Highlights, promo As Boolean, subscription As Boolean, offering As String = "") //This method is used to log a purchase page view in your global database if necessary self.displaydate = DateTime.Now self.variation = variation //Do something End Sub

Protected Sub RestoreTransactions() PaymentQueue.restoreCompletedTransactions End Sub

Property IAPMode As String = "B"

Property Protected displaydate As DateTime

Property Private purchase_viewsID As String

Property variation As String

End Class

Class myProductsRequest Inherits SKProductsRequestMBS

Delegate Sub ReceivedResponseDelegate(Success As Boolean)

EventHandler Sub didFailWithError(error as NSErrorMBS) #if DebugBuild System.DebugLog CurrentMethodName MessageBox AppStoreModule.cIAPController.localErrorAppStoreConnection + &u0A + error.localizedDescription #endif 'MessageBox "Failed with error: "+error.localizedDescription if callback <> nil then callback.Invoke(False) end if End EventHandler

EventHandler Sub didFinish() self.completed = True #if DebugBuild System.DebugLog CurrentMethodName #endif End EventHandler

EventHandler Sub didReceiveResponse(products() as SKProductMBS, invalidProductIdentifiers() as string) #if DebugBuild System.DebugLog CurrentMethodName #endif For Each p As SKProductMBS In products #if DebugBuild System.DebugLog CurrentMethodName + " product: "+p.localizedTitle #endif validProducts.Add p if list <> nil then Dim cd As MobileTableCellData = list.CreateCell(p.localizedTitle, p.localizedDescription+" "+p.priceString) cd.Tag = p list.AddRow(0, cd) end if next If ExtensionsXC.IsTestflightXC then if invalidProductIdentifiers.Count > 0 then MessageBox "Invalid: " + EndOfLine + string.FromArray(invalidProductIdentifiers) End If End If for each i as string in invalidProductIdentifiers #if DebugBuild 'Break System.DebugLog CurrentMethodName + "invalid: "+i #endif if list <> nil then Dim cd As MobileTableCellData = list.CreateCell(i, "Invalid product identifier") list.AddRow(0, cd) end if next if callback <> nil then callback.Invoke(true) end if list = nil callback = nil End EventHandler

Property callback As ReceivedResponseDelegate

Property completed As Boolean

Property list As iOSMobileTable

Property validProducts() As SKProductMBS

End Class

Class vIAPVertical Inherits MobileScreen

EventHandler Sub Activated() self.SetNavBarTransparentXC() End EventHandler

EventHandler Sub AppearanceChanged(dark As Boolean) self.SetNavBarTransparentXC() Rectangle1.FillColor = cgSystemBackground btBuy.SetCornerRadiusXC(50/2) if self.RightNavigationToolbar.Count > 0 then SetCloseButton end if End EventHandler

EventHandler Sub Closing() self.controller = nil if AppStoreModule.PaymentQueue <> nil then AppStoreModule.PaymentQueue.RestoreFailedCallback = nil AppStoreModule.PaymentQueue.UpdatedTransactionsCallback = nil end if JK_NotificationCenter.MainCenter.PostNotification("paywall_close", self) End EventHandler

EventHandler Sub Opening() me.Title = "" btBuy.Caption = localContinue btBuy.SetBackgroundColorXC(cgTint) btBuy.SetCornerRadiusXC(15) btBuy.CaptionColor = color.White Dim annualy, monthly, perYear, perMonth As String annualy = localAnnualy monthly = localMonthly perYear = localPerYear perMonth = localPerMonth timer.CallLater(2000, AddressOf SetCloseButton) //Cancelled ok Self.AddProgressXC(Progress) if controller is nil then controller = new cIAPController end if //Set the defaults: #if not DebugBuild #Pragma error "Need to change the purchase IDs" #endif self.monthlyID = "<<app.premium.month.3" self.annualID = "<<app.premium.year.10" LoadOffering() #if DebugBuild 'self.lifetimeID = "" #endif LoadProducts() LoadTable End EventHandler

EventHandler Sub ToolbarButtonPressed(button As MobileToolbarButton) // Part of the iScrollViewCC interface. Dim buttonTag As String = button.Tag select case buttonTag Case "debug" 'StoreKit.InAppPurchaseHelper.SKProvideContentForProductNotification Case "restore" AppStoreModule.RestoreTransactions(WeakAddressOf RestoreCompleted, WeakAddressOf RestoreFailed) Case "close" self.Close Else Break //Unknown button end select End EventHandler

Sub Constructor(highlight As cIAPController.Highlights) // Calling the overridden superclass constructor. // Note that this may need modifications if there are multiple constructor choices. // Possible constructor calls: // Constructor() -- From iOSContainerControl // Constructor() -- From iOSControl // Constructor(deserializer As xojo.Core._Deserializer) -- From iOSControl 'self.BigpromoID = Foundation.NSUserDefaults.StandardUserDefaults.TextForKey("bigpromo") Self.highlight = highlight 'self.LoadSchemeAndProducts(iapID) Super.Constructor End Sub

Protected Sub Dismiss() self.Close 'self.DismissViewControllerXC End Sub

Private Function GetPurchaseOptions() As dPurchaseOption() Dim options() as dPurchaseOption Dim prodYear As SKProductMBS = AppStoreModule.GetProduct(annualID) Dim prodMonth As SKProductMBS = AppStoreModule.GetProduct(monthlyID) Dim po As dPurchaseOption if prodYear is nil then Return options() end if Dim price As String Dim pricePerYear As String = localPricePerYear Dim pricePerMonth As String = localPricePerMonth price = pricePerYear.Replace("2.99", AppStoreModule.GetPrice(annualID)) Dim cancelCaption As String = localCancelAnytime lblCancel.Text = cancelCaption //Monthly po = new dPurchaseOption options.Add po po.productID = monthlyID po.callback = WeakAddressOf Purchase po.subscription = True po.title = localMonthly po.price = pricePerMonth.Replace("2.99", AppStoreModule.GetPrice(monthlyID, False)) po.save = "" po.img1 = nil po.caption1 = "" //////////////////// //Annualy po = new dPurchaseOption po.selected = true self.selectedPurchaseOption = po options.Add po po.subscription = True po.productID = annualID po.callback = WeakAddressOf Purchase po.title = localAnnualy po.price = price po.priceTotal = "(" + pricePerMonth.Replace("2.99", AppStoreModule.GetPrice(annualID, true)) + ")" '+ " (" + price + ")" po.cancel = cancelCaption if prodYear <> nil and prodMonth <> nil then Dim savings As String = AppStoreModule.GetSavingsPercent(prodYear, prodMonth) po.save = savings po.save = po.save.Uppercase end if if isFree then po.productID = productID po.price = AppStoreModule.GetPrice(productID) po.priceTotal = "" po.save = "Free" po.cancel = "" end if //Lifetime if lifetimeID.IsEmpty = False then Dim prodLifetime As SKProductMBS = AppStoreModule.GetProduct(lifetimeID) if prodLifetime <> nil then po = new dPurchaseOption options.Add po po.subscription = False po.productID = lifetimeID po.callback = WeakAddressOf Purchase po.title = localLifetime po.price = AppStoreModule.GetPrice(lifetimeID, False) po.save = "" end if end if Return options End Function

Protected Sub LoadOffering() //This method is optional. //If your app has different offerings setup on RevenueCat, use this method to select the correct one Dim offeringIdentifier As String = "3_10" //This is the RevenueCat offering identifier //New v2.4.4 //Load the offerings if not loaded yet if RevenueCat.HasOfferings = False then Dim rvc As new RevenueCat rvc.Init end if Dim offering As RevenueCatOffering = RevenueCat.GetOffering(offeringIdentifier) if offering is nil and offeringIdentifier.BeginsWith("Subscription_") = False then offeringIdentifier = "Subscription_" + offeringIdentifier offering = RevenueCat.GetOffering(offeringIdentifier) end if if offering <> nil then For each package as RevenueCatOfferingPackage in offering.packages if package.identifier = "$rc_annual" then self.annualID = package.platform_product_identifier Elseif package.identifier = "$rc_monthly" then self.monthlyID = package.platform_product_identifier elseif package.identifier = "$rc_lifetime" then self.lifetimeID = package.platform_product_identifier elseif package.identifier = "$rc_weekly" then self.weeklyID = package.platform_product_identifier end if Next Else offeringIdentifier = "" end if Globals.presented_offering_identifier = offeringIdentifier End Sub

Private Sub LoadProducts() Dim productIDs() As String productIDs.Add self.annualID productIDs.Add self.monthlyID #if not DebugBuild #Pragma error "Add more product identifiers if necessary #endif 'productIDs.Add "" //Reorder the product IDs Dim idx As Integer idx = productIDs.IndexOf(self.monthlyID) if idx > -1 then productIDs.RemoveAt(idx) end if idx = productIDs.IndexOf(self.annualID) if idx > -1 then productIDs.RemoveAt(idx) end if productIDs.AddAt(0, self.monthlyID) productIDs.AddAt(1, self.annualID) if self.lifetimeID.IsEmpty = False then idx = productIDs.IndexOf(self.lifetimeID) if idx > -1 then productIDs.RemoveAt(idx) end if productIDs.AddAt(2, self.lifetimeID) end if AppStoreModule.Init AppStoreModule.GetProductInfoWithCallback(AddressOf LoadProductsCompleted, productIDs) dim isPromo as boolean = (dateSpecialOfferEnd <> nil) Dim variation As String variation = "Vertical_v1" controller.LogPurchaseView(productIDs, variation, self.highlight, isPromo, True, globals.presented_offering_identifier) End Sub

Protected Sub LoadProductsCompleted(Success As Boolean) self.Progress.Visible = False If Not Success Then MessageBox(controller.localErrorAppStoreConnection) btBuy.Enabled = False 'btBuy.SetBackgroundColorXC(AppTheme.SkeletonColorDark) btBuy.AnimateAlphaXC(0.5) Return End If btBuy.Enabled = True if datasource <> nil then Dim section as Integer = 0 Dim options() as dPurchaseOption = GetPurchaseOptions datasource.Sections(section).rows.RemoveAll for each opt as dPurchaseOption in options datasource.AddRow(section, "") datasource.LastRowDicData(section).Value("tag") = opt datasource.LastRowDicData(section).Value("type") = "cellPurchaseFullWidth" next table.ReloadDataInSection(0) end if End Sub

Protected Sub LoadTable() table.TintColor = cgTint self.datasource = new dsPurchase Dim section As Integer Dim caption, detail As String Dim icon As Picture Dim accessory As MobileTableCellData.AccessoryTypes = MobileTableCellData.AccessoryTypes.None Dim iconSize As Integer = 20 Dim iconWeight As Picture.SystemImageWeights = Picture.SystemImageWeights.Medium dim firstSectionTitle As String = "" if table.Format = iOSMobileTable.Formats.InsetGrouped then firstSectionTitle = " " end if section = datasource.AddSection(firstSectionTitle) datasource.Sections(section).tag = "purchaseoptions" #if False caption = OnlineLoc("localPremiumAnnualDescription",localPremiumAnnualDescription, localPremiumAnnualDescription("en"), False) if caption.isTranslated then datasource.Sections(section).title = "" datasource.AddRow(section, localPremiumAnnualDescription) if isIPad or isiPhoneX then datasource.LastRowDicData(section).Value("Roundedfont30") = true datasource.LastRowDicData(section).Value("alignment") = ControlExtensionsXC.NSTextAlignment.center else datasource.LastRowDicData(section).Value("Roundedfont22") = true datasource.LastRowDicData(section).Value("alignment") = ControlExtensionsXC.NSTextAlignment.natural end if datasource.LastRowDicData(section).Value("lines") = 3 datasource.LastRowDicData(section).Value("type") = "cellTitle" end if #endif //Purchase options Dim options() as dPurchaseOption = GetPurchaseOptions() for each opt as dPurchaseOption in options datasource.AddRow(section, "", "", MobileTableCellData.AccessoryTypes.None, opt) datasource.LastRowDicData(section).Value("type") = "cellPurchaseFullWidth" next /////////////// //Features /////////////// caption = " " section = datasource.AddSection(caption) Dim imgCheck As Picture = Picture.SystemImage("checkmark.circle.fill", iconSize, iconWeight, nil) //Categories caption = "Unlock this special feature 🚀" detail = "" datasource.AddRow(section, caption, detail, accessory, nil, imgCheck) //No Ads caption = "No ads ❌" detail = "" icon = Picture.SystemImage("nosign", iconSize, iconWeight) datasource.AddRow(section, caption, detail, accessory, nil, icon) //Family Sharing caption = localFamilySharing if caption.Contains(" ") = False then section = datasource.AddSection("") icon = Picture.SystemImage("figure.2.and.child.holdinghands", iconSize, iconWeight) if icon <> nil then datasource.AddRow(section, caption, "", accessory, nil, icon) end if end if ////////////////// // Restore ////////////////// section = datasource.AddSection("") datasource.AddRow(section, "", localRestore, MobileTableCellData.AccessoryTypes.None, "restore", Picture.SystemImage("arrow.clockwise", 14)) ////////////////// // Terms of Use / Privacy ////////////////// section = datasource.AddSection("") caption = localTermsOfUse datasource.AddRow(section, "", caption, MobileTableCellData.AccessoryTypes.None, "terms", Picture.SystemImage("doc.text", 14)) caption = localPrivacyPolicy datasource.AddRow(section, "", caption, MobileTableCellData.AccessoryTypes.None, "privacy", Picture.SystemImage("shield.lefthalf.filled", 14)) 'datasource.LastRowDicData(section).Value("textColor") = cgTint table.DataSource = datasource End Sub

Protected Sub Purchase(productID As String) If SKPaymentQueueMBS.canMakePayments Then ShowProgressHUD() self.productID = productID 'if isFree then '//Nothing 'elseif ccPurchaseYear.Selected then 'self.productID = productID 'Elseif true then 'if ccPurchaseMonth.Selected then 'self.productID = productID 'Else 'Break 'end if AppStoreModule.PurchaseProduct(self.productID, WeakAddressOf updatedTransactions) Else 'MessageBox "Can't make payments with this computer. App Store not setup?" MessageBox cIAPController.localIAPBlockedPayments End If End Sub

Protected Sub Restore() ShowProgressHUD() AppStoreModule.RestoreTransactions(WeakAddressOf RestoreCompleted, WeakAddressOf RestoreFailed) Return End Sub

Private Sub RestoreCompleted(transactions() as SKPaymentTransactionMBS) self.progress.Visible = False if self.progressHUD <> nil then self.progressHUD.hide(true) end if Dim success As Boolean for each transaction as SKPaymentTransactionMBS in transactions Select case transaction.transactionState case SKPaymentTransactionMBS.StatePurchased success = True case SKPaymentTransactionMBS.StateFailed case SKPaymentTransactionMBS.StateRestored success = True end Select next if success then MessageBox(cIAPController.localIAPRestoredPurchase) end if End Sub

Private Sub RestoreFailed(Error as NSErrorMBS) self.progress.Visible = False if self.progressHUD <> nil then self.progressHUD.hide(true) end if MessageBox( "Error" + &u0A + Error.LocalizedDescription ) End Sub

Protected Sub SetCloseButton() self.RightNavigationToolbar.RemoveAllButtons Dim tbClose As MobileToolbarButton ' = AppTheme.GetCloseButton Dim pic As Picture = Picture.SystemImage("xmark", 0, Picture.SystemImageWeights.Regular) tbClose = new MobileToolbarButton(MobileToolbarButton.Types.Done, if(pic=nil, "Close", ""), pic) tbClose.Tag = "close" If self.RightNavigationToolbar.Count = 0 Then self.RightNavigationToolbar.AddButton tbClose Else self.LeftNavigationToolbar.AddButton tbClose End If End Sub

Protected Sub ShowProgressHUD() progressHUD = new MyProgressHUD(self) progressHUD.Mode = MyProgressHUD.ModeIndeterminate progressHUD.RemoveFromSuperViewOnHide = True progressHUD.backgroundView.ColorValue = &c000000A0 progressHUD.backgroundView.Style = progressHUD.backgroundView.BackgroundStyleSolidColor progressHUD.show() End Sub

Private Sub updatedTransactions(transactions() as SKPaymentTransactionMBS) for each transaction as SKPaymentTransactionMBS in transactions Select case transaction.transactionState case SKPaymentTransactionMBS.StatePurchased Dim identifier As String = transaction.payment.productIdentifier if identifier.Contains("yearly") or identifier.Contains("monthly") then NSUserDefaults.SetBoolForKey(True, "subscription") end if //Ok to close self.Close Return case SKPaymentTransactionMBS.StatePurchasing case SKPaymentTransactionMBS.StateFailed if Progress <> nil then Progress.Visible = False end if if progressHUD <> nil then progressHUD.hide(true) end if // Finish the transaction for a failed purchase. if transaction.error.code <> StoreKitMBS.SKErrorPaymentCancelled then // Optionally, display an error here. MessageBox "Error" + EndOfLine + EndOfLine + _ Transaction.error.localizedDescription + EndOfLine + EndOfLine + _ transaction.Error.Code.ToString end if case SKPaymentTransactionMBS.StateRestored if AppStoreModule.isSubscriptionValid(transaction.payment.productIdentifier) then MessageBox(cIAPController.localIAPRestoredPurchase) Return end if end Select next End Sub

Property Private Progress As MobileProgressWheel

Property Protected RatingsLoaded As Boolean

Property Protected annualID As String

Property Private caption2 As Text

Property controller As cIAPController

Property Private datasource As dsPurchase

Property Private Shared dateSpecialOfferEnd As DateTime

Property Private headerImageView As MobileImageViewer

Property highlight As cIAPController.Highlights

Property isFree As Boolean

Property Protected jsRatings As Text

Property lifetimeID As String

Property loadFail As Integer

Property Protected monthlyID As String

Property productID As String

Property productIDRich As Text

Property progressHUD As MyProgressHUD

Property selectedPurchaseOption As dPurchaseOption

Property Protected weeklyID As String

End Class

Class dsPurchase Inherits myDatasource

Protected Function RowData(table As iOSMobileTable, section As Integer, row As Integer) As MobileTableCellData // Part of the iOSMobileTableDataSource interface. #if DebugBuild Dim sectionName As String sectionName = GetSectionTitle(section) #endif Dim cell As MobileTableCellData Dim rows() As Dictionary rows = sections(section).rows Dim nd As Dictionary = rows(row) if nd.HasKey("type") then Dim type As String = nd.Value("type") Select case type Case "cellPurchaseOptions" Break 'cell = table.CreateCustomCell(GetTypeInfo(cellPurchaseOptions)) ' 'cellPurchaseOptions(cell.Control).Setup(nd.Value("tag")) Case "cellPurchaseFullWidth" cell = table.CreateCustomCell(GetTypeInfo(cellPurchaseFullWidth)) cellPurchaseFullWidth(cell.Control).option = (nd.Value("tag")) cell.SetSelectionStyleXC(TableExtensionsXC.selectionStyle.none) Return cell Case "cellPurchaseRatings" Break Case "cellTitle" cell = table.CreateCell Dim value As String = nd.Value("Text") Dim detail As String = nd.Value("detail") cell.Text = value cell.DetailText = detail cell.Image = nd.Lookup("image", Nil) cell.AccessoryType = nd.Value("accessory") cell.Tag = nd.Value("tag") if nd.HasKey("lines") then cell.AdjustsFontSizeToFitWidthXC(nd.Value("lines")) else cell.AdjustsFontSizeToFitWidthXC(2) end if cell.SetTableCellDetailBreakXC(ControlExtensionsXC.NSLineBreakMode.WordWrap, 3) cell.SetSelectionStyleXC(TableExtensionsXC.selectionStyle.none) if nd.HasKey("textColor") then cell.SetTextColorXC(nd.Value("textColor")) end if End Select cell.SetSelectionStyleXC(TableExtensionsXC.selectionStyle.none) else cell = table.CreateCell("") Dim value As String = nd.Value("Text") Dim detail As String = nd.Value("detail") cell.Text = value cell.DetailText = detail cell.Image = nd.Lookup("image", Nil) cell.AccessoryType = nd.Value("accessory") 'cell.TextColorXC = AppTheme.TableTextColor cell.Tag = nd.Value("tag") 'cell.AccessoryType = nd.Value( if nd.HasKey("lines") then cell.AdjustsFontSizeToFitWidthXC(nd.Value("lines")) else cell.AdjustsFontSizeToFitWidthXC(2) end if cell.SetTableCellDetailBreakXC(ControlExtensionsXC.NSLineBreakMode.WordWrap, 3) cell.SetSelectionStyleXC(TableExtensionsXC.selectionStyle.none) if nd.HasKey("textColor") then cell.SetTextColorXC(nd.Value("textColor")) end if end if Return cell End Function

Property variation As String

End Class

Class dPurchaseOption

Delegate Sub PurchaseDelegate(productID As String)

Property callback As PurchaseDelegate

Property cancel As String

Property caption1 As String

Property caption2 As String

Property description As String

Property img1 As Picture

Property img2 As Picture

Property price As String

Property priceTotal As String

Property productID As String

Property save As String

Property selected As Boolean

Property subscription As Boolean

Property tag As String

Property title As String

End Class

Class cellPurchaseFullWidth Inherits MobileTableCustomCell

ComputedProperty option As dPurchaseOption

Sub Set() moption = value if value.selected then ImageViewer1.Image = Picture.SystemImage("checkmark.circle.fill", 0) ImageViewer1.TintColor = cgTint Rectangle1.BorderColor = cgTint else ImageViewer1.Image = Picture.SystemImage("circle.fill", 0) ImageViewer1.TintColor = cgSecondarySystemFill Rectangle1.BorderColor = cgSecondarySystemFill end if lblTitle.Text = value.title lblTitle.TextColor = cgTextColor Dim ft As Font = font.BoldSystemFont(20) lblTitle.TextFont = ft 'lblTitle.AdjustsFontForContentSizeCategoryXC(UIFontTextStyle.body, ft, 30) lblTitle.AdjustsFontSizeToFitWidthXC(1) if value.subscription = False then lblPrice.Text = value.priceTotal + " " + value.price else lblPrice.Text = value.price end if lblPrice.TextColor = cgTextColor lblPrice.AdjustsFontForContentSizeCategoryXC(UIFontTextStyle.body) lblPrice.AdjustsFontSizeToFitWidthXC(1) if value.priceTotal.IsEmpty = False then lblPriceTotal.Visible = True lblPriceTotal.Text = value.priceTotal lblPriceTotal.TextColor = cgSecondaryLabel lblPriceTotal.AdjustsFontForContentSizeCategoryXC(UIFontTextStyle.subHeadline) lblPriceTotal.AdjustsFontSizeToFitWidthXC(1) Else lblPriceTotal.Visible = False end if if not value.save.IsEmpty then lblSave.AdjustsFontSizeToFitWidthXC Declare Sub userInteractionEnabled Lib UIKitLib Selector "setUserInteractionEnabled:" _ (obj As ptr, value As Boolean) userInteractionEnabled(lblSave.handle, False) lblSave.SetBackgroundColorXC(cgRed) lblSave.SetCornerRadiusXC(26/2) lblSave.CaptionColor = &cFFFFFF 'if lblSave.Caption <> value.save then lblSave.Caption = value.save 'lblSave.SetAlphaValueXC(0.0) 'lblSave.Visible = true 'lblSave.AnimateAlphaXC(1.0) 'Else lblSave.Visible = True 'end if 'lblSave.Caption = OnlineLoc("localBestDeal", localBestDeal, localBestDeal("en"), False).Uppercase 'me.SetButtonInsetsXC(ExtensionsXC.UIEdgeInsetMake(0, 4, 0, 4)) Else lblSave.Caption = "" lblSave.Visible = False end if End Set

Sub Get() Return moption End Get

End ComputedProperty

Property Private moption As dPurchaseOption

End Class

Class datasourceSection

Property allrows() As Dictionary

Property collapsed As Boolean

Property rows() As Dictionary

Property tag As Variant

Property title As String

End Class

Class myDatasource

ComputedProperty myTable As iOSMobileTable

Sub Set() mmyTableRef = xojo.Core.WeakRef.Create(value) End Set

Sub Get() if mmyTableRef <> nil then return iOSMobileTable(mmyTableRef.Value) End If End Get

End ComputedProperty

Const kLastupdate = 20181220

Delegate Sub MobileRowEditingDelegate(tag As Auto, action As iOSMobileTable . RowEditingStyles)

Delegate Sub RowEditingDelegate(tag As Auto, action As iOSMobileTable . RowEditingStyles)

Sub AddRow(section As Integer, title As String, detail As String = "", Accessory As MobileTableCellData.AccessoryTypes = MobileTableCellData.AccessoryTypes.None, tag As Auto = nil, image As Picture = nil) 'section As Integer, Text As Text, detail As Text, Accessory As MobileTableCellData.AccessoryTypes = MobileTableCellData.AccessoryTypes.Disclosure, tag As Auto, image As iOSImage = Nil dim nd As new Dictionary nd.Value("text") = Title nd.Value("detail") = detail nd.Value("accessory") = Accessory nd.Value("image") = image nd.Value("tag") = tag sections(section).rows.Add nd End Sub

Sub AddSection(title As String, tag As Auto = nil) Dim s As new datasourceSection s.title = title s.tag = tag s.collapsed = False Sections.Add s End Sub

Function AddSection(title As String, tag As Auto = nil) As Integer AddSection(title, tag) Return Sections.LastIndex End Function

Sub Constructor() End Sub

Protected Function GetSectionTitle(section As Integer) As String Return sections(section).title End Function

Sub InsertRow(index As Integer, section As Integer, title As String, detail As String, Accessory As MobileTableCellData.AccessoryTypes = MobileTableCellData.AccessoryTypes.Disclosure, tag As Auto) dim nd As new Dictionary nd.Value("text") = title nd.Value("detail") = detail nd.Value("accessory") = Accessory nd.Value("tag") = tag Dim rows() As Dictionary try sections(section).rows.Insert(index, nd) Catch err Try If section > sections.LastIndex Then err.Message = err.Message + &u0A + "Section greater than section count" Elseif index > rows.LastIndex+1 Then err.Message = err.Message + &u0A + "Index greater than row count" End If Catch End Try End Try End Sub

Sub InsertSection(index As Integer, title As String = "", tag As Auto = nil) Dim s As new datasourceSection s.title = title s.tag = tag s.collapsed = False Sections.Insert(index, s) End Sub

Function LastRowDicData(section As Integer) As Dictionary Dim rows() As Dictionary rows = sections(section).rows Return RowDicData(section, rows.LastIndex) End Function

Sub RemoveAllSections() Sections.ResizeTo(-1) End Sub

Sub RemoveRow(section As Integer, row As Integer) Dim rows() As Dictionary rows = sections(section).rows if row > -1 and row <= rows.LastIndex then //error #1370 rows.Remove row Else Break //Should never happen End If End Sub

Sub RemoveSection(index as Integer) sections.Remove(index) End Sub

Function RowCount(table As iOSMobileTable, section As Integer) As Integer // Part of the iOSMobileTableDataSource interface. If myTable = Nil Then myTable = table End If If section = -1 Or section > sections.LastIndex Then Return 0 End If Dim sectionData As datasourceSection = sections(section) Return sectionData.rows.Count End Function

Protected Function RowData(table As iOSMobileTable, section As Integer, row As Integer) As MobileTableCellData // Part of the iOSMobileTableDataSource interface. #if DebugBuild Dim sectionName As String sectionName = GetSectionTitle(section) #endif Dim cell As MobileTableCellData Dim rows() As Dictionary rows = sections(section).rows Dim nd as Dictionary = rows(row) cell = table.CreateCell() cell.Text = nd.Value("text") cell.DetailText = nd.Value("detail") cell.Image = nd.Lookup("image", Nil) cell.AccessoryType = nd.Value("accessory") cell.Tag = nd.Value("tag") Return cell End Function

Function RowDicData(section As Integer, row As Integer) As Dictionary #if DebugBuild Dim sectionName As String sectionName = GetSectionTitle(section) #endif Dim rows() As Dictionary rows = sections(section).rows If row <= rows.LastIndex Then Return rows(row) End If End Function

Function SectionCount(table as iOSMobileTable) As Integer // Part of the iOSMobileTableDataSource interface. #Pragma Unused table Return sections.Count End Function

Function SectionData(section as Integer) As datasourceSection If section = -1 Then Return nil End If Return sections(section) End Function

Private Function SectionTitle(table As iOSMobileTable, section As Integer) As String // Part of the iOSMobileTableDataSource interface. #pragma Unused table Return GetSectionTitle(section) End Function

Property Private mmyTableRef As Xojo.Core.WeakRef

Property sections() As datasourceSection

End Class

Module Notification_Center

End Module

Class NotificationRelation

ComputedProperty Observer As Object

Sub Set() 'mObserver = value mObserver = xojo.Core.WeakRef.Create(value) End Set

Sub Get() 'Return mObserver if mObserver <> nil then Return mObserver.Value end if End Get

End ComputedProperty

Sub Constructor(observer as object, callback as JK_NotificationCenter.NotificationCallBack, notificationName as text, sender as object) self.Observer = observer self.CallBack = callback self.NotificationName = notificationName self.Sender = sender End Sub

Sub SendNotification(anotification As JK_Notification) CallBack.Invoke(aNotification) End Sub

Function WantsNotification(aNotification As JK_Notification) As Boolean dim wants as Boolean = False if NotificationName = "" and sender = nil then //accepts all notifications from all sources wants = True end if if NotificationName = aNotification.Name and (sender = aNotification.Sender or Sender = nil) then //accepts notifications with this name from all senders or the sender is the accepted sender wants = True end if if Sender = aNotification.Sender and NotificationName = "" then //accepts all notifications from this sender wants = true end if Return wants End Function

Property CallBack As JK_NotificationCenter.NotificationCallBack

Property NotificationName As text

Property Sender As Object

Property Private mObserver As xojo.Core.WeakRef

End Class

Class JK_Notification

ComputedProperty Sender As Object

Sub Set() mSender = xojo.Core.WeakRef.Create(value) End Set

Sub Get() return mSender.Value End Get

End ComputedProperty

Sub Constructor(notificationName as Text, sender as Object) self.Constructor(notificationName,sender,nil) End Sub

Sub Constructor(notificationName as Text, sender as object, userInfoDict as Dictionary) self.Name = notificationName self.Sender = sender self.UserInfo = userInfoDict End Sub

Private Sub Destructor() mSender = nil End Sub

Property Name As Text

Property UserInfo As Dictionary

Property Private mSender As xojo.Core.WeakRef

End Class

Class JK_NotificationCenter

Delegate Sub NotificationCallBack(aNotification As JK_Notification)

Private Sub Cleanup() Dim u as Integer = relations.LastIndex for i as integer = u DownTo 0 if relations(i).observer is nil then relations.Remove(i) end if next End Sub

Private Sub Constructor() End Sub

Function HasObserverForNotification(aNotification As JK_Notification) As Boolean //jly Cleanup for i as Integer = 0 to relations.LastIndex If relations(i).WantsNotification(aNotification) then Return True end if next End Function

Shared Function MainCenter() As JK_NotificationCenter static mcenter as JK_NotificationCenter if mcenter = nil then mcenter = new JK_NotificationCenter end if Return mcenter End Function

Sub PostNotification(aNotification As JK_Notification) if aNotification = nil then Break 'A posted notification cannot be nil. Return end if //Do some cleanup if necessary Cleanup Dim found As Boolean for i as Integer = 0 to relations.LastIndex If relations(i).WantsNotification(aNotification) then relations(i).SendNotification(aNotification) found = true end if next #if DebugBuild if not found then System.DebugLog CurrentMethodName + ": couldn't find a receiver for " + aNotification.Name found = found end if #endif End Sub

Sub PostNotification(name as text, sender as object) PostNotification(name,sender,nil) End Sub

Sub PostNotification(name as text, sender as object, userInfo as Dictionary) PostNotification(new JK_Notification(name, sender, userInfo)) End Sub

Sub PostNotificationDelayed(afterMsec As Integer, aNotification As JK_Notification) if aNotification = nil then Break 'A posted notification cannot be nil. Return end if timer.CallLater(afterMsec, AddressOf PostNotificationDelayed_internal, aNotification) End Sub

Protected Sub PostNotificationDelayed_internal(value as Variant) Dim aNotification as JK_Notification = value self.PostNotification(aNotification) End Sub

Sub addObserver(observer as object, callback as NotificationCallBack, notificationName as text, sender as object) if callback = nil then break ' The callback for a notification must not be nil Return end if dim nr as new NotificationRelation(observer, callback,notificationName,sender) relations.Add nr End Sub

Sub addObservers(observer as object, callback as NotificationCallBack, notificationNames() as text, sender as object) if callback = nil then break ' The callback for a notification must not be nil Return end if For each notificationName as text in notificationNames dim nr as new NotificationRelation(observer, callback,notificationName,sender) relations.Add nr Next End Sub

Sub removeObserver(observer as Object) removeObserver(observer,"",nil) End Sub

Sub removeObserver(observer as object, notificationName as text, sender as object) dim tmpRelation as NotificationRelation for i as Integer = relations.LastIndex DownTo 0 tmpRelation = relations(i) if tmpRelation.Observer = observer then //observer is correct if notificationName = "" then //all notifications if tmpRelation.sender = sender or sender = nil then //sender matches relations.Remove i end if ElseIf tmpRelation.NotificationName = notificationName then //notificationName matches if tmpRelation.sender = sender or sender = nil then //sender matches relations.Remove i end if end if end if next End Sub

Property Private relations() As NotificationRelation

End Class

Class RevenueCat Inherits URLConnection

Const kDefaultOfferings = "{}"

EventHandler Sub ContentReceived(URL As String, HTTPStatus As Integer, content As String) self.requestInProgress = False if content.Encoding is nil then content = content.DefineEncoding(Encodings.UTF8) end if if HTTPStatus > 201 then if DebugBuild or ExtensionsXC.IsTestflightXC then MessageBox(url + EndOfLine + EndOfLine + content) end if if HTTPStatus <> 429 and url.Contains("attributes") = False then Dim err As new RuntimeException Break end if Return end if If HTTPStatus = 200 then if self.parseEntitlements then self.parseEntitlements = False try Dim dic As Dictionary = ParseJSON(content) if dic.HasKey("subscriber") then dim dicSubscriber As Dictionary = dic.Value("subscriber") if dicSubscriber.HasKey("entitlements") then Dim dicEntitlements As Dictionary = dicSubscriber.Value("entitlements") self.entitlements = dicEntitlements NSUserDefaults.SetTextForKey(GenerateJSON(dicEntitlements), "RevenueCatEntitlements_" + Globals.userID) end if end if Catch err #if app.useSentry app.sentry.AddExtraKeyValue("content", content) app.sentry.AddExtraKeyValue("URL", url) app.sentry.SubmitException(err, CurrentMethodName + "_entitlements") #endif end try Elseif self.parseOfferings then self.parseOfferings = False try Dim dic As Dictionary = ParseJSON(content) if dic.HasKey("offerings") then Dim vOfferings() as Variant = dic.Value("offerings") For each o as Dictionary in vOfferings self.offerings.Add new RevenueCatOffering(o) Next Dim value As String = GenerateJSON(dic.Value("offerings")) NSUserDefaults.SetTextForKey(value, "RevenueCatOfferings_" + Globals.userID) end if Catch err #if app.useSentry app.sentry.AddExtraKeyValue("content", content) app.sentry.AddExtraKeyValue("URL", url) app.sentry.SubmitException(err, CurrentMethodName + "_offerings") #endif end try End If else self.parseOfferings = False self.parseEntitlements = False End If End EventHandler

EventHandler Sub Error(e As RuntimeException) Static fails As Integer fails = fails + 1 if self.lastURL.Contains("offerings") then Timer.CallLater(min(30000, fails*1000), AddressOf GetOfferingsDefaultUserID) end if self.parseOfferings = False self.parseEntitlements = False self.requestInProgress = False End EventHandler

Private Sub Authorization() self.ClearRequestHeaders #if not DebugBuild #Pragma error "Change your RevenueCat API token here" #endif dim decodedString as String = "<<YOUR REVENUECAT API>>" if decodedString.BeginsWith("<<") then Break Return end if self.RequestHeader("Authorization") = "Bearer " + decodedString self.RequestHeader("accept") = "application/json" self.RequestHeader("X-Platform") = "iOS" Dim userID As String if Globals.userID.IsEmpty then userID = "0" else userID = Globals.userID end if self.RequestHeader("X-Version") = "4.23.0" self.RequestHeader("X-Platform-Version") = System.Version.ToString self.RequestHeader("X-Platform-Flavor") = "native" self.RequestHeader("X-Client-Version") = app.Version self.RequestHeader("X-Client-Build-Version") = app.NonReleaseVersion.ToString End Sub

Sub CreateSubscriber(userID As String) self.Authorization() 'self.RequestHeader("X-Platform-Version") = "1.0" 'self.RequestHeader("X-Observer-Mode-Enabled") = "false" 'self.RequestHeader("X-Is-Sandbox") = "false" self.parseEntitlements = True Dim url As String = "https://api.revenuecat.com/v1/subscribers/" + userID self.debug_postData = "" self.requestInProgress = True self.Send("GET", url) self.last_send_method = "GET" self.lastURL = url End Sub

Shared Function GetOffering(identifier As String) As RevenueCatOffering if offerings.Count = 0 then Return nil for each off as RevenueCatOffering in offerings if off.identifier = identifier then Return off end if next End Function

Sub GetOfferings(userID As String) if userID.IsEmpty or userID = "0" then Return end if self.Authorization self.RequestHeader("X-Platform") = "ios" self.parseOfferings = True Dim url As String = "https://api.revenuecat.com/v1/subscribers/" + userID + "/offerings" self.debug_postData = "" self.requestInProgress = True self.Send("GET", url) self.last_send_method = "GET" self.lastURL = url End Sub

Sub GetOfferingsDefaultUserID() Dim userID As String = Globals.userID if userID.isEmpty = False and userID <> "0" then GetOfferings(userID) end if End Sub

Shared Function HasEntitlement(name As String) As Boolean if entitlements is nil then Return False if not entitlements.HasKey(name) then Return False try Dim entitlement As Dictionary = entitlements.Value(name) Dim expires_date As String = entitlement.value("expires_date").stringvalue.Replace("T", " ").Replace("Z", "") if expires_date.IsEmpty then Return True //No expiration Dim tz As new TimeZone(0) Dim expires_datetime As DateTime = datetime.FromString(expires_date, nil, tz) if expires_datetime.SecondsFrom1970 > DateTime.Now.SecondsFrom1970 then Return True Catch err #if app.useSentry app.sentry.SubmitException(err, CurrentMethodName) #endif end try Return False End Function

Shared Function HasOfferings() As Boolean Return offerings.Count > 0 End Function

Sub Init() Dim userID As String = globals.userID if self.entitlements is nil then Dim entitlements As String = NSUserDefaults.TextForKey("RevenueCatEntitlements_" + userID) if entitlements.IsEmpty or entitlements = "{}" then //Don't parse Else try Dim dicEntitlements As Dictionary = ParseJSON(entitlements) self.entitlements = dicEntitlements Catch err end try end if end if if self.offerings.Count = 0 then //Loading offerings from NSUSerDefaults Dim offerings as String = NSUserDefaults.TextForKey("RevenueCatOfferings_" + userID) if offerings.IsEmpty = False and offerings.Length > 10 then Dim vOfferings() as Variant = ParseJSON(offerings) For each o as Dictionary in vOfferings self.offerings.Add new RevenueCatOffering(o) Next Else //Loading offerings from the default value Dim dic As Dictionary = ParseJSON(kDefaultOfferings) if dic.HasKey("offerings") then Dim vOfferings() as Variant = dic.Value("offerings") For each o as Dictionary in vOfferings self.offerings.Add new RevenueCatOffering(o) Next end if end if end if End Sub

Sub RecordPreviousPurchase() if NSUserDefaults.BoolForKey("SentOldReceiptToRevenueCat") then Return Static doneOnce as Boolean if doneOnce then Return doneOnce = True self.RecordPurchase("", False, 0.0, "") NSUserDefaults.SetBoolForKey(True, "SentOldReceiptToRevenueCat") End Sub

Sub RecordPurchase(product_id As String, is_restore As Boolean, price As Double, currencyValue As String) self.Authorization self.parseEntitlements = true self.RequestHeader("X-Platform") = "ios" Dim url As String = "https://api.revenuecat.com/v1/receipts" dim data As new Dictionary data.Value("app_user_id") = Globals.userID Declare Function mainBundle Lib "Foundation" selector "mainBundle" (clsRef As ptr) As ptr Declare Function NSClassFromString Lib "Foundation" (name As CFStringRef) As Ptr Declare Function appStoreReceiptURL lib "Foundation" selector "appStoreReceiptURL" (obj as ptr) as ptr Declare function path lib "Foundation" selector "path" (obj as ptr) as CFStringRef Declare Function base64EncodedStringWithOptions Lib "UIKit" Selector "base64EncodedStringWithOptions:" (data As Ptr, options As UInt32) As CFStringRef declare function dataWithContentsOfURL_ lib "Foundation" selector "dataWithContentsOfURL:" (clsRef as ptr, aURL as ptr) as ptr Dim theURL As Ptr = appStoreReceiptURL(mainBundle(NSClassFromString("NSBundle"))) if theURL <> nil then Dim receiptURLString as Text = path(theURL) Dim receiptData as ptr = dataWithContentsOfURL_(NSClassFromString("NSData"), theURL) Dim t as string = base64EncodedStringWithOptions(receiptData, 0) data.Value("fetch_token") = t Else Break Return end if if not product_id.IsEmpty then data.Value("product_id") = product_id end if data.Value("is_restore") = is_restore if price > 0.0 then data.Value("price") = price data.Value("currency") = currencyValue end if //The offering identifier if Globals.presented_offering_identifier.IsEmpty = False then data.Value("presented_offering_identifier") = Globals.presented_offering_identifier end if data.Value("store_country") = locale.Current.Identifier.Right(2) //Attributes Dim dicAttributes As new Dictionary 'dicAttributes.Value("$idfv") = new Dictionary("value": Session.user_uuid) if Globals.user_email.isEmpty = False then dicAttributes.Value("$email") = new Dictionary("value": Globals.user_email) end if data.Value("attributes") = dicAttributes dim postData as String = GenerateJSON(data) self.debug_postData = postData Me.SetRequestContent(postData, "application/json") self.requestInProgress = True self.Send("POST", url) self.last_send_method = "GET" self.lastURL = url NSUserDefaults.SetBoolForKey(True, "SentOldReceiptToRevenueCat") End Sub

Protected Sub SendAttributes() if self.requestInProgress then timer.CancelCallLater(AddressOf SendAttributes) timer.CallLater(10000, AddressOf SendAttributes) Return end if Dim userID As String = Globals.userID if userID.isEmpty or userID = "0" then timer.CancelCallLater(AddressOf SendAttributes) timer.CallLater(10000, AddressOf SendAttributes) Return end if if dicAttributes is nil or dicAttributes.KeyCount = 0 then Return self.Authorization Dim url as string = "https://api.revenuecat.com/v1/subscribers/" + userID + "/attributes" dim data As new Dictionary Dim now As Double = DateTime.Now.SecondsFrom1970 * 1000 Dim epoch As String = now.ToString(locale.Raw, "#") data.Value("attributes") = dicAttributes dim postData as String = GenerateJSON(data) self.debug_postData = postData Me.SetRequestContent(postData, "application/json") self.requestInProgress = True self.send("POST", url) self.last_send_method = "GET" self.lastURL = url End Sub

Sub UpdateAttribute(key As String, value As Variant, delayed As Boolean = True) Dim p As new pair(key, value) self.UpdateAttributes(Array(p), delayed) End Sub

Sub UpdateAttributes(entries() As Pair, delayed As Boolean = true) #if DebugBuild if Globals.userID.isEmpty then Return end if #endif //Attributes if dicAttributes is nil then dicAttributes = new Dictionary end if for each p as pair in entries dicAttributes.Value(p.Left) = new Dictionary("value": p.Right.StringValue) ', "updated_at_ms": epoch) next if delayed then timer.CancelCallLater(AddressOf SendAttributes) timer.CallLater(10000, AddressOf SendAttributes) Return end if SendAttributes End Sub

Property Private ChineseNetwork As Boolean

Property debug_postData As String

Property Protected dicAttributes As Dictionary

Property Private Shared entitlements As Dictionary

Property Private lastURL As String

Property Private last_send_method As String

Property Private Shared offerings() As RevenueCatOffering

Property Private parseEntitlements As Boolean

Property Private parseOfferings As Boolean

Property Private requestInProgress As Boolean

End Class

Class RevenueCatOffering

Sub Constructor(dic As Dictionary) self.identifier = dic.Value("identifier") self.description = dic.Lookup("description", "") if dic.HasKey("packages") then Dim vPackages() As Variant = dic.Value("packages") for each pack as Dictionary in vPackages self.packages.Add new RevenueCatOfferingPackage(pack) next end if End Sub

Property description As String

Property identifier As String

Property packages() As RevenueCatOfferingPackage

End Class

Class RevenueCatOfferingPackage

Sub Constructor(dic As Dictionary) self.identifier = dic.Value("identifier") self.platform_product_identifier = dic.Value("platform_product_identifier") End Sub

Property identifier As String

Property platform_product_identifier As String

End Class

Module NSUserDefaults

Protected Function BoolForKey(defaultName as CFStringRef) As Boolean Dim defaults As ptr = StandardUserDefaults() declare function boolForKey_ lib "Foundation" selector "boolForKey:" (obj_id as ptr, defaultName as CFStringRef) as Boolean Return boolForKey_(defaults, defaultName) End Function

Protected Function IntegerForKey(defaultName As String) As Integer Dim defaults As ptr = StandardUserDefaults() declare function integerForKey_ lib "Foundation.framework" selector "integerForKey:" (obj_id as ptr, defaultName as CFStringRef) as Integer Return integerForKey_(defaults, defaultName) End Function

Protected Sub RemoveObjectForKey(defaultName As String) Dim defaults As ptr = StandardUserDefaults() declare sub removeObjectForKey_ lib "Foundation.framework" selector "removeObjectForKey:" (obj_id as ptr, defaultName as CFStringRef) removeObjectForKey_(defaults, defaultName) End Sub

Protected Sub SetBoolForKey(value As boolean, defaultName As String) Dim defaults As ptr = StandardUserDefaults() declare sub setBool_ lib "Foundation.framework" selector "setBool:forKey:" (obj_id as ptr, value as Boolean, defaultName as CFStringRef) setBool_(defaults, value, defaultName) End Sub

Protected Sub SetIntegerForKey(value As Integer, defaultName As String) Dim defaults As ptr = StandardUserDefaults() declare sub setInteger_ lib "Foundation.framework" selector "setInteger:forKey:" (obj_id as ptr, value as Integer, defaultName as CFStringRef) setInteger_(defaults, value, defaultName) End Sub

Protected Sub SetTextForKey(value As String, defaultName As CFStringRef) Dim defaults As ptr = StandardUserDefaults() Declare Function NSClassFromString Lib "Foundation.framework" (clsName As CFStringRef) As Ptr Declare Function stringWithString Lib "Foundation.framework" Selector "stringWithString:" (cls As Ptr, value As CFStringRef) As Ptr Dim s As ptr = stringWithString( NSClassFromString("NSString"), value) declare sub setObject_ lib "Foundation.framework" selector "setObject:forKey:" (obj_id as ptr, value as ptr, defaultName as CFStringRef) setObject_(defaults, s, defaultName) End Sub

Private Function StandardUserDefaults() As ptr Declare Function NSClassFromString Lib "Foundation.framework" (clsName As CFStringRef) As Ptr Declare Function standardUserDefaults_ Lib "Foundation.framework" Selector "standardUserDefaults" (clsRef As Ptr) As Ptr static ClassRef as ptr = NSClassFromString("NSUserDefaults") 'declare function alloc lib "Foundation.framework" selector "alloc" (clsRef as ptr) as ptr declare function initWithSuiteName_ lib "Foundation.framework" selector "initWithSuiteName:" (obj_id as ptr, suitename as CFStringRef) as ptr 'Dim defaults as ptr = initWithSuiteName_(alloc(ClassRef), standardUserDefaults_(ClassRef)) ) Static defaults As ptr = standardUserDefaults_(ClassRef) Return defaults End Function

Private Sub StandardUserDefaultsSynchronize() declare function synchronize_ lib "Foundation.framework" selector "synchronize" (obj_id as ptr) as Boolean call synchronize_(StandardUserDefaults) End Sub

Protected Function TextForKey(defaultName As String) As CFStringRef Dim defaults As ptr = StandardUserDefaults() declare function stringForKey_ lib "Foundation.framework" selector "stringForKey:" (obj_id as ptr, defaultName as CFStringRef) as CFStringRef Return stringForKey_(defaults, defaultName) End Function

End Module

Module Globals

Property Protected presented_offering_identifier As String

Property Protected userID As String

Property Protected user_email As String

End Module

Class MyProgressHUD Inherits ProgressHUDMBS

EventHandler Sub buttonAction() me.cancel = True End EventHandler

EventHandler Sub hudWasHidden() End EventHandler

Property cancel As Boolean

End Class

Module ButtonExtensionsXC

Enum UIButtonRole normal = 0 primary cancel destructive End Enum

Sub AdjustsFontForContentSizeCategoryXC(extends button As MobileButton, textStyle As ControlExtensionsXC.UIFontTextStyle, customFont As Font = nil, maxPointSize As Double = 0.0) Dim label As ptr Declare Function getTextLabel Lib "UIKit.framework" selector "titleLabel" (obj_ref As ptr) As ptr label = getTextLabel(button.Handle) ControlExtensionsXC.AdjustsFontForContentSizeCategoryXC_internal(label, textStyle, customFont, maxPointSize) End Sub

Sub AdjustsFontSizeToFitWidthXC(extends bt As MobileButton, lines As Integer = -1) Dim label As ptr Declare Function getTextLabel Lib "UIKit.framework" selector "titleLabel" (obj_ref As ptr) As ptr label = getTextLabel(bt.Handle) If lines > 0 Then Declare Sub setNumberOfLines Lib "UIKit.framework" selector "setNumberOfLines:" (id As ptr, value As Integer) setNumberOfLines label, lines End If Declare Sub setAdjustsFontSizeToFitWidth Lib "UIKit.framework" selector "setAdjustsFontSizeToFitWidth:" (id As ptr, value As Boolean) setAdjustsFontSizeToFitWidth label, True End Sub

Sub SetBackdropXC(extends bt as MobileButton, backdrop as Picture) 'This method was posted by Jim McKay in the https://forum.xojo.com/18184-button-and-view-colours-ios/last thread 'on 12/12/2014 Declare Sub setBackgroundImage Lib "UIKit" selector "setBackgroundImage:forState:" (obj As ptr, value As ptr, state As Integer) if backdrop is nil then setBackgroundImage(bt.Handle, nil, 0) else Dim bestImage As Picture = ImageExtensionsXC.BestRepresentationXC(backdrop) setBackgroundImage(bt.Handle, bestImage.CopyOSHandle(Picture.HandleType.iOSUIImage), 0) end if End Sub

Sub SetBorderWidthXC(extends bt As MobileButton, value As Double) Declare Function layer_ Lib "UIKit.framework" selector "layer" (id As ptr) As Ptr Dim layer As ptr = layer_(bt.Handle) Declare Sub setBorderWidth Lib "UIKit.framework" selector "setBorderWidth:" (obj_id As ptr, st As CGFloat) setBorderWidth(layer, value) End Sub

Sub SetButtonInsetsXC(extends bt As MobileButton, value As ExtensionsXC.xcUIEdgeInsets) Declare Sub setContentEdgeInsets Lib "UIKit.framework" selector "setContentEdgeInsets:" (id As ptr, value As ExtensionsXC.xcUIEdgeInsets) setContentEdgeInsets (bt.handle, value) End Sub

Sub SetButtonTiledBackgroundXC(extends bt As MobileButton, img As Picture) Dim insets As ExtensionsXC.xcUIEdgeInsets insets.Left = 12 insets.Top = 12 insets.Bottom = 12 insets.Right = 12 Dim resizedImg as Picture resizedImg = ImageExtensionsXC.ResizableTiledImageXC(insets, img) bt.SetBackdropXC(resizedImg) bt.SetButtonInsetsXC(insets) End Sub

Sub SetContentHorizontalAlignmentXC(extends bt As MobileButton, alignment As ControlExtensionsXC.UIControlContentHorizontalAlignment) declare sub setContentHorizontalAlignment lib "UIKit" Selector "setContentHorizontalAlignment:" (obj as ptr, value as ControlExtensionsXC.UIControlContentHorizontalAlignment) setContentHorizontalAlignment(bt.Handle, alignment) End Sub

Sub SetImageInsetsXC(extends bt As MobileButton, value As ExtensionsXC.xcUIEdgeInsets) Declare Sub setImageEdgeInsets Lib "UIKit.framework" selector "setImageEdgeInsets:" (id As ptr, value As ExtensionsXC.xcUIEdgeInsets) setImageEdgeInsets (bt.handle, value) End Sub

Sub SetImageXC(extends bt As MobileButton, image As Picture, state As ControlExtensionsXC.UIControlState = ControlExtensionsXC.UIControlState.normal) 'This method was posted by Jim McKay in the https://forum.xojo.com/18184-button-and-view-colours-ios/last thread 'on 12/12/2014 Declare Sub setImage Lib "UIKit.framework" selector "setImage:forState:" (obj As ptr, value As ptr, state As ControlExtensionsXC.UIControlState) If image Is Nil Then setImage(bt.Handle, Nil, state) Else Dim bestImg As Picture = ImageExtensionsXC.BestRepresentationXC(image) setImage(bt.Handle, bestImg.Handle, state) End If End Sub

Sub SetLineBreakModeXC(extends bt As MobileButton, mode As ControlExtensionsXC.NSLineBreakMode) Dim label As ptr Declare Function getTextLabel Lib "UIKit.framework" selector "titleLabel" (obj_ref As ptr) As ptr label = getTextLabel(bt.Handle) Declare Sub setLineBreakMode Lib "UIKit.framework" selector "setLineBreakMode:" (id As ptr, value As ControlExtensionsXC.NSLineBreakMode) setLineBreakMode label, mode End Sub

Sub SetNumberOfLinesXC(extends bt As MobileButton, lines As Integer) Dim label As ptr Declare Function getTextLabel Lib "UIKit.framework" selector "titleLabel" (obj_ref As ptr) As ptr label = getTextLabel(bt.Handle) Declare Sub setTextAlignment Lib "UIKit.framework" selector "setTextAlignment:" (id As ptr, value As ControlExtensionsXC.NSTextAlignment) 'setTextAlignment(label, NSTextAlignment.center) Declare Sub setNumberOfLines Lib "UIKit.framework" selector "setNumberOfLines:" (id As ptr, value As Integer) setNumberOfLines label, lines End Sub

Sub SetRoleXC(extends bt As MobileButton, value As ButtonExtensionsXC.UIButtonRole) //New in version 2.0 if ExtensionsXC.GetiOSVersionXC >= 14.0 then Declare Sub setRole Lib "UIKit.framework" selector "setRole:" (obj_id As ptr, aRole As UIButtonRole) setRole(bt.handle, value) end if End Sub

Sub SetTextAlignmentXC(extends bt As MobileButton, alignment As ControlExtensionsXC.NSTextAlignment) Dim label As ptr Declare Function getTextLabel Lib "UIKit.framework" selector "titleLabel" (obj_ref As ptr) As ptr label = getTextLabel(bt.Handle) Declare Sub setTextAlignment Lib "UIKit.framework" selector "setTextAlignment:" (id As ptr, value As ControlExtensionsXC.NSTextAlignment) setTextAlignment(label, alignment) End Sub

Sub SetTitleEdgeInsetsXC(extends bt As MobileButton, value As ExtensionsXC.xcUIEdgeInsets) Declare Sub setTitleEdgeInsets_ Lib "UIKit.framework" selector "setTitleEdgeInsets:" (id As ptr, value As ExtensionsXC.xcUIEdgeInsets) setTitleEdgeInsets_ (bt.handle, value) End Sub

Sub x_SetBackgroundColorXC(Extends bt As MobileButton, value As color) Declare Function NSClassFromString Lib "Foundation" (className As CFStringRef) As Ptr Declare Function colorWithRGBA Lib "UIKit.framework" Selector "colorWithRed:green:blue:alpha:" ( UIColorClassRef As Ptr, red As CGFloat, green As CGFloat, blue As CGFloat, alpha As CGFloat) As Ptr Declare Function view Lib "UIKit.framework" Selector "view" (UIViewController As Ptr) As Ptr Declare Sub setBackgroundColor Lib "UIKit.framework" Selector "setBackgroundColor:" (UIView As Ptr, UIColor As Ptr) Dim UIColorClassPtr As Ptr = NSClassFromString("UIColor") Dim colorPtr As ptr = colorWithRGBA(UIColorClassPtr, (value.red / 255.0), (value.Green / 255.0), (value.Blue / 255.0), (1.0-value.Alpha/255.0)) Dim viewPtr As Ptr = bt.Handle SetBackgroundColor(viewPtr, colorPtr) End Sub

Sub x_SetBorderColorXC(extends bt As MobileButton, value As Color) Declare Function layer_ Lib "UIKit.framework" selector "layer" (id As ptr) As Ptr Dim layer As ptr = layer_(bt.Handle) Dim uic As UIKit.UIColor If value.Alpha = 255 Then uic = UIKit.UIColor.ClearColor Else uic = New UIColor(value) End If declare sub setBorderColor lib "UIKit.framework" selector "setBorderColor:" (obj_id as ptr, col as ptr) setBorderColor(layer, uic.CGColor) End Sub

End Module

Module ControlExtensionsXC

Enum NSLineBreakMode WordWrap = 0 CharacterWrap Clip TruncateHead TruncateTail TruncateMiddle End Enum

Enum NSTextAlignment left = 0 center right justified natural End Enum

Enum UIActivityIndicatorViewStyle whiteLarge white gray End Enum

Enum UIControlContentHorizontalAlignment Center = 0 Left Right Fill Leading Trailing End Enum

Enum UIControlState normal highlighted disabled selected focused End Enum

Enum UIDatePickerStyle automatic = 0 wheels compact inline End Enum

Enum UIFontTextStyle body callout caption1 caption2 footnote headline subHeadline largeTitle title1 title2 title3 End Enum

Enum UIUserInterfaceStyle Unspecified Light Dark End Enum

Enum UIUserInterfaceStyle1 unspecified = 0 light = 1 dark = 2 End Enum

Enum UIVIewAnimationCurve EaseInEaseOut EaseIn EaseOut Linear Keyboard = 7 End Enum

Enum UIVIewAnimationTransition None FlipFromLeft FlipFromRight CurlUp CurlDown CrossDissolve FlipFromTop FlipFromBottom End Enum

Sub AdjustsFontForContentSizeCategoryXC(extends ctrl As MobileTextControl, textStyle As ControlExtensionsXC.UIFontTextStyle, customFont As Font = nil, maxPointSize As Double = 0.0) ControlExtensionsXC.AdjustsFontForContentSizeCategoryXC_internal(ctrl.Handle, textStyle, customFont, maxPointSize) End Sub

Protected Sub AdjustsFontForContentSizeCategoryXC_internal(label As Ptr, textStyle As ControlExtensionsXC.UIFontTextStyle, customFont As Font = nil, maxPointSize As Double = 0.0) Declare Function NSClassFromString Lib "Foundation" (className As CFStringRef) As Ptr Declare Function alloc Lib "Foundation.framework" selector "alloc" (clsRef As ptr) As ptr Declare Function initFont Lib "UIKit.framework" selector "fontWithName:size:" (obj_id As ptr, name As CFStringRef, size As CGFloat) As ptr Declare Function preferredFontForTextStyle Lib "UIKit.framework" selector "preferredFontForTextStyle:" (obj_id As ptr, mode As CFStringRef) As ptr Declare function metricsForTextStyle lib "UIKit.framework" selector "metricsForTextStyle:" (clsRef as ptr, mode As CFStringRef) as ptr Declare function scaledFontForFontmaximumPointSize lib "UIKit.framework" selector "scaledFontForFont:maximumPointSize:" (obj as ptr, font as ptr, pointSize As CGFloat) as ptr Declare function scaledFontForFont lib "UIKit.framework" selector "scaledFontForFont:" (obj as ptr, font as ptr) as ptr Dim constName As String Select case textStyle Case UIFontTextStyle.body constName = "UIFontTextStyleBody" Case UIFontTextStyle.callout constName = "UIFontTextStyleCallout" Case UIFontTextStyle.caption1 constName = "UIFontTextStyleCaption1" Case UIFontTextStyle.caption2 constName = "UIFontTextStyleCaption2" Case UIFontTextStyle.footnote constName = "UIFontTextStyleFootnote" Case UIFontTextStyle.headline constName = "UIFontTextStyleHeadline" Case UIFontTextStyle.subHeadline constName = "UIFontTextStyleSubheadline" Case UIFontTextStyle.largeTitle constName = "UIFontTextStyleLargeTitle" Case UIFontTextStyle.title1 constName = "UIFontTextStyleTitle1" Case UIFontTextStyle.title2 constName = "UIFontTextStyleTitle2" case UIFontTextStyle.title3 constName = "UIFontTextStyleTitle3" End Select Dim textStylePtr As Ptr = ExtensionsXC.LoadConstantXC("UIKit", constName) Dim fontPtr As ptr if customFont <> nil then 'Declare Function initFont Lib "UIKit.framework" selector "fontWithName:size:" (obj_id As ptr, name As CFStringRef, size As CGFloat) As ptr Dim fontMetricsPtr As Ptr = metricsForTextStyle((NSClassFromString("UIFontMetrics")), textStylePtr.CFStringRef(0)) Dim customFontPtr As Ptr customFontPtr = initFont(NSClassFromString("UIFont"), customFont.Name, customFont.Size) if maxPointSize > 0.0 then //Returns a version of the specified font that adopts the current font metrics and is constrained to the specified maximum size. fontPtr = scaledFontForFontmaximumPointSize(fontMetricsPtr, customFontPtr, maxPointSize) Else //Returns a version of the specified font that adopts the current font metrics. fontPtr = scaledFontForFont(fontMetricsPtr, customFontPtr) end if Else fontPtr = preferredFontForTextStyle((NSClassFromString("UIFont")), textStylePtr.CFStringRef(0)) if maxPointSize > 0.0 then Dim fontMetricsPtr As Ptr = metricsForTextStyle((NSClassFromString("UIFontMetrics")), textStylePtr.CFStringRef(0)) fontPtr = scaledFontForFontmaximumPointSize(fontMetricsPtr, fontPtr, maxPointSize) end if end if Declare sub setFont lib "UIKit.framework" selector "setFont:" (obj_ref as ptr, fontRef as ptr) Declare Sub setAdjustsFontForContentSizeCategory Lib "UIKit.framework" Selector "setAdjustsFontForContentSizeCategory:" (obj_ref as ptr, value as Boolean) setFont(label, fontPtr) setAdjustsFontForContentSizeCategory label, True End Sub

Sub AdjustsFontSizeToFitWidthXC(extends label As MobileLabel, lines As Integer = -1) label.LineBreakMode = MobileLabel.LineBreakModes.TruncateEnd If lines > 0 Then Declare Sub setNumberOfLines Lib "UIKit.framework" selector "setNumberOfLines:" (id As ptr, value As Integer) setNumberOfLines label.handle, lines End If Declare sub setAdjustsFontSizeToFitWidth lib "UIKit.framework" selector "setAdjustsFontSizeToFitWidth:" (id as ptr, value as Boolean) setAdjustsFontSizeToFitWidth label.handle, True End Sub

Sub AnimateAlphaXC(extends ctrl as MobileUIControl, newAlpha as double, duration as double = 0.2, completion as iOSBlock = nil) #If ExtensionsXC.kUseUIKit Dim v As New UIView(ctrl.Handle) v.AnimateAlpha newalpha, duration, completion #else #Pragma Unused ctrl #Pragma Unused newalpha #Pragma Unused duration #Pragma Unused completion #EndIf End Sub

Sub FlipHorizontalForRTLXC(extends c As MobileUIControl) //Flips an MobileUIControl on the horizontal axis for RTL Declare sub transform lib "UIKit.framework" selector "setTransform:" (obj_id as ptr, matrix as ExtensionsXC.xcCGAffineTransform) Declare function CGAffineTransformMakeScale lib "CoreGraphics.framework" (sx as CGFloat, sy as CGFloat) as ExtensionsXC.xcCGAffineTransform Dim scale As ExtensionsXC.xcCGAffineTransform scale = CGAffineTransformMakeScale(-1, 1) transform(c.Handle, scale) End Sub

Function GetBoundsXC(extends c as MobileUIControl) As Rect 'Declare Function view_ Lib "UIKit.framework" selector "view" (controlHandle As ptr) As Ptr Declare Function bounds Lib "UIKit.framework" selector "bounds" (obj_id As Ptr) As ExtensionsXC.xcCGRect 'Dim view As Ptr = view_(c.handle) Dim re As ExtensionsXC.xcCGRect = bounds(c.handle) Return New Rect(re.origin.x, re.origin.y, re.rsize.width, re.rsize.height) End Function

Function GetFrameXC(extends c as MobileUIControl) As Rect Dim viewRef As ptr = c.Handle Declare Function frame Lib "UIKit.framework" selector "frame" (obj_id As Ptr) As ExtensionsXC.xcCGRect Dim re As ExtensionsXC.xcCGRect = frame(viewRef) Return New Rect(re.origin.x, re.origin.y, re.rsize.width, re.rsize.height) End Function

Sub PopToRootViewControllerXC(extends v As MobileScreen, animated As Boolean = true) //Reference to Navigation Controller declare function navigationController lib "UIKit.framework" selector "navigationController" (viewController as ptr) as ptr dim navigationControllerRef as ptr = navigationController(v.ViewControllerHandle) declare function popToRootViewController_ lib "UIKit.framework" selector "popToRootViewControllerAnimated:" (obj_ref as ptr, aniamted As Boolean) as ptr call popToRootViewController_(navigationControllerRef, animated) End Sub

Sub RemoveConstraintsXC(extends screen As MobileScreen) // http://stackoverflow.com/questions/13388104/remove-auto-layout-constraints-for-specific-object '[detailsPhotoView removeConstraints:detailsPhotoView.constraints]; Declare sub removeConstraints lib "UIKit.framework" selector "removeConstraints:" (obj_id as ptr, constraints as ptr) Declare function constraints lib "UIKit.framework" selector "constraints" (obj_id as ptr) as ptr dim ctrs As ptr = constraints(screen.handle) removeConstraints(screen.Handle, ctrs) End Sub

Sub RemoveConstraintsXC(extends container As MobileUIControl) // http://stackoverflow.com/questions/13388104/remove-auto-layout-constraints-for-specific-object '[detailsPhotoView removeConstraints:detailsPhotoView.constraints]; Declare sub removeConstraints lib "UIKit.framework" selector "removeConstraints:" (obj_id as ptr, constraints as ptr) Declare function constraints lib "UIKit.framework" selector "constraints" (obj_id as ptr) as ptr dim ctrs As ptr = constraints(container.Handle) removeConstraints(container.Handle, ctrs) End Sub

Sub SetActivityIndicatorViewStyleXC(extends progress As MobileProgressWheel, value As UIActivityIndicatorViewStyle) #if TargetIOS declare sub setActivityIndicatorViewStyle lib "UIKit.framework" selector "setActivityIndicatorViewStyle:" (id as ptr, value as UIActivityIndicatorViewStyle) setActivityIndicatorViewStyle progress.Handle, value #endif End Sub

Sub SetAlphaValueXC(extends ctrl As MobileUIControl, value As Double) Declare Sub setAlphaValue Lib "UIKit.framework" selector "setAlpha:" (id As ptr, value As CGFloat) setAlphaValue ctrl.handle, value End Sub

Sub SetBackgroundColorXC(extends ctrl As MobileUIControl, value As Color) Dim uic As UIKit.UIColor If value.Alpha = 255 Then uic = UIKit.UIColor.ClearColor else uic = New UIKit.UIColor(value) end if Declare Sub decl_SetBackgroundColor lib "UIKit.framework" selector "setBackgroundColor:" (aUIView As Ptr, aUIColor As Ptr) ' Here is the corresponding Xojo call decl_SetBackgroundColor(ctrl.handle, uic) End Sub

Sub SetCornersRadiusXC(extends view As UIKit.UIView, corners As Integer, radius As Double) #If Not DebugBuild // Create the path (with only the top-left corner rounded) 'UIBezierPath *maskPath = [UIBezierPath bezierPathWithRoundedRect:imageView.bounds 'byRoundingCorners:UIRectCornerTopLeft 'cornerRadii:CGSizeMake(10.0, 10.0)]; // Create the shape layer and set its path 'CAShapeLayer *maskLayer = [CAShapeLayer layer]; 'maskLayer.frame = imageView.bounds; 'maskLayer.path = maskPath.CGPath; // Set the newly created shape layer as the mask for the image view's layer 'imageView.layer.mask = maskLayer; Declare Function layer_ Lib "UIKit.framework" selector "layer" (id As ptr) As Ptr Declare Function bezierPathWithRoundedRect Lib "UIKit.framework" selector "bezierPathWithRoundedRect:byRoundingCorners:cornerRadii:" _ (cls_ref as ptr, bounds as CGRect, corners as Integer, radius as CGSize) as ptr Dim radSize As CGSize radSize.width = radius radSize.height = radius Dim bounds As Xojo.Core.Rect = view.bounds Dim boundRect As CGRect = CGRectMake(bounds.left, bounds.Top, bounds.Width, bounds.Height) Dim maskPath As Ptr maskPath = bezierPathWithRoundedRect(Foundation.NSClassFromString("UIBezierPath"), _ boundRect, corners, radSize) Dim maskLayer As Ptr maskLayer = layer_(NSClassFromString("CAShapeLayer")) Declare Sub setFrame_ Lib "UIKit.framework" selector "setFrame:" (obj_id As ptr, frame As CGRect) setFrame_(maskLayer, boundRect) Declare Sub setPath_ Lib "UIKit.framework" selector "setPath:" (obj_id As ptr, path As ptr) Declare function CGPath_ lib "UIKit.framework" selector "CGPath" (obj_id as ptr) as ptr setPath_(maskLayer, CGPath_(maskPath)) Dim layer As ptr = layer_(view.id) Declare Sub setMask Lib "UIKit.framework" selector "setMask:" (obj_id As ptr, mask As ptr) setMask(layer, maskLayer) Declare Sub masksToBounds_ Lib "UIKit.framework" selector "setMasksToBounds:" (id As ptr, value As Boolean) 'masksToBounds_(layer, False) #EndIf End Sub

Sub SetDatePickerMinuteIntervalXC(Extends datepicker As MobileDateTimePicker, interval As Integer) Declare Sub minuteInterval Lib "UIKit.framework" Selector "setMinuteInterval:" (obj As ptr, interval As Integer) minuteInterval(datepicker.Handle, interval) End Sub

Sub SetDatePickerStyleXC(extends datepicker As MobileDateTimePicker, style As ControlExtensionsXC.UIDatePickerStyle) if ExtensionsXC.GetiOSVersionXC >= 13.4 then declare sub preferredDatePickerStyle lib "UIKit.framework" selector "setPreferredDatePickerStyle:" (obj as ptr, mode as UIDatePickerStyle) preferredDatePickerStyle(datepicker.Handle, style) end if End Sub

Sub SetOnTintColorXC(extends switch As MobileSwitch, value As Color) 'declare sub setTintColor lib "UIKit.framework" selector "setTintColor:" (id as ptr, UIColor as Ptr) 'setTintColor s.Handle, new UIColor(c) Dim uic As UIKit.UIColor If value.Alpha = 255 Then uic = UIKit.UIColor.ClearColor Else uic = New UIColor(value) End If declare sub setOnTintColor lib "UIKit.framework" selector "setOnTintColor:" (id as ptr, UIColor as Ptr) setOnTintColor(switch.Handle, uic) End Sub

Sub SetOverrideUserInterfaceStyleXC(extends control As MobileUIControl, style As ControlExtensionsXC.UIUserInterfaceStyle) if ExtensionsXC.GetiOSVersionXC >= 13.0 then declare sub overrideUserInterfaceStyle lib "UIKit.framework" selector "setOverrideUserInterfaceStyle:" (obj as ptr, style As ControlExtensionsXC.UIUserInterfaceStyle) overrideUserInterfaceStyle(control.Handle, style) end if End Sub

Sub SetTextColorXC(extends picker as MobileDateTimePicker, value as Color) Dim uic As UIKit.UIColor If value.Alpha = 255 Then uic = UIKit.UIColor.ClearColor else uic = New UIKit.UIColor(value) end if declare sub setValue_ lib "Foundation" selector "setValue:forKey:" (obj_id as ptr, value as ptr, key as CFStringRef) setValue_(picker.Handle, uic, "textColor") End Sub

Sub SetTintColorXC(extends ctrl As MobileUIControl, c As Color) declare sub setTintColor lib "UIKit.framework" selector "setTintColor:" (id as ptr, UIColor as Ptr) setTintColor ctrl.Handle, new UIColor(c) End Sub

Sub SetUIFontXC(extends lbl as MobileLabel, fontHandle as ptr) Declare sub setFont_ lib "UIKit.framework" selector "setFont:" (obj as ptr, font as ptr) setFont_(lbl.Handle, fontHandle) End Sub

Sub SetUserInterfaceStyleXC(extends ctrl as MobileUIControl, value as ControlExtensionsXC.UIUserInterfaceStyle) if ExtensionsXC.GetiOSVersionXC >= 13.4 then Declare sub overrideUserInterfaceStyle lib "UIKit" selector "setOverrideUserInterfaceStyle:" (obj as ptr, value as UIUserInterfaceStyle) overrideUserInterfaceStyle(ctrl.handle, value) end if End Sub

Sub StretchToParentXC(extends c As MobileUIControl, parentView As MobileUIControl) Dim cons As iOSLayoutConstraint //Top cons = new iOSLayoutConstraint(c, _ iOSLayoutConstraint.AttributeTypes.top, _ iOSLayoutConstraint.RelationTypes.Equal, _ parentView, _ iOSLayoutConstraint.AttributeTypes.Top, _ 1, _ 0) cons.Active = True parentView.AddConstraint(cons) //Left cons = new iOSLayoutConstraint(c, _ iOSLayoutConstraint.AttributeTypes.left, _ iOSLayoutConstraint.RelationTypes.Equal, _ parentView, _ iOSLayoutConstraint.AttributeTypes.left, _ 1, _ 0) cons.Active = True parentView.AddConstraint(cons) //Right cons = new iOSLayoutConstraint(c, _ iOSLayoutConstraint.AttributeTypes.Right, _ iOSLayoutConstraint.RelationTypes.Equal, _ parentView, _ iOSLayoutConstraint.AttributeTypes.Right, _ 1, _ 0) cons.Active = True parentView.AddConstraint(cons) //Bottom cons = new iOSLayoutConstraint(c, _ iOSLayoutConstraint.AttributeTypes.Bottom, _ iOSLayoutConstraint.RelationTypes.Equal, _ parentView, _ iOSLayoutConstraint.AttributeTypes.Bottom, _ 1, _ 0) cons.Active = True parentView.AddConstraint(cons) End Sub

Sub StretchToViewXC(extends c As MobileUIControl, parentView As MobileScreen) Dim cons As iOSLayoutConstraint //Top cons = new iOSLayoutConstraint(c, _ iOSLayoutConstraint.AttributeTypes.top, _ iOSLayoutConstraint.RelationTypes.Equal, _ parentView, _ iOSLayoutConstraint.AttributeTypes.Top, _ 1, _ 0) cons.Active = True parentView.AddConstraint(cons) //Left cons = new iOSLayoutConstraint(c, _ iOSLayoutConstraint.AttributeTypes.left, _ iOSLayoutConstraint.RelationTypes.Equal, _ parentView, _ iOSLayoutConstraint.AttributeTypes.left, _ 1, _ 0) cons.Active = True parentView.AddConstraint(cons) //Right cons = new iOSLayoutConstraint(c, _ iOSLayoutConstraint.AttributeTypes.Right, _ iOSLayoutConstraint.RelationTypes.Equal, _ parentView, _ iOSLayoutConstraint.AttributeTypes.Right, _ 1, _ 0) cons.Active = True parentView.AddConstraint(cons) //Bottom cons = new iOSLayoutConstraint(c, _ iOSLayoutConstraint.AttributeTypes.Bottom, _ iOSLayoutConstraint.RelationTypes.Equal, _ parentView, _ iOSLayoutConstraint.AttributeTypes.Bottom, _ 1, _ 0) cons.Active = True parentView.AddConstraint(cons) End Sub

End Module

Module LayerExtensionsXC

Const QuartzCoreLib = Quartzcore.framework

Function GetLayerXC(extends c as MobileUIControl) As ptr Declare Function layer_ Lib "UIKit.framework" selector "layer" (id As ptr) As Ptr Dim layer As ptr = layer_(c.Handle) Return layer End Function

Function SetBackgroundGradientXC(extends ctrl As MobileUIControl, linearBrush As LinearGradientBrush) As Ptr Dim layer as ptr = ctrl.GetLayerXC Declare Function init Lib "Foundation.framework" selector "init" (obj_id As ptr) As ptr Declare Function alloc Lib "Foundation.framework" selector "alloc" (clsRef As ptr) As ptr Declare Function NSClassFromString Lib "Foundation.framework" (clsName As CFStringRef) As ptr Dim gradient As ptr = init(alloc(NSClassFromString ("CAGradientLayer"))) ' gradient.frame = view.bounds; Dim frame As ExtensionsXC.xcCGRect Dim viewFrame As Rect = ctrl.GetFrameXC frame.origin.x = 0 frame.origin.y = 0 frame.rsize.width = viewFrame.Width frame.rsize.height = viewFrame.Height #if False linearBrush = New LinearGradientBrush linearBrush.StartPoint = New Point(0, 0) linearBrush.EndPoint = New Point(sz.Width, sz.Height) linearBrush.GradientStops.Add(New Pair(0, &c6078EA)) linearBrush.GradientStops.Add(New Pair(1.0, &cFD575C)) #endif Declare Sub setFrame Lib UIKitLib selector "setFrame:" (obj_id As ptr, frame As ExtensionsXC.xcCGRect) setFrame(gradient, frame) ' gradient.colors = @[(id)[UIColor whiteColor].CGColor, (id)[UIColor blackColor].CGColor]; Declare Function arrayWithCapacity Lib "Foundation" selector "arrayWithCapacity:" (cls As ptr, count as UInteger) As ptr Declare Sub addObject Lib "Foundation" selector "addObject:" (arr As ptr, obj As ptr) Dim colorArray As ptr colorArray = arrayWithCapacity(NSClassFromString("NSMutableArray"), 2) Dim c1, c2 As UIKit.UIColor Dim col1 As color = linearBrush.GradientStops(0).Right Dim col2 As color = linearBrush.GradientStops(linearBrush.GradientStops.LastIndex).Right c1 = New UIKit.UIColor(col1) c2 = New UIKit.UIColor(col2) addObject colorArray, c1.CGColor addObject colorArray, c2.CGColor Declare Sub setColors Lib QuartzCoreLib selector "setColors:" (obj_id As ptr, colors As ptr) setColors(gradient, colorArray) Dim startPt As ExtensionsXC.xcCGPoint StartPt.x = linearBrush.StartPoint.X StartPt.y = linearBrush.StartPoint.Y Dim endPt As ExtensionsXC.xcCGPoint endPt.x = linearBrush.EndPoint.X endPt.y = linearBrush.EndPoint.Y Declare sub startPoint lib QuartzCoreLib selector "setStartPoint:" (obj as ptr, value as ExtensionsXC.xcCGPoint) startPoint(gradient, startpt) Declare sub endPoint lib QuartzCoreLib selector "setEndPoint:" (obj as ptr, value as ExtensionsXC.xcCGPoint) endPoint(gradient, endpt) 'Declare Sub clipsToBounds Lib "UIKit.framework" selector "setMasksToBounds:" (id As ptr, value As Boolean) 'clipsToBounds(gradient, True) ' 'Declare Sub setCornerRadius Lib "QuartzCore.framework" selector "setCornerRadius:" (id As ptr, value As CGFloat) ' 'setCornerRadius gradient, 16 ' [view.layer insertSublayer:gradient atIndex:0]; Declare Sub insertSublayer Lib QuartzCoreLib selector "insertSublayer:atIndex:" (id As ptr, aLayer As ptr, Index As UInt32) Declare Sub replaceSubLayer Lib QuartzCoreLib selector "replaceSublayer:with:" (id As ptr, aLayer As ptr, aLayer2 as ptr) 'if gradientSet = False then insertSublayer layer, gradient, 0 'Else 'replaceSubLayer(layer, lastLayer, gradient) 'End If Return gradient End Function

Sub SetBorderColorXC(extends c As MobileUIControl, value As Color) Dim layer as ptr = c.GetLayerXC Dim uic As uikit.uicolor If value.Alpha = 255 Then uic = UIKit.UIColor.ClearColor Else uic = New UIColor(value) End If declare sub setBorderColor lib "UIKit.framework" selector "setBorderColor:" (obj_id as ptr, col as ptr) setBorderColor(layer, uic.CGColor) End Sub

Sub SetBorderWidthXC(extends c As MobileUIControl, width As Double) Dim layer As ptr = c.GetLayerXC declare sub setBorderWidth lib "UIKit.framework" selector "setBorderWidth:" (obj_id as ptr, value as CGFloat) setBorderWidth(layer, width) End Sub

Sub SetCornerRadiusXC(extends ctrl As MobileUIControl, radius As Double) Declare Function layer_ Lib "UIKit.framework" selector "layer" (id As ptr) As Ptr Dim layer As ptr = layer_(ctrl.Handle) Declare Sub setCornerRadius Lib "QuartzCore.framework" selector "setCornerRadius:" (id As ptr, value As CGFloat) setCornerRadius layer, radius if ctrl isa MobileButton then Dim insets As ExtensionsXC.xcUIEdgeInsets insets.Left = radius insets.Top = 0 insets.Right = radius insets.Bottom = 0 MobileButton(ctrl).SetButtonInsetsXC(insets) else Declare Sub clipsToBounds Lib "UIKit.framework" selector "setClipsToBounds:" (id As ptr, value As Boolean) clipsToBounds(ctrl.Handle, True) end if End Sub

Sub SetShadowXC(extends control As MobileUIControl, ShadowColor As Color, radius As Double, offset As Point, opacity As Double = 1.0) Declare Function layer_ Lib "UIKit.framework" selector "layer" (id As ptr) As Ptr Dim layer As ptr = layer_(control.Handle) Declare Sub masksToBounds_ Lib "UIKit.framework" selector "setMasksToBounds:" (id As ptr, value As Boolean) masksToBounds_(layer, False) Declare Sub shadowColor_ Lib QuartzCoreLib selector "setShadowColor:" (id As ptr, col As ptr) Dim c As new UIColor(ShadowColor) shadowColor_(layer, c.CGColor) Declare Sub shadowRadius_ Lib QuartzCoreLib selector "setShadowRadius:" (id As ptr, col As CGFloat) shadowRadius_(layer, radius) Dim size As ExtensionsXC.xcCGSize size.width = offset.X size.height = offset.y Declare Sub shadowOffset_ Lib QuartzCoreLib selector "setShadowOffset:" (id As ptr, sz As ExtensionsXC.xcCGSize) shadowOffset_(layer, size) 'Declare function opac lib QuartzCoreLib selector "shadowOpacity" (id as ptr) as CGFloat 'dim v As Double = opac(layer) 'v = v Declare Sub shadowOpacity_ Lib QuartzCoreLib selector "setShadowOpacity:" (id As ptr, col As single) shadowOpacity_(layer, opacity) End Sub

End Module

Module ExtensionsXC

Const kUseUIKit = False

Const kVersion = 2.6.0

Protected Function CGRectMake(x As CGFloat, y As CGFloat, width As CGFloat, height As CGFloat) As xcCGRect Dim origin As ExtensionsXC.xcCGPoint origin.x = x origin.y = y Dim size As ExtensionsXC.xcCGSize size.width = width size.height = height Dim rect As xcCGRect rect.origin = origin rect.rsize = size Return rect End Function

Protected Function GetiOSVersionAsStringXC() As String Static sSystemVersion As String //Get sSystemVersion only once If sSystemVersion.IsEmpty then Declare Function currentDevice_ Lib "UIKit.framework" selector "currentDevice" (clsRef As ptr) As ptr Declare Function systemversion_ Lib "UIKit.framework" selector "systemVersion" (obj_id As ptr) As CFStringRef Declare Function NSClassFromString Lib "Foundation" (name As CFStringRef) As Ptr Dim device As Ptr = currentDevice_(NSClassFromString("UIDevice")) Dim systemVersion As String = systemversion_(device) sSystemVersion = systemVersion End If Return sSystemVersion End Function

Protected Function GetiOSVersionXC() As Double Static sSystemVersion As Double //Get sSystemVersion only once If sSystemVersion = 0.0 Then Declare Function currentDevice_ Lib "UIKit.framework" selector "currentDevice" (clsRef As ptr) As ptr Declare Function systemversion_ Lib "UIKit.framework" selector "systemVersion" (obj_id As ptr) As CFStringRef Declare Function NSClassFromString Lib "Foundation" (name As CFStringRef) As Ptr Dim device As Ptr = currentDevice_(NSClassFromString("UIDevice")) Dim systemVersion As String = systemversion_(device) Try sSystemVersion = Double.FromString(systemVersion) Catch End Try End If Return sSystemVersion End Function

Protected Function IsTestflightXC() As Boolean Declare Function mainBundle Lib "Foundation" selector "mainBundle" (clsRef As ptr) As ptr Declare Function NSClassFromString Lib "Foundation" (name As CFStringRef) As Ptr Declare Function appStoreReceiptURL lib "Foundation" selector "appStoreReceiptURL" (obj as ptr) as ptr Declare function path lib "Foundation" selector "path" (obj as ptr) as CFStringRef Dim theURL As Ptr = appStoreReceiptURL(mainBundle(NSClassFromString("NSBundle"))) if theURL <> nil then Dim receiptURLString as Text = path(theURL) if receiptURLString.IndexOf("sandboxReceipt") > -1 then Return True end if end if End Function

Protected Function LoadConstantXC(frameworkName as String, constName as String) As Ptr Declare Function dlsym Lib "/usr/lib/libSystem.dylib" ( handle As Ptr, name As CString ) As ptr dim libPtr as Ptr = LoadFrameworkXC(frameworkName) Dim cstr As CString = constName dim constPtr as Ptr = dlsym(libPtr, cstr) Return constPtr Return nil End Function

Protected Function LoadFrameworkXC(frameworkName as String) As Ptr static frameworkHandlesDict as Dictionary = new Dictionary if frameworkHandlesDict.HasKey(frameworkName) then Return frameworkHandlesDict.Value(frameworkName) Declare Function dlopen Lib "/usr/lib/libSystem.dylib" ( path As CString, mode As Int32 ) As Ptr Declare Function dlerror Lib "/usr/lib/libSystem.dylib" () As CString Const RTLD_LAZY = 1 Const RTLD_GLOBAL = 8 dim path as String = "/System/Library/Frameworks/" + frameworkName + ".framework/" + frameworkName Dim pathCstr As CString = path Dim result As ptr = dlopen(pathCstr, RTLD_LAZY Or RTLD_GLOBAL ) If result = Nil Then 'Dim reason As Text = Text.FromCString(dlerror(), Xojo.Core.TextEncoding.UTF8) Dim reason As String = dlerror Dim exc As New InvalidArgumentException exc.message = reason Raise exc Return nil end if frameworkHandlesDict.Value(frameworkName) = result Return result End Function

Protected Function MainScreenScaleXC() As Double //declare function NSClassFromString lib "Foundation.Framework" (aClassName as CFStringRef) as Ptr Declare Function NSClassFromString Lib "Foundation" (aClassName As CFStringRef) As Ptr Soft Declare Function scale Lib "UIKit" selector "scale" (classRef As Ptr) As CGFloat Soft Declare Function mainScreen Lib "UIKit" selector "mainScreen" (classRef As Ptr) As ptr Dim scale As Double = scale(mainScreen(NSClassFromString("UIScreen"))) Return scale End Function

Protected Function MainScreenSizeXC() As Size //declare function NSClassFromString lib "Foundation.Framework" (aClassName as CFStringRef) as Ptr Declare Function NSClassFromString Lib "Foundation" (aClassName As CFStringRef) As Ptr //Improve size of picture Declare Function mainScreen Lib UIKitLib selector "mainScreen" (clsRef As ptr) As ptr Declare Function nativebounds Lib UIKitLib selector "nativeBounds" (obj_id As Ptr) As xcCGRect Dim sz As xcCGSize = nativeBounds(mainScreen(NSClassFromString("UIScreen"))).rsize Dim s As new Size(sz.width, sz.height) Return s End Function