PoFGui/Main_Win.ada.0

   1 with gb; use gb;
   2 with gb.OleInterfaces;
   3 with gbOBJECTs; use gbOBJECTs;
   4 with Win32, Win32.WinDef, Win32.WinMain, Win32.WinUser, Win32.WinError, System;
   5 with Win32.WinGDI, Win32.WinBase, Win32.WinNT, Win32.Utils, Interfaces.C;
   6 use  Win32, Win32.WinError, Interfaces.C, System;
   7
   8 with MSComctlLib_Slider; use MSComctlLib_Slider;
   9 package Main_Win is
  10   Form            : aliased gb.MainWindow;
  11   Frm_Ensembles   : aliased gb.Frame;
  12   Rad_Mandel      : aliased gb.RadioButton;
  13   Rad_Julia       : aliased gb.RadioButton;
  14   Txt_Cx          : aliased gb.TextBox(Alignment => Right, AutoScroll => Both,
  15                                        MultiLine => gb.False, Password => gb.False,
  16                                        ReadOnly => gb.False);
  17   Txt_Cy          : aliased gb.TextBox(Alignment => Right, AutoScroll => Both,
  18                                        MultiLine => gb.False, Password => gb.False,
  19                                        ReadOnly => gb.False);
  20   Ch_Antialiasing : aliased gb.CheckBox;
  21   Txt_Iterations  : aliased gb.TextBox(Alignment => Right, AutoScroll => Both,
  22                                        MultiLine => gb.False, Password => gb.False,
  23                                        ReadOnly => gb.False);
  24   But_Redraw      : aliased gb.Button;
  25   Lab_Cx          : aliased gb.Label;
  26   Lab_Cy          : aliased gb.Label;
  27   Pic_Draw        : aliased gb.Picture;
  28   Img_Logo        : aliased gb.Image;
  29   Frm_Iterations  : aliased gb.Frame;
  30   Frm_Part_Droite : aliased gb.Frame;
  31   Frm_Part_Bas    : aliased gb.Frame;
  32   Image2          : aliased gb.Image;
  33   Slid_Iterations       : aliased MSComctlLib_Slider.SliderCtrl(Parent => Frm_Iterations'access);
  34   package Slid_Iterations_Interfaces is new gb.OleInterfaces(Slid_Iterations'access, "Main_Win_Slid_Iterations");
  35   procedure Initialize_Form;
  36 end Main_Win;
  37
  38 with gbOBJECTs; use gbOBJECTs;
  39 with Public;
  40
  41 package body Main_Win is
  42   procedure Rad_Mandel_Click is
  43   begin
  44
  45     if gb.Value(Rad_Mandel) = 1 then
  46        gb.Value(Rad_Julia, 0);
  47        gb.Enabled(Txt_Cx, 0);
  48        gb.Enabled(Txt_Cy, 0);
  49     else
  50        gb.Value(Rad_Julia, 1);
  51        gb.enabled(Txt_Cx, 1);
  52        gb.enabled(Txt_Cy, 1);
  53     end if;
  54
  55   end Rad_Mandel_Click;
  56
  57   procedure Rad_Julia_Click is
  58   begin
  59     if gb.Value(Rad_Julia) = 1 then
  60        gb.Value(Rad_Mandel, 0);
  61        gb.enabled(Txt_Cx, 1);
  62        gb.enabled(Txt_Cy, 1);
  63     else
  64        gb.Value(Rad_Mandel, 1);
  65        gb.enabled(Txt_Cx, 0);
  66        gb.enabled(Txt_Cy, 0);
  67     end if;
  68   end Rad_Julia_Click;
  69
  70   procedure Txt_Iterations_Changed is
  71
  72    Nb_Iterations : gb.Long;
  73    Nb_Iteration_Min : Constant := 10;
  74    Nb_Iteration_Max : Constant := 1000;
  75
  76   begin
  77
  78     Nb_Iterations := gb.Long'value(Text(Txt_Iterations));
  79
  80     if Nb_Iterations >= Nb_Iteration_Min and Nb_Iterations <= Nb_Iteration_Max then
  81
  82       Value(Slid_Iterations, Nb_Iterations);
  83
  84     end if;
  85
  86   end Txt_Iterations_Changed;
  87
  88   procedure But_Redraw_Click is
  89
  90   begin
  91
  92
  93         Line(Image2, 10, 10,  100,  100 ,  Color(122, 122, 122), 0,1);
  94
  95   end But_Redraw_Click;
  96
  97   procedure Slid_Iterations_Scroll is
  98   begin
  99
 100
 101       Text(Txt_Iterations,gb.Long'Image(Value(Slid_Iterations)));
 102
 103
 104   end Slid_Iterations_Scroll;
 105
 106   procedure Form_WindowResized(Flag : gb.INT; Width : gb.INT; Height : gb.INT) is
 107
 108   begin
 109   --gb.Width(Pic_Draw) + gb.Width(Frm_Part_Droite) + 16
 110      if gb.Width(Main_win.Form) < 542  then
 111         gb.Width(Main_win.Form, 542);
 112      end if;
 113
 114      if gb.Height(Main_win.Form) < 369 then
 115         gb.Height(Main_win.Form, 369);
 116      end if;
 117
 118
 119      --redimmensionnement de la zone de dessin
 120      gb.Width(Pic_Draw, gb.width(Main_Win.Form) - gb.Width(Frm_Part_Droite) - 16 );
 121      gb.Height(Pic_Draw, gb.Height(Main_Win.Form) - gb.Height(Frm_Part_Bas) - 35 );
 122
 123      --Deplacement de la frame de droite
 124      gb.Left(Frm_Part_Droite, gb.Width(Main_Win.Form) - gb.Width(Frm_Part_Droite) - 9 );
 125
 126      --Deplacement de la frame du bas
 127      gb.Top(Frm_Part_Bas, gb.Height(Main_Win.Form) - gb.Height(Frm_Part_Bas) - 30);
 128
 129      --Deplacement du logo (en bas a gauche)
 130
 131
 132
 133
 134   end Form_WindowResized;
 135
 136   procedure Initialize_Form is
 137   begin
 138     Caption(Frm_Ensembles, "Ensembles");
 139     Move(Frm_Ensembles, 6, 10, 89, 134);
 140     Parent(Frm_Ensembles, Frm_Part_Droite);
 141
 142     Rad_Mandel.Click := Rad_Mandel_Click'Access;
 143     Caption(Rad_Mandel, "Mandelbrot");
 144     Value(Rad_Mandel, gb.True);
 145     Move(Rad_Mandel, 8, 18, 77, 13);
 146     Parent(Rad_Mandel, Frm_Ensembles);
 147
 148     Rad_Julia.Click := Rad_Julia_Click'Access;
 149     Caption(Rad_Julia, "Julia");
 150     TabStop(Rad_Julia, gb.False);
 151     Move(Rad_Julia, 8, 59, 61, 13);
 152     Parent(Rad_Julia, Frm_Ensembles);
 153
 154     Enabled(Txt_Cx, gb.False);
 155     Text(Txt_Cx, "0");
 156     Move(Txt_Cx, 31, 86, 51, 21);
 157     Parent(Txt_Cx, Frm_Ensembles);
 158
 159     Enabled(Txt_Cy, gb.False);
 160     Text(Txt_Cy, "0");
 161     Move(Txt_Cy, 31, 107, 51, 21);
 162     Parent(Txt_Cy, Frm_Ensembles);
 163
 164     Caption(Ch_Antialiasing, "Antialiasing");
 165     Move(Ch_Antialiasing, 12, 206, 74, 13);
 166     Parent(Ch_Antialiasing, Frm_Part_Droite);
 167
 168     Txt_Iterations.Changed := Txt_Iterations_Changed'Access;
 169     Text(Txt_Iterations, "0");
 170     Move(Txt_Iterations, 3, 30, 84, 19);
 171     Parent(Txt_Iterations, Frm_Iterations);
 172
 173     But_Redraw.Click := But_Redraw_Click'Access;
 174     Caption(But_Redraw, "REDRAW");
 175     Move(But_Redraw, 7, 244, 88, 20);
 176     Parent(But_Redraw, Frm_Part_Droite);
 177
 178     Caption(Lab_Cx, "Cx");
 179     SetFont(Lab_Cx, "MS Sans Serif", 8, gb.False, gb.False, gb.False);
 180     Move(Lab_Cx, 14, 89, 14, 21);
 181     Parent(Lab_Cx, Frm_Ensembles);
 182
 183     Caption(Lab_Cy, "Cy");
 184     SetFont(Lab_Cy, "MS Sans Serif", 8, gb.False, gb.False, gb.False);
 185     Move(Lab_Cy, 14, 109, 16, 21);
 186     Parent(Lab_Cy, Frm_Ensembles);
 187
 188     Cursor(Pic_Draw, gb.CrossCursor);
 189     Move(Pic_Draw, 3, 4, 422, 259);
 190
 191     Border(Img_Logo, gb.False);
 192     Move(Img_Logo, 1, 287, 100, 48);
 193     Parent(Img_Logo, Frm_Part_Droite);
 194
 195     Caption(Frm_Iterations, "Iterations");
 196     Move(Frm_Iterations, 7, 145, 89, 51);
 197     Parent(Frm_Iterations, Frm_Part_Droite);
 198
 199     Caption(Frm_Part_Droite, "");
 200     Move(Frm_Part_Droite, 429, -2, 104, 341);
 201
 202     Caption(Frm_Part_Bas, "");
 203     Move(Frm_Part_Bas, 3, 264, 423, 75);
 204
 205     Move(Image2, 197, 15, 109, 51);
 206     Parent(Image2, Frm_Part_Bas);
 207
 208     Slid_Iterations.Scroll := Slid_Iterations_Scroll'Access;
 209     Move(Slid_Iterations, 2, 14, 84, 14);
 210
 211     Form.WindowResized := Form_WindowResized'Access;
 212     Caption(Form, "Power Fractal 0.1");
 213     MaxButton(Form, gb.False);
 214     Move(Form, 203, 205, 542, 369);
 215     Visible(Form, gb.True);
 216   end Initialize_Form;
 217 begin
 218   Initialize_Form;
 219 end Main_Win;
 220
 221
 222 with gb;
 223 with Main_Win;
 224
 225 procedure PowerFractal is begin
 226   gb.StartApplication;
 227 end PowerFractal;
 228
 229