Category Archives: Delphi

Delphi. Запуск анонимного потока

Posted on 11.11.2018 by Stanislav_Panteleev

Увидел в блоге следующий пример, по-моему оч. удобно для каких-то простых случаев….

TThread.CreateAnonymousThread(
          procedure   
          begin
            // do smth...
          end).Start;

TThread.CreateAnonymousThread(

procedure

begin

// do smth...

end).Start;

Немного модифицировал

 // Если нужно настраивать какие-то параметры проекта после его запуска
 t := TThread.CreateAnonymousThread(
    procedure
    var
      i: Integer;
    begin
      for i := 0 to 10 do
        Sleep(15);
    end).Start;
  t.FreeOnTerminate := true;

  // Если нужно настраивать какие-то параметры потока до его запуска...
  with TThread.CreateAnonymousThread(
    procedure
    var
      i: Integer;
    begin
      for i := 0 to 10 do
        Sleep(15);
    end) do
  begin
    FreeOnTerminate := true;
    Start;
  end;
e

// Если нужно настраивать какие-то параметры проекта после его запуска

t := TThread.CreateAnonymousThread(

procedure

var

i: Integer;

begin

for i := 0 to 10 do

Sleep(15);

end).Start;

t.FreeOnTerminate := true;

// Если нужно настраивать какие-то параметры потока до его запуска...

with TThread.CreateAnonymousThread(

procedure

var

i: Integer;

begin

for i := 0 to 10 do

Sleep(15);

end) do

begin

FreeOnTerminate := true;

Start;

end;

Со StackOverflow, в тему, запуск анонимного потока процедуры с параметрами

procedure DoSomething(const aWebAddress: String);
begin
end;

procedure BuildThread;
var
  myThread: TThread;
  fetchURL: string;
begin
  fetchURL := 'http://stackoverflow.com';
  // Create an anonymous thread that calls a method and passes in
  // the fetchURL to that method.
  myThread := TThread.CreateAnonymousThread(
    procedure
    begin
      DoSomething(fetchURL);
    end);
  ...
end;

procedure DoSomething(const aWebAddress: String);

begin

end;

procedure BuildThread;

var

myThread: TThread;

fetchURL: string;

begin

fetchURL := 'http://stackoverflow.com';

// Create an anonymous thread that calls a method and passes in

// the fetchURL to that method.

myThread := TThread.CreateAnonymousThread(

procedure

begin

DoSomething(fetchURL);

end);

...

end;

Posted in Delphi | Comments Off

Delphi. “Nullable” Post by Allen Bauer

Posted on 30.10.2018 by Stanislav_Panteleev

В Delphi вроде как нет Nullable типов, но если нет, но очень хочется, то они могут появиться ))) Читал книгу Delphi Memory Management, и там наткнулся на раздел про Nullable, автор книги ссылался на MVP Allen Bauer. Идея проста… To implement … Continue reading →

Posted in Delphi | Comments Off

Delphi. SmartPointers – меньше кода больше дела

Posted on 30.10.2018 by Stanislav_Panteleev

Читая Delphi Memory Management, открыл для себя SmartPointers. Подход, основанный на ARC, позволяет, применяя данный класс писать меньше кода, заниматься больше делом, сосредоточиться на бизнес-задаче.

unit uSmartPointer;

interface

type
  ISmartPointer<T> = reference to function: T;

  TSmartPointer<T: class, constructor> = class(TInterfacedObject, ISmartPointer<T>)
  private
    FValue: T;
    function Invoke: T;
    procedure SetValue(const Value: T);
  public
    constructor Create; overload;
    constructor Create(AValue: T); overload;
    destructor Destroy; override;
    function Extract: T;
    property Value: T read FValue write SetValue;
  end;

implementation

constructor TSmartPointer<T>.Create;
begin
  inherited Create;
  FValue := T.Create;
end;

constructor TSmartPointer<T>.Create(AValue: T);
begin
  inherited Create;
  FValue := AValue;
end;

destructor TSmartPointer<T>.Destroy;
begin
  FValue.Free;
  inherited;
