skyzoframe[hun]

November 2, 2022

SQL triggers will be the solution. CRUD monitoring in one table, with a timestamp and user ID. ( Create, Read, Update, Delete)

August 24, 2022

//Upload Using Parameters -FMX
var
  Qcon  : TFDConnection;
  Q : TFDQuery;
  mStr : TMemoryStream;
  Mezo : TField;

begin
 Qcon  :=  TfdConnection.Create(Self);
 try
  DBCon(Qcon); // procedure for setting up connection details. 
  Q :=  TfdQuery.Create(Self);
  try
   Q.Connection := QCon;
   try
    Q.SQL.Text  :=  'select max(id) as Maxid from MGR_BLOB'; // Get max ID
	Q.Open;
	try
	 Mezo := Q.FieldByName('Maxid');
	 if Mezo.IsNull
	 then  MGR_BLOB_ID :=  0
	 else  MGR_BLOB_ID :=  Mezo.AsInteger+1;
    finally
     Q.Close;
    end;
   finally       
    Q.Params.Clear;
   
    Q.Params.Add.Name := 'ID'; 
    Q.Params.Add.Name := 'BLOB01_KEY';
    Q.Params.Add.Name := 'BLOB01';

    Q.ParamByName('ID').AsInteger := MGR_BLOB_ID;
    Q.ParamByName('BLOB01_KEY').AsBoolean := Boolean(1);

    mStr := TMemoryStream.Create;
    try
     mStr.LoadFromFile(ZipPath);
	 Q.ParamByName('BLOB01').LoadFromStream(mStr,ftBlob);
    
     Q.SQL.Text  :=  ('insert into MGR_BLOB (BLOB01,'+sLineBreak
						+'BLOB01_KEY,'+sLineBreak                       
	 					+'ID)'+sLineBreak
					+'values'+sLineBReak
						+'(:BLOB01,'+sLineBreak
						+':BLOB01_KEY,'+sLineBreak
						+':ID)');
    finally
	 mStr.DisposeOf;
    end;
   finally
    Q.ExecSQL;		
   end;
  finally    
   Q.DisposeOf;
  end;
 finally
  Qcon.DisposeOf;
 end;
end;

August 9, 2022

I'm interested in all options because I don't know what the best solution would be.

hm... I stay in the database table. I will use the unique ID of the database in negative ranges and make a copy of the row there. Before the line changes.

Also, I need a column to store the unique ID of the changed row. (which was in the positive range)
Also, I need a column that contains the user ID. because after logging out I need to delete the rows stored in the negative range.

Maybe I can solve the log with two triggers.

I don't know how it will work.

I will share the final result here.

August 8, 2022

1 hour ago, Der schöne Günther said:

The Command Design Pattern (sourcemaking.com) is generally used for undo/redo operations.

Thanks for the information. I will buy the book!

August 8, 2022

Hello, I need advice from all of you. I know I am not the only one who has got these problems. Maybe someone has already solved it.

1.-How to handle undo and redo in code?

2.-What are the best strategies for handling it in the relational databases (InterBase and Firebird)?

best wishes, k.z.

October 13, 2021

Hi, I have almost the same question. How to get ListView item width and height in runtime?

Create bitmap on fly.: check WorkStation00.rar

September 14, 2021

I think everything goes wrong, when you want to use "ListView1.SearchVisible :=True" properities.

ListView indexes are then unusable.

If the ListView Index must be the same as the database index, then I use the tag properties.

item  :=  ListView1.Items.Add;

item.Index := YourDatabaseIndex; //  (After the search, it will be changed!)
item.Tag := YourDatabaseIndex; //integer
// or  item.Objects.FindObjectT<TListItemText>('INDEX').Text := YourDatabaseIndex.ToString;
  
  
  
//and if you search, and wanted the selected item database indexes
  
procedure TForm2.ListView1ItemClickEx(const Sender: TObject; ItemIndex: Integer;
  const LocalClickPos: TPointF; const ItemObject: TListItemDrawable);
