Discussion :

[Cazaux-Moutou-Philippe]

Bonjour

quel composant de type mémo avec acces à la bdd utiliser pour mettre du texte mis en forme avec couleur, gras etc.., et possibilité de lien url cliquable

e quel type de colonne dans la bbd Firebird ??

merci

[Gilbert Geyer]

Salut,

composant de type mémo avec acces à la bdd utiliser pour mettre du texte mis en forme avec couleur, gras etc..,

... impossible. Le TMemo c'est limité à du texte monochrome.
... pour du texte mis en forme et polychrome il faut du TRichEdit.

A+

[Cazaux-Moutou-Philippe]

TRichEdit

Oui je l ai aussi mis, mais je ne peux pas y mettre d url cliquable

n'y a t il pas de compos pour D7, qui inclurai aussi une toolbar avec les possibilités (gras etc..)

j avais vu un compo comme ca mais impossible de le retrouver

[Gilbert Geyer]

Re-Salut,

En utilisant un TRichEdit il est possible :

1) D'utiliser son onMouseMove pour détecter si la SubStringMotSousCurseurDeLaSouris commence par 'http:' et dans ce cas tu récupères ce nom sinon tu fais SubStringMotSousCurseurDeLaSouris:='';
(tu peux en profiter pour changer sa couleur au passage de la souris mais ça c'est des fioritures).

2) Ensuite tu peux utiliser le onMouseDown du RichEdit pour utiliser le lien :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
begin
   ShellExecute(Handle,'OPEN', PChar(SubStringMotSousCurseurDeLaSouris),
                       Nil,Nil,SW_SHOW);
end;

... pour ShellExecute ajouter ShellApi dans le uses.

A+

[Gilbert Geyer]

Re-Salut,

Je viens de retrouver l'appli dans laquelle j'avais fait ça avec un RichEdit mais un peu différemment (tout se passe dans le MouseDown) voiçi le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Const coulLienDef = clNavy; coulLienVu = clTeal;
 
function IndexCarSouris(UnEdit: TCustomEdit; ClientPos: TPoint): Integer;
// Renvoie l''Index absolu du caractère le plus proche d'un point en coordonnées écran d'un TRichEdit, TEdit, ou TMemo
var      lParam: Integer;
begin    if UnEdit is TRichEdit then
         begin lParam:= Integer(@ClientPos);
               result:= UnEdit.Perform(EM_CHARFROMPOS, 0, lParam);
         end else
         begin lParam:= ClientPos.Y shl 16 + ClientPos.X;
               result:= LoWord(UnEdit.Perform(EM_CHARFROMPOS, 0, lParam)); //index caractère
               //result:= HiWord(UnEdit.Perform(EM_CHARFROMPOS, 0, lParam)); //index ligne
         end;
end;
 
