mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-08 11:36:05 +02:00
Starts a new unit, lazcanvas.pas, for adding extensions for TFPImageCanvas to support all our TCanvas features
git-svn-id: trunk@33581 -
This commit is contained in:
parent
ee99a1f649
commit
d8824e0700
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -5753,6 +5753,7 @@ lcl/languages/lclstrconsts.sk.po svneol=native#text/plain
|
||||
lcl/languages/lclstrconsts.tr.po svneol=native#text/plain
|
||||
lcl/languages/lclstrconsts.uk.po svneol=native#text/plain
|
||||
lcl/languages/lclstrconsts.zh_CN.po svneol=native#text/utf8
|
||||
lcl/lazcanvas.pas svneol=native#text/pascal
|
||||
lcl/lazconfigstorage.pas svneol=native#text/pascal
|
||||
lcl/lazhelphtml.pas svneol=native#text/pascal
|
||||
lcl/lazhelpintf.pas svneol=native#text/pascal
|
||||
|
@ -24,7 +24,7 @@ uses
|
||||
WSControls, WSDesigner, WSDialogs, WSExtCtrls, WSExtDlgs, WSFactory,
|
||||
WSForms, WSGrids, WSImgList, WSLCLClasses, WSMenus, WSPairSplitter, WSProc,
|
||||
WSReferences, WSSpin, WSStdCtrls, WSToolwin, ActnList, Arrow, AsyncProcess,
|
||||
AvgLvlTree, ButtonPanel, Buttons, Calendar, RegisterLCL, ValEdit,
|
||||
AvgLvlTree, ButtonPanel, Buttons, Calendar, RegisterLCL, ValEdit, lazcanvas,
|
||||
LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
77
lcl/lazcanvas.pas
Normal file
77
lcl/lazcanvas.pas
Normal file
@ -0,0 +1,77 @@
|
||||
{
|
||||
/***************************************************************************
|
||||
lazcanvas.pas
|
||||
---------------
|
||||
|
||||
***************************************************************************/
|
||||
|
||||
*****************************************************************************
|
||||
* *
|
||||
* This file is part of the Lazarus Component Library (LCL) *
|
||||
* *
|
||||
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
|
||||
* for details about the copyright. *
|
||||
* *
|
||||
* This program is distributed in the hope that it will be useful, *
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
||||
* *
|
||||
*****************************************************************************
|
||||
|
||||
Author: Felipe Monteiro de Carvalho
|
||||
|
||||
Abstract:
|
||||
Classes and functions for extending TFPImageCanvas to support more stretching
|
||||
filters and to support all features from the LCL TCanvas
|
||||
}
|
||||
unit lazcanvas;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
// RTL
|
||||
Classes, SysUtils,
|
||||
// FCL-Image
|
||||
fpimgcanv, fpcanvas, fpimage;
|
||||
|
||||
type
|
||||
|
||||
{ TFPSharpInterpolation }
|
||||
|
||||
// This does a very sharp and square interpolation for stretching,
|
||||
// similar to StretchBlt from the Windows API
|
||||
TFPSharpInterpolation = class (TFPCustomInterpolation)
|
||||
protected
|
||||
procedure Execute (x,y,w,h : integer); override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TFPWindowsSharpInterpolation }
|
||||
|
||||
procedure TFPSharpInterpolation.Execute(x, y, w, h: integer);
|
||||
// paint Image on Canvas at x,y,w*h
|
||||
var
|
||||
srcx, srcy: Integer; // current coordinates in the source image
|
||||
dx, dy: Integer; // current coordinates in the destination canvas
|
||||
lWidth, lHeight: Integer; // Image size
|
||||
begin
|
||||
if (w<=0) or (h<=0) or (image.Width=0) or (image.Height=0) then
|
||||
exit;
|
||||
|
||||
lWidth := Image.Width-1;
|
||||
lHeight := Image.Height-1;
|
||||
|
||||
for dx := 0 to w-1 do
|
||||
for dy := 0 to h-1 do
|
||||
begin
|
||||
srcx := Round((dx / w) * lWidth);
|
||||
srcy := Round((dy / w) * lHeight);
|
||||
Canvas.Colors[dx+x, dy+y] := Image.Colors[srcx, srcy];
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
@ -4,7 +4,7 @@
|
||||
<Name Value="LCLBase"/>
|
||||
<Author Value="Lazarus"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="10"/>
|
||||
<Version Value="11"/>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="include"/>
|
||||
<OtherUnitFiles Value="forms;widgetset"/>
|
||||
@ -12,12 +12,6 @@
|
||||
</SearchPaths>
|
||||
<Conditionals Value="if SrcOS<>'win' then
|
||||
UnitPath := 'nonwin32';"/>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<GenerateDebugInfo Value="True"/>
|
||||
<DebugInfoType Value="dsAuto"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
<Other>
|
||||
<Verbosity>
|
||||
<ShowNotes Value="False"/>
|
||||
@ -37,7 +31,7 @@
|
||||
<License Value="modified LGPL-2
|
||||
"/>
|
||||
<Version Major="1" Release="1"/>
|
||||
<Files Count="285">
|
||||
<Files Count="286">
|
||||
<Item1>
|
||||
<Filename Value="barchart.pp"/>
|
||||
<UnitName Value="BarChart"/>
|
||||
@ -1184,6 +1178,10 @@
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="ValEdit"/>
|
||||
</Item285>
|
||||
<Item286>
|
||||
<Filename Value="lazcanvas.pas"/>
|
||||
<UnitName Value="lazcanvas"/>
|
||||
</Item286>
|
||||
</Files>
|
||||
<LazDoc Paths="../docs/xml/lcl"/>
|
||||
<i18n>
|
||||
|
Loading…
Reference in New Issue
Block a user