mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-31 14:12:32 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			244 lines
		
	
	
		
			7.6 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			244 lines
		
	
	
		
			7.6 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
| unit frmmain;
 | |
| 
 | |
| {$mode objfpc}
 | |
| 
 | |
| Interface
 | |
| 
 | |
| Uses gtk,gdk,glib,sysutils,classes;
 | |
| 
 | |
| Type
 | |
|   TMainWindow = Record
 | |
|     FDir,
 | |
|     FMask : String;
 | |
|     Window : PGtkWindow;
 | |
|     Menu : PGtkMenuBar;
 | |
|     Toolbar : PGtkToolBar;
 | |
|     DirTree : PGtkTree;
 | |
|     FileList : PGtkClist;
 | |
|     Pane : PGtkPaned;
 | |
|     StatusBar : PGtkStatusBar;
 | |
|     FilesHeader,DirHeader : PGtkLabel;
 | |
|     // helper objects - Menu
 | |
|     Accel : PGtkAccelGroup;
 | |
|     MFile,
 | |
|     MView,
 | |
|     MColumns,
 | |
|     MHelp,
 | |
|     // Main menu items
 | |
|     PMFiles : PGtkMenu;
 | |
|     MIFile,
 | |
|     MIFileProperties,
 | |
|     MIFileDelete,
 | |
|     MIExit,
 | |
|     MIColumns,
 | |
|     MIMask,
 | |
|     MIAbout,
 | |
|     MIHelp : PGtkMenuItem;
 | |
|     MIShowTitles,
 | |
|     MIShowExt,
 | |
|     MIShowSize,
 | |
|     MiShowDate,
 | |
|     MIShowAttrs : PGtkCheckMenuItem;
 | |
|     // Files PopupMenu Items:
 | |
|     PMIFileProperties,
 | |
|     PMIFileDelete : PGtkMenuItem;
 | |
|     // Packing boxes
 | |
|     VBox,
 | |
|     LeftBox,
 | |
|     RightBox : PGtkBox;
 | |
|     // Scroll boxes
 | |
|     TreeScrollWindow,
 | |
|     ListScrollWindow : PGtkScrolledWindow;
 | |
|     // Tree root node.
 | |
|     RootNode : PGtkTreeItem;
 | |
|     
 | |
|   end;
 | |
|   PMainWindow = ^TMainWindow;   
 | |
| 
 | |
| Function NewMainForm : PMainWindow;
 | |
| Function NewMainMenu(MainWindow : PMainWindow) : PGtkMenuBar;
 | |
| Function NewToolbar(MainWindow : PMainWindow) : PGtkToolbar;
 | |
| Function NewDirtree(MainWindow : PMainWindow) : PGtkTree;
 | |
| Function NewFileList(MainWindow : PMainWindow) : PGtkClist;
 | |
| Procedure ShowDir (Window : PMainWindow; Dir : String);
 | |
| Function NewFilePopupMenu (MainWindow : PMainWindow) : PGtkMenu;
 | |
| 
 | |
| Implementation
 | |
| 
 | |
| uses menus,futils,frmabout,fxbitmaps,frmprops,frmmask;
 | |
| 
 | |
| Const
 | |
|   SFileExplorer : PChar = 'File explorer';
 | |
|   SFilesindir = 'Files in directory %s';
 | |
|   SDirTree : Pchar = 'Directory tree';
 | |
| 
 | |
| {$i filelist.inc}
 | |
| {$i dirlist.inc}
 | |
| {$i factions.inc}
 | |
| 
 | |
| procedure destroy(widget : pGtkWidget ; Window : PMainWindow); cdecl;
 | |
| begin
 | |
|   gtk_clist_clear(Window^.FileList);
 | |
|   dispose(Window);
 | |
|   gtk_main_quit();
 | |
| end;
 | |
| 
 | |
| procedure DoAbout(widget : pGtkWidget ; data: pgpointer ); cdecl;
 | |
| begin
 | |
|   ShowAboutForm(NewAboutform);
 | |
| end;
 | |
| 
 | |
| Procedure ApplyMask(Mask : String; Data : Pointer);
 | |
| 
 | |
| begin
 | |
|   PMainWindow(data)^.FMask:=Mask;
 | |
|   RefreshFileView(PMainWindow(Data));
 | |
| end; 
 | |
| 
 | |
| procedure DoMask(Widget : PGtkWidget ; MainForm : PMainWindow ); cdecl;
 | |
| 
 | |
| Var
 | |
|   S : AnsiString;
 | |
|     
 | |
| begin
 | |
|   With NewMaskForm^ do
 | |
|     begin
 | |
