Add Free Vision examples.

packages/fv/examples/demoedit.pas

@@ -0,0 +1,201 @@
+program DemoEditor;
+{$mode fpc}
+
+uses
+  {$ifdef UNIX}cwstring,{$endif}Objects,fvconsts,
+  //Drivers, Views, Menus, StdDlg, App, Editors,Msgbox{$ifdef unix},fvclip { OSC 52 support unit } {$endif},FVCommon;
+  uDrivers, uViews, uMenus, uStdDlg, uApp, uEditors,uMsgbox{$ifdef unix},ufvclip { OSC 52 support unit } {$endif},uFVCommon;
+
+
+const
+  cmShowClip   = 102;
+  cmCopyWin    = 240;
+  cmPasteWin   = 241;
+
+type
+  PEditorApp = ^TEditorApp;
+  TEditorApp = object(TApplication)
+    constructor Init;
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure InitMenuBar; virtual;
+    procedure InitStatusLine; virtual;
+  end;
+
+  PMyEditWindow = ^TMyEditWindow;
+  TMyEditWindow = object(TEditWindow)
+    procedure HandleEvent(var Event: TEvent); virtual;
+  end;
+
+var
+  EditorApp: TEditorApp;
+  ClipWindow: PEditWindow;
+
+function OpenEditor(FileName: FNameStr; Visible: Boolean): PEditWindow;
+var
+  P: PWindow;
+  R: TRect;
+begin
+  DeskTop^.GetExtent(R);
+  P := New(PMyEditWindow, Init(R, FileName, wnNoNumber));
+  if not Visible then P^.Hide;
+  OpenEditor := PEditWindow(Application^.InsertWindow(P));
+end;
+
+procedure TMyEditWindow.HandleEvent(var Event: TEvent);
+
+procedure ClipCopyWin;
+var p : pointer;
+begin
+{$ifdef unix}
+  if Editor^.SelStart<>Editor^.SelEnd then { Text selected? }
+  begin
+    {This is where the magic happens. Parameters are PAnsiChar and Length of data to be copied to global clipboard}
+    SetGlobalClipboardData( @Editor^.Buffer^[Editor^.BufPtr(Editor^.SelStart)], Editor^.SelEnd - Editor^.SelStart);
+  end;
+{$else}
+  MessageBox('Not implemented for this platform!', nil, mfInformation + mfOkButton);
+{$endif}
+end;
+
+procedure ClipPasteWin;
+begin
+{$ifdef unix}
+  GetGlobalClipboardData; {Request data from global Clipboard. That's it}
+{$else}
+  MessageBox('Not implemented for this platform!', nil, mfInformation + mfOkButton);
+{$endif}
+end;
+
+begin
+  inherited HandleEvent(Event);
+  case Event.What of
+    evCommand:
+      case Event.Command of
+        cmCopyWin   : ClipCopyWin;
+        cmPasteWin  : ClipPasteWin;
+      else
+        Exit;
+      end;
+  else
+    Exit;
+  end;
+  ClearEvent(Event);
+end;
+
+constructor TEditorApp.Init;
+var
+  H: Word;
+  R: TRect;
+begin
+  inherited Init;
+  DisableCommands([cmSave, cmSaveAs, cmCut, cmCopy, cmPaste,
+    {cmCopyWin, cmPasteWin,}
+    cmClear, cmUndo, cmFind, cmReplace, cmSearchAgain]);
+  EditorDialog := @StdEditorDialog;
+  ClipWindow := OpenEditor('', False);
+  if ClipWindow <> nil then
+  begin
+    Clipboard := ClipWindow^.Editor;
+    Clipboard^.CanUndo := False;
+  end;
+end;
+
+procedure TEditorApp.HandleEvent(var Event: TEvent);
+
+procedure FileOpen;
+var
+  FileName: FNameStr;
+begin
+  FileName := '*.*';
+  if ExecuteDialog(New(PFileDialog, Init('*.*', 'Open file',
+    '~N~ame', fdOpenButton, 100)), @FileName) <> cmCancel then
+    OpenEditor(FileName, True);
+end;
+
+procedure FileNew;
+begin
+  OpenEditor('', True);
+end;
+
+procedure ChangeDir;
+begin
+  ExecuteDialog(New(PChDirDialog, Init(cdNormal, 0)), nil);
+end;
+
+procedure ShowClip;
+begin
+  ClipWindow^.Select;
+  ClipWindow^.Show;
+end;
+
+begin
+  inherited HandleEvent(Event);
+  case Event.What of
+    evCommand:
+      case Event.Command of
+        cmOpen: FileOpen;
+        cmNew: FileNew;
+        cmChangeDir : ChangeDir;
+        cmShowClip  : ShowClip;
+      else
+        Exit;
+      end;
+  else
+    Exit;
+  end;
+  ClearEvent(Event);
+end;
+
+procedure TEditorApp.InitMenuBar;
+var
+  R: TRect;
+begin
+  GetExtent(R);
+  R.B.Y := R.A.Y + 1;
+  MenuBar := New(PMenuBar, Init(R, NewMenu(
+    NewSubMenu('~F~ile', hcNoContext, NewMenu(
+      StdFileMenuItems(
+      nil)),
+    NewSubMenu('~E~dit', hcNoContext, NewMenu(
+      StdEditMenuItems(
+      NewLine(
+      NewItem('~S~hwo clipboard', '', kbNoKey, cmShowClip, hcNoContext,
+      NewLine(
+      NewItem('Cop~y~ to Windows', '', kbNoKey, cmCopyWin, hcNoContext,
+      NewItem('Paste from ~W~indows', '', kbNoKey, cmPasteWin, hcNoContext,
+      nil))))))),
+    NewSubMenu('~S~earch', hcNoContext, NewMenu(
+      NewItem('~F~ind...', '', kbNoKey, cmFind, hcNoContext,
+      NewItem('~R~eplace...', '', kbNoKey, cmReplace, hcNoContext,
+      NewItem('~S~earch again', '', kbNoKey, cmSearchAgain, hcNoContext,
+      nil)))),
+    NewSubMenu('~W~indows', hcNoContext, NewMenu(
+      StdWindowMenuItems(
+      nil)),
+    nil)))))));
+end;
+
+procedure TEditorApp.InitStatusLine;
+var
+  R: TRect;
+begin
+  GetExtent(R);
+  R.A.Y := R.B.Y - 1;
+  New(StatusLine, Init(R,
+    NewStatusDef(0, $FFFF,
+      NewStatusKey('~F2~ Save', kbF2, cmSave,
+      NewStatusKey('~F3~ Open', kbF3, cmOpen,
+      NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
+      NewStatusKey('~F5~ Zoom', kbF5, cmZoom,
+      NewStatusKey('~F6~ Next', kbF6, cmNext,
+      NewStatusKey('~F10~ Menu', kbF10, cmMenu,
+      NewStatusKey('', kbCtrlF5, cmResize,
+      nil))))))),
+    nil)));
+end;
+
+begin
+  EditorApp.Init;
+  EditorApp.Run;
+  EditorApp.Done;
+end.

