Category Archives: Delphi

Delphi. System.ZIP Simple Examples

Posted on 20.10.2017 by Stanislav_Panteleev

example from project… zip file

  //packing in zip
  z := TZipFile.Create;
  FfilepathZIP := clientTempDir + '\' + TPath.GetRandomFileName + '.zip';
  if (TFile.Exists(FfilepathZIP)) then
    TFile.Delete(FfilepathZIP);
  z.Open(FfilepathZIP, zmWrite);
  try
    z.Add(Ffilepath);
    z.Close();
  finally
    z.Free;
  end;

//packing in zip

z := TZipFile.Create;

FfilepathZIP := clientTempDir + '\' + TPath.GetRandomFileName + '.zip';

if (TFile.Exists(FfilepathZIP)) then

TFile.Delete(FfilepathZIP);

z.Open(FfilepathZIP, zmWrite);

try

z.Add(Ffilepath);

z.Close();

finally

z.Free;

end;

unzip

 // unzip
          z := TZipFile.Create;
          try
            z.Open(filenameZIP, zmRead);
            if not TDirectory.Exists(clientTempDir) then
              TDirectory.CreateDirectory(clientTempDir);
            for i := 0 to z.FileCount - 1 do
            begin
              filename := z.FileName[i]; // having only one file in archive
              z.Extract(filename, clientTempDir, true);
            end;
          finally
            z.Free;
          end;

// unzip

z := TZipFile.Create;

try

z.Open(filenameZIP, zmRead);

if not TDirectory.Exists(clientTempDir) then

TDirectory.CreateDirectory(clientTempDir);

for i := 0 to z.FileCount - 1 do

begin

filename := z.FileName[i]; // having only one file in archive

z.Extract(filename, clientTempDir, true);

end;

finally

z.Free;

end;

more info

Posted in Delphi | Comments Off

Delphi.FastReport. Batch and unbatch reports. Buggy way on concat

Posted on 19.10.2017 by Stanislav_Panteleev

Although in docs there is a sample of concating reports – it is a buggy way for some reasons… Problem 1 i’ve already posted that function that concat reports but it well concats dynamically generated reports, if one of them … Continue reading →

Posted in Delphi | Comments Off

Delphi. FireDAC. BLOB

Posted on 19.10.2017 by Stanislav_Panteleev

Example from project shows writing in parent table and blob table

  try
    //save in blob or on http server
    q := TFDQuery.Create(nil);
    q1 := TFDQuery.Create(nil);
    try
      { // saving to blob, but foung bug - not loaded correctly - no data from datasets...
      with q do
      begin
        Connection := MainModule.FDConnection;
        //-----------insert in generatedReports-------------
        SQL.Text := 'INSERT INTO `coffeetest_db`.`generatedreports` (`name`, `users_id`, `generatedReportsType_id` ) ' + ' VALUES (:name, :users_id, (SELECT id FROM coffeetest_db.generatedreportstype limit 1,1));';
        params.ParamValues['name'] := FeventsName;
        params.ParamValues['users_id'] := MainModule.UsersID;
        ExecSQL();
        generatedReports_id := MainModule.getLastInsertID();
      end;
      with q1 do
      begin
        filesize := GetFileSize(filename);
        Connection := MainModule.FDConnection;
        //-----------isnert in generatedReportsBlob-----------
        SQL.Text := 'INSERT INTO `coffeetest_db`.`generatedreportsblob` (`generatedReports_id`,`blob`,`blobsize` ) ' + ' VALUES (:generatedReports_id,:blob,:blobsize);';
        params.ParamValues['generatedReports_id'] := generatedReports_id;
        Params[1].DataType := ftBlob;
        Params[1].AsStream := TFileStream.Create(filename, fmOpenRead);
        Params.ParamValues['blobsize'] := filesize;
        ExecSQL();
      end;
     }
    finally
      q.Free();
      q1.Free();
    end;
//  finally
    //if TFile.Exists(filename) then
    //  TFIle.Delete(filename);
//  end;

try

//save in blob or on http server

q := TFDQuery.Create(nil);

q1 := TFDQuery.Create(nil);

try

