~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to fpcdocs/gtk5ex/graphics.pp

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
program graphics;
 
2
 
 
3
{$mode objfpc}
 
4
{$h+}
 
5
 
 
6
uses glib,gdk,gtk,sysutils;
 
7
 
 
8
var
 
9
  window,
 
10
  area : PGtkWidget;
 
11
 
 
12
Function close_application( widget : PGtkWidget ;
 
13
                        event : PGdkEvent;
 
14
                        data : gpointer) : boolean; cdecl;
 
15
Begin
 
16
  gtk_main_quit();
 
17
  close_application := false;
 
18
End;
 
19
 
 
20
Function AllocateColor(R,G,B : Integer; Widget : PGtkWidget) : PGdkColor;
 
21
 
 
22
begin
 
23
  Result:=New(PgdkColor);
 
24
  With Result^ do
 
25
    begin
 
26
    Pixel:=0;
 
27
    Red:=R;
 
28
    Blue:=B;
 
29
    Green:=G;
 
30
    end;
 
31
  gdk_colormap_alloc_color(gtk_widget_get_colormap(Widget),Result,true,False);
 
32
end;
 
33
 
 
34
 
 
35
function Exposed(Widget: PGtkWidget;event : PGdkEventExpose; Data : gpointer) : Integer; cdecl;
 
36
 
 
37
Const
 
38
  Triangle : Array[1..4] of TgdkPoint =
 
39
            ((X:10;Y:195),(X:110;Y:195),(X:55;Y:145),(X:10;Y:195));
 
40
  LineStyles : Array[1..5] of TgdkLineStyle =
 
41
          (GDK_LINE_SOLID, GDK_LINE_ON_OFF_DASH, GDK_LINE_DOUBLE_DASH,
 
42
          GDK_LINE_ON_OFF_DASH, GDK_LINE_SOLID);
 
43
  capstyles : Array[1..5] of TgdkCapStyle =
 
44
          (GDK_CAP_ROUND,GDK_CAP_NOT_LAST, GDK_CAP_BUTT,  GDK_CAP_PROJECTING,
 
45
          GDK_CAP_NOT_LAST);
 
46
 
 
47
  FontName : Pchar =
 
48
   '-*-helvetica-bold-r-normal--*-120-*-*-*-*-iso8859-1';
 
49
 
 
50
Var
 
51
  SegTriangle : Array[1..3] of TgdkSegment;
 
52
  Win : pgdkWindow;
 
53
  gc : PgdkGC;
 
54
  i,seg : Integer;
 
55
  font : PgdkFont;
 
56
  Angle1,Angle2 : Longint;
 
57
 
 
58
begin
 
59
  gc:=gdk_gc_new(widget^.Window);
 
60
  Win:=widget^.window;
 
61
  With Event^.area do
 
62
    gdk_window_clear_area (win,x,y,width,height);
 
63
  gdk_gc_set_foreground(gc,allocatecolor(0,0,0,Widget));
 
64
  gdk_draw_rectangle(win,gc,0,5,5,590,390);
 
65
//  gdk_draw_rectangle(win,gc,-1,15,15,570,370);
 
66
  gdk_gc_set_foreground(gc,allocatecolor(0,0,$ffff,Widget));
 
67
  for I:=10 to 50 do
 
68
    gdk_draw_point(win,gc,I*10,100);
 
69
  gdk_gc_set_foreground(gc,allocatecolor($ffff,0,0,Widget));
 
70
  for I:=10 to 50 do
 
71
    begin
 
72
    gdk_gc_set_line_attributes(gc,6,LineStyles[i div 10],CapStyles[i div 10],GDK_JOIN_MITER);
 
73
    gdk_draw_line(win,gc,I*10,20,I*10,90)
 
74
    end;
 
75
  gdk_gc_set_line_attributes(gc,1,GDK_LINE_SOLID,GDK_CAP_BUTT,GDK_JOIN_MITER);
 
76
  gdk_gc_set_foreground(gc,allocatecolor($ffff,0,$ffff,Widget));
 
77
  seg:=(360 div 20) * 64;
 
78
  For I:=1 to 20 do
 
79
    gdk_draw_arc(win,gc,0,220-I*4,200-i*4,8*i,8*i,i*seg,seg*19);
 
80
  For I:=1 to 20 do
 
81
    gdk_draw_arc(win,gc,-1,380-I*4,200-i*4,8*i,8*i,(i-1)*seg,seg);
 
82
  gdk_gc_set_foreground(gc,allocatecolor(0,$ffff,$ffff,Widget));
 
83
  gdk_draw_polygon(win,gc,0,@triangle[1],4);
 
84
  For I:=1 to 4 do
 
85
    Triangle[i].Y:=400-Triangle[i].y;
 
86
  gdk_draw_polygon(win,gc,-1,@triangle[1],4);
 
87
  gdk_gc_set_foreground(gc,allocatecolor(0,$ffff,0,Widget));
 
88
  For I:=1 to 4 do
 
89
    Triangle[i].X:=600-Triangle[i].x;
 
90
  gdk_draw_lines(win,gc,@triangle[1],4);
 
91
  For I:=1 to 3 do
 
92
    begin
 
93
    SegTriangle[i].X1:=Triangle[i].X;
 
94
    SegTriangle[i].Y1:=400-Triangle[i].Y;
 
95
    SegTriangle[i].X2:=Triangle[i+1].X;
 
96
    SegTriangle[i].Y2:=400-Triangle[i+1].Y;
 
97
    end;
 
98
  gdk_draw_segments(win,gc,@segtriangle[1],3);
 
99
  font:=gdk_font_load(FontName);
 
100
  gdk_gc_set_foreground(gc,allocatecolor($ffff,$ffff,0,Widget));
 
101
  For I:=1 to 4 do
 
102
    gdk_draw_string(win,font,gc,I*100,300,Pchar(format('String %d',[i])));
 
103
  result:=0;
 
104
end;
 
105
 
 
106
Begin
 
107
  // Initialize GTK and create the main window
 
108
  gtk_init( @argc, @argv );
 
109
  window := gtk_window_new( GTK_WINDOW_TOPLEVEL );
 
110
  gtk_window_set_policy(PgtkWindow(Window),0,0,1);
 
111
  gtk_signal_connect (GTK_OBJECT (window), 'delete_event',
 
112
          GTK_SIGNAL_FUNC( @close_application ), NIL);
 
113
  gtk_container_set_border_width (GTK_CONTAINER (window), 10);
 
114
  area := gtk_drawing_area_new();
 
115
  gtk_container_add( GTK_CONTAINER(window), Area);
 
116
  gtk_signal_connect (GTK_OBJECT (area),'expose_event',
 
117
                      GTK_SIGNAL_FUNC(@Exposed),Nil);
 
118
  gtk_drawing_area_size (PGTKDRAWINGAREA(area),600,400);
 
119
  gtk_widget_show_all( window );
 
120
  gtk_main();
 
121
end.