packages/fv/examples/demostatuses.pas

@@ -0,0 +1,151 @@
+program demostatuses;
+{$codepage utf8}
+uses
+  {$ifdef UNIX}cwstring,{$endif}
+  //Objects, Drivers, Views, Menus, Dialogs, App, Gadgets, Statuses, Time, fvconsts, FVCommon; { for legacy uncomment this line and comment next line }
+  Objects, UDrivers, uViews, uMenus, uDialogs, uApp, uGadgets, uStatuses, Time, fvconsts, UFVCommon; { for unicode support uncomment this line and comment previous line }
+
+const cmOpenGaugeWindow          =22351;
+      cmOpenArrowGaugeWindow     =22352;
+      cmOpenArrowBackGaugeWindow =22353;
+      cmOpenSpinnerGaugeWindow   =22354;
+      cmOpenPercentGaugeWindow   =22355;
+      cmOpenBarGaugeWindow       =22356;
+      cmStatusUp = 19883;
+
+type
+  PClockViewCount= ^TClockViewCount;
+  TClockViewCount = object(TClockView)
+    PROCEDURE Update; Virtual;
+  end;
+
+  PStatusesApp = ^TStatusesApp;
+  TStatusesApp = object(TApplication)
+    Clock: PClockViewCount;
+    Heap: PHeapView;
+    constructor Init;
+    procedure Idle; virtual;
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure InitMenuBar; virtual;
+  end;
+
+PROCEDURE TClockViewCount.Update;
+VAR Hour, Min, Sec, Sec100: Word;
+begin
+  GetTime(Hour, Min, Sec, Sec100);                   { Get current time }
+  If (Abs(Sec - LastTime) >= Refresh) Then Begin     { Refresh time elapsed }
+     inherited;
+     Message(Owner,evStatus,cmStatusUpdate, pointer(ptruint(cmStatusUp)));   { tell the world that second has passed }
+  end;
+end;
+
+constructor TStatusesApp.Init;
+var
+  R: TRect;
+begin
+  Inherited Init;
+  { Initialize demo Statuses }
+
+  GetExtent(R);
+  R.A.X := R.B.X - 9; R.B.Y := R.A.Y + 1;
+  Clock := New(PClockViewCount, Init(R));
+  Clock^.GrowMode:=gfGrowLoX+gfGrowHiX;
+  Insert(Clock);
+
+  GetExtent(R);
+  Dec(R.B.X);
+  R.A.X := R.B.X - 9; R.A.Y := R.B.Y - 1;
+  Heap := New(PHeapView, Init(R));
+  Heap^.GrowMode:=gfGrowAll;
+  Insert(Heap);
+end;
+
+procedure TStatusesApp.Idle;
+begin
+  TApplication.Idle;
+  Clock^.Update;
+  Heap^.Update;
+end;
+
+procedure TStatusesApp.InitMenuBar;
+var
+  R: TRect;
+begin
+  GetExtent(R);
+  R.B.Y := R.A.Y + 1;
+  MenuBar := New(PMenubar, Init(R, NewMenu(NewSubMenu('~M~enu',  hcNoContext,
+    NewMenu(
+    NewItem('~G~auge', 'F2', kbF2, cmOpenGaugeWindow, hcNoContext,
+    NewItem('~A~rrow gauge', 'F3', kbF3, cmOpenArrowGaugeWindow, hcNoContext,
+    NewItem('Back a~r~row gauge', 'F4', kbF4, cmOpenArrowBackGaugeWindow, hcNoContext,
+    NewItem('~S~pinner gauge', 'F5', kbF5, cmOpenSpinnerGaugeWindow, hcNoContext,
+    NewItem('~P~ercente gauge', 'F6', kbF6, cmOpenPercentGaugeWindow, hcNoContext,
+    NewItem('~B~ar gauge', 'F7', kbF7, cmOpenBarGaugeWindow, hcNoContext,
+    nil)))))))
+    ,
+    nil))));
+end;
+
+procedure TStatusesApp.HandleEvent(var Event: TEvent);
+
+procedure StatusesDlg( aChoice : byte);
+var
+  D: PDialog;
+  G: PStatus;
+  R : TRect;
+  Title: Sw_String;
+begin
+  R.Assign(13, 7, 55, 8);
+  case aChoice of
+    1: G := new(PGauge,Init(R,cmStatusUp,1,12));
+    2: G := new(PArrowGauge,Init(R,cmStatusUp,1,12,true));
+    3: G := new(PArrowGauge,Init(R,cmStatusUp,1,12,false));
+    4: G := new(PSpinnerGauge,Init(13,7,cmStatusUp));
+    5: G := new(PPercentGauge,Init(R,cmStatusUp,1,12));
+    6: G := new(PBarGauge,Init(R,cmStatusUp,1,12));
+    else
+      exit; { none chosen }
+  end;
+  Title:='12 seconds to pass';
+  if aChoice = 4 then
+     Title:='Infinite seconds to pass';
+
+{$if sizeof(sw_string)<=8}
+  D := New(PStatusMessageDlg,Init(Title, G , sdPauseButton or sdCancelButton,#3'Unicode symbols ◀ ◌ ◂ ◃ ◄ ◅ ◆ ◇ ◈ ◉ ◊'));
+{$else}
+  D := New(PStatusMessageDlg,Init(Title, G , sdPauseButton or sdCancelButton,#3'Legacy gauge'));
+{$endif}
+  if ExecuteDialog(D, nil) <> cmCancel then
+  begin
+    { task complete }
+
+  end;
+end;
+
+begin
+  inherited HandleEvent(Event);
+  case Event.What of
+    evCommand:
+      begin
+        case Event.Command of
+          cmOpenGaugeWindow          : StatusesDlg(1);
+          cmOpenArrowGaugeWindow     : StatusesDlg(2);
+          cmOpenArrowBackGaugeWindow : StatusesDlg(3);
+          cmOpenSpinnerGaugeWindow   : StatusesDlg(4);
+          cmOpenPercentGaugeWindow   : StatusesDlg(5);
+          cmOpenBarGaugeWindow       : StatusesDlg(6);
+        else
+          Exit;
+        end;
+        ClearEvent(Event);
+      end;
+  end;
+end;
+
+var
+  StatusesApp: TStatusesApp;
+begin
+  StatusesApp.Init;
+  StatusesApp.Run;
+  StatusesApp.Done;
+end.

packages/fv/examples/filedlg.pas

@@ -0,0 +1,148 @@
+program demofiledialog;
+{$codepage utf8}
+uses
+  {$ifdef UNIX}cwstring,{$endif} 
+  //Objects, Drivers, Views, Menus, Dialogs, App, Stddlg, MsgBox, FVCommon; { for legacy uncomment this line and comment next line }
+  Objects, uDrivers, uViews, uMenus, uDialogs, uApp, uStddlg, uMsgBox, uFVCommon; { for unicode support uncomment this line and comment previous line }
+
+const cmOpneFileDlg =14523;
+      cmDirChangeDlg=26745;
+      cmDirChangeDlg2=3412;
+
+{$if sizeof(sw_string)<=8}
+const  cStr1: utf8String = '◀ ◌ ◂ ◃ ◄ ◅ ◆ ◇ ';
+       cStr2: utf8String = ' ◈ ◉ ◊ ○ ◌ ◍ ◎ ●';
+       cMoStr = '◇ ';
+       cMcStr = '◊ ';
+       cMeStr = '◌ ';
+
+{$else}
+const  cStr1: AnsiString = '';
+       cStr2: AnsiString = '';
+       cMoStr = '';
+       cMcStr = '';
+       cMeStr = '';
+{$endif}
+
+type
+  PFileDlgApp = ^TFileDlgApp;
+  TFileDlgApp = object(TApplication)
+    procedure HandleEvent(var Event: TEvent); virtual;
+    procedure InitMenuBar; virtual;
+  end;
+
+procedure TFileDlgApp.InitMenuBar;
+var
+  R: TRect;
+begin
+  GetExtent(R);
+  R.B.Y := R.A.Y + 1;
+  MenuBar := New(PMenubar, Init(R, NewMenu(NewSubMenu('~M~enu',  hcNoContext,
+    NewMenu(
+    NewItem(cMoStr+'~O~pen File Dialog', 'F2', kbF2, cmOpneFileDlg, hcNoContext,
+    NewItem(cMcStr+'~C~hange Directory Dialog', 'F4', kbF4, cmDirChangeDlg, hcNoContext,
+    NewItem(cMeStr+'Change ~D~irectory Dialog II', 'F6', kbF6, cmDirChangeDlg2, hcNoContext,
+
+    NewLine(
+    NewItem('E~x~it', 'Alt-X', kbNoKey, cmQuit, hcNoContext,
+    nil))))))
+    ,
+    nil))));
+end;
+
+procedure TFileDlgApp.HandleEvent(var Event: TEvent);
+
+procedure OpenFileDialog;
+var
+  R: TRect;
+  D: PFileDialog;
+  S: Sw_String;
+  P : pointer;
+begin
+  S:='*.pas';
+  D := New(PFileDialog, Init(S,cStr1+'File dialog'+cStr2,'Chosen ~f~ile ',fdOkButton,199));
+  //D := New(PFileDialog, Init(S,'File dialog','Chosen ~f~ile ',fdOkButton,199));
+  { Resize }
+  if Desktop^.Size.Y > 26 then
+    D^.GrowTo(D^.Size.X,Desktop^.Size.Y-6);
+  if Desktop^.Size.X > 60 then
+    D^.GrowTo(Min(Desktop^.Size.X-(60-D^.Size.X),102),D^.Size.Y);
+  { Number of columns in file open dialog }
+  D^.FileList^.NumCols:= Max((D^.FileList^.Size.X-(D^.FileList^.Size.X div 14)) div 14,2);
+  { Adjust scrollbar step and page step }
+  D^.FileList^.SetRange(D^.FileList^.Range); {set again for scrollbar min max values}
+
+  if ExecuteDialog(D, @S) <> cmCancel then
+  begin
+    P:=@S;
+    MessageBox('The file %s', @P, mfInformation + mfOKButton);
+  end;
+end;
+
+procedure DirChangeDialog;
+var
+  R: TRect;
+  D: PChDirDialog;
+  S: Sw_String;
+begin
+  GetDir(0,S); { current directory }
+  D := New(PEditChDirDialog, Init(cdNormal,213));
+  { Resize }
+  if Desktop^.Size.Y > 26 then
+    D^.GrowTo(D^.Size.X,Desktop^.Size.Y-6);
+  if Desktop^.Size.X > 60 then
+    D^.GrowTo(Min(Desktop^.Size.X-(60-D^.Size.X),102),D^.Size.Y);
+
+  if ExecuteDialog(D, @S) <> cmCancel then
+  begin
+    MessageBox('The directory '+S, nil, mfInformation + mfOKButton);
+  end;
+end;
+
+procedure DirChangeDialogII;
+var
+  R: TRect;
+  D: PChDirDialog;
+  S: Sw_String;
+begin
+  GetDir(0,S); { current directory }
+  D := New(PChDirDialog, Init(cdNormal,213));
+  { Resize }
+  if Desktop^.Size.Y > 26 then
+    D^.GrowTo(D^.Size.X,Desktop^.Size.Y-6);
+  if Desktop^.Size.X > 60 then
+    D^.GrowTo(Min(Desktop^.Size.X-(60-D^.Size.X),102),D^.Size.Y);
+
+  if ExecuteDialog(D, nil) <> cmCancel then
+  begin
+    GetDir(0,S); { new current directory }
+    MessageBox('The directory '+S, nil, mfInformation + mfOKButton);
+  end;
+end;
+
+
+
+begin
+  inherited HandleEvent(Event);
+  case Event.What of
+    evCommand:
+      begin
+        case Event.Command of
+          cmOpneFileDlg : OpenFileDialog;
+          cmDirChangeDlg: DirChangeDialog;
+          cmDirChangeDlg2:DirChangeDialogII;
+        else
+          Exit;
+        end;
+        ClearEvent(Event);
+      end;
+  end;
+end;
+
+var
+  FileDlgApp: TFileDlgApp;
+begin
+  FileDlgApp.Init;
+  FileDlgApp.Run;
+  FileDlgApp.Done;
+end.