begin
  Label1.text := Itemindex.ToString; (After the search, it will be changed!)
  Label2.Text := Listview1.Selected.Tag.ToString;
end;

September 14, 2021

18 hours ago, Henry Olive said:

AFTER INSERT

Change after insert to before insert.

https://docwiki.embarcadero.com/InterBase/2020/en/The_Trigger_Body

September 13, 2021

Here what I use.:

by the way.. I don't know, if it works on iOS. Android was fine for me.

unit ListViewTap;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.ListView.Types,
  FMX.ListView.Appearances, FMX.ListView.Adapters.Base, FMX.ListView,
  FMX.Objects, FMX.TabControl, FireDAC.Stan.Intf, FireDAC.Stan.Option,
  FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def,
  FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.IB,
  FireDAC.Phys.IBDef, FireDAC.FMXUI.Wait, Data.DB, FireDAC.Comp.Client;

type
  TForm1 = class(TForm)
    ListView01: TListView;
    lbError: TLabel;
    sbtExit01 : TSpeedButton;   
    sbtShowAll: TSpeedButton;  

    procedure FormCreate(Sender: TObject);

    procedure FormDestroy(Sender: TObject);


  private
    { Private declarations }
  public

    procedure MainSetup;

    {$IFDEF ANDROID}

    procedure SetupGestures_ListView01;
    procedure Gestures_ListView01(Sender: TObject; const EventInfo: TGestureEventInfo; var Handled: Boolean);

    {$ELSE}
      {$IFDEF MSWINDOWS}

      procedure ListView01Click(Sender: TObject);  

      {$ENDIF}
    {$ENDIF}

  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}
{$R *.LgXhdpiPh.fmx ANDROID}
{$R *.Surface.fmx MSWINDOWS}

//uses SharedGlobals, CRUDL_Work20;


{$region 'FormCreate & FormDestroy'}

procedure TForm1.FormCreate(Sender: TObject);
begin

  MainSetup;

{$IFDEF ANDROID}
  lbError.Text := 'Android';

  ListView01.OnGesture := Self.Gestures_ListView01;
{$ELSE}
  {$IFDEF MSWINDOWS}
    lbError.Text := 'MSWindows';

    ListView01.OnClick :=  Self.ListView01Click;
  {$ENDIF}
{$ENDIF}

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  // do something
end;

procedure TForm1.sbtExit01Click(Sender: TObject);
begin
{$IFDEF ANDROID}
  Application.Terminate;
{$ENDIF}

{$IFDEF MSWINDOWS}
//  mtWarning       -> Warns the user about a potential issue.
//  mtError         -> Informs the user of an error that occurred.
//  mtInformation   -> Provides information to the user.
//  mtConfirmation  -> Ask the user for confirmation.
//	mtCustom        -> None of the above.

  if  MessageDlg('Realy exit?',
        TMsgDlgType.mtConfirmation,
        [TMsgDlgBtn.mbYes,TMsgDlgBtn.mbNo],
        0) = mrYes
  then
  begin
    Application.Terminate;
  end;
{$ENDIF}
end;

procedure TForm1.MainSetup;
begin
  {$IFDEF ANDROID}
  sbtShowAll.TintColor    := TAlphaColors.Aqua;
  {$ENDIF}
  {$IFDEF MSWINDOWS}
  sbtShowAll.IsPressed    := Boolean(1);
  {$ENDIF}
end;


{$region 'Android_Setup'}
{$IFDEF ANDROID}

procedure TForm1.SetupGestures_ListView01;
begin
  ListView01.Touch.InteractiveGestures :=
    [TInteractiveGesture.DoubleTap,  //Similar to a double-click. One of the basic survival rules in ZombieLand.
    //TInteractiveGesture.TwoFingerTap, // The "Two Finger Tap" gesture; requires two fingers.
    //TInteractiveGesture.PressAndTap, // The "Press And Tap" gesture; requires two fingers, one to hold pressed and one to tap.
    TInteractiveGesture.LongTap]; // The "Long Tap" gesture (also known as "Tap and hold", "Long Press" or "Press"); requires just one finger. Elicits a command such as Copy (for a picture), text editing commands or the TMagnifierGlass (for TMemo).
