paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 10:48:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Initial check-in

Browse Source
This commit is contained in:
michael 2001-07-10 21:54:31 +00:00
parent a5da4c13bd
commit 6db08d5a0c
25 changed files with 1744 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
docs/gtk1ex/ex1.pp Normal file
View File

@ -0,0 +1,23 @@
program ex1;
{$mode objfpc}
uses
glib,gtk;
procedure destroy(widget : pGtkWidget ; data: pgpointer ); cdecl;
begin
gtk_main_quit();
end;
var
window : pGtkWidget;
begin
gtk_init (@argc, @argv);
window := gtk_window_new (GTK_WINDOW_TOPLEVEL);
gtk_signal_connect (pGTKOBJECT (window), 'destroy',
GTK_SIGNAL_FUNC (@destroy), NULL);
gtk_widget_show (window);
gtk_main ();
end.

28
docs/gtk1ex/ex2.pp Normal file
View File

@ -0,0 +1,28 @@
program ex2;
{$mode objfpc}
uses
glib,gtk;
procedure destroy(widget : pGtkWidget ; data: pgpointer ); cdecl;
begin
gtk_main_quit();
end;
var
window : PGtkWidget;
button : PGtkWidget;
begin
gtk_init (@argc, @argv);
window := gtk_window_new (GTK_WINDOW_TOPLEVEL);
button := gtk_button_new_with_label('Click me');
gtk_container_set_border_width(GTK_CONTAINER(Window),5);
gtk_container_add(GTK_Container(window),button);
gtk_signal_connect (PGTKOBJECT (window), 'destroy',
GTK_SIGNAL_FUNC (@destroy), NULL);
gtk_widget_show (button);
gtk_widget_show (window);
gtk_main ();
end.

55
docs/gtk1ex/ex3.pp Normal file
View File

@ -0,0 +1,55 @@
program ex3;
{$mode objfpc}
uses
glib,gtk;
function newbutton(ALabel : PChar) : PGtkWidget;
begin
Result:=gtk_button_new_with_label(ALabel);
gtk_widget_show(result);
end;
procedure destroy(widget : pGtkWidget ; data: pgpointer ); cdecl;
begin
gtk_main_quit();
end;
var
window,
totalbox,
hbox,vbox : PgtkWidget;
begin
gtk_init (@argc, @argv);
window := gtk_window_new (GTK_WINDOW_TOPLEVEL);
// Box to divide window in 2 halves:
totalbox := gtk_vbox_new(true,10);
gtk_widget_show(totalbox);
// A box for each half of the screen:
hbox := gtk_hbox_new(false,5);
gtk_widget_show(hbox);
vbox := gtk_vbox_new(true,5);
gtk_widget_show(vbox);
// Put boxes in their halves
gtk_box_pack_start(GTK_BOX(totalbox),hbox,true,true,0);
gtk_box_pack_start(GTK_BOX(totalbox),vbox,true,true,0);
// Now fill boxes with buttons.
// Horizontal box
gtk_box_pack_start(GTK_BOX(hbox),newbutton('Button 1'),false,false,0);
gtk_box_pack_start(GTK_BOX(hbox),newbutton('Button 2'),false,false,0);
gtk_box_pack_start(GTK_BOX(hbox),newbutton('Button 3'),false,false,0);
// Vertical box
gtk_box_pack_start(GTK_BOX(vbox),newbutton('Button A'),true,true,0);
gtk_box_pack_start(GTK_BOX(vbox),newbutton('Button B'),true,true,0);
gtk_box_pack_start(GTK_BOX(vbox),newbutton('Button C'),true,true,0);
// Put totalbox in window
gtk_container_set_border_width(GTK_CONTAINER(Window),5);
gtk_container_add(GTK_Container(window),totalbox);
gtk_signal_connect (PGTKOBJECT (window), 'destroy',
GTK_SIGNAL_FUNC (@destroy), NULL);
gtk_widget_show (window);
gtk_main ();
end.

46
docs/gtk1ex/ex4.pp Normal file
View File

@ -0,0 +1,46 @@
program ex4;
{$mode objfpc}
uses
glib,gtk;
function newbutton(ALabel : PChar) : PGtkWidget;
begin
Result:=gtk_button_new_with_label(ALabel);
gtk_widget_show(result);
end;
procedure destroy(widget : pGtkWidget ; data: pgpointer ); cdecl;
begin
gtk_main_quit();
end;
var
window,
maintable: PgtkWidget;
procedure AddToTable(Widget : PGtkWidget;
Left,Right, Top,Bottom : guint);
begin
gtk_table_attach_defaults (GTK_TABLE(MainTable),Widget,
Left,right,top,bottom);
end;
begin
gtk_init (@argc, @argv);
window := gtk_window_new (GTK_WINDOW_TOPLEVEL);
Maintable := gtk_table_new(6,6,True);
gtk_widget_show(MainTable);
AddToTable(newbutton('1,1 At 1,1'),1,2,1,2);
AddToTable(newbutton('2,2 At 3,1'),3,5,1,3);
AddToTable(newbutton('4,1 At 4,1'),1,5,4,5);
// Put all in window
gtk_container_set_border_width(GTK_CONTAINER(Window),5);
gtk_container_add(GTK_Container(window),maintable);
gtk_signal_connect (PGTKOBJECT (window), 'destroy',
GTK_SIGNAL_FUNC (@destroy), NULL);
gtk_widget_show (window);
gtk_main ();
end.

31
docs/gtk1ex/ex5.pp Normal file
View File

@ -0,0 +1,31 @@
program ex5;
{$mode objfpc}
uses
glib,gtk;
procedure destroy(widget : pGtkWidget ; data: pgpointer ); cdecl;
begin
gtk_main_quit();
end;
var
window : PGtkWidget;
button : PGtkWidget;
begin
gtk_init (@argc, @argv);
window := gtk_window_new (GTK_WINDOW_TOPLEVEL);
button := gtk_button_new_with_label('Click me');
gtk_container_set_border_width(GTK_CONTAINER(Window),5);
gtk_container_add(GTK_Container(window),button);
gtk_signal_connect (PGTKOBJECT (window), 'destroy',
GTK_SIGNAL_FUNC (@destroy), NULL);
gtk_signal_connect_object(PGTKOBJECT(button),'clicked',
GTK_SIGNAL_FUNC(@gtk_widget_destroy),
PGTKOBJECT(window));
gtk_widget_show (button);
gtk_widget_show (window);
gtk_main ();
end.

71
docs/gtk1ex/ex6.pp Normal file
View File

