mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 07:46:00 +02:00
--- Merging r47236 into '.':
U packages/ptc/src/ptcwrapper/ptcwrapper.pp --- Recording mergeinfo for merge of r47236 into '.': U . --- Merging r47458 into '.': U packages/graph/src/ptcgraph/ptcgraph.pp --- Recording mergeinfo for merge of r47458 into '.': G . # revisions: 47236,47458 r47236 | michael | 2020-10-28 15:12:28 +0100 (Wed, 28 Oct 2020) | 1 line Changed paths: M /trunk/packages/ptc/src/ptcwrapper/ptcwrapper.pp * Fix bug #38003, small memleak r47458 | nickysn | 2020-11-19 18:59:21 +0100 (Thu, 19 Nov 2020) | 3 lines Changed paths: M /trunk/packages/graph/src/ptcgraph/ptcgraph.pp + added function InstallUserMode to ptcgraph, that allows you to register a custom resolution and thus, open a custom window size git-svn-id: branches/fixes_3_2@47648 -
This commit is contained in:
parent
9ee089112c
commit
4791d2e0ff
@ -139,6 +139,8 @@ var
|
|||||||
WindowTitle: AnsiString;
|
WindowTitle: AnsiString;
|
||||||
PTCWrapperObject: TPTCWrapperThread;
|
PTCWrapperObject: TPTCWrapperThread;
|
||||||
|
|
||||||
|
function InstallUserMode(Width, Height: SmallInt; Colors: LongInt; HardwarePages: SmallInt; XAspect, YAspect: Word): smallint;
|
||||||
|
|
||||||
{******************************************************************************}
|
{******************************************************************************}
|
||||||
implementation
|
implementation
|
||||||
{******************************************************************************}
|
{******************************************************************************}
|
||||||
@ -156,6 +158,7 @@ var
|
|||||||
VesaInfo: record { dummy, for compatibility with graph.inc under go32v2 }
|
VesaInfo: record { dummy, for compatibility with graph.inc under go32v2 }
|
||||||
ModeList: PInteger;
|
ModeList: PInteger;
|
||||||
end;
|
end;
|
||||||
|
NextNonStandardModeNumber: LongInt;
|
||||||
|
|
||||||
{$i graph.inc}
|
{$i graph.inc}
|
||||||
|
|
||||||
@ -2442,6 +2445,106 @@ end;
|
|||||||
isgraphmode := false;
|
isgraphmode := false;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure FillCommonVESA16(var mode: TModeInfo);
|
||||||
|
begin
|
||||||
|
mode.HardwarePages := 1;
|
||||||
|
mode.MaxColor := 16;
|
||||||
|
mode.PaletteSize := mode.MaxColor;
|
||||||
|
mode.DirectColor := FALSE;
|
||||||
|
mode.DirectPutPixel := @ptc_DirectPixelProc_8bpp;
|
||||||
|
mode.PutPixel := @ptc_PutPixelProc_8bpp;
|
||||||
|
mode.GetPixel := @ptc_GetPixelProc_8bpp;
|
||||||
|
mode.PutImage := @ptc_PutImageProc_8bpp;
|
||||||
|
mode.GetImage := @ptc_GetImageProc_8bpp;
|
||||||
|
mode.GetScanLine := @ptc_GetScanLineProc_8bpp;
|
||||||
|
mode.SetRGBPalette := @ptc_SetRGBPaletteProc;
|
||||||
|
mode.GetRGBPalette := @ptc_GetRGBPaletteProc;
|
||||||
|
mode.HLine := @ptc_HLineProc_8bpp;
|
||||||
|
mode.VLine := @ptc_VLineProc_8bpp;
|
||||||
|
mode.PatternLine := @ptc_PatternLineProc_8bpp;
|
||||||
|
mode.SetVisualPage := @ptc_SetVisualPage;
|
||||||
|
mode.SetActivePage := @ptc_SetActivePage;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure FillCommonVESA256(var mode: TModeInfo);
|
||||||
|
begin
|
||||||
|
mode.HardwarePages := 1;
|
||||||
|
mode.MaxColor := 256;
|
||||||
|
mode.PaletteSize := mode.MaxColor;
|
||||||
|
mode.DirectColor := FALSE;
|
||||||
|
mode.DirectPutPixel := @ptc_DirectPixelProc_8bpp;
|
||||||
|
mode.PutPixel := @ptc_PutPixelProc_8bpp;
|
||||||
|
mode.GetPixel := @ptc_GetPixelProc_8bpp;
|
||||||
|
mode.PutImage := @ptc_PutImageProc_8bpp;
|
||||||
|
mode.GetImage := @ptc_GetImageProc_8bpp;
|
||||||
|
mode.GetScanLine := @ptc_GetScanLineProc_8bpp;
|
||||||
|
mode.SetRGBPalette := @ptc_SetRGBPaletteProc;
|
||||||
|
mode.GetRGBPalette := @ptc_GetRGBPaletteProc;
|
||||||
|
//mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
|
||||||
|
mode.HLine := @ptc_HLineProc_8bpp;
|
||||||
|
mode.VLine := @ptc_VLineProc_8bpp;
|
||||||
|
mode.PatternLine := @ptc_PatternLineProc_8bpp;
|
||||||
|
mode.SetVisualPage := @ptc_SetVisualPage;
|
||||||
|
mode.SetActivePage := @ptc_SetActivePage;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure FillCommonVESA32kOr64k(var mode: TModeInfo);
|
||||||
|
begin
|
||||||
|
mode.HardwarePages := 1;
|
||||||
|
mode.DirectColor := TRUE;
|
||||||
|
mode.DirectPutPixel := @ptc_DirectPixelProc_16bpp;
|
||||||
|
mode.PutPixel := @ptc_PutPixelProc_16bpp;
|
||||||
|
mode.GetPixel := @ptc_GetPixelProc_16bpp;
|
||||||
|
mode.PutImage := @ptc_PutImageProc_16bpp;
|
||||||
|
mode.GetImage := @ptc_GetImageProc_16bpp;
|
||||||
|
mode.GetScanLine := @ptc_GetScanLineProc_16bpp;
|
||||||
|
mode.SetRGBPalette := @ptc_SetRGBPaletteProc;
|
||||||
|
mode.GetRGBPalette := @ptc_GetRGBPaletteProc;
|
||||||
|
//mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
|
||||||
|
mode.HLine := @ptc_HLineProc_16bpp;
|
||||||
|
mode.VLine := @ptc_VLineProc_16bpp;
|
||||||
|
mode.PatternLine := @ptc_PatternLineProc_16bpp;
|
||||||
|
mode.SetVisualPage := @ptc_SetVisualPage;
|
||||||
|
mode.SetActivePage := @ptc_SetActivePage;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure FillCommonVESA32k(var mode: TModeInfo);
|
||||||
|
begin
|
||||||
|
FillCommonVESA32kOr64k(mode);
|
||||||
|
mode.MaxColor := 32768;
|
||||||
|
mode.PaletteSize := mode.MaxColor;
|
||||||
|
end;
|
||||||
|
procedure FillCommonVESA64k(var mode: TModeInfo);
|
||||||
|
begin
|
||||||
|
FillCommonVESA32kOr64k(mode);
|
||||||
|
mode.MaxColor := 65536;
|
||||||
|
mode.PaletteSize := mode.MaxColor;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$ifdef FPC_GRAPH_SUPPORTS_TRUECOLOR}
|
||||||
|
procedure FillCommonVESA32bpp(var mode: TModeInfo);
|
||||||
|
begin
|
||||||
|
mode.HardwarePages := 1;
|
||||||
|
mode.MaxColor := 16777216;
|
||||||
|
mode.PaletteSize := mode.MaxColor;
|
||||||
|
mode.DirectColor := TRUE;
|
||||||
|
mode.DirectPutPixel := @ptc_DirectPixelProc_32bpp;
|
||||||
|
mode.PutPixel := @ptc_PutPixelProc_32bpp;
|
||||||
|
mode.GetPixel := @ptc_GetPixelProc_32bpp;
|
||||||
|
mode.PutImage := @ptc_PutImageProc_32bpp;
|
||||||
|
mode.GetImage := @ptc_GetImageProc_32bpp;
|
||||||
|
mode.GetScanLine := @ptc_GetScanLineProc_32bpp;
|
||||||
|
mode.SetRGBPalette := @ptc_SetRGBPaletteProc;
|
||||||
|
mode.GetRGBPalette := @ptc_GetRGBPaletteProc;
|
||||||
|
//mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
|
||||||
|
mode.HLine := @ptc_HLineProc_32bpp;
|
||||||
|
mode.VLine := @ptc_VLineProc_32bpp;
|
||||||
|
mode.PatternLine := @ptc_PatternLineProc_32bpp;
|
||||||
|
mode.SetVisualPage := @ptc_SetVisualPage;
|
||||||
|
mode.SetActivePage := @ptc_SetActivePage;
|
||||||
|
end;
|
||||||
|
{$endif FPC_GRAPH_SUPPORTS_TRUECOLOR}
|
||||||
|
|
||||||
function QueryAdapterInfo:PModeInfo;
|
function QueryAdapterInfo:PModeInfo;
|
||||||
{ This routine returns the head pointer to the list }
|
{ This routine returns the head pointer to the list }
|
||||||
{ of supported graphics modes. }
|
{ of supported graphics modes. }
|
||||||
@ -2628,106 +2731,6 @@ end;
|
|||||||
mode.SetActivePage := @ptc_SetActivePage;
|
mode.SetActivePage := @ptc_SetActivePage;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure FillCommonVESA16(var mode: TModeInfo);
|
|
||||||
begin
|
|
||||||
mode.HardwarePages := 1;
|
|
||||||
mode.MaxColor := 16;
|
|
||||||
mode.PaletteSize := mode.MaxColor;
|
|
||||||
mode.DirectColor := FALSE;
|
|
||||||
mode.DirectPutPixel := @ptc_DirectPixelProc_8bpp;
|
|
||||||
mode.PutPixel := @ptc_PutPixelProc_8bpp;
|
|
||||||
mode.GetPixel := @ptc_GetPixelProc_8bpp;
|
|
||||||
mode.PutImage := @ptc_PutImageProc_8bpp;
|
|
||||||
mode.GetImage := @ptc_GetImageProc_8bpp;
|
|
||||||
mode.GetScanLine := @ptc_GetScanLineProc_8bpp;
|
|
||||||
mode.SetRGBPalette := @ptc_SetRGBPaletteProc;
|
|
||||||
mode.GetRGBPalette := @ptc_GetRGBPaletteProc;
|
|
||||||
mode.HLine := @ptc_HLineProc_8bpp;
|
|
||||||
mode.VLine := @ptc_VLineProc_8bpp;
|
|
||||||
mode.PatternLine := @ptc_PatternLineProc_8bpp;
|
|
||||||
mode.SetVisualPage := @ptc_SetVisualPage;
|
|
||||||
mode.SetActivePage := @ptc_SetActivePage;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure FillCommonVESA256(var mode: TModeInfo);
|
|
||||||
begin
|
|
||||||
mode.HardwarePages := 1;
|
|
||||||
mode.MaxColor := 256;
|
|
||||||
mode.PaletteSize := mode.MaxColor;
|
|
||||||
mode.DirectColor := FALSE;
|
|
||||||
mode.DirectPutPixel := @ptc_DirectPixelProc_8bpp;
|
|
||||||
mode.PutPixel := @ptc_PutPixelProc_8bpp;
|
|
||||||
mode.GetPixel := @ptc_GetPixelProc_8bpp;
|
|
||||||
mode.PutImage := @ptc_PutImageProc_8bpp;
|
|
||||||
mode.GetImage := @ptc_GetImageProc_8bpp;
|
|
||||||
mode.GetScanLine := @ptc_GetScanLineProc_8bpp;
|
|
||||||
mode.SetRGBPalette := @ptc_SetRGBPaletteProc;
|
|
||||||
mode.GetRGBPalette := @ptc_GetRGBPaletteProc;
|
|
||||||
//mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
|
|
||||||
mode.HLine := @ptc_HLineProc_8bpp;
|
|
||||||
mode.VLine := @ptc_VLineProc_8bpp;
|
|
||||||
mode.PatternLine := @ptc_PatternLineProc_8bpp;
|
|
||||||
mode.SetVisualPage := @ptc_SetVisualPage;
|
|
||||||
mode.SetActivePage := @ptc_SetActivePage;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure FillCommonVESA32kOr64k(var mode: TModeInfo);
|
|
||||||
begin
|
|
||||||
mode.HardwarePages := 1;
|
|
||||||
mode.DirectColor := TRUE;
|
|
||||||
mode.DirectPutPixel := @ptc_DirectPixelProc_16bpp;
|
|
||||||
mode.PutPixel := @ptc_PutPixelProc_16bpp;
|
|
||||||
mode.GetPixel := @ptc_GetPixelProc_16bpp;
|
|
||||||
mode.PutImage := @ptc_PutImageProc_16bpp;
|
|
||||||
mode.GetImage := @ptc_GetImageProc_16bpp;
|
|
||||||
mode.GetScanLine := @ptc_GetScanLineProc_16bpp;
|
|
||||||
mode.SetRGBPalette := @ptc_SetRGBPaletteProc;
|
|
||||||
mode.GetRGBPalette := @ptc_GetRGBPaletteProc;
|
|
||||||
//mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
|
|
||||||
mode.HLine := @ptc_HLineProc_16bpp;
|
|
||||||
mode.VLine := @ptc_VLineProc_16bpp;
|
|
||||||
mode.PatternLine := @ptc_PatternLineProc_16bpp;
|
|
||||||
mode.SetVisualPage := @ptc_SetVisualPage;
|
|
||||||
mode.SetActivePage := @ptc_SetActivePage;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure FillCommonVESA32k(var mode: TModeInfo);
|
|
||||||
begin
|
|
||||||
FillCommonVESA32kOr64k(mode);
|
|
||||||
mode.MaxColor := 32768;
|
|
||||||
mode.PaletteSize := mode.MaxColor;
|
|
||||||
end;
|
|
||||||
procedure FillCommonVESA64k(var mode: TModeInfo);
|
|
||||||
begin
|
|
||||||
FillCommonVESA32kOr64k(mode);
|
|
||||||
mode.MaxColor := 65536;
|
|
||||||
mode.PaletteSize := mode.MaxColor;
|
|
||||||
end;
|
|
||||||
|
|
||||||
{$ifdef FPC_GRAPH_SUPPORTS_TRUECOLOR}
|
|
||||||
procedure FillCommonVESA32bpp(var mode: TModeInfo);
|
|
||||||
begin
|
|
||||||
mode.HardwarePages := 1;
|
|
||||||
mode.MaxColor := 16777216;
|
|
||||||
mode.PaletteSize := mode.MaxColor;
|
|
||||||
mode.DirectColor := TRUE;
|
|
||||||
mode.DirectPutPixel := @ptc_DirectPixelProc_32bpp;
|
|
||||||
mode.PutPixel := @ptc_PutPixelProc_32bpp;
|
|
||||||
mode.GetPixel := @ptc_GetPixelProc_32bpp;
|
|
||||||
mode.PutImage := @ptc_PutImageProc_32bpp;
|
|
||||||
mode.GetImage := @ptc_GetImageProc_32bpp;
|
|
||||||
mode.GetScanLine := @ptc_GetScanLineProc_32bpp;
|
|
||||||
mode.SetRGBPalette := @ptc_SetRGBPaletteProc;
|
|
||||||
mode.GetRGBPalette := @ptc_GetRGBPaletteProc;
|
|
||||||
//mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
|
|
||||||
mode.HLine := @ptc_HLineProc_32bpp;
|
|
||||||
mode.VLine := @ptc_VLineProc_32bpp;
|
|
||||||
mode.PatternLine := @ptc_PatternLineProc_32bpp;
|
|
||||||
mode.SetVisualPage := @ptc_SetVisualPage;
|
|
||||||
mode.SetActivePage := @ptc_SetActivePage;
|
|
||||||
end;
|
|
||||||
{$endif FPC_GRAPH_SUPPORTS_TRUECOLOR}
|
|
||||||
|
|
||||||
procedure FillCommonVESA320x200(var mode: TModeInfo);
|
procedure FillCommonVESA320x200(var mode: TModeInfo);
|
||||||
begin
|
begin
|
||||||
mode.DriverNumber := VESA;
|
mode.DriverNumber := VESA;
|
||||||
@ -2777,7 +2780,6 @@ end;
|
|||||||
var
|
var
|
||||||
graphmode:Tmodeinfo;
|
graphmode:Tmodeinfo;
|
||||||
I: Integer;
|
I: Integer;
|
||||||
NextNonStandardModeNumber: SmallInt;
|
|
||||||
begin
|
begin
|
||||||
QueryAdapterInfo := ModeList;
|
QueryAdapterInfo := ModeList;
|
||||||
{ If the mode listing already exists... }
|
{ If the mode listing already exists... }
|
||||||
@ -3451,6 +3453,74 @@ end;
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function InstallUserMode(Width, Height: SmallInt; Colors: LongInt; HardwarePages: SmallInt; XAspect, YAspect: Word): smallint;
|
||||||
|
var
|
||||||
|
graphmode: Tmodeinfo;
|
||||||
|
begin
|
||||||
|
if (NextNonStandardModeNumber > NonStandardModeNumberMaxLimit) or (HardwarePages < 1) or
|
||||||
|
(Width <= 0) or (Height <= 0) or (XAspect <= 0) or (YAspect <= 0) then
|
||||||
|
begin
|
||||||
|
InstallUserMode := grError;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
InitMode(graphmode);
|
||||||
|
case Colors of
|
||||||
|
{ 2:
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
4:
|
||||||
|
begin
|
||||||
|
end;}
|
||||||
|
16:
|
||||||
|
begin
|
||||||
|
FillCommonVESA16(graphmode);
|
||||||
|
graphmode.InitMode := @ptc_InitNonStandard16;
|
||||||
|
end;
|
||||||
|
256:
|
||||||
|
begin
|
||||||
|
FillCommonVESA256(graphmode);
|
||||||
|
graphmode.InitMode := @ptc_InitNonStandard256;
|
||||||
|
end;
|
||||||
|
32768:
|
||||||
|
begin
|
||||||
|
FillCommonVESA32k(graphmode);
|
||||||
|
graphmode.InitMode := @ptc_InitNonStandard32k;
|
||||||
|
end;
|
||||||
|
65536:
|
||||||
|
begin
|
||||||
|
FillCommonVESA64k(graphmode);
|
||||||
|
graphmode.InitMode := @ptc_InitNonStandard64k;
|
||||||
|
end;
|
||||||
|
{$ifdef FPC_GRAPH_SUPPORTS_TRUECOLOR}
|
||||||
|
16777216:
|
||||||
|
begin
|
||||||
|
FillCommonVESA32bpp(graphmode);
|
||||||
|
graphmode.InitMode := @ptc_InitNonStandard32bpp;
|
||||||
|
end;
|
||||||
|
{$endif FPC_GRAPH_SUPPORTS_TRUECOLOR}
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
InstallUserMode := grError;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
with graphmode do
|
||||||
|
begin
|
||||||
|
ModeNumber := NextNonStandardModeNumber;
|
||||||
|
DriverNumber := VESA;
|
||||||
|
WriteStr(ModeName, Width, ' x ', Height, ' VESA');
|
||||||
|
MaxX := Width - 1;
|
||||||
|
MaxY := Height - 1;
|
||||||
|
HardwarePages := 1;
|
||||||
|
end;
|
||||||
|
graphmode.XAspect := XAspect;
|
||||||
|
graphmode.YAspect := YAspect;
|
||||||
|
graphmode.HardwarePages := HardwarePages - 1;
|
||||||
|
AddMode(graphmode);
|
||||||
|
Inc(NextNonStandardModeNumber);
|
||||||
|
InstallUserMode := graphmode.ModeNumber;
|
||||||
|
end;
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
WindowTitle := ParamStr(0);
|
WindowTitle := ParamStr(0);
|
||||||
PTCFormat8 := TPTCFormatFactory.CreateNew(8);
|
PTCFormat8 := TPTCFormatFactory.CreateNew(8);
|
||||||
|
@ -179,6 +179,7 @@ end;
|
|||||||
|
|
||||||
destructor TPTCWrapperThread.Destroy;
|
destructor TPTCWrapperThread.Destroy;
|
||||||
begin
|
begin
|
||||||
|
FreeAndNil(FSurfaceCriticalSection);
|
||||||
inherited;
|
inherited;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user