end;

procedure TForm1.Gesture_ListView01(Sender: TObject;
  const EventInfo: TGestureEventInfo; var Handled: Boolean);
begin
  if ListView01.Selected <> nil then
  begin
    case EventInfo.GestureID of
      igiLongTap :
      begin
        lbError.Text := ('Long Tap: ' + ListView01.Selected.Index.ToString);
        //do something
      end;
      igiDoubleTap:
      begin
        lbError.Text := ('Double Tap: ' + ListView01.Selected.Index.ToString);
        //do something
      end;
    end;
  end;
end;

{$ENDIF}
{$endregion}

{$region 'MSWindows_setup'}
{$IFDEF MSWINDOWS}

procedure TForm1.ListView01Click(Sender: TObject);
begin
  lbError.Text := 'Click';
end;


{$ENDIF}
{$endregion}

end.

August 23, 2021

if you have problems with "Thousand Separators", remove it from the string!

if   (ContainsText(sString, ',')) 
 and (ContainsText(sString, '.')) 
then
  begin
  
  if  (fs.ThousandSeparator=',') then sString := StringReplace(sString,',','',[rfReplaceAll, rfIgnoreCase])
  else if (fs.ThousandSeparator='.') then sString := StringReplace(sString,'.','',[rfReplaceAll, rfIgnoreCase]); 

  end;

hm.. it is stupid... if string="1,1546.98" and ThousandSeparator=',' then result="1,154698"

August 23, 2021

function StrToInt00(sString:String; out f : Float32):Boolean;
  var
    fs:TFormatSettings;
begin
  try
    try
      GetLocaleFormatSettings(LOCALE_SYSTEM_DEFAULT, fs);
        // remove space
        if ContainsText(sString, ' ')
        then sString := StringReplace(sString,' ','',[rfReplaceAll, rfIgnoreCase]);      

        if ContainsText(sString, ',') then 
        begin
          if fs.DecimalSeparator='.' 
          then sString :=  StringReplace(sString,',','.',[rfReplaceAll, rfIgnoreCase]);
        end
        else if ContainsText(sString, '.') then 
        begin
          if fs.DecimalSeparator=',' 
          then sString :=  StringReplace(sString,'.',',',[rfReplaceAll, rfIgnoreCase]);
        end; 

    finally
      f :=  StrToFloat(sString);	
      Result := True;
    end;
  except
    Result := False;
  end;
end;

June 28, 2021

41 minutes ago, Stefan Glienke said:

Yeah, writing Boolean(0/1) is really much faster than false/true

nope... i mean change!!

ctrl+c - ctrl+v copy code sample, then change it... ^^

June 28, 2021

On 6/22/2021 at 10:03 PM, Martin Sedgewick said:

Why would you do this?

procedure TForm2.Button2Click(Sender: TObject);
var
  Bool : Boolean;
  Bool01 : Boolean;
begin

  Bool := false;
  Bool01 := Boolean(0);

  Button2.Text:=Bool.ToString+' - '+Bool01.ToString;
end;

// Boolean(0) equivalent False; 
// Boolean(1) equivalent True; 
// the reason is simple.. I am too lazy to change true-to false , write 1-to 0 is much faster.
//

June 20, 2021

hi, one solution from the infinity.

// on login form.
procedure TFormLogin.Log(uiMessage: String);
var
  TimeStamp : TDateTime;
begin
  TimeStamp := Now;
  TMemo_Log.lines.add('--'+DateTimeToStr(TimeStamp)+sLineBreak
                +uiMessage);
end;

// write to file..
procedure TFormLogin.FormDestroy(Sender: TObject);
var
  BOM: WideChar;
  FS: TFileStream;
  WS: WideString;
  I: Integer;