@ -0,0 +1,71 @@
program ex6;
{$mode objfpc}
uses
glib,gtk;
Type
TButtonSignalState = Record
Obj : PgtkObject;
SignalID : longint;
Disable : Boolean;
end;
PButtonSignalState = ^TButtonSignalState;
procedure destroy(widget : pGtkWidget ; data: pgpointer ); cdecl;
begin
gtk_main_quit();
end;
procedure disablesignal(widget : pGtkWidget ; data: pgpointer ); cdecl;
begin
With PButtonSignalState(Data)^ do
begin
If Disable then
gtk_signal_handler_block(Obj,SignalID)
else
gtk_signal_handler_unblock(Obj,SignalID);
disable:=Not disable;
end;
end;
var
window : PGtkWidget;
quitbutton : PGtkWidget;
disablebutton : PGTKWidget;
windowbox : PGTKWidget;
quitsignal : guint;
QuitState : TButtonSignalState;
begin
gtk_init (@argc, @argv);
window := gtk_window_new (GTK_WINDOW_TOPLEVEL);
quitbutton := gtk_button_new_with_label('Quit program');
disablebutton := gtk_button_new_with_label('Disable button');
windowbox:=gtk_vbox_new(TRUE,10);
gtk_box_pack_start(GTK_BOX(windowbox),disablebutton,True,false,0);
gtk_box_pack_start(GTK_BOX(windowbox),quitbutton,True,false,0);
gtk_container_set_border_width(GTK_CONTAINER(Window),10);
gtk_container_add(GTK_Container(window),windowbox);
gtk_signal_connect (PGTKOBJECT (window), 'destroy',
GTK_SIGNAL_FUNC (@destroy), NULL);
With QuitState do
begin
Obj:=PGTKObject(QuitButton);
SignalID:=gtk_signal_connect_object(Obj,'clicked',
GTK_SIGNAL_FUNC(@gtk_widget_destroy),
PGTKOBJECT(window));
Disable:=True;
end;
gtk_signal_connect(PGTKOBJECT(disablebutton),'clicked',
GTK_SIGNAL_FUNC(@disablesignal),@QuitState);
gtk_widget_show (quitbutton);
gtk_widget_show (disablebutton);
gtk_widget_show (windowbox);
gtk_widget_show (window);
gtk_main ();
end.

54
docs/gtk1ex/ex7.pp Normal file
View File

@ -0,0 +1,54 @@
program ex2;
uses
gdk,glib,gtk,strings;
procedure destroy(widget : pGtkWidget ; data: pgpointer ); cdecl;
begin
gtk_main_quit();
end;
Const
Inside : PChar ='Mouse is over label';
OutSide : PChar ='Mouse is not over label';
var
OverLabel : Boolean;
window, box1, box2, stackbox, label1, Label2 : PGtkWidget;
Procedure ChangeLabel(P : PGtkWidget;
Event : PGdkEventCrossing;
Var Data : Boolean);cdecl;
begin
If Not Data then
gtk_label_set_text(PGTKLABEL(Label2),Inside)
else
gtk_label_set_text(PGTKLABEL(Label2),Outside);
Data := Not Data;
end;
begin
gtk_init (@argc, @argv);
window := gtk_window_new (GTK_WINDOW_TOPLEVEL);
stackbox:=gtk_vbox_new(TRUE,10);
box1 := gtk_event_box_new();
label1 := gtk_label_new(strnew('Move mouse over label'));
gtk_container_add(GTK_CONTAINER(box1),label1);
box2 := gtk_event_box_new();
label2 := gtk_label_new(strNew(OutSide));
gtk_container_add(GTK_CONTAINER(box2),label2);
gtk_box_pack_start(GTK_BOX(stackbox),box1,TRUE,TRUE,0);
gtk_box_pack_start(GTK_BOX(stackbox),box2,TRUE,TRUE,0);
gtk_container_set_border_width(GTK_CONTAINER(Window),5);
gtk_container_add(GTK_Container(window),stackbox);
gtk_signal_connect(PGTKOBJECT (window), 'destroy',
GTK_SIGNAL_FUNC (@destroy), NULL);
overlabel:=False;
gtk_signal_connect(PGTKOBJECT(box1),'enter_notify_event',
GTK_SIGNAL_FUNC (@ChangeLabel), @Overlabel);
gtk_signal_connect(PGTKOBJECT(box1),'leave_notify_event',
GTK_SIGNAL_FUNC (@ChangeLabel), @Overlabel);
gtk_widget_show_all (window);
gtk_main ();
end.

40
docs/gtk1ex/ex8.pp Normal file
View File

@ -0,0 +1,40 @@
program ex8;
uses
glib,gtk;
procedure destroy(widget : pGtkWidget ; data: pgpointer ); cdecl;
begin
gtk_main_quit();
end;
var
window, stackbox, label1, Label2 : PGtkWidget;
labelstyle : pgtkstyle;
begin
gtk_init (@argc, @argv);
window := gtk_window_new (GTK_WINDOW_TOPLEVEL);
stackbox:=gtk_vbox_new(TRUE,10);
label1 := gtk_label_new('Red label text');
labelstyle := gtk_style_copy(gtk_widget_get_style(label1));
With LabelStyle^.fg[GTK_STATE_NORMAL] do
begin
pixel:=0;
red:=$ffff;
blue:=0;
green:=0;
end;
gtk_widget_set_style(label1,labelstyle);
// Uncomment this to see the effect of setting the default style.
// gtk_widget_set_default_style(labelstyle);
label2 := gtk_label_new('Black label text');
gtk_box_pack_start(GTK_BOX(stackbox),label1,TRUE,TRUE,0);
gtk_box_pack_start(GTK_BOX(stackbox),label2,TRUE,TRUE,0);
gtk_container_set_border_width(GTK_CONTAINER(Window),5);
gtk_container_add(GTK_Container(window),stackbox);
gtk_signal_connect(PGTKOBJECT (window), 'destroy',
GTK_SIGNAL_FUNC (@destroy), NULL);
gtk_widget_show_all (window);
gtk_main ();
end.

62
docs/gtk1ex/ex9.pp Normal file
View File

