mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-31 09:32:00 +01:00 
			
		
		
		
	* Bugfixes for RegisterBGIFont which can be called BEFORE
InitGraph.
This commit is contained in:
		
							parent
							
								
									3fa1d1b644
								
							
						
					
					
						commit
						b0bdd46ee1
					
				| @ -605,6 +605,9 @@ procedure SetFillPattern(Pattern: FillPatternType; Color: word); | |||||||
|  procedure MoveRel(Dx, Dy: Integer); |  procedure MoveRel(Dx, Dy: Integer); | ||||||
|  procedure MoveTo(X,Y: Integer); |  procedure MoveTo(X,Y: Integer); | ||||||
| 
 | 
 | ||||||
|  |  procedure SetDirectVideo(DirectAccess: boolean); | ||||||
|  |  function GetDirectVideo: boolean; | ||||||
|  | 
 | ||||||
|  { -------------------- Color/Palette ------------------------------- } |  { -------------------- Color/Palette ------------------------------- } | ||||||
|  procedure SetBkColor(ColorNum: Word); |  procedure SetBkColor(ColorNum: Word); | ||||||
|  function  GetColor: Word; |  function  GetColor: Word; | ||||||
| @ -757,6 +760,7 @@ var | |||||||
|   DriverName: String; |   DriverName: String; | ||||||
|   DirectColor : Boolean ; { Is it a direct color mode? } |   DirectColor : Boolean ; { Is it a direct color mode? } | ||||||
|   ModeList : PModeInfo; |   ModeList : PModeInfo; | ||||||
|  |   DirectVideo : Boolean;  { Direct access to video memory? } | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| @ -1909,12 +1913,7 @@ end; | |||||||
|   { overridable routines.                                  } |   { overridable routines.                                  } | ||||||
|   {********************************************************} |   {********************************************************} | ||||||
|    Begin |    Begin | ||||||
|     InstalledFonts := 0; |     DirectVideo := TRUE;  { By default use fastest access possible } | ||||||
|     { Install standard fonts } |  | ||||||
|     InstallUserFont('TRIP'); |  | ||||||
|     InstallUserFont('LITT'); |  | ||||||
|     InstallUserFont('SANS'); |  | ||||||
|     InstallUserFont('GOTH'); |  | ||||||
|     ArcCall.X := 0; |     ArcCall.X := 0; | ||||||
|     ArcCall.Y := 0; |     ArcCall.Y := 0; | ||||||
|     ArcCall.XStart := 0; |     ArcCall.XStart := 0; | ||||||
| @ -2572,6 +2571,18 @@ end; | |||||||
|   end; |   end; | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
|  |  procedure SetDirectVideo(DirectAccess: boolean); | ||||||
|  |   begin | ||||||
|  |     DirectVideo := DirectAccess; | ||||||
|  |   end; | ||||||
|  | 
 | ||||||
|  |  function GetDirectVideo: boolean; | ||||||
|  |   begin | ||||||
|  |     GetDirectVideo := DirectVideo; | ||||||
|  |   end; | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
| var | var | ||||||
|  ExitSave: pointer; |  ExitSave: pointer; | ||||||
| 
 | 
 | ||||||
| @ -2582,6 +2593,13 @@ begin | |||||||
|  { This must be called at startup... because GetGraphMode may } |  { This must be called at startup... because GetGraphMode may } | ||||||
|  { be called even when not in graph mode.                     } |  { be called even when not in graph mode.                     } | ||||||
|  QueryAdapterInfo; |  QueryAdapterInfo; | ||||||
|  |  { Install standard fonts } | ||||||
|  |  { This is done BEFORE startup... } | ||||||
|  |  InstalledFonts := 0; | ||||||
|  |  InstallUserFont('TRIP'); | ||||||
|  |  InstallUserFont('LITT'); | ||||||
|  |  InstallUserFont('SANS'); | ||||||
|  |  InstallUserFont('GOTH'); | ||||||
|  { This installs an exit procedure which cleans up the mode list...} |  { This installs an exit procedure which cleans up the mode list...} | ||||||
|  ExitSave := ExitProc; |  ExitSave := ExitProc; | ||||||
|  ExitProc := @CleanMode; |  ExitProc := @CleanMode; | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user
	 carl
						carl