end;

function TSmartPointer<T>.Invoke: T;
begin
  Result := FValue;
end;

procedure TSmartPointer<T>.SetValue(const Value: T);
begin
  FValue := Value;
end;

function TSmartPointer<T>.Extract: T;
begin
  Result := FValue;
  FValue := nil;
end;

end.

unit uSmartPointer;

interface

type

ISmartPointer<T> = reference to function: T;

TSmartPointer<T: class, constructor> = class(TInterfacedObject, ISmartPointer<T>)

private

FValue: T;

function Invoke: T;

procedure SetValue(const Value: T);

public

constructor Create; overload;

constructor Create(AValue: T); overload;

destructor Destroy; override;

function Extract: T;

property Value: T read FValue write SetValue;

end;

implementation

constructor TSmartPointer<T>.Create;

begin

inherited Create;

FValue := T.Create;

end;

constructor TSmartPointer<T>.Create(AValue: T);

begin

inherited Create;

FValue := AValue;

end;

destructor TSmartPointer<T>.Destroy;

begin

FValue.Free;

inherited;

end;

function TSmartPointer<T>.Invoke: T;

begin

Result := FValue;

end;

procedure TSmartPointer<T>.SetValue(const Value: T);

begin

FValue := Value;

end;

function TSmartPointer<T>.Extract: T;

begin

Result := FValue;

FValue := nil;

end;

end.

Теперь можно писать так…

var
sl: ISmartPointer<TStringList>;
begin
sl := TSmartPointer<TStringList>.Create();
sl.Add('I am inside automanaged StringList');
end;

var

sl: ISmartPointer<TStringList>;

begin

sl := TSmartPointer<TStringList>.Create();

sl.Add('I am inside automanaged StringList');

end;

Вместо…

Posted in Delphi | Comments Off

Delphi. Memory Management. Book

Posted on 27.10.2018 by Stanislav_Panteleev

Купил сегодня книгу по управлению памятью в Delphi. Понравилось содержание, хочу углубить свои знания в этом вопросе. А вот и содержание на английском…

Posted in Delphi | Comments Off

Delphi. GarbageCollector

Posted on 26.10.2018 by Stanislav_Panteleev

Понравилось, на одном из форумов, а ля сборщик мусора, теоретически должно сократиться количество кода… Но надо потестить….

unit uGC;
 
interface
 
uses
  System.Generics.Collections, Rtti, System.Classes;
 
 ///<summary> Класс позволяющий упростить освобождение памяти.</summary>
type
  TGarbageCollector = class(TComponent)
  public
    const
      DEFAULT_TAG = 'DEFAULT_TAG';
  private
    items: TDictionary<TObject, string>;
  public
    //constructor Create();
    destructor Destroy; override;
//    constructor Create(AOwner: TComponent); override;
    constructor Create(AOwner: TComponent); override;
  ///<summary> Добавить элемент в список и вернуть свежедобавленный элемент.</summary>
    function Add<T>(item: T): T; overload;
  ///<summary> Добавить помеченый элемент в список и вернуть свежедобавленный элемент.</summary>
    function Add<T>(item: T; const tag: string): T; overload;
  /// <summary> Произвести сборку мусора с указанной меткой. </summary>
    procedure Collect(const tag: string);
  end;
 
var
  GC: TGarbageCollector;
 
implementation
 
uses
  System.Types, System.SysUtils;
 
{
constructor TGarbageCollector.Create();
begin
  items := TObjectDictionary<TObject, string>.Create([doOwnsKeys]);
end;
}
 
constructor TGarbageCollector.Create(AOwner: TComponent);
begin
  inherited;
  items := TObjectDictionary<TObject, string>.Create([doOwnsKeys]);
end;
 
destructor TGarbageCollector.Destroy;
begin
  items.free();
  inherited Destroy;
end;
 
function TGarbageCollector.Add<T>(item: T): T;
begin
  result := Add(item, DEFAULT_TAG);
end;
 
function TGarbageCollector.Add<T>(item: T; const tag: string): T;
var
  obj: TObject;
  v: TValue;