@ -0,0 +1,62 @@
program ex9;
uses
gdk,glib,gtk,strings;
procedure destroy(widget : pGtkWidget ; data: pgpointer ); cdecl;
begin
gtk_main_quit();
end;
Const
Inside : PChar ='Mouse is over label';
OutSide : PChar ='Mouse is not over label';
var
window, button1,Button2, Alabel,stackbox : PGtkWidget;
buttonstyle : pgtkstyle;
OverButton : boolean;
Procedure ChangeLabel(P : PGtkWidget;
Event : PGdkEventCrossing;
Var Data : Boolean);cdecl;
begin
If Not Data then
gtk_label_set_text(PGTKLABEL(ALabel),Inside)
else
gtk_label_set_text(PGTKLABEL(ALabel),Outside);
Data := Not Data;
end;
begin
gtk_init (@argc, @argv);
window := gtk_window_new (GTK_WINDOW_TOPLEVEL);
stackbox:=gtk_vbox_new(TRUE,10);
button1 := gtk_button_new_with_label(strnew('Move mouse over button'));
buttonstyle := gtk_style_copy(gtk_widget_get_style(Button1));
With ButtonStyle^.bg[GTK_STATE_PRELIGHT] do
begin
pixel:=0;
red:=$ffff;
blue:=0;
green:=0;
end;
gtk_widget_set_style(button1,buttonstyle);
button2 := gtk_button_new;
ALabel:=gtk_label_new(Outside);
gtk_container_add(GTK_CONTAINER(button2),ALAbel);
gtk_box_pack_start(GTK_BOX(stackbox),button1,TRUE,TRUE,0);
gtk_box_pack_start(GTK_BOX(stackbox),button2,TRUE,TRUE,0);
gtk_container_set_border_width(GTK_CONTAINER(Window),5);
gtk_container_add(GTK_Container(window),stackbox);
gtk_signal_connect(PGTKOBJECT (window), 'destroy',
GTK_SIGNAL_FUNC (@destroy), NULL);
overbutton:=False;
gtk_signal_connect(PGTKOBJECT(button1),'enter_notify_event',
GTK_SIGNAL_FUNC (@ChangeLabel), @OverButton);
gtk_signal_connect(PGTKOBJECT(button1),'leave_notify_event',
GTK_SIGNAL_FUNC (@ChangeLabel), @OverButton);
gtk_widget_show_all (window);
gtk_main ();
end.

25
docs/gtk4ex/delete.xpm Normal file
View File

@ -0,0 +1,25 @@
/* XPM */
static char *delete[] = {
/* width height num_colors chars_per_pixel */
" 16 16 2 1",
/* colors */
". c #000000",
"# c #c0c0c0",
/* pixels */
"################",
"################",
"##...#########.#",
"##....######..##",
"###....####..###",
"#####...##..####",
"######.....#####",
"#######...######",
"######.....#####",
"#####...##..####",
"####...####..###",
"###...######.###",
"##....#######.##",
"##...###########",
"###.##########.#",
"################"
};

115
docs/gtk4ex/dirlist.inc Normal file
View File

@ -0,0 +1,115 @@
Procedure Scandirs(Path: String; Tree : PgtkTree;
Node: PGtkTreeItem ; SubSub : Boolean;
Window : PMainWindow); forward;
Function GetPathName(Item : PGtkTreeItem) : String;
Var P : PChar;
PTree : PGtkTree;
begin
gtk_label_get(PgtkLabel(PGtkBin(Item)^.Child),@P);
Result:=StrPas(P);
If (PGtkWidget(item)^.Parent<>Nil) then
begin
PTree:=PGtkTree(PgtkWidget(Item)^.Parent);
If (Ptree^.Level<>0) Then
Result:=AddTrailingSeparator(GetPathName(PgtkTreeItem(PTree^.Tree_Owner)))+Result
end;
end;
Procedure DirSelect(Item : PGtkTreeItem; Window : PMainWindow);cdecl;
begin
ShowDir(Window,GetPathName(Item));
end;
Procedure DirExpand(Item : PGtkTreeItem; Window : PMainWindow);cdecl;
Var
Dir : String;
SubTree : PGtkTree;
SubNodes : PGList;
Node : PGtkTreeItem;
begin
SubTree:=PgtkTree(Item^.SubTree);
SubNodes:=gtk_container_children(PGtkContainer(SubTree));
While SubNodes<>Nil do
begin
Node:=PgtkTreeItem(SubNodes^.Data);
If (Node^.SubTree<>Nil) then
gtk_tree_item_remove_subtree(Node);
Scandirs(GetPathName(Node),Nil,Node,False,Window);
SubNodes:=g_list_remove_link(SubNodes,SubNodes);
end;
end;
Procedure Scandirs(Path: String; Tree : PgtkTree;
Node: PGtkTreeItem ; SubSub : Boolean;
Window : PMainWindow);
Var
NewTree : PGtkTree;
NewNode : PGtkTreeItem;
Info : TSearchRec;
S,FP : AnsiString;
begin
NewTree:=Nil;
FP:=AddTrailingSeparator(Path);
If FindFirst(FP+'*.*',faAnyfile,Info)=0 then
Try
repeat
If ((Info.Attr and faDirectory)=faDirectory) then
begin
S:=Info.Name;
If (S<>'.') and (S<>'..') then
begin
If (Node<>Nil) then
begin
If (NewTree=Nil) and (node<>Nil) then
begin
NewTree:=PGtkTree(gtk_tree_new);
gtk_tree_item_set_subtree(Node,PGtkWidget(NewTree));
end
end
else
NewTree:=Tree;
NewNode:=PGtkTreeItem(gtk_tree_item_new_with_label(Pchar(S)));
gtk_tree_append(NewTree,PgtkWidget(NewNode));
gtk_signal_connect(PGtkObject(NewNode),'select',
TGtkSignalFunc(@DirSelect),Window);
gtk_signal_connect(PGtkObject(NewNode),'expand',
TGtkSignalFunc(@DirExpand),Window);
If SubSub then
ScanDirs(FP+S,Tree,NewNode,False,Window);
gtk_widget_show(PGtkWidget(NewNode));
end;
end;
until FindNext(Info)<>0;
Finally
FindClose(Info);
end;
gtk_widget_show(PGtkWidget(Node));
end;
Function NewDirtree (MainWindow : PMainWindow) : PGtkTree;
begin
Result:=PGtkTree(gtk_tree_new());
With MainWindow^ do
begin
TreeScrollWindow:=PGtkScrolledWindow(gtk_scrolled_window_new(Nil,Nil));
gtk_widget_show(PGtkWidget(TreeScrollWindow));
gtk_scrolled_window_set_policy(TreeScrollWindow,
GTK_POLICY_AUTOMATIC,
GTK_POLICY_AUTOMATIC);
gtk_scrolled_window_add_with_viewport(TreeScrollWindow,PGtkWidget(Result));
RootNode:=PGtkTreeItem(gtk_tree_Item_new_with_label(Pchar(PathSeparator)));
gtk_tree_append(Result,PgtkWidget(RootNode));
scandirs(PathSeparator,Result, RootNode,True,MainWindow);
gtk_tree_item_expand(rootnode);
end;
end;

33
docs/gtk4ex/factions.inc Normal file
View File

