Listing 1. Compiled Sample Program
{
Temperature.pas - allow the user to enter temperatures and convert
them between Fahrenheit and Celsius
}
program temperature;
{$mode objfpc} // use Delphi 2 extensions
uses
glib, gdk, gtk, sysutils;
{ Define a record type to represent our app's window and controls. This
makes it easier to mainpulate it w/o using global variables. }
Type
TMainWindow = Record
Window : pGtkWindow; // top-level window
hBox, // main container for controls
fahBox, // holds Fahrenheit label and text box
celBox, // holds Celsius label and text box
celButton, // C to F button
fahButton, // F to C button
celEntry, // Celsius text box
fahEntry, // Fahrenheit text box
celSlider, // Celsius slider
fahSlider, // Fahrenheit slider
celLabel, // label in Celsius box
fahLabel : pGtkWidget; // label in Fahrenheit box
celAdjust, // range for Celsius slider
fahAdjust : pGtkObject; // range for Fahrenheit slider
end;
PMainWindow = ^TMainWindow;
procedure quit_app (widget: pGtkWidget; Window: PMainWindow); cdecl;
{ Clean up and shut down GTK+ signal handling. }
begin
dispose(Window);
gtk_main_quit;
end; // procedure quit_app
procedure scale_set_default_values( scale : pGtkScale);
{ Set default values for specified GtkScale widget. }
begin
gtk_range_set_update_policy (GTK_RANGE (scale),
GTK_UPDATE_CONTINUOUS);
gtk_scale_set_digits (scale, 1);
gtk_scale_set_value_pos (scale, GTK_POS_BOTTOM);
gtk_scale_set_draw_value (scale, TRUE);
end; // procedure scale_set_default_values
function FtoC(tempF: float):float;
{ Convert temp in Fahrenheit to Celsius. }
begin
Result := (tempF - 32) * (5/9);
end; // function FtoC
function CtoF(tempC: float): float;
{ Convert temp in Celsius to Fahrenheit. }
begin
Result := (tempC * (9/5) + 32);
end; // function CtoF
procedure SetSliderValue ( slider : pGtkAdjustment; value : float);
{ Position the specified GtkAdjustment widget to the value. }
begin
if (value < 0.0) and (value > 100.0) then
value := 0.0;
gtk_adjustment_set_value(slider, value);
end; // procedure SetSliderValue
procedure DisplayTemp( temperature : float; entry : pGtkEntry);
{ Put the temperature in the specified text box. }
begin
gtk_entry_set_text(entry, pchar(Format('%.1f', [temperature])));
end; // procedure DisplayTemp
procedure buttonCtoF(widget: pGtkWidget; Window: PMainWindow); cdecl;
{ C to F button signal handler. Get Cel temp, convert it and display new
Fah temp. }
var
textValue: pgchar;
tempC,
tempF: float;
begin
textValue := gtk_entry_get_text(pGtkEntry(Window^.celEntry));
if textValue <>'' then
begin
// Wrap StrToFloat in a try-except-end block in case letters were
// typed into the text box.
try
tempC := StrToFloat(textValue);
except
on E:EConvertError do
tempC := 0.0;
end; // try-except
tempF := CtoF(tempC);
DisplayTemp(tempF, pGtkEntry(Window^.fahEntry));
SetSliderValue(pGtkAdjustment(Window^.fahAdjust), tempF);
end; // procedure buttonCtoF
end;
procedure buttonFtoC(widget: pGtkWidget; Window: PMainWindow); cdecl;
{ F to C button signal handler. Get Fah temp, convert it and display new
Cel temp. }
var
textValue: pgchar;
tempC,
tempF: float;
begin
textValue := gtk_entry_get_text(pGtkEntry(Window^.fahEntry));
if textValue <>'' then
begin
// Wrap StrToFloat in a try-except-end block in case letters were
// typed into the text box.
try
tempF := StrToFloat(textValue);
except
on E:EConvertError do
tempF := 0.0;
end; // try-except
tempC := FtoC(tempF);
DisplayTemp(tempC, pGtkEntry(Window^.celEntry));
SetSliderValue(pGtkAdjustment(Window^.celAdjust), tempC);
end; // if textValue <> ''
end; // procedure buttonFtoC
procedure FsliderChanged( widget : pGtkWidget; Window : PMainWindow); cdecl;
{ Fahrenheit slider has moved, display new value. }
begin
DisplayTemp(pGtkAdjustment(Window^.fahAdjust)^.value,
pGtkEntry(Window^.fahEntry));
end; // procedure FsliderChanged
procedure CsliderChanged( widget : pGtkWidget; Window : PMainWindow); cdecl;
{ Celsius slider has moved, display new value. }
begin
DisplayTemp(pGtkAdjustment(Window^.celAdjust)^.value,
pGtkEntry(Window^.celEntry));
end; // procedure CsliderChanged
function create_main_window : PMainWindow;
{ Create an instance of the main window and all its controls. }
begin
Result := New(PMainWindow);
with Result^ do
begin
Window := pGtkWindow(gtk_window_new(GTK_WINDOW_TOPLEVEL));
gtk_window_set_title(Window, 'Temperature Conversion');
gtk_signal_connect(pGtkObject(Window), 'destroy',
GTK_SIGNAL_FUNC (@quit_app), Result);
hBox := gtk_hbox_new(false, 10);
gtk_container_add(GTK_CONTAINER(Window), hBox);
// Create vertical sliders whose ranges are controlled by a
// gtk_adjustment widget, set signal handlers, and add them
// to the application's window.
fahAdjust := gtk_adjustment_new(0.0, 0.0, 101.0, 0.5, 10.0, 1.0);
fahSlider := gtk_vscale_new(GTK_ADJUSTMENT(fahAdjust));
scale_set_default_values(GTK_SCALE(fahSlider));
gtk_signal_connect(GTK_OBJECT(fahAdjust), 'value_changed',
GTK_SIGNAL_FUNC(@FsliderChanged), Result);
gtk_box_pack_start(pGtkBox(hBox), pGtkWidget(fahSlider),
False, False, 0);
// Create a vertical box to hold the Fahrenheit label and text box.
fahBox := gtk_vbox_new(false, 10);
gtk_container_add(GTK_CONTAINER(hBox), fahBox);
fahLabel := gtk_label_new('Fahrenheit');
gtk_box_pack_start(pGtkBox(fahBox), pGtkWidget(fahLabel),
False, False, 0);
fahEntry := gtk_entry_new();
gtk_box_pack_start(pGtkBox(fahBox), pGtkWidget(fahEntry),
False, False, 0);
fahButton := gtk_button_new_with_label('--F to C-->');
gtk_signal_connect(pGtkObject(fahButton), 'clicked',
GTK_SIGNAL_FUNC(@buttonFtoC), Result);
gtk_box_pack_start(pGtkBox(fahBox), pGtkWidget(fahButton),
False, False, 5);
// Create a vertical box to hold the Celsius label and text box.
celBox := gtk_vbox_new(False, 10);
gtk_container_add(GTK_CONTAINER(hBox), celBox);
celLabel := gtk_label_new('Celsius');
celEntry := gtk_entry_new();
gtk_box_pack_start(pGtkBox(celBox), pGtkWidget(celLabel),
False, False, 0);
gtk_box_pack_start(pGtkBox(celBox), pGtkWidget(celEntry),
False, False, 0);
celButton := gtk_button_new_with_label('<--C to F--');
gtk_signal_connect(pGtkObject(celButton), 'clicked',
GTK_SIGNAL_FUNC(@buttonCtoF), Result);
gtk_box_pack_start(pGtkBox(celBox), pGtkWidget(celButton),
False, False, 5);
// Finally add the Celsius slider to the application window.
celAdjust := gtk_adjustment_new(0.0, 0.0, 101.0, 0.5, 10.0, 1.0);
celSlider := gtk_vscale_new(GTK_ADJUSTMENT(celAdjust));
scale_set_default_values(GTK_SCALE(celSlider));
gtk_signal_connect(GTK_OBJECT(celAdjust), 'value_changed',
GTK_SIGNAL_FUNC(@CsliderChanged), Result);
gtk_box_pack_start(pGtkBox(hBox), pGtkWidget(celSlider),
False, False, 0);
end; // with Result^
end; // function create_main_window
var
MainWindow : PMainWindow;
begin
// Initialize the GTK+ libraries.
gtk_init(@argc, @argv);
// Create and show the application's window.
MainWindow:=create_main_window;
gtk_widget_show_all(PGtkWidget(MainWindow^.Window));
// Start handling signals.
gtk_main();
end.