begin
  log(']---[Program Close]---['+sLineBreak
     +'-----------------------------'+sLineBreak
	 +'Server='+f_ip+sLineBreak
	 +'Port='+f_port+sLineBreak
	 +'RoleName='+rolename+sLineBreak
	 +'SharedGlobals.DataBase='+SharedGlobals.DataBase+sLineBreak
	 +'Protocol='+Protocol+sLineBreak
	 +'CharacterSet='+CharacterSet+sLineBreak
	 +'ExtendedMetadata='+ExtendedMetadata+sLineBreak
	 +'-----------------------------'+sLineBreak
	 +'DB name='+LOGONNAME+sLineBreak
	 +'DB password='+LOGONPASSWORD+sLineBreak
	 +'ui name='+LOGINNAME+sLineBreak
	 +'ui password='+LOGINPASSWORD+sLineBreak
	 +'-----------------------------');

  // write out to file!
  FS := TFileStream.Create('.\ini\Log.txt', fmCreate);
  try
    BOM := WideChar($FEFF);
    FS.WriteBuffer(BOM, SizeOf(BOM));
    For I := 0 to  mLog.Lines.Count-1 do
    begin
      WS := WideString( mLog.Lines[I] + sLineBreak);
      FS.WriteBuffer(PWideChar(WS)^, Length(WS) * SizeOf(WideChar));
    end;
  finally
    FS.DisposeOf;
  end;
end;


/// then every time you use Showmessage('fcuk.. it is wrong..');
/// cal FormLogin.Log('nope.. error here.. or something');

{$region 'Business Logic'}

// check every success and failed database talc.. like.:

function TdmWork19.GetMGR_WP(aList: dmTombMGR_WP; out Error: String): Boolean;
var
    fSor  : dmSorMGR_WP;
    Qcon  : TFDConnection;
    Q : TFDQuery;

    calc : Float32;

    n:integer;
begin
  Error := '';

  Qcon  :=  TFDConnection.Create(Self);
  try
    FormLogin.DBCon(QCon);
    Q :=  TFDQuery.Create(Self);
    try
      Q.Connection  :=  Qcon;
      try
        if aList<>nil then
        begin


          Q.SQL.Text  :=  ('select '+sLineBreak
                          +' extract(year from ITEM_DONE) as ForYear, '+sLineBreak
                          +' extract(month from ITEM_DONE) as ForMonth, '+sLineBreak
                          +' extract(day from ITEM_DONE) as ForDay, '+sLineBreak
                          +' Count(ITEM_Z) as db, '+sLineBreak
                          +' sum(ITEM_Z) as fm '+sLineBreak
                          +'from MGR_WP '+sLineBreak
                          +'group by ForDay'+sLineBreak
                          +'order by ForYear desc, ForMonth desc, ForDay desc');



          Q.Open;
          try
            if Q.IsEmpty then
            begin
              Error := Error+'Database empty';
              FormLogin.Log(Error); //here save out
              Result  :=  Boolean(0);

            end
            else
            begin
              aList.Clear;


              n:=0;
              while not Q.Eof do
              begin

                fSor.FORYEAR := Q.FieldByName('FORYEAR').AsInteger;
                fSor.FORMONTH := Q.FieldByName('FORMONTH').AsInteger;
                fSor.FORDAY := Q.FieldByName('FORDAY').AsInteger;

                fSor.DB :=  Q.FieldByName('DB').AsInteger;
                calc:=  Q.FieldByName('FM').AsInteger;
                fSor.FM := trunc(calc/10);



                aList.Add(fSor);
                Q.Next;
                inc(n,1);
              end;
              Error:=Error+sLineBreak+'records number.: '+n.Tostring;
              FormLogin.Log(Error);
              Result  :=  Boolean(1);
            end;
          finally
            Q.Close;
          end;

        end;
      except
        on E : Exception do
        begin
          Error := Error+sLineBreak+'n='+n.Tostring+sLineBreak+('GetMGR_WP'+sLineBreak+'Exception class name =  		'+E.ClassName+SLineBreak+'Exception message = '+E.Message);
          FormLogin.Log(Error);
          Result := Boolean(0);
        end;

      end;
    finally
      Q.DisposeOf;
    end;
  finally
    Qcon.DisposeOf;
  end;