|     S:=MainForm^.FMask;
 | |
|     gtk_entry_set_text(EMask,PChar(S));
 | |
|     CallBack:=@ApplyMask;
 | |
|     CallBackData:=MainForm;
 | |
|     gtk_widget_show_all(PgtkWidget(Window));
 | |
|     end;  
 | |
| end;
 | |
| 
 | |
| Function NewMainForm : PMainWindow;
 | |
| 
 | |
| begin
 | |
|   Result:=New(PMainWindow);
 | |
|   With Result^ do
 | |
|     begin
 | |
|     FMask:='*.*';
 | |
|     Window:=PgtkWindow(gtk_window_new(GTK_WINDOW_TOPLEVEL));
 | |
|     gtk_window_set_title(Window,SFileExplorer);
 | |
|     gtk_widget_set_usize(PgtkWidget(Window),640,480);
 | |
|     gtk_signal_connect (PGTKOBJECT (window), 'destroy',
 | |
|                     GTK_SIGNAL_FUNC (@destroy), Result);
 | |
|     gtk_widget_realize(PgtkWidget(window));
 | |
|     Menu:=NewMainMenu(Result);
 | |
|     ToolBar:=NewToolbar(Result);
 | |
|     Pane:=PgtkPaned(gtk_hpaned_new);
 | |
|     StatusBar:=PgtkStatusBar(gtk_statusbar_new);
 | |
|     FileList:=NewFileList(Result);
 | |
|     DirTree:=NewDirtree(Result);
 | |
|     PMFiles:=NewFilePopupMenu(Result);
 | |
|     FilesHeader:=PgtkLabel(gtk_label_new(pchar(SFilesInDir)));
 | |
|     DirHeader:=PgtkLabel(gtk_label_new(pchar(SDirTree)));
 | |
|     LeftBox:=PGtkBox(gtk_vbox_new(false,0));
 | |
|     gtk_box_pack_start(Leftbox,PGtkWidget(DirHeader),False,False,0);
 | |
|     gtk_box_pack_start(Leftbox,PgtkWidget(TreeScrollWindow),true,True,0);
 | |
|     gtk_paned_add1(pane,PGtkWidget(Leftbox));
 | |
|     RightBox:=PGtkBox(gtk_vbox_new(false,0));
 | |
|     gtk_box_pack_start(Rightbox,PGtkWidget(FilesHeader),False,False,0);
 | |
|     gtk_box_pack_start(Rightbox,PGtkWidget(ListScrollWindow),true,True,0);
 | |
|     gtk_paned_add2(pane,PGtkWidget(Rightbox));
 | |
|     VBox:=PGtkBox(gtk_vbox_new(false,0));
 | |
|     gtk_container_add(PGtkContainer(Window),PgtkWidget(VBox));
 | |
|     gtk_box_pack_start(vbox,PGtkWidget(Menu),False,False,0);
 | |
|     gtk_widget_show_all(PGtkWidget(vbox));
 | |
|     gtk_box_pack_start(vbox,PGtkWidget(ToolBar),False,False,0);
 | |
|     gtk_box_pack_start(vbox,PGtkWidget(Pane),true,true,0);
 | |
|     gtk_box_pack_start(vbox,PGtkWidget(StatusBar),false,false,0);
 | |
|     end;
 | |
| end;
 | |
| 
 | |
| 
 | |
| 
 | |
| Function NewMainMenu(MainWindow : PMainWindow) : PGtkMenuBar;
 | |
| 
 | |
| begin
 | |
|   With MainWindow^ do
 | |
|     begin
 | |
|     Result:=pgtkmenubar(gtk_menu_bar_new);
 | |
|     Accel:=gtk_accel_group_new;
 | |
|     gtk_window_add_accel_group(Window,accel);
 | |
|     MFile:=AddMenuToMenuBar(Result,accel,'_File',Nil,Nil,False,MIFile);
 | |
|     MIFileProperties:=AddItemToMenu(MFile,accel,'_Properties','<alt>p',TgtkSignalFunc(@DoProperties),MainWindow);
 | |
|     MIFileDelete:=AddItemToMenu(MFile,accel,'_Delete','',TgtkSignalFunc(@DeleteFile),MainWindow);
 | |
|     AddSeparatorToMenu(MFile);
 | |
|     MIExit:=AddItemToMenu(MFile,accel,'E_xit','<alt>x',TgtkSignalFunc(@destroy),MainWindow);
 | |
|     MView:=AddMenuToMenuBar(Result,accel,'_View',Nil,Nil,False,MIFile);
 | |
|     MIShowTitles:=AddCheckItemToMenu(MView,accel,'Hide titles','',TgtkSignalFunc(@ToggleFileListTitles),MainWindow);
 | |