{ // saving to blob, but foung bug - not loaded correctly - no data from datasets...

with q do

begin

Connection := MainModule.FDConnection;

//-----------insert in generatedReports-------------

SQL.Text := 'INSERT INTO `coffeetest_db`.`generatedreports` (`name`, `users_id`, `generatedReportsType_id` ) ' + ' VALUES (:name, :users_id, (SELECT id FROM coffeetest_db.generatedreportstype limit 1,1));';

params.ParamValues['name'] := FeventsName;

params.ParamValues['users_id'] := MainModule.UsersID;

ExecSQL();

generatedReports_id := MainModule.getLastInsertID();

end;

with q1 do

begin

filesize := GetFileSize(filename);

Connection := MainModule.FDConnection;

//-----------isnert in generatedReportsBlob-----------

SQL.Text := 'INSERT INTO `coffeetest_db`.`generatedreportsblob` (`generatedReports_id`,`blob`,`blobsize` ) ' + ' VALUES (:generatedReports_id,:blob,:blobsize);';

params.ParamValues['generatedReports_id'] := generatedReports_id;

Params[1].DataType := ftBlob;

Params[1].AsStream := TFileStream.Create(filename, fmOpenRead);

Params.ParamValues['blobsize'] := filesize;

ExecSQL();

end;

}

finally

q.Free();

q1.Free();

end;

// finally

//if TFile.Exists(filename) then

// TFIle.Delete(filename);

// end;

Theory from Embarcadero site Embarcadero The BLOB streaming technique implements BLOB parameter values streaming to / from a database. This allows to transfer a BLOB value “by reference” in contrast … Continue reading →

Posted in Delphi | Comments Off

Delphi. FireDAC. FastReport. MasterDetail. Example from project

Posted on 19.10.2017 by Stanislav_Panteleev

qSelectEventUsers – 1st query Note: we use UsersID, eventsID as field alias

SELECT 
distinct(u.id) as usersID, /* <<<<*/
u.name,
u.family,
u.patronymic, 
(select concat(u.family,' ',LEFT(u.name, 1),'.',LEFT(u.patronymic, 1)  ) ) as usersShortName,
uheht.events_id as eventsID /* <<<<*/
FROM coffeetest_db.users_has_events_has_tests uheht, users u
where uheht.users_id=u.id and uheht.events_id=:events_id

SELECT

distinct(u.id) as usersID, /* <<<<*/

u.name,

u.family,

u.patronymic,

(select concat(u.family,' ',LEFT(u.name, 1),'.',LEFT(u.patronymic, 1) ) ) as usersShortName,

uheht.events_id as eventsID /* <<<<*/

FROM coffeetest_db.users_has_events_has_tests uheht, users u

where uheht.users_id=u.id and uheht.events_id=:events_id

setup DataSource

DS_EventUsers.DataSet:=qSelectEventUsers

1	DS_EventUsers.DataSet:=qSelectEventUsers

qSelectEventUsersElements – 2d query Note: we use UsersID, eventsID as param

SELECT t.name as testsName,s.name as statusName, uheht.users_id as usersID  
FROM coffeetest_db.users_has_events_has_tests uheht, status s, tests t
where uheht.status_id=s.id and uheht.tests_id=t.id and events_id=:eventsID and uheht.users_id=:usersID order by t.name

SELECT t.name as testsName,s.name as statusName, uheht.users_id as usersID

FROM coffeetest_db.users_has_events_has_tests uheht, status s, tests t

where uheht.status_id=s.id and uheht.tests_id=t.id and events_id=:eventsID and uheht.users_id=:usersID order by t.name

setup 2-d query

qSelectEventUsersElements.MasterSource:=DS_EventUsers

qSelectEventUsersElements.MasterFields:=[UsersID;eventsID]

qSelectEventUsersElements.MasterSource:=DS_EventUsers

qSelectEventUsersElements.MasterFields:=[UsersID;eventsID]

setup FastReport components frxDBDataset_qSelectEventUsers DataSet:=DS_EventUsers UserName:=frxDBDataset_qSelectEventUsers frxDBDataset_qEventUserElements DataSet:=qSelectEventUsersElements … Continue reading →

Posted in Delphi | Comments Off

Delphi. VCL. FastReport. Manual

Posted on 19.10.2017 by Stanislav_Panteleev

https://www.fastreport.ru/public_download/docs/vcl/UserManual-ru.pdf

Posted in Delphi | Comments Off

Delphi. FireDAC. MasterDetail

Posted on 19.10.2017 by Stanislav_Panteleev