end;



{$endregion}

{$region 'user interface'}

//here check if your user build-up interface object is good or wrong.


procedure TMunkaAllomas_19.GetListView1;
var
  uiError : String;
  item  :   TListViewItem;
  fSor  :  dmSorMGR_WP;
  f : Float32;
  dt : TDateTime;
  DayName : String;

  ev,honap,nap : word;
begin
  if GetData.GetMGR_WP(FdmTombMGR_WP,uiError)=Boolean(1) then
  begin

    ListView1.ApplyStyleLookup;
    ListView1.Items.Clear;
    ListView1.BeginUpdate;
    try
      try
        for fSor in FdmTombMGR_WP do
        begin
          item  :=  ListView1.Items.Add;
          try
            ev := Word(fSor.FORYEAR);
            honap := Word(FSor.ForMonth);
            nap := Word(FSor.ForDay);
          finally
            dt := EncodeDate(ev, honap,nap);  
          end;
          if SharedGlobals.WeekEndCheck(dt,DayName)=Boolean(1) then
          begin
            item.Objects.FindObjectT<TListItemText>('DATUM').Text := DateTimeToStr(DT);
            item.Objects.FindObjectT<TListItemText>('NAP').Text := DayName
          end
          else
          begin
            item.Objects.FindObjectT<TListItemText>('DATUM').Text := DateTimeToStr(DT);
            item.Objects.FindObjectT<TListItemText>('NAP').Text := DayName
          end;
          item.Objects.FindObjectT<TListItemText>('DB').Text := fSor.DB.ToString+' [db] alkatrész.';
          f:= FSor.FM;
          item.Objects.FindObjectT<TListItemText>('FM').Text := Format('%.3f', [(f/1000)])+' [fm] anyag.';
        end;
      finally
        ListView1.EndUpdate;
      end;
    except
      on E : Exception do
      begin
        uiError:=uiError+sLineBreak+('ListView1'+sLineBreak+'Exception class name = '+E.ClassName+SLineBreak+'Exception message = '+E.Message);
        FormLogin.Log(uiError);
      end;
    end;
  end
  else ShowMessage(uiError);
end;


{$endregion}

June 14, 2021

On 5/13/2021 at 7:58 PM, Remy Lebeau said:

https://en.wikipedia.org/wiki/ISO/IEC_8859-1

there are 65 undefined characters

Extended version.: https://en.wikipedia.org/wiki/ISO/IEC_8859-2

Here "ő" and "ű" aren't missing.

June 14, 2021

Mistake here.:

procedure TForm2.FormDestroy(Sender: TObject);
Var
  rec :  dmRecord;
begin
  try
    for rec in FArray do
    begin
      if rec.mStr_Flag=Boolean(1)
      then  rec.mStr.DisposeOf;
    end;
  finally
    //FArray.Clear;
    FArray.DisposeOf; // missing line
  end;
end;

OR

procedure TForm2.FormDestroy(Sender: TObject);
begin
  try
    GetData.dmArray_CLEAR(FArray);
  finally
    FArray.DisposeOf;
  end;
end;

June 1, 2021

Maybe create a TMemo and save here every log information. And before the program closed, save it out to file.

  {$IFDEF MSWINDOWS}



procedure Form1.Log(uiMessage: String);
var
  TimeStamp : TDateTime;
begin
  TimeStamp := Now;
  Memo1.lines.add('--'+DateTimeToStr(TimeStamp)+sLineBreak
                 +uiMessage);
end;

procedure Form1.FormDestroy(Sender: TObject);
var
  BOM: WideChar;
  FS: TFileStream;
  WS: WideString;
  I: Integer;
