Delphi Archivi - Synaptica srl

Xtumble Web Builder 2 for Mac OSX 64bit

per Ivan Revelli
in Articoli, Delphi, Software, Xtumble
on Maggio 27, 2021

0

Xtumble Web Builder 2 è lo strumento base con cui personalizzaziamo tutta l’esperienza WEB delle applicazioni realizzate sulla nuovissima piattaforma cloud business Xtumble e con cui abbiamo realizzato gli e-commerce visibili su xtumble.store . Per permettere agli sviluppatori / designer / web developer di poter personalizzare le applicazioni pubblicate sulla piattaforma Xtumble abbiamo deciso di…
Leggi tutto

Delphi macOSX create and deploy application outside Mac App Store

per Ivan Revelli
in Delphi
on Maggio 27, 2021

0

With Delphi you can create your own applications for Mac OSX 64Bit and distribute them both via the Mac App Store and independently using the Developer ID distribution method. In this article we will see how to distribute an app through the “Notarization” procedure of the app to be able to distribute it independently, even…
Leggi tutto

smartFB nuova versione

per Ivan Revelli
in Articoli, databases, Delphi, Firebird SQL
on Maggio 25, 2021

0

Una nuova versione di smartFB, il tool rapido di gestione database Firebird e Interbase. Nuove features: Migliorata usabilità e piccoli ritocchi grafici Migliorata la gestione della creazione di database embedded Integrazione con libreria Xtumble4Delphi per la gestione da JSON a Delphi Record Iniziata implementazione di un tool che permetta di esportare/importare i dataset nei formati…
Leggi tutto

Delphi VCL highlights word in visual components programmatically

per Ivan Revelli
in Articoli, Delphi
on Maggio 1, 2021

0

Highlights word in a RichView component programmatically:

uses Winapi.RichEdit;

procedure SetTextColor(oRichEdit : TRichEdit; sText : String; rAttributes : TTextAttributes);
var
          iPos : Integer;
          iLen : Integer;

          Format: CHARFORMAT2;
begin
          FillChar(Format, SizeOf(Format), 0);
          Format.cbSize := SizeOf(Format);
          Format.dwMask := CFM_BACKCOLOR;
          Format.crBackColor := rAttributes.BackColor;

          iPos := 0;
          iLen := Length(oRichEdit.Lines.Text) ;
          iPos := oRichEdit.FindText(sText, iPos, iLen, []);

          while iPos > -1 do begin
                oRichEdit.SelStart  := iPos;
                oRichEdit.SelLength := Length(sText) ;
                oRichEdit.SelAttributes.Color := rAttributes.Font.Color;
                oRichEdit.SelAttributes.Size  := rAttributes.Font.Size;
                oRichEdit.SelAttributes.Style := rAttributes.Font.Style;
                oRichEdit.SelAttributes.Name  := rAttributes.Font.Name;

                oRichEdit.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format));

                iPos := oRichEdit.FindText(sText,iPos + Length(sText),iLen, []) ;
          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

uses Winapi.RichEdit;

procedure SetTextColor(oRichEdit : TRichEdit; sText : String; rAttributes : TTextAttributes);

var

iPos : Integer;

iLen : Integer;

Format: CHARFORMAT2;

begin

FillChar(Format, SizeOf(Format), 0);

Format.cbSize := SizeOf(Format);

Format.dwMask := CFM_BACKCOLOR;

Format.crBackColor := rAttributes.BackColor;

iPos := 0;

iLen := Length(oRichEdit.Lines.Text) ;

iPos := oRichEdit.FindText(sText, iPos, iLen, []);

while iPos > -1 do begin

oRichEdit.SelStart := iPos;

oRichEdit.SelLength := Length(sText) ;

oRichEdit.SelAttributes.Color := rAttributes.Font.Color;

oRichEdit.SelAttributes.Size := rAttributes.Font.Size;

oRichEdit.SelAttributes.Style := rAttributes.Font.Style;

oRichEdit.SelAttributes.Name := rAttributes.Font.Name;

oRichEdit.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format));

iPos := oRichEdit.FindText(sText,iPos + Length(sText),iLen, []) ;

end;

How to highlitgh full cell in a DBGrid:

procedure TfrmRuleCreator.DBGrid1DrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
  mstr: String;
  I : Integer;
  currValue: string;
begin
  currValue := Column.Field.AsString.ToUpper().Trim;
  if (Length(currValue) > 3)and(Column.Field.FieldName.ToUpper <> 'NOTE') then
  Begin
    If FDMemTable1.FieldByName('NOTE').AsString.ToUpper.IndexOf(currValue) <> -1
    then
    Begin
      DBGrid1.Canvas.Brush.Color := clYellow;
    End
  End;

  if Column.Field.FieldName.ToUpper = 'NOTE' then
   DBGrid1.Canvas.Brush.Color := $00D7FFD7;


  DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

procedure TfrmRuleCreator.DBGrid1DrawColumnCell(Sender: TObject;

const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);

var

mstr: String;

I : Integer;