@ -0,0 +1,33 @@
Procedure DoProperties(widget : pGtkWidget ; Window : PMainWindow); cdecl;
Var i : longint;
S : string;
Dlg : PFilePropertiesDialog;
begin
With Window^ do
S:=AddTrailingSeparator(FDir)+GetFileFirstSelection(FileList);
Dlg:=NewFilePropertiesDialog(S);
ShowFilePropertiesDialog(Dlg);
end;
Procedure DeleteFile(Widget : PGtkWidget; Window : PMainWindow); cdecl;
Var i : longint;
S : TStringList;
begin
S:=TStringList.Create;
Try
GetFileSelection(Window^.FileList,S);
For I:=0 to S.Count-1 do
begin
For I:=0 to S.Count-1 do
SysUtils.DeleteFile(Window^.FDir+S[i]);
end;
Finally
If S.Count>0 then
RefreshFileView(Window);
S.Free;
end;
end;

213
docs/gtk4ex/filelist.inc Normal file
View File

@ -0,0 +1,213 @@
Const
DefCompare : TGtkCListCompareFunc = Nil;
Function FileCompareFunc(List:PGtkCList; Row1,Row2 : PGtkCListRow) : Longint; Cdecl;
Var
SC : Longint;
begin
SC:=List^.sort_column;
If SC in [2,3] then
begin
SC:=SC-2;
Result:=PLongint(Row1^.Data)[SC]-PLongint(Row2^.Data)[SC];
end
Else
Result:=DefCompare(List,Row1,Row2);
end;
Procedure DestroySortData(FSD : Pointer);cdecl;
begin
FreeMem(FSD);
end;
Procedure AddFileToList(List : PGtkCList; Info : TSearchRec);
Var
Texts : Array[1..6] of AnsiString;
FSD : PLongint;
I : longint;
begin
Texts[1]:=ExtractFileName(Info.Name);
Texts[2]:=ExtractFileExt(Info.Name);
Texts[3]:=FileSizeToString(Info.Size);
Texts[4]:=DateTimeToStr(FileDateToDateTime(Info.Time));
Texts[5]:=FileAttrsToString(Info.Attr);
Texts[6]:='';
i:=gtk_clist_append(List,@Texts[1]);
FSD:=GetMem(2*SizeOf(Longint));
FSD[0]:=Info.Size;
FSD[1]:=Info.Time;
gtk_clist_set_row_data_full (List,I,FSD,@DestroySortData);
end;
Function FillList(List : PGtkCList; Const Dir,Mask : String) : Integer;
Var
Info : TSearchRec;
Size : Int64;
I : longint;
begin
Result:=0;
Size:=0;
gtk_clist_freeze(List);
Try
gtk_clist_clear(List);
If FindFirst (AddTrailingSeparator(Dir)+Mask,faAnyFile,Info)=0 then
Repeat
Inc(Size,Info.Size);
AddFileToList(List,Info);
Inc(Result);
Until FindNext(Info)<>0;
FindClose(info);
finally
For I:=0 to 4 do
gtk_clist_set_column_width(List,i,gtk_clist_optimal_column_width(List,i));
gtk_clist_thaw(List)
end;
end;
Procedure ShowPopup(Widget : PGtkWidget; Event : PGdkEventButton; Window : PMainWindow);cdecl;
begin
if (event^.thetype=GDK_BUTTON_PRESS) and (event^.button=3) then
begin
gtk_menu_popup(Window^.PMFiles,Nil,Nil,Nil,NIl,3,event^.time);
end;
end;
Procedure FileColumnClick(List : PGtkCList;Column:gint; Window : PMainWindow);cdecl;
Var
I : longint;
NS : TGtkSortType;
begin
If Column<>List^.sort_column Then
begin
gtk_clist_set_sort_type(List,GTK_SORT_ASCENDING);
gtk_clist_set_sort_column(list,Column);
end
else
begin
If (List^.Sort_type=GTK_SORT_ASCENDING) Then
NS:=GTK_SORT_DESCENDING
else
NS:=GTK_SORT_ASCENDING;
gtk_clist_set_sort_type(List,NS);
end;
gtk_clist_sort(list);
end;
Function NewFileList(MainWindow : PMainWindow) : PGtkClist;
Const
Titles : Array[1..6] of pchar = ('Name','ext','Size','Date','Attributes','');
begin
MainWindow^.ListScrollWindow:=PGtkScrolledWindow(gtk_scrolled_window_new(Nil,Nil));
gtk_scrolled_window_set_policy(MainWindow^.ListScrollWindow,
GTK_POLICY_AUTOMATIC,
GTK_POLICY_AUTOMATIC);
Result:=PGtkClist(Gtk_Clist_New_with_titles(6,@Titles));
gtk_signal_connect(PgtkObject(Result),'button_press_event',TGtkSignalFunc(@ShowPopup),MainWindow);
gtk_signal_connect(PgtkObject(Result),'click_column',TGtkSignalFunc(@FileColumnClick),MainWindow);
gtk_Container_add(PGTKContainer(MainWindow^.ListScrollWindow),PGtkWidget(Result));
gtk_clist_set_shadow_type(Result,GTK_SHADOW_ETCHED_OUT);
gtk_clist_set_column_justification(result,2,GTK_JUSTIFY_RIGHT);
gtk_clist_set_selection_mode(Result,GTK_SELECTION_MULTIPLE);
gtk_clist_set_auto_sort(Result,True);
If DefCompare=Nil then
DefCompare:=Result^.compare;
gtk_clist_set_compare_func(Result,TGtkCListCompareFunc(@FileCompareFunc));
end;
Procedure ToggleFileListTitles(Sender : PGtkCheckMenuItem;Window : PMainWindow);cdecl;
begin
If active(Sender^)=0 then
gtk_clist_column_titles_show(Window^.FileList)
else
gtk_clist_column_titles_hide(Window^.FileList)
end;
Procedure ToggleFileListColumns(Sender : PGtkCheckMenuItem;Window : PMainWindow);cdecl;
Var Col : Longint;
begin
With Window^ do
If Sender=MIShowExt Then
Col:=1
else if Sender=MiShowSize Then
Col:=2
else if Sender=MIShowDate then
Col:=3
else
Col:=4;
gtk_clist_set_column_visibility(Window^.FileList,Col,(Active(Sender^)=0));
end;
Procedure GetFileSelection (List : PGtkClist; Selection : TStrings);
Var
SList : PGList;
Index : Longint;
P : PChar;
begin
Selection.Clear;
Slist:=List^.Selection;
While SList<>nil do
begin
Index:=Longint(SList^.Data);
gtk_clist_get_text(List,Index,0,@p);
Selection.Add(StrPas(p));
SList:=g_list_next(SList);
end;
end;
Function GetFileFirstSelection (List : PGtkClist) : String;
Var
SList : PGList;
Index : Longint;
P : PChar;
begin
REsult:='';
Slist:=List^.Selection;
If SList<>nil then
begin
Index:=Longint(SList^.Data);
gtk_clist_get_text(List,Index,0,@p);
Result:=StrPas(p);
end;
end;
Function GetFileSelectionCount (List : PGtkClist) : Longint;
Var
SList : PGList;
begin
Slist:=List^.Selection;
Result:=0;
While SList<>nil do
begin
Inc(Result);
SList:=g_list_next(SList);
end;
end;
Procedure RefreshFileView(Window : PMainWindow);
begin
With Window^ do
FillList(FileList,FDir,FMask);
end;

