paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-12 09:29:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

* PutImage used an integer index that became negative !!!!

Browse Source 
* Default needed procedure now genrate a RTE 218 instead of a
    GPF by call to nil pointer !
This commit is contained in:
pierre 1999-11-24 23:42:31 +00:00
parent c29072c681
commit 2719fb91e8
1 changed files with 52 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
rtl/inc/graph/graph.pp
View File

@ -1955,13 +1955,13 @@ end;
Procedure DefaultPutImage(X,Y: Integer; var Bitmap; BitBlt: Word); {$ifndef fpc}far;{$endif fpc} Procedure DefaultPutImage(X,Y: Integer; var Bitmap; BitBlt: Word); {$ifndef fpc}far;{$endif fpc}
type type
pt = array[0..32000] of word; pt = array[0..$fffffff] of word;
ptw = array[0..3] of longint; ptw = array[0..3] of longint;
var var
color: word; color: word;
i,j: Integer; i,j: Integer;
Y1,X1: Integer; Y1,X1: Integer;
k: integer; k: longint;
Begin Begin
X1:= ptw(Bitmap)[0]+X; { get width and adjust end coordinate accordingly } X1:= ptw(Bitmap)[0]+X; { get width and adjust end coordinate accordingly }
Y1:= ptw(Bitmap)[1]+Y; { get height and adjust end coordinate accordingly } Y1:= ptw(Bitmap)[1]+Y; { get height and adjust end coordinate accordingly }
@ -1990,7 +1990,7 @@ end;
Procedure DefaultGetImage(X1,Y1,X2,Y2: Integer; Var Bitmap); {$ifndef fpc}far;{$endif fpc} Procedure DefaultGetImage(X1,Y1,X2,Y2: Integer; Var Bitmap); {$ifndef fpc}far;{$endif fpc}
type type
pt = array[0..32000] of word; pt = array[0..$fffffff] of word;
ptw = array[0..3] of longint; ptw = array[0..3] of longint;
var var
i,j: integer; i,j: integer;
@ -2039,6 +2039,33 @@ end;
begin begin
end; end;
procedure DirectPutPixelDefault(X,Y: Integer);
begin
RunError(218);
end;
function GetPixelDefault(X,Y: Integer): word;
begin
RunError(218);
exit(0); { avoid warning }
end;
procedure PutPixelDefault(X,Y: Integer; Color: Word);
begin
RunError(218);
end;
procedure SetRGBPaletteDefault(ColorNum, RedValue, GreenValue, BlueValue: Integer);
begin
RunError(218);
end;
procedure GetRGBPaletteDefault(ColorNum: integer; var
RedValue, GreenValue, BlueValue: Integer);
begin
RunError(218);
end;
Procedure DefaultHooks; Procedure DefaultHooks;
{********************************************************} {********************************************************}
@ -2051,15 +2078,16 @@ end;
Begin Begin
{ All default hooks procedures } { All default hooks procedures }
{$ifdef fpc}
{ required...} { required...}
DirectPutPixel := nil; DirectPutPixel := @DirectPutPixelDefault;
PutPixel := nil; PutPixel := @PutPixelDefault;
GetPixel := nil; GetPixel := @GetPixelDefault;
SetRGBPalette := nil; SetRGBPalette := @SetRGBPaletteDefault;
GetRGBPalette := nil; GetRGBPalette := @GetRGBPaletteDefault;
{ optional...} { optional...}
{$ifdef fpc}
SetActivePage := @SetActivePageDefault; SetActivePage := @SetActivePageDefault;
SetVisualPage := @SetVisualPageDefault; SetVisualPage := @SetVisualPageDefault;
ClearViewPort := @ClearViewportDefault; ClearViewPort := @ClearViewportDefault;
@ -2067,6 +2095,14 @@ end;
GetImage := @DefaultGetImage; GetImage := @DefaultGetImage;
ImageSize := @DefaultImageSize; ImageSize := @DefaultImageSize;
{$else fpc} {$else fpc}
{ required...}
DirectPutPixel := DirectPutPixelDefault;
PutPixel := PutPixelDefault;
GetPixel := GetPixelDefault;
SetRGBPalette := SetRGBPaletteDefault;
GetRGBPalette := GetRGBPaletteDefault;
{ optional...}
SetActivePage := SetActivePageDefault; SetActivePage := SetActivePageDefault;
SetVisualPage := SetVisualPageDefault; SetVisualPage := SetVisualPageDefault;
ClearViewPort := ClearViewportDefault; ClearViewPort := ClearViewportDefault;
@ -2966,7 +3002,12 @@ SetGraphBufSize
{ {
$Log$ $Log$
Revision 1.38 1999-11-11 17:55:07 florian Revision 1.39 1999-11-24 23:42:31 pierre
* PutImage used an integer index that became negative !!!!
* Default needed procedure now genrate a RTE 218 instead of a
GPF by call to nil pointer !
Revision 1.38 1999/11/11 17:55:07 florian
* the size was calculated wrong by imagesize * the size was calculated wrong by imagesize
Revision 1.37 1999/11/11 14:07:14 florian Revision 1.37 1999/11/11 14:07:14 florian