Que pensez-vous de mon scrolling iPhone like ? :)

**Montor** · 25/05/2009, 21h25

Envoyé par Andnotor

Dans le cas présent, il serait judicieux de briser la linéarité de ton texte en rajoutant quelques ponctuations et retours à la ligne

sur mes codes peut-etre

Envoyé par Paul TOTH

alors replaçons les choses dans leur contexte

j'ai juste voulu reproduire l'effet de scrolling d'un iPhone, pour cela j'ai pris le desktop qui présente l'avantage de ne pas avoir a choisir un bitmap et j'ai codé directement le comportement dans la fiche car je n'avais pas d'autre besoin.

pour faire scroller des contrôles c'est plutôt le déplacement d'un TWinControl conteneur qu'il faudrait gérer.

Non c'est pas a toi que je vais donner des conseils mais il y a des gens qui veulent l'integé sur leur applis c'est mon cas aussi je veux savoir les conditions pour le bon fonctionnement.
Bon je veux récuperer les cordonnées de clique je ne sais pas si Gillbert_Geyer a avancé sur le sujet, au passage la constante WS_EX_LAYERED = $00080000;
le probleme je ne veux pas que le scroll s'arrete au milieu de colonne ou la ligne si tu peux m'aider
Voici 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
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
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
unit Main;
 
{
  Effet de scrolling à la iPhone (c)2009, Paul TOTH <tothpaul@free.fr>
}
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Math,types, ExtCtrls, StdCtrls;
 
type
  TMainForm = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormResize(Sender: TObject);
 
  private
    { Déclarations privées }
    FDesktop  : TBitmap;
    FBitmap   : TBitmap;
    FTop      : Integer;
    FLeft     : Integer;
    FPos      : TPoint;
    FDownTime : Cardinal;
    FDownPos  : TPoint;
    FDownState: TPoint;
    FMoveTime : Cardinal;
    FVector   : TPoint;
    FSpeed    : Cardinal;
    FTicks    : Cardinal;
    FBounds   : TRect;
    procedure InitPosition;
    procedure WMEraseBkGnd(var Msg: TMessage); message WM_ERASEBKGND;
    procedure DrawScrollBars;
  public
    { Déclarations publiques }
  end;
 
var
  MainForm: TMainForm;
 
 bb:integer;
implementation
 
{$R *.dfm}
const
    sH=50;
    sW=60;
procedure TabWiew(ABitmap:TBitmap;ACols,ARows:Integer);
const
   Cl:array[boolean] of TColor=(clRed,clLime);
var
  sTop,sLeft,I,J:integer;
  Tc,Oc:boolean;
begin
     oc:=false; ABitmap.PixelFormat := pf32Bit;
     if not Assigned(ABitmap)then Exit;
     ABitmap.Height:=ARows *sH;
     ABitmap.Width :=ACols *sW;
    for I:=0 to ARows-1 do
    with  ABitmap.Canvas  do
      begin
         Tc:=Oc;
         for J:=0 to ACols-1 do
            begin
              Brush.Color:=Cl[Tc];
              sLeft:=J*sW;
              sTop:= I*sH;
              FillRect(Bounds(sLeft,sTop,sW,sH));
              TextOut(sLeft+5,sTop+5,Format('[%d,%d]',[J,I]));
              Tc:=not Tc;
            end;
         Oc:=not Oc;
      end;
end;
 
procedure TransformBitmap(aBitmap : TBitmap;ARect:TRect;AMs:TColor=clBlack);
var
  x, y : Integer;
  Pixel: PCardinal;
begin
// effectuer une transformation sur chaque pixel de l'image
 
 // if IsRectEmpty(ARect) then Exit;
  with aBitmap.Canvas,ARect do
     if not PtInRect(ClipRect,TopLeft) or
        not PtInRect(ClipRect,BottomRight) then Exit;
 
  aBitmap.PixelFormat := pf32Bit;
  for y := ARect.Top to ARect.Bottom do
  begin
    Pixel := aBitmap.ScanLine[y];
    inc(Pixel,ARect.Left);
    for x := ARect.Left to ARect.Right do
    begin
       Pixel^ :=(Pixel^)xor AMs;
       Inc(Pixel);
    end;
  end;
