path: root/fpcdocs/gtk2ex/digit.pp

unit digit;

{$mode objfpc}
{$H+}

Interface

uses gtk,gdk,glib;

Type
  TPoint = Record
    X,Y : gint;
    end;

  PGtkDigit = ^TGtkDigit;
  TGtkDigit = Record
    ParentWidget : TGtkWidget;
    borderwidth,
    digit : guint;
    Corners : Array [1..6] of TPoint;
  end;

  PGtkDigitClass = ^TGtkDigitClass;
  TGtkDigitClass = Record
    Parent_Class : TGtkWidgetClass;
  end;

Function  GtkDigit_get_type : Guint;cdecl;
Function  GtkDigit_new : PGtkWidget;cdecl;
Procedure GtkDigit_set_digit (Obj : PGtkDigit; Digit : guint);cdecl;
Function  GtkDigit_get_digit (Obj : PGtkDigit) : guint;cdecl;

Type
  PGtkActiveDigit = ^TGtkActiveDigit;
  TGtkActiveDigit = Record
    ParentWidget : TGtkDigit;
    Button : guint8;
  end;

  PGtkActiveDigitClass = ^TGtkActiveDigitClass;
  TGtkActiveDigitClass = Record
    Parent_Class : TGtkDigitClass;
  end;

Function  GtkActiveDigit_get_type : Guint;cdecl;
Function  GtkActiveDigit_new : PGtkWidget;cdecl;

Implementation

Type
  TLEDSegment = (lsTop,lsCenter,lsBottom,
                 lsLeftTop,lsRightTop,
                 lsLeftBottom, lsRightBottom);
  TLedSegments = Array[TLedSegment] of boolean;
  TSegmentCorners = Array [1..2] of Byte;

Const
  DigitSegments : Array[0..9] of TLEDSegments =
    (
     (true,false,true,true,true,true,true),       // 0
     (false,false,false,false,true,false,true),   // 1
     (true,true,true,false,true,true,false),      // 2
     (true,true,true,false,true,false,true),      // 3
     (false,true,false,true,true,false,true),     // 4
     (true,true,true,true,false,false,true),      // 5
     (true,true,true,true,false,true,true),       // 6
     (true,false,false,false,true,false,true),    // 7
     (true,true,true,true,true,true,true),        // 8
     (true,true,true,true,true,false,true)        // 9
    );

  SegmentCorners : Array [TLEDSegment] of TSegmentCorners =
    (
     (1,2),
     (3,4),
     (5,6),
     (1,3),
     (2,4),
     (3,5),
     (4,6)
    );

Const
  GtkDigitType : guint = 0;

Procedure GTKDigitSizeRequest (Widget : PGtkWidget;
                               Request : PGtkRequisition);cdecl;

Var BW : guint;

begin
  With PGTKDigit(Widget)^ do
    BW:=BorderWidth;
  With Request^ do
    begin
    Width:=20+2*BW;
    Height:=40+2*BW;
    end;
end;

Function GTKDigitExpose (Widget : PGTKWidget;
                         ExposeEvent : PGDKEventExpose) : gint;cdecl;


Var
  Segment : TLedSegment;

begin
  With PGTKDigit(Widget)^ do
    For Segment:=lsTop to lsRightBottom do
      if DigitSegments[Digit][Segment] then
        gdk_draw_line(widget^.window,
                  PgtkStyle(widget^.thestyle)^.fg_gc[widget^.state],
                  Corners[SegmentCorners[Segment][1]].X,
                  Corners[SegmentCorners[Segment][1]].Y,
                  Corners[SegmentCorners[Segment][2]].X,
                  Corners[SegmentCorners[Segment][2]].Y
                  )
      else
        gdk_draw_line(widget^.window,
                  PgtkStyle(widget^.thestyle)^.bg_gc[widget^.state],
                  Corners[SegmentCorners[Segment][1]].X,
                  Corners[SegmentCorners[Segment][1]].Y,
                  Corners[SegmentCorners[Segment][2]].X,
                  Corners[SegmentCorners[Segment][2]].Y
                  );

