Category Archives: Delphi

Delphi. UniGUI. Как узнать высоту текста в uniHTMLFrame?

Posted on 03.04.2018 by Stanislav_Panteleev

Выстраивал высоту элементов, возник вопрос с определением высоты текста в UniHTMLFrame. Способ №1 от Delphi Developer

  js:='alert('+HTMLFrame.JSName+'.body.el.dom.scrollHeight);';
  UniSession.JSCode(js);

1 2	js:='alert('+HTMLFrame.JSName+'.body.el.dom.scrollHeight);'; UniSession.JSCode(js);

Способ №2 Мой способ, менее эффективный, с оборачиванием в div, но тоже рабочий. Решил так. Сначала обернем наш HTML в div c известным … Continue reading →

Posted in Delphi, UniGui | Comments Off

Delphi. UniGUI. Делаем товары месяца

Posted on 24.03.2018 by Stanislav_Panteleev

Вот что у нас получится. Левая и правая панельки нужны для листания вправо и влево. Листание происходит за счет смещения на 1 плитку в ту или иную сторону. Стартовое размещение плиток при загрузке.

Posted in Delphi | Comments Off

Delphi. UniGUI. Делаем витрину. Алгоритм выкладывания плиток

Posted on 23.03.2018 by Stanislav_Panteleev

Здесь будет код из проекта и идеи алгоритма по шагам. Вот какой будет результат в конце. Оттолкнувшись от него, можно будет сделать в своем проекте аналогичное выкладывание плиток ШАГ 0 – рисуем на бумаге

Posted in Delphi | Comments Off

Delphi. MultiSelect. Gather field values

Posted on 07.03.2018 by Stanislav_Panteleev

simple example….

  invoicesIDSL := TStringList.Create;
  try
    if DBGrid.SelectedRows.Count > 0 then
      with DBGrid.DataSource.DataSet do
        for i := 0 to DBGrid.SelectedRows.Count - 1 do
        begin
          GotoBookmark(pointer(DBGrid.SelectedRows.Items[i]));
          invoicesIDSL.Add(FieldByName('id').AsInteger.ToString);
        end;
  finally
    invoicesIDSL.Free();
  end;

invoicesIDSL := TStringList.Create;

try

if DBGrid.SelectedRows.Count > 0 then

with DBGrid.DataSource.DataSet do

for i := 0 to DBGrid.SelectedRows.Count - 1 do

begin

GotoBookmark(pointer(DBGrid.SelectedRows.Items[i]));

invoicesIDSL.Add(FieldByName('id').AsInteger.ToString);

end;

finally

invoicesIDSL.Free();

end;

Posted in Delphi | Comments Off

OmniThread and Exceptions

Posted on 11.02.2018 by Stanislav_Panteleev

OmniThread and exceptions… Example # 48 is good… from demos of omni lib…

procedure TOmniTasks.Test2;
begin
  Parallel.Async(
    procedure
    begin
      Sleep(1000);
      raise Exception.Create('Exception in Async');
    end, Parallel.TaskConfig.OnTerminated(
    procedure(const task: IOmniTaskControl)
    var
      e: Exception;
    begin
      if assigned(task.FatalException) then
      begin
        e := task.DetachException;
        FLogger.LogStr('foreCastSalesCount ' + e.Message, tlpError);
        //  Log('Caught async exception %s:%s', [excp.ClassName, excp.Message]);
        FreeAndNil(e);
      end;
    end));
end;

procedure TOmniTasks.Test2;

begin

Parallel.Async(

procedure

begin

Sleep(1000);

raise Exception.Create('Exception in Async');

end, Parallel.TaskConfig.OnTerminated(

procedure(const task: IOmniTaskControl)

var

e: Exception;

begin

if assigned(task.FatalException) then

begin

e := task.DetachException;

FLogger.LogStr('foreCastSalesCount ' + e.Message, tlpError);

// Log('Caught async exception %s:%s', [excp.ClassName, excp.Message]);

FreeAndNil(e);

end;

end));

end;

Posted in Delphi | Comments Off

Delphi. Omnithreads. ProgressBar with ForEach

Posted on 28.01.2018 by Stanislav_Panteleev

Example with progress Bar on ForEach abstraction.