begin
  FS := TFileStream.Create('.\ini\Log.txt', fmCreate);
  try
    BOM := WideChar($FEFF);
    FS.WriteBuffer(BOM, SizeOf(BOM));
    For I := 0 to  Memo1.Lines.Count-1 do
    begin
      WS := WideString( Memo1.Lines[I] + sLineBreak);
      FS.WriteBuffer(PWideChar(WS)^, Length(WS) * SizeOf(WideChar));
    end;
  finally
    FS.DisposeOf;
  end;
end;

  {$ENDIF}

How to do it on Android?

May 31, 2021

Hi,
I need examples for error handling strategies. Does anyone have any advice?

(Log every success and failed procedure or function.)

May 30, 2021

On 5/28/2021 at 4:23 PM, skyzoframe[hun] said:

I need to stay in Listview-objects!

Almost done.. but slow when I use 500 record..

Solution.:

WorkStation00.rar

WorkStation00.7z

Check here the rar file. In data module you can see, how to build up in runtime the query for data source usage. Here usually I use synchronized threads. In user interface I handle every data sources in dynamic arrays. You all right, I don't use livebindings and live database connections. Live bindings for me is like "tying hands".

May 29, 2021

Or,

  y :=  5;
  //x :=  200;
  x := trunc(Listview1.Width-50);

and it will be responsive for window resize.:

Problem step.:

5.- By the way. Is there another method to get object width, in runtime?

"TAppearanceListViewItem(ListView1.Items.Add).Objects.FindObjectT<TListItemImage>('IMAGE').Width"

May 29, 2021

One solution from the infinite .:

->

WorkStation00.zip

May 29, 2021

WorkStation00.zip

May 29, 2021

Thanks for all the replies.

Problem step.:

-4. How to move the image, behind the selection?

Alternative solution.:

The image still in front of the selection blue.

May 28, 2021

I need to stay in Listview-objects!

Almost done.. but slow when I use 500 record..

Solution.:

WorkStation00.rar

WorkStation00.7z

May 28, 2021

hi,

Problem.:

1.- ListView using with DynamiAppearance,

image.png.f4a602978806aab11a6230e9df28c608.png

using only these kinds of objects.:

2.- I have to create a progress bar in runtime. I want to create/draw a bitmap in runtime.

3.- How to draw a rectangle, and fill it with color.

-input data.: 25

-output.: Some bitmap with two rectangle

-bitmap Height 10 Width 100 all the time!

kind regards kz.

Sign In

skyzoframe[hun]

Content Count

Joined

Last visited

Content Type

Profiles

Forums

Calendar

Posts posted by skyzoframe[hun]

Count requests in different intervals

Write image to database

The best way to handle undo and redo.

The best way to handle undo and redo.

The best way to handle undo and redo.

Create a bitmap of selected control?

TListView OnItemClick problems

Interbase Trigger

TListView OnItemClick problems

StrToFloat () all combinations of decimal separator and lang. settings

StrToFloat () all combinations of decimal separator and lang. settings

How to handle delphi exception elegantly with logging feature.

How to handle delphi exception elegantly with logging feature.

How to handle delphi exception elegantly with logging feature.

Binary data in String?

FMX TListView with dynamicappearance. Create progress bar as bitmap.

FMX Error handling. Save out in log file, every success and failed function or procedure.

FMX Error handling. Save out in log file, every success and failed function or procedure.

FMX TListView with dynamicappearance. Create progress bar as bitmap.

FMX TListView with dynamicappearance. Create progress bar as bitmap.

FMX TListView with dynamicappearance. Create progress bar as bitmap.

FMX TListView with dynamicappearance. Create progress bar as bitmap.

FMX TListView with dynamicappearance. Create progress bar as bitmap.

FMX TListView with dynamicappearance. Create progress bar as bitmap.

FMX TListView with dynamicappearance. Create progress bar as bitmap.

Browse

Activity