diff --git a/ide/text/whtml.pas b/ide/text/whtml.pas
index 0f08c0f4dd..c448e70652 100644
--- a/ide/text/whtml.pas
+++ b/ide/text/whtml.pas
@@ -1,3 +1,16 @@
+{
+ $Id$
+ This file is part of the Free Pascal Integrated Development Environment
+ Copyright (c) 1998 by Berczi Gabor
+
+ 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 WHTML;
interface
@@ -684,4 +697,10 @@ end;
-END.
\ No newline at end of file
+END.
+{
+ $Log$
+ Revision 1.3 1999-03-01 15:51:42 peter
+ + Log
+
+}
diff --git a/ide/text/wutils.pas b/ide/text/wutils.pas
new file mode 100644
index 0000000000..94a1a9988d
--- /dev/null
+++ b/ide/text/wutils.pas
@@ -0,0 +1,136 @@
+{
+ $Id$
+ This file is part of the Free Pascal Integrated Development Environment
+ Copyright (c) 1998 by Berczi Gabor
+
+ 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 WUtils;
+
+interface
+
+uses Objects;
+
+type
+ PByteArray = ^TByteArray;
+ TByteArray = array[0..65520] of byte;
+
+ PUnsortedStringCollection = ^TUnsortedStringCollection;
+ TUnsortedStringCollection = object(TCollection)
+ function At(Index: Integer): PString;
+ procedure FreeItem(Item: Pointer); virtual;
+ end;
+
+function Min(A,B: longint): longint;
+function Max(A,B: longint): longint;
+
+function CharStr(C: char; Count: byte): string;
+function Trim(S: string): string;
+function UpcaseStr(S: string): string;
+function RExpand(S: string; MinLen: byte): string;
+function LTrim(S: string): string;
+function RTrim(S: string): string;
+function IntToStr(L: longint): string;
+function StrToInt(S: string): longint;
+function GetStr(P: PString): string;
+
+function EatIO: integer;
+
+const LastStrToIntResult : integer = 0;
+
+implementation
+
+function Min(A,B: longint): longint; begin if AB then Max:=A else Max:=B; end;
+function CharStr(C: char; Count: byte): string;
+var S: string;
+begin S[0]:=chr(Count); if Count>0 then FillChar(S[1],Count,C); CharStr:=S; end;
+
+function UpcaseStr(S: string): string;
+var I: integer;
+begin
+ for I:=1 to length(S) do
+ S[I]:=Upcase(S[I]);
+ UpcaseStr:=S;
+end;
+
+function RExpand(S: string; MinLen: byte): string;
+begin
+ if length(S)0 then L:=-1;
+ LastStrToIntResult:=C;
+ StrToInt:=L;
+end;
+
+function GetStr(P: PString): string;
+begin
+ if P=nil then GetStr:='' else GetStr:=P^;
+end;
+
+
+function EatIO: integer;
+begin
+ EatIO:=IOResult;
+end;
+
+
+
+function TUnsortedStringCollection.At(Index: Integer): PString;
+begin
+ At:=inherited At(Index);
+end;
+
+procedure TUnsortedStringCollection.FreeItem(Item: Pointer);
+begin
+ if Item<>nil then DisposeStr(Item);
+end;
+
+END.
+{
+ $Log$
+ Revision 1.1 1999-03-01 15:51:43 peter
+ + Log
+
+}
diff --git a/ide/text/wviews.pas b/ide/text/wviews.pas
new file mode 100644
index 0000000000..a6848301c3
--- /dev/null
+++ b/ide/text/wviews.pas
@@ -0,0 +1,1380 @@
+{
+ $Id$
+ This file is part of the Free Pascal Integrated Development Environment
+ Copyright (c) 1998 by Berczi Gabor
+
+ 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 WViews;
+
+interface
+
+uses Objects,Drivers,Views,Menus,Dialogs;
+
+const
+ evIdle = $8000;
+
+ cmLocalMenu = 54100;
+ cmUpdate = 54101;
+ cmListFocusChanged = 54102;
+
+type
+ PCenterDialog = ^TCenterDialog;
+ TCenterDialog = object(TDialog)
+ constructor Init(var Bounds: TRect; ATitle: TTitleStr);
+ end;
+
+ PAdvancedMenuBox = ^TAdvancedMenuBox;
+ TAdvancedMenuBox = object(TMenuBox)
+ function NewSubView(var Bounds: TRect; AMenu: PMenu;
+ AParentMenu: PMenuView): PMenuView; virtual;
+ function Execute: Word; virtual;
+ end;
+
+ PAdvancedMenuPopUp = ^TAdvancedMenuPopup;
+ TAdvancedMenuPopUp = object(TMenuPopup)
+ function NewSubView(var Bounds: TRect; AMenu: PMenu;
+ AParentMenu: PMenuView): PMenuView; virtual;
+ function Execute: Word; virtual;
+ end;
+
+ PAdvancedMenuBar = ^TAdvancedMenuBar;
+ TAdvancedMenuBar = object(TMenuBar)
+ constructor Init(var Bounds: TRect; AMenu: PMenu);
+ function NewSubView(var Bounds: TRect; AMenu: PMenu;
+ AParentMenu: PMenuView): PMenuView; virtual;
+ procedure Update; virtual;
+ procedure HandleEvent(var Event: TEvent); virtual;
+ function Execute: Word; virtual;
+ end;
+
+ PAdvancedStaticText = ^TAdvancedStaticText;
+ TAdvancedStaticText = object(TStaticText)
+ procedure SetText(S: string); virtual;
+ end;
+
+ PAdvancedListBox = ^TAdvancedListBox;
+ TAdvancedListBox = object(TListBox)
+ Default: boolean;
+ procedure FocusItem(Item: sw_integer); virtual;
+ procedure HandleEvent(var Event: TEvent); virtual;
+ end;
+
+ TLocalMenuListBox = object(TAdvancedListBox)
+ procedure HandleEvent(var Event: TEvent); virtual;
+ procedure LocalMenu(P: TPoint); virtual;
+ function GetLocalMenu: PMenu; virtual;
+ function GetCommandTarget: PView; virtual;
+ private
+ LastLocalCmd: word;
+ end;
+
+ PColorStaticText = ^TColorStaticText;
+ TColorStaticText = object(TAdvancedStaticText)
+ Color: word;
+ DontWrap: boolean;
+ Delta: TPoint;
+ constructor Init(var Bounds: TRect; AText: String; AColor: word);
+ procedure Draw; virtual;
+ end;
+
+ PHSListBox = ^THSListBox;
+ THSListBox = object(TLocalMenuListBox)
+ constructor Init(var Bounds: TRect; ANumCols: Word; AHScrollBar, AVScrollBar: PScrollBar);
+ end;
+
+ PDlgWindow = ^TDlgWindow;
+ TDlgWindow = object(TDialog)
+ constructor Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Integer);
+ end;
+
+ PAdvancedStatusLine = ^TAdvancedStatusLine;
+ TAdvancedStatusLine = object(TStatusLine)
+ StatusText: PString;
+ function GetStatusText: string; virtual;
+ procedure SetStatusText(const S: string); virtual;
+ procedure ClearStatusText; virtual;
+ procedure Draw; virtual;
+ end;
+
+procedure InsertOK(ADialog: PDialog);
+procedure InsertButtons(ADialog: PDialog);
+
+procedure ErrorBox(const S: string; Params: pointer);
+procedure WarningBox(const S: string; Params: pointer);
+procedure InformationBox(const S: string; Params: pointer);
+function ConfirmBox(const S: string; Params: pointer; CanCancel: boolean): word;
+
+procedure ShowMessage(Msg: string);
+procedure HideMessage;
+
+function SearchMenuItem(Menu: PMenu; Cmd: word): PMenuItem;
+procedure SetMenuItemParam(Menu: PMenuItem; Param: string);
+function IsSubMenu(P: PMenuItem): boolean;
+function IsSeparator(P: PMenuItem): boolean;
+function UpdateMenu(M: PMenu): boolean;
+function SearchSubMenu(M: PMenu; Index: integer): PMenuItem;
+procedure AppendMenuItem(M: PMenu; I: PMenuItem);
+procedure RemoveMenuItem(Menu: PMenu; I: PMenuItem);
+function GetMenuItemBefore(Menu:PMenu; BeforeOf: PMenuItem): PMenuItem;
+
+procedure NotImplemented;
+
+implementation
+
+uses Commands,App,MsgBox;
+
+const
+ MessageDialog : PCenterDialog = nil;
+
+{*****************************************************************************
+ TCenterDialog
+*****************************************************************************}
+
+constructor TCenterDialog.Init(var Bounds: TRect; ATitle: TTitleStr);
+begin
+ inherited Init(Bounds,ATitle);
+ Options:=Options or ofCentered;
+end;
+
+function TAdvancedMenuBox.NewSubView(var Bounds: TRect; AMenu: PMenu;
+ AParentMenu: PMenuView): PMenuView;
+begin
+ NewSubView := New(PAdvancedMenuBox, Init(Bounds, AMenu, AParentMenu));
+end;
+
+function TAdvancedMenuBox.Execute: word;
+type
+ MenuAction = (DoNothing, DoSelect, DoReturn);
+var
+ AutoSelect: Boolean;
+ Action: MenuAction;
+ Ch: Char;
+ Result: Word;
+ ItemShown, P: PMenuItem;
+ Target: PMenuView;
+ R: TRect;
+ E: TEvent;
+ MouseActive: Boolean;
+function IsDisabled(Item: PMenuItem): boolean;
+var Found: boolean;
+begin
+ Found:=Item^.Disabled or IsSeparator(Item);
+ if (Found=false) and (IsSubMenu(Item)=false) then
+ Found:=CommandEnabled(Item^.Command)=false;
+ IsDisabled:=Found;
+end;
+
+procedure TrackMouse;
+var
+ Mouse: TPoint;
+ R: TRect;
+ OldC: PMenuItem;
+begin
+ MakeLocal(E.Where, Mouse);
+ OldC:=Current;
+ Current := Menu^.Items;
+ while Current <> nil do
+ begin
+ GetItemRect(Current, R);
+ if R.Contains(Mouse) then
+ begin
+ MouseActive := True;
+ Break;
+ end;
+ Current := Current^.Next;
+ end;
+ if (Current<>nil) and IsDisabled(Current) then
+ begin
+ Current:={OldC}nil;
+ MouseActive:=false;
+ end;
+end;
+
+procedure TrackKey(FindNext: Boolean);
+
+procedure NextItem;
+begin
+ Current := Current^.Next;
+ if Current = nil then Current := Menu^.Items;
+end;
+
+procedure PrevItem;
+var
+ P: PMenuItem;
+begin
+ P := Current;
+ if P = Menu^.Items then P := nil;
+ repeat NextItem until Current^.Next = P;
+end;
+
+begin
+ if Current <> nil then
+ repeat
+ if FindNext then NextItem else PrevItem;
+ until (Current^.Name <> nil) and (IsDisabled(Current)=false);
+end;
+
+function MouseInOwner: Boolean;
+var
+ Mouse: TPoint;
+ R: TRect;
+begin
+ MouseInOwner := False;
+ if (ParentMenu <> nil) and (ParentMenu^.Size.Y = 1) then
+ begin
+ ParentMenu^.MakeLocal(E.Where, Mouse);
+ ParentMenu^.GetItemRect(ParentMenu^.Current, R);
+ MouseInOwner := R.Contains(Mouse);
+ end;
+end;
+
+function MouseInMenus: Boolean;
+var
+ P: PMenuView;
+begin
+ P := ParentMenu;
+ while (P <> nil) and (P^.MouseInView(E.Where)=false) do
+ P := P^.ParentMenu;
+ MouseInMenus := P <> nil;
+end;
+
+function TopMenu: PMenuView;
+var
+ P: PMenuView;
+begin
+ P := @Self;
+ while P^.ParentMenu <> nil do P := P^.ParentMenu;
+ TopMenu := P;
+end;
+
+begin
+ AutoSelect := False; E.What:=evNothing;
+ Result := 0;
+ ItemShown := nil;
+ Current := Menu^.Default;
+ MouseActive := False;
+ if UpdateMenu(Menu) then
+ begin
+ if Current<>nil then
+ if Current^.Disabled then
+ TrackKey(true);
+ repeat
+ Action := DoNothing;
+ GetEvent(E);
+ case E.What of
+ evMouseDown:
+ if MouseInView(E.Where) or MouseInOwner then
+ begin
+ TrackMouse;
+ if Size.Y = 1 then AutoSelect := True;
+ end else Action := DoReturn;
+ evMouseUp:
+ begin
+ TrackMouse;
+ if MouseInOwner then
+ Current := Menu^.Default
+ else
+ if (Current <> nil) and (Current^.Name <> nil) then
+ Action := DoSelect
+ else
+ if MouseActive or MouseInView(E.Where) then Action := DoReturn
+ else
+ begin
+ Current := Menu^.Default;
+ if Current = nil then Current := Menu^.Items;
+ Action := DoNothing;
+ end;
+ end;
+ evMouseMove:
+ if E.Buttons <> 0 then
+ begin
+ TrackMouse;
+ if not (MouseInView(E.Where) or MouseInOwner) and
+ MouseInMenus then Action := DoReturn;
+ end;
+ evKeyDown:
+ case CtrlToArrow(E.KeyCode) of
+ kbUp, kbDown:
+ if Size.Y <> 1 then
+ TrackKey(CtrlToArrow(E.KeyCode) = kbDown) else
+ if E.KeyCode = kbDown then AutoSelect := True;
+ kbLeft, kbRight:
+ if ParentMenu = nil then
+ TrackKey(CtrlToArrow(E.KeyCode) = kbRight) else
+ Action := DoReturn;
+ kbHome, kbEnd:
+ if Size.Y <> 1 then
+ begin
+ Current := Menu^.Items;
+ if E.KeyCode = kbEnd then TrackKey(False);
+ end;
+ kbEnter:
+ begin
+ if Size.Y = 1 then AutoSelect := True;
+ Action := DoSelect;
+ end;
+ kbEsc:
+ begin
+ Action := DoReturn;
+ if (ParentMenu = nil) or (ParentMenu^.Size.Y <> 1) then
+ ClearEvent(E);
+ end;
+ else
+ Target := @Self;
+ Ch := GetAltChar(E.KeyCode);
+ if Ch = #0 then Ch := E.CharCode else Target := TopMenu;
+ P := Target^.FindItem(Ch);
+ if P = nil then
+ begin
+ P := TopMenu^.HotKey(E.KeyCode);
+ if (P <> nil) and CommandEnabled(P^.Command) then
+ begin
+ Result := P^.Command;
+ Action := DoReturn;
+ end
+ end else
+ if Target = @Self then
+ begin
+ if Size.Y = 1 then AutoSelect := True;
+ Action := DoSelect;
+ Current := P;
+ end else
+ if (ParentMenu <> Target) or (ParentMenu^.Current <> P) then
+ Action := DoReturn;
+ end;
+ evCommand:
+ if E.Command = cmMenu then
+ begin
+ AutoSelect := False;
+ if ParentMenu <> nil then Action := DoReturn;
+ end else Action := DoReturn;
+ end;
+ if ItemShown <> Current then
+ begin
+ ItemShown := Current;
+ DrawView;
+ end;
+ if (Action = DoSelect) or ((Action = DoNothing) and AutoSelect) then
+ if Current <> nil then with Current^ do if Name <> nil then
+ if Command = 0 then
+ begin
+ if E.What and (evMouseDown + evMouseMove) <> 0 then PutEvent(E);
+ GetItemRect(Current, R);
+ R.A.X := R.A.X + Origin.X;
+ R.A.Y := R.B.Y + Origin.Y;
+ R.B := Owner^.Size;
+ if Size.Y = 1 then Dec(R.A.X);
+ Target := TopMenu^.NewSubView(R, SubMenu, @Self);
+ Result := Owner^.ExecView(Target);
+ Dispose(Target, Done);
+ end else if Action = DoSelect then Result := Command;
+ if (Result <> 0) and CommandEnabled(Result) then
+ begin
+ Action := DoReturn;
+ ClearEvent(E);
+ end
+ else
+ Result := 0;
+ until Action = DoReturn;
+ end;
+ if E.What <> evNothing then
+ if (ParentMenu <> nil) or (E.What = evCommand) then PutEvent(E);
+ if Current <> nil then
+ begin
+ Menu^.Default := Current;
+ Current := nil;
+ DrawView;
+ end;
+ Execute := Result;
+end;
+
+function TAdvancedMenuPopup.NewSubView(var Bounds: TRect; AMenu: PMenu;
+ AParentMenu: PMenuView): PMenuView;
+begin
+ NewSubView := New(PAdvancedMenuBox, Init(Bounds, AMenu, AParentMenu));
+end;
+
+function TAdvancedMenuPopup.Execute: word;
+type
+ MenuAction = (DoNothing, DoSelect, DoReturn);
+var
+ AutoSelect: Boolean;
+ Action: MenuAction;
+ Ch: Char;
+ Result: Word;
+ ItemShown, P: PMenuItem;
+ Target: PMenuView;
+ R: TRect;
+ E: TEvent;
+ MouseActive: Boolean;
+function IsDisabled(Item: PMenuItem): boolean;
+var Found: boolean;
+begin
+ Found:=Item^.Disabled or IsSeparator(Item);
+ if (Found=false) and (IsSubMenu(Item)=false) then
+ Found:=CommandEnabled(Item^.Command)=false;
+ IsDisabled:=Found;
+end;
+
+procedure TrackMouse;
+var
+ Mouse: TPoint;
+ R: TRect;
+ OldC: PMenuItem;
+begin
+ MakeLocal(E.Where, Mouse);
+ OldC:=Current;
+ Current := Menu^.Items;
+ while Current <> nil do
+ begin
+ GetItemRect(Current, R);
+ if R.Contains(Mouse) then
+ begin
+ MouseActive := True;
+ Break;
+ end;
+ Current := Current^.Next;
+ end;
+ if (Current<>nil) and IsDisabled(Current) then
+ begin
+ Current:={OldC}nil;
+ MouseActive:=false;
+ end;
+end;
+
+procedure TrackKey(FindNext: Boolean);
+
+procedure NextItem;
+begin
+ Current := Current^.Next;
+ if Current = nil then Current := Menu^.Items;
+end;
+
+procedure PrevItem;
+var
+ P: PMenuItem;
+begin
+ P := Current;
+ if P = Menu^.Items then P := nil;
+ repeat NextItem until Current^.Next = P;
+end;
+
+begin
+ if Current <> nil then
+ repeat
+ if FindNext then NextItem else PrevItem;
+ until (Current^.Name <> nil) and (IsDisabled(Current)=false);
+end;
+
+function MouseInOwner: Boolean;
+var
+ Mouse: TPoint;
+ R: TRect;
+begin
+ MouseInOwner := False;
+ if (ParentMenu <> nil) and (ParentMenu^.Size.Y = 1) then
+ begin
+ ParentMenu^.MakeLocal(E.Where, Mouse);
+ ParentMenu^.GetItemRect(ParentMenu^.Current, R);
+ MouseInOwner := R.Contains(Mouse);
+ end;
+end;
+
+function MouseInMenus: Boolean;
+var
+ P: PMenuView;
+begin
+ P := ParentMenu;
+ while (P <> nil) and (P^.MouseInView(E.Where)=false) do
+ P := P^.ParentMenu;
+ MouseInMenus := P <> nil;
+end;
+
+function TopMenu: PMenuView;
+var
+ P: PMenuView;
+begin
+ P := @Self;
+ while P^.ParentMenu <> nil do P := P^.ParentMenu;
+ TopMenu := P;
+end;
+
+begin
+ AutoSelect := False; E.What:=evNothing;
+ Result := 0;
+ ItemShown := nil;
+ Current := Menu^.Default;
+ MouseActive := False;
+ if UpdateMenu(Menu) then
+ begin
+ if Current<>nil then
+ if Current^.Disabled then
+ TrackKey(true);
+ repeat
+ Action := DoNothing;
+ GetEvent(E);
+ case E.What of
+ evMouseDown:
+ if MouseInView(E.Where) or MouseInOwner then
+ begin
+ TrackMouse;
+ if Size.Y = 1 then AutoSelect := True;
+ end else Action := DoReturn;
+ evMouseUp:
+ begin
+ TrackMouse;
+ if MouseInOwner then
+ Current := Menu^.Default
+ else
+ if (Current <> nil) and (Current^.Name <> nil) then
+ Action := DoSelect
+ else
+ if MouseActive or MouseInView(E.Where) then Action := DoReturn
+ else
+ begin
+ Current := Menu^.Default;
+ if Current = nil then Current := Menu^.Items;
+ Action := DoNothing;
+ end;
+ end;
+ evMouseMove:
+ if E.Buttons <> 0 then
+ begin
+ TrackMouse;
+ if not (MouseInView(E.Where) or MouseInOwner) and
+ MouseInMenus then Action := DoReturn;
+ end;
+ evKeyDown:
+ case CtrlToArrow(E.KeyCode) of
+ kbUp, kbDown:
+ if Size.Y <> 1 then
+ TrackKey(CtrlToArrow(E.KeyCode) = kbDown) else
+ if E.KeyCode = kbDown then AutoSelect := True;
+ kbLeft, kbRight:
+ if ParentMenu = nil then
+ TrackKey(CtrlToArrow(E.KeyCode) = kbRight) else
+ Action := DoReturn;
+ kbHome, kbEnd:
+ if Size.Y <> 1 then
+ begin
+ Current := Menu^.Items;
+ if E.KeyCode = kbEnd then TrackKey(False);
+ end;
+ kbEnter:
+ begin
+ if Size.Y = 1 then AutoSelect := True;
+ Action := DoSelect;
+ end;
+ kbEsc:
+ begin
+ Action := DoReturn;
+ if (ParentMenu = nil) or (ParentMenu^.Size.Y <> 1) then
+ ClearEvent(E);
+ end;
+ else
+ Target := @Self;
+ Ch := GetAltChar(E.KeyCode);
+ if Ch = #0 then Ch := E.CharCode else Target := TopMenu;
+ P := Target^.FindItem(Ch);
+ if P = nil then
+ begin
+ P := TopMenu^.HotKey(E.KeyCode);
+ if (P <> nil) and CommandEnabled(P^.Command) then
+ begin
+ Result := P^.Command;
+ Action := DoReturn;
+ end
+ end else
+ if Target = @Self then
+ begin
+ if Size.Y = 1 then AutoSelect := True;
+ Action := DoSelect;
+ Current := P;
+ end else
+ if (ParentMenu <> Target) or (ParentMenu^.Current <> P) then
+ Action := DoReturn;
+ end;
+ evCommand:
+ if E.Command = cmMenu then
+ begin
+ AutoSelect := False;
+ if ParentMenu <> nil then Action := DoReturn;
+ end else Action := DoReturn;
+ end;
+ if ItemShown <> Current then
+ begin
+ ItemShown := Current;
+ DrawView;
+ end;
+ if (Action = DoSelect) or ((Action = DoNothing) and AutoSelect) then
+ if Current <> nil then with Current^ do if Name <> nil then
+ if Command = 0 then
+ begin
+ if E.What and (evMouseDown + evMouseMove) <> 0 then PutEvent(E);
+ GetItemRect(Current, R);
+ R.A.X := R.A.X + Origin.X;
+ R.A.Y := R.B.Y + Origin.Y;
+ R.B := Owner^.Size;
+ if Size.Y = 1 then Dec(R.A.X);
+ Target := TopMenu^.NewSubView(R, SubMenu, @Self);
+ Result := Owner^.ExecView(Target);
+ Dispose(Target, Done);
+ end else if Action = DoSelect then Result := Command;
+ if (Result <> 0) and CommandEnabled(Result) then
+ begin
+ Action := DoReturn;
+ ClearEvent(E);
+ end
+ else
+ Result := 0;
+ until Action = DoReturn;
+ end;
+ if E.What <> evNothing then
+ if (ParentMenu <> nil) or (E.What = evCommand) then PutEvent(E);
+ if Current <> nil then
+ begin
+ Menu^.Default := Current;
+ Current := nil;
+ DrawView;
+ end;
+ Execute := Result;
+end;
+
+constructor TAdvancedMenuBar.Init(var Bounds: TRect; AMenu: PMenu);
+begin
+ inherited Init(Bounds, AMenu);
+ EventMask:=EventMask or evBroadcast;
+end;
+
+function TAdvancedMenuBar.NewSubView(var Bounds: TRect; AMenu: PMenu;
+ AParentMenu: PMenuView): PMenuView;
+begin
+ NewSubView := New(PAdvancedMenuBox, Init(Bounds, AMenu, AParentMenu));
+end;
+
+procedure TAdvancedMenuBar.Update;
+begin
+ UpdateMenu(Menu);
+ DrawView;
+end;
+
+procedure TAdvancedMenuBar.HandleEvent(var Event: TEvent);
+begin
+ case Event.What of
+ evBroadcast :
+ case Event.Command of
+ cmCommandSetChanged : Update;
+ cmUpdate : Update;
+ end;
+ end;
+ inherited HandleEvent(Event);
+end;
+
+function TAdvancedMenuBar.Execute: word;
+type
+ MenuAction = (DoNothing, DoSelect, DoReturn);
+var
+ AutoSelect: Boolean;
+ Action: MenuAction;
+ Ch: Char;
+ Result: Word;
+ ItemShown, P: PMenuItem;
+ Target: PMenuView;
+ R: TRect;
+ E: TEvent;
+ MouseActive: Boolean;
+function IsDisabled(Item: PMenuItem): boolean;
+var Dis : boolean;
+begin
+ Dis:=Item^.Disabled or IsSeparator(Item);
+ if (Dis=false) and (IsSubMenu(Item)=false) then
+ Dis:=CommandEnabled(Item^.Command)=false;
+ IsDisabled:=Dis;
+end;
+
+procedure TrackMouse;
+var
+ Mouse: TPoint;
+ R: TRect;
+ OldC: PMenuItem;
+begin
+ MakeLocal(E.Where, Mouse);
+ OldC:=Current;
+ Current := Menu^.Items;
+ while Current <> nil do
+ begin
+ GetItemRect(Current, R);
+ if R.Contains(Mouse) then
+ begin
+ MouseActive := True;
+ Break;
+ end;
+ Current := Current^.Next;
+ end;
+ if (Current<>nil) and IsDisabled(Current) then
+ Current:=nil;
+end;
+
+procedure TrackKey(FindNext: Boolean);
+
+procedure NextItem;
+begin
+ Current := Current^.Next;
+ if Current = nil then Current := Menu^.Items;
+end;
+
+procedure PrevItem;
+var
+ P: PMenuItem;
+begin
+ P := Current;
+ if P = Menu^.Items then P := nil;
+ repeat NextItem until Current^.Next = P;
+end;
+
+begin
+ if Current <> nil then
+ repeat
+ if FindNext then NextItem else PrevItem;
+ until (Current^.Name <> nil) and (IsDisabled(Current)=false);
+end;
+
+function MouseInOwner: Boolean;
+var
+ Mouse: TPoint;
+ R: TRect;
+begin
+ MouseInOwner := False;
+ if (ParentMenu <> nil) and (ParentMenu^.Size.Y = 1) then
+ begin
+ ParentMenu^.MakeLocal(E.Where, Mouse);
+ ParentMenu^.GetItemRect(ParentMenu^.Current, R);
+ MouseInOwner := R.Contains(Mouse);
+ end;
+end;
+
+function MouseInMenus: Boolean;
+var
+ P: PMenuView;
+begin
+ P := ParentMenu;
+ while (P <> nil) and not P^.MouseInView(E.Where) do P := P^.ParentMenu;
+ MouseInMenus := P <> nil;
+end;
+
+function TopMenu: PMenuView;
+var
+ P: PMenuView;
+begin
+ P := @Self;
+ while P^.ParentMenu <> nil do P := P^.ParentMenu;
+ TopMenu := P;
+end;
+
+begin
+ AutoSelect := False; E.What:=evNothing;
+ Result := 0;
+ ItemShown := nil;
+ Current := Menu^.Default;
+ MouseActive := False;
+ if UpdateMenu(Menu) then
+ begin
+ if Current<>nil then
+ if Current^.Disabled then
+ TrackKey(true);
+ repeat
+ Action := DoNothing;
+ GetEvent(E);
+ case E.What of
+ evMouseDown:
+ if MouseInView(E.Where) or MouseInOwner then
+ begin
+ TrackMouse;
+ if Size.Y = 1 then AutoSelect := True;
+ end else Action := DoReturn;
+ evMouseUp:
+ begin
+ TrackMouse;
+ if MouseInOwner then
+ Current := Menu^.Default
+ else
+ if (Current <> nil) and (Current^.Name <> nil) then
+ Action := DoSelect
+ else
+ if MouseActive or MouseInView(E.Where) then Action := DoReturn
+ else
+ begin
+ Current := Menu^.Default;
+ if Current = nil then Current := Menu^.Items;
+ Action := DoNothing;
+ end;
+ end;
+ evMouseMove:
+ if E.Buttons <> 0 then
+ begin
+ TrackMouse;
+ if not (MouseInView(E.Where) or MouseInOwner) and
+ MouseInMenus then Action := DoReturn;
+ end;
+ evKeyDown:
+ case CtrlToArrow(E.KeyCode) of
+ kbUp, kbDown:
+ if Size.Y <> 1 then
+ TrackKey(CtrlToArrow(E.KeyCode) = kbDown) else
+ if E.KeyCode = kbDown then AutoSelect := True;
+ kbLeft, kbRight:
+ if ParentMenu = nil then
+ TrackKey(CtrlToArrow(E.KeyCode) = kbRight) else
+ Action := DoReturn;
+ kbHome, kbEnd:
+ if Size.Y <> 1 then
+ begin
+ Current := Menu^.Items;
+ if E.KeyCode = kbEnd then TrackKey(False);
+ end;
+ kbEnter:
+ begin
+ if Size.Y = 1 then AutoSelect := True;
+ Action := DoSelect;
+ end;
+ kbEsc:
+ begin
+ Action := DoReturn;
+ if (ParentMenu = nil) or (ParentMenu^.Size.Y <> 1) then
+ ClearEvent(E);
+ end;
+ else
+ Target := @Self;
+ Ch := GetAltChar(E.KeyCode);
+ if Ch = #0 then Ch := E.CharCode else Target := TopMenu;
+ P := Target^.FindItem(Ch);
+ if P = nil then
+ begin
+ P := TopMenu^.HotKey(E.KeyCode);
+ if (P <> nil) and CommandEnabled(P^.Command) then
+ begin
+ Result := P^.Command;
+ Action := DoReturn;
+ end
+ end else
+ if Target = @Self then
+ begin
+ if Size.Y = 1 then AutoSelect := True;
+ Action := DoSelect;
+ Current := P;
+ end else
+ if (ParentMenu <> Target) or (ParentMenu^.Current <> P) then
+ Action := DoReturn;
+ end;
+ evCommand:
+ if E.Command = cmMenu then
+ begin
+ AutoSelect := False;
+ if ParentMenu <> nil then Action := DoReturn;
+ end else Action := DoReturn;
+ end;
+ if ItemShown <> Current then
+ begin
+ ItemShown := Current;
+ DrawView;
+ end;
+ if (Action = DoSelect) or ((Action = DoNothing) and AutoSelect) then
+ if Current <> nil then with Current^ do if Name <> nil then
+ if Command = 0 then
+ begin
+ if E.What and (evMouseDown + evMouseMove) <> 0 then PutEvent(E);
+ GetItemRect(Current, R);
+ R.A.X := R.A.X + Origin.X;
+ R.A.Y := R.B.Y + Origin.Y;
+ R.B := Owner^.Size;
+ if Size.Y = 1 then Dec(R.A.X);
+ Target := TopMenu^.NewSubView(R, SubMenu, @Self);
+ Result := Owner^.ExecView(Target);
+ Dispose(Target, Done);
+ end else if Action = DoSelect then Result := Command;
+ if (Result <> 0) and CommandEnabled(Result) then
+ begin
+ Action := DoReturn;
+ ClearEvent(E);
+ end
+ else
+ Result := 0;
+ until Action = DoReturn;
+ end;
+ if E.What <> evNothing then
+ if (ParentMenu <> nil) or (E.What = evCommand) then PutEvent(E);
+ if Current <> nil then
+ begin
+ Menu^.Default := Current;
+ Current := nil;
+ DrawView;
+ end;
+ Execute := Result;
+end;
+
+procedure TAdvancedStaticText.SetText(S: string);
+begin
+ if Text<>nil then DisposeStr(Text);
+ Text:=NewStr(S);
+ DrawView;
+end;
+
+procedure TAdvancedListBox.FocusItem(Item: sw_integer);
+begin
+ inherited FocusItem(Item);
+ Message(Owner,evBroadcast,cmListFocusChanged,@Self);
+end;
+
+procedure TAdvancedListBox.HandleEvent(var Event: TEvent);
+begin
+ case Event.What of
+ evMouseDown :
+ if MouseInView(Event.Where) and (Event.Double) then
+ begin
+ inherited HandleEvent(Event);
+ if Range>Focused then SelectItem(Focused);
+ end;
+ evBroadcast :
+ case Event.Command of
+ cmListItemSelected :
+ Message(Owner,evBroadcast,cmDefault,nil);
+ end;
+ end;
+ inherited HandleEvent(Event);
+end;
+
+constructor TColorStaticText.Init(var Bounds: TRect; AText: String; AColor: word);
+begin
+ inherited Init(Bounds,AText);
+ Color:=AColor;
+end;
+
+procedure TColorStaticText.Draw;
+var
+ C: word;
+ Center: Boolean;
+ I, J, L, P, Y: Integer;
+ B: TDrawBuffer;
+ S: String;
+ T: string;
+ CurS: string;
+ TildeCount,Po: integer;
+ TempS: string;
+begin
+ if Size.X=0 then Exit;
+ if DontWrap=false then
+ begin
+ C:=Color;
+ GetText(S);
+ L := Length(S);
+ P := 1;
+ Y := 0;
+ Center := False;
+ while Y < Size.Y do
+ begin
+ MoveChar(B, ' ', Lo(C), Size.X);
+ if P <= L then
+ begin
+ if S[P] = #3 then
+ begin
+ Center := True;
+ Inc(P);
+ end;
+ I := P;
+ repeat
+ J := P;
+ while (P <= L) and (S[P] = ' ') do Inc(P);
+ while (P <= L) and (S[P] <> ' ') and (S[P] <> #13) do Inc(P);
+ until (P > L) or (P >= I + Size.X) or (S[P] = #13);
+ TildeCount:=0; TempS:=copy(S,I,P-I);
+ repeat
+ Po:=Pos('~',TempS);
+ if Po>0 then begin Inc(TildeCount); Delete(TempS,1,Po); end;
+ until Po=0;
+ if P > I + Size.X + TildeCount then
+ if J > I then P := J else P := I + Size.X;
+ T:=copy(S,I,P-I);
+ if Center then J := (Size.X - {P + I}CStrLen(T)) div 2 else J := 0;
+ MoveCStr(B[J],T,C);
+ while (P <= L) and (S[P] = ' ') do Inc(P);
+ if (P <= L) and (S[P] = #13) then
+ begin
+ Center := False;
+ Inc(P);
+ if (P <= L) and (S[P] = #10) then Inc(P);
+ end;
+ end;
+ WriteLine(0, Y, Size.X, 1, B);
+ Inc(Y);
+ end;
+ end { Wrap=false } else
+ begin
+ C := Color;
+ GetText(S);
+ I:=1;
+ for Y:=0 to Size.Y-1 do
+ begin
+ MoveChar(B, ' ', Lo(C), Size.X);
+ CurS:='';
+ if S<>'' then
+ begin
+ P:=Pos(#13,S);
+ if P=0 then P:=length(S)+1;
+ CurS:=copy(S,1,P-1);
+ CurS:=copy(CurS,Delta.X+1,255);
+ CurS:=copy(CurS,1,MaxViewWidth);
+ Delete(S,1,P);
+ end;
+ if CurS<>'' then MoveCStr(B,CurS,C);
+ WriteLine(0,Y,Size.X,1,B);
+ end;
+ end;
+end;
+
+constructor THSListBox.Init(var Bounds: TRect; ANumCols: Word; AHScrollBar, AVScrollBar: PScrollBar);
+begin
+ inherited Init(Bounds,ANumCols,AVScrollBar);
+ HScrollBar:=AHScrollBar;
+end;
+
+constructor TDlgWindow.Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Integer);
+begin
+ inherited Init(Bounds,ATitle);
+ Number:=ANumber;
+ Flags:=Flags or (wfMove + wfGrow + wfClose + wfZoom);
+end;
+
+procedure TLocalMenuListBox.LocalMenu(P: TPoint);
+var M: PMenu;
+ MV: PAdvancedMenuPopUp;
+ R: TRect;
+ Re: word;
+begin
+ M:=GetLocalMenu;
+ if M=nil then Exit;
+ if LastLocalCmd<>0 then
+ M^.Default:=SearchMenuItem(M,LastLocalCmd);
+ Desktop^.GetExtent(R);
+ MakeGlobal(P,R.A); {Desktop^.MakeLocal(R.A,R.A);}
+ New(MV, Init(R, M));
+ Re:=Application^.ExecView(MV);
+ if M^.Default=nil then LastLocalCmd:=0
+ else LastLocalCmd:=M^.Default^.Command;
+ Dispose(MV, Done);
+ if Re<>0 then
+ Message(GetCommandTarget,evCommand,Re,@Self);
+end;
+
+function TLocalMenuListBox.GetLocalMenu: PMenu;
+begin
+ GetLocalMenu:=nil;
+ Abstract;
+end;
+
+function TLocalMenuListBox.GetCommandTarget: PView;
+begin
+ GetCommandTarget:=@Self;
+end;
+
+procedure TLocalMenuListBox.HandleEvent(var Event: TEvent);
+var DontClear: boolean;
+ P: TPoint;
+begin
+ case Event.What of
+ evMouseDown :
+ if MouseInView(Event.Where) and (Event.Buttons=mbRightButton) then
+ begin
+ MakeLocal(Event.Where,P); Inc(P.X); Inc(P.Y);
+ LocalMenu(P);
+ ClearEvent(Event);
+ end;
+ evKeyDown :
+ begin
+ DontClear:=false;
+ case Event.KeyCode of
+ kbAltF10 : Message(@Self,evCommand,cmLocalMenu,@Self);
+ else DontClear:=true;
+ end;
+ if DontClear=false then ClearEvent(Event);
+ end;
+ evCommand :
+ begin
+ DontClear:=false;
+ case Event.Command of
+ cmLocalMenu :
+ begin
+ P:=Cursor; Inc(P.X); Inc(P.Y);
+ LocalMenu(P);
+ end;
+ else DontClear:=true;
+ end;
+ if not DontClear then ClearEvent(Event);
+ end;
+ end;
+ inherited HandleEvent(Event);
+end;
+
+function TAdvancedStatusLine.GetStatusText: string;
+var S: string;
+begin
+ if StatusText=nil then S:='' else S:=StatusText^;
+ GetStatusText:=S;
+end;
+
+procedure TAdvancedStatusLine.SetStatusText(const S: string);
+begin
+ if StatusText<>nil then DisposeStr(StatusText);
+ StatusText:=NewStr(S);
+ DrawView;
+end;
+
+procedure TAdvancedStatusLine.ClearStatusText;
+begin
+ SetStatusText('');
+end;
+
+procedure TAdvancedStatusLine.Draw;
+var B: TDrawBuffer;
+ C: word;
+ S: string;
+begin
+ S:=GetStatusText;
+ if S='' then inherited Draw else
+ begin
+ C:=GetColor(1);
+ MoveChar(B,' ',C,Size.X);
+ MoveStr(B[1],S,C);
+ WriteLine(0,0,Size.X,Size.Y,B);
+ end;
+end;
+
+
+procedure ErrorBox(const S: string; Params: pointer);
+begin
+ MessageBox(S,Params,mfError+mfInsertInApp+mfOKButton);
+end;
+
+procedure WarningBox(const S: string; Params: pointer);
+begin
+ MessageBox(S,Params,mfWarning+mfInsertInApp+mfOKButton);
+end;
+
+procedure InformationBox(const S: string; Params: pointer);
+begin
+ MessageBox(S,Params,mfInformation+mfInsertInApp+mfOKButton);
+end;
+
+function ConfirmBox(const S: string; Params: pointer; CanCancel: boolean): word;
+begin
+ ConfirmBox:=MessageBox(S,Params,mfConfirmation+mfInsertInApp+mfYesButton+mfNoButton+integer(CanCancel)*mfCancelButton);
+end;
+
+function IsSeparator(P: PMenuItem): boolean;
+begin
+ IsSeparator:=(P<>nil) and (P^.Name=nil) and (P^.HelpCtx=hcNoContext);
+end;
+
+function IsSubMenu(P: PMenuItem): boolean;
+begin
+ IsSubMenu:=(P<>nil) and (P^.Name<>nil) and (P^.Command=0) and (P^.SubMenu<>nil);
+end;
+
+function SearchMenuItem(Menu: PMenu; Cmd: word): PMenuItem;
+var P,I: PMenuItem;
+begin
+ I:=nil;
+ if Menu=nil then P:=nil else P:=Menu^.Items;
+ while (P<>nil) and (I=nil) do
+ begin
+ if IsSubMenu(P) then
+ I:=SearchMenuItem(P^.SubMenu,Cmd);
+ if I=nil then
+ if P^.Command=Cmd then I:=P else
+ P:=P^.Next;
+ end;
+ SearchMenuItem:=I;
+end;
+
+procedure SetMenuItemParam(Menu: PMenuItem; Param: string);
+begin
+ if Menu=nil then Exit;
+ if Menu^.Param<>nil then DisposeStr(Menu^.Param);
+ Menu^.Param:=NewStr(Param);
+end;
+
+function UpdateMenu(M: PMenu): boolean;
+var P: PMenuItem;
+ IsEnabled: boolean;
+begin
+ if M=nil then begin UpdateMenu:=false; Exit; end;
+ P:=M^.Items; IsEnabled:=false;
+ while (P<>nil) do
+ begin
+ if IsSubMenu(P) then
+ P^.Disabled:=not UpdateMenu(P^.SubMenu);
+ if (IsSeparator(P)=false) and (P^.Disabled=false) and (Application^.CommandEnabled(P^.Command)=true) then
+ IsEnabled:=true;
+ P:=P^.Next;
+ end;
+ UpdateMenu:=IsEnabled;
+end;
+
+function SearchSubMenu(M: PMenu; Index: integer): PMenuItem;
+var P,C: PMenuItem;
+ Count: integer;
+begin
+ P:=nil; Count:=-1;
+ if M<>nil then C:=M^.Items else C:=nil;
+ while (C<>nil) and (P=nil) do
+ begin
+ if IsSubMenu(C) then
+ begin
+ Inc(Count);
+ if Count=Index then P:=C;
+ end;
+ C:=C^.Next;
+ end;
+ SearchSubMenu:=P;
+end;
+
+procedure AppendMenuItem(M: PMenu; I: PMenuItem);
+var P: PMenuItem;
+begin
+ if (M=nil) or (I=nil) then Exit;
+ I^.Next:=nil;
+ if M^.Items=nil then M^.Items:=I else
+ begin
+ P:=M^.Items;
+ while (P^.Next<>nil) do P:=P^.Next;
+ P^.Next:=I;
+ end;
+end;
+
+procedure DisposeMenuItem(P: PMenuItem);
+begin
+ if P<>nil then
+ begin
+ if IsSubMenu(P) then DisposeMenu(P^.SubMenu) else
+ if IsSeparator(P)=false then
+ if P^.Param<>nil then DisposeStr(P^.Param);
+ if P^.Name<>nil then DisposeStr(P^.Name);
+ Dispose(P);
+ end;
+end;
+
+procedure RemoveMenuItem(Menu: PMenu; I: PMenuItem);
+var P,PrevP: PMenuItem;
+begin
+ if (Menu=nil) or (I=nil) then Exit;
+ P:=Menu^.Items; PrevP:=nil;
+ while (P<>nil) do
+ begin
+ if P=I then
+ begin
+ if Menu^.Items<>I then PrevP^.Next:=P^.Next
+ else Menu^.Items:=P^.Next;
+ DisposeMenuItem(P);
+ Break;
+ end;
+ PrevP:=P; P:=P^.Next;
+ end;
+end;
+
+function GetMenuItemBefore(Menu: PMenu; BeforeOf: PMenuItem): PMenuItem;
+var P,C: PMenuItem;
+begin
+ P:=nil;
+ if Menu<>nil then C:=Menu^.Items else C:=nil;
+ while (C<>nil) do
+ begin
+ if C^.Next=BeforeOf then begin P:=C; Break; end;
+ C:=C^.Next;
+ end;
+ GetMenuItemBefore:=P;
+end;
+
+procedure NotImplemented;
+begin
+ InformationBox('This function is not yet implemented...',nil);
+end;
+
+procedure InsertButtons(ADialog: PDialog);
+var R : TRect;
+ W,H : integer;
+ X : integer;
+ X1,X2: Sw_integer;
+begin
+ with ADialog^ do
+ begin
+ GetExtent(R);
+ W:=R.B.X-R.A.X; H:=(R.B.Y-R.A.Y);
+ R.Assign(0,0,W,H+3); ChangeBounds(R);
+ X:=W div 2; X1:=X div 2+1; X2:=X+X1-1;
+ R.Assign(X1-3,H,X1+7,H+2);
+ Insert(New(PButton, Init(R, 'O~K~', cmOK, bfDefault)));
+ R.Assign(X2-7,H,X2+3,H+2);
+ Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
+ SelectNext(true);
+ end;
+end;
+
+procedure InsertOK(ADialog: PDialog);
+var BW: Sw_integer;
+ R: TRect;
+begin
+ with ADialog^ do
+ begin
+ GetBounds(R); R.Grow(0,1); Inc(R.B.Y);
+ ChangeBounds(R);
+ BW:=10;
+ R.A.Y:=R.B.Y-2; R.B.Y:=R.A.Y+2;
+ R.A.X:=R.A.X+(R.B.X-R.A.X-BW) div 2; R.B.X:=R.A.X+BW;
+ Insert(New(PButton, Init(R, 'O~K~', cmOK, bfDefault)));
+ SelectNext(true);
+ end;
+end;
+
+procedure ShowMessage(Msg: string);
+var R: TRect;
+ Width: integer;
+begin
+ Width:=length(Msg)+4*2;
+ if Width<(Desktop^.Size.X div 2) then Width:=(Desktop^.Size.X div 2);
+ R.Assign(0,0,Width,5);
+ New(MessageDialog, Init(R, ''));
+ with MessageDialog^ do
+ begin
+ Flags:=0;
+ GetExtent(R); R.Grow(-4,-2);
+ if copy(Msg,1,1)<>^C then Msg:=^C+Msg;
+ Insert(New(PStaticText, Init(R, Msg)));
+ end;
+ Application^.Insert(MessageDialog);
+end;
+
+procedure HideMessage;
+begin
+ if MessageDialog<>nil then
+ begin
+ Application^.Delete(MessageDialog);
+ Dispose(MessageDialog, Done);
+ MessageDialog:=nil;
+ end;
+end;
+
+
+
+END.
+{
+ $Log$
+ Revision 1.1 1999-03-01 15:51:43 peter
+ + Log
+
+}