BIN
docs/gtk4ex/filemask.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.7 KiB

BIN
docs/gtk4ex/fileprops.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 5.0 KiB

66
docs/gtk4ex/frmabout.pp Normal file
View File

@ -0,0 +1,66 @@
unit frmabout;
{$mode objfpc}
Interface
uses glib,gdk,gtk;
Type
TAboutForm = Record
Window : PGtkDialog;
OkButton : PgtkButton;
InfoLabel : PGtkLabel;
end;
PAboutForm = ^TAboutForm;
Function NewAboutForm : PAboutForm;
Procedure ShowAboutForm(Form : PAboutForm);
Implementation
Const
SInfo : PChar = 'File explorer demo'#10'Florian Klaempfl'#10'Michael Van Canneyt';
SAboutTitle : Pchar = 'About File explorer';
procedure DestroyAbout(Widget : PGtkWidget; About : PAboutForm);cdecl;
begin
Dispose(About);
end;
Function NewAboutForm : PAboutForm;
begin
Result:=New(PAboutForm);
With Result^ do
begin
Window:=PgtkDialog(gtk_dialog_new);
gtk_window_set_modal(PgtkWindow(Window),True);
gtk_window_set_title(PgtkWindow(Window),SAboutTitle);
gtk_widget_set_usize(PGtkWidget(Window),250,150);
gtk_window_set_policy(PgtkWindow(Window),0,0,0);
gtk_window_set_position(PGtkWindow(Window),GTK_WIN_POS_CENTER);
OkButton:=PGtkButton(gtk_button_new_with_label(' Ok '));
gtk_box_pack_start(PgtkBox(Window^.action_area),PGtkWidget(Okbutton),False,False,5);
gtk_window_set_focus(PGtkWindow(Window),PGtkWidget(OkButton));
gtk_widget_show(PGtkWidget(OkButton));
InfoLabel:=PgtkLabel(gtk_label_new(SInfo));
gtk_box_pack_start(PGtkBox(Window^.vbox),PGtkWidget(InfoLabel),True,True,10);
gtk_widget_show(PGtkWidget(InfoLabel));
gtk_signal_connect(PGtkObject(Window),'destroy',
TGTKSignalFunc(@DestroyAbout),Result);
gtk_signal_connect_object(PgtkObject(OKButton),'clicked',
GTK_SIGNAL_FUNC(@gtk_widget_destroy),
PGTKOBJECT(Window));
end;
end;
Procedure ShowAboutForm(Form : PAboutForm);
begin
gtk_window_set_modal(PgtkWindow(Form^.Window),True);
gtk_widget_show(PgtkWidget(Form^.Window));
end;
end.

244
docs/gtk4ex/frmmain.pp Normal file
View File

@ -0,0 +1,244 @@
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.

88
docs/gtk4ex/frmmask.pp Normal file
View File

@ -0,0 +1,88 @@
unit frmmask;
{$mode objfpc}
Interface
uses glib,gdk,gtk;
Type
TMaskCallBack = Procedure (Mask : String; Data : Pointer);
TMaskForm = Record
Window : PGtkDialog;
EMask : PGtkEntry;
LEMAsk : PGtkLabel;
HBox : PGtkBox;
OKButton,
CancelButton : PGtkButton;
Mask : ShortString;
CallBack : TMaskCallBack;
CallBackData : Pointer;
end;
PMaskForm = ^TMaskForm;
Function NewMaskForm : PMaskForm;
Implementation
Const
SEnterMask : PChar = 'Enter new file mask';
SNewMask : PChar = 'New mask';
SOK : PChar = ' OK ';
SCancel : PChar = ' Cancel ';
Procedure ApplyMask(Widget : PGtkWidget; Window : PMaskForm);cdecl;
begin
With Window^ do
begin
Mask:=StrPas(gtk_entry_get_text(EMask));
If (CallBack<>Nil) then
CallBack(Mask,CallBackData);
end;
end;
Procedure DestroyMaskForm(Widget : PGtkWidget; Window : PMaskForm);cdecl;
begin
Dispose(Window);
end;
Function NewMaskForm : PMaskForm;
begin
Result:=New(PMaskForm);
With Result^ do
begin
Window:=PGtkDialog(gtk_dialog_new);
gtk_window_set_title(PgtkWindow(Window),SEnterMask);
gtk_widget_set_usize(PGtkWidget(Window),350,150);
gtk_window_set_policy(PgtkWindow(Window),0,0,0);
gtk_window_set_position(PGtkWindow(Window),GTK_WIN_POS_CENTER);
OKButton:=PGtkButton(gtk_button_new_with_label(SOK));
CancelButton:=PGtkButton(gtk_button_new_with_label(SCancel));
gtk_box_pack_end(PgtkBox(Window^.action_area),PGtkWidget(Okbutton),False,False,5);
gtk_box_pack_end(PgtkBox(Window^.action_area),PGtkWidget(Cancelbutton),False,False,5);
Emask:=PGtkEntry(gtk_entry_new_with_max_length(255));
LEMask:=PGtkLabel(gtk_label_new(SNewMask));
HBox:=PGtkBox(gtk_hbox_new(False,8));
gtk_box_pack_start(PgtkBox(HBox),PGtkWidget(LEMask),True,False,0);
gtk_box_pack_start(PgtkBox(HBox),PGtkWidget(EMask),True,False,0);
gtk_box_pack_start(PGtkBox(Window^.vbox),PGtkWidget(HBox),True,True,10);
gtk_window_set_modal(PGtkWindow(Window),TRUE);
gtk_signal_connect(PgtkObject(OKButton),'clicked',
TGtkSignalFunc(@ApplyMask),Result);
gtk_signal_connect_object(PgtkObject(OKButton),'clicked',
GTK_SIGNAL_FUNC(@gtk_widget_destroy),
PGTKOBJECT(Window));
gtk_signal_connect_object(PgtkObject(CancelButton),'clicked',
GTK_SIGNAL_FUNC(@gtk_widget_destroy),
PGTKOBJECT(Window));
gtk_signal_connect(PgtkObject(Window),'destroy',
TGtkSignalFunc(@DestroyMaskForm),Result);
CallBack:=Nil;
CallBackdata:=Nil;
end;
end;
end.

