mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 08:29:29 +02:00
* desktop saving things
* vesa mode * preferences dialog
This commit is contained in:
peter
parent
406efbaa5c
commit
f62a9a4d77
@ -21,8 +21,10 @@ uses
|
||||
{$endif IDEHeapTrc}
|
||||
Dos,
|
||||
BrowCol,
|
||||
FPIni,FPViews,FPConst,FPVars,FPUtils,FPIde,FPHelp,FPSwitch,FPUsrScr,
|
||||
FPTools,FPDebug,FPTemplt,FPCatch,FPRedir
|
||||
WViews,
|
||||
FPIDE,
|
||||
FPIni,FPViews,FPConst,FPVars,FPUtils,FPHelp,FPSwitch,FPUsrScr,
|
||||
FPTools,FPDebug,FPTemplt,FPCatch,FPRedir,FPDesk
|
||||
{$ifdef TEMPHEAP}
|
||||
,dpmiexcp
|
||||
{$endif TEMPHEAP}
|
||||
@ -68,6 +70,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
var CanExit : boolean;
|
||||
|
||||
BEGIN
|
||||
{$ifdef DEV}HeapLimit:=4096;{$endif}
|
||||
writeln('þ Free Pascal IDE Version '+VersionStr);
|
||||
@ -76,6 +80,9 @@ BEGIN
|
||||
|
||||
ProcessParams(true);
|
||||
|
||||
{$ifndef FV20}
|
||||
InitVESAScreenModes;
|
||||
{$endif}
|
||||
InitRedir;
|
||||
InitBreakpoints;
|
||||
InitReservedWords;
|
||||
@ -92,16 +99,29 @@ BEGIN
|
||||
|
||||
{ load all options after init because of open files }
|
||||
ReadINIFile;
|
||||
InitDesktopFile;
|
||||
LoadDesktop;
|
||||
|
||||
{ Update IDE }
|
||||
MyApp.Update;
|
||||
|
||||
ProcessParams(false);
|
||||
|
||||
repeat
|
||||
MyApp.Run;
|
||||
if (AutoSaveOptions and asEditorFiles)=0 then CanExit:=true else
|
||||
CanExit:=MyApp.SaveAll;
|
||||
until CanExit;
|
||||
|
||||
{ must be written before done for open files }
|
||||
WriteINIFile;
|
||||
if (AutoSaveOptions and asEnvironment)<>0 then
|
||||
if WriteINIFile=false then
|
||||
ErrorBox('Error saving configuration.',nil);
|
||||
if (AutoSaveOptions and asDesktop)<>0 then
|
||||
if SaveDesktop=false then
|
||||
ErrorBox('Error saving desktop.',nil);
|
||||
|
||||
DoneDesktopFile;
|
||||
|
||||
MyApp.Done;
|
||||
|
||||
@ -119,7 +139,12 @@ BEGIN
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.18 1999-03-21 22:51:35 florian
|
||||
Revision 1.19 1999-03-23 15:11:26 peter
|
||||
* desktop saving things
|
||||
* vesa mode
|
||||
* preferences dialog
|
||||
|
||||
Revision 1.18 1999/03/21 22:51:35 florian
|
||||
+ functional screen mode switching added
|
||||
|
||||
Revision 1.17 1999/03/16 12:38:06 peter
|
||||
|
||||
@ -30,6 +30,7 @@ const
|
||||
|
||||
ININame = 'fp.ini';
|
||||
SwitchesName = 'fp.cfg';
|
||||
DesktopName = 'fp.dsk';
|
||||
|
||||
ToolCaptureName = '$$TOOL$$.OUT';
|
||||
FilterCaptureName = '$FILTER$.OUT';
|
||||
@ -69,6 +70,20 @@ const
|
||||
dfOpenWindows = $00000010;
|
||||
dfSymbolInformation = $00000020;
|
||||
|
||||
{ Auto Save flag constants }
|
||||
asEditorFiles = $00000001; { Editor files }
|
||||
asEnvironment = $00000002; { .INI file }
|
||||
asDesktop = $00000004; { .DSK file }
|
||||
|
||||
{ Misc. Options flag constants }
|
||||
moAutoTrackSource = $00000001;
|
||||
moCloseOnGotoSource = $00000002;
|
||||
moChangeDirOnOpen = $00000004;
|
||||
|
||||
{ Desktop Location constants }
|
||||
dlCurrentDir = $00;
|
||||
dlConfigFileDir = $01;
|
||||
|
||||
{ Command constants }
|
||||
cmShowClipboard = 201;
|
||||
cmFindProcedure = 206;
|
||||
@ -308,7 +323,12 @@ implementation
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.15 1999-03-19 16:04:28 peter
|
||||
Revision 1.16 1999-03-23 15:11:27 peter
|
||||
* desktop saving things
|
||||
* vesa mode
|
||||
* preferences dialog
|
||||
|
||||
Revision 1.15 1999/03/19 16:04:28 peter
|
||||
* new compiler dialog
|
||||
|
||||
Revision 1.14 1999/03/16 12:38:08 peter
|
||||
|
||||
102
ide/text/fpdesk.pas
Normal file
102
ide/text/fpdesk.pas
Normal file
@ -0,0 +1,102 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal Integrated Development Environment
|
||||
Copyright (c) 1998 by Berczi Gabor
|
||||
|
||||
Desktop loading/saving routines
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
unit FPDesk;
|
||||
|
||||
interface
|
||||
|
||||
procedure InitDesktopFile;
|
||||
function LoadDesktop: boolean;
|
||||
function SaveDesktop: boolean;
|
||||
procedure DoneDesktopFile;
|
||||
|
||||
implementation
|
||||
|
||||
uses Dos,
|
||||
WResource,
|
||||
FPConst,FPVars,FPUtils;
|
||||
|
||||
procedure InitDesktopFile;
|
||||
begin
|
||||
if DesktopLocation=dlCurrentDir then
|
||||
DesktopPath:=FExpand(DesktopName)
|
||||
else
|
||||
DesktopPath:=FExpand(DirOf(INIPath)+DesktopName);
|
||||
end;
|
||||
|
||||
procedure DoneDesktopFile;
|
||||
begin
|
||||
end;
|
||||
|
||||
function WriteHistory(F: PResourceFile): boolean;
|
||||
begin
|
||||
end;
|
||||
|
||||
function WriteClipboard(F: PResourceFile): boolean;
|
||||
begin
|
||||
end;
|
||||
|
||||
function WriteWatches(F: PResourceFile): boolean;
|
||||
begin
|
||||
end;
|
||||
|
||||
function WriteBreakpoints(F: PResourceFile): boolean;
|
||||
begin
|
||||
end;
|
||||
|
||||
function WriteOpenWindows(F: PResourceFile): boolean;
|
||||
begin
|
||||
end;
|
||||
|
||||
function WriteSymbols(F: PResourceFile): boolean;
|
||||
begin
|
||||
end;
|
||||
|
||||
function LoadDesktop: boolean;
|
||||
begin
|
||||
end;
|
||||
|
||||
function SaveDesktop: boolean;
|
||||
var OK: boolean;
|
||||
F: PSimpleResourceFile;
|
||||
begin
|
||||
New(F, Create(DesktopPath));
|
||||
OK:=true;
|
||||
if OK and ((DesktopFileFlags and dfHistoryLists)<>0) then
|
||||
OK:=WriteHistory(F);
|
||||
if OK and ((DesktopFileFlags and dfClipboardContent)<>0) then
|
||||
OK:=WriteClipboard(F);
|
||||
if OK and ((DesktopFileFlags and dfWatches)<>0) then
|
||||
OK:=WriteWatches(F);
|
||||
if OK and ((DesktopFileFlags and dfBreakpoints)<>0) then
|
||||
OK:=WriteBreakpoints(F);
|
||||
if OK and ((DesktopFileFlags and dfOpenWindows)<>0) then
|
||||
OK:=WriteOpenWindows(F);
|
||||
if OK and ((DesktopFileFlags and dfSymbolInformation)<>0) then
|
||||
OK:=WriteSymbols(F);
|
||||
Dispose(F, Done);
|
||||
SaveDesktop:=OK;
|
||||
end;
|
||||
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1999-03-23 15:11:28 peter
|
||||
* desktop saving things
|
||||
* vesa mode
|
||||
* preferences dialog
|
||||
|
||||
}
|
||||
|
||||
@ -61,7 +61,7 @@ uses Objects,Views,App,MsgBox,
|
||||
FPConst,FPVars,FPUtils;
|
||||
|
||||
const
|
||||
MaxStatusLevel = 5;
|
||||
MaxStatusLevel = {$ifdef FPC}10{$else}2{$endif};
|
||||
|
||||
var StatusStack : array[0..MaxStatusLevel] of string[MaxViewWidth];
|
||||
|
||||
@ -379,7 +379,12 @@ end;
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.12 1999-03-16 12:38:09 peter
|
||||
Revision 1.13 1999-03-23 15:11:28 peter
|
||||
* desktop saving things
|
||||
* vesa mode
|
||||
* preferences dialog
|
||||
|
||||
Revision 1.12 1999/03/16 12:38:09 peter
|
||||
* tools macro fixes
|
||||
+ tph writer
|
||||
+ first things for resource files
|
||||
|
||||
@ -31,6 +31,7 @@ type
|
||||
procedure InitStatusLine; virtual;
|
||||
procedure Open(FileName: string);
|
||||
function OpenSearch(FileName: string) : boolean;
|
||||
function SaveAll: boolean;
|
||||
procedure Idle; virtual;
|
||||
procedure Update;
|
||||
procedure HandleEvent(var Event: TEvent); virtual;
|
||||
@ -45,7 +46,6 @@ type
|
||||
procedure NewEditor;
|
||||
procedure NewFromTemplate;
|
||||
procedure OpenRecentFile(RecentIndex: integer);
|
||||
procedure SaveAll;
|
||||
procedure ChangeDir;
|
||||
procedure ShowClipboard;
|
||||
procedure FindProcedure;
|
||||
@ -105,6 +105,7 @@ type
|
||||
function SearchRecentFile(AFileName: string): integer;
|
||||
procedure RemoveRecentFile(Index: integer);
|
||||
private
|
||||
SaveCancelled: boolean;
|
||||
procedure CurDirChanged;
|
||||
procedure UpdatePrimaryFile;
|
||||
procedure UpdateINIFile;
|
||||
@ -451,6 +452,8 @@ begin
|
||||
end;
|
||||
evBroadcast :
|
||||
case Event.Command of
|
||||
cmSaveCancelled :
|
||||
SaveCancelled:=true;
|
||||
cmUpdateTools :
|
||||
UpdateTools;
|
||||
cmUpdate :
|
||||
@ -731,7 +734,12 @@ end;
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.24 1999-03-19 16:04:29 peter
|
||||
Revision 1.25 1999-03-23 15:11:29 peter
|
||||
* desktop saving things
|
||||
* vesa mode
|
||||
* preferences dialog
|
||||
|
||||
Revision 1.24 1999/03/19 16:04:29 peter
|
||||
* new compiler dialog
|
||||
|
||||
Revision 1.23 1999/03/16 12:38:10 peter
|
||||
|
||||
@ -53,6 +53,7 @@ const
|
||||
secSearch = 'Search';
|
||||
secTools = 'Tools';
|
||||
secSourcePath = 'SourcePath';
|
||||
secPreferences = 'Preferences';
|
||||
|
||||
{ INI file tags }
|
||||
ieRecentFile = 'RecentFile';
|
||||
@ -86,6 +87,11 @@ const
|
||||
ieBreakpointLine = 'LineNumber';
|
||||
ieBreakpointCond = 'Condition';
|
||||
ieSourceList = 'SourceList';
|
||||
ieVideoMode = 'VideoMode';
|
||||
ieAutoSave = 'AutoSaveFlags';
|
||||
ieMiscOptions = 'MiscOptions';
|
||||
ieDesktopLocation = 'DesktopLocation';
|
||||
ieDesktopFlags = 'DesktopFileFlags';
|
||||
|
||||
procedure InitINIFile;
|
||||
var S: string;
|
||||
@ -338,6 +344,12 @@ begin
|
||||
{ remove it because otherwise we allways keep old files }
|
||||
INIFile^.DeleteEntry(secFiles,ieOpenFile+IntToStr(I));
|
||||
end;
|
||||
{ Desktop }
|
||||
DesktopFileFlags:=INIFile^.GetIntEntry(secPreferences,ieDesktopFlags,DesktopFileFlags);
|
||||
{ Preferences }
|
||||
AutoSaveOptions:=INIFile^.GetIntEntry(secPreferences,ieAutoSave,AutoSaveOptions);
|
||||
MiscOptions:=INIFile^.GetIntEntry(secPreferences,ieMiscOptions,MiscOptions);
|
||||
DesktopLocation:=INIFile^.GetIntEntry(secPreferences,ieDesktopLocation,DesktopLocation);
|
||||
Dispose(INIFile, Done);
|
||||
end;
|
||||
ReadINIFile:=OK;
|
||||
@ -456,6 +468,12 @@ begin
|
||||
INIFile^.SetEntry(secColors,iePalette+'_161_200',PaletteToStr(copy(S,161,40)));
|
||||
INIFile^.SetEntry(secColors,iePalette+'_201_240',PaletteToStr(copy(S,201,40)));
|
||||
end;
|
||||
{ Desktop }
|
||||
INIFile^.SetIntEntry(secPreferences,ieDesktopFlags,DesktopFileFlags);
|
||||
{ Preferences }
|
||||
INIFile^.SetIntEntry(secPreferences,ieAutoSave,AutoSaveOptions);
|
||||
INIFile^.SetIntEntry(secPreferences,ieMiscOptions,MiscOptions);
|
||||
INIFile^.SetIntEntry(secPreferences,ieDesktopLocation,DesktopLocation);
|
||||
OK:=INIFile^.Update;
|
||||
Dispose(INIFile, Done);
|
||||
WriteINIFile:=OK;
|
||||
@ -464,7 +482,12 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.17 1999-03-12 01:13:58 peter
|
||||
Revision 1.18 1999-03-23 15:11:31 peter
|
||||
* desktop saving things
|
||||
* vesa mode
|
||||
* preferences dialog
|
||||
|
||||
Revision 1.17 1999/03/12 01:13:58 peter
|
||||
* flag if trytoopen should look for other extensions
|
||||
+ browser tab in the tools-compiler
|
||||
|
||||
|
||||
@ -136,7 +136,7 @@ begin
|
||||
RemoveRecentFile(RecentIndex);
|
||||
end;
|
||||
|
||||
procedure TIDEApp.SaveAll;
|
||||
function TIDEApp.SaveAll: boolean;
|
||||
|
||||
procedure SendSave(P: PView); {$ifndef FPC}far;{$endif}
|
||||
begin
|
||||
@ -144,7 +144,9 @@ procedure TIDEApp.SaveAll;
|
||||
end;
|
||||
|
||||
begin
|
||||
SaveCancelled:=false;
|
||||
Desktop^.ForEach(@SendSave);
|
||||
SaveAll:=not SaveCancelled;
|
||||
end;
|
||||
|
||||
|
||||
@ -156,7 +158,12 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.9 1999-02-19 18:43:47 peter
|
||||
Revision 1.10 1999-03-23 15:11:32 peter
|
||||
* desktop saving things
|
||||
* vesa mode
|
||||
* preferences dialog
|
||||
|
||||
Revision 1.9 1999/02/19 18:43:47 peter
|
||||
+ open dialog supports mask list
|
||||
|
||||
Revision 1.8 1999/02/05 12:11:57 pierre
|
||||
|
||||
@ -475,7 +475,7 @@ begin
|
||||
ExecuteDialog(New(PToolsDialog, Init),nil);
|
||||
end;
|
||||
|
||||
procedure TIDEApp.Preferences;
|
||||
(*procedure TIDEApp.Preferences;
|
||||
var R,R2: TRect;
|
||||
D: PCenterDialog;
|
||||
RB1 : PRadioButtons;
|
||||
@ -549,6 +549,141 @@ begin
|
||||
end;
|
||||
end;
|
||||
Dispose(D, Done);
|
||||
end;*)
|
||||
|
||||
type
|
||||
PVideoModeCollection = ^TVideoModeCollection;
|
||||
TVideoModeCollection = object(TSortedCollection)
|
||||
function Compare(Key1, Key2: Pointer): Integer; virtual;
|
||||
procedure FreeItem(Item: Pointer); virtual;
|
||||
end;
|
||||
|
||||
function TVideoModeCollection.Compare(Key1, Key2: Pointer): Integer;
|
||||
var R: integer;
|
||||
K1: PVideoModeList absolute Key1;
|
||||
K2: PVideoModeList absolute Key2;
|
||||
begin
|
||||
if K1^.Col<K2^.Col then R:=-1 else
|
||||
if K1^.Col>K2^.Col then R:= 1 else
|
||||
if K1^.Row<K2^.Row then R:=-1 else
|
||||
if K1^.Row>K2^.Row then R:= 1 else
|
||||
if (K1^.Color=false) and (K2^.Color=true ) then R:=-1 else
|
||||
if (K1^.Color=true ) and (K2^.Color=false) then R:= 1 else
|
||||
R:=0;
|
||||
Compare:=R;
|
||||
end;
|
||||
|
||||
procedure TVideoModeCollection.FreeItem(Item: Pointer);
|
||||
begin
|
||||
{ don't do anything here }
|
||||
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,R3: TRect;
|
||||
D: PCenterDialog;
|
||||
C: PVideoModeCollection;
|
||||
VMLB: PVideoModeListBox;
|
||||
VP: PVideoModeList;
|
||||
VM: TVideoMode;
|
||||
RB1,RB2: PPlainRadioButtons;
|
||||
CB1,CB2: PPlainCheckBoxes;
|
||||
CurM: PVideoModeList;
|
||||
CurIdx: integer;
|
||||
begin
|
||||
New(C, Init(10,50));
|
||||
VP:=Video.Modes; CurM:=nil;
|
||||
while VP<>nil do
|
||||
begin
|
||||
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;
|
||||
R.Assign(0,0,64,15);
|
||||
New(D, Init(R, 'Preferences'));
|
||||
with D^ do
|
||||
begin
|
||||
GetExtent(R); R.Grow(-2,-2);
|
||||
R.B.X:=R.A.X+(R.B.X-R.A.X) div 2 - 1;
|
||||
|
||||
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 CurIdx<>-1 then
|
||||
VMLB^.FocusItem(CurIdx);
|
||||
Insert(New(PGroupView, Init(R, 'Video mode', VMLB)));
|
||||
Insert(VMLB);
|
||||
|
||||
R.Move(0,R.B.Y-R.A.Y{+1}); R.B.Y:=R.A.Y+4;
|
||||
R2.Copy(R); R2.Grow(-1,-1);
|
||||
New(RB1, Init(R2,
|
||||
NewSItem('C~u~rrent directory',
|
||||
NewSItem('Conf~i~g file directory',
|
||||
nil))));
|
||||
RB1^.Press(DesktopLocation);
|
||||
Insert(New(PGroupView, Init(R, 'Desktop file', RB1)));
|
||||
Insert(RB1);
|
||||
|
||||
R.Move(0,R.B.Y-R.A.Y{+1}); R.B.Y:=R.A.Y+5;
|
||||
R2.Copy(R); R2.Grow(-1,-1);
|
||||
New(CB1, Init(R2,
|
||||
NewSItem('Editor ~f~iles',
|
||||
NewSItem('~E~nvironment',
|
||||
NewSItem('~D~esktop',
|
||||
nil)))));
|
||||
CB1^.Value:=AutoSaveOptions;
|
||||
Insert(New(PGroupView, Init(R, 'Auto save', CB1)));
|
||||
Insert(CB1);
|
||||
|
||||
GetExtent(R); R.Grow(-2,-2);
|
||||
R.A.X:=R.B.X-(R.B.X-R.A.X) div 2 + 1;
|
||||
R.B.Y:=R.A.Y+7;
|
||||
|
||||
R.Move(0,R.B.Y-R.A.Y{+1}); R.B.Y:=R.A.Y+5;
|
||||
R2.Copy(R); R2.Grow(-1,-1);
|
||||
New(CB2, Init(R2,
|
||||
NewSItem('~A~uto track source',
|
||||
NewSItem('C~l~ose on go to source',
|
||||
NewSItem('C~h~ange dir on open',
|
||||
nil)))));
|
||||
CB2^.Value:=MiscOptions;
|
||||
Insert(New(PGroupView, Init(R, 'Options', CB2)));
|
||||
Insert(CB2);
|
||||
|
||||
end;
|
||||
InsertButtons(D);
|
||||
if Desktop^.ExecView(D)=cmOK then
|
||||
begin
|
||||
with PVideoModeList(C^.At(VMLB^.Focused))^ do
|
||||
begin
|
||||
VM.Col:=Col;
|
||||
VM.Row:=Row;
|
||||
VM.Color:=Color;
|
||||
end;
|
||||
if (VM.Col<>ScreenMode.Col) or (VM.Row<>ScreenMode.Row) or (VM.Color<>ScreenMode.Color) then
|
||||
SetScreenVideoMode(VM);
|
||||
AutoSaveOptions:=CB1^.Value;
|
||||
MiscOptions:=CB2^.Value;
|
||||
DesktopLocation:=RB1^.Value;
|
||||
end;
|
||||
Dispose(D, Done);
|
||||
Dispose(C, Done);
|
||||
end;
|
||||
|
||||
procedure TIDEApp.EditorOptions(Editor: PEditor);
|
||||
@ -930,7 +1065,12 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.22 1999-03-21 22:51:36 florian
|
||||
Revision 1.23 1999-03-23 15:11:33 peter
|
||||
* desktop saving things
|
||||
* vesa mode
|
||||
* preferences dialog
|
||||
|
||||
Revision 1.22 1999/03/21 22:51:36 florian
|
||||
+ functional screen mode switching added
|
||||
|
||||
Revision 1.21 1999/03/16 12:38:12 peter
|
||||
|
||||
@ -113,7 +113,7 @@ const
|
||||
('~N~ormal','~D~ebug','~R~elease');
|
||||
SwitchesModeStr : array[TSwitchMode] of string[8]=
|
||||
('NORMAL','DEBUG','RELEASE');
|
||||
CustomArg : array[TSwitchMode] of string=
|
||||
CustomArg : array[TSwitchMode] of string{$ifndef FPC}[128]{$endif}=
|
||||
('','','');
|
||||
|
||||
var
|
||||
@ -841,7 +841,12 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.11 1999-03-12 01:14:01 peter
|
||||
Revision 1.12 1999-03-23 15:11:34 peter
|
||||
* desktop saving things
|
||||
* vesa mode
|
||||
* preferences dialog
|
||||
|
||||
Revision 1.11 1999/03/12 01:14:01 peter
|
||||
* flag if trytoopen should look for other extensions
|
||||
+ browser tab in the tools-compiler
|
||||
|
||||
|
||||
@ -129,7 +129,7 @@ procedure ClearToolMessages;
|
||||
procedure UpdateToolMessages;
|
||||
|
||||
const
|
||||
ToolFilter : string = '';
|
||||
ToolFilter : string[128] = '';
|
||||
CaptureToolTo : TCaptureTarget = capNone;
|
||||
ToolMessages : PCollection = nil;
|
||||
ToolModuleNames: PStoreCollection = nil;
|
||||
@ -1426,7 +1426,12 @@ end;
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 1999-03-16 12:38:14 peter
|
||||
Revision 1.7 1999-03-23 15:11:35 peter
|
||||
* desktop saving things
|
||||
* vesa mode
|
||||
* preferences dialog
|
||||
|
||||
Revision 1.6 1999/03/16 12:38:14 peter
|
||||
* tools macro fixes
|
||||
+ tph writer
|
||||
+ first things for resource files
|
||||
|
||||
@ -60,7 +60,11 @@ const ClipboardWindow : PClipboardWindow = nil;
|
||||
StartupOptions : longint = 0;
|
||||
LastExitCode : integer = 0;
|
||||
ASCIIChart : PFPASCIIChart = nil;
|
||||
DesktopPath : string = DesktopName;
|
||||
DesktopFileFlags : longint = dfHistoryLists+dfOpenWindows;
|
||||
DesktopLocation : byte = dlConfigFileDir;
|
||||
AutoSaveOptions : longint = asEnvironment+asDesktop;
|
||||
MiscOptions : longint = moChangeDirOnOpen+moCloseOnGotoSource;
|
||||
|
||||
ActionCommands : array[acFirstAction..acLastAction] of word =
|
||||
(cmHelpTopicSearch,cmGotoCursor,cmToggleBreakpoint,
|
||||
@ -75,7 +79,12 @@ implementation
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.14 1999-03-19 16:04:32 peter
|
||||
Revision 1.15 1999-03-23 15:11:36 peter
|
||||
* desktop saving things
|
||||
* vesa mode
|
||||
* preferences dialog
|
||||
|
||||
Revision 1.14 1999/03/19 16:04:32 peter
|
||||
* new compiler dialog
|
||||
|
||||
Revision 1.13 1999/03/16 12:38:15 peter
|
||||
|
||||
@ -278,6 +278,11 @@ type
|
||||
destructor Done; virtual;
|
||||
end;
|
||||
|
||||
PVideoModeListBox = ^TVideoModeListBox;
|
||||
TVideoModeListBox = object(TDropDownListBox)
|
||||
function GetText(Item: pointer; MaxLen: sw_integer): string; virtual;
|
||||
end;
|
||||
|
||||
function SearchFreeWindowNo: integer;
|
||||
|
||||
function IsThereAnyEditor: boolean;
|
||||
@ -302,6 +307,10 @@ function TryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tr
|
||||
|
||||
function StartEditor(Editor: PCodeEditor; FileName: string): boolean;
|
||||
|
||||
{$ifndef FV20}
|
||||
procedure InitVESAScreenModes;
|
||||
{$endif}
|
||||
|
||||
const
|
||||
SourceCmds : TCommandSet =
|
||||
([cmSave,cmSaveAs,cmCompile]);
|
||||
@ -326,8 +335,9 @@ var MsgParms : array[1..10] of
|
||||
implementation
|
||||
|
||||
uses
|
||||
Strings,Keyboard,Memory,MsgBox,Validate,
|
||||
Video,Strings,Keyboard,Memory,MsgBox,Validate,
|
||||
Tokens,Version,
|
||||
{$ifndef FV20}Vesa,{$endif}
|
||||
FPSwitch,FPSymbol,FPDebug,FPVars,FPUtils,FPCompile,FPHelp;
|
||||
|
||||
const
|
||||
@ -730,6 +740,7 @@ begin
|
||||
inherited Init(Bounds);
|
||||
Options:=Options or gfGrowHiX or gfGrowHiY;
|
||||
EventMask:=EventMask or evIdle;
|
||||
GrowMode:=gfGrowAll;
|
||||
end;
|
||||
|
||||
constructor TFPHeapView.InitKb(var Bounds: TRect);
|
||||
@ -737,6 +748,7 @@ begin
|
||||
inherited InitKb(Bounds);
|
||||
Options:=Options or gfGrowHiX or gfGrowHiY;
|
||||
EventMask:=EventMask or evIdle;
|
||||
GrowMode:=gfGrowAll;
|
||||
end;
|
||||
|
||||
procedure TFPHeapView.HandleEvent(var Event: TEvent);
|
||||
@ -2436,10 +2448,52 @@ begin
|
||||
inherited Done;
|
||||
end;
|
||||
|
||||
function TVideoModeListBox.GetText(Item: pointer; MaxLen: sw_integer): string;
|
||||
var P: PVideoModeList;
|
||||
S: string;
|
||||
begin
|
||||
P:=Item;
|
||||
S:=IntToStr(P^.Col)+'x'+IntToStr(P^.Row)+' ';
|
||||
if P^.Color then
|
||||
S:=S+'color'
|
||||
else
|
||||
S:=S+'mono';
|
||||
GetText:=copy(S,1,MaxLen);
|
||||
end;
|
||||
|
||||
{$ifndef FV20}
|
||||
function VESASetVideoModeProc(const VideoMode: TVideoMode; Params: Longint): Boolean; {$ifndef FPC}far;{$endif}
|
||||
begin
|
||||
VESASetMode(Params);
|
||||
end;
|
||||
|
||||
procedure InitVESAScreenModes;
|
||||
var ML: TVESAModeList;
|
||||
MI: TVESAModeInfoBlock;
|
||||
I: integer;
|
||||
begin
|
||||
if VESAInit=false then Exit;
|
||||
if VESAGetModeList(ML)=false then Exit;
|
||||
for I:=1 to ML.Count do
|
||||
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,VESASetVideoModeProc,ML.Modes[I]);
|
||||
end;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.24 1999-03-21 22:51:37 florian
|
||||
Revision 1.25 1999-03-23 15:11:37 peter
|
||||
* desktop saving things
|
||||
* vesa mode
|
||||
* preferences dialog
|
||||
|
||||
Revision 1.24 1999/03/21 22:51:37 florian
|
||||
+ functional screen mode switching added
|
||||
|
||||
Revision 1.23 1999/03/19 16:04:33 peter
|
||||
|
||||
489
ide/text/vesa.pas
Normal file
489
ide/text/vesa.pas
Normal file
@ -0,0 +1,489 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the PinGUI - Platform Independent GUI Project
|
||||
Copyright (c) 1999 by Berczi Gabor
|
||||
|
||||
VESA support routines
|
||||
|
||||
See the file COPYING.GUI, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
unit VESA;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Dos,
|
||||
{$ifdef TP}
|
||||
{$ifdef DPMI}
|
||||
,WinDos,WinAPI
|
||||
{$endif}
|
||||
{$endif}
|
||||
{$ifdef FPC}
|
||||
{$ifdef GO32V2}
|
||||
,Go32
|
||||
{$endif}
|
||||
{$endif}
|
||||
Objects,Strings,WUtils;
|
||||
|
||||
const
|
||||
{ Video Mode Attributes mask constants }
|
||||
vesa_vma_CanBeSetInCurrentConfig = $0001;
|
||||
vesa_vma_OptionalBlockPresent = $0002;
|
||||
vesa_vma_BIOSSupport = $0004;
|
||||
vesa_vma_ColorMode = $0008; { else mono }
|
||||
vesa_vma_GraphicsMode = $0010; { else text }
|
||||
{ -- VBE 2.0 --- }
|
||||
vesa_vma_VGACompatibleMode = $0020;
|
||||
vesa_vma_VGACompWindowedAvail = $0040;
|
||||
vesa_vma_LinearFrameBufferAvail = $0080;
|
||||
|
||||
{ Windows Attributes mask constants }
|
||||
vesa_wa_Present = $0001;
|
||||
vesa_wa_Readable = $0002;
|
||||
vesa_wa_Writeable = $0004;
|
||||
|
||||
{ Memory Model value constants }
|
||||
vesa_mm_Text = $0000;
|
||||
vesa_mm_CGAGraphics = $0001;
|
||||
vesa_mm_HerculesGraphics = $0002;
|
||||
vesa_mm_4planePlanar = $0003;
|
||||
vesa_mm_PackedPixel = $0004;
|
||||
vesa_mm_NonChain4_256color = $0005;
|
||||
vesa_mm_DirectColor = $0006;
|
||||
vesa_mm_YUV = $0007;
|
||||
|
||||
{ Memory Window value constants }
|
||||
vesa_mw_WindowA = $0000;
|
||||
vesa_mw_WindowB = $0001;
|
||||
|
||||
type
|
||||
{$ifdef FPC}tregisters=registers;{$endif}
|
||||
|
||||
PtrRec16 = record
|
||||
Ofs,Seg: word;
|
||||
end;
|
||||
|
||||
TVESAInfoBlock = record
|
||||
Signature : longint; { 'VESA' }
|
||||
Version : word;
|
||||
OEMString : PString;
|
||||
Capabilities : longint;
|
||||
VideoModeList: PWordArray;
|
||||
TotalMemory : word; { in 64KB blocks }
|
||||
Fill : array[1..236] of byte;
|
||||
VBE2Fill : array[1..256] of byte;
|
||||
end;
|
||||
|
||||
TVESAModeInfoBlock = record
|
||||
Attributes : word;
|
||||
WinAAttrs : byte;
|
||||
WinBAttrs : byte;
|
||||
Granularity : word;
|
||||
Size : word;
|
||||
ASegment : word;
|
||||
BSegment : word;
|
||||
FuncPtr : pointer;
|
||||
BytesPerLine : word;
|
||||
{ optional }
|
||||
XResolution : word;
|
||||
YResolution : word;
|
||||
XCharSize : byte;
|
||||
YCharSize : byte;
|
||||
NumberOfPlanes : byte;
|
||||
BitsPerPixel : byte;
|
||||
NumberOfBanks : byte;
|
||||
MemoryModel : byte;
|
||||
BankSize : byte;
|
||||
NumberOfImagePages: byte;
|
||||
Reserved : byte;
|
||||
{ direct color fields }
|
||||
RedMaskSize : byte;
|
||||
RedFieldPosition: byte;
|
||||
GreenMaskSize : byte;
|
||||
GreenFieldPosition: byte;
|
||||
BlueMaskSize : byte;
|
||||
BlueFieldPosition: byte;
|
||||
ReservedMaskSize: byte;
|
||||
ReservedPosition: byte;
|
||||
DirectColorModeInfo: byte;
|
||||
{ --- VBE 2.0 optional --- }
|
||||
LinearFrameAddr : longint;
|
||||
OffScreenAddr : longint;
|
||||
OffScreenSize : word;
|
||||
Reserved2 : array[1..216-(4+4+2)] of byte;
|
||||
end;
|
||||
|
||||
TVESAModeList = record
|
||||
Count : word;
|
||||
Modes : array[1..256] of word;
|
||||
end;
|
||||
|
||||
function VESAInit: boolean;
|
||||
function VESAGetInfo(var B: TVESAInfoBlock): boolean;
|
||||
function VESAGetModeInfo(Mode: word; var B: TVESAModeInfoBlock): boolean;
|
||||
function VESAGetModeList(var B: TVESAModeList): boolean;
|
||||
function VESASearchMode(XRes,YRes,BPX: word; LFB: boolean; var Mode: word; var ModeInfo: TVESAModeInfoBlock): boolean;
|
||||
function VESAGetOemString: string;
|
||||
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 MemToStr(var B; Count: byte): string;
|
||||
|
||||
implementation
|
||||
|
||||
{$IFDEF DPMI}
|
||||
const
|
||||
DPMI_INTR = $31;
|
||||
|
||||
type
|
||||
TDPMIRegisters = record { DPMI call structure }
|
||||
EDI : LongInt;
|
||||
ESI : LongInt;
|
||||
EBP : LongInt;
|
||||
Reserved: LongInt;
|
||||
EBX : LongInt;
|
||||
EDX : LongInt;
|
||||
ECX : LongInt;
|
||||
EAX : LongInt;
|
||||
Flags : Word;
|
||||
ES : Word;
|
||||
DS : Word;
|
||||
FS : Word;
|
||||
GS : Word;
|
||||
IP : Word;
|
||||
CS : Word;
|
||||
SP : Word;
|
||||
SS : Word;
|
||||
end;
|
||||
|
||||
MemPtr = record
|
||||
{$ifdef TP}
|
||||
Selector: Word; {Protected mode}
|
||||
Segment : Word; {Real mode}
|
||||
{$endif}
|
||||
{$ifdef FPC}
|
||||
Selector: Word; {Real mode}
|
||||
Segment : Word; {Protected mode}
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
Function GetMem(var Mem : MemPtr; Size : Word): Boolean;
|
||||
begin
|
||||
if (Size > 0) then
|
||||
begin
|
||||
{$ifdef TP}
|
||||
LongInt(Mem) := GlobalDOSAlloc(Size);
|
||||
{$endif}
|
||||
{$ifdef FPC}
|
||||
longint(Mem) := global_dos_alloc(Size);
|
||||
if int31error<>0 then longint(Mem):=0;
|
||||
{$endif}
|
||||
GetMem := (LongInt(Mem) <> 0);
|
||||
end
|
||||
|
||||
else
|
||||
begin
|
||||
LongInt(Mem) := 0;
|
||||
GetMem := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure FreeMem(Mem : MemPtr; Size : Word);
|
||||
begin
|
||||
{$ifdef TP}
|
||||
if (Size > 0) then
|
||||
GlobalDOSFree(Mem.Selector);
|
||||
{$endif}
|
||||
{$ifdef FPC}
|
||||
if (Size > 0) then
|
||||
global_dos_free(Mem.Selector);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
Function MakePtr(Mem : MemPtr): Pointer;
|
||||
begin
|
||||
MakePtr := Ptr(Mem.Selector, 0);
|
||||
end;
|
||||
|
||||
{$ifdef TP}
|
||||
var
|
||||
DPMIRegs: TDPMIRegisters;
|
||||
|
||||
procedure realintr(IntNo: byte; var r: tregisters);
|
||||
var Regs: TRegisters;
|
||||
begin
|
||||
FillChar(DPMIRegs, SizeOf(TDPMIRegisters), 0);
|
||||
DPMIRegs.EAX := r.ax;
|
||||
DPMIRegs.EBX := r.bx;
|
||||
DPMIRegs.ECX := r.cx;
|
||||
DPMIRegs.EDX := r.dx;
|
||||
DPMIRegs.EDI := r.di;
|
||||
DPMIRegs.ESI := r.si;
|
||||
DPMIRegs.EBP := r.bp;
|
||||
DPMIRegs.DS := r.ds;
|
||||
DPMIRegs.ES := r.es;
|
||||
DPMIRegs.Flags := r.flags;
|
||||
Regs.AX := $0300;
|
||||
Regs.BL := IntNo;
|
||||
Regs.BH := 0;
|
||||
Regs.CX := 0;
|
||||
Regs.ES := Seg(DPMIRegs);
|
||||
Regs.DI := Ofs(DPMIRegs);
|
||||
Intr(DPMI_INTR, Regs);
|
||||
r.ax := DPMIRegs.EAX;
|
||||
r.bx := DPMIRegs.EBX;
|
||||
r.cx := DPMIRegs.ECX;
|
||||
r.dx := DPMIRegs.EDX;
|
||||
r.di := DPMIRegs.EDI;
|
||||
r.si := DPMIRegs.ESI;
|
||||
r.bp := DPMIRegs.EBP;
|
||||
r.ds := DPMIRegs.DS;
|
||||
r.es := DPMIRegs.ES;
|
||||
r.Flags := DPMIRegs.Flags;
|
||||
end;
|
||||
{$endif}
|
||||
{$ENDIF}
|
||||
|
||||
function MemToStr(var B; Count: byte): string;
|
||||
var S: string;
|
||||
begin
|
||||
S[0]:=chr(Count);
|
||||
if Count>0 then Move(B,S[1],Count);
|
||||
MemToStr:=S;
|
||||
end;
|
||||
|
||||
procedure StrToMem(S: string; var B);
|
||||
begin
|
||||
if length(S)>0 then Move(S[1],B,length(S));
|
||||
end;
|
||||
|
||||
function VESAGetInfo(var B: TVESAInfoBlock): boolean;
|
||||
{$IFNDEF DPMI}
|
||||
var r : registers;
|
||||
{$ELSE}
|
||||
var r : tregisters;
|
||||
pB : MemPtr;
|
||||
{$ENDIF}
|
||||
OK: boolean;
|
||||
begin
|
||||
StrToMem('VBE2',B.Signature);
|
||||
r.ah:=$4f; r.al:=0;
|
||||
{$IFNDEF DPMI}
|
||||
r.es:=seg(B); r.di:=ofs(B);
|
||||
intr($10,r);
|
||||
{$ELSE}
|
||||
GetMem(pB, SizeOf(B));
|
||||
{$ifdef TP}
|
||||
Move(B,MakePtr(pB)^,SizeOf(B));
|
||||
{$endif}
|
||||
{$ifdef FPC}
|
||||
dosmemput(pB.Segment,0,B,SizeOf(B));
|
||||
{$endif}
|
||||
r.es:=pB.Segment; r.di:=0; r.ds:=r.es;
|
||||
realintr($10,r);
|
||||
{$ENDIF}
|
||||
{$IFDEF DPMI}
|
||||
{$ifdef TP}
|
||||
Move(MakePtr(pB)^,B,SizeOf(B));
|
||||
{$endif}
|
||||
{$ifdef FPC}
|
||||
dosmemget(pB.Segment,0,B,SizeOf(B));
|
||||
{$endif}
|
||||
FreeMem(pB, SizeOf(B));
|
||||
{$ENDIF}
|
||||
OK:=(r.ax=$004f){ and (MemToStr(B.Signature,4)='VESA')};
|
||||
VESAGetInfo:=OK;
|
||||
end;
|
||||
|
||||
function VESAGetModeList(var B: TVESAModeList): boolean;
|
||||
var OK: boolean;
|
||||
VI: TVESAInfoBlock;
|
||||
Sel: word;
|
||||
begin
|
||||
FillChar(B,SizeOf(B),0);
|
||||
OK:=VESAGetInfo(VI);
|
||||
if OK then
|
||||
begin
|
||||
{$ifdef TP}
|
||||
{$ifdef DPMI}
|
||||
Sel:=AllocSelector(0);
|
||||
OK:=Sel<>0;
|
||||
if OK then
|
||||
begin
|
||||
SetSelectorBase(Sel,(longint(VI.VideoModeList) shr 16)*16+longint(VI.VideoModeList) and $ffff);
|
||||
SetSelectorLimit(Sel,SizeOf(B.Modes));
|
||||
Move(ptr(Sel,0)^,B.Modes,SizeOf(B.Modes));
|
||||
FreeSelector(Sel);
|
||||
end;
|
||||
{$endif}
|
||||
{$endif}
|
||||
{$ifdef FPC}
|
||||
with VI do
|
||||
dosmemget(PtrRec(VideoModeList).Seg,PtrRec(VideoModeList).Ofs,B.Modes,SizeOf(B.Modes));
|
||||
{$endif}
|
||||
if OK then
|
||||
while (B.Modes[B.Count+1]<>$ffff) and (B.Count<255) do
|
||||
Inc(B.Count);
|
||||
end;
|
||||
VESAGetModeList:=OK;
|
||||
end;
|
||||
|
||||
function VESASearchMode(XRes,YRes,BPX: word; LFB: boolean; var Mode: word; var ModeInfo: TVESAModeInfoBlock): boolean;
|
||||
var B: TVESAModeList;
|
||||
OK: boolean;
|
||||
I: integer;
|
||||
MI: TVESAModeInfoBlock;
|
||||
begin
|
||||
OK:=VESAGetModeList(B);
|
||||
I:=1; Mode:=0;
|
||||
repeat
|
||||
OK:=VESAGetModeInfo(B.Modes[I],MI);
|
||||
if OK and (MI.XResolution=XRes) and (MI.YResolution=YRes) and
|
||||
(MI.BitsPerPixel=BPX) and
|
||||
((LFB=false) or ((MI.Attributes and vesa_vma_LinearFrameBufferAvail)<>0)) then
|
||||
begin Mode:=B.Modes[I]; ModeInfo:=MI; end;
|
||||
Inc(I);
|
||||
until (OK=false) or (I>=B.Count) or (Mode<>0);
|
||||
OK:=Mode<>0;
|
||||
VESASearchMode:=OK;
|
||||
end;
|
||||
|
||||
function VESAGetOemString: string;
|
||||
var OK: boolean;
|
||||
VI: TVESAInfoBlock;
|
||||
Sel: word;
|
||||
S: array[0..256] of char;
|
||||
begin
|
||||
FillChar(S,SizeOf(S),0);
|
||||
OK:=VESAGetInfo(VI);
|
||||
{$IFDEF DPMI}
|
||||
if OK then
|
||||
begin
|
||||
{$ifdef TP}
|
||||
Sel:=AllocSelector(0);
|
||||
OK:=Sel<>0;
|
||||
if OK then
|
||||
begin
|
||||
SetSelectorBase(Sel,longint(PtrRec16(VI.OemString).Seg)*16+PtrRec16(VI.OemString).Ofs);
|
||||
SetSelectorLimit(Sel,SizeOf(S));
|
||||
Move(ptr(Sel,0)^,S,SizeOf(S));
|
||||
FreeSelector(Sel);
|
||||
end;
|
||||
{$endif}
|
||||
{$ifdef FPC}
|
||||
dosmemget(PtrRec16(VI.OemString).Seg,PtrRec16(VI.OemString).Ofs,S,SizeOf(S));
|
||||
{$endif}
|
||||
end;
|
||||
{$ELSE}
|
||||
Move(VI.OemString^,S,SizeOf(S));
|
||||
{$ENDIF}
|
||||
VESAGetOemString:=StrPas(@S);
|
||||
end;
|
||||
|
||||
function VESAGetModeInfo(Mode: word; var B: TVESAModeInfoBlock): boolean;
|
||||
{$IFNDEF DPMI}
|
||||
var r : registers;
|
||||
{$ELSE}
|
||||
var r : tregisters;
|
||||
{$ENDIF}
|
||||
OK: boolean;
|
||||
{$ifdef DPMI}
|
||||
pB: MemPtr;
|
||||
{$endif}
|
||||
begin
|
||||
r.ah:=$4f; r.al:=$01; r.cx:=Mode;
|
||||
{$IFDEF DPMI}
|
||||
GetMem(pB, SizeOf(B));
|
||||
{$ifdef TP}
|
||||
Move(B,MakePtr(pB)^,SizeOf(B));
|
||||
{$endif}
|
||||
{$ifdef FPC}
|
||||
dosmemput(pB.Segment,0,B,SizeOf(B));
|
||||
{$endif}
|
||||
r.es:=pB.Segment; r.di:=0; {r.ds:=r.es;}
|
||||
realintr($10,r);
|
||||
{$ELSE}
|
||||
r.es:=seg(B); r.di:=ofs(B);
|
||||
intr($10,r);
|
||||
{$ENDIF}
|
||||
{$IFDEF DPMI}
|
||||
{$ifdef TP}
|
||||
Move(MakePtr(pB)^,B,SizeOf(B));
|
||||
{$endif}
|
||||
{$ifdef FPC}
|
||||
dosmemget(pB.Segment,0,B,SizeOf(B));
|
||||
{$endif}
|
||||
FreeMem(pB, SizeOf(B));
|
||||
{$ENDIF}
|
||||
OK:=(r.ax=$004f);
|
||||
VESAGetModeInfo:=OK;
|
||||
end;
|
||||
|
||||
function VESASetMode(Mode: word): boolean;
|
||||
var r: registers;
|
||||
OK: boolean;
|
||||
begin
|
||||
r.ah:=$4f; r.al:=$02; r.bx:=Mode;
|
||||
intr($10,r);
|
||||
OK:=(r.ax=$004f);
|
||||
VESASetMode:=OK;
|
||||
end;
|
||||
|
||||
function VESAGetMode(var Mode: word): boolean;
|
||||
var r : registers;
|
||||
OK: boolean;
|
||||
begin
|
||||
r.ah:=$4f; r.al:=$03;
|
||||
intr($10,r);
|
||||
OK:=(r.ax=$004f);
|
||||
if OK then Mode:=r.bx;
|
||||
VESAGetMode:=OK;
|
||||
end;
|
||||
|
||||
function VESASelectMemoryWindow(Window: byte; Position: word): boolean;
|
||||
var r : registers;
|
||||
OK : boolean;
|
||||
begin
|
||||
r.ah:=$4f; r.al:=$05; r.bh:=0; r.bl:=Window; r.dx:=Position;
|
||||
intr($10,r);
|
||||
OK:=(r.ax=$004f);
|
||||
VESASelectMemoryWindow:=OK;
|
||||
end;
|
||||
|
||||
function VESAReturnMemoryWindow(Window: byte; var Position: word): boolean;
|
||||
var r : registers;
|
||||
OK : boolean;
|
||||
begin
|
||||
r.ah:=$4f; r.al:=$05; r.bh:=1; r.bl:=Window;
|
||||
intr($10,r);
|
||||
OK:=(r.ax=$004f);
|
||||
if OK then Position:=r.dx;
|
||||
VESAReturnMemoryWindow:=OK;
|
||||
end;
|
||||
|
||||
function VESAInit: boolean;
|
||||
var OK: boolean;
|
||||
VI: TVESAInfoBlock;
|
||||
begin
|
||||
OK:=VESAGetInfo(VI);
|
||||
VESAInit:=OK;
|
||||
end;
|
||||
|
||||
BEGIN
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1999-03-23 15:11:39 peter
|
||||
* desktop saving things
|
||||
* vesa mode
|
||||
* preferences dialog
|
||||
|
||||
}
|
||||
@ -24,6 +24,7 @@ const
|
||||
cmFileNameChanged = 51234;
|
||||
cmASCIIChar = 51235;
|
||||
cmClearLineHighlights = 51236;
|
||||
cmSaveCancelled = 51237;
|
||||
|
||||
{$ifdef FPC}
|
||||
EditorTextBufSize = 32768;
|
||||
@ -3117,7 +3118,10 @@ begin
|
||||
case EditorDialog(D, @FileName) of
|
||||
cmYes : OK := Save;
|
||||
cmNo : begin Modified := False; OK:=true; end;
|
||||
cmCancel : OK := False;
|
||||
cmCancel : begin
|
||||
OK := False;
|
||||
Message(Application,evBroadcast,cmSaveCancelled,@Self);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
SaveAsk:=OK;
|
||||
@ -3405,7 +3409,12 @@ end;
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.27 1999-03-08 14:58:17 peter
|
||||
Revision 1.28 1999-03-23 15:11:39 peter
|
||||
* desktop saving things
|
||||
* vesa mode
|
||||
* preferences dialog
|
||||
|
||||
Revision 1.27 1999/03/08 14:58:17 peter
|
||||
+ prompt with dialogs for tools
|
||||
|
||||
Revision 1.26 1999/03/07 22:58:57 pierre
|
||||
|
||||
@ -138,6 +138,12 @@ type
|
||||
procedure WriteResourceTable;
|
||||
end;
|
||||
|
||||
PSimpleResourceFile = ^TSimpleResourceFile;
|
||||
TSimpleResourceFile = object(TResourceFile)
|
||||
constructor Create(AFileName: string);
|
||||
constructor Load(AFileName: string);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses CallSpec,
|
||||
@ -670,11 +676,38 @@ begin
|
||||
begin Entries^.DeleteAll; Dispose(Entries, Done); Entries:=nil; end;
|
||||
end;
|
||||
|
||||
constructor TSimpleResourceFile.Create(AFileName: string);
|
||||
var B: PBufStream;
|
||||
begin
|
||||
New(B, Init(AFileName, stCreate, 4096));
|
||||
if (B<>nil) and (B^.Status<>stOK) then
|
||||
begin Dispose(B, Done); B:=nil; end;
|
||||
if B=nil then Fail;
|
||||
if inherited Create(B^)=false then
|
||||
Fail;
|
||||
end;
|
||||
|
||||
constructor TSimpleResourceFile.Load(AFileName: string);
|
||||
var B: PBufStream;
|
||||
begin
|
||||
New(B, Init(AFileName, stCreate, 4096));
|
||||
if (B<>nil) and (B^.Status<>stOK) then
|
||||
begin Dispose(B, Done); B:=nil; end;
|
||||
if B=nil then Fail;
|
||||
if inherited Load(B^)=false then
|
||||
Fail;
|
||||
end;
|
||||
|
||||
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1999-03-16 12:38:18 peter
|
||||
Revision 1.2 1999-03-23 15:11:40 peter
|
||||
* desktop saving things
|
||||
* vesa mode
|
||||
* preferences dialog
|
||||
|
||||
Revision 1.1 1999/03/16 12:38:18 peter
|
||||
* tools macro fixes
|
||||
+ tph writer
|
||||
+ first things for resource files
|
||||
|
||||
@ -27,12 +27,31 @@ type
|
||||
PByteArray = ^TByteArray;
|
||||
TByteArray = array[0..65520] of byte;
|
||||
|
||||
PNoDisposeCollection = ^TNoDisposeCollection;
|
||||
TNoDisposeCollection = object(TCollection)
|
||||
procedure FreeItem(Item: Pointer); virtual;
|
||||
end;
|
||||
|
||||
PUnsortedStringCollection = ^TUnsortedStringCollection;
|
||||
TUnsortedStringCollection = object(TCollection)
|
||||
function At(Index: Integer): PString;
|
||||
procedure FreeItem(Item: Pointer); virtual;
|
||||
end;
|
||||
|
||||
PSubStream = ^TSubStream;
|
||||
TSubStream = object(TStream)
|
||||
constructor Init(AStream: PStream; AStartPos, ASize: longint);
|
||||
function GetPos: Longint; virtual;
|
||||
function GetSize: Longint; virtual;
|
||||
procedure Read(var Buf; Count: Word); virtual;
|
||||
procedure Seek(Pos: Longint); virtual;
|
||||
procedure Write(var Buf; Count: Word); virtual;
|
||||
private
|
||||
StartPos: longint;
|
||||
Size : longint;
|
||||
S : PStream;
|
||||
end;
|
||||
|
||||
{$ifdef TPUNIXLF}
|
||||
procedure readln(var t:text;var s:string);
|
||||
{$endif}
|
||||
@ -196,6 +215,10 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure TNoDisposeCollection.FreeItem(Item: Pointer);
|
||||
begin
|
||||
{ don't do anything here }
|
||||
end;
|
||||
|
||||
function TUnsortedStringCollection.At(Index: Integer): PString;
|
||||
begin
|
||||
@ -207,10 +230,57 @@ begin
|
||||
if Item<>nil then DisposeStr(Item);
|
||||
end;
|
||||
|
||||
constructor TSubStream.Init(AStream: PStream; AStartPos, ASize: longint);
|
||||
begin
|
||||
inherited Init;
|
||||
S:=AStream; StartPos:=AStartPos; Size:=ASize;
|
||||
inherited Seek(StartPos);
|
||||
end;
|
||||
|
||||
function TSubStream.GetPos: Longint;
|
||||
var Pos: longint;
|
||||
begin
|
||||
Pos:=inherited GetPos; Dec(Pos,StartPos);
|
||||
GetPos:=Pos;
|
||||
end;
|
||||
|
||||
function TSubStream.GetSize: Longint;
|
||||
begin
|
||||
GetSize:=Size;
|
||||
end;
|
||||
|
||||
procedure TSubStream.Read(var Buf; Count: Word);
|
||||
var Pos: longint;
|
||||
RCount: word;
|
||||
begin
|
||||
Pos:=GetPos;
|
||||
if Pos+Count>Size then RCount:=Size-Pos else RCount:=Count;
|
||||
inherited Read(Buf,RCount);
|
||||
if RCount<Count then
|
||||
Error(stReadError,0);
|
||||
end;
|
||||
|
||||
procedure TSubStream.Seek(Pos: Longint);
|
||||
var RPos: longint;
|
||||
begin
|
||||
if (Pos<=Size) then RPos:=Pos else RPos:=Size;
|
||||
inherited Seek(StartPos+RPos);
|
||||
end;
|
||||
|
||||
procedure TSubStream.Write(var Buf; Count: Word);
|
||||
begin
|
||||
inherited Write(Buf,Count);
|
||||
end;
|
||||
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 1999-03-08 14:58:22 peter
|
||||
Revision 1.3 1999-03-23 15:11:41 peter
|
||||
* desktop saving things
|
||||
* vesa mode
|
||||
* preferences dialog
|
||||
|
||||
Revision 1.2 1999/03/08 14:58:22 peter
|
||||
+ prompt with dialogs for tools
|
||||
|
||||
Revision 1.1 1999/03/01 15:51:43 peter
|
||||
|
||||
@ -24,6 +24,8 @@ const
|
||||
cmUpdate = 54101;
|
||||
cmListFocusChanged = 54102;
|
||||
|
||||
CPlainCluster = #7#8#9#9;
|
||||
|
||||
type
|
||||
PCenterDialog = ^TCenterDialog;
|
||||
TCenterDialog = object(TDialog)
|
||||
@ -103,6 +105,64 @@ type
|
||||
procedure Draw; virtual;
|
||||
end;
|
||||
|
||||
PDropDownListBox = ^TDropDownListBox;
|
||||
|
||||
PDDHelperLB = ^TDDHelperLB;
|
||||
TDDHelperLB = object(TLocalMenuListBox)
|
||||
constructor Init(ALink: PDropDownListBox; var Bounds: TRect; ANumCols: Word; AScrollBar: PScrollBar);
|
||||
procedure HandleEvent(var Event: TEvent); virtual;
|
||||
procedure SetState(AState: Word; Enable: Boolean); virtual;
|
||||
procedure SelectItem(Item: Integer); virtual;
|
||||
function GetText(Item: sw_Integer; MaxLen: Integer): String; virtual;
|
||||
function GetLocalMenu: PMenu; virtual;
|
||||
function GetCommandTarget: PView; virtual;
|
||||
private
|
||||
Link : PDropDownListBox;
|
||||
LastTT: longint;
|
||||
InClose: boolean;
|
||||
end;
|
||||
|
||||
TDropDownListBox = object(TView)
|
||||
Text: string;
|
||||
Focused: sw_integer;
|
||||
List: PCollection;
|
||||
constructor Init(var Bounds: TRect; ADropLineCount: integer; AList: PCollection);
|
||||
procedure HandleEvent(var Event: TEvent); virtual;
|
||||
function GetText(Item: pointer; MaxLen: sw_integer): string; virtual;
|
||||
procedure NewList(AList: PCollection); virtual;
|
||||
procedure CreateListBox(var R: TRect);
|
||||
procedure DropList(Drop: boolean); virtual;
|
||||
function GetItemCount: sw_integer; virtual;
|
||||
procedure FocusItem(Item: sw_integer); virtual;
|
||||
function LBGetLocalMenu: PMenu; virtual;
|
||||
function LBGetCommandTarget: PView; virtual;
|
||||
procedure SetState(AState: Word; Enable: Boolean); virtual;
|
||||
procedure Draw; virtual;
|
||||
function GetPalette: PPalette; virtual;
|
||||
destructor Done; virtual;
|
||||
private
|
||||
DropLineCount: integer;
|
||||
ListDropped : boolean;
|
||||
ListBox : PDDHelperLB;
|
||||
SB : PScrollBar;
|
||||
end;
|
||||
|
||||
PGroupView = ^TGroupView;
|
||||
TGroupView = object(TLabel)
|
||||
constructor Init(var Bounds: TRect; AText: String; ALink: PView);
|
||||
procedure Draw; virtual;
|
||||
end;
|
||||
|
||||
PPlainCheckBoxes = ^TPlainCheckBoxes;
|
||||
TPlainCheckBoxes = object(TCheckBoxes)
|
||||
function GetPalette: PPalette; virtual;
|
||||
end;
|
||||
|
||||
PPlainRadioButtons = ^TPlainRadioButtons;
|
||||
TPlainRadioButtons = object(TRadioButtons)
|
||||
function GetPalette: PPalette; virtual;
|
||||
end;
|
||||
|
||||
procedure InsertOK(ADialog: PDialog);
|
||||
procedure InsertButtons(ADialog: PDialog);
|
||||
|
||||
@ -128,7 +188,9 @@ procedure NotImplemented;
|
||||
|
||||
implementation
|
||||
|
||||
uses Commands,App,MsgBox;
|
||||
uses Mouse,
|
||||
Commands,App,MsgBox,
|
||||
WUtils;
|
||||
|
||||
const
|
||||
MessageDialog : PCenterDialog = nil;
|
||||
@ -651,6 +713,7 @@ constructor TAdvancedMenuBar.Init(var Bounds: TRect; AMenu: PMenu);
|
||||
begin
|
||||
inherited Init(Bounds, AMenu);
|
||||
EventMask:=EventMask or evBroadcast;
|
||||
GrowMode:=gfGrowHiX;
|
||||
end;
|
||||
|
||||
function TAdvancedMenuBar.NewSubView(var Bounds: TRect; AMenu: PMenu;
|
||||
@ -1419,11 +1482,465 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
constructor TDDHelperLB.Init(ALink: PDropDownListBox; var Bounds: TRect; ANumCols: Word; AScrollBar: PScrollBar);
|
||||
begin
|
||||
inherited Init(Bounds,ANumCols,AScrollBar);
|
||||
EventMask:=EventMask or (evMouseMove+evIdle);
|
||||
{ Options:=Options or ofPreProcess;}
|
||||
Link:=ALink;
|
||||
end;
|
||||
|
||||
procedure TDDHelperLB.SetState(AState: Word; Enable: Boolean);
|
||||
var OState: longint;
|
||||
begin
|
||||
OState:=State;
|
||||
inherited SetState(AState,Enable);
|
||||
{ if (((State xor OState) and sfFocused)<>0) and (GetState(sfFocused)=false) then
|
||||
Link^.DropList(false);}
|
||||
end;
|
||||
|
||||
function TDDHelperLB.GetText(Item: sw_Integer; MaxLen: Integer): String;
|
||||
var P: pointer;
|
||||
S: string;
|
||||
begin
|
||||
P:=List^.At(Item);
|
||||
if Link=nil then S:='' else
|
||||
S:=Link^.GetText(P,MaxLen);
|
||||
GetText:=S;
|
||||
end;
|
||||
|
||||
function TDDHelperLB.GetLocalMenu: PMenu;
|
||||
begin
|
||||
GetLocalMenu:=Link^.LBGetLocalMenu;
|
||||
end;
|
||||
|
||||
function TDDHelperLB.GetCommandTarget: PView;
|
||||
begin
|
||||
GetCommandTarget:=Link^.LBGetCommandTarget;
|
||||
end;
|
||||
|
||||
procedure TDDHelperLB.HandleEvent(var Event: TEvent);
|
||||
const
|
||||
MouseAutosToSkip = 4;
|
||||
var
|
||||
Mouse : TPoint;
|
||||
OldItem, NewItem : Sw_Integer;
|
||||
ColWidth,Count : Sw_Word;
|
||||
GoSelectItem: sw_integer;
|
||||
MouseWhere: TPoint;
|
||||
begin
|
||||
GoSelectItem:=-1;
|
||||
TView.HandleEvent(Event);
|
||||
case Event.What of
|
||||
evMouseDown :
|
||||
if MouseInView(Event.Where)=false then
|
||||
GoSelectItem:=-2
|
||||
else
|
||||
begin
|
||||
ColWidth := Size.X div NumCols + 1;
|
||||
OldItem := Focused;
|
||||
MakeLocal(Event.Where, Mouse);
|
||||
if MouseInView(Event.Where) then
|
||||
NewItem := Mouse.Y + (Size.Y * (Mouse.X div ColWidth)) + TopItem
|
||||
else
|
||||
NewItem := OldItem;
|
||||
Count := 0;
|
||||
repeat
|
||||
if NewItem <> OldItem then
|
||||
begin
|
||||
FocusItemNum(NewItem);
|
||||
DrawView;
|
||||
end;
|
||||
OldItem := NewItem;
|
||||
MakeLocal(Event.Where, Mouse);
|
||||
if MouseInView(Event.Where) then
|
||||
NewItem := Mouse.Y + (Size.Y * (Mouse.X div ColWidth)) + TopItem
|
||||
else
|
||||
begin
|
||||
if NumCols = 1 then
|
||||
begin
|
||||
if Event.What = evMouseAuto then Inc(Count);
|
||||
if Count = MouseAutosToSkip then
|
||||
begin
|
||||
Count := 0;
|
||||
if Mouse.Y < 0 then NewItem := Focused-1
|
||||
else if Mouse.Y >= Size.Y then NewItem := Focused+1;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if Event.What = evMouseAuto then Inc(Count);
|
||||
if Count = MouseAutosToSkip then
|
||||
begin
|
||||
Count := 0;
|
||||
if Mouse.X < 0 then NewItem := Focused-Size.Y
|
||||
else if Mouse.X >= Size.X then NewItem := Focused+Size.Y
|
||||
else if Mouse.Y < 0 then
|
||||
NewItem := Focused - Focused mod Size.Y
|
||||
else if Mouse.Y > Size.Y then
|
||||
NewItem := Focused - Focused mod Size.Y + Size.Y - 1;
|
||||
end
|
||||
end;
|
||||
end;
|
||||
until not MouseEvent(Event, evMouseMove + evMouseAuto);
|
||||
FocusItemNum(NewItem);
|
||||
DrawView;
|
||||
if Event.Double and (Range > Focused) then SelectItem(Focused);
|
||||
ClearEvent(Event);
|
||||
GoSelectItem:=Focused;
|
||||
end;
|
||||
evMouseMove,evMouseAuto:
|
||||
if GetState(sfFocused) then
|
||||
if MouseInView(Event.Where) then
|
||||
begin
|
||||
MakeLocal(Event.Where,Mouse);
|
||||
FocusItemNum(TopItem+Mouse.Y);
|
||||
ClearEvent(Event);
|
||||
end;
|
||||
evKeyDown :
|
||||
begin
|
||||
if (Event.KeyCode=kbEsc) then
|
||||
begin
|
||||
GoSelectItem:=-2;
|
||||
ClearEvent(Event);
|
||||
end else
|
||||
if (Event.CharCode = ' ') and (Focused < Range) then
|
||||
begin
|
||||
GoSelectItem:=Focused;
|
||||
NewItem := Focused;
|
||||
end
|
||||
else
|
||||
case CtrlToArrow(Event.KeyCode) of
|
||||
kbUp : NewItem := Focused - 1;
|
||||
kbDown : NewItem := Focused + 1;
|
||||
kbRight: if NumCols > 1 then NewItem := Focused + Size.Y else Exit;
|
||||
kbLeft : if NumCols > 1 then NewItem := Focused - Size.Y else Exit;
|
||||
kbPgDn : NewItem := Focused + Size.Y * NumCols;
|
||||
kbPgUp : NewItem := Focused - Size.Y * NumCols;
|
||||
kbHome : NewItem := TopItem;
|
||||
kbEnd : NewItem := TopItem + (Size.Y * NumCols) - 1;
|
||||
kbCtrlPgDn: NewItem := Range - 1;
|
||||
kbCtrlPgUp: NewItem := 0;
|
||||
else
|
||||
Exit;
|
||||
end;
|
||||
FocusItemNum(NewItem);
|
||||
DrawView;
|
||||
ClearEvent(Event);
|
||||
end;
|
||||
evBroadcast :
|
||||
case Event.Command of
|
||||
cmReceivedFocus :
|
||||
if (Event.InfoPtr<>@Self) and (InClose=false) then
|
||||
begin
|
||||
GoSelectItem:=-2;
|
||||
end;
|
||||
else
|
||||
if Options and ofSelectable <> 0 then
|
||||
if (Event.Command = cmScrollBarClicked) and
|
||||
((Event.InfoPtr = HScrollBar) or (Event.InfoPtr = VScrollBar)) then
|
||||
Select
|
||||
else
|
||||
if (Event.Command = cmScrollBarChanged) then
|
||||
begin
|
||||
if (VScrollBar = Event.InfoPtr) then
|
||||
begin
|
||||
FocusItemNum(VScrollBar^.Value);
|
||||
DrawView;
|
||||
end
|
||||
else
|
||||
if (HScrollBar = Event.InfoPtr) then
|
||||
DrawView;
|
||||
end;
|
||||
end;
|
||||
evIdle :
|
||||
begin
|
||||
MouseWhere.X:=MouseWhereX shr 3; MouseWhere.Y:=MouseWhereY shr 3;
|
||||
if MouseInView(MouseWhere)=false then
|
||||
if abs(GetDosTicks-LastTT)>=1 then
|
||||
begin
|
||||
LastTT:=GetDosTicks;
|
||||
MakeLocal(MouseWhere,Mouse);
|
||||
if ((Mouse.Y<-1) or (Mouse.Y>=Size.Y)) and
|
||||
((0<=Mouse.X) and (Mouse.X<Size.X)) then
|
||||
if Range>0 then
|
||||
if Mouse.Y<0 then
|
||||
FocusItemNum(Focused-(0-Mouse.Y))
|
||||
else
|
||||
FocusItemNum(Focused+(Mouse.Y-(Size.Y-1)));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if (Range>0) and (GoSelectItem<>-1) then
|
||||
begin
|
||||
InClose:=true;
|
||||
if GoSelectItem=-2 then
|
||||
Link^.DropList(false)
|
||||
else
|
||||
SelectItem(GoSelectItem);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDDHelperLB.SelectItem(Item: Integer);
|
||||
begin
|
||||
inherited SelectItem(Item);
|
||||
Link^.FocusItem(Focused);
|
||||
Link^.DropList(false);
|
||||
end;
|
||||
|
||||
constructor TDropDownListBox.Init(var Bounds: TRect; ADropLineCount: integer; AList: PCollection);
|
||||
begin
|
||||
inherited Init(Bounds);
|
||||
Options:=Options or (ofSelectable);
|
||||
EventMask:=EventMask or (evBroadcast);
|
||||
DropLineCount:=ADropLineCount;
|
||||
NewList(AList);
|
||||
end;
|
||||
|
||||
procedure TDropDownListBox.HandleEvent(var Event: TEvent);
|
||||
var DontClear: boolean;
|
||||
Count: sw_integer;
|
||||
begin
|
||||
case Event.What of
|
||||
evKeyDown :
|
||||
if GetState(sfFocused) then
|
||||
begin
|
||||
DontClear:=false;
|
||||
Count:=GetItemCount;
|
||||
if Count>0 then
|
||||
case Event.KeyCode of
|
||||
kbUp :
|
||||
if Focused>0 then
|
||||
FocusItem(Focused-1);
|
||||
kbDown :
|
||||
if Focused<Count-1 then
|
||||
FocusItem(Focused+1);
|
||||
kbHome :
|
||||
FocusItem(0);
|
||||
kbEnd :
|
||||
FocusItem(Count-1);
|
||||
kbPgDn :
|
||||
DropList(true);
|
||||
else DontClear:=true;
|
||||
end;
|
||||
if DontClear=false then ClearEvent(Event);
|
||||
end;
|
||||
evBroadcast :
|
||||
case Event.Command of
|
||||
{ cmReleasedFocus :
|
||||
if (ListBox<>nil) and (Event.InfoPtr=ListBox) then
|
||||
DropList(false);}
|
||||
cmListItemSelected :
|
||||
if (ListBox<>nil) and (Event.InfoPtr=ListBox) then
|
||||
begin
|
||||
FocusItem(ListBox^.Focused);
|
||||
Text:=GetText(List^.At(Focused),255);
|
||||
DrawView;
|
||||
DropList(false);
|
||||
end;
|
||||
end;
|
||||
evMouseDown :
|
||||
if MouseInView(Event.Where) then
|
||||
begin
|
||||
DropList(not ListDropped);
|
||||
ClearEvent(Event);
|
||||
end;
|
||||
end;
|
||||
inherited HandleEvent(Event);
|
||||
end;
|
||||
|
||||
function TDropDownListBox.GetText(Item: pointer; MaxLen: integer): string;
|
||||
var S: string;
|
||||
begin
|
||||
S:=GetStr(Item);
|
||||
GetText:=copy(S,1,MaxLen);
|
||||
end;
|
||||
|
||||
procedure TDropDownListBox.NewList(AList: PCollection);
|
||||
begin
|
||||
if List<>nil then Dispose(List, Done); List:=nil;
|
||||
List:=AList; FocusItem(0);
|
||||
end;
|
||||
|
||||
procedure TDropDownListBox.CreateListBox(var R: TRect);
|
||||
var R2: TRect;
|
||||
begin
|
||||
R2.Copy(R); R2.A.X:=R2.B.X-1;
|
||||
New(SB, Init(R2));
|
||||
Dec(R.B.X);
|
||||
New(ListBox, Init(@Self,R,1,SB));
|
||||
end;
|
||||
|
||||
procedure TDropDownListBox.DropList(Drop: boolean);
|
||||
var R: TRect;
|
||||
begin
|
||||
if ListDropped=Drop then Exit;
|
||||
|
||||
if Drop then
|
||||
begin
|
||||
R.Assign(Origin.X+1,Origin.Y+Size.Y,Origin.X+Size.X,Origin.Y+Size.Y+DropLineCount);
|
||||
if Owner<>nil then Owner^.Lock;
|
||||
CreateListBox(R);
|
||||
if SB<>nil then
|
||||
Owner^.Insert(SB);
|
||||
if ListBox<>nil then
|
||||
begin
|
||||
ListBox^.NewList(List);
|
||||
ListBox^.FocusItem(Focused);
|
||||
Owner^.Insert(ListBox);
|
||||
end;
|
||||
if Owner<>nil then Owner^.UnLock;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if Owner<>nil then Owner^.Lock;
|
||||
if ListBox<>nil then
|
||||
begin
|
||||
{ ListBox^.List:=nil;}
|
||||
Dispose(ListBox, Done);
|
||||
ListBox:=nil;
|
||||
end;
|
||||
if SB<>nil then
|
||||
begin
|
||||
Dispose(SB, Done);
|
||||
SB:=nil;
|
||||
end;
|
||||
Select;
|
||||
if Owner<>nil then Owner^.UnLock;
|
||||
end;
|
||||
|
||||
ListDropped:=Drop;
|
||||
DrawView;
|
||||
end;
|
||||
|
||||
function TDropDownListBox.GetItemCount: sw_integer;
|
||||
var Count: sw_integer;
|
||||
begin
|
||||
if assigned(List)=false then Count:=0 else
|
||||
Count:=List^.Count;
|
||||
GetItemCount:=Count;
|
||||
end;
|
||||
|
||||
procedure TDropDownListBox.FocusItem(Item: sw_integer);
|
||||
var P: pointer;
|
||||
begin
|
||||
Focused:=Item;
|
||||
if assigned(ListBox) and (Item>=0) then
|
||||
ListBox^.FocusItem(Item);
|
||||
if (GetItemCount>0) and (Focused>=0) then
|
||||
begin
|
||||
P:=List^.At(Focused);
|
||||
Text:=GetText(P,Size.X-4);
|
||||
end;
|
||||
DrawView;
|
||||
end;
|
||||
|
||||
function TDropDownListBox.LBGetLocalMenu: PMenu;
|
||||
begin
|
||||
LBGetLocalMenu:=nil;
|
||||
end;
|
||||
|
||||
function TDropDownListBox.LBGetCommandTarget: PView;
|
||||
begin
|
||||
LBGetCommandTarget:=@Self;
|
||||
end;
|
||||
|
||||
procedure TDropDownListBox.SetState(AState: Word; Enable: Boolean);
|
||||
begin
|
||||
inherited SetState(AState,Enable);
|
||||
if (AState and (sfSelected + sfActive + sfFocused)) <> 0 then DrawView;
|
||||
end;
|
||||
|
||||
procedure TDropDownListBox.Draw;
|
||||
var B: TDrawBuffer;
|
||||
C,TextC: word;
|
||||
LC: char;
|
||||
begin
|
||||
if GetState(sfFocused)=false then
|
||||
begin
|
||||
C:=GetColor(2);
|
||||
TextC:=GetColor(2);
|
||||
end
|
||||
else
|
||||
begin
|
||||
C:=GetColor(3);
|
||||
TextC:=GetColor(3);
|
||||
end;
|
||||
MoveChar(B,' ',C,Size.X);
|
||||
MoveStr(B[1],copy(Text,1,Size.X-2),TextC);
|
||||
if ListDropped then LC:=#30 else LC:=#31;
|
||||
MoveChar(B[Size.X-2],LC,C,1);
|
||||
WriteLine(0,0,Size.X,Size.Y,B);
|
||||
end;
|
||||
|
||||
function TDropDownListBox.GetPalette: PPalette;
|
||||
const P: string[length(CListViewer)] = CListViewer;
|
||||
begin
|
||||
GetPalette:=@P;
|
||||
end;
|
||||
|
||||
destructor TDropDownListBox.Done;
|
||||
begin
|
||||
if ListDropped then DropList(false);
|
||||
inherited Done;
|
||||
end;
|
||||
|
||||
constructor TGroupView.Init(var Bounds: TRect; AText: String; ALink: PView);
|
||||
begin
|
||||
inherited Init(Bounds,AText,ALink);
|
||||
end;
|
||||
|
||||
procedure TGroupView.Draw;
|
||||
var B: TDrawBuffer;
|
||||
FrameC,LabelC: word;
|
||||
begin
|
||||
FrameC:=GetColor(1);
|
||||
if Light then
|
||||
LabelC:=GetColor(2)+GetColor(4) shl 8
|
||||
else
|
||||
LabelC:=GetColor(1)+GetColor(3) shl 8;
|
||||
{ First Line }
|
||||
MoveChar(B[0],'Ú',FrameC,1);
|
||||
MoveChar(B[1],'Ä',FrameC,Size.X-2);
|
||||
MoveChar(B[Size.X-1],'¿',FrameC,1);
|
||||
if Text<>nil then
|
||||
begin
|
||||
MoveCStr(B[1],' '+Text^+' ',LabelC);
|
||||
end;
|
||||
WriteLine(0,0,Size.X,1,B);
|
||||
{ Mid Lines }
|
||||
MoveChar(B[0],'³',FrameC,1);
|
||||
MoveChar(B[1],' ',FrameC,Size.X-2);
|
||||
MoveChar(B[Size.X-1],'³',FrameC,1);
|
||||
WriteLine(0,1,Size.X,Size.Y-2,B);
|
||||
{ Last Line }
|
||||
MoveChar(B[0],'À',FrameC,1);
|
||||
MoveChar(B[1],'Ä',FrameC,Size.X-2);
|
||||
MoveChar(B[Size.X-1],'Ù',FrameC,1);
|
||||
WriteLine(0,Size.Y-1,Size.X,1,B);
|
||||
end;
|
||||
|
||||
function TPlainCheckBoxes.GetPalette: PPalette;
|
||||
const P: string[length(CPlainCluster)] = CPlainCluster;
|
||||
begin
|
||||
GetPalette:=@P;
|
||||
end;
|
||||
|
||||
function TPlainRadioButtons.GetPalette: PPalette;
|
||||
const P: string[length(CPlainCluster)] = CPlainCluster;
|
||||
begin
|
||||
GetPalette:=@P;
|
||||
end;
|
||||
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 1999-03-19 16:04:35 peter
|
||||
Revision 1.4 1999-03-23 15:11:42 peter
|
||||
* desktop saving things
|
||||
* vesa mode
|
||||
* preferences dialog
|
||||
|
||||
Revision 1.3 1999/03/19 16:04:35 peter
|
||||
* new compiler dialog
|
||||
|
||||
Revision 1.2 1999/03/08 14:58:23 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user