You've already forked lazarus-ccr
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:
@ -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;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
@ -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);
|
||||
@ -786,44 +790,35 @@ begin
|
||||
Dest.Width := dw;
|
||||
Dest.Height := dh;
|
||||
if dw > aWidth then
|
||||
xlen := aWidth
|
||||
begin
|
||||
xlen := Min(aWidth + Posx, dw);
|
||||
xpos := Posx;
|
||||
end
|
||||
else
|
||||
begin
|
||||
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
|
||||
end;
|
||||
if dh > aHeight then
|
||||
begin
|
||||
ylen := Min(aHeight + Posy, dh);
|
||||
ypos := Posy;
|
||||
end
|
||||
else
|
||||
xpos := Posx - NewLeft;
|
||||
if aHeight > dh then
|
||||
begin
|
||||
ylen := dh;
|
||||
ypos := 0
|
||||
else
|
||||
ypos := Posy - NewTop;
|
||||
{ for i := ypos to ylen - 1 do
|
||||
end;
|
||||
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;
|
||||
LScan1[j] := LScan2[k];
|
||||
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)];
|
||||
end;
|
||||
Dest.InvalidateScanLine;
|
||||
ACanvas.Draw(NewLeft, NewTop, Dest);
|
||||
Dest.Free;
|
||||
|
@ -128,7 +128,7 @@ type
|
||||
procedure FuzzyRectangle(X1, Y1, X2, Y2: integer);
|
||||
public
|
||||
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 DrawMode: TDrawMode read FDrawMode write FDrawMode;
|
||||
@ -596,12 +596,12 @@ begin
|
||||
end;
|
||||
|
||||
procedure TRGBBitmapCore.StretchDrawTo(ACanvas: TCanvas;
|
||||
DstX, DstY, DstWidth, DstHeight: integer);
|
||||
DstX, DstY, DstWidth, DstHeight, HPos, VPos, aWidth, aHeight: integer);
|
||||
begin
|
||||
// if ACanvas <> nil then
|
||||
// ACanvas.StretchDraw(Rect(DstX, DstY, DstWidth, DstHeight), Self);
|
||||
// StretchDLBMP(Self, 3, 3);
|
||||
StretchDLBMP(ACanvas, Self, DstX, DstY, DstWidth, DstHeight);
|
||||
StretchDLBMPEx(ACanvas, Self, DstX, DstY, DstWidth, DstHeight, HPos, VPos, aWidth, aHeight);
|
||||
{begin
|
||||
ACanvas.AntialiasingMode:=amOff;
|
||||
ACanvas.CopyMode:=cmSrcPaint;
|
||||
|
@ -434,6 +434,7 @@ begin
|
||||
FScrollStop := TPanel.Create(Self);
|
||||
FScrollStop.SetBounds(0, 0, 0, 0);
|
||||
FScrollStop.Parent := Self;
|
||||
Self.AutoScroll := True;
|
||||
end;
|
||||
|
||||
destructor TCustomPictureView.Destroy;
|
||||
@ -444,13 +445,13 @@ end;
|
||||
procedure TCustomPictureView.WMHScroll(var Message : TLMHScroll);
|
||||
begin
|
||||
inherited;
|
||||
HorzPos := Message.Pos;
|
||||
//HorzPos := Message.Pos;
|
||||
end;
|
||||
|
||||
procedure TCustomPictureView.WMVScroll(var Message : TLMVScroll);
|
||||
begin
|
||||
inherited;
|
||||
VertPos := Message.Pos;
|
||||
//VertPos := Message.Pos;
|
||||
end;
|
||||
|
||||
procedure TCustomPictureView.Paint;
|
||||
@ -468,10 +469,10 @@ begin
|
||||
|
||||
if Assigned(FPicture) then
|
||||
begin
|
||||
HorzPos := HorzScrollbar.Position;
|
||||
VertPos := VertScrollbar.Position;
|
||||
FPicture.StretchDrawTo(Canvas, FPictureRect.Left, FPictureRect.Top,
|
||||
FPictureRect.Right, FPictureRect.Bottom, HorzPos,
|
||||
VertPos, Width, Height);
|
||||
application.Mainform.Caption := IntToStr(HorzPos);
|
||||
FPictureRect.Right, FPictureRect.Bottom, HorzPos, VertPos, Width, Height);
|
||||
if (poShowGrid in Options) and (Zoom > 2.0) then
|
||||
begin
|
||||
Pen.Color := clGray;
|
||||
|
Reference in New Issue
Block a user