Zoom optimized now.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1737 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
yangjixian
2011-07-05 04:15:54 +00:00
parent 1bcf7f4580
commit 2bd3df926b
4 changed files with 43 additions and 35 deletions

View File

@ -1,3 +1,15 @@
{
Authors: Felipe Monteiro de Carvalho, Yang JiXian
License: The same modifying LGPL with static linking exception as the LCL
This unit implements the TDLBitmap class which has similar property "ScanLine"
of Delphi TBitmap. With this property we can reuse some classic code of delphi
to yield our platform independent bitmap class. We hope it simple and powerful.
Also some useful image process function has been added into the class.
}
unit DLBitmap; unit DLBitmap;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}

View File

@ -1,5 +1,9 @@
{ {
These are the TDLBitmap process functions. Authors: Felipe Monteiro de Carvalho, Yang JiXian
License: The same modifying LGPL with static linking exception as the LCL
Those are the TDLBitmap process functions.
} }
procedure LazBMPRotate90(const aBitmap: TDLBitmap; IsTurnRight: boolean); procedure LazBMPRotate90(const aBitmap: TDLBitmap; IsTurnRight: boolean);
@ -786,44 +790,35 @@ begin
Dest.Width := dw; Dest.Width := dw;
Dest.Height := dh; Dest.Height := dh;
if dw > aWidth then if dw > aWidth then
xlen := aWidth begin
xlen := Min(aWidth + Posx, dw);
xpos := Posx;
end
else else
begin
xlen := dw; 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 xpos := 0
end;
if dh > aHeight then
begin
ylen := Min(aHeight + Posy, dh);
ypos := Posy;
end
else else
xpos := Posx - NewLeft; begin
if aHeight > dh then ylen := dh;
ypos := 0 ypos := 0
else end;
ypos := Posy - NewTop; for i := ypos to ylen - 1 do
{ for i := ypos to ylen - 1 do
begin begin
LScan1 := Dest.Scanline[i]; LScan1 := Dest.Scanline[i];
LScan2 := Src.Scanline[Trunc(i / sh)]; LScan2 := Src.Scanline[Trunc(i / sh)];
for j := xpos to xlen - 1 do for j := xpos to xlen - 1 do
begin begin
k := Trunc(j / sw); k := Trunc(j / sw);
LScan1[j].rgbtBlue := LScan2[k].rgbtBlue; LScan1[j] := LScan2[k];
LScan1[j].rgbtGreen := LScan2[k].rgbtGreen; end;
LScan1[j].rgbtRed := LScan2[k].rgbtRed;
end; 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; Dest.InvalidateScanLine;
ACanvas.Draw(NewLeft, NewTop, Dest); ACanvas.Draw(NewLeft, NewTop, Dest);
Dest.Free; Dest.Free;

View File

@ -128,7 +128,7 @@ type
procedure FuzzyRectangle(X1, Y1, X2, Y2: integer); procedure FuzzyRectangle(X1, Y1, X2, Y2: integer);
public public
procedure DrawTo(ACanvas: TCanvas; X, Y: integer); procedure DrawTo(ACanvas: TCanvas; X, Y: integer);
procedure StretchDrawTo(ACanvas: TCanvas; DstX, DstY, DstWidth, DstHeight: integer); procedure StretchDrawTo(ACanvas: TCanvas; DstX, DstY, DstWidth, DstHeight, HPos, VPos, aWidth, aHeight: integer);
property EraseMode: TEraseMode read FEraseMode write FEraseMode; property EraseMode: TEraseMode read FEraseMode write FEraseMode;
property DrawMode: TDrawMode read FDrawMode write FDrawMode; property DrawMode: TDrawMode read FDrawMode write FDrawMode;
@ -596,12 +596,12 @@ begin
end; end;
procedure TRGBBitmapCore.StretchDrawTo(ACanvas: TCanvas; procedure TRGBBitmapCore.StretchDrawTo(ACanvas: TCanvas;
DstX, DstY, DstWidth, DstHeight: integer); DstX, DstY, DstWidth, DstHeight, HPos, VPos, aWidth, aHeight: integer);
begin begin
// if ACanvas <> nil then // if ACanvas <> nil then
// ACanvas.StretchDraw(Rect(DstX, DstY, DstWidth, DstHeight), Self); // ACanvas.StretchDraw(Rect(DstX, DstY, DstWidth, DstHeight), Self);
// StretchDLBMP(Self, 3, 3); // StretchDLBMP(Self, 3, 3);
StretchDLBMP(ACanvas, Self, DstX, DstY, DstWidth, DstHeight); StretchDLBMPEx(ACanvas, Self, DstX, DstY, DstWidth, DstHeight, HPos, VPos, aWidth, aHeight);
{begin {begin
ACanvas.AntialiasingMode:=amOff; ACanvas.AntialiasingMode:=amOff;
ACanvas.CopyMode:=cmSrcPaint; ACanvas.CopyMode:=cmSrcPaint;

View File

@ -434,6 +434,7 @@ begin
FScrollStop := TPanel.Create(Self); FScrollStop := TPanel.Create(Self);
FScrollStop.SetBounds(0, 0, 0, 0); FScrollStop.SetBounds(0, 0, 0, 0);
FScrollStop.Parent := Self; FScrollStop.Parent := Self;
Self.AutoScroll := True;
end; end;
destructor TCustomPictureView.Destroy; destructor TCustomPictureView.Destroy;
@ -444,13 +445,13 @@ end;
procedure TCustomPictureView.WMHScroll(var Message : TLMHScroll); procedure TCustomPictureView.WMHScroll(var Message : TLMHScroll);
begin begin
inherited; inherited;
HorzPos := Message.Pos; //HorzPos := Message.Pos;
end; end;
procedure TCustomPictureView.WMVScroll(var Message : TLMVScroll); procedure TCustomPictureView.WMVScroll(var Message : TLMVScroll);
begin begin
inherited; inherited;
VertPos := Message.Pos; //VertPos := Message.Pos;
end; end;
procedure TCustomPictureView.Paint; procedure TCustomPictureView.Paint;
@ -468,10 +469,10 @@ begin
if Assigned(FPicture) then if Assigned(FPicture) then
begin begin
HorzPos := HorzScrollbar.Position;
VertPos := VertScrollbar.Position;
FPicture.StretchDrawTo(Canvas, FPictureRect.Left, FPictureRect.Top, FPicture.StretchDrawTo(Canvas, FPictureRect.Left, FPictureRect.Top,
FPictureRect.Right, FPictureRect.Bottom, HorzPos, FPictureRect.Right, FPictureRect.Bottom, HorzPos, VertPos, Width, Height);
VertPos, Width, Height);
application.Mainform.Caption := IntToStr(HorzPos);
if (poShowGrid in Options) and (Zoom > 2.0) then if (poShowGrid in Options) and (Zoom > 2.0) then
begin begin
Pen.Color := clGray; Pen.Color := clGray;