unit test_55_ForEachProgress;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls, ComCtrls,

  OtlTask,
  OtlParallel;

type
  TfrmForEachWithProgressBar = class(TForm)
    btnStart : TButton;
    pbForEach: TProgressBar;
    procedure btnStartClick(Sender: TObject);
  private
    FPosition: integer;
    FProgress: integer;
    FWorker  : IOmniParallelLoop<integer>;
    procedure IncrementProgressBar;
  end;

var
  frmForEachWithProgressBar: TfrmForEachWithProgressBar;

implementation

{$R *.dfm}

const
  CNumLoop = 20000;

procedure TfrmForEachWithProgressBar.btnStartClick(Sender: TObject);
begin
  btnStart.Enabled := false;

  pbForEach.Max := 100;
  pbForEach.Position := 0;
  pbForEach.Update;
  FProgress := 0;
  FPosition := 0;

  // reference must be kept in a global field so that the task controller is not destroyed before the processing ends
  FWorker := Parallel
    .ForEach(1, CNumLoop)
    .NoWait // important, otherwise message loop will be blocked while ForEach waits for all tasks to terminate
    .OnStop(
      procedure (const task: IOmniTask)
      begin
        // because of NoWait, OnStop delegate is invoked from the worker code; we must not destroy the worker at that point or the program will block
        task.Invoke(
          procedure begin
            FWorker := nil;
            btnStart.Enabled := true;
          end
        );
      end
    );

  FWorker.Execute(
    procedure (const task: IOmniTask; const i: integer)
    begin
      // do some work
      Sleep(1);

      // update the progress bar
      // we cannot use 'i' for progress as it does not increase sequentially
      // IncrementProgressBar uses internal counter to follow the progress
      task.Invoke(IncrementProgressBar);
    end
  );
end;

procedure TfrmForEachWithProgressBar.IncrementProgressBar;
var
  newPosition: integer;
begin
  Inc(FProgress);
  newPosition := Trunc((FProgress / CNumLoop)*pbForEach.Max);
  // make sure we don't overflow TProgressBar with messages
  if newPosition <> FPosition then begin
    pbForEach.Position := newPosition;
    FPosition := newPosition;
  end;
end;

end.

unit test_55_ForEachProgress;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics,

Controls, Forms, Dialogs, StdCtrls, ComCtrls,

OtlTask,

OtlParallel;

type

TfrmForEachWithProgressBar = class(TForm)

btnStart : TButton;

pbForEach: TProgressBar;

procedure btnStartClick(Sender: TObject);

private

FPosition: integer;

FProgress: integer;

FWorker : IOmniParallelLoop<integer>;

procedure IncrementProgressBar;

end;

var

frmForEachWithProgressBar: TfrmForEachWithProgressBar;

implementation

{$R *.dfm}

const

CNumLoop = 20000;

procedure TfrmForEachWithProgressBar.btnStartClick(Sender: TObject);

begin

btnStart.Enabled := false;

pbForEach.Max := 100;

pbForEach.Position := 0;

pbForEach.Update;

FProgress := 0;

FPosition := 0;

// reference must be kept in a global field so that the task controller is not destroyed before the processing ends

FWorker := Parallel

.ForEach(1, CNumLoop)

.NoWait // important, otherwise message loop will be blocked while ForEach waits for all tasks to terminate

.OnStop(

procedure (const task: IOmniTask)

begin

// because of NoWait, OnStop delegate is invoked from the worker code; we must not destroy the worker at that point or the program will block

task.Invoke(

procedure begin

FWorker := nil;

btnStart.Enabled := true;

end

);

end

);

FWorker.Execute(

procedure (const task: IOmniTask; const i: integer)

begin

// do some work

Sleep(1);

// update the progress bar

// we cannot use 'i' for progress as it does not increase sequentially

// IncrementProgressBar uses internal counter to follow the progress

task.Invoke(IncrementProgressBar);

end

);

end;

procedure TfrmForEachWithProgressBar.IncrementProgressBar;

var

newPosition: integer;

begin

Inc(FProgress);

newPosition := Trunc((FProgress / CNumLoop)*pbForEach.Max);

// make sure we don't overflow TProgressBar with messages