end;
 
function GetDesktopBitmap: HBitmap;
var
  cScreenDC : HDC;
  cOldBitmap: HBitmap;
  cBitmapDC : HDC;
begin
// récupérer le DC de l'écran
  cScreenDC := GetDC(0);
// créer un bitmap compatible
  Result := CreateCompatibleBitmap(cScreenDC, Screen.Width, Screen.Height);
// obtenir un second DC compatible
  cBitmapDC := CreateCompatibleDC(cScreenDC);
// y placer le bitmap
  cOldBitmap := SelectObject(cBitmapDC, Result);
// copier le DC de l'écran dans le DC contenant le bitmap
  BitBlt(cBitmapDC, 0, 0, Screen.Width, Screen.Height, cScreenDC, 0, 0, SRCCOPY);
// restaurer l'ancien bitmap
  SelectObject(cBitmapDC, cOldBitmap);
// supprimer les DC
  DeleteDC(cBitmapDC);
  ReleaseDC(0, cScreenDC);
end;
 
procedure TMainForm.FormCreate(Sender: TObject);
begin
// on récupère l'image du bureau
  FDesktop := TBitmap.Create;
   TabWiew(FDesktop,50,30);
  //FDesktop.Handle := GetDesktopBitmap;
// image pour dessiner offline
  FBitmap := TBitmap.Create;
  FBitmap.PixelFormat := pf32Bit;
// on lui applique une petite transformation
  TransformBitmap(FDesktop,Rect(0,0,FDesktop.Width-1,FDesktop.Height-1));
// l'image a besoin d'être repositionnée
  tag:=1;
   //DoubleBuffered:=true;
end;
 
procedure TMainForm.FormResize(Sender: TObject);
begin
 // positions limites de l'image
  FBounds := Rect(ClientWidth - FDesktop.Width, ClientHeight - FDesktop.Height, 0, 0);
  FBitmap.Width := ClientWidth;
  FBitmap.Height := ClientHeight;
end;
 
procedure TMainForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Pt:Tpoint;
begin
    Pt.X:=X-FLeft;
    Pt.Y:=Y-FTop;
 
   if PtInRect(Rect(1,1,FDesktop.Width,FDesktop.Height),Pt) then
     Caption:=Format('Clonne:%d  Ligne :%d',[Pt.X div sW,Pt.Y div sH]);
 
// quand on clic, l'image ne doit plus bouger, mais nous devons connaitre la position et le temps de référence
  FSpeed := 0;
  FVector.X := 0;
  FVector.Y := 0;
  FDownTime := GetTickCount;
  FDownPos.X := x;
  FDownPos.Y := y;
  FDownState := FDownPos;
end;
 
procedure TMainForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
// l'image se déplace avec la souris quand un bouton est enfoncé
  if [ssLeft, ssRight] * Shift <> [] then
  begin
    Inc(FLeft, X - FDownState.X);
    Inc(FTop, Y - FDownState.Y);
    FDownState.X := X;
    FDownState.Y := Y;
    FMoveTime := GetTickCount;
   // on vérifie que la souris n'est pas restée sur place trop longtemps
    if FMoveTime - FDownTime > 400 then
    begin
      FDownPos := FDownState;
      FDownTime := FMoveTime;
    end;
   Invalidate;
  end;
end;
 
procedure TMainForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
// quand on relache la souris, on détermine le déplacement de l'image en conséquence
  if FDownTime > 0 then
  begin
   // vecteur de déplacement
    FVector.X := X - FDownPos.X;
    FVector.Y := Y - FDownPos.Y;
   // vitesse de déplacement
    FTicks := GetTickCount;
    FSpeed := FTicks - FDownTime;
    FDownTime := 0;
    Invalidate;
  end;
end;
 
procedure TMainForm.InitPosition;
var
  cPoint    : TPoint;
begin
// calcul de la position de l'image pour que la fiche semble transparente
  cPoint.X := 0;
  cPoint.Y := 0;
  cPoint := ClientToScreen(cPoint);
  FLeft := - cPoint.X;
  FTop := - cPoint.Y;
  FPos.X := Left;
  FPos.Y := Top;
