pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Added dialogs example

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2012 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
drewski207
2011-09-25 16:37:08 +00:00
parent 0ccec5aa6e
commit e9b9262598
2 changed files with 193 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

78
bindings/gtk3/examples/dialog/dialog.lpi Normal file
View File

@ -0,0 +1,78 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="Gtk3Pkg"/>
</Item1>
</RequiredPackages>
<Units Count="1">
<Unit0>
<Filename Value="dialog.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="dialog"/>
</Unit0>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="10"/>
<Target>
<Filename Value="dialog"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
<CompilerMessages>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

115
bindings/gtk3/examples/dialog/dialog.lpr Normal file
View File

@ -0,0 +1,115 @@
program dialog;
{$mode objfpc}{$H+}
uses
Classes, Math, GLib2, GObject2 ,Gtk3;
procedure show_info(widget: PGtkWidget; window: PGtkWindow); cdecl;
var
dialog: PGtkMessageDialog;
begin
dialog := gtk_message_dialog_new(window,
GTK_DIALOG_DESTROY_WITH_PARENT,
GTK_MESSAGE_INFO,
GTK_BUTTONS_OK,
'Download Completed', ['title']);
dialog^.set_title('Information');
dialog^.run;
dialog^.destroy_;
end;
procedure show_error(widget: PGtkWidget; window: PGtkWindow); cdecl;
var
dialog: PGtkMessageDialog;
begin
dialog := gtk_message_dialog_new(window,
GTK_DIALOG_DESTROY_WITH_PARENT,
GTK_MESSAGE_ERROR,
GTK_BUTTONS_OK,
'Error loading file', []);
dialog^.set_title('Error');
dialog^.run;
dialog^.destroy_;
end;
procedure show_question(widget: PGtkWidget; window: PGtkWindow); cdecl;
var
dialog: PGtkMessageDialog;
begin
dialog := gtk_message_dialog_new(window,
GTK_DIALOG_DESTROY_WITH_PARENT,
GTK_MESSAGE_QUESTION,
GTK_BUTTONS_YES_NO,
'Are you sure to quit?',[]);
dialog^.set_title('Question');
if dialog^.run = GTK_RESPONSE_YES then
window^.destroy_
else
dialog^.destroy_;
end;
procedure show_warning(widget: PGtkWidget; window: PGtkWindow); cdecl;
var
dialog: PGtkMessageDialog;
begin
dialog := gtk_message_dialog_new(window,
GTK_DIALOG_DESTROY_WITH_PARENT,
GTK_MESSAGE_WARNING,
GTK_BUTTONS_OK,
'Unallowed operation', []);
dialog^.set_title('Warning');
dialog^.run;
dialog^.destroy_;
end;
var
window : PgtkWindow;
table: PGtkTable;
info,
warn,
que,
err: PGtkButton;
begin
SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]);
gtk_init(@argc, @argv);
window := TGtkWindow.new(GTK_WINDOW_TOPLEVEL);
window^.set_position(GTK_WIN_POS_CENTER);
window^.set_default_size(260, 150);
window^.set_title('Message dialogs');
table := TGtkTable.new(2, 2, TRUE);
table^.set_row_spacings(2);
table^.set_col_spacings(2);
info := TGtkButton.new_with_label('Info');
warn := TGtkButton.new_with_label('Warning');
que := TGtkButton.new_with_label('Question');
err := TGtkButton.new_with_label('Error');
table^.attach(info, 0, 1, 0, 1, GTK_FILL, GTK_FILL, 3, 3);
table^.attach(warn, 1, 2, 0, 1, GTK_FILL, GTK_FILL, 3, 3);
table^.attach(que, 0, 1, 1, 2, GTK_FILL, GTK_FILL, 3, 3);
table^.attach(err, 1, 2, 1, 2, GTK_FILL, GTK_FILL, 3, 3);
window^.add(PGtkWidget(table));
window^.set_border_width(15);
g_signal_connect_data(info, 'clicked', TGCallback(@show_info), window, nil, 0);
g_signal_connect_data(warn, 'clicked', TGCallback(@show_warning), window, nil, 0);
g_signal_connect_data(que, 'clicked', TGCallback(@show_question), window, nil, 0);
g_signal_connect_data(err, 'clicked', TGCallback(@show_error), window, nil, 0);
g_signal_connect_data(window, 'destroy', TGCallback(@gtk_main_quit), window, nil, G_CONNECT_SWAPPED);
window^.show_all;
gtk_main;
end.