|     MIColumns:=AddItemToMenu(MView,accel,'Hide columns','',Nil,MainWindow);
 | |
|     MIMask:=AddItemToMenu(MView,accel,'File Mask','',TGtkSignalFunc(@DoMask),MainWindow);
 | |
|     MColumns:=PgtkMenu(gtk_menu_new);
 | |
|     gtk_menu_item_set_submenu(MIColumns, PgtkWidget(MColumns));
 | |
|     MIShowExt:=AddCheckItemToMenu(MColumns,accel,'Extension','',TgtkSignalFunc(@ToggleFileListColumns),MainWindow);
 | |
|     MIShowSize:=AddCheckItemToMenu(MColumns,accel,'Size','',TgtkSignalFunc(@ToggleFileListColumns),MainWindow);
 | |
|     MIShowDate:=AddCheckItemToMenu(MColumns,accel,'Date','',TgtkSignalFunc(@ToggleFileListColumns),MainWindow);
 | |
|     MIShowAttrs:=AddCheckItemToMenu(MColumns,accel,'Attributes','',TgtkSignalFunc(@ToggleFileListColumns),MainWindow);
 | |
|     MHelp:=AddMenuToMenuBar(Result,accel,'_Help',Nil,Nil,True,MIHelp);
 | |
|     MIAbout:=AddItemToMenu(MHelp,accel,'_About','',TgtkSignalFunc(@DoAbout),Nil);
 | |
|     gtk_widget_show(PgtkWidget(result));
 | |
|     end;
 | |
| end;
 | |
| 
 | |
| Function NewToolbar (MainWindow : PMainWindow) : PGtkToolbar;
 | |
| 
 | |
| begin
 | |
|   Result:=pGtkToolBar(gtk_toolbar_new(GTK_ORIENTATION_HORIZONTAL,GTK_TOOLBAR_ICONS));
 | |
|   gtk_toolbar_append_item(result,
 | |
|                           Nil,
 | |
|                           'File Properties',
 | |
|                           nil,
 | |
|                           CreateWidgetFromXPm(PgtkWidget(MainWindow^.Window),@PropertiesXPM),
 | |
|                           TgtkSignalFunc(@DoProperties),
 | |
|                           MainWindow);
 | |
|   gtk_toolbar_append_item(result,
 | |
|                           Nil,
 | |
|                           'Delete File',
 | |
|                           Nil,
 | |
|                           CreateWidgetFromXPm(PgtkWidget(MainWindow^.Window),@DeleteXPM),
 | |
|                           TgtkSignalFunc(@DeleteFile),
 | |
|                           MainWindow);
 | |
| end;
 | |
| 
 | |
| 
 | |
| 
 | |
| Procedure ShowDir (Window : PMainWindow; Dir : String);
 | |
| 
 | |
| begin
 | |
|   With Window^ do
 | |
|     begin
 | |
|     FDir:=Dir;
 | |
|     FillList(FileList,Dir,FMask);
 | |
|     gtk_label_set_text(FilesHeader,pchar(Format(SFilesInDir,[Dir])));
 | |
|     end;
 | |
| end;
 | |
| 
 | |
| Procedure PMFilesActivate(Widget : PGtkWidget; Window : PMainWindow); cdecl;
 | |
| 
 | |
| Var State : TGtkStateType;
 | |
| 
 | |
| begin
 | |
|   if GetFileSelectionCount(Window^.FileList)>1 then
 | |
|     State:=GTK_STATE_INSENSITIVE
 | |
|   else
 | |
|     State:=GTK_STATE_Normal;
 | |
|   gtk_widget_set_state(PgtkWidget(Window^.PMIFileProperties),State);
 | |
| end;
 | |
| 
 | |
| 
 | |
| Function NewFilePopupMenu (MainWindow : PMainWindow) : PGtkMenu;
 | |
| 
 | |
| begin
 | |
|   result:=PGtkMenu(gtk_menu_new);
 | |
|   gtk_signal_connect(PGtkObject(result),'show',
 | |
|                      TGtkSignalFunc(@PMFilesActivate),MainWindow);
 | |
|   With MainWindow^ do
 | |
|     begin
 | |
|     PMIFileProperties:=AddItemToMenu(Result,Accel,'_Properties','',TgtkSignalFunc(@DoProperties),MainWindow);
 | |
|     PMIFileDelete:=AddItemToMenu(Result,Accel,'_Delete','<ctrl>d',TgtkSignalFunc(@DeleteFile),MainWindow);
 | |
|     end; 
 | |
| end;
 | |
| 
 | |
| end. | 