function MotSousMouse(UnEdit: TCustomEdit; ClientPos: TPoint; var icd,ics,icf : integer): string;
var      lg : integer; //icd,ics,icf : indexes car deb,souris,fin
begin    ics:=IndexCarSouris(UnEdit,ClientPos);
         icd:=ics+1; icf:=ics-1; lg:=length(UnEdit.Text);
         repeat dec(icd);
         until (icd=1) or (UnEdit.Text[icd] in [' ',#09,#10,#13]);
         repeat inc(icf);
         until (icf=lg) or (UnEdit.Text[icf] in [' ',#09,#10,#13]);
         if UnEdit.Text[icd] in [' ',#09,#10,#13] then inc(icd);
         if UnEdit.Text[icf] in [' ',#09,#10,#13] then dec(icf);
         Result:=copy(UnEdit.text,icd,icf-icd+1)
end;
 
procedure TfrmGen.redGenMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var       lienUrl : string; ics,icd,icf : integer; clPrec : tColor;
begin     if (ssCtrl in Shift) and (Button=mbLeft) then // Simulation lien hypertexte
          begin  lienUrl:=MotSousMouse(redGen, Point(X, Y),icd,ics,icf);
                if pos('http',lienUrl)>0 then
                begin with redGen do // Marquage
                      begin SelStart:=icd-1; SelLength:=icf-icd+1;
                            clPrec:=SelAttributes.Color;
                            SelAttributes.Color:=coulLienVu;
                            SelLength:=0; SelStart:=ics;
                            SelAttributes.Color:=clPrec;
                            upDate;
                      end;
                      ShellExecute(Handle,'OPEN',PChar(lienUrl),Nil,Nil,SW_SHOW);
                end;
          end;
end; // TfrmGen.redGenMouseDown

... suffit de remplacer dans ce code redGen par le nom de ton RichEdit : par ex : RichEdit1.
... la combinaison Appui touche Ctrl + Appui-Bouton-Souris-Gauche lance le lien.

A+

[Gilbert Geyer]

Bonjour,

Tant qu'à faire j'ai transformé le code de mon post précédent en composant dérivé du TRichEdit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
unit cRichEditUrl;
 
// *****************************************************************************
// Composant TRichEditUrl dérivé du TRichEdit de façon à identifier un lien
// hypertexte activable par combinaison touche Ctrl + Appui-bouton-Souris-Gauche
// *****************************************************************************
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  StdCtrls, ComCtrls, ShellApi;
 
type TRichEditUrl = class(TRichEdit)
  private
    FColorLienActivable : TColor; // couleur prise par le lien hypertexte au passage de la souris
    FColorLienVu        : TColor; // couleur du lien après activation 
    procedure SetColorLienActivable(Value : TColor);
    procedure SetColorLienVu(Value : TColor);
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  published
    property ColorLienActivable : TColor read FColorLienActivable write SetColorLienActivable;
    property ColorLienVu : TColor read FColorLienVu write SetColorLienVu;
end;
 
procedure Register;
 
implementation
 
procedure Register;
begin     RegisterComponents('Ajouts', [TRichEditUrl]);
end;
 
constructor TRichEditUrl.Create(AOwner: TComponent);
begin       inherited Create(AOwner);
            FColorLienActivable := clRed;
            FColorLienVu        := clTeal;
end;
 
destructor  TRichEditUrl.Destroy;
begin       inherited Destroy;
end;
 
function IndexCarSouris(UnEdit: TCustomEdit; ClientPos: TPoint): Integer;
// Renvoie Index absolu du caractère le plus proche d'un point en coordonnées
// écran d'un TRichEdit, TEdit, ou TMemo
var      lParam: Integer;
begin    if UnEdit is TRichEdit then
         begin lParam:= Integer(@ClientPos);
               result:= UnEdit.Perform(EM_CHARFROMPOS, 0, lParam);
         end else
         begin lParam:= ClientPos.Y shl 16 + ClientPos.X;
               result:= LoWord(UnEdit.Perform(EM_CHARFROMPOS, 0, lParam)); //index caractère
               //result:= HiWord(UnEdit.Perform(EM_CHARFROMPOS, 0, lParam)); //index ligne
         end;
end;
 
function MotSousMouse(UnEdit: TCustomEdit; ClientPos: TPoint; var icd,ics,icf : integer): string;
// Result = Mot sous curseur souris en position ClientPos
// var icd,ics,icf : Indexes des car deb,souris,et fin
var      lg : integer; 
begin    ics:=IndexCarSouris(UnEdit,ClientPos);
         icd:=ics+1; icf:=ics-1; lg:=length(UnEdit.Text);
         if lg=0 then begin Result:=''; EXIT; end; //< Ligne ajoutée le 5 mars 2009
         repeat dec(icd);
         until (icd=1) or (UnEdit.Text[icd] in [' ',#09,#10,#13]);
         repeat inc(icf);
         until (icf=lg) or (UnEdit.Text[icf] in [' ',#09,#10,#13]);
         if UnEdit.Text[icd] in [' ',#09,#10,#13] then inc(icd);
         if UnEdit.Text[icf] in [' ',#09,#10,#13] then dec(icf);
         Result:=copy(UnEdit.text,icd,icf-icd+1)
end;
 
procedure TRichEditUrl.SetColorLienActivable(Value : TColor);
begin     FColorLienActivable :=Value;
end;
 
procedure TRichEditUrl.SetColorLienVu(Value : TColor);
begin     FColorLienVu :=Value;
end;
 
procedure TRichEditUrl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var       lienUrl : string; ics,icd,icf : integer; clPrec : tColor;
begin     if (ssCtrl in Shift) and (Button=mbLeft) then // Activation du lien hypertexte
          begin lienUrl:=MotSousMouse(Self, Point(X, Y),icd,ics,icf);
                if pos('http',lienUrl)>0 then
                begin with Self do // Marquage comme Vu
                      begin SelStart:=icd-1; SelLength:=icf-icd+1;
                            clPrec:=SelAttributes.Color;
                            SelAttributes.Color:=ColorLienVu;
                            SelLength:=0; SelStart:=ics;
                            SelAttributes.Color:=clPrec;
                            upDate;
                      end;
                      ShellExecute(Handle,'OPEN',PChar(lienUrl),Nil,Nil,SW_SHOW);
                end;
          end;
end; // TRichEditUrl.MouseDown
 
procedure TRichEditUrl.MouseMove(Shift: TShiftState; X,Y: Integer);
var       lienUrl : string; ics,icd,icf : integer; clPrec : tColor;
begin     lienUrl:=MotSousMouse(Self, Point(X, Y),icd,ics,icf);
          if (pos('http',lienUrl)>0) then
          begin with Self do // Marquage comme activable
                begin SelStart:=icd-1; SelLength:=icf-icd+1;
                      clPrec:=SelAttributes.Color;
                      if (clPrec<>ColorLienActivable) and (clPrec<>ColorLienVu) then
                      begin SelAttributes.Color:=ColorLienActivable;
                            upDate;
                      end;
                      SelLength:=0; SelStart:=ics;
                end;
          end;
end; // TRichEditUrl.MouseMove
 
END. //=========================================================================

... reste plus qu'à créer le fichier .dcr avec l'Editeur d'images de Delphi et installer le composant.

A+

EDIT du 5 mars 2009 : Ajoué une ligne de code dans la function MotSousMouse suite à la remarque de Lung