Source. Embarcadero To set up a master-detail relationship, this sample uses the Object Inspector to configure the following components at design time as follows: Two TFDQuery objects named qryOrders and qryOrderDetails. These components are used to implement a dataset capable of executing SQL queries. The following setup is … Continue reading →

Posted in Delphi | Comments Off

Delphi. MVC pattern in UniGUI vs traditional coding to form

Posted on 16.10.2017 by Stanislav_Panteleev

My discussion on forum Conclusion – mvc is possible to implement, but not obligatory. Standart delphi structure of dfm and pas is natural to delphi enviroment. Maybe mvc pattern would be better for big projects…

Posted in Delphi, UniGui | Comments Off

Delphi. UniGUI. Calc, just calc

Posted on 16.10.2017 by Stanislav_Panteleev

Wanted to show 2 patterns on calc example, but calc itself has become not simple task… Below version that works correctly but there is things to do…

unit Main;

interface

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

type
  TMainForm = class(TUniForm)
    b8: TUniBitBtn;
    b9: TUniBitBtn;
    b4: TUniBitBtn;
    b5: TUniBitBtn;
    b6: TUniBitBtn;
    bOne: TUniBitBtn;
    b2: TUniBitBtn;
    b3: TUniBitBtn;
    eResult: TUniEdit;
    UniBitBtn10: TUniBitBtn;
    bEqual: TUniBitBtn;
    bDivide: TUniBitBtn;
    bMultiply: TUniBitBtn;
    bMinus: TUniBitBtn;
    bPlus: TUniBitBtn;
    bCE: TUniBitBtn;
    b7: TUniBitBtn;
    unilabel: TUniLabel;
    procedure UniFormCreate(Sender: TObject);
    procedure digitClick(Sender: TObject);
    procedure signClick(Sender: TObject);
    procedure bEqualClick(Sender: TObject);
    procedure bCEClick(Sender: TObject);
  private
    { Private declarations }
    faIsEmpty: Boolean;
    fbIsEmpty: Boolean;
    fcIsEmpty: Boolean;
    fdIsEmpty: Boolean;
    fIsSignClickedBefore: Boolean;
    fIsDigitClicked: Boolean;
    fa, fb, fc: real;
    fd: char;
    foperators: set of Char;
    procedure nullAll;
  public
    { Public declarations }
  end;

function MainForm: TMainForm;

implementation

{$R *.dfm}

uses
  uniGUIVars, MainModule, uniGUIApplication, System.Generics.Collections;

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

procedure TMainForm.bCEClick(Sender: TObject);
begin
  nullAll();
end;

procedure TMainForm.bEqualClick(Sender: TObject);
begin
  case fd of
    '-':
      fc := fa - fb;
    '+':
      fc := fa + fb;
    '*':
      fc := fa * fb;
    '/':
      fc := fa / fb;
  end;
  fa := fc;
  fbIsEmpty := True;
  eResult.Text := FloatToStr(fc);
end;

procedure TMainForm.nullAll;
begin
  fa := 0.00;
  fb := 0.00;
  fc := 0.00;
  unilabel.Caption := '';
  faIsEmpty := true;
  fbIsEmpty := true;
  fcIsEmpty := true;
  fdIsEmpty := true;
  foperators := ['+', '-', '*', '/'];
  unilabel.Caption := '';
  eResult.Text := '';
end;

procedure TMainForm.digitClick(Sender: TObject);
begin
  fIsSignClickedBefore := false;
  fIsDigitClicked := True;
  if faIsEmpty then
  begin
    fa := strToFloat((Sender as TUniBitbtn).Caption);
    faIsEmpty := false;
  end
  else
  begin
    fb := strToFloat((Sender as TUniBitbtn).Caption);
    fbIsEmpty := False;
  end;
  unilabel.Caption := unilabel.Caption + (Sender as TUniBitbtn).Caption;
end;

procedure TMainForm.signClick(Sender: TObject);
var
  s: string;
  lastSymbol:char;
