mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 18:09:27 +02:00
* adapt to new video unit layout
This commit is contained in:
pierre
parent
abc2e8bfd7
commit
22b8f0dd59
@ -688,8 +688,8 @@ type
|
||||
|
||||
function TVideoModeCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
|
||||
var R: Sw_integer;
|
||||
K1: PVideoModeList absolute Key1;
|
||||
K2: PVideoModeList absolute Key2;
|
||||
K1: PVideoMode absolute Key1;
|
||||
K2: PVideoMode absolute Key2;
|
||||
begin
|
||||
if K1^.Col<K2^.Col then R:=-1 else
|
||||
if K1^.Col>K2^.Col then R:= 1 else
|
||||
@ -703,44 +703,32 @@ end;
|
||||
|
||||
procedure TVideoModeCollection.FreeItem(Item: Pointer);
|
||||
begin
|
||||
{ don't do anything here }
|
||||
FreeMem(Item,sizeof(TVideoMode));
|
||||
end;
|
||||
|
||||
procedure TIDEApp.Preferences;
|
||||
function SearchVideoMode(Col,Row: word; Color: boolean): PVideoModeList;
|
||||
var I,P: PVideoModeList;
|
||||
begin
|
||||
I:=nil; P:=Video.Modes;
|
||||
while (I=nil) and (P<>nil) do
|
||||
begin
|
||||
if (P^.Col=Col) and (P^.Row=Row) and (P^.Color=Color) then
|
||||
I:=P
|
||||
else
|
||||
P:=P^.Next;
|
||||
end;
|
||||
SearchVideoMode:=I;
|
||||
end;
|
||||
var R,R2: TRect;
|
||||
D: PCenterDialog;
|
||||
C: PVideoModeCollection;
|
||||
VMLB: PVideoModeListBox;
|
||||
VP: PVideoModeList;
|
||||
VM: TVideoMode;
|
||||
CurVP,VP: PVideoMode;
|
||||
RB1: PPlainRadioButtons;
|
||||
CB1,CB2: PPlainCheckBoxes;
|
||||
CurM: PVideoModeList;
|
||||
CurIdx: integer;
|
||||
i : word;
|
||||
begin
|
||||
New(C, Init(10,50));
|
||||
VP:=Video.Modes; CurM:=nil;
|
||||
while VP<>nil do
|
||||
begin
|
||||
for i:=0 to GetVideoModeCount-1 do
|
||||
begin
|
||||
GetVideoModeData(i,VM);
|
||||
GetMem(VP,sizeof(TVideoMode));
|
||||
Move(VM,VP^,sizeof(TVideoMode));
|
||||
C^.Insert(VP);
|
||||
if (VP^.Row=ScreenMode.Row) and (VP^.Col=ScreenMode.Col) and
|
||||
(VP^.Color=ScreenMode.Color) then
|
||||
CurM:=VP;
|
||||
VP:=VP^.Next;
|
||||
end;
|
||||
if (VM.Row=ScreenMode.Row) and (VM.Col=ScreenMode.Col) and
|
||||
(VM.Color=ScreenMode.Color) then
|
||||
CurVP:=VP;
|
||||
end;
|
||||
R.Assign(0,0,64,15);
|
||||
New(D, Init(R, dialog_preferences));
|
||||
with D^ do
|
||||
@ -752,8 +740,8 @@ begin
|
||||
R.B.Y:=R.A.Y+3;
|
||||
R2.Copy(R); R2.Grow(-1,-1);
|
||||
New(VMLB, Init(R2, Min(4,C^.Count), C));
|
||||
if CurM=nil then CurIdx:=-1 else
|
||||
CurIdx:=C^.IndexOf(CurM);
|
||||
if CurVP=nil then CurIdx:=-1 else
|
||||
CurIdx:=C^.IndexOf(CurVP);
|
||||
if CurIdx<>-1 then
|
||||
VMLB^.FocusItem(CurIdx);
|
||||
Insert(New(PGroupView, Init(R, label_preferences_videomode, VMLB)));
|
||||
@ -801,7 +789,7 @@ begin
|
||||
begin
|
||||
if (C^.count>0) then
|
||||
begin
|
||||
with PVideoModeList(C^.At(VMLB^.Focused))^ do
|
||||
with PVideoMode(C^.At(VMLB^.Focused))^ do
|
||||
begin
|
||||
VM.Col:=Col;
|
||||
VM.Row:=Row;
|
||||
@ -1285,7 +1273,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2001-08-05 12:23:00 peter
|
||||
Revision 1.3 2001-10-11 11:35:53 pierre
|
||||
* adapt to new video unit layout
|
||||
|
||||
Revision 1.2 2001/08/05 12:23:00 peter
|
||||
* Automatically support for fvision or old fv
|
||||
|
||||
Revision 1.1 2001/08/04 11:30:23 peter
|
||||
|
||||
@ -3914,7 +3914,7 @@ end;
|
||||
{$endif FVISION}
|
||||
|
||||
function TVideoModeListBox.GetText(Item: pointer; MaxLen: sw_integer): string;
|
||||
var P: PVideoModeList;
|
||||
var P: PVideoMode;
|
||||
S: string;
|
||||
begin
|
||||
P:=Item;
|
||||
@ -4148,8 +4148,7 @@ begin
|
||||
if VESAGetModeInfo(ML.Modes[I],MI) then
|
||||
with MI do
|
||||
if (Attributes and vesa_vma_GraphicsMode)=0 then
|
||||
RegisterVideoMode(XResolution,YResolution,
|
||||
(Attributes and vesa_vma_ColorMode)<>0,{$ifdef FPC}@{$endif}VESASetVideoModeProc,ML.Modes[I]);
|
||||
RegisterVesaVideoMode(ML.Modes[I]);
|
||||
end;
|
||||
end;
|
||||
{$endif}
|
||||
@ -4181,7 +4180,10 @@ end;
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.7 2001-09-27 22:29:12 pierre
|
||||
Revision 1.8 2001-10-11 11:36:30 pierre
|
||||
* adapt to new video unit layout
|
||||
|
||||
Revision 1.7 2001/09/27 22:29:12 pierre
|
||||
* avoid to give the same core to all new files
|
||||
|
||||
Revision 1.6 2001/09/25 22:46:50 pierre
|
||||
|
||||
157
ide/vesa.pas
157
ide/vesa.pas
@ -125,10 +125,37 @@ function VESASetMode(Mode: word): boolean;
|
||||
function VESAGetMode(var Mode: word): boolean;
|
||||
function VESASelectMemoryWindow(Window: byte; Position: word): boolean;
|
||||
function VESAReturnMemoryWindow(Window: byte; var Position: word): boolean;
|
||||
function RegisterVesaVideoMode(Mode : word) : boolean;
|
||||
|
||||
implementation
|
||||
|
||||
uses pmode;
|
||||
uses
|
||||
{$ifdef FPC}
|
||||
video, mouse,
|
||||
{$endif FPC}
|
||||
pmode;
|
||||
|
||||
type
|
||||
|
||||
PVesaVideoMode = ^TVesaVideoMode;
|
||||
TVesaVideoMode = record
|
||||
{Col,Row : word;
|
||||
Color : boolean;}
|
||||
V : TVideoMode;
|
||||
Mode : word;
|
||||
{ zero based vesa specific driver count }
|
||||
VideoIndex : word;
|
||||
Next : PVesaVideoMode;
|
||||
end;
|
||||
|
||||
const
|
||||
VesaVideoModeHead : PVesaVideoMode = nil;
|
||||
VesaRegisteredModes : word = 0;
|
||||
Var
|
||||
SysGetVideoModeCount : function : word;
|
||||
SysSetVideoMode : function (Const VideoMode : TVideoMode) : boolean;
|
||||
SysGetVideoModeData : Function (Index : Word; Var Data : TVideoMode) : boolean;
|
||||
|
||||
|
||||
function VESAGetInfo(var B: TVESAInfoBlock): boolean;
|
||||
var r: registers;
|
||||
@ -210,6 +237,39 @@ begin
|
||||
VESAGetModeInfo:=OK;
|
||||
end;
|
||||
|
||||
function RegisterVesaVideoMode(Mode : word) : boolean;
|
||||
var B: TVESAModeInfoBlock;
|
||||
VH : PVesaVideoMode;
|
||||
DoAdd : boolean;
|
||||
begin
|
||||
if not VESAGetModeInfo(Mode,B) then
|
||||
RegisterVesaVideoMode:=false
|
||||
else
|
||||
begin
|
||||
VH:=VesaVideoModeHead;
|
||||
DoAdd:=true;
|
||||
RegisterVesaVideoMode:=false;
|
||||
while assigned(VH) do
|
||||
begin
|
||||
if VH^.mode=mode then
|
||||
DoAdd:=false;
|
||||
VH:=VH^.next;
|
||||
end;
|
||||
if DoAdd then
|
||||
begin
|
||||
New(VH);
|
||||
VH^.next:=VesaVideoModeHead;
|
||||
VH^.mode:=mode;
|
||||
VH^.v.color:=(B.Attributes and vesa_vma_ColorMode)<>0;
|
||||
VH^.v.col:=B.XResolution;
|
||||
VH^.v.row:=B.YResolution;
|
||||
VH^.VideoIndex:=VesaRegisteredModes;
|
||||
Inc(VesaRegisteredModes);
|
||||
RegisterVesaVideoMode:=true;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function VESASetMode(Mode: word): boolean;
|
||||
var r: registers;
|
||||
OK: boolean;
|
||||
@ -257,14 +317,107 @@ var OK: boolean;
|
||||
VI: TVESAInfoBlock;
|
||||
begin
|
||||
OK:=VESAGetInfo(VI);
|
||||
if OK then
|
||||
|
||||
VESAInit:=OK;
|
||||
end;
|
||||
|
||||
{$ifdef FPC}
|
||||
Function VesaGetVideoModeData (Index : Word; Var Data : TVideoMode) : boolean;
|
||||
Var
|
||||
PrevCount : word;
|
||||
VH : PVesaVideoMode;
|
||||
|
||||
begin
|
||||
PrevCount:=SysGetVideoModeCount();
|
||||
VesaGetVideoModeData:=(Index<PrevCount);
|
||||
If VesaGetVideoModeData then
|
||||
begin
|
||||
VesaGetVideoModeData:=SysGetVideoModeData(Index,Data);
|
||||
exit;
|
||||
end;
|
||||
VesaGetVideoModeData:=(Index-PrevCount)<VesaRegisteredModes;
|
||||
If VesaGetVideoModeData then
|
||||
begin
|
||||
VH:=VesaVideoModeHead;
|
||||
while assigned(VH) and (VH^.VideoIndex<>Index-PrevCount) do
|
||||
VH:=VH^.next;
|
||||
if assigned(VH) then
|
||||
Data:=VH^.v
|
||||
else
|
||||
VesaGetVideoModeData:=false;
|
||||
end;
|
||||
end;
|
||||
|
||||
function SetVESAMode(const VideoMode: TVideoMode): Boolean;
|
||||
|
||||
var
|
||||
w : word;
|
||||
res : boolean;
|
||||
VH : PVesaVideoMode;
|
||||
|
||||
begin
|
||||
res:=false;
|
||||
VH:=VesaVideoModeHead;
|
||||
while assigned(VH) do
|
||||
begin
|
||||
if (VideoMode.col=VH^.v.col) and
|
||||
(VideoMode.row=VH^.v.row) and
|
||||
(VideoMode.color=VH^.v.color) then
|
||||
begin
|
||||
res:=VESASetMode(VH^.mode);
|
||||
if res then
|
||||
begin
|
||||
ScreenWidth:=VideoMode.Col;
|
||||
ScreenHeight:=VideoMode.Row;
|
||||
ScreenColor:=VideoMode.Color;
|
||||
// cheat to get a correct mouse
|
||||
{
|
||||
mem[$40:$84]:=ScreenHeight-1;
|
||||
mem[$40:$4a]:=ScreenWidth;
|
||||
memw[$40:$4c]:=ScreenHeight*((ScreenWidth shl 1)-1);
|
||||
}
|
||||
DoCustomMouse(true);
|
||||
end;
|
||||
end;
|
||||
if res then
|
||||
exit;
|
||||
VH:=VH^.next;
|
||||
end;
|
||||
SetVESAMode:=SysSetVideoMode(VideoMode);
|
||||
end;
|
||||
|
||||
|
||||
Function VesaGetVideoModeCount : Word;
|
||||
|
||||
begin
|
||||
VesaGetVideoModeCount:=SysGetVideoModeCount()+VesaRegisteredModes;
|
||||
end;
|
||||
|
||||
|
||||
Var
|
||||
Driver : TVideoDriver;
|
||||
|
||||
BEGIN
|
||||
{ Get the videodriver to be used }
|
||||
GetVideoDriver (Driver);
|
||||
{ Change needed functions }
|
||||
SysGetVideoModeCount:=Driver.GetVideoModeCount;
|
||||
Driver.GetVideoModeCount:=@VesaGetVideoModeCount;
|
||||
SysGetVideoModeData:=Driver.GetVideoModeData;
|
||||
Driver.GetVideoModeData:=@VesaGetVideoModeData;
|
||||
SysSetVideoMode:=Driver.SetVideoMode;
|
||||
Driver.SetVideoMode:=@SetVESAMode;
|
||||
|
||||
SetVideoDriver (Driver);
|
||||
{$endif FPC}
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2001-08-04 11:30:25 peter
|
||||
Revision 1.2 2001-10-11 11:35:34 pierre
|
||||
* adapt to new video unit layout
|
||||
|
||||
Revision 1.1 2001/08/04 11:30:25 peter
|
||||
* ide works now with both compiler versions
|
||||
|
||||
Revision 1.1 2000/07/13 09:48:36 michael
|
||||
|
||||
Loading…
Reference in New Issue
Block a user