end;

Procedure SetDigitCorners(Digit : PGtkDigit; IgnoreOffset : Boolean);

Var
  BW : guint;
  W,H,SX,SY : gint;
  i : longint;
  Widget : PGTKWidget;

begin
  Widget:=PGTKWidget(Digit);
  BW:=Digit^.Borderwidth;
  If IgnoreOffset then
    begin
    SX:=0;
    SY:=0;
    end
  else
    begin
    SX:=Widget^.Allocation.x;
    SY:=Widget^.Allocation.y;
    end;
  W:=Widget^.Allocation.Width-2*BW;
  H:=(Widget^.Allocation.Height-2*BW) div 2;
  With PGTKDigit(Widget)^ do
    For I:=1 to 6 do
      begin
      // Set X
      Case I of
        1,3,5 : Corners[i].X:=SX+BW;
        2,4,6 : Corners[i].X:=SX+BW+W;
      end;
      // Set Y
      Case I of
        1,2 : Corners[i].Y:=SY+BW;
        3,4 : Corners[i].Y:=SY+BW+H;
        5,6 : Corners[i].Y:=SY+BW+2*H
      end;
      end;
end;

procedure GTKDigitSizeAllocate(Widget : PGTKWidget;
                               Allocation : PGTKAllocation);cdecl;

begin
  Widget^.Allocation:=Allocation^;
  SetDigitCorners(PGtkDigit(Widget),False);
end;

Procedure GtkDigitClassInit (CObj : PGtkDigitClass);cdecl;

begin
  With PGtkWidgetClass(Cobj)^ do
    begin
    size_request:=@GTKDigitSizeRequest;
    expose_event:=@GTKDigitExpose;
    size_allocate:=@GTKDigitSizeAllocate;
    end;
end;


Procedure GtkDigitInit (Obj : PGtkDigit);cdecl;

Var I : longint;

begin
  gtk_widget_set_flags(pgtkWidget(obj),GTK_NO_WINDOW);
  With Obj^ do
    begin
    Digit:=0;
    BorderWidth:=2;
    For I:=1 to 6 do
    with Corners[i] do
      begin
      X:=0;
      Y:=0;
      end;
    end;
end;

Function GtkDigit_get_type : Guint;cdecl;

Const
  GtkDigitInfo : TGtkTypeInfo =
    (type_name : 'GtkDigit';
     object_size : SizeOf(TGtkDigit);
     class_size : SizeOf(TGtkDigitClass);
     class_init_func : TGtkClassInitFunc(@GtkDigitClassInit);
     object_init_func : TGtkObjectInitFunc(@GtkDigitInit);
     reserved_1 : Nil;
     reserved_2 : Nil;
     base_class_init_func : Nil
    );

begin
  if (GtkDigitType=0) then
    GtkDigitType:=gtk_type_unique(gtk_widget_get_type,@GtkDigitInfo);
  Result:=GtkDigitType;
end;

Function GtkDigit_new : PGtkWidget;cdecl;

begin
  Result:=gtk_type_new(GtkDigit_get_type)
end;

Procedure GtkDigit_set_digit (Obj : PGtkDigit; Digit : guint);cdecl;

begin
  if Digit in [0..9] then
    begin
    Obj^.Digit:=Digit;
    gtk_widget_draw(PGTKWidget(Obj),Nil);
    end;
end;

Function GtkDigit_get_digit (Obj : PGtkDigit) : guint;cdecl;

begin
  Result:=Obj^.Digit;
end;

{ ---------------------------------------------------------------------
    GTKActiveDigit
  ---------------------------------------------------------------------}

Procedure GtkActiveDigitRealize(widget : PgtkWidget);cdecl;

Var
 attr : TGDKWindowAttr;
 Mask : gint;

