Embarcadero Rad Studio 10.1.2 Delphi Linker error code 1 ($00000001)
[DCC Error] E2597 C:\Users\Public\Documents\Embarcadero\Studio\18.0\PlatformSDKs\android-ndk-r9c\toolchains\arm-linux-androideabi-4.6\prebuilt\windows\bin\arm-linux-androideabi-ld.exe: fatal error: .
Android
Debug
libAlamcenistaImpo.so: mmap: failed to allocate 202548716 bytes for output file: Not enough space
http://support.embarcadero.com/article/44279
Нам нужно 2 изображения – то, которое нужно сделать круглым и сама маска в виде круга. В процессе этого кода размеры этих изображений выравниваются, чтобы маска могла наложиться корректно, иначе это будет невозможно.
Помог вот это код с официального сайта Embarcadero
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 |
function TRegistrationFrame.BitMapFromMask(aSourceBitmap, aMaskBitmap: TBitmap): TBitmap; // The source bitmap and the mask will have the same size procedure CenterCopy(Source, Target: TBitmap); var X, Y: integer; TopLeft: TPoint; Rect: TRect; begin X := Source.Width div 2; Y := Source.Height div 2; //Define the top left corner of the rectangle to be copied TopLeft := Point(X - Target.Width div 2, Y - Target.Height div 2); //Define the rectangle to be copied Rect := TRect.Create(TopLeft, Target.Width, Target.Height); Target.CopyFromBitmap(Source, Rect, 0, 0); end; procedure CreateSameSizeBitmaps(Source1, Source2: TBitmap; var Target1, Target2: TBitmap); var minX, minY: Integer; begin // Resizes the initial bitmap and the mask to the same sizes // Finds the size of the result bitmap minX := Min(Source1.Width, Source2.Width); minY := Min(Source1.Height, Source2.Height); Target1 := TBitmap.Create(minX, minY); Target2 := TBitmap.Create(minX, minY); // Resizes to the initial bitmap CenterCopy(Source1, Target1); // Resizes to the mask CenterCopy(Source2, Target2); end; var Bitmap1, Bitmap2, Bitmap3: TBitmap; begin try // Resizes the source and the mask CreateSameSizeBitmaps(aSourceBitmap, aMaskBitmap, Bitmap1, Bitmap2); // Creates the final bitmap by applying the mask over the source Result := TBitmap.CreateFromBitmapAndMask(Bitmap1, Bitmap2); // iPhoto.Bitmap:=TBitmap.CreateFromBitmapAndMask(Bitmap1, Bitmap2); try // Displays the result //Result := Bitmap3; // Image3.Bitmap.UpdateHandles; finally // Frees the result bitmap //Bitmap3.Free; end; // Displays the resized images (source and mask) // Image4.Bitmap := Bitmap1; // Image5.Bitmap := Bitmap2; finally // Frees the resized source and mask bitmaps Bitmap2.Free; Bitmap1.Free; end; end; |
Вот как я его использовал
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 |
procedure TRegistrationFrame.TakePhotoFromLibraryAction1DidFinishTaking(Image: TBitmap); var imgRotated: TImage; minSide: integer; srcImage, maskImage: TImage; s: TResourceStream; newSize: Integer; R: Byte; ms: TMemoryStream; o: string; answer: string; begin maskImage := TImage.Create(Self); imgRotated := TImage.Create(Self); ms := TMemoryStream.Create; s := TResourceStream.Create(hInstance, 'mask4', RT_RCDATA); try { Image.SaveToStream(ms); o := GetExifOrientation(ms); if o = 'Rotate 90°' then Image.Rotate(90) //RotateBitmap90DegreesClockwise(Image) else if o = 'Rotate 180°' then Image.Rotate(180) else if o = 'Rotate 270°' then begin Image.Rotate(180); Image.Rotate(90); end; } // Image.Resize(180, 180); maskImage.Bitmap.LoadFromStream(s); iPhoto.Bitmap := BitMapFromMask(Image, maskImage.Bitmap); //CreateFromBitmapAndMask(img.Bitmap, maskImage.Bitmap); // := BitMapFromMask(Image, maskImage.Bitmap); PositionElements; LayoutNewPhoto.Visible := true; finally maskImage.Free; imgRotated.Free; ms.Free; s.Free; end; end; |
Писал сервер, и понадобилось обработать application/json запрос, очень помог код со stackOverflow для получения всей структуры json, делается это вот так…
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 |
procedure ParseJSON; var JSONText: string; JSON: ISuperObject; begin // Retrieve JSON as a string into JSONText variable any way you like. JSON := SO(JSONText); ProcessObject(JSON.AsObject); end; procedure ProcessObject(const aAsObject: TSuperTableString; const aPrefix: string = ''); var Names: ISuperObject; Name: string; Items: ISuperObject; Item: ISuperObject; idx: Integer; Value: string; ArrayItem: ISuperObject; begin if Assigned(aAsObject) then begin Names := aAsObject.GetNames; Items := aAsObject.GetValues; for idx := 0 to Items.AsArray.Length - 1 do begin Name := Names.AsArray[idx].AsString; Item := Items.AsArray[idx]; if Item.DataType = stObject then Value := '<Object>' else if Item.DataType = stArray then Value := '<Array>' else Value := Item.AsString; if SameText(Name, 'id') then WriteLn(Format('%s: %s', [aPrefix + Name, Value])); if Item.DataType = stArray then for ArrayItem in Item do ProcessObject(ArrayItem.AsObject, aPrefix + Name + '.'); if Item.DataType = stObject then ProcessObject(Item.AsObject, aPrefix + Name + '.'); end; end; end; |
В моем исполнении это получилось вот так…
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 |
procedure TDecodePostRequest.ParseJson(const aAsObject: TSuperTableString; var postParams: TStringList); //https://stackoverflow.com/questions/14082886/superobject-extract-all var Names: ISuperObject; Name: string; Items: ISuperObject; Item: ISuperObject; idx: Integer; Value: string; ArrayItem: ISuperObject; begin if Assigned(aAsObject) then begin Names := aAsObject.GetNames; Items := aAsObject.GetValues; for idx := 0 to Items.AsArray.Length - 1 do begin Name := Names.AsArray[idx].AsString; Item := Items.AsArray[idx]; if Item.DataType = stObject then Value := '<Object>' else if Item.DataType = stArray then Value := '<Array>' else Value := Item.AsString; postParams.Add(Name + '=' + Value); //if SameText(Name, 'id') then // WriteLn(Format('%s: %s', [aPrefix + Name, Value])); { if Item.DataType = stArray then for ArrayItem in Item do ProcessObject(ArrayItem.AsObject, aPrefix + Name + '.'); if Item.DataType = stObject then ProcessObject(Item.AsObject, aPrefix + Name + '.'); } end; end; end; |
В Android нет модальных окон, в Windows они есть. Обойти это можно так.
|
1 2 3 4 5 6 7 8 9 10 11 |
procedure TfrmParent.TestModalWindowClick(Sender: TObject); var f: TForm1; begin f := TForm1.Create(Self); f.ShowModal(procedure(ModalResult : TModalResult) begin if ModalResult = mrOK then // do something here end); end; |
Уничтожить форму можно в момент закрытия
|
1 2 3 4 |
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin Action := TCloseAction.caFree; end; |
Гениально и просто !)
Получение IMEI, пример работает на Delphi Berlin
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
function TSplashForm.GetIMEI: string; var obj: JObject; tm: JTelephonyManager; identifier: String; begin obj := SharedActivityContext.getSystemService(TJContext.JavaClass.TELEPHONY_SERVICE); if obj <> nil then begin tm := TJTelephonyManager.Wrap( (obj as ILocalObject).GetObjectID ); if obj<>nil then identifier := JStringToString(tm.getDeviceId); end; if identifier = '' then identifier := JStringToString(TJSettings_Secure.JavaClass.getString(SharedActivity.getContentResolver, TJSettings_Secure.JavaClass.ANDROID_ID)); result:=identifier; end; |
Пишу небольшое приложение на FireMonkey для Android, пару часов настраивал вкладку SDK Manager, скачивал SDK, NDK, JRE, выставлял пути сам пару часов, бился об ошибки, но Delphi оказался умнее, надо было просто нажать кнопку на Add и далее Delphi ищет все пути, нужно только чуток подождать ))) Вот скрины моих настроек, если это кому-то понадобится…
Ещё, как стартовая точка, мне очень помог пост Влада
Основной поток
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 |
unit uMain; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.Buttons, uApiTestThread; const WM_DATA_UPDATE = WM_APP + 1000; type TMain = class(TForm) pTop: TPanel; bTest: TBitBtn; mAllTests: TMemo; mErrors: TMemo; procedure bTestClick(Sender: TObject); private { Private declarations } procedure HandleProc(var aMsg: TMessage); message WM_DATA_UPDATE; public { Public declarations } end; var Main: TMain; implementation {$R *.dfm} procedure TMain.bTestClick(Sender: TObject); var t: TApiTestThread; begin t := TApiTestThread.Create(true); t.MainHandle := Self.Handle; t.FreeOnTerminate := true; t.Start; end; procedure TMain.HandleProc(var aMsg: TMessage); var txt: PWideChar; begin txt := PWideChar(aMsg.lParam); mAllTests.Lines.Add(aMsg.WParam.ToString()); mErrors.Lines.Add(txt); end; end. |
Дополнительный поток
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 |
unit uApiTestThread; interface uses System.Classes, Winapi.Messages, Winapi.Windows; const WM_DATA_UPDATE = WM_APP + 1000; type TApiTestThread = class(TThread) private FMainHandle: Hwnd; procedure Test; procedure SetMainHandle(const Value: Hwnd); { Private declarations } public property MainHandle: Hwnd read FMainHandle write SetMainHandle; protected procedure Execute; override; end; implementation { Important: Methods and properties of objects in visual components can only be used in a method called using Synchronize, for example, Synchronize(UpdateCaption); and UpdateCaption could look like, procedure TApiTestThread.UpdateCaption; begin Form1.Caption := 'Updated in a thread'; end; or Synchronize( procedure begin Form1.Caption := 'Updated in thread via an anonymous method' end ) ); where an anonymous method is passed. Similarly, the developer can call the Queue method with similar parameters as above, instead passing another TThread class as the first parameter, putting the calling thread in a queue with the other thread. } { TApiTestThread } procedure TApiTestThread.SetMainHandle(const Value: Hwnd); begin FMainHandle := Value; end; procedure TApiTestThread.Test(); var h: hwnd; s: string; begin h := FMainHandle; s := 'Привет'; Sendmessage(h, WM_DATA_UPDATE, 20, DWORD(PChar(s))); end; procedure TApiTestThread.Execute; begin { Place thread code here } Test; end; end. |
Пример из проекта – импорт данных в базу из Excel
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 |
procedure TRPAvitoImport.Execute; procedure parseParams(aParams: string; var aCategory: string; var aSubCategory: string); var sa, sa1, sa2: TArray<string>; begin sa := aParams.Split(['=']); if length(sa) > 1 then aCategory := stringReplace(sa[1], ', Тип услуги', '', [rfReplaceAll]); if length(sa) > 2 then aSubCategory := sa[2]; end; var e, sheet: OLEVariant; r: integer; c: integer; j: integer; i: Integer; rawPhone: string; contactName: string; regionName: string; cityName: string; adress: string; description: string; params: string; keywords: string; subCategoryName: string; categoryName: string; phone: string; idRegion: Integer; idCity: Integer; idCategory: integer; idUser: integer; currKeyWords: string; filePath: string; idSubCategory: Integer; begin e := CreateOleObject('Excel.Application'); e.DisplayAlerts := false; //отключаем запросы Excel e.Visible := false; filePath := 'avito_Orenburg_20180420.xls'; if TFile.Exists(ExtractFilePath(Application.ExeName) + filePath) then begin e.Workbooks.Open(ExtractFilePath(Application.ExeName) + filePath); sheet := e.Workbooks[ExtractFileName(filePath)].WorkSheets[1]; i := 2; // first row j := e.ActiveCell.SpecialCells(xlCellTypeLast).Row; // last row while i <> j do begin rawPhone := sheet.cells[i, 5]; contactName := sheet.cells[i, 7]; regionName := sheet.cells[i, 8]; cityName := sheet.cells[i, 9]; adress := sheet.cells[i, 12]; description := sheet.cells[i, 13]; //users_has_categories keywords := sheet.cells[i, 3]; // users_has_categories params := sheet.cells[i, 18]; parseParams(params, categoryName, subCategoryName); // ------------ INSERTION IN DB // --- region idRegion := getRegionID(regionName); if idRegion = -1 then idRegion := insertRegion(regionName); // --- city idCity := getCityID(cityName, idRegion); if idCity = -1 then idCity := insertCity(cityName, idRegion); // insert in users phone := TCommon.TryGetUserPhone(rawPhone); if (phone <> '') // then begin idUser := getUsersID(phone); if idUser = -1 then begin TCommon.InsertUser( // phone, // 'password', // 3, // aUserStatusCode // with status freezed 2, // aRoleCode contactName, // adress, // 1, // Russia idRegion, // idCity); // idUser := db.GetLastID; end; end; // update user keyWords currKeyWords := GetUserKeyWords(idUser); if currKeyWords = '' then currKeyWords := keywords else currKeyWords := currKeyWords + ',' + keywords; UpdateUserKeyWords(idUser, currKeyWords); // insert in categories idCategory := getCategoryID(categoryName); if idCategory = -1 then idCategory := insertCategory(categoryName, ''); // idSubCategory := getCategoryID(subCategoryName); if (subCategoryName <> '') and (idSubCategory = -1) then idSubCategory := insertCategory(subCategoryName, idCategory.toString); // insert in user_has_categories if GetUsersHasCategoriesID(idUser, idCategory) then UpdateUsersHasCategories(idUser, idCategory, description) else InsertUsersHasCategories(idUser, idCategory, description); inc(i); end; end; e.ActiveWorkBook.Close; e.Quit; e := Unassigned; end; |
Перешел superobject библиотеку с System.Json и ощутил массу удобств. Работать с ней показалось на порядок проще!
Чуть позже напишу развернутый пост, но пока зафиксирую ссылки, которые мне помогли с ней разобраться.
https://github.com/hgourvest/superobject
https://stackoverflow.com/questions/16790006/how-to-create-json-file-in-delphi-using-superobject-lib