if newPosition <> FPosition then begin

pbForEach.Position := newPosition;

FPosition := newPosition;

end;

end.

Posted in Delphi | Comments Off

Delphi.Omnithreads.Future – hunting the value in backGroundThread

Posted on 28.01.2018 by Stanislav_Panteleev

Future is good thread abstraction that hunts for the value in background thread. We can ask backGround thread what is value now. Calling VCL from backGround is bad idea in that case. For that pupose see http://www.thedelphigeek.com/2014/07/incrementing-progress-bar-from-foreach.html Below is example … Continue reading →

Posted in Delphi | Comments Off

Delphi. OmniThreads.Async – most simple example

Posted on 28.01.2018 by Stanislav_Panteleev

hi, most simple example of OmniThread lib looks like

procedure TfrmDemoParallelAsync.btnAsyncClick(Sender: TObject);
begin
  btnAsync.Enabled := false;

  Parallel.Async(
    procedure
    begin
      // executed in background thread
      Caption := 'Work...';
      Sleep(500);
      MessageBeep($FFFFFFFF);
    end, Parallel.TaskConfig.OnTerminated(
    procedure(const task: IOmniTaskControl)
    begin
        // executed in main thread
      btnAsync.Enabled := true;
      Caption := 'Ready';
    end));
end;

procedure TfrmDemoParallelAsync.btnAsyncClick(Sender: TObject);

begin

btnAsync.Enabled := false;

Parallel.Async(

procedure

begin

// executed in background thread

Caption := 'Work...';

Sleep(500);

MessageBeep($FFFFFFFF);

end, Parallel.TaskConfig.OnTerminated(

procedure(const task: IOmniTaskControl)

begin

// executed in main thread

btnAsync.Enabled := true;

Caption := 'Ready';

end));

end;

GUI is responsive during executing the code…

Posted in Delphi | Comments Off

Delphi. UniGUI. Emulation of Pages using Frames

Posted on 27.01.2018 by Stanislav_Panteleev

UniGUI is SPA – single page application, but, emulation is possible. One option – use frames.

unit uPagesFramesDM;

interface

uses
  SysUtils, Classes, uPage1Frame, uPage2Frame;

