paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 21:09:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ unicode version of the menus unit

Browse Source 
git-svn-id: branches/unicodekvm@48576 -
This commit is contained in:
nickysn 2021-02-10 00:41:08 +00:00
parent e902487711
commit eb6d1dc73f
4 changed files with 213 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -5030,6 +5030,7 @@ packages/fv/src/tabs.pas svneol=native#text/plain
packages/fv/src/time.pas svneol=native#text/plain packages/fv/src/time.pas svneol=native#text/plain
packages/fv/src/timeddlg.pas svneol=native#text/plain packages/fv/src/timeddlg.pas svneol=native#text/plain
packages/fv/src/udrivers.pas svneol=native#text/plain packages/fv/src/udrivers.pas svneol=native#text/plain
packages/fv/src/umenus.pas svneol=native#text/plain
packages/fv/src/unixsmsg.inc svneol=native#text/plain packages/fv/src/unixsmsg.inc svneol=native#text/plain
packages/fv/src/uoutline.pas svneol=native#text/plain packages/fv/src/uoutline.pas svneol=native#text/plain
packages/fv/src/uviews.pas svneol=native#text/plain packages/fv/src/uviews.pas svneol=native#text/plain

9
packages/fv/fpmake.pp
View File

@ -188,6 +188,15 @@ begin
AddUnit('views'); AddUnit('views');
AddUnit('fvconsts'); AddUnit('fvconsts');
end; end;
T:=P.Targets.AddUnit('umenus.pas');
with T.Dependencies do
begin
AddInclude('menus.inc');
AddInclude('platform.inc');
AddUnit('udrivers');
AddUnit('uviews');
AddUnit('fvconsts');
end;
T:=P.Targets.AddUnit('msgbox.pas'); T:=P.Targets.AddUnit('msgbox.pas');
with T.Dependencies do with T.Dependencies do
begin begin

220
packages/fv/src/menus.inc
View File

