You've already forked lazarus-ccr
fixed zoom bugs.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1610 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@@ -677,19 +677,22 @@ end;
|
|||||||
|
|
||||||
procedure StretchDLBMP(ACanvas: TCanvas; Src: TDLBitmap; NewLeft, NewTop, NewWidth, NewHeight: integer);
|
procedure StretchDLBMP(ACanvas: TCanvas; Src: TDLBitmap; NewLeft, NewTop, NewWidth, NewHeight: integer);
|
||||||
var
|
var
|
||||||
sw, sh, dw, dh, i, j: DWord;
|
dw, dh, i, j: DWord; Dest: TDLBitmap; sw, sh: Float;
|
||||||
Dest: TDLBitmap;
|
|
||||||
begin
|
begin
|
||||||
Dest := TDLBitmap.Create;
|
Dest := TDLBitmap.Create;
|
||||||
sw := Max(1, NewWidth div Src.Width);
|
|
||||||
sh := Max(1, NewHeight div Src.Height);
|
|
||||||
dw := NewWidth - NewLeft;
|
dw := NewWidth - NewLeft;
|
||||||
dh := NewHeight - NewTop;
|
dh := NewHeight - NewTop;
|
||||||
|
sw := dw / Src.Width;
|
||||||
|
sh := dh / Src.Height;
|
||||||
|
if sw = 0 then
|
||||||
|
sw := 1;
|
||||||
|
if sh = 0 then
|
||||||
|
sh := 1;
|
||||||
Dest.Width := dw;
|
Dest.Width := dw;
|
||||||
Dest.Height := dh;
|
Dest.Height := dh;
|
||||||
for i := 0 to dh - 1 do
|
for i := 0 to dh - 1 do
|
||||||
for j := 0 to dw - 1 do
|
for j := 0 to dw - 1 do
|
||||||
Dest.Pixels[j, i] := Src.Pixels[j div sw, i div sh];
|
Dest.Pixels[j, i] := Src.Pixels[Trunc(j / sw), Trunc(i / sh)];
|
||||||
Dest.InvalidateScanLine;
|
Dest.InvalidateScanLine;
|
||||||
ACanvas.Draw(NewLeft, NewTop, Dest);
|
ACanvas.Draw(NewLeft, NewTop, Dest);
|
||||||
Dest.Free;
|
Dest.Free;
|
||||||
|
Reference in New Issue
Block a user