begin
  fdIsEmpty := false;
  if fIsSignClickedBefore then
  begin
    s := unilabel.Caption;
    lastSymbol:=s[Length(s)];
    if ((s[Length(s)] in foperators) and ((lastSymbol <> (Sender as TUniBitbtn).Caption))) then
    begin
      delete(s, length(s), 1);
      fdIsEmpty := true;
      unilabel.Caption := s;
      //fIsSignClickedBefore := false;
    end
    else if (s[Length(s)] = (Sender as TUniBitbtn).Caption) then
      exit;
  end;

  unilabel.Caption := unilabel.Caption + (Sender as TUniBitbtn).Caption;
  s := (Sender as TUniBitBtn).Caption;
  fd := s[Low(s)];
  if fdIsEmpty then
    exit;

  if not fIsDigitClicked and fIsSignClickedBefore then
    exit;

  fIsSignClickedBefore := true;

  if (not faIsEmpty) and (not fbIsEmpty) then
  begin
    case fd of
      '-':
        fc := fa - fb;
      '+':
        fc := fa + fb;
      '*':
        fc := fa * fb;
      '/':
        fc := fa / fb;
    end;
    fa := fc;
    eResult.Text := FloatToStr(fc);
    fIsDigitClicked := false;
  end;
end;

procedure TMainForm.UniFormCreate(Sender: TObject);
begin
  nullAll();
end;


initialization
  RegisterAppFormClass(TMainForm);

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

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

unit Main;

interface

uses

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

Dialogs, uniGUITypes, uniGUIAbstractClasses, uniGUIClasses, uniGUIRegClasses,

uniGUIForm, uniEdit, uniGUIBaseClasses, uniButton, uniBitBtn, uniLabel;

type

TMainForm = class(TUniForm)

b8: TUniBitBtn;

b9: TUniBitBtn;

b4: TUniBitBtn;

b5: TUniBitBtn;

b6: TUniBitBtn;

bOne: TUniBitBtn;

b2: TUniBitBtn;

b3: TUniBitBtn;

eResult: TUniEdit;

UniBitBtn10: TUniBitBtn;

bEqual: TUniBitBtn;

bDivide: TUniBitBtn;

bMultiply: TUniBitBtn;

bMinus: TUniBitBtn;

bPlus: TUniBitBtn;

bCE: TUniBitBtn;

b7: TUniBitBtn;

unilabel: TUniLabel;

procedure UniFormCreate(Sender: TObject);

procedure digitClick(Sender: TObject);

procedure signClick(Sender: TObject);

procedure bEqualClick(Sender: TObject);

procedure bCEClick(Sender: TObject);

private

{ Private declarations }

faIsEmpty: Boolean;

fbIsEmpty: Boolean;

fcIsEmpty: Boolean;

fdIsEmpty: Boolean;

fIsSignClickedBefore: Boolean;

fIsDigitClicked: Boolean;

fa, fb, fc: real;

fd: char;

foperators: set of Char;

procedure nullAll;

public

{ Public declarations }

end;

function MainForm: TMainForm;

implementation

{$R *.dfm}

uses

uniGUIVars, MainModule, uniGUIApplication, System.Generics.Collections;

function MainForm: TMainForm;

begin

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

end;

procedure TMainForm.bCEClick(Sender: TObject);

begin

nullAll();

end;

procedure TMainForm.bEqualClick(Sender: TObject);

begin

case fd of

'-':

fc := fa - fb;

'+':

fc := fa + fb;

'*':

fc := fa * fb;

'/':

fc := fa / fb;

end;

fa := fc;

fbIsEmpty := True;

eResult.Text := FloatToStr(fc);

end;

procedure TMainForm.nullAll;

begin

fa := 0.00;

fb := 0.00;

fc := 0.00;

unilabel.Caption := '';

faIsEmpty := true;

fbIsEmpty := true;

fcIsEmpty := true;

fdIsEmpty := true;

foperators := ['+', '-', '*', '/'];

unilabel.Caption := '';

eResult.Text := '';

end;

procedure TMainForm.digitClick(Sender: TObject);

begin

fIsSignClickedBefore := false;

fIsDigitClicked := True;

if faIsEmpty then

begin

fa := strToFloat((Sender as TUniBitbtn).Caption);

faIsEmpty := false;

end

else

begin

fb := strToFloat((Sender as TUniBitbtn).Caption);

fbIsEmpty := False;

end;

unilabel.Caption := unilabel.Caption + (Sender as TUniBitbtn).Caption;

end;

procedure TMainForm.signClick(Sender: TObject);

var

s: string;

lastSymbol:char;

begin

fdIsEmpty := false;

if fIsSignClickedBefore then

begin

s := unilabel.Caption;