type
  TPagesFramesDM = class(TDataModule)
  private
    FCurrentPage: integer;
    FPage1: TPage1Frame;
    FPage2: TPage2Frame;
    FSomeParent: TObject;
    FHistory: TArray<integer>;
    procedure SetCurrentPage(const Value: integer);
    procedure KillFrames();
    procedure AddHistory(AValue: integer);
    procedure SetMainForm(const Value: TObject);
    procedure SetHistory(const Value: TArray<integer>);

    { Private declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    procedure Back();
    procedure Next();
    procedure Load(aIndex: integer);
    property SomeParent: TObject read FSomeParent write SetMainForm;
    property CurrentPage: integer read FCurrentPage write SetCurrentPage;
    property History: TArray<integer> read FHistory write SetHistory;
  end;

implementation

uses
  Vcl.Controls, Main, uniGUIApplication;

{$R *.dfm}


{ TDataModule1 }

procedure TPagesFramesDM.AddHistory(AValue: integer);
begin
  SetLength(FHistory, length(FHistory) + 1);
  FHistory[high(FHistory)] := AValue;
end;

procedure TPagesFramesDM.Back;
begin
  if FCurrentPage > 0 then
  begin
    FCurrentPage := FCurrentPage - 1;
    Load(CurrentPage);
  end;
end;

constructor TPagesFramesDM.Create(AOwner: TComponent);
begin
  inherited;
// loadCurrentPage
  FHistory := [0, 1];
end;

procedure TPagesFramesDM.Next;
begin
  if FCurrentPage < High(FHistory) then
  begin
    FCurrentPage := FCurrentPage + 1;
    Load(CurrentPage);
  end;
end;

procedure TPagesFramesDM.KillFrames;
begin
  if assigned(FPage1) then
    FreeAndNil(FPage1);
  if assigned(FPage2) then
    FreeAndNil(FPage2);
end;

procedure TPagesFramesDM.Load(aIndex: integer);
begin
  case aIndex of
    0:
      begin
      // load first page
        killFrames();
        FPage1 := TPage1Frame.Create(MainForm);
        with FPage1 do
        begin
          Parent := MainForm;
          Align := alClient;
          Show();
        end;
      end;
    1:
      begin
      // load second page
        killFrames();
        FPage2 := TPage2Frame.Create(MainForm);
        with FPage2 do
        begin
          Parent := MainForm;
          Align := alClient;
          Show();
        end;
      end;
  end;
end;

procedure TPagesFramesDM.SetCurrentPage(const Value: integer);
begin
  FCurrentPage := Value;
end;

procedure TPagesFramesDM.SetHistory(const Value: TArray<integer>);
begin
  FHistory := Value;
end;

procedure TPagesFramesDM.SetMainForm(const Value: TObject);
begin
  FSomeParent := Value;
end;

end.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

unit uPagesFramesDM;

interface

uses

SysUtils, Classes, uPage1Frame, uPage2Frame;

type

TPagesFramesDM = class(TDataModule)

private

FCurrentPage: integer;

FPage1: TPage1Frame;

FPage2: TPage2Frame;

FSomeParent: TObject;

FHistory: TArray<integer>;

procedure SetCurrentPage(const Value: integer);

procedure KillFrames();

procedure AddHistory(AValue: integer);

procedure SetMainForm(const Value: TObject);

procedure SetHistory(const Value: TArray<integer>);

{ Private declarations }

public

{ Public declarations }

constructor Create(AOwner: TComponent); override;

procedure Back();

procedure Next();

procedure Load(aIndex: integer);

property SomeParent: TObject read FSomeParent write SetMainForm;

property CurrentPage: integer read FCurrentPage write SetCurrentPage;

property History: TArray<integer> read FHistory write SetHistory;

end;

implementation

uses

Vcl.Controls, Main, uniGUIApplication;

{$R *.dfm}

{ TDataModule1 }

procedure TPagesFramesDM.AddHistory(AValue: integer);

begin

SetLength(FHistory, length(FHistory) + 1);

FHistory[high(FHistory)] := AValue;

end;

procedure TPagesFramesDM.Back;

begin

if FCurrentPage > 0 then

begin

FCurrentPage := FCurrentPage - 1;

Load(CurrentPage);

end;

constructor TPagesFramesDM.Create(AOwner: TComponent);

begin

inherited;

// loadCurrentPage

FHistory := [0, 1];

end;

procedure TPagesFramesDM.Next;

begin

if FCurrentPage < High(FHistory) then

begin

FCurrentPage := FCurrentPage + 1;

Load(CurrentPage);

end;

procedure TPagesFramesDM.KillFrames;

begin

if assigned(FPage1) then

FreeAndNil(FPage1);

if assigned(FPage2) then

FreeAndNil(FPage2);

end;

procedure TPagesFramesDM.Load(aIndex: integer);

begin

case aIndex of

begin

// load first page

killFrames();

FPage1 := TPage1Frame.Create(MainForm);

with FPage1 do

begin

Parent := MainForm;

Align := alClient;

Show();

end;

begin

// load second page

killFrames();

FPage2 := TPage2Frame.Create(MainForm);

with FPage2 do

begin

Parent := MainForm;

Align := alClient;

Show();

end;

procedure TPagesFramesDM.SetCurrentPage(const Value: integer);

begin

FCurrentPage := Value;

end;

procedure TPagesFramesDM.SetHistory(const Value: TArray<integer>);

begin

FHistory := Value;

end;

procedure TPagesFramesDM.SetMainForm(const Value: TObject);

begin

FSomeParent := Value;

end;

end.

Then call its in main like this

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, uniGUITypes, uniGUIAbstractClasses, uniGUIClasses, uniGUIRegClasses,
  uniGUIForm, uniGUIBaseClasses, uniPanel, uniButton, uniBitBtn, uPagesFramesDM;

type
  TMainForm = class(TUniForm)
    pMainMenuTop: TUniPanel;
    bPrevious: TUniBitBtn;
    bNext: TUniBitBtn;
    bPage1: TUniBitBtn;
    bPage2: TUniBitBtn;
    procedure bPreviousClick(Sender: TObject);
    procedure bNextClick(Sender: TObject);
    procedure bPage1Click(Sender: TObject);
    procedure bPage2Click(Sender: TObject);
    procedure UniFormAfterShow(Sender: TObject);
  private
    { Private declarations }
    FPages: TPagesFramesDM;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
  end;

function MainForm: TMainForm;

implementation

{$R *.dfm}

uses
  uniGUIVars, MainModule, uniGUIApplication;

function MainForm: TMainForm;
begin
  Result := TMainForm(UniMainModule.GetFormInstance(TMainForm));
end;

{ TMainForm }

procedure TMainForm.bPage1Click(Sender: TObject);
begin
  FPages.Load(0);
end;

procedure TMainForm.bPage2Click(Sender: TObject);
begin
  FPages.Load(1);
end;

procedure TMainForm.bPreviousClick(Sender: TObject);
begin
  FPages.Back();
end;

constructor TMainForm.Create(AOwner: TComponent);
begin
  inherited;
  FPages := TPagesFramesDM.Create(UniApplication);
  FPages.SomeParent := Self;
end;

procedure TMainForm.UniFormAfterShow(Sender: TObject);
begin
  FPages.Load(0);
end;

procedure TMainForm.bNextClick(Sender: TObject);
begin
  FPages.Next()
end;

initialization
  RegisterAppFormClass(TMainForm);

end.

unit Main;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, uniGUITypes, uniGUIAbstractClasses, uniGUIClasses, uniGUIRegClasses,

uniGUIForm, uniGUIBaseClasses, uniPanel, uniButton, uniBitBtn, uPagesFramesDM;

type

TMainForm = class(TUniForm)

pMainMenuTop: TUniPanel;

bPrevious: TUniBitBtn;

bNext: TUniBitBtn;

bPage1: TUniBitBtn;

bPage2: TUniBitBtn;

procedure bPreviousClick(Sender: TObject);

procedure bNextClick(Sender: TObject);

procedure bPage1Click(Sender: TObject);

procedure bPage2Click(Sender: TObject);

procedure UniFormAfterShow(Sender: TObject);

private

{ Private declarations }

FPages: TPagesFramesDM;

public

{ Public declarations }

constructor Create(AOwner: TComponent); override;

end;

function MainForm: TMainForm;

implementation

{$R *.dfm}

uses

uniGUIVars, MainModule, uniGUIApplication;

function MainForm: TMainForm;

begin

Result := TMainForm(UniMainModule.GetFormInstance(TMainForm));

end;

{ TMainForm }

procedure TMainForm.bPage1Click(Sender: TObject);

begin

FPages.Load(0);

end;

procedure TMainForm.bPage2Click(Sender: TObject);

begin

FPages.Load(1);

end;

procedure TMainForm.bPreviousClick(Sender: TObject);

begin

FPages.Back();

end;

constructor TMainForm.Create(AOwner: TComponent);

begin

inherited;

FPages := TPagesFramesDM.Create(UniApplication);

FPages.SomeParent := Self;

end;

procedure TMainForm.UniFormAfterShow(Sender: TObject);

begin

FPages.Load(0);

end;

procedure TMainForm.bNextClick(Sender: TObject);

begin

FPages.Next()

end;

initialization

RegisterAppFormClass(TMainForm);

end.

Posted in Delphi | Comments Off

RTTI Atributes

Posted on 26.01.2018 by Stanislav_Panteleev

shows how to work with RTTI and attributes RTTI – Run Time Type Library – is approach that helps to manage code when program is running. Lets say we have code from someOne without docs. RTTI will help to find … Continue reading →

Posted in Delphi | Comments Off

Category Archives: Delphi

Delphi. UniGUI. Как узнать высоту текста в uniHTMLFrame?

Delphi. UniGUI. Делаем товары месяца

Delphi. UniGUI. Делаем витрину. Алгоритм выкладывания плиток

Delphi. MultiSelect. Gather field values

OmniThread and Exceptions

Delphi. Omnithreads. ProgressBar with ForEach

Delphi.Omnithreads.Future – hunting the value in backGroundThread

Delphi. OmniThreads.Async – most simple example

Delphi. UniGUI. Emulation of Pages using Frames

RTTI Atributes

MY PROJECTS

Recent Posts

Categories