130
docs/gtk4ex/frmprops.pp Normal file
View File

@ -0,0 +1,130 @@
Unit frmprops;
{$mode objfpc}
Interface
uses glib,gdk,gtk,sysutils;
Const
NrTableLines = 8;
CheckBoxLineStart = 5;
Type
TFilePropertiesDialog = Record
Window : PgtkDialog;
Table : PGtkTable;
OkButton : PGtkButton;
Labels : Array[0..1,0..NrTableLines] of PGtkLabel;
CheckBoxes : Array[CheckBoxLineStart..NrTableLines] of PgtkCheckButton;
end;
PFilePropertiesDialog = ^TFilePropertiesDialog;
Function NewFilePropertiesDialog(FileName : String) : PFilePropertiesDialog;
Procedure ShowFilePropertiesDialog(Dialog : PFilePropertiesDialog);
Implementation
uses Futils;
Const
SPropsTitle : PChar = 'File properties';
SOk : PChar = ' OK ';
SFile = ' File.';
LabelTexts : Array[0..NrTableLines] of Pchar = (
'Name',
'Directory',
'Type',
'Size',
'Date',
'Attributes',
'',
'',
''
);
CheckBoxTexts : Array[CheckBoxLineStart..NrTableLines] of Pchar = (
'Read-only',
'Archive',
'Hidden',
'System'
);
procedure DestroyPropDialog(Widget : PGtkWidget; Dlg : PFilePropertiesDialog);cdecl;
begin
Dispose(Dlg);
end;
Function NewFilePropertiesDialog(FileName : String) : PFilePropertiesDialog;
Const
CheckAttrs : Array [CheckBoxLineStart..NrTableLines] of Integer
= (faReadOnly,faArchive,faHidden,faSysFile);
Var
Info : TSearchRec;
I : Longint;
begin
Result:=New(PFilePropertiesDialog);
With Result^ do
begin
Window:=PgtkDialog(gtk_dialog_new);
gtk_window_set_title(PgtkWindow(Window),SPropsTitle);
gtk_window_set_modal(PgtkWindow(Window),True);
gtk_window_set_policy(PgtkWindow(Window),0,0,0);
gtk_window_set_position(PGtkWindow(Window),GTK_WIN_POS_CENTER);
OkButton:=PGtkButton(gtk_button_new_with_label(SOK));
gtk_box_pack_start(PgtkBox(Window^.action_area),PGtkWidget(Okbutton),False,False,5);
gtk_window_set_focus(PGtkWindow(Window),PGtkWidget(OkButton));
gtk_widget_show(PGtkWidget(OkButton));
Table:=PgtkTable(gtk_table_new(NrTableLines+1,2,TRUE));
gtk_box_pack_start(PGtkBox(Window^.vbox),PGtkWidget(Table),True,True,10);
For I:=0 to NrTableLines do
begin
Labels[0,i]:=PGtkLabel(gtk_label_new(LabelTexts[i]));
gtk_label_set_justify(Labels[0,I],GTK_JUSTIFY_RIGHT);
gtk_table_attach_defaults(Table,PgtkWidget(Labels[0,I]),0,1,I,I+1);
end;
For I:=0 to CheckboxLineStart-1 do
begin
Labels[1,i]:=PGtkLabel(gtk_label_new(''));
gtk_label_set_justify(Labels[1,I],GTK_JUSTIFY_LEFT);
gtk_table_attach_defaults(Table,PgtkWidget(Labels[1,I]),1,2,I,I+1);
end;
For I:=CheckboxLineStart to NrTableLines do
begin
checkBoxes[i]:=PgtkCheckButton(gtk_check_button_new_with_label(CheckBoxTexts[I]));
gtk_widget_set_state(PGtKWidget(CheckBoxes[i]),GTK_STATE_INSENSITIVE);
gtk_table_attach_defaults(Table,PgtkWidget(CheckBoxes[i]),1,2,I,I+1);
end;
gtk_label_set_text(Labels[1,0],PChar(ExtractFileName(FileName)));
gtk_label_set_text(Labels[1,1],PChar(ExtractFilePath(FileName)));
gtk_label_set_text(Labels[1,2],PChar(ExtractFileExt(FileName)+SFile));
If FindFirst(FileName,faAnyFile,Info)=0 Then
begin
gtk_label_set_text(Labels[1,3],PChar(FileSizeToString(Info.Size)));
gtk_label_set_text(Labels[1,4],PChar(DateTimeToStr(FileDateToDateTime(Info.Time))));
For I:=CheckboxLineStart to NrTableLines do
If (CheckAttrs[i] and Info.Attr)=CheckAttrs[i] then
gtk_toggle_button_set_active(PgtkToggleButton(CheckBoxes[I]),True);
FindClose(Info);
end;
gtk_signal_connect(PGtkObject(Window),'destroy',
TGTKSignalFunc(@DestroyPropDialog),Result);
gtk_signal_connect_object(PgtkObject(OKButton),'clicked',
GTK_SIGNAL_FUNC(@gtk_widget_destroy),
PGTKOBJECT(Window));
end;
end;
Procedure ShowFilePropertiesDialog(Dialog : PFilePropertiesDialog);
begin
gtk_widget_show_all(PgtkWidget(Dialog^.Window));
end;
end.

92
docs/gtk4ex/futils.pp Normal file
View File

@ -0,0 +1,92 @@
unit futils;
{$mode objfpc}
{$h+}
Interface
Const
{$ifdef win32}
PathSeparator='\';
{$else}
PathSeparator='/';
{$endif}
Function StripTrailingSeparator(Const Dir : String) : String;
Function AddTrailingSeparator(Const Dir : String) : String;
Function FileSizeToString(Size: Int64) : String;
Function FileAttrsToString(FileAttrs : Integer) : String;
Implementation
Uses sysutils;
Function StripTrailingSeparator(Const Dir : String) : String;
Var
L : Integer;
begin
Result:=Dir;
L:=Length(result);
If (L>1) and (Result[l]=PathSeparator) then
SetLength(Result,L-1);
end;
Function AddTraiLingSeparator(Const Dir : String) : String;
Var
L : Integer;
begin
Result:=Dir;
L:=Length(Result);
If (L>0) and (Result[l]<>PathSeparator) then
Result:=Result+PathSeparator;
end;
Function FileSizeToString(Size: Int64) : String;
Const
Sizes : Array [0..4] of String =
('Bytes','Kb','Mb','Gb','Tb');
Var
F : Double;
I : longint;
begin
If Size>1024 Then
begin
F:=Size;
I:=0;
While (F>1024) and (I<4) do
begin
F:=F / 1024;
Inc(i);
end;
Result:=Format('%4.2f %s',[F,Sizes[i]]);
end
else
Result:=Format('%d %s',[Size,Sizes[0]]);
end;
Function FileAttrsToString(FileAttrs : Integer) : String;
Const
Attrs : Array[1..4] of integer =
(faArchive,faReadOnly,faHidden,faSysfile);
AttrChars : Array[1..4] of char =
('A','R','H','S');
Var
i : longint;
begin
Result:='';
For I:=1 to 4 do
If (Attrs[i] and FileAttrs)=Attrs[i] then
Result:=Result+AttrChars[i];
end;
end.