currValue: string;

begin

currValue := Column.Field.AsString.ToUpper().Trim;

if (Length(currValue) > 3)and(Column.Field.FieldName.ToUpper <> 'NOTE') then

Begin

If FDMemTable1.FieldByName('NOTE').AsString.ToUpper.IndexOf(currValue) <> -1

then

Begin

DBGrid1.Canvas.Brush.Color := clYellow;

End

End;

if Column.Field.FieldName.ToUpper = 'NOTE' then

DBGrid1.Canvas.Brush.Color := $00D7FFD7;

DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);

end;

Delphi FMXLinux – Create Launcher Icon

per Ivan Revelli
in Articoli, Delphi
on Novembre 26, 2020

0

Con FMXLinux e le ultime versioni di Delphi è molto semplice realizzare un’applicazione Linux. L’oggetto di questo post è creare un’icona sul desktop e tra i preferiti per rendere lanciabile la vostra applicazione dal desktop di gnome. Nel mio caso ho realizzato un’applicazione POS (Point of Sale) demominata XtumbleRetail e devo creare l’applicazione launcher della…
Leggi tutto

TCriticalSection Threrad Example Delphi

per Ivan Revelli
in Articoli, Delphi
on Maggio 15, 2020

0

TThreadedMsgEvent = class( TThread )
    private
          FLock : TCriticalSection;
          FStr : TQueue<String>;
          FMemo : TMemo;
          function GetEvent : String;
    protected
          procedure Execute; override;
    public
          procedure AddEvent( aMsg : String );

          constructor Create( AMemo: TMemo );
          destructor Destroy; override;
    end;
implementation

{ TThreadedMsgEvent }

procedure TThreadedMsgEvent.AddEvent(aMsg: String);
begin
     FLock.Acquire;
     FStr.Enqueue( FormatDateTime('DD/MM/YY HH:NN:SS.ZZZ',Now)+ ' : '+ aMsg );
     FLock.Release;
end;

constructor TThreadedMsgEvent.Create(aMemo: TMemo);
begin
  inherited Create(True);

  FreeOnTerminate := False;
  FOnMessage := ACallBack;
  FStr := TQueue<String>.Create();
  FLock      := TCriticalSection.Create;
  FMemo := aMemo;
  Resume;
end;

destructor  TThreadedMsgEvent.Destroy; override;
begin
      FreeAndNil( FStr );
      FreeAndNil( FLock );
end;

procedure TThreadedMsgEvent.Execute;
begin
  while not Terminated do
  begin

      try
         if (FStr.Count > 0) then
         begin
              if Assigned( aMemo ) then
              begin
                    TThread.synchronize( procedure
                                         begin
                                            FMemo.Lines.Add( GetEvent );    
                                         end; );
              end;

         end;
      except
      end;
      TThread.Sleep(1);
  end;

end;

function TThreadedMsgEvent.GetEvent: String;
begin
     FLock.Acquire;
     result := FStr.Dequeue;
     FLock.Release;
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

TThreadedMsgEvent = class( TThread )

private

FLock : TCriticalSection;

FStr : TQueue<String>;

FMemo : TMemo;

function GetEvent : String;

protected

procedure Execute; override;

public

procedure AddEvent( aMsg : String );

constructor Create( AMemo: TMemo );

destructor Destroy; override;

end;

implementation

{ TThreadedMsgEvent }

procedure TThreadedMsgEvent.AddEvent(aMsg: String);

begin

FLock.Acquire;

FStr.Enqueue( FormatDateTime('DD/MM/YY HH:NN:SS.ZZZ',Now)+ ' : '+ aMsg );

FLock.Release;

end;

constructor TThreadedMsgEvent.Create(aMemo: TMemo);

begin

inherited Create(True);

FreeOnTerminate := False;

FOnMessage := ACallBack;

FStr := TQueue<String>.Create();

FLock := TCriticalSection.Create;

FMemo := aMemo;

Resume;

end;

destructor TThreadedMsgEvent.Destroy; override;

begin

FreeAndNil( FStr );

FreeAndNil( FLock );

end;

procedure TThreadedMsgEvent.Execute;

begin

while not Terminated do

begin

try

if (FStr.Count > 0) then

begin

if Assigned( aMemo ) then

begin

TThread.synchronize( procedure

begin

FMemo.Lines.Add( GetEvent );

end; );

end;

except

end;

TThread.Sleep(1);

end;

function TThreadedMsgEvent.GetEvent: String;

begin

FLock.Acquire;

result := FStr.Dequeue;

FLock.Release;

end;

From post found at: https://stackoverflow.com/questions/17506615/how-to-handle-log-in-a-threaded-manner-in-delphi

Categoria: Delphi

Xtumble Web Builder 2 for Mac OSX 64bit

Delphi macOSX create and deploy application outside Mac App Store

smartFB nuova versione

Delphi VCL highlights word in visual components programmatically

Delphi FMXLinux – Create Launcher Icon

TCriticalSection Threrad Example Delphi

Ricerca Articolo

Categorie