lastSymbol:=s[Length(s)];

if ((s[Length(s)] in foperators) and ((lastSymbol <> (Sender as TUniBitbtn).Caption))) then

begin

delete(s, length(s), 1);

fdIsEmpty := true;

unilabel.Caption := s;

//fIsSignClickedBefore := false;

end

else if (s[Length(s)] = (Sender as TUniBitbtn).Caption) then

exit;

end;

unilabel.Caption := unilabel.Caption + (Sender as TUniBitbtn).Caption;

s := (Sender as TUniBitBtn).Caption;

fd := s[Low(s)];

if fdIsEmpty then

exit;

if not fIsDigitClicked and fIsSignClickedBefore then

exit;

fIsSignClickedBefore := true;

if (not faIsEmpty) and (not fbIsEmpty) then

begin

case fd of

'-':

fc := fa - fb;

'+':

fc := fa + fb;

'*':

fc := fa * fb;

'/':

fc := fa / fb;

end;

fa := fc;

eResult.Text := FloatToStr(fc);

fIsDigitClicked := false;

end;

procedure TMainForm.UniFormCreate(Sender: TObject);

begin

nullAll();

end;

initialization

RegisterAppFormClass(TMainForm);

end.

Posted in Delphi, UniGui | Comments Off

MySQL. function to count ratio. Example from project

Posted on 14.10.2017 by Stanislav_Panteleev

Was needed to count progress of finished / all elements,below is an example how to do this…

CREATE DEFINER=`root`@`localhost` FUNCTION `eventElementProgress`(eventsID integer,testsID integer) RETURNS varchar(45) CHARSET utf8
BEGIN
DECLARE allVar INT; 
DECLARE finishedVar INT;
DECLARE rounded decimal(10,2);
DECLARE r decimal(10,2);
DECLARE progressInChars varchar(45); 

SELECT count(*) FROM coffeetest_db.users_has_events_has_tests where events_id=eventsID 
and tests_id=testsID  into allVar;

SELECT count(*) FROM coffeetest_db.users_has_events_has_tests where events_id=eventsID 
and tests_id=testsID and status_id=(select max(id) from status) into finishedVar;
#select (finishedVar/allVar*100) into r;
#select cast(round((finishedVar/allVar*100),2) as char (50)) into progressInChars ;
select (finishedVar/allVar*100) into r;
select round(r,2) into rounded;
select cast(rounded as char(50)) into progressInChars;
#select round(r,2) into rounded;
#select progressInChars;

RETURN progressInChars;
END

CREATE DEFINER=`root`@`localhost` FUNCTION `eventElementProgress`(eventsID integer,testsID integer) RETURNS varchar(45) CHARSET utf8

BEGIN

DECLARE allVar INT;

DECLARE finishedVar INT;

DECLARE rounded decimal(10,2);

DECLARE r decimal(10,2);

DECLARE progressInChars varchar(45);

SELECT count(*) FROM coffeetest_db.users_has_events_has_tests where events_id=eventsID

and tests_id=testsID into allVar;

SELECT count(*) FROM coffeetest_db.users_has_events_has_tests where events_id=eventsID

and tests_id=testsID and status_id=(select max(id) from status) into finishedVar;

#select (finishedVar/allVar*100) into r;

#select cast(round((finishedVar/allVar*100),2) as char (50)) into progressInChars ;

select (finishedVar/allVar*100) into r;

select round(r,2) into rounded;

select cast(rounded as char(50)) into progressInChars;

#select round(r,2) into rounded;

#select progressInChars;

RETURN progressInChars;

END

Posted in Delphi | Comments Off

Delphi. FireMonkeyStyles

Posted on 14.10.2017 by Stanislav_Panteleev

Posted in Delphi, FireMonkey | Comments Off

Category Archives: Delphi

Delphi. System.ZIP Simple Examples

Delphi.FastReport. Batch and unbatch reports. Buggy way on concat

Delphi. FireDAC. BLOB

Delphi. FireDAC. FastReport. MasterDetail. Example from project

Delphi. VCL. FastReport. Manual

Delphi. FireDAC. MasterDetail

Delphi. MVC pattern in UniGUI vs traditional coding to form

Delphi. UniGUI. Calc, just calc

MySQL. function to count ratio. Example from project

Delphi. FireMonkeyStyles

MY PROJECTS

Recent Posts

Categories