14
docs/gtk4ex/fx.pp Normal file
View File

@ -0,0 +1,14 @@
program fx;
uses glib,gdk,gtk,frmmain,sysutils;
Var
MainWindow : PMainWindow;
begin
gtk_init(@argc,@argv);
MainWindow:=NewMainForm;
gtk_widget_show_all(PGtkWidget(MainWindow^.Window));
ShowDir(mainwindow,Extractfilepath(Paramstr(0)){'/usr/bin/'});
gtk_main;
end.

78
docs/gtk4ex/fxbitmaps.pp Normal file
View File

@ -0,0 +1,78 @@
Unit fxbitmaps;
{$mode objfpc}
Interface
uses glib,gdk,gtk;
Const
DeleteXpmHeight=16;
DeleteXpmColors=2;
DeleteXpmArraySize=DeleteXpmHeight+DeleteXpmColors+1;
DeleteXpm : Array[1..DeleteXpmArraySize] of Pchar = (
'16 16 2 1', { 16x16 bitmap using 2 colors, 1 char per color}
'. c #000000', { First color: Black }
'# c None', { Second color : Transparent}
'################', { The bitmap }
'################',
'##...#########.#',
'##....######..##',
'###....####..###',
'#####...##..####',
'######.....#####',
'#######...######',
'######.....#####',
'#####...##..####',
'####...####..###',
'###...######.###',
'##....#######.##',
'##...###########',
'###.##########.#',
'################'
);
PropertiesXpmHeight = 16;
PropertiesXpmColors = 4;
PropertiesXpmArraySize = PropertiesXpmHeight+PropertiesXpmColors+1;
PropertiesXpm : Array [1..PropertiesXpmArraySize] of PChar = (
'16 16 4 1', { 16x16 bitmap using 2 colors, 1 char per color}
'. c #000000', { First color : Black }
'# c #000080', { Second color : Light Blue }
'a c None', { Third color : Transparent }
'b c #f8fcf8', { Last color : greyish }
'aaaaaaaaaaaaaaaa',
'aaaaaaa......a##',
'aaaaaa.aaaaaa.##',
'aaaaa.a.aaaaaa##',
'.....a.a.aaaaa##',
'.bb.a.a.a.aaa.##',
'.b.a.b.a.a...a##',
'.b..bbb.a.b.aaaa',
'.bbbbbbb.bb.aaaa',
'.bbbbbbbbbb.aaaa',
'.b..b.....b.aaaa',
'.bbbbbbbbbb.aaaa',
'.b..b.....b.aaaa',
'.bbbbbbbbbb.aaaa',
'............aaaa',
'aaaaaaaaaaaaaaaa'
);
function CreateWidgetFromXPM (Window : PGtkWidget; Data : PPChar) : PgtkWidget;
Implementation
function CreateWidgetFromXPM (Window : PGtkWidget; Data : PPChar) : PGtkWidget;
Var
mask : PGdkBitmap;
pixmap : PGdkPixMap;
begin
pixmap:=gdk_pixmap_create_from_xpm_d(window^.window,@mask,nil,ppgchar(Data));
Result:=gtk_pixmap_new(Pixmap,Mask);
gtk_widget_show(Result);
end;
end.

BIN
docs/gtk4ex/mainwin.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 20 KiB

209
docs/gtk4ex/menus.pp Normal file
View File

