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
| ScaleFactor := abs(ScaleFactor);
if ScaleFactor <= 1.0 then begin // Si ScaleFactor <= 1.0 XBR n'apporte rien donc simple réduction de taille rapide avec StretchBlt
Result := tBitMap.Create;
// BmpS.PixelFormat := pf32bit; // jpt : voir commentaires dans initialisations
Result.Assign(BmpS);
iKech := round(ScaleFactor);
goto Achever;
end else // sinon utilisation du XBR :
if ScaleFactor >= 8.0 then sKech := Scalefactor
else sKech := 8.0; // Si ScaleFactor < 8.0 on procède à un XBR avec 8 et qui sera suivi d'un ajustement de taille rapide avec StretchBlt
iKech := round(sKech);
Initialisations;
for ys := 0 to HS - 1 do begin
// jpt [comment. fonctionnel pour le forum] ici rien n'a été touché, je l'enlève pour alléger, à reprendre de l'original
end; // for xs
//jpt if ToucheCla(VK_ESCAPE) then EXIT; // ne compile pas : c'est quel uses qui manque ?
if Assigned(ProgressCallBack) then ProgressCallBack;
end; // for ys
Achever:
//jpt if iKech <> ScaleFactor then -- si présent, ne fonctionne plus avec les val entières > 8
begin // Ajustement de taille si ScaleFactor n'est pas une valeur entière ou s'il est inférieur à 8
//jpt WR := round(ScaleFactor * bmpS.Width); HR := round(ScaleFactor * bmpS.Height); // + lisible dessous
WR := round(WS * ScaleFactor); HR := round(HS * ScaleFactor);
tmp:=TBitmap.Create; // jpt, nouveau
//tmp.PixelFormat := pf32bit;
tmp.PixelFormat := pf24bit; // +1 !
tmp.Width := WR; // 2 lignes nécessaires sinon fichier vide
tmp.Height:= HR;
//jpt inconnu sous Linux GetBrushOrgEx(Result.Canvas.Handle, pt);
//jpt SetStretchBltMode(Result.Canvas.Handle, HalfTone);
SetStretchBltMode(tmp.Canvas.Handle, HalfTone);
//jpt inconnu sous Linux SetBrushOrgEx(Result.Canvas.Handle, pt.x, pt.y, @pt);
//jpt StretchBlt(Result.Canvas.Handle, 0, 0, WR, HR,
StretchBlt(tmp.Canvas.Handle, 0, 0, WR, HR,
Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, SRCCOPY);
//jpt with Result do begin Width := WR; height := HR; end; // commenté car inutile
Result.Assign(tmp);
tmp.Free;
end;
Result.Canvas.Changed; // jpt +1!
SetLength(pixS, 0, 0); SetLength(pixR, 0, 0);
end; // StretchXBR |
[Windows - Linux] Porter le projet Delphi StretchXBR vers Lazarus
Répondre avec citation
Re-Hello ca serait vraiment sympa si tu pourrais nous mettre le projet complet. Vraiment pas le temps et envie de me faire ***** à convertir les units de Delphi, créer un projet insérer ta Form supprimer l'ancienne bref. Un petit Zip All-in-one ne serait pas de refus et désagréable 
Envoyé par BeanzMaster
: 
, vu comment je misère avec certains fichiers qui sont très bien ouverts par les routines Mitchell mais redimensionnés avec les traits verticaux habituels des défauts de scanline...
Partager