begin
  v := TValue.From<T>(item);
  if v.IsObject then
  begin
    items.add(v.AsObject, tag);
    result := item;
  end
  else
    raise Exception.Create('not an Object');
end;
 
procedure TGarbageCollector.Collect(const tag: string);
var
  key: TObject;
  item: TPair<TObject, string>;
  gcList: TList<TObject>;
begin
  gcList := TList<TObject>.Create();
  try
    for item in items do
    begin
      if (item.Value = tag) then
        gcList.add(item.Key);
    end;
 
    for key in gcList do
      items.remove(key);
  finally
    gcList.free();
  end;
end;
 
end.

unit uGC;

interface

uses

System.Generics.Collections, Rtti, System.Classes;

///<summary> Класс позволяющий упростить освобождение памяти.</summary>

type

TGarbageCollector = class(TComponent)

public

const

DEFAULT_TAG = 'DEFAULT_TAG';

private

items: TDictionary<TObject, string>;

public

//constructor Create();

destructor Destroy; override;

// constructor Create(AOwner: TComponent); override;

constructor Create(AOwner: TComponent); override;

///<summary> Добавить элемент в список и вернуть свежедобавленный элемент.</summary>

function Add<T>(item: T): T; overload;

///<summary> Добавить помеченый элемент в список и вернуть свежедобавленный элемент.</summary>

function Add<T>(item: T; const tag: string): T; overload;

/// <summary> Произвести сборку мусора с указанной меткой. </summary>

procedure Collect(const tag: string);

end;

var

GC: TGarbageCollector;

implementation

uses

System.Types, System.SysUtils;

{

constructor TGarbageCollector.Create();

begin

items := TObjectDictionary<TObject, string>.Create([doOwnsKeys]);

end;

}

constructor TGarbageCollector.Create(AOwner: TComponent);

begin

inherited;

items := TObjectDictionary<TObject, string>.Create([doOwnsKeys]);

end;

destructor TGarbageCollector.Destroy;

begin

items.free();

inherited Destroy;

end;

function TGarbageCollector.Add<T>(item: T): T;

begin

result := Add(item, DEFAULT_TAG);

end;

function TGarbageCollector.Add<T>(item: T; const tag: string): T;

var

obj: TObject;

v: TValue;

begin

v := TValue.From<T>(item);

if v.IsObject then

begin

items.add(v.AsObject, tag);

result := item;

end

else

raise Exception.Create('not an Object');

end;

procedure TGarbageCollector.Collect(const tag: string);

var

key: TObject;

item: TPair<TObject, string>;

gcList: TList<TObject>;

begin

gcList := TList<TObject>.Create();

try

for item in items do

begin

if (item.Value = tag) then

gcList.add(item.Key);

end;

for key in gcList do

items.remove(key);

finally

gcList.free();

end;

end.

Пример использования

program GarbageCollector;
 
uses
  Vcl.Forms,
  uMain in 'uMain.pas' {Main},
  uGC in 'uGC.pas',
  uSomeClass in 'uSomeClass.pas';
 
{$R *.res}
 
begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  GC := TGarbageCollector.Create(Application); // <<<
  Application.CreateForm(TMain, Main);
  Application.Run;
end.

program GarbageCollector;

uses

Vcl.Forms,

uMain in 'uMain.pas' {Main},

uGC in 'uGC.pas',

uSomeClass in 'uSomeClass.pas';

{$R *.res}

begin

Application.Initialize;

Application.MainFormOnTaskbar := True;

GC := TGarbageCollector.Create(Application); // <<<

Application.CreateForm(TMain, Main);

Application.Run;

end.

В любом месте проекта делаем что-то подобное…

someInstance := GC.Add(TSomeClass.Create(nil), 'TSomeClassTag');
  // do smth with someInstance
  //now destroy
  GC.Collect('TSomeClassTag');
  //
  anotherInstance := GC.Add(TSomeClass.Create(nil), 'TSomeClassTag');
  // do smth with anotherInstance
  // not destroying here - will be destroyed on app destroy...

