Créer un Zoom sur un Mémo

Version imprimable

26/09/2006, 11h13
freestyler

Créer un Zoom sur un Mémo

Bonjour,

J'ai un Memo que j'utilise comme écran de saisie.
Je veux que l'utilisateur puisse etre le plus confortable possible pour la saisie.

j'ai pensé à créer un zoom sur le Memo (genre éditeur qui s'ouvre ailleurs) pour que la saisie soit plus facile et plus claire

qqn a til une idée SVP ou a til rencontré le même besoin??
Merci
26/09/2006, 13h47
LadyWasky

Te sens tu à l'aise avec les TBitmap, TCanvas et TPaintBox ?

Si oui, c'est tout bête, sinon, ça va être plus dur à expliquer :aie:
26/09/2006, 14h31
freestyler

essaie tjs de m'expliquer..

je devrai m'en sortir...

Merci

L'idée est la suivante, c'est de copier le dessin du memo dans un bitmap (memo.PaintTo) que tu affiches ensuite dans une PaintBox, tout ça lorsque la souris se déplace au-dessus du memo ou que le texte du meo est modifié.

Voici un exemple, dans une fiche, j'ai mis un mémo et une paintbox :

Code:

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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;
 
type
  TForm1 = class(TForm)
    Memo1: TMemo;
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure Memo1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Memo1Change(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
    ScreenShotMemo:TBitmap;
    procedure PrendScreenShot(SourisX,SourisY:Integer);
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
//Creation d'un Bitmap de 50x50
procedure TForm1.FormCreate(Sender: TObject);
begin
  ScreenShotMemo:=TBitmap.Create;
  ScreenShotMemo.Width:=50;
  ScreenShotMemo.Height:=50;
  //Ca c'est pour éviter un effet de clignotement
  DoubleBuffered:=true;
end;
 
//Destruction du Bitmap
procedure TForm1.FormDestroy(Sender: TObject);
begin
  ScreenShotMemo.Free;
end;
 
//Construction du ScreenShot
procedure TForm1.PrendScreenShot(SourisX,SourisY:Integer);
begin
  //On Efface l'arrière plan
  ScreenShotMemo.Canvas.Brush.Style:=bsSolid;
  ScreenShotMemo.Canvas.Brush.Color:=clGray;
  ScreenShotMemo.Canvas.FillRect(PaintBox1.ClientRect);
  //On demande au memo de se dessiner dans notre bitmap
  //-SourisX, c'est pour décaler le dessin vers le haut à gauche, hors bitmap
  //25, c'est la moitié de la largeur/hauteur de notre screenshot
  Memo1.PaintTo(ScreenShotMemo.Canvas,-SourisX+25,-SourisY+25);
  //Appel du OnPaint de la PaintBox
  PaintBox1.Repaint;
end;
 
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.StretchDraw(PaintBox1.ClientRect,ScreenShotMemo);
end;
 
//OnMouseMove du memo
procedure TForm1.Memo1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  PrendScreenShot(x,y);
end;
 
//OnChange du memo
procedure TForm1.Memo1Change(Sender: TObject);
var APoint:TPoint;
begin
  //On converti les coordonnées écran de la souris en coordonnées du Mémo"
  APoint:=memo1.ScreenToClient(mouse.CursorPos);
  PrendScreenShot(APoint.X,APoint.Y);
end;
 
end.

j'avais fait aussi un petit exemple d'un zoom sur une image, il y a quelques temps ; ça peut aussi te donner des idées :

Code:

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
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
unit UZoom;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;
 
type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Timer1Timer(Sender: TObject);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Déclarations privées }
    permute:boolean;
    taille:integer;
    rectsource,rectdestination:Trect;
    imagezoom,image,imageini:Tbitmap;
    procedure zoom(x,y,taille:integer);
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
//** création de la fiche.
procedure TForm1.FormCreate(Sender: TObject);
begin
Width:=screen.Width;
height:=screen.Height;
position:=poscreencenter;
  {chargement du fichier Bmp dans le bitmap d'affichage.}
image:=Tbitmap.Create;
with image do begin
width:=paintbox1.clientWidth;
height:=paintbox1.clientHeight;
loadfromfile('DSCN1244.bmp');
end;
  {copie du bitmap d'affichage dans sa version initiale.}
imageini:=TBitmap.create;
imageini.assign(image);
  {Creation d'un bitmap conteneur de la partie zoomée.}
imagezoom:=Tbitmap.Create;
with imagezoom do begin
width:=200;
height:=200;
end;
  {timer pour zoomer automatiquement}
timer1.Enabled:=False;
timer1.Interval:=1;
paintbox1.Cursor:=crcross;
end;
 
//***************** procedure zoom.
procedure TForm1.zoom(x,y,taille:integer);
Var textzoom,pourcentage:string;
begin
  {recopie de l'image initiale dans le bitmap d'affichage à chaque entrée dans la proc zoom.}
image.Canvas.CopyRect(paintbox1.ClientRect,imageini.canvas,paintbox1.clientrect);
  {définition du rectangle à copier sur l'image source.}
rectsource:=rect(x-50+taille,y-50+taille,x+50-taille,y+50-taille);
  {definition d'un rectangle de restitution pour le zoom (invariant ici).}
rectdestination:=rect(0,0,200,200);
  {remplissage du bitmap zoom avec grandissement de la partie copiée.}
imagezoom.Canvas.CopyRect(rectdestination,image.canvas,rectsource);
textzoom:= 'zoom:';
  {Affichage dans le caneva du zoom en pourcentage par rapport à l'image source.}
If taille<>50 then pourcentage:=FloattostrF(200/(100-2*taille)*100,FFfixed,5,2);
with imagezoom.Canvas do begin
brush.Style:=bsclear;
 with font do begin
        Color:=clwhite;
        Style:=[fsbold];
        Size:=8;
 end;
textout(0,rectdestination.Bottom-rectdestination.top-20,textzoom+' '+pourcentage+'  %');
end;
  {intégration du bitmap zoom dans le bitmap d'affichage (image initiale + partie zoomée).}
image.Canvas.Draw(x-imagezoom.Width div 2,y-imagezoom.height div 2,imagezoom);
end;
//**********************************************************
 
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  {bascule dans le réel avec affichage du bitmap global (image initiale + partie zoomée).}
paintbox1.canvas.Draw(0,0,image);
end;
 
//****Procedure appelée lors d'un mouvement de souris.
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  {Affichage du bitmap global.}
zoom(x,y,taille); 
paintbox1paint(nil);
end;
 
//**procedure déclenchée lors de l'enfoncement d'un bouton de souris.
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 {activation du timer}
timer1.Enabled:=true;
 {si le bouton gauche de la souris est enfoncé alors le rectangle source augmente--> le zoom diminue}
 {si le bouton droit de la souris est enfoncé alors le rectangle source diminue--> le zoom est +fort}
IF ssLeft in shift  then permute:=true;
if ssright in shift then permute:=false;
end;
 
// procedure appelée à chaque intervalle timer.
procedure TForm1.Timer1Timer(Sender: TObject);
var origin:TPoint;
x,y:integer;
begin
 {décrémentation de taille --> btn droit enfoncé --> zoom +}
 {incrémentation de taille --> btn gauche enfoncé --> zoom -}
if permute then dec(taille) else inc(taille);
 {coordonnées souris référencées par rapport à la paintbox.}
origin:=paintbox1.clientOrigin;
x:=mouse.cursorpos.x-origin.x;
y:=mouse.CursorPos.y-origin.y;
  {Affichage du bitmap global.}
zoom(x,y,taille);
paintbox1paint(nil);
end;
 
//Procedure déclenchée lors d'un relâchement de bouton de souris.
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  {timer désactivé}
timer1.Enabled:=false;
end;
 
//****** Libération des bitmaps
procedure TForm1.FormDestroy(Sender: TObject);
begin
image.Free;
imageini.Free;
imagezoom.Free;
end;
 
//******************
 
end.

voilà
a+

Si je comprend bien ta question, tu veux ouvrir une fenêtre plus grande pour améliorer la saisie de l'utilisateur, donc si c'est bien de cela qu'il s'agit, moi je fait comme ceci:

0) Je créer un form de type dialogue qui comporte une TMemo qui occupe tout l'espace et un bouton "Accept" pour valider les modifications, que je vais appeler pour l'exemple frmSaisie.

1) Je créer une Action dans mon TActionListe que j'appel (pour l'exemple) aEditer.

2) Je défini un popup menu pour ma zone de saisie, et dans lequel j'ajoute un item qui aura comme propriété Action mon aEditer.

3) Je défini la méthode Update de mon aEditer comme ceci:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
procedure TfrmKam.aEditerUpdate(Sender: TObject);
var
  W: TWinControl;
begin
  W := frmKam.ActiveControl;
 
  if (W <> nil) then
  begin
    if ((W as TControl).Name = frmSaisie.MemoInput.Name) then
      aEditer.Enabled := False
    else
      aEditer.Enabled := (W.ClassName = 'TEdit') or (W.ClassName = 'TMemo') or (W.ClassName = 'TDBMemo') or (W.ClassName = 'TDBEdit');
  end;
end;

4) Puis je défini la méthode Execute de mon aEditer comme ceci:

Code:

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
procedure TfrmKam.aEditerExecute(Sender: TObject);
var
  W: TWinControl;
  I: integer;
begin
  W := frmKam.ActiveControl;
 
  // Envoi dans la zone d'édition le texte courant en fonction du type de composant.
  if (W is TEdit) then
    frmSaisie.MemoInput.Lines.Text := Trim((W as TEdit).Text)
  else if (W is TDBEdit) then
    frmSaisie.MemoInput.Lines.Text := Trim((W as TDBEdit).Text);
  else if (W is TDBMemo) then
    frmSaisie.MemoInput.Lines := (W as TDBMemo).Lines;
  else if (W is TMemo) then
    frmSaisie.MemoInput.Lines := (W as TMemo).Lines;
 
  // Affiche la fenêtre d'édition.
  I := frmSaisie.ShowModal;
 
  // Envoi dans la zone de texte du composant courant le texte de la zone d'édition.
  if (I = mrOk) then
  begin
    if (W is TEdit) then
      (W as TEdit).Text := frmSaisie.MemoInput.Lines.Text
    else if (W is TDBEdit) then
      (W as TDBEdit).Text := frmSaisie.MemoInput.Lines.Text
    else if (W is TMemo) then
      (W as TMemo).Lines := frmSaisie.MemoInput.Lines
    else if (W is TDBMemo) then
      (W as TDBMemo).Lines := frmSaisie.MemoInput.Lines;
  end;
end;

Voila, j'espére que cela va t'aider, sinon, je peut completer.

Der§en.