You've already forked lazarus-ccr
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:
@ -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
|
||||
|
@ -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;
|
||||
|
||||
|
||||
|
||||
|
@ -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;
|
||||
|
Reference in New Issue
Block a user