mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 14:09:17 +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}
|
{$endif IDEHeapTrc}
|
||||||
Dos,
|
Dos,
|
||||||
BrowCol,
|
BrowCol,
|
||||||
FPIni,FPViews,FPConst,FPVars,FPUtils,FPIde,FPHelp,FPSwitch,FPUsrScr,
|
WViews,
|
||||||
FPTools,FPDebug,FPTemplt,FPCatch,FPRedir
|
FPIDE,
|
||||||
|
FPIni,FPViews,FPConst,FPVars,FPUtils,FPHelp,FPSwitch,FPUsrScr,
|
||||||
|
FPTools,FPDebug,FPTemplt,FPCatch,FPRedir,FPDesk
|
||||||
{$ifdef TEMPHEAP}
|
{$ifdef TEMPHEAP}
|
||||||
,dpmiexcp
|
,dpmiexcp
|
||||||
{$endif TEMPHEAP}
|
{$endif TEMPHEAP}
|
||||||
@ -68,6 +70,8 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
var CanExit : boolean;
|
||||||
|
|
||||||
BEGIN
|
BEGIN
|
||||||
{$ifdef DEV}HeapLimit:=4096;{$endif}
|
{$ifdef DEV}HeapLimit:=4096;{$endif}
|
||||||
writeln('þ Free Pascal IDE Version '+VersionStr);
|
writeln('þ Free Pascal IDE Version '+VersionStr);
|
||||||
@ -76,6 +80,9 @@ BEGIN
|
|||||||
|
|
||||||
ProcessParams(true);
|
ProcessParams(true);
|
||||||
|
|
||||||
|
{$ifndef FV20}
|
||||||
|
InitVESAScreenModes;
|
||||||
|
{$endif}
|
||||||
InitRedir;
|
InitRedir;
|
||||||
InitBreakpoints;
|
InitBreakpoints;
|
||||||
InitReservedWords;
|
InitReservedWords;
|
||||||
@ -92,16 +99,29 @@ BEGIN
|
|||||||
|
|
||||||
{ load all options after init because of open files }
|
{ load all options after init because of open files }
|
||||||
ReadINIFile;
|
ReadINIFile;
|
||||||
|
InitDesktopFile;
|
||||||
|
LoadDesktop;
|
||||||
|
|
||||||
{ Update IDE }
|
{ Update IDE }
|
||||||
MyApp.Update;
|
MyApp.Update;
|
||||||
|
|
||||||
ProcessParams(false);
|
ProcessParams(false);
|
||||||
|
|
||||||
|
repeat
|
||||||
MyApp.Run;
|
MyApp.Run;
|
||||||
|
if (AutoSaveOptions and asEditorFiles)=0 then CanExit:=true else
|
||||||
|
CanExit:=MyApp.SaveAll;
|
||||||
|
until CanExit;
|
||||||
|
|
||||||
{ must be written before done for open files }
|
{ 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;
|
MyApp.Done;
|
||||||
|
|
||||||
@ -119,7 +139,12 @@ BEGIN
|
|||||||
END.
|
END.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
+ functional screen mode switching added
|
||||||
|
|
||||||
Revision 1.17 1999/03/16 12:38:06 peter
|
Revision 1.17 1999/03/16 12:38:06 peter
|
||||||
|
|||||||
@ -30,6 +30,7 @@ const
|
|||||||
|
|
||||||
ININame = 'fp.ini';
|
ININame = 'fp.ini';
|
||||||
SwitchesName = 'fp.cfg';
|
SwitchesName = 'fp.cfg';
|
||||||
|
DesktopName = 'fp.dsk';
|
||||||
|
|
||||||
ToolCaptureName = '$$TOOL$$.OUT';
|
ToolCaptureName = '$$TOOL$$.OUT';
|
||||||
FilterCaptureName = '$FILTER$.OUT';
|
FilterCaptureName = '$FILTER$.OUT';
|
||||||
@ -69,6 +70,20 @@ const
|
|||||||
dfOpenWindows = $00000010;
|
dfOpenWindows = $00000010;
|
||||||
dfSymbolInformation = $00000020;
|
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 }
|
{ Command constants }
|
||||||
cmShowClipboard = 201;
|
cmShowClipboard = 201;
|
||||||
cmFindProcedure = 206;
|
cmFindProcedure = 206;
|
||||||
@ -308,7 +323,12 @@ implementation
|
|||||||
END.
|
END.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* new compiler dialog
|
||||||
|
|
||||||
Revision 1.14 1999/03/16 12:38:08 peter
|
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;
|
FPConst,FPVars,FPUtils;
|
||||||
|
|
||||||
const
|
const
|
||||||
MaxStatusLevel = 5;
|
MaxStatusLevel = {$ifdef FPC}10{$else}2{$endif};
|
||||||
|
|
||||||
var StatusStack : array[0..MaxStatusLevel] of string[MaxViewWidth];
|
var StatusStack : array[0..MaxStatusLevel] of string[MaxViewWidth];
|
||||||
|
|
||||||
@ -379,7 +379,12 @@ end;
|
|||||||
END.
|
END.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* tools macro fixes
|
||||||
+ tph writer
|
+ tph writer
|
||||||
+ first things for resource files
|
+ first things for resource files
|
||||||
|
|||||||
@ -31,6 +31,7 @@ type
|
|||||||
procedure InitStatusLine; virtual;
|
procedure InitStatusLine; virtual;
|
||||||
procedure Open(FileName: string);
|
procedure Open(FileName: string);
|
||||||
function OpenSearch(FileName: string) : boolean;
|
function OpenSearch(FileName: string) : boolean;
|
||||||
|
function SaveAll: boolean;
|
||||||
procedure Idle; virtual;
|
procedure Idle; virtual;
|
||||||
procedure Update;
|
procedure Update;
|
||||||
procedure HandleEvent(var Event: TEvent); virtual;
|
procedure HandleEvent(var Event: TEvent); virtual;
|
||||||
@ -45,7 +46,6 @@ type
|
|||||||
procedure NewEditor;
|
procedure NewEditor;
|
||||||
procedure NewFromTemplate;
|
procedure NewFromTemplate;
|
||||||
procedure OpenRecentFile(RecentIndex: integer);
|
procedure OpenRecentFile(RecentIndex: integer);
|
||||||
procedure SaveAll;
|
|
||||||
procedure ChangeDir;
|
procedure ChangeDir;
|
||||||
procedure ShowClipboard;
|
procedure ShowClipboard;
|
||||||
procedure FindProcedure;
|
procedure FindProcedure;
|
||||||
@ -105,6 +105,7 @@ type
|
|||||||
function SearchRecentFile(AFileName: string): integer;
|
function SearchRecentFile(AFileName: string): integer;
|
||||||
procedure RemoveRecentFile(Index: integer);
|
procedure RemoveRecentFile(Index: integer);
|
||||||
private
|
private
|
||||||
|
SaveCancelled: boolean;
|
||||||
procedure CurDirChanged;
|
procedure CurDirChanged;
|
||||||
procedure UpdatePrimaryFile;
|
procedure UpdatePrimaryFile;
|
||||||
procedure UpdateINIFile;
|
procedure UpdateINIFile;
|
||||||
@ -451,6 +452,8 @@ begin
|
|||||||
end;
|
end;
|
||||||
evBroadcast :
|
evBroadcast :
|
||||||
case Event.Command of
|
case Event.Command of
|
||||||
|
cmSaveCancelled :
|
||||||
|
SaveCancelled:=true;
|
||||||
cmUpdateTools :
|
cmUpdateTools :
|
||||||
UpdateTools;
|
UpdateTools;
|
||||||
cmUpdate :
|
cmUpdate :
|
||||||
@ -731,7 +734,12 @@ end;
|
|||||||
END.
|
END.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* new compiler dialog
|
||||||
|
|
||||||
Revision 1.23 1999/03/16 12:38:10 peter
|
Revision 1.23 1999/03/16 12:38:10 peter
|
||||||
|
|||||||
@ -53,6 +53,7 @@ const
|
|||||||
secSearch = 'Search';
|
secSearch = 'Search';
|
||||||
secTools = 'Tools';
|
secTools = 'Tools';
|
||||||
secSourcePath = 'SourcePath';
|
secSourcePath = 'SourcePath';
|
||||||
|
secPreferences = 'Preferences';
|
||||||
|
|
||||||
{ INI file tags }
|
{ INI file tags }
|
||||||
ieRecentFile = 'RecentFile';
|
ieRecentFile = 'RecentFile';
|
||||||
@ -86,6 +87,11 @@ const
|
|||||||
ieBreakpointLine = 'LineNumber';
|
ieBreakpointLine = 'LineNumber';
|
||||||
ieBreakpointCond = 'Condition';
|
ieBreakpointCond = 'Condition';
|
||||||
ieSourceList = 'SourceList';
|
ieSourceList = 'SourceList';
|
||||||
|
ieVideoMode = 'VideoMode';
|
||||||
|
ieAutoSave = 'AutoSaveFlags';
|
||||||
|
ieMiscOptions = 'MiscOptions';
|
||||||
|
ieDesktopLocation = 'DesktopLocation';
|
||||||
|
ieDesktopFlags = 'DesktopFileFlags';
|
||||||
|
|
||||||
procedure InitINIFile;
|
procedure InitINIFile;
|
||||||
var S: string;
|
var S: string;
|
||||||
@ -338,6 +344,12 @@ begin
|
|||||||
{ remove it because otherwise we allways keep old files }
|
{ remove it because otherwise we allways keep old files }
|
||||||
INIFile^.DeleteEntry(secFiles,ieOpenFile+IntToStr(I));
|
INIFile^.DeleteEntry(secFiles,ieOpenFile+IntToStr(I));
|
||||||
end;
|
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);
|
Dispose(INIFile, Done);
|
||||||
end;
|
end;
|
||||||
ReadINIFile:=OK;
|
ReadINIFile:=OK;
|
||||||
@ -456,6 +468,12 @@ begin
|
|||||||
INIFile^.SetEntry(secColors,iePalette+'_161_200',PaletteToStr(copy(S,161,40)));
|
INIFile^.SetEntry(secColors,iePalette+'_161_200',PaletteToStr(copy(S,161,40)));
|
||||||
INIFile^.SetEntry(secColors,iePalette+'_201_240',PaletteToStr(copy(S,201,40)));
|
INIFile^.SetEntry(secColors,iePalette+'_201_240',PaletteToStr(copy(S,201,40)));
|
||||||
end;
|
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;
|
OK:=INIFile^.Update;
|
||||||
Dispose(INIFile, Done);
|
Dispose(INIFile, Done);
|
||||||
WriteINIFile:=OK;
|
WriteINIFile:=OK;
|
||||||
@ -464,7 +482,12 @@ end;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* flag if trytoopen should look for other extensions
|
||||||
+ browser tab in the tools-compiler
|
+ browser tab in the tools-compiler
|
||||||
|
|
||||||
|
|||||||
@ -136,7 +136,7 @@ begin
|
|||||||
RemoveRecentFile(RecentIndex);
|
RemoveRecentFile(RecentIndex);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TIDEApp.SaveAll;
|
function TIDEApp.SaveAll: boolean;
|
||||||
|
|
||||||
procedure SendSave(P: PView); {$ifndef FPC}far;{$endif}
|
procedure SendSave(P: PView); {$ifndef FPC}far;{$endif}
|
||||||
begin
|
begin
|
||||||
@ -144,7 +144,9 @@ procedure TIDEApp.SaveAll;
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
SaveCancelled:=false;
|
||||||
Desktop^.ForEach(@SendSave);
|
Desktop^.ForEach(@SendSave);
|
||||||
|
SaveAll:=not SaveCancelled;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -156,7 +158,12 @@ end;
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
+ open dialog supports mask list
|
||||||
|
|
||||||
Revision 1.8 1999/02/05 12:11:57 pierre
|
Revision 1.8 1999/02/05 12:11:57 pierre
|
||||||
|
|||||||
@ -475,7 +475,7 @@ begin
|
|||||||
ExecuteDialog(New(PToolsDialog, Init),nil);
|
ExecuteDialog(New(PToolsDialog, Init),nil);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TIDEApp.Preferences;
|
(*procedure TIDEApp.Preferences;
|
||||||
var R,R2: TRect;
|
var R,R2: TRect;
|
||||||
D: PCenterDialog;
|
D: PCenterDialog;
|
||||||
RB1 : PRadioButtons;
|
RB1 : PRadioButtons;
|
||||||
@ -549,6 +549,141 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
Dispose(D, Done);
|
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;
|
end;
|
||||||
|
|
||||||
procedure TIDEApp.EditorOptions(Editor: PEditor);
|
procedure TIDEApp.EditorOptions(Editor: PEditor);
|
||||||
@ -930,7 +1065,12 @@ end;
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
+ functional screen mode switching added
|
||||||
|
|
||||||
Revision 1.21 1999/03/16 12:38:12 peter
|
Revision 1.21 1999/03/16 12:38:12 peter
|
||||||
|
|||||||
@ -113,7 +113,7 @@ const
|
|||||||
('~N~ormal','~D~ebug','~R~elease');
|
('~N~ormal','~D~ebug','~R~elease');
|
||||||
SwitchesModeStr : array[TSwitchMode] of string[8]=
|
SwitchesModeStr : array[TSwitchMode] of string[8]=
|
||||||
('NORMAL','DEBUG','RELEASE');
|
('NORMAL','DEBUG','RELEASE');
|
||||||
CustomArg : array[TSwitchMode] of string=
|
CustomArg : array[TSwitchMode] of string{$ifndef FPC}[128]{$endif}=
|
||||||
('','','');
|
('','','');
|
||||||
|
|
||||||
var
|
var
|
||||||
@ -841,7 +841,12 @@ end;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* flag if trytoopen should look for other extensions
|
||||||
+ browser tab in the tools-compiler
|
+ browser tab in the tools-compiler
|
||||||
|
|
||||||
|
|||||||
@ -129,7 +129,7 @@ procedure ClearToolMessages;
|
|||||||
procedure UpdateToolMessages;
|
procedure UpdateToolMessages;
|
||||||
|
|
||||||
const
|
const
|
||||||
ToolFilter : string = '';
|
ToolFilter : string[128] = '';
|
||||||
CaptureToolTo : TCaptureTarget = capNone;
|
CaptureToolTo : TCaptureTarget = capNone;
|
||||||
ToolMessages : PCollection = nil;
|
ToolMessages : PCollection = nil;
|
||||||
ToolModuleNames: PStoreCollection = nil;
|
ToolModuleNames: PStoreCollection = nil;
|
||||||
@ -1426,7 +1426,12 @@ end;
|
|||||||
END.
|
END.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* tools macro fixes
|
||||||
+ tph writer
|
+ tph writer
|
||||||
+ first things for resource files
|
+ first things for resource files
|
||||||
|
|||||||
@ -60,7 +60,11 @@ const ClipboardWindow : PClipboardWindow = nil;
|
|||||||
StartupOptions : longint = 0;
|
StartupOptions : longint = 0;
|
||||||
LastExitCode : integer = 0;
|
LastExitCode : integer = 0;
|
||||||
ASCIIChart : PFPASCIIChart = nil;
|
ASCIIChart : PFPASCIIChart = nil;
|
||||||
|
DesktopPath : string = DesktopName;
|
||||||
DesktopFileFlags : longint = dfHistoryLists+dfOpenWindows;
|
DesktopFileFlags : longint = dfHistoryLists+dfOpenWindows;
|
||||||
|
DesktopLocation : byte = dlConfigFileDir;
|
||||||
|
AutoSaveOptions : longint = asEnvironment+asDesktop;
|
||||||
|
MiscOptions : longint = moChangeDirOnOpen+moCloseOnGotoSource;
|
||||||
|
|
||||||
ActionCommands : array[acFirstAction..acLastAction] of word =
|
ActionCommands : array[acFirstAction..acLastAction] of word =
|
||||||
(cmHelpTopicSearch,cmGotoCursor,cmToggleBreakpoint,
|
(cmHelpTopicSearch,cmGotoCursor,cmToggleBreakpoint,
|
||||||
@ -75,7 +79,12 @@ implementation
|
|||||||
END.
|
END.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* new compiler dialog
|
||||||
|
|
||||||
Revision 1.13 1999/03/16 12:38:15 peter
|
Revision 1.13 1999/03/16 12:38:15 peter
|
||||||
|
|||||||
@ -278,6 +278,11 @@ type
|
|||||||
destructor Done; virtual;
|
destructor Done; virtual;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
PVideoModeListBox = ^TVideoModeListBox;
|
||||||
|
TVideoModeListBox = object(TDropDownListBox)
|
||||||
|
function GetText(Item: pointer; MaxLen: sw_integer): string; virtual;
|
||||||
|
end;
|
||||||
|
|
||||||
function SearchFreeWindowNo: integer;
|
function SearchFreeWindowNo: integer;
|
||||||
|
|
||||||
function IsThereAnyEditor: boolean;
|
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;
|
function StartEditor(Editor: PCodeEditor; FileName: string): boolean;
|
||||||
|
|
||||||
|
{$ifndef FV20}
|
||||||
|
procedure InitVESAScreenModes;
|
||||||
|
{$endif}
|
||||||
|
|
||||||
const
|
const
|
||||||
SourceCmds : TCommandSet =
|
SourceCmds : TCommandSet =
|
||||||
([cmSave,cmSaveAs,cmCompile]);
|
([cmSave,cmSaveAs,cmCompile]);
|
||||||
@ -326,8 +335,9 @@ var MsgParms : array[1..10] of
|
|||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Strings,Keyboard,Memory,MsgBox,Validate,
|
Video,Strings,Keyboard,Memory,MsgBox,Validate,
|
||||||
Tokens,Version,
|
Tokens,Version,
|
||||||
|
{$ifndef FV20}Vesa,{$endif}
|
||||||
FPSwitch,FPSymbol,FPDebug,FPVars,FPUtils,FPCompile,FPHelp;
|
FPSwitch,FPSymbol,FPDebug,FPVars,FPUtils,FPCompile,FPHelp;
|
||||||
|
|
||||||
const
|
const
|
||||||
@ -730,6 +740,7 @@ begin
|
|||||||
inherited Init(Bounds);
|
inherited Init(Bounds);
|
||||||
Options:=Options or gfGrowHiX or gfGrowHiY;
|
Options:=Options or gfGrowHiX or gfGrowHiY;
|
||||||
EventMask:=EventMask or evIdle;
|
EventMask:=EventMask or evIdle;
|
||||||
|
GrowMode:=gfGrowAll;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
constructor TFPHeapView.InitKb(var Bounds: TRect);
|
constructor TFPHeapView.InitKb(var Bounds: TRect);
|
||||||
@ -737,6 +748,7 @@ begin
|
|||||||
inherited InitKb(Bounds);
|
inherited InitKb(Bounds);
|
||||||
Options:=Options or gfGrowHiX or gfGrowHiY;
|
Options:=Options or gfGrowHiX or gfGrowHiY;
|
||||||
EventMask:=EventMask or evIdle;
|
EventMask:=EventMask or evIdle;
|
||||||
|
GrowMode:=gfGrowAll;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TFPHeapView.HandleEvent(var Event: TEvent);
|
procedure TFPHeapView.HandleEvent(var Event: TEvent);
|
||||||
@ -2436,10 +2448,52 @@ begin
|
|||||||
inherited Done;
|
inherited Done;
|
||||||
end;
|
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.
|
END.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
+ functional screen mode switching added
|
||||||
|
|
||||||
Revision 1.23 1999/03/19 16:04:33 peter
|
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;
|
cmFileNameChanged = 51234;
|
||||||
cmASCIIChar = 51235;
|
cmASCIIChar = 51235;
|
||||||
cmClearLineHighlights = 51236;
|
cmClearLineHighlights = 51236;
|
||||||
|
cmSaveCancelled = 51237;
|
||||||
|
|
||||||
{$ifdef FPC}
|
{$ifdef FPC}
|
||||||
EditorTextBufSize = 32768;
|
EditorTextBufSize = 32768;
|
||||||
@ -3117,7 +3118,10 @@ begin
|
|||||||
case EditorDialog(D, @FileName) of
|
case EditorDialog(D, @FileName) of
|
||||||
cmYes : OK := Save;
|
cmYes : OK := Save;
|
||||||
cmNo : begin Modified := False; OK:=true; end;
|
cmNo : begin Modified := False; OK:=true; end;
|
||||||
cmCancel : OK := False;
|
cmCancel : begin
|
||||||
|
OK := False;
|
||||||
|
Message(Application,evBroadcast,cmSaveCancelled,@Self);
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
SaveAsk:=OK;
|
SaveAsk:=OK;
|
||||||
@ -3405,7 +3409,12 @@ end;
|
|||||||
END.
|
END.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
+ prompt with dialogs for tools
|
||||||
|
|
||||||
Revision 1.26 1999/03/07 22:58:57 pierre
|
Revision 1.26 1999/03/07 22:58:57 pierre
|
||||||
|
|||||||
@ -138,6 +138,12 @@ type
|
|||||||
procedure WriteResourceTable;
|
procedure WriteResourceTable;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
PSimpleResourceFile = ^TSimpleResourceFile;
|
||||||
|
TSimpleResourceFile = object(TResourceFile)
|
||||||
|
constructor Create(AFileName: string);
|
||||||
|
constructor Load(AFileName: string);
|
||||||
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses CallSpec,
|
uses CallSpec,
|
||||||
@ -670,11 +676,38 @@ begin
|
|||||||
begin Entries^.DeleteAll; Dispose(Entries, Done); Entries:=nil; end;
|
begin Entries^.DeleteAll; Dispose(Entries, Done); Entries:=nil; end;
|
||||||
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.
|
END.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* tools macro fixes
|
||||||
+ tph writer
|
+ tph writer
|
||||||
+ first things for resource files
|
+ first things for resource files
|
||||||
|
|||||||
@ -27,12 +27,31 @@ type
|
|||||||
PByteArray = ^TByteArray;
|
PByteArray = ^TByteArray;
|
||||||
TByteArray = array[0..65520] of byte;
|
TByteArray = array[0..65520] of byte;
|
||||||
|
|
||||||
|
PNoDisposeCollection = ^TNoDisposeCollection;
|
||||||
|
TNoDisposeCollection = object(TCollection)
|
||||||
|
procedure FreeItem(Item: Pointer); virtual;
|
||||||
|
end;
|
||||||
|
|
||||||
PUnsortedStringCollection = ^TUnsortedStringCollection;
|
PUnsortedStringCollection = ^TUnsortedStringCollection;
|
||||||
TUnsortedStringCollection = object(TCollection)
|
TUnsortedStringCollection = object(TCollection)
|
||||||
function At(Index: Integer): PString;
|
function At(Index: Integer): PString;
|
||||||
procedure FreeItem(Item: Pointer); virtual;
|
procedure FreeItem(Item: Pointer); virtual;
|
||||||
end;
|
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}
|
{$ifdef TPUNIXLF}
|
||||||
procedure readln(var t:text;var s:string);
|
procedure readln(var t:text;var s:string);
|
||||||
{$endif}
|
{$endif}
|
||||||
@ -196,6 +215,10 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TNoDisposeCollection.FreeItem(Item: Pointer);
|
||||||
|
begin
|
||||||
|
{ don't do anything here }
|
||||||
|
end;
|
||||||
|
|
||||||
function TUnsortedStringCollection.At(Index: Integer): PString;
|
function TUnsortedStringCollection.At(Index: Integer): PString;
|
||||||
begin
|
begin
|
||||||
@ -207,10 +230,57 @@ begin
|
|||||||
if Item<>nil then DisposeStr(Item);
|
if Item<>nil then DisposeStr(Item);
|
||||||
end;
|
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.
|
END.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
+ prompt with dialogs for tools
|
||||||
|
|
||||||
Revision 1.1 1999/03/01 15:51:43 peter
|
Revision 1.1 1999/03/01 15:51:43 peter
|
||||||
|
|||||||
@ -24,6 +24,8 @@ const
|
|||||||
cmUpdate = 54101;
|
cmUpdate = 54101;
|
||||||
cmListFocusChanged = 54102;
|
cmListFocusChanged = 54102;
|
||||||
|
|
||||||
|
CPlainCluster = #7#8#9#9;
|
||||||
|
|
||||||
type
|
type
|
||||||
PCenterDialog = ^TCenterDialog;
|
PCenterDialog = ^TCenterDialog;
|
||||||
TCenterDialog = object(TDialog)
|
TCenterDialog = object(TDialog)
|
||||||
@ -103,6 +105,64 @@ type
|
|||||||
procedure Draw; virtual;
|
procedure Draw; virtual;
|
||||||
end;
|
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 InsertOK(ADialog: PDialog);
|
||||||
procedure InsertButtons(ADialog: PDialog);
|
procedure InsertButtons(ADialog: PDialog);
|
||||||
|
|
||||||
@ -128,7 +188,9 @@ procedure NotImplemented;
|
|||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses Commands,App,MsgBox;
|
uses Mouse,
|
||||||
|
Commands,App,MsgBox,
|
||||||
|
WUtils;
|
||||||
|
|
||||||
const
|
const
|
||||||
MessageDialog : PCenterDialog = nil;
|
MessageDialog : PCenterDialog = nil;
|
||||||
@ -651,6 +713,7 @@ constructor TAdvancedMenuBar.Init(var Bounds: TRect; AMenu: PMenu);
|
|||||||
begin
|
begin
|
||||||
inherited Init(Bounds, AMenu);
|
inherited Init(Bounds, AMenu);
|
||||||
EventMask:=EventMask or evBroadcast;
|
EventMask:=EventMask or evBroadcast;
|
||||||
|
GrowMode:=gfGrowHiX;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TAdvancedMenuBar.NewSubView(var Bounds: TRect; AMenu: PMenu;
|
function TAdvancedMenuBar.NewSubView(var Bounds: TRect; AMenu: PMenu;
|
||||||
@ -1419,11 +1482,465 @@ begin
|
|||||||
end;
|
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.
|
END.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* new compiler dialog
|
||||||
|
|
||||||
Revision 1.2 1999/03/08 14:58:23 peter
|
Revision 1.2 1999/03/08 14:58:23 peter
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user