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
This commit is contained in:
yangjixian
2011-07-04 17:14:17 +00:00
parent 57541c8e74
commit 7a497ea46b
3 changed files with 80 additions and 3 deletions

View File

@ -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

View File

@ -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;

View File

@ -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;