paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-10 13:56:01 +02:00
Code Issues Packages Projects Releases Wiki Activity

added TLazIntfImage.TColors property

Browse Source 
git-svn-id: trunk@6076 -
This commit is contained in:
mattias 2004-09-27 10:01:18 +00:00
parent abacaa7cbf
commit 6ce2f93ba8
3 changed files with 47 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
lcl/graphics.pp
View File

@ -1096,6 +1096,7 @@ type
ReaderClass: TFPCustomImageReaderClass); virtual;
procedure WriteNativeStream(Stream: TStream; WriteSize: Boolean;
SaveStreamType: TBitmapNativeType); virtual;
function CreateIntfImage: TLazIntfImage;
{$ENDIF}
public
property Canvas: TCanvas read GetCanvas write FCanvas;
@ -1213,6 +1214,10 @@ Function Blue(rgb: TColor): BYTE;
Function Green(rgb: TColor): BYTE;
Function Red(rgb: TColor): BYTE;
procedure RedGreenBlue(rgb: TColor; var Red, Green, Blue: Byte);
{$IFNDEF DisableFPImage}
function FPColorToTColor(const FPColor: TFPColor): TColor;
function TColorToFPColor(const c: TColor): TFPColor;
{$ENDIF}
// fonts
procedure GetCharsetValues(Proc: TGetStrProc);
@ -1527,6 +1532,23 @@ begin
Blue := (rgb shr 16) and $000000ff;
end;
function FPColorToTColor(const FPColor: TFPColor): TColor;
begin
Result:=((FPColor.Red shr 8) and $ff)
or (FPColor.Green and $ff00)
or ((FPColor.Blue shl 8) and $ff0000);
end;
function TColorToFPColor(const c: TColor): TFPColor;
begin
Result.Red:=(c and $ff);
Result.Red:=Result.Red+(Result.Red shl 8);
Result.Green:=(c and $ff00);
Result.Green:=Result.Green+(Result.Green shr 8);
Result.Blue:=(c and $ff0000) shr 8;
Result.Blue:=Result.Blue+(Result.Blue shr 8);
Result.Alpha:=FPImage.alphaOpaque;
end;
{$I graphicsobject.inc}
{$I graphic.inc}
@ -1752,6 +1774,9 @@ end.
{ =============================================================================
$Log$
Revision 1.155 2004/09/27 10:01:18 mattias
added TLazIntfImage.TColors property
Revision 1.154 2004/09/24 21:34:14 micha
convert LM_CREATE message to interface methods
remove SendMsgToInterface, CNSendMessage and related methods

9
lcl/include/bitmap.inc
View File

@ -1178,6 +1178,12 @@ begin
if (FImage.SaveStream<>nil) and (FImage.SaveStreamType=bnNone) then
FImage.SaveStreamType:=SaveStreamType;
end;
function TBitmap.CreateIntfImage: TLazIntfImage;
begin
Result:=TLazIntfImage.Create(0,0);
Result.LoadFromBitmap(Handle,MaskHandle);
end;
{$ENDIF}
function TBitmap.GetEmpty: boolean;
@ -1240,6 +1246,9 @@ end;
{ =============================================================================
$Log$
Revision 1.91 2004/09/27 10:01:18 mattias
added TLazIntfImage.TColors property
Revision 1.90 2004/09/24 10:23:49 mattias
fixed 1.0.10 compilation

13
lcl/intfgraphics.pas
View File

@ -127,7 +127,9 @@ type
FWriteRawImageBits: TOnWriteRawImageBits;
FAlphaReadRawImageBits: TOnReadRawImageBits;
FAlphaWriteRawImageBits: TOnWriteRawImageBits;
function GetTColors(x, y: integer): TGraphicsColor;
procedure SetAutoCreateMask(const AValue: boolean);
procedure SetTColors(x, y: integer; const AValue: TGraphicsColor);
protected
OnGetInternalColor: TOnGetLazIntfImagePixel;
OnSetInternalColor: TOnSetLazIntfImagePixel;
@ -195,6 +197,7 @@ type
property DataDescription: TRawImageDescription read FDataDescription
write SetDataDescription;
property AutoCreateMask: boolean read FAutoCreateMask write SetAutoCreateMask;
property TColors[x,y: integer]: TGraphicsColor read GetTColors write SetTColors;
end;
@ -1433,6 +1436,16 @@ begin
FreeMaskData;
end;
function TLazIntfImage.GetTColors(x, y: integer): TGraphicsColor;
begin
Result:=FPColorToTColor(Colors[x,y]);
end;
procedure TLazIntfImage.SetTColors(x, y: integer; const AValue: TGraphicsColor);
begin
Colors[x,y]:=TColorToFPColor(AValue);
end;
procedure TLazIntfImage.SetUsePalette(Value: boolean);
begin
inherited SetUsePalette(False); // Can't handle palettes at the moment