someInstance := GC.Add(TSomeClass.Create(nil), 'TSomeClassTag');

// do smth with someInstance

//now destroy

GC.Collect('TSomeClassTag');

anotherInstance := GC.Add(TSomeClass.Create(nil), 'TSomeClassTag');

// do smth with anotherInstance

// not destroying here - will be destroyed on app destroy...

Врубил

ReportMemoryLeaksOnShutdown := true;

1	ReportMemoryLeaksOnShutdown := true;

При закрытии приложения – тишина, и это радует. Прошелся … Continue reading →

Posted in Delphi | Comments Off

Delphi. Тестовое задание. Проект квартира

Posted on 15.10.2018 by Stanislav_Panteleev

Ссылка на описание тестового задания Проект сделан на Delphi Berlin+MySQL; Реализация на VCL Forms Application Проект на Delphi Berlin (скачать) Код на gitHub База данных Для автоматического проставления даты в момент добавления записей использованы триггеры, например

CREATE DEFINER = CURRENT_USER TRIGGER `flat_db`.`counterData_BEFORE_INSERT` BEFORE INSERT ON `counterData` FOR EACH ROW
BEGIN
SET NEW.MeasureDateTime = Now();
END

CREATE DEFINER = CURRENT_USER TRIGGER `flat_db`.`counterData_BEFORE_INSERT` BEFORE INSERT ON `counterData` FOR EACH ROW

BEGIN

SET NEW.MeasureDateTime = Now();

END

Полный код … Continue reading →

Posted in Delphi | Comments Off

Delphi. Firemonkey. Fatal error

Posted on 16.07.2018 by Stanislav_Panteleev

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: .AndroidDebuglibAlamcenistaImpo.so: mmap: failed to allocate 202548716 bytes for output file: Not enough space http://support.embarcadero.com/article/44279

Posted in Delphi | Comments Off

Delphi. Firemonkey. Делаем круглое изображение наложением маски

Posted on 29.06.2018 by Stanislav_Panteleev

Нам нужно 2 изображения – то, которое нужно сделать круглым и сама маска в виде круга. В процессе этого кода размеры этих изображений выравниваются, чтобы маска могла наложиться корректно, иначе это будет невозможно. Помог вот это код с официального сайта … Continue reading →

Posted in Delphi | Comments Off

Delphi. Json. Получение всей структуры ключей-значений

Posted on 28.06.2018 by Stanislav_Panteleev

Писал сервер, и понадобилось обработать application/json запрос, очень помог код со stackOverflow для получения всей структуры json, делается это вот так… Для своей задачи сделал так…

procedure TDecodePostRequest.ParseJson(const aAsObject: TSuperTableString; var postParams: TStringList);
var
  names: ISuperObject;
  name: string;
  items: ISuperObject;
  item: ISuperObject;
  idx: Integer;
  value: string;
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;

procedure TDecodePostRequest.ParseJson(const aAsObject: TSuperTableString; var postParams: TStringList);

var

names: ISuperObject;

name: string;

items: ISuperObject;

item: ISuperObject;

idx: Integer;

value: string;

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;

Posted in Delphi | Comments Off

Delphi. FireMonkey. Модальные окна

Posted on 28.06.2018 by Stanislav_Panteleev

В Android нет модальных окон, в Windows они есть. Обойти это можно так.

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;

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;

Уничтожить форму можно в момент закрытия

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

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Action := TCloseAction.caFree;

end;

Гениально и просто !) Взял отсюда

Posted in Delphi, FireMonkey | Comments Off

Category Archives: Delphi

Delphi. Запуск анонимного потока

Delphi. “Nullable” Post by Allen Bauer

Delphi. SmartPointers – меньше кода больше дела

Delphi. Memory Management. Book

Delphi. GarbageCollector

Delphi. Тестовое задание. Проект квартира

Delphi. Firemonkey. Fatal error

Delphi. Firemonkey. Делаем круглое изображение наложением маски

Delphi. Json. Получение всей структуры ключей-значений

Delphi. FireMonkey. Модальные окна

MY PROJECTS

Recent Posts

Categories