Try to promote the zoom speed but the scrollbars position not work now.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1735 8e941d3f-bd1b-0410-a28a-d453659cc2b4

applications/lazimageeditor/DLBitmap.pas

@@ -148,6 +148,8 @@ function DWordTrans(SrcRow: TRGBATriple): DWORD;
 function DWordToTriple(SrcRow: DWORD): TRGBATriple;
 procedure StretchLinear(Dest, Src: TDLBitmap);
 procedure StretchDLBMP(ACanvas: TCanvas; Src: TDLBitmap; NewLeft, NewTop, NewWidth, NewHeight: integer);
+procedure StretchDLBMPEx(ACanvas: TCanvas; Src: TDLBitmap;
+  NewLeft, NewTop, NewWidth, NewHeight: integer; Posx, Posy, aWidth, aHeight: integer);
 procedure DrawRegularPolygon(aCanvas: TCanvas; Center, ThePoint: TPoint; Count: integer);
 
 implementation

applications/lazimageeditor/DLBmpUtils.inc

@@ -769,6 +769,65 @@ begin
   aCanvas.Polygon(ptempaddr);
 end;
 
+procedure StretchDLBMPEx(ACanvas: TCanvas; Src: TDLBitmap;
+  NewLeft, NewTop, NewWidth, NewHeight: integer; Posx, Posy, aWidth, aHeight: integer);
+var
+  dw, dh, i, j, k, ypos, xpos, ylen, xlen: DWord; Dest: TDLBitmap; sw, sh: Float; LScan1, LScan2: pRGBATriple;
+begin
+  Dest := TDLBitmap.Create;
+  dw := NewWidth - NewLeft;
+  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.Height := dh;
+  if dw > aWidth then
+    xlen := aWidth
+  else
+    xlen := dw;
+  if dh > aHeight then
+    ylen := aHeight
+  else
+    ylen := dh;
+{  if Pos.y > 0 then
+    ypos := Pos.y - NewTop
+  else
+    ypos := 0;
+  if Pos.x > 0 then
+    xpos := Pos.x - NewLeft
+  else
+    xpos := 0;    }
+  if aWidth > dw then
+    xpos := 0
+  else
+    xpos := Posx - NewLeft;
+  if aHeight > dh then
+    ypos := 0
+  else
+    ypos := Posy - NewTop;
+{  for  i := ypos to ylen - 1 do
+  begin
+    LScan1 := Dest.Scanline[i];
+    LScan2 := Src.Scanline[Trunc(i / sh)];
+    for  j := xpos to xlen - 1 do
+    begin
+      k := Trunc(j / sw);
+      LScan1[j].rgbtBlue := LScan2[k].rgbtBlue;
+      LScan1[j].rgbtGreen := LScan2[k].rgbtGreen;
+      LScan1[j].rgbtRed := LScan2[k].rgbtRed;
+    end;
+  end;    }
+    for  i := ypos to ylen - 1 do
+    for  j := xpos to xlen - 1 do
+      Dest.Pixels[j, i] := Src.Pixels[Trunc(j / sw), Trunc(i / sh)];
+  Dest.InvalidateScanLine;
+  ACanvas.Draw(NewLeft, NewTop, Dest);
+  Dest.Free;
+end;
 
 
 

applications/lazimageeditor/picturectrls.pas

@@ -31,7 +31,7 @@ interface
 
 uses
   Classes, SysUtils, LCLType, LCLIntf, Controls, Forms, ExtCtrls, Graphics, Math,
-  BmpRGBGraph, BmpRGBUtils, BmpRGBTypes, DLBitmap;
+  LMessages, BmpRGBGraph, BmpRGBUtils, BmpRGBTypes, DLBitmap;
 
 type
   TPictureViewOption = (poShowGrid, poShowMask);
@@ -55,11 +55,14 @@ type
     FStartPos: TPoint;
     FEndPos: TPoint;
     FPaintIndex: integer;
+    HorzPos, VertPos: integer;
     procedure SetOptions(const AValue: TPictureViewOptions);
     procedure SetPicture(const AValue: TPictureBitmap);
     procedure SetZoom(const AValue: single);
     procedure MaskDraw(Data: PtrInt);
   protected
+    procedure WMHScroll(var Message : TLMHScroll); message LM_HScroll;
+    procedure WMVScroll(var Message : TLMVScroll); message LM_VScroll;
     procedure PictureMouseDown(Button: TMouseButton; Shift: TShiftState;
       X, Y: integer); dynamic;
     procedure PictureMouseMove(Shift: TShiftState; X, Y: integer); dynamic;
@@ -438,6 +441,18 @@ begin
   inherited;
 end;
 
+procedure TCustomPictureView.WMHScroll(var Message : TLMHScroll);
+begin
+  inherited;
+  HorzPos := Message.Pos;
+end;
+
+procedure TCustomPictureView.WMVScroll(var Message : TLMVScroll);
+begin
+  inherited;
+  VertPos := Message.Pos;
+end;
+
 procedure TCustomPictureView.Paint;
 var
   I: integer;
@@ -454,8 +469,9 @@ begin
     if Assigned(FPicture) then
     begin
       FPicture.StretchDrawTo(Canvas, FPictureRect.Left, FPictureRect.Top,
-        FPictureRect.Right, FPictureRect.Bottom);
+        FPictureRect.Right, FPictureRect.Bottom, HorzPos,
-
+        VertPos, Width, Height);
+    application.Mainform.Caption := IntToStr(HorzPos);
       if (poShowGrid in Options) and (Zoom > 2.0) then
       begin
         Pen.Color := clGray;