@ -0,0 +1,209 @@
Unit menus;
{$mode objfpc}
Interface
Uses Gtk,Gdk,Glib;
Function AddMenuToMenuBar (MenuBar : PGtkMenuBar;
ShortCuts : PGtkAccelGroup;
Caption : AnsiString;
CallBack : TgtkSignalFunc;
CallBackdata : Pointer;
AlignRight : Boolean;
Var MenuItem : PgtkMenuItem
) : PGtkMenu;
Function AddItemToMenu (Menu : PGtkMenu;
ShortCuts : PGtkAccelGroup;
Caption : AnsiString;
ShortCut : AnsiString;
CallBack : TgtkSignalFunc;
CallBackdata : Pointer
) : PGtkMenuItem;
Function AddCheckItemToMenu (Menu : PGtkMenu;
ShortCuts : PGtkAccelGroup;
Caption : AnsiString;
ShortCut : AnsiString;
CallBack : TgtkSignalFunc;
CallBackdata : Pointer
) : PGtkCheckMenuItem;
Function AddImageItemToMenu (Menu : PGtkMenu;
ShortCuts : PGtkAccelGroup;
Caption : AnsiString;
ShortCut : AnsiString;
Bitmap : AnsiString;
CallBack : TgtkSignalFunc;
CallBackdata : Pointer
) : PGtkMenuItem;
Function AddSeparatorToMenu(Menu : PgtkMenu) : PgtkMenuItem;
Implementation
Function AddMenuToMenuBar (MenuBar : PGtkMenuBar;
ShortCuts : PGtkAccelGroup;
Caption : AnsiString;
CallBack : TgtkSignalFunc;
CallBackdata : Pointer;
AlignRight : Boolean;
Var MenuItem : PgtkMenuItem
) : PGtkMenu;
Var
Key : guint;
TheLabel : PGtkLabel;
begin
MenuItem:=pgtkmenuitem(gtk_menu_item_new_with_label(''));
If AlignRight Then
gtk_menu_item_right_justify(MenuItem);
TheLabel:=GTK_LABEL(GTK_BIN(MenuItem)^.child);
Key:=gtk_label_parse_uline(TheLabel,Pchar(Caption));
If Key<>0 then
gtk_widget_add_accelerator(PGtkWidget(MenuItem),'activate_item',
Shortcuts,Key,
GDK_MOD1_MASK,GTK_ACCEL_LOCKED);
Result:=PGtkMenu(gtk_menu_new);
If CallBack<>Nil then
gtk_signal_connect(PGtkObject(result),'activate',
CallBack,CallBackdata);
gtk_widget_show(PgtkWidget(MenuItem));
gtk_menu_item_set_submenu(MenuItem, PgtkWidget(Result));
gtk_menu_bar_append(MenuBar,PgtkWidget(MenuItem));
end;
Function AddItemToMenu (Menu : PGtkMenu;
ShortCuts : PGtkAccelGroup;
Caption : AnsiString;
ShortCut : AnsiString;
CallBack : TgtkSignalFunc;
CallBackdata : Pointer
) : PGtkMenuItem;
Var
Key,Modifiers : guint;
LocalAccelGroup : PGtkAccelGroup;
TheLabel : PGtkLabel;
begin
Result:=pgtkmenuitem(gtk_menu_item_new_with_label(''));
TheLabel:=GTK_LABEL(GTK_BIN(Result)^.child);
Key:=gtk_label_parse_uline(TheLabel,Pchar(Caption));
If Key<>0 then
begin
{ $ifndef win32}
LocalAccelGroup:=gtk_menu_ensure_uline_accel_group(Menu);
{ $endif}
gtk_widget_add_accelerator(PGtkWidget(result),'activate_item',
LocalAccelGroup,Key,
0,TGtkAccelFlags(0));
end;
gtk_menu_append(Menu,pgtkWidget(result));
If (ShortCut<>'') and (ShortCuts<>Nil) then
begin
gtk_accelerator_parse (pchar(ShortCut), @key, @modifiers);
gtk_widget_add_accelerator(PGtkWidget(result),'activate_item',
ShortCuts,Key,
modifiers, GTK_ACCEL_VISIBLE);
end;
If CallBack<>Nil then
gtk_signal_connect(PGtkObject(result),'activate',
CallBack,CallBackdata);
gtk_widget_show(PgtkWidget(result));
end;
Function AddCheckItemToMenu (Menu : PGtkMenu;
ShortCuts : PGtkAccelGroup;
Caption : AnsiString;
ShortCut : AnsiString;
CallBack : TgtkSignalFunc;
CallBackdata : Pointer
) : PGtkCheckMenuItem;
Var
Key,Modifiers : guint;
LocalAccelGroup : PGtkAccelGroup;
TheLabel : PGtkLabel;
begin
Result:=pgtkcheckmenuitem(gtk_check_menu_item_new_with_label(PChar(Caption)));
gtk_check_menu_item_set_show_toggle(Result,True);
gtk_menu_append(Menu,pgtkWidget(result));
If (ShortCut<>'') and (ShortCuts<>Nil) then
begin
gtk_accelerator_parse (pchar(ShortCut), @key, @modifiers);
gtk_widget_add_accelerator(PGtkWidget(result),'activate_item',
ShortCuts,Key,
modifiers, GTK_ACCEL_VISIBLE);
end;
If CallBack<>Nil then
gtk_signal_connect(PGtkObject(result),'toggled',
CallBack,CallBackdata);
gtk_widget_show(PgtkWidget(result));
end;
Function AddImageItemToMenu (Menu : PGtkMenu;
ShortCuts : PGtkAccelGroup;
Caption : AnsiString;
ShortCut : AnsiString;
Bitmap : AnsiString;
CallBack : TgtkSignalFunc;
CallBackdata : Pointer
) : PGtkMenuItem;
Var
Key,Modifiers : guint;
LocalAccelGroup : PGtkAccelGroup;
TheLabel : PGtkLabel;
Image : PGtkPixmap;
hbox : PGtkHBox;
pixmap : PGdkPixmap;
BitMapdata : PGdkBitmap;
begin
Result:=pgtkmenuitem(gtk_menu_item_new);
hbox:=PGtkHBox(gtk_hbox_new(false,0));
gtk_container_add(pgtkcontainer(result),pgtkWidget(hbox));
pixmap:=gdk_pixmap_create_from_xpm(Nil,@BitmapData,Nil,pchar(BitMap));
Image := PgtkPixMap(gtk_pixmap_new(Pixmap,BitmapData));
gtk_box_pack_start(PGtkBox(hbox),pgtkWidget(image),false,false,0);
TheLabel:=PgtkLabel(gtk_label_new(''));
gtk_box_pack_start(PGtkBox(hbox),pgtkWidget(TheLabel),True,True,0);
Key:=gtk_label_parse_uline(TheLabel,Pchar(Caption));
If Key<>0 then
begin
{ $ifndef win32}
LocalAccelGroup:=gtk_menu_ensure_uline_accel_group(Menu);
{ $endif}
gtk_widget_add_accelerator(PGtkWidget(result),'activate_item',
LocalAccelGroup,Key,
0,TGtkAccelFlags(0));
end;
gtk_menu_append(Menu,pgtkWidget(result));
If (ShortCut<>'') and (ShortCuts<>Nil) then
begin
gtk_accelerator_parse (pchar(ShortCut), @key, @modifiers);
gtk_widget_add_accelerator(PGtkWidget(result),'activate_item',
ShortCuts,Key,
modifiers, GTK_ACCEL_VISIBLE);
end;
If CallBack<>Nil then
gtk_signal_connect(PGtkObject(result),'activate',
CallBack,CallBackdata);
gtk_widget_show_all(PgtkWidget(result));
end;
Function AddSeparatorToMenu(Menu : PgtkMenu) : PgtkMenuItem;
begin
Result:=pgtkmenuitem(gtk_menu_item_new());
gtk_menu_append(Menu,pgtkWidget(result));
gtk_widget_show(PgtkWidget(result));
end;
end.

27
docs/gtk4ex/properties.xpm Normal file
View File

@ -0,0 +1,27 @@
/* XPM */
static char *properties[] = {
/* width height num_colors chars_per_pixel */
" 16 16 4 1",
/* colors */
". c #000000",
"# c #000080",
"a c #c0c0c0",
"b c #f8fcf8",
/* pixels */
"aaaaaaaaaaaaaaaa",
"aaaaaaa......a##",
"aaaaaa.aaaaaa.##",
"aaaaa.a.aaaaaa##",
".....a.a.aaaaa##",
".bb.a.a.a.aaa.##",
".b.a.b.a.a...a##",
".b..bbb.a.b.aaaa",
".bbbbbbb.bb.aaaa",
".bbbbbbbbbb.aaaa",
".b..b.....b.aaaa",
".bbbbbbbbbb.aaaa",
".b..b.....b.aaaa",
".bbbbbbbbbb.aaaa",
"............aaaa",
"aaaaaaaaaaaaaaaa"
};