paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-15 14:29:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

Adds WindowOrg support for lazcanvas and a upsidedown init for graphtype

Browse Source 
git-svn-id: trunk@33733 -
This commit is contained in:
sekelsenmat 2011-11-23 20:54:38 +00:00
parent 72ea67ba06
commit a485ecf313
2 changed files with 50 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
lcl/graphtype.pp
View File

@ -152,6 +152,7 @@ type
// Formats in RGB order
procedure Init_BPP24_R8G8B8_BIO_TTB(AWidth, AHeight: integer);
procedure Init_BPP24_R8G8B8_BIO_TTB_UpsideDown(AWidth, AHeight: integer);
// Formats in Windows pixels order: BGR
procedure Init_BPP24_B8G8R8_BIO_TTB(AWidth, AHeight: integer);
@ -597,6 +598,30 @@ begin
// MaskBitsPerPixel:=0;
end;
procedure TRawImageDescription.Init_BPP24_R8G8B8_BIO_TTB_UpsideDown(AWidth, AHeight: integer);
begin
// setup an artificial ScanLineImage with format RGB 24 bit, 24bit depth format
FillChar(Self, SizeOf(Self), 0);
Format := ricfRGBA;
Depth := 24; // used bits per pixel
Width := AWidth;
Height := AHeight;
BitOrder := riboBitsInOrder;
ByteOrder := riboLSBFirst;
LineOrder := riloBottomToTop;
BitsPerPixel := 24; // bits per pixel. can be greater than Depth.
LineEnd := rileDWordBoundary;
RedPrec := 8; // red precision. bits for red
RedShift := 0;
GreenPrec := 8;
GreenShift := 8; // bitshift. Direction: from least to most significant
BluePrec := 8;
BlueShift:=16;
// AlphaPrec:=0;
// MaskBitsPerPixel:=0;
end;
procedure TRawImageDescription.Init_BPP24_B8G8R8_BIO_TTB(AWidth, AHeight: integer);
{ pf24bit:

28
lcl/lazcanvas.pas
View File

@ -34,7 +34,7 @@ uses
// RTL
Classes, SysUtils,
// FCL-Image
fpimgcanv, fpcanvas, fpimage,
fpimgcanv, fpcanvas, fpimage, clipping,
// regions
lazregions;
@ -55,10 +55,14 @@ type
private
FAssignedBrush: TFPCustomBrush;
FAssignedPen: TFPCustomPen;
FBaseWindowOrg: TPoint;
FUseSimpleRectClipping: Boolean;
FLazClipRegion: TLazRegion;
FWindowOrg: TPoint; // already in absolute coords with BaseWindowOrg summed up
function GetAssignedBrush: TFPCustomBrush;
function GetAssignedPen: TFPCustomPen;
function GetWindowOrg: TPoint;
procedure SetWindowOrg(AValue: TPoint);
protected
procedure SetColor (x,y:integer; const AValue:TFPColor); override;
public
@ -72,7 +76,10 @@ type
property AssignedPen: TFPCustomPen read GetAssignedPen write FAssignedPen;
property AssignedBrush: TFPCustomBrush read GetAssignedBrush write FAssignedBrush;
//
// SetWindowOrg operations will be relative to BaseWindowOrg, useful for customdrawn wincontrols
property BaseWindowOrg: TPoint read FBaseWindowOrg write FBaseWindowOrg;
property UseSimpleRectClipping: Boolean read FUseSimpleRectClipping write FUseSimpleRectClipping;
property WindowOrg: TPoint read GetWindowOrg write SetWindowOrg;
end;
implementation
@ -95,9 +102,24 @@ begin
Result := FAssignedPen;
end;
procedure TLazCanvas.SetColor(x, y: integer; const AValue: TFPColor);
function TLazCanvas.GetWindowOrg: TPoint;
begin
inherited SetColor(x, y, AValue);
Result := Point(FWindowOrg.X-FBaseWindowOrg.X, FWindowOrg.Y-FBaseWindowOrg.Y)
end;
procedure TLazCanvas.SetWindowOrg(AValue: TPoint);
begin
FWindowOrg.X := AValue.X+FBaseWindowOrg.X;
FWindowOrg.Y := AValue.Y+FBaseWindowOrg.Y;
end;
procedure TLazCanvas.SetColor(x, y: integer; const AValue: TFPColor);
var
lx, ly: Integer;
begin
lx := x + FWindowOrg.X;
ly := y + FWindowOrg.Y;
inherited SetColor(lx, ly, AValue);
end;
constructor TLazCanvas.create(AnImage: TFPCustomImage);