paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-28 22:40:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

Amiga: 32 bit set color functions for OS 1.x

Browse Source
This commit is contained in:
Marcus Sackrow 2023-01-02 19:51:20 +01:00
parent cd8aa3f0e0
commit aced88e43c
1 changed files with 36 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
packages/amunits/src/coreunits/agraphics.pas
View File

@ -2572,6 +2572,9 @@ procedure SetABPenDrMd(Rp: PRastPort; APen, BPen, Drawmode: LongWord); inline;
function AllocBitMap(SizeX, SizeY, Depth, Flags: LongWord; friend_bitmap: PBitMap): PBitMap; function AllocBitMap(SizeX, SizeY, Depth, Flags: LongWord; friend_bitmap: PBitMap): PBitMap;
procedure FreeBitMap(Bm: PBitMap); procedure FreeBitMap(Bm: PBitMap);
function GetBitMapAttr(Bm: PBitMap; AttrNum: LongWord): LongWord; function GetBitMapAttr(Bm: PBitMap; AttrNum: LongWord): LongWord;
procedure SetRGB32(Vp: PViewPort; n: LongWord; r, g, b: LongWord); inline;
procedure SetRGB32CM(Cm: PColorMap; n, r, g, b: LongWord); inline;
procedure LoadRGB32(Vp: PViewPort ;const table: PLongWord);
{$endif} {$endif}
@ -2640,6 +2643,39 @@ begin
GetBitMapAttr := 0; GetBitMapAttr := 0;
end; end;
end; end;
procedure SetRGB32(Vp: PViewPort; n: LongWord; r, g, b: LongWord); inline;
begin
SetRGB4(Vp, n, r shr 28, g shr 28, b shr 28);
end;
procedure SetRGB32CM(Cm: PColorMap; n, r, g, b: LongWord); inline;
begin
SetRGB4CM(Cm, n, r shr 28, g shr 28, b shr 28);
end;
procedure LoadRGB32(Vp: PViewPort; const Table: PLongWord);
var
Num: LongWord;
R: PLongWord;
Red, Green, Blue: LongWord;
i: Integer;
begin
R := Table;
Num := (R^) shr 16;
Inc(R);
//
for i := 0 to Num - 1 do
begin
Red := R^;
Inc(R);
Green := R^;
Inc(R);
Blue := R^;
Inc(R);
SetRGB32(Vp, i, Red, Green, Blue);
end;
end;
{$endif} {$endif}
{$if not defined(AMIGA_V1_2_ONLY)} {$if not defined(AMIGA_V1_2_ONLY)}