@ -25,7 +25,11 @@
{ } { }
{**********************************************************} {**********************************************************}
{$ifdef FV_UNICODE}
UNIT UMenus;
{$else FV_UNICODE}
UNIT Menus; UNIT Menus;
{$endif FV_UNICODE}
{$CODEPAGE cp437} {$CODEPAGE cp437}
@ -71,7 +75,11 @@ USES
{$ENDIF} {$ENDIF}
{$ENDIF} {$ENDIF}
{$ifdef FV_UNICODE}
objects, udrivers, uviews, fvconsts; { GFV standard units }
{$else FV_UNICODE}
objects, drivers, views, fvconsts; { GFV standard units } objects, drivers, views, fvconsts; { GFV standard units }
{$endif FV_UNICODE}
{***************************************************************************} {***************************************************************************}
{ PUBLIC CONSTANTS } { PUBLIC CONSTANTS }
@ -88,7 +96,11 @@ CONST
{ RECORD DEFINITIONS } { RECORD DEFINITIONS }
{***************************************************************************} {***************************************************************************}
TYPE TYPE
{$ifdef FV_UNICODE}
TMenuStr = UnicodeString; { Menu string }
{$else FV_UNICODE}
TMenuStr = String[31]; { Menu string } TMenuStr = String[31]; { Menu string }
{$endif FV_UNICODE}
PMenu = ^TMenu; { Pointer to menu } PMenu = ^TMenu; { Pointer to menu }
@ -102,14 +114,23 @@ TYPE
{$endif FPC_REQUIRES_PROPER_ALIGNMENT} {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
RECORD RECORD
Next: PMenuItem; { Next menu item } Next: PMenuItem; { Next menu item }
{$ifdef FV_UNICODE}
Name: UnicodeString; { Menu item name }
{$else FV_UNICODE}
Name: PString; { Menu item name } Name: PString; { Menu item name }
{$endif FV_UNICODE}
Command: Word; { Menu item command } Command: Word; { Menu item command }
Disabled: Boolean; { Menu item state } Disabled: Boolean; { Menu item state }
KeyCode: Word; { Menu item keycode } KeyCode: Word; { Menu item keycode }
HelpCtx: Word; { Menu item help ctx } HelpCtx: Word; { Menu item help ctx }
{$ifdef FV_UNICODE}
Param: UnicodeString;
SubMenu: PMenu;
{$else FV_UNICODE}
Case SmallInt Of Case SmallInt Of
0: (Param: PString); 0: (Param: PString);
1: (SubMenu: PMenu); 1: (SubMenu: PMenu);
{$endif FV_UNICODE}
END; END;
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
@ -135,7 +156,11 @@ TYPE
{$endif FPC_REQUIRES_PROPER_ALIGNMENT} {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
RECORD RECORD
Next: PStatusItem; { Next status item } Next: PStatusItem; { Next status item }
{$ifdef FV_UNICODE}
Text: UnicodeString; { Text of status item }
{$else FV_UNICODE}
Text: PString; { Text of status item } Text: PString; { Text of status item }
{$endif FV_UNICODE}
KeyCode: Word; { Keycode of item } KeyCode: Word; { Keycode of item }
Command: Word; { Command of item } Command: Word; { Command of item }
END; END;
@ -233,7 +258,11 @@ TYPE
CONSTRUCTOR Load (Var S: TStream); CONSTRUCTOR Load (Var S: TStream);
DESTRUCTOR Done; Virtual; DESTRUCTOR Done; Virtual;
FUNCTION GetPalette: PPalette; Virtual; FUNCTION GetPalette: PPalette; Virtual;
{$ifdef FV_UNICODE}
FUNCTION Hint (AHelpCtx: Word): UnicodeString; Virtual;
{$else FV_UNICODE}
FUNCTION Hint (AHelpCtx: Word): String; Virtual; FUNCTION Hint (AHelpCtx: Word): String; Virtual;
{$endif FV_UNICODE}
PROCEDURE Draw; Virtual; PROCEDURE Draw; Virtual;
PROCEDURE Update; Virtual; PROCEDURE Update; Virtual;
PROCEDURE Store (Var S: TStream); PROCEDURE Store (Var S: TStream);
@ -315,8 +344,13 @@ with the given parameter values (using NewStr to allocate the Text).
An error in creating will return a nil pointer. An error in creating will return a nil pointer.
15May98 LdB 15May98 LdB
---------------------------------------------------------------------} ---------------------------------------------------------------------}
{$ifdef FV_UNICODE}
FUNCTION NewStatusKey (AText: UnicodeString; AKeyCode: Word; ACommand: Word;
ANext: PStatusItem): PStatusItem;
{$else FV_UNICODE}
FUNCTION NewStatusKey (AText: String; AKeyCode: Word; ACommand: Word; FUNCTION NewStatusKey (AText: String; AKeyCode: Word; ACommand: Word;
ANext: PStatusItem): PStatusItem; ANext: PStatusItem): PStatusItem;
{$endif FV_UNICODE}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ OBJECT REGISTER ROUTINES } { OBJECT REGISTER ROUTINES }
@ -406,7 +440,11 @@ USES
Video; Video;
CONST CONST
{$ifdef FV_UNICODE}
SubMenuChar : array[boolean] of WideChar = ('>',#$25BA);
{$else FV_UNICODE}
SubMenuChar : array[boolean] of char = ('>',#16); SubMenuChar : array[boolean] of char = ('>',#16);
{$endif FV_UNICODE}
{ SubMenuChar is the character displayed at right of submenu } { SubMenuChar is the character displayed at right of submenu }
{***************************************************************************} {***************************************************************************}
@ -444,19 +482,31 @@ CONSTRUCTOR TMenuView.Load (Var S: TStream);
If (Item <> Nil) Then Begin { Check item valid } If (Item <> Nil) Then Begin { Check item valid }
Last := @Item^.Next; { Complete chain } Last := @Item^.Next; { Complete chain }
With Item^ Do Begin With Item^ Do Begin
{$ifdef FV_UNICODE}
Name := S.ReadUnicodeString; { Read menu name }
{$else FV_UNICODE}
Name := S.ReadStr; { Read menu name } Name := S.ReadStr; { Read menu name }
{$endif FV_UNICODE}
S.Read(Command, SizeOf(Command)); { Menu item command } S.Read(Command, SizeOf(Command)); { Menu item command }
S.Read(Disabled, SizeOf(Disabled)); { Menu item state } S.Read(Disabled, SizeOf(Disabled)); { Menu item state }
S.Read(KeyCode, SizeOf(KeyCode)); { Menu item keycode } S.Read(KeyCode, SizeOf(KeyCode)); { Menu item keycode }
S.Read(HelpCtx, SizeOf(HelpCtx)); { Menu item help ctx } S.Read(HelpCtx, SizeOf(HelpCtx)); { Menu item help ctx }
{$ifdef FV_UNICODE}
If (Name <> '') Then
{$else FV_UNICODE}
If (Name <> Nil) Then If (Name <> Nil) Then
{$endif FV_UNICODE}
If Command = 0 Then If Command = 0 Then
{$ifdef PPC_FPC} {$ifdef PPC_FPC}
SubMenu := DoLoadMenu() { Load submenu } SubMenu := DoLoadMenu() { Load submenu }
{$else not PPC_FPC} {$else not PPC_FPC}
SubMenu := DoLoadMenu { Load submenu } SubMenu := DoLoadMenu { Load submenu }
{$endif not PPC_FPC} {$endif not PPC_FPC}
{$ifdef FV_UNICODE}
Else Param := S.ReadUnicodeString; { Read param string }
{$else FV_UNICODE}
Else Param := S.ReadStr; { Read param string } Else Param := S.ReadStr; { Read param string }
{$endif FV_UNICODE}
End; End;
End; End;
S.Read(Tok, SizeOf(Tok)); { Read token } S.Read(Tok, SizeOf(Tok)); { Read token }
@ -516,7 +566,11 @@ VAR AutoSelect: Boolean; Action: MenuAction; Ch: Char; Res: Word; R: TRect;
If (Current <> Nil) Then { Current view valid } If (Current <> Nil) Then { Current view valid }
Repeat Repeat
If FindNext Then NextItem Else PrevItem; { Find next/prev item } If FindNext Then NextItem Else PrevItem; { Find next/prev item }
{$ifdef FV_UNICODE}
Until (Current^.Name <> ''); { Until we have name }
{$else FV_UNICODE}
Until (Current^.Name <> Nil); { Until we have name } Until (Current^.Name <> Nil); { Until we have name }
{$endif FV_UNICODE}
END; END;
FUNCTION MouseInOwner: Boolean; FUNCTION MouseInOwner: Boolean;
@ -571,7 +625,11 @@ BEGIN
If MouseInOwner Then { Mouse in owner } If MouseInOwner Then { Mouse in owner }
Current := Menu^.Default { Set as current } Current := Menu^.Default { Set as current }
Else If (Current <> Nil) AND Else If (Current <> Nil) AND
{$ifdef FV_UNICODE}
(Current^.Name <> '') Then
{$else FV_UNICODE}
(Current^.Name <> Nil) Then (Current^.Name <> Nil) Then
{$endif FV_UNICODE}
Action := DoSelect { Set select action } Action := DoSelect { Set select action }
Else If MouseActive OR MouseInView(E.Where) Else If MouseActive OR MouseInView(E.Where)
Then Action := DoReturn { Set return action } Then Action := DoReturn { Set return action }
@ -646,7 +704,11 @@ BEGIN
If (Action = DoSelect) OR ((Action = DoNothing) If (Action = DoSelect) OR ((Action = DoNothing)
AND AutoSelect) Then { Item is selecting } AND AutoSelect) Then { Item is selecting }
If (Current <> Nil) Then With Current^ Do { Current item valid } If (Current <> Nil) Then With Current^ Do { Current item valid }
{$ifdef FV_UNICODE}
If (Name <> '') Then { Item has a name }
{$else FV_UNICODE}
If (Name <> Nil) Then { Item has a name } If (Name <> Nil) Then { Item has a name }
{$endif FV_UNICODE}
If (Command = 0) Then Begin { Has no command } If (Command = 0) Then Begin { Has no command }
If (E.What AND (evMouseDown+evMouseMove) <> 0) If (E.What AND (evMouseDown+evMouseMove) <> 0)
Then PutEvent(E); { Put event on queue } Then PutEvent(E); { Put event on queue }
@ -687,7 +749,12 @@ BEGIN
C := @Self; { Start at self } C := @Self; { Start at self }
While (C <> Nil) AND ((C^.Current = Nil) OR While (C <> Nil) AND ((C^.Current = Nil) OR
(C^.Current^.HelpCtx = hcNoContext) OR { Has no context } (C^.Current^.HelpCtx = hcNoContext) OR { Has no context }
(C^.Current^.Name = Nil)) Do C := C^.ParentMenu; { Parent menu context } {$ifdef FV_UNICODE}
(C^.Current^.Name = '')) Do
{$else FV_UNICODE}
(C^.Current^.Name = Nil)) Do
{$endif FV_UNICODE}
C := C^.ParentMenu; { Parent menu context }
If (C<>Nil) Then GetHelpCtx := C^.Current^.HelpCtx { Current context } If (C<>Nil) Then GetHelpCtx := C^.Current^.HelpCtx { Current context }
Else GetHelpCtx := hcNoContext; { No help context } Else GetHelpCtx := hcNoContext; { No help context }
END; END;
@ -714,10 +781,14 @@ BEGIN
Ch := UpCase(Ch); { Upper case of char } Ch := UpCase(Ch); { Upper case of char }
P := Menu^.Items; { First menu item } P := Menu^.Items; { First menu item }
While (P <> Nil) Do Begin { While item valid } While (P <> Nil) Do Begin { While item valid }
{$ifdef FV_UNICODE}
If (P^.Name <> '') AND (NOT P^.Disabled) { Valid enabled cmd }
{$else FV_UNICODE}
If (P^.Name <> Nil) AND (NOT P^.Disabled) { Valid enabled cmd } If (P^.Name <> Nil) AND (NOT P^.Disabled) { Valid enabled cmd }
{$endif FV_UNICODE}
Then Begin Then Begin
I := Pos('~', P^.Name^); { Scan for highlight } I := Pos('~', P^.Name{$ifndef FV_UNICODE}^{$endif}); { Scan for highlight }
If (I <> 0) AND (Ch = UpCase(P^.Name^[I+1])) { Hotkey char found } If (I <> 0) AND (Ch = UpCase(P^.Name{$ifndef FV_UNICODE}^{$endif}[I+1])) { Hotkey char found }
Then Begin Then Begin
FindItem := P; { Return item } FindItem := P; { Return item }
Exit; { Now exit } Exit; { Now exit }
@ -737,7 +808,7 @@ FUNCTION TMenuView.HotKey (KeyCode: Word): PMenuItem;
VAR T: PMenuItem; VAR T: PMenuItem;
BEGIN BEGIN
While (P <> Nil) Do Begin { While item valid } While (P <> Nil) Do Begin { While item valid }
If (P^.Name <> Nil) Then { If valid name } If (P^.Name <> {$ifdef FV_UNICODE}''{$else}Nil{$endif}) Then { If valid name }
If (P^.Command = 0) Then Begin { Valid command } If (P^.Command = 0) Then Begin { Valid command }
T := FindHotKey(P^.SubMenu^.Items); { Search for hot key } T := FindHotKey(P^.SubMenu^.Items); { Search for hot key }
If (T <> Nil) Then Begin If (T <> Nil) Then Begin
@ -782,14 +853,22 @@ PROCEDURE TMenuView.Store (Var S: TStream);
While (Item <> Nil) Do Begin While (Item <> Nil) Do Begin
With Item^ Do Begin With Item^ Do Begin
S.Write(Tok, SizeOf(Tok)); { Write tok value } S.Write(Tok, SizeOf(Tok)); { Write tok value }
{$ifdef FV_UNICODE}
S.WriteUnicodeString(Name); { Write item name }
{$else FV_UNICODE}
S.WriteStr(Name); { Write item name } S.WriteStr(Name); { Write item name }
{$endif FV_UNICODE}
S.Write(Command, SizeOf(Command)); { Menu item command } S.Write(Command, SizeOf(Command)); { Menu item command }
S.Write(Disabled, SizeOf(Disabled)); { Menu item state } S.Write(Disabled, SizeOf(Disabled)); { Menu item state }
S.Write(KeyCode, SizeOf(KeyCode)); { Menu item keycode } S.Write(KeyCode, SizeOf(KeyCode)); { Menu item keycode }
S.Write(HelpCtx, SizeOf(HelpCtx)); { Menu item help ctx } S.Write(HelpCtx, SizeOf(HelpCtx)); { Menu item help ctx }
If (Name <> Nil) Then If Name <> {$ifdef FV_UNICODE}''{$else}Nil{$endif} Then
If Command = 0 Then DoStoreMenu(SubMenu) If Command = 0 Then DoStoreMenu(SubMenu)
{$ifdef FV_UNICODE}
Else S.WriteUnicodeString(Param); { Write parameter }
{$else FV_UNICODE}
Else S.WriteStr(Param); { Write parameter } Else S.WriteStr(Param); { Write parameter }
{$endif FV_UNICODE}
End; End;
Item := Item^.Next; { Next item } Item := Item^.Next; { Next item }
End; End;
@ -813,7 +892,7 @@ VAR CallDraw: Boolean; P: PMenuItem;
BEGIN BEGIN
P := AMenu^.Items; { Start on first item } P := AMenu^.Items; { Start on first item }
While (P <> Nil) Do Begin While (P <> Nil) Do Begin
If (P^.Name <> Nil) Then { Valid name } If (P^.Name <> {$ifdef FV_UNICODE}''{$else}Nil{$endif}) Then { Valid name }
If (P^.Command = 0) Then UpdateMenu(P^.SubMenu){ Update menu } If (P^.Command = 0) Then UpdateMenu(P^.SubMenu){ Update menu }
Else Begin Else Begin
CommandState := CommandEnabled(P^.Command); { Menu item state } CommandState := CommandEnabled(P^.Command); { Menu item state }
@ -923,7 +1002,7 @@ BEGIN
I := 0; { Set start position } I := 0; { Set start position }
P := Menu^.Items; { First item } P := Menu^.Items; { First item }
While (P <> Nil) Do Begin While (P <> Nil) Do Begin
If (P^.Name <> Nil) Then Begin { Name valid } If (P^.Name <> {$ifdef FV_UNICODE}''{$else}Nil{$endif}) Then Begin { Name valid }
If P^.Disabled Then Begin If P^.Disabled Then Begin
If (P = Current) Then Color := CSelDisabled{ Select disabled } If (P = Current) Then Color := CSelDisabled{ Select disabled }
Else Color := CNormDisabled { Normal disabled } Else Color := CNormDisabled { Normal disabled }
@ -931,9 +1010,9 @@ BEGIN
If (P = Current) Then Color := CSelect { Select colour } If (P = Current) Then Color := CSelect { Select colour }
Else Color := CNormal; { Normal colour } Else Color := CNormal; { Normal colour }
End; End;
J := CStrLen(P^.Name^); { Length of string } J := CStrLen(P^.Name{$ifndef FV_UNICODE}^{$endif}); { Length of string }
MoveChar(B[I], ' ', Byte(Color), 1); MoveChar(B[I], ' ', Byte(Color), 1);
MoveCStr(B[I+1], P^.Name^, Color); { Name to buffer } MoveCStr(B[I+1], P^.Name{$ifndef FV_UNICODE}^{$endif}, Color); { Name to buffer }
MoveChar(B[I+1+J], ' ', Byte(Color), 1); MoveChar(B[I+1+J], ' ', Byte(Color), 1);
Inc(I, J+2); { Advance position } Inc(I, J+2); { Advance position }
End; End;
@ -954,9 +1033,9 @@ BEGIN
P := Menu^.Items; { First item } P := Menu^.Items; { First item }
While (P <> Nil) Do Begin { While valid item } While (P <> Nil) Do Begin { While valid item }
R.A.X := I; { Move area along } R.A.X := I; { Move area along }
If (P^.Name <> Nil) Then Begin { Valid name } If P^.Name <> {$ifdef FV_UNICODE}''{$else}Nil{$endif} Then Begin { Valid name }
R.B.X := R.A.X+CTextWidth(' ' + P^.Name^ + ' ');{ Add text width } R.B.X := R.A.X+CTextWidth(' ' + P^.Name{$ifndef FV_UNICODE}^{$endif} + ' ');{ Add text width }
I := I + CStrLen(P^.Name^) + 2; { Add item length } I := I + CStrLen(P^.Name{$ifndef FV_UNICODE}^{$endif}) + 2; { Add item length }
End Else R.B.X := R.A.X; End Else R.B.X := R.A.X;
If (P = Item) Then break; { Requested item found } If (P = Item) Then break; { Requested item found }
P := P^.Next; { Next item } P := P^.Next; { Next item }
@ -972,18 +1051,31 @@ END;
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
CONSTRUCTOR TMenuBox.Init (Var Bounds: TRect; AMenu: PMenu; CONSTRUCTOR TMenuBox.Init (Var Bounds: TRect; AMenu: PMenu;
AParentMenu: PMenuView); AParentMenu: PMenuView);
VAR W, H, L: SmallInt; S: String; P: PMenuItem; R: TRect; VAR W, H, L: SmallInt; P: PMenuItem; R: TRect;
{$ifdef FV_UNICODE}
S: UnicodeString;
{$else FV_UNICODE}
S: String;
{$endif FV_UNICODE}
BEGIN BEGIN
W := 0; { Clear initial width } W := 0; { Clear initial width }
H := 2; { Set initial height } H := 2; { Set initial height }
If (AMenu <> Nil) Then Begin { Valid menu } If (AMenu <> Nil) Then Begin { Valid menu }
P := AMenu^.Items; { Start on first item } P := AMenu^.Items; { Start on first item }
While (P <> Nil) Do Begin { If item valid } While (P <> Nil) Do Begin { If item valid }
{$ifdef FV_UNICODE}
If (P^.Name <> '') Then Begin { Check for name }
S := ' ' + P^.Name + ' '; { Transfer string }
If (P^.Command <> 0) AND (P^.Param <> '')
Then S := S + ' - ' + P^.Param; { Add any parameter }
End;
{$else FV_UNICODE}
If (P^.Name <> Nil) Then Begin { Check for name } If (P^.Name <> Nil) Then Begin { Check for name }
S := ' ' + P^.Name^ + ' '; { Transfer string } S := ' ' + P^.Name^ + ' '; { Transfer string }
If (P^.Command <> 0) AND (P^.Param <> Nil) If (P^.Command <> 0) AND (P^.Param <> Nil)
Then S := S + ' - ' + P^.Param^; { Add any parameter } Then S := S + ' - ' + P^.Param^; { Add any parameter }
End; End;
{$endif FV_UNICODE}
L := CTextWidth(S); { Width of string } L := CTextWidth(S); { Width of string }
If (L > W) Then W := L; { Hold maximum } If (L > W) Then W := L; { Hold maximum }
Inc(H); { Inc count of items } Inc(H); { Inc count of items }
@ -1009,13 +1101,26 @@ END;
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
PROCEDURE TMenuBox.Draw; PROCEDURE TMenuBox.Draw;
VAR CNormal, CSelect, CSelectDisabled, CDisabled, Color: Word; Index, Y: SmallInt; VAR CNormal, CSelect, CSelectDisabled, CDisabled, Color: Word; Index, Y: SmallInt;
S: String; P: PMenuItem; B: TDrawBuffer; P: PMenuItem; B: TDrawBuffer;
{$ifdef FV_UNICODE}
S: UnicodeString;
{$else FV_UNICODE}
S: String;
{$endif FV_UNICODE}
Type Type
FrameLineType = (UpperLine,NormalLine,SeparationLine,LowerLine); FrameLineType = (UpperLine,NormalLine,SeparationLine,LowerLine);
{$ifdef FV_UNICODE}
FrameLineChars = Array[0..2] of WideChar;
{$else FV_UNICODE}
FrameLineChars = Array[0..2] of char; FrameLineChars = Array[0..2] of char;
{$endif FV_UNICODE}
Const Const
FrameLines : Array[FrameLineType] of FrameLineChars = FrameLines : Array[FrameLineType] of FrameLineChars =
{$ifdef FV_UNICODE}
(#$250C#$2500#$2510,#$2502#$0020#$2502,#$251C#$2500#$2524,#$2514#$2500#$2518);
{$else FV_UNICODE}
('ÚÄ¿','³ ³','ÃÄ´','ÀÄÙ'); ('ÚÄ¿','³ ³','ÃÄ´','ÀÄÙ');
{$endif FV_UNICODE}
Procedure CreateBorder(LineType : FrameLineType); Procedure CreateBorder(LineType : FrameLineType);
Begin Begin
MoveChar(B, ' ', CNormal, 1); MoveChar(B, ' ', CNormal, 1);
@ -1039,7 +1144,11 @@ BEGIN
P := Menu^.Items; { Start on first } P := Menu^.Items; { Start on first }
While (P <> Nil) Do Begin { Valid menu item } While (P <> Nil) Do Begin { Valid menu item }
Color := CNormal; { Normal colour } Color := CNormal; { Normal colour }
{$ifdef FV_UNICODE}
If (P^.Name <> '') Then Begin { Item has text }
{$else FV_UNICODE}
If (P^.Name <> Nil) Then Begin { Item has text } If (P^.Name <> Nil) Then Begin { Item has text }
{$endif FV_UNICODE}
If P^.Disabled Then If P^.Disabled Then
begin begin
if (P = Current) then if (P = Current) then
@ -1051,16 +1160,28 @@ BEGIN
If (P = Current) Then Color := CSelect; { Select colour } If (P = Current) Then Color := CSelect; { Select colour }
CreateBorder(NormalLine); CreateBorder(NormalLine);
Index:=2; Index:=2;
{$ifdef FV_UNICODE}
S := ' ' + P^.Name + ' '; { Menu string }
{$else FV_UNICODE}
S := ' ' + P^.Name^ + ' '; { Menu string } S := ' ' + P^.Name^ + ' '; { Menu string }
{$endif FV_UNICODE}
MoveCStr(B[Index], S, Color); { Transfer string } MoveCStr(B[Index], S, Color); { Transfer string }
if P^.Command = 0 then if P^.Command = 0 then
MoveChar(B[Size.X - 4],SubMenuChar[LowAscii], MoveChar(B[Size.X - 4],SubMenuChar[LowAscii],
Byte(Color), 1) else Byte(Color), 1) else
{$ifdef FV_UNICODE}
If (P^.Command <> 0) AND(P^.Param <> '') Then
Begin
MoveCStr(B[Size.X - 3 - Length(P^.Param)], P^.Param, Color); { Add param chars }
S := S + ' - ' + P^.Param; { Add to string }
End;
{$else FV_UNICODE}
If (P^.Command <> 0) AND(P^.Param <> Nil) Then If (P^.Command <> 0) AND(P^.Param <> Nil) Then
Begin Begin
MoveCStr(B[Size.X - 3 - Length(P^.Param^)], P^.Param^, Color); { Add param chars } MoveCStr(B[Size.X - 3 - Length(P^.Param^)], P^.Param^, Color); { Add param chars }
S := S + ' - ' + P^.Param^; { Add to string } S := S + ' - ' + P^.Param^; { Add to string }
End; End;
{$endif FV_UNICODE}
If (OldItem = Nil) OR (OldItem = P) OR If (OldItem = Nil) OR (OldItem = P) OR
(Current = P) Then (Current = P) Then
Begin { We need to fix draw } Begin { We need to fix draw }
@ -1175,7 +1296,11 @@ CONSTRUCTOR TStatusLine.Load (Var S: TStream);
Last^ := Cur; { First chain part } Last^ := Cur; { First chain part }
If (Cur <> Nil) Then Begin { Check pointer valid } If (Cur <> Nil) Then Begin { Check pointer valid }
Last := @Cur^.Next; { Chain complete } Last := @Cur^.Next; { Chain complete }
{$ifdef FV_UNICODE}
Cur^.Text := S.ReadUnicodeString; { Read item text }
{$else FV_UNICODE}
Cur^.Text := S.ReadStr; { Read item text } Cur^.Text := S.ReadStr; { Read item text }
{$endif FV_UNICODE}
S.Read(Cur^.KeyCode, SizeOf(Cur^.KeyCode)); { Keycode of item } S.Read(Cur^.KeyCode, SizeOf(Cur^.KeyCode)); { Keycode of item }
S.Read(Cur^.Command, SizeOf(Cur^.Command)); { Command of item } S.Read(Cur^.Command, SizeOf(Cur^.Command)); { Command of item }
End; End;
@ -1223,7 +1348,9 @@ VAR T: PStatusDef;
While (Item <> Nil) Do Begin { Item to dispose } While (Item <> Nil) Do Begin { Item to dispose }
T := Item; { Hold pointer } T := Item; { Hold pointer }
Item := Item^.Next; { Move down chain } Item := Item^.Next; { Move down chain }
{$ifndef FV_UNICODE}
DisposeStr(T^.Text); { Dispose string } DisposeStr(T^.Text); { Dispose string }
{$endif FV_UNICODE}
Dispose(T); { Dispose item } Dispose(T); { Dispose item }
End; End;
END; END;
@ -1255,7 +1382,11 @@ END;
{--TStatusLine--------------------------------------------------------------} {--TStatusLine--------------------------------------------------------------}
{ Hint -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB } { Hint -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB }
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
{$ifdef FV_UNICODE}
FUNCTION TStatusLine.Hint (AHelpCtx: Word): UnicodeString;
{$else FV_UNICODE}
FUNCTION TStatusLine.Hint (AHelpCtx: Word): String; FUNCTION TStatusLine.Hint (AHelpCtx: Word): String;
{$endif FV_UNICODE}
BEGIN BEGIN
Hint := ''; { Return nothing } Hint := ''; { Return nothing }
END; END;
@ -1300,7 +1431,11 @@ PROCEDURE TStatusLine.Store (Var S: TStream);
End; End;
S.Write(Count, SizeOf(Count)); { Write item count } S.Write(Count, SizeOf(Count)); { Write item count }
While (Cur <> Nil) Do Begin While (Cur <> Nil) Do Begin
{$ifdef FV_UNICODE}
S.WriteUnicodeString(Cur^.Text); { Store item text }
{$else FV_UNICODE}
S.WriteStr(Cur^.Text); { Store item text } S.WriteStr(Cur^.Text); { Store item text }
{$endif FV_UNICODE}
S.Write(Cur^.KeyCode, SizeOf(Cur^.KeyCode)); { Keycode of item } S.Write(Cur^.KeyCode, SizeOf(Cur^.KeyCode)); { Keycode of item }
S.Write(Cur^.Command, SizeOf(Cur^.Command)); { Command of item } S.Write(Cur^.Command, SizeOf(Cur^.Command)); { Command of item }
Cur := Cur^.Next; { Move to next item } Cur := Cur^.Next; { Move to next item }
@ -1347,9 +1482,9 @@ VAR Mouse: TPoint; T, Tt: PStatusItem;
X := 0; { Zero x position } X := 0; { Zero x position }
T := Items; { Start at first item } T := Items; { Start at first item }
While (T <> Nil) Do Begin { While item valid } While (T <> Nil) Do Begin { While item valid }
If (T^.Text <> Nil) Then Begin { Check valid text } If (T^.Text <> {$ifdef FV_UNICODE}''{$else}Nil{$endif}) Then Begin { Check valid text }
Xi := X; { Hold initial x value } Xi := X; { Hold initial x value }
X := Xi + CTextWidth(' ' + T^.Text^ + ' '); { Add text width } X := Xi + CTextWidth(' ' + T^.Text{$ifndef FV_UNICODE}^{$endif} + ' '); { Add text width }
If (Mouse.X >= Xi) AND (Mouse.X < X) If (Mouse.X >= Xi) AND (Mouse.X < X)
Then Begin Then Begin
ItemMouseIsIn := T; { Selected item } ItemMouseIsIn := T; { Selected item }
@ -1426,7 +1561,12 @@ END;
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
PROCEDURE TStatusLine.DrawSelect (Selected: PStatusItem); PROCEDURE TStatusLine.DrawSelect (Selected: PStatusItem);
VAR I, L: SmallInt; Color, CSelect, CNormal, CSelDisabled, CNormDisabled: Word; VAR I, L: SmallInt; Color, CSelect, CNormal, CSelDisabled, CNormDisabled: Word;
HintBuf: String; B: TDrawBuffer; T: PStatusItem; B: TDrawBuffer; T: PStatusItem;
{$ifdef FV_UNICODE}
HintBuf: UnicodeString;
{$else FV_UNICODE}
HintBuf: String;
{$endif FV_UNICODE}
BEGIN BEGIN
CNormal := GetColor($0301); { Normal colour } CNormal := GetColor($0301); { Normal colour }
CSelect := GetColor($0604); { Select colour } CSelect := GetColor($0604); { Select colour }
@ -1437,26 +1577,42 @@ BEGIN
I := 0; { Clear the count } I := 0; { Clear the count }
L := 0; L := 0;
While (T <> Nil) Do Begin { While valid item } While (T <> Nil) Do Begin { While valid item }
{$ifdef FV_UNICODE}
If (T^.Text <> '') Then Begin { While valid text }
{$else FV_UNICODE}
If (T^.Text <> Nil) Then Begin { While valid text } If (T^.Text <> Nil) Then Begin { While valid text }
{$endif FV_UNICODE}
{$ifdef FV_UNICODE}
L := CStrLen(' '+T^.Text+' '); { Text length }
{$else FV_UNICODE}
L := CStrLen(' '+T^.Text^+' '); { Text length } L := CStrLen(' '+T^.Text^+' '); { Text length }
{$endif FV_UNICODE}
If CommandEnabled(T^.Command) Then Begin { Command enabled } If CommandEnabled(T^.Command) Then Begin { Command enabled }
If T = Selected Then Color := CSelect { Selected colour } If T = Selected Then Color := CSelect { Selected colour }
Else Color := CNormal { Normal colour } Else Color := CNormal { Normal colour }
End Else End Else
If T = Selected Then Color := CSelDisabled { Selected disabled } If T = Selected Then Color := CSelDisabled { Selected disabled }
Else Color := CNormDisabled; { Disabled colour } Else Color := CNormDisabled; { Disabled colour }
{$ifdef FV_UNICODE}
MoveCStr(B[I], ' '+T^.Text+' ', Color); { Move text to buf }
{$else FV_UNICODE}
MoveCStr(B[I], ' '+T^.Text^+' ', Color); { Move text to buf } MoveCStr(B[I], ' '+T^.Text^+' ', Color); { Move text to buf }
{$endif FV_UNICODE}
Inc(I, L); { Advance position } Inc(I, L); { Advance position }
End; End;
T := T^.Next; { Next item } T := T^.Next; { Next item }
End; End;
HintBuf := Hint(HelpCtx); { Get hint string } HintBuf := Hint(HelpCtx); { Get hint string }
If (HintBuf <> '') Then Begin { Hint present } If (HintBuf <> '') Then Begin { Hint present }
{$ifdef FV_UNICODE}
MoveChar(B[I], #$2502, Byte(CNormal), 1); { '|' char to buffer }
{$else FV_UNICODE}
{$IFNDEF OS_WINDOWS} {$IFNDEF OS_WINDOWS}
MoveChar(B[I], #179, Byte(CNormal), 1); { '|' char to buffer } MoveChar(B[I], #179, Byte(CNormal), 1); { '|' char to buffer }
{$ELSE} {$ELSE}
MoveChar(B[I], #124, Byte(CNormal), 1); { '|' char to buffer } MoveChar(B[I], #124, Byte(CNormal), 1); { '|' char to buffer }
{$ENDIF} {$ENDIF}
{$endif FV_UNICODE}
Inc(I, 2); { Move along } Inc(I, 2); { Move along }
MoveStr(B[I], HintBuf, Byte(CNormal)); { Move hint to buffer } MoveStr(B[I], HintBuf, Byte(CNormal)); { Move hint to buffer }
I := I + Length(HintBuf); { Hint length } I := I + Length(HintBuf); { Hint length }
@ -1496,10 +1652,15 @@ BEGIN
If (Menu <> Nil) Then Begin { Valid menu item } If (Menu <> Nil) Then Begin { Valid menu item }
P := Menu^.Items; { First item in list } P := Menu^.Items; { First item in list }
While (P <> Nil) Do Begin { Item is valid } While (P <> Nil) Do Begin { Item is valid }
If (P^.Name <> Nil) Then Begin { Valid name pointer } If (P^.Name <> {$ifdef FV_UNICODE}''{$else}Nil{$endif}) Then Begin { Valid name pointer }
{$ifndef FV_UNICODE}
DisposeStr(P^.Name); { Dispose of name } DisposeStr(P^.Name); { Dispose of name }
{$endif FV_UNICODE}
If (P^.Command <> 0) Then If (P^.Command <> 0) Then
DisposeStr(P^.Param) Else { Dispose parameter } {$ifndef FV_UNICODE}
DisposeStr(P^.Param) { Dispose parameter }
{$endif FV_UNICODE}
Else
DisposeMenu(P^.SubMenu); { Dispose submenu } DisposeMenu(P^.SubMenu); { Dispose submenu }
End; End;
Q := P; { Hold pointer } Q := P; { Hold pointer }
@ -1540,7 +1701,11 @@ BEGIN
FillChar(P^,sizeof(TMenuItem),0); FillChar(P^,sizeof(TMenuItem),0);
If (P <> Nil) Then Begin { Check valid pointer } If (P <> Nil) Then Begin { Check valid pointer }
P^.Next := Next; { Hold next item } P^.Next := Next; { Hold next item }
{$ifdef FV_UNICODE}
P^.Name := Name; { Hold item name }
{$else FV_UNICODE}
P^.Name := NewStr(Name); { Hold item name } P^.Name := NewStr(Name); { Hold item name }
{$endif FV_UNICODE}
P^.Command := Command; { Hold item command } P^.Command := Command; { Hold item command }
R.Assign(1, 1, 10, 10); { Random assignment } R.Assign(1, 1, 10, 10); { Random assignment }
T := New(PView, Init(R)); { Create a view } T := New(PView, Init(R)); { Create a view }
@ -1550,7 +1715,11 @@ BEGIN
End Else P^.Disabled := True; End Else P^.Disabled := True;
P^.KeyCode := KeyCode; { Hold item keycode } P^.KeyCode := KeyCode; { Hold item keycode }
P^.HelpCtx := AHelpCtx; { Hold help context } P^.HelpCtx := AHelpCtx; { Hold help context }
{$ifdef FV_UNICODE}
P^.Param := Param; { Hold parameter }
{$else FV_UNICODE}
P^.Param := NewStr(Param); { Hold parameter } P^.Param := NewStr(Param); { Hold parameter }
{$endif FV_UNICODE}
End; End;
NewItem := P; { Return item } NewItem := P; { Return item }
End Else NewItem := Next; { Move forward } End Else NewItem := Next; { Move forward }
@ -1568,7 +1737,11 @@ BEGIN
FillChar(P^,sizeof(TMenuItem),0); FillChar(P^,sizeof(TMenuItem),0);
If (P <> Nil) Then Begin { Check valid pointer } If (P <> Nil) Then Begin { Check valid pointer }
P^.Next := Next; { Hold next item } P^.Next := Next; { Hold next item }
{$ifdef FV_UNICODE}
P^.Name := Name; { Hold submenu name }
{$else FV_UNICODE}
P^.Name := NewStr(Name); { Hold submenu name } P^.Name := NewStr(Name); { Hold submenu name }
{$endif FV_UNICODE}
P^.HelpCtx := AHelpCtx; { Set help context } P^.HelpCtx := AHelpCtx; { Set help context }
P^.SubMenu := SubMenu; { Hold next submenu } P^.SubMenu := SubMenu; { Hold next submenu }
End; End;
@ -1600,13 +1773,22 @@ END;
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
{ NewStatusKey -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15May98 LdB } { NewStatusKey -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15May98 LdB }
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
{$ifdef FV_UNICODE}
FUNCTION NewStatusKey (AText: UnicodeString; AKeyCode: Word; ACommand: Word;
ANext: PStatusItem): PStatusItem;
{$else FV_UNICODE}
FUNCTION NewStatusKey (AText: String; AKeyCode: Word; ACommand: Word; FUNCTION NewStatusKey (AText: String; AKeyCode: Word; ACommand: Word;
ANext: PStatusItem): PStatusItem; ANext: PStatusItem): PStatusItem;
{$endif FV_UNICODE}
VAR T: PStatusItem; VAR T: PStatusItem;
BEGIN BEGIN
New(T); { Allocate memory } New(T); { Allocate memory }
If (T <> Nil) Then Begin { Check valid pointer } If (T <> Nil) Then Begin { Check valid pointer }
{$ifdef FV_UNICODE}
T^.Text := AText; { Hold text string }
{$else FV_UNICODE}
T^.Text := NewStr(AText); { Hold text string } T^.Text := NewStr(AText); { Hold text string }
{$endif FV_UNICODE}
T^.KeyCode := AKeyCode; { Hold keycode } T^.KeyCode := AKeyCode; { Hold keycode }
T^.Command := ACommand; { Hold command } T^.Command := ACommand; { Hold command }
T^.Next := ANext; { Pointer to next } T^.Next := ANext; { Pointer to next }

2
packages/fv/src/umenus.pas Normal file
View File

@ -0,0 +1,2 @@
{$DEFINE FV_UNICODE}
{$I menus.inc}