end;
 
procedure TMainForm.WMEraseBkGnd(var Msg: TMessage);
begin
// pas de dessin du background (évite le clignotemment)
  Msg.Result := 1;
end;
 
procedure TMainForm.FormPaint(Sender: TObject);
var
  cDelta  : Cardinal;
  cRedraw : Boolean;
  cDx, cDy: Integer;
begin
// si nécessaire, calcul la position initiale de l'image
//with PaintBox1 do begin
  if Tag = 1 then
  begin
    Tag := 0;
    InitPosition;
  end;
 
 
 
// on va boucler sur FormPaint aussi longtemps que nécessaire
  cRedraw := False;
// a-t-on une vitesse de déplacement ?
  if FSpeed > 0 then
  begin
   // dans ce cas on va boucler
    cRedraw := True;
   // et en fonction du temps, on déplace l'image
    cDelta := GetTickCount - FTicks;
    if cDelta > 0 then
    begin
    // nouvelle position en fonction du temps écouler et de la vitesse
      cDx := Round(FVector.X * cDelta / FSpeed);
      cDy := Round(FVector.Y * cDelta / FSpeed);
      if (cDx = 0) and (cDy = 0) then
      begin
        FVector.X := 0;
        FVector.Y := 0;
        FSpeed := 0;
      end
      else
      begin
        FLeft := Round(FLeft + cDx);
        FTop := Round(FTop + cDy);
      // ajutement de la vitesse
        FSpeed := Round(FSpeed + FSpeed * cDelta / 1000);
      // nouveau temps de référence
        Inc(FTicks, cDelta);
      // si le vecteur de déplacement est nul, la vitesse l'est également
        if (FVector.X = 0) and (FVector.Y = 0) then
          FSpeed := 0
      end;
    end;
  end;
  if FDownTime = 0 then
  with  FBounds do
    begin
      if IsRectEmpty(Rect(FLeft,Left,Right,FLeft)) then
      begin
        FLeft     := Min(FLeft,Right);
        FLeft     := Max(FLeft,Left );
        FVector.X := 0;
        cRedraw   := True;
      end;
      if IsRectEmpty(Rect(FTop,Top,Bottom,FTop)) then
      begin
        FTop      := Min(FTop,Bottom);
        FTop      := Max(FTop,Top );
        FVector.Y := 0;
        cRedraw   := True;
      end;
 
   end;
 
  with FBitmap.Canvas do
  begin
  // dessiner l'image
    Brush.Color := $606060;
    FillRect(Rect(0, 0, FBitmap.Width, FBitmap.Height));
 
    Draw(FLeft, FTop, FDesktop);
    DrawScrollBars;
 
  end;
  //
  //Canvas.Draw(FLeft, FTop, FDesktop);
  Canvas.Draw(0, 0, FBitmap);
  if cRedraw then
   invalidate;
 
 
end;
 
 
function _ScrollBars(var AStart,ALen:integer;TL,AOP1,AOP2,DES:integer):boolean;
begin
   result:=false;
  if (AOP1> 10) then
  begin
    result :=true;
    ALen   := MulDiv((AOP2 - 17), AOP2, DES);
    AStart := MulDiv(5 - (AOP2 - 17), TL, DES);
    if AStart < 5 then
    begin
      inc(ALen, AStart - 5);
      AStart := 5;
    end;
    if AStart + ALen > AOP2 - 17 then
      ALen := AOP2 - 17 - AStart;
  end;
 
end;
 
procedure TMainForm.DrawScrollBars;
var
  start: Integer;
  len  : Integer;
begin
  with FBitmap do
  begin
   if _ScrollBars(start, len, FLeft, Height, Width, FDesktop.Width) then
    TransformBitmap(FBitmap, Bounds(start, Height - 10, len, 5),clCream);
 
   if _ScrollBars(start, len, Ftop, Width, Height, FDesktop.Height) then
      TransformBitmap(FBitmap, Bounds(Width - 10, start, 5, len),clCream);
 
  end;
 
end;
end.

une autre questions si FLeft et cDx sont des integer que arrondir ?

Code :

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

FLeft := Round(FLeft + cDx);

Merci

**Gilbert Geyer** · 26/05/2009, 09h14

Bonjour,

Montor, Hier 21h25 :

je ne sais pas si Gillbert_Geyer a avancé sur le sujet

... Réponse : Pour l'instant je n'ai pas avancé. Comme le concept iPhone c'est un fond d'écran avec des boutons, etc et que tout cela bouge ça risque de nécessiter la création d'une usine à gaz ... et ergonomie bien ordonnée s'appliquant à soi-même, la loi du moindre effort me conduirait plutôt vers la simplicité d'une ScrollBox contenant un TImage pour le cas d'images dépassant la taille de l'écran bien que ceci n'aie pas vraiment le look iPhone.
Donc pour la suite de l'iPhone je laisse temporairement mon subconscient méditer sur le sujet.

Cordialement et à +.

**Paul TOTH** · 26/05/2009, 10h09

Envoyé par Gilbert Geyer

Bonjour,

Montor, Hier 21h25 :
... Réponse : Pour l'instant je n'ai pas avancé. Comme le concept iPhone c'est un fond d'écran avec des boutons, etc et que tout cela bouge ça risque de nécessiter la création d'une usine à gaz ... et ergonomie bien ordonnée s'appliquant à soi-même, la loi du moindre effort me conduirait plutôt vers la simplicité d'une ScrollBox contenant un TImage pour le cas d'images dépassant la taille de l'écran bien que ceci n'aie pas vraiment le look iPhone.
Donc pour la suite de l'iPhone je laisse temporairement mon subconscient méditer sur le sujet.

Cordialement et à +.

j'ajouterais qu'avant de coder quoi que ce soit, il faudrait commencer par déterminé ce qu'on veux obtenir, se poser la question de comment y arriver de la meilleur façon, puis enfin de mettre tout cela en code

et en fait, en te lisant Montor, je ne comprend pas ce que tu cherches à faire

**Montor** · 26/05/2009, 15h09

Envoyé par Gilbert Geyer

... Réponse : Pour l'instant je n'ai pas avancé

portant r tu étais le plus motive

Envoyé par Gilbert Geyer

Comme le concept iPhone c'est un fond d'écran avec des boutons, etc et que tout cela bouge ça risque de nécessiter la création d'une usine à gaz ... et ergonomie bien ordonnée s'appliquant à soi-même

Non je ne pense pas que c'est une bon idée pour faire déplacer des contrôles sur la fiche mais il faut que tu les remplace par des graphiques et un seul Handler pour les événements click dbclick context.

Envoyé par Paul TOTH

j'ajouterais qu'avant de coder quoi que ce soit, il faudrait commencer par déterminé ce qu'on veux obtenir, se poser la question de comment y arriver de la meilleur façon, puis enfin de mettre tout cela en code

Dans mon cas ca tombe au bon moment je viens de terminer la phase de création des classes avec base de donnes bien sure que j'ai fait des tests avec les classiques TButton, TMemo, Showmessage etc...,arrivant a la phase de l'interface utilisateur au premier je viens de télécharger des composants de style pour Delphi http://www.sunisoft.com/ mais ne offres pas des vrai nouvelle fonctionnalité.
Si je peux faire une discription j'ai crée un grand arbre avec des pseudo-dossiers items qui seront représenter comme des thumbs et pour parcourir il faut un petit explorer et si j'ajoute l'effet de scroll il exploration sera très fluide.

Envoyé par Paul TOTH

et en fait, en te lisant Montor, je ne comprend pas ce que tu cherches à faire

C'est reglé

Code :

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

1
2
3
4
5
      if (FLeft mod  sW)> -5 then
      begin
        FSpeed := 0 ;
       FLeft:=FLeft+(FLeft  mod  sW);
      end;

la fonction Round génère un effet de zigzag qui se produit lorsque je fait un scroll en diagonal
comment tester la rectitude de ces trois points pour corriger cet erreur?
FDownPos,FVector et la nouvelle position(FTop,FLeft)
Merci

Que pensez-vous de mon scrolling iPhone like ? :)

Delphi

Discussions similaires

Partager

Partager