begin
  GTK_WIDGET_SET_FLAGS(widget,GTK_REALIZED);
  With Attr do
    begin
    x := widget^.allocation.x;
    y := widget^.allocation.y;
    width:=widget^.allocation.width;
    height:=widget^.allocation.height;
    wclass:=GDK_INPUT_OUTPUT;
    window_type:=gdk_window_child;
    event_mask:=gtk_widget_get_events(widget) or GDK_EXPOSURE_MASK or
                GDK_BUTTON_PRESS_MASK OR GDK_BUTTON_RELEASE_MASK;
    visual:=gtk_widget_get_visual(widget);
    colormap:=gtk_widget_get_colormap(widget);
    end;
  Mask:=GDK_WA_X or GDK_WA_Y or GDK_WA_VISUAL or GDK_WA_COLORMAP;
  widget^.Window:=gdk_window_new(widget^.parent^.window,@attr,mask);
  widget^.thestyle:=gtk_style_attach(widget^.thestyle,widget^.window);
  gdk_window_set_user_data(widget^.window,widget);
  gtk_style_set_background(widget^.thestyle,widget^.window,GTK_STATE_ACTIVE);
end;

procedure GTKActiveDigitSizeAllocate(Widget : PGTKWidget;
                               Allocation : PGTKAllocation);cdecl;
begin
  Widget^.allocation:=Allocation^;
  if GTK_WIDGET_REALIZED(widget) then
    gdk_window_move_resize(widget^.window,
                           Allocation^.x,
                           Allocation^.y,
                           Allocation^.width,
                           Allocation^.height);
  SetDigitCorners(PGTKDigit(Widget),True);
end;

Function GtkActiveDigitButtonPress(Widget: PGtKWidget;
                                    Event : PGdkEventButton) : gint;cdecl;

begin
  PGTKActiveDigit(Widget)^.Button:=Event^.Button;
end;

Function GtkActiveDigitButtonRelease(Widget: PGtKWidget;
                                      Event : PGdkEventButton) : gint;cdecl;

Var
  Digit : PGtkDigit;
  D : guint;

begin
  Digit:=PGTKDigit(Widget);
  D:=gtkdigit_get_digit(Digit);
  If PGTKActiveDigit(Digit)^.Button=Event^.Button then
    begin
    If Event^.Button=1 then
      GTKDigit_set_digit(Digit,D+1)
    else if Event^.Button=3 then
      GTKDigit_set_digit(Digit,D-1)
    else
      GTKDigit_set_digit(Digit,0);
    end;
  PGTKActiveDigit(Digit)^.Button:=0;
end;

Procedure GtkActiveDigitClassInit (CObj : PGtkActiveDigitClass);cdecl;

begin
  With PGtkWidgetClass(Cobj)^ do
    begin
    realize := @GtkActiveDigitRealize;
    size_allocate := @GtkActiveDigitSizeAllocate;
    button_press_event:=@GtkActiveDigitButtonPress;
    button_release_event:=@GtkActiveDigitButtonRelease;
    end;
end;


Procedure GtkActiveDigitInit (Obj : PGtkActiveDigit);cdecl;

Var I : longint;

begin
  gtk_widget_unset_flags(pgtkWidget(obj),GTK_NO_WINDOW);
  With Obj^ do
    Button:=0;
end;

Const
  GtkActiveDigitType : guint = 0;

Function  GtkActiveDigit_get_type : Guint;cdecl;

Const
  GtkActiveDigitInfo : TGtkTypeInfo =
    (type_name : 'GtkActiveDigit';
     object_size : SizeOf(TGtkActiveDigit);
     class_size : SizeOf(TGtkActiveDigitClass);
     class_init_func : TGtkClassInitFunc(@GtkActiveDigitClassInit);
     object_init_func : TGtkObjectInitFunc(@GtkActiveDigitInit);
     reserved_1 : Nil;
     reserved_2 : Nil;
     base_class_init_func : Nil
    );

begin
  if (GtkActiveDigitType=0) then
    GtkActiveDigitType:=gtk_type_unique(gtkdigit_get_type,@GtkActiveDigitInfo);
  Result:=GtkActiveDigitType;
end;


Function  GtkActiveDigit_new : PGtkWidget;cdecl;

begin
  Result:=gtk_type_new(GtkActiveDigit_get_type)
end;

end.