path: root/prototypes/multihandle/gui2Base.pas

{
  Proof of concept one handle per widget GUI.
  Graeme Geldenhuys
}

unit gui2Base;

{$mode objfpc}{$H+}

{$Define DEBUG}

interface

uses
  Classes
  ,fpgfx
  ,GFXBase
  ;

  
type

  TWidgetStyle = set of (
      wsCaptureMouse,
      wsClickable,
      wsOpaque
      );
      
  
  TWidgetState = set of (
      wsEnabled,
      wsIsVisible,
      wsSizeIsForced,
      wsHasFocus,
      wsMouseInside,
      wsClicked
      );
      
  // The following flags are used for styles

  TButtonFlags = set of (
      btnIsEmbedded,
      btnIsDefault,
      btnIsPressed,
      btnIsSelected,
      btnHasFocus
      );


  { TWidget }

  TWidget = class(TFWindow)
  private
    FColor: TGfxColor;
    FOnClick: TNotifyEvent;
    procedure   EvOnMouseReleased(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); virtual;
    procedure   EvOnMousePressed(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); virtual;
    procedure   EvOnMouseLeave(Sender: TObject); virtual;
    procedure   SetColor(const AValue: TGfxColor);
  protected
    FWidgetStyle: TWidgetStyle;
    FWidgetState: TWidgetState;
    procedure   Paint; virtual;
    property    OnClick: TNotifyEvent read FOnClick write FOnClick;
    property    Color: TGfxColor read FColor write SetColor;
  public
    constructor Create(AParent: TFCustomWindow; AWindowOptions: TFWindowOptions); override;
    constructor Create(AParent: TFCustomWindow); overload;
    destructor  Destroy; override;
    procedure   ProcessEvent(AEvent: TFEvent); override;
    procedure   SetFocus;
  end;

  { TForm }
  
  TForm = class(TWidget)
  public
    constructor Create(AParent: TFCustomWindow; AWindowOptions: TFWindowOptions); override;
    constructor Create; virtual; reintroduce;
    property    Color;
  end;

  { TPopupWindow }
  {$Note TPopupWindow is still work in progess. }
  TPopupWindow = class(TForm)
  public
    constructor Create; override;
  end;

  { TButton }

  TButton = class(TWidget)
  private
    FCaption: string;
    procedure   SetCaption(const AValue: string);
  protected
    procedure   Paint; override;
  public
    constructor Create(AParent: TFCustomWindow; APosition: TPoint); overload; reintroduce;
    property    Caption: string read FCaption write SetCaption;
  published
    property    OnClick;
  end;
  
  { TLabel }

  TLabel = class(TWidget)
  private
    FCaption: string;
    procedure   SetCaption(const AValue: string);
  protected
    procedure   Paint; override;
  public
    constructor Create(AParent: TFCustomWindow; APosition: TPoint); overload; reintroduce;
    property    Caption: string read FCaption write SetCaption;
  end;

  { TCustomEdit }

  TCustomEdit = class(TWidget)
  private
    FText: string;
    procedure   SetText(const AValue: string);
  protected
    procedure   Paint; override;
  public
    constructor Create(AParent: TFCustomWindow; APosition: TPoint); overload; reintroduce;
    property    Text: string read FText write SetText;
  end;

  { TEdit }
  
  TEdit = class(TCustomEdit)
  public
    property    Text;
  end;


implementation

const
  clDkWhite: TGfxColor      = (Red: $e000; Green: $e000; Blue: $e000; Alpha: 0);
  cl3DShadow: TGfxColor     = (Red: $8000; Green: $8000; Blue: $8000; Alpha: 0);
  cl3DDkShadow: TGfxColor   = (Red: $0000; Green: $0000; Blue: $0000; Alpha: 0);
  cl3DHighlight: TGfxColor  = (Red: $FF00; Green: $FF00; Blue: $FF00; Alpha: 0);
  cl3DFace: TGfxColor		    = (Red: $c000; Green: $c000; Blue: $c000; Alpha: 0);
  clWindow: TGfxColor       = (Red: $FF00; Green: $FF00; Blue: $FF00; Alpha: 0);
  cl3DLight: TGfxColor      = (Red: $e000; Green: $e000; Blue: $e000; Alpha: 0);


// Helper functions, that will actually be in a style class.

procedure Draw3DFrame(Canvas: TFCanvas; const ARect: TRect; Color1, Color2, Color3, Color4: TGfxColor);
begin
  with ARect do
  begin
    Canvas.SetColor(Color1);
    Canvas.DrawLine(Point(Left, Bottom - 2), TopLeft);
    Canvas.DrawLine(TopLeft, Point(Right - 1, Top));

    Canvas.SetColor(Color2);
    Canvas.DrawLine(Point(Left + 1, Bottom - 3), Point(Left + 1, Top + 1));
    Canvas.DrawLine(Point(Left + 1, Top + 1), Point(Right - 2, Top + 1));

    Canvas.SetColor(Color3);
    Canvas.DrawLine(Point(Left, Bottom - 1), Point(Right - 1, Bottom - 1));
    Canvas.DrawLine(Point(Right - 1, Bottom - 1), Point(Right - 1, Top - 1));

    Canvas.SetColor(Color4);
    Canvas.DrawLine(Point(Left + 1, Bottom - 2), Point(Right - 2, Bottom - 2));
    Canvas.DrawLine(Point(Right - 2, Bottom - 2), Point(Right - 2, Top));
  end;
end;

procedure DrawEditBox(Canvas: TFCanvas; const ARect: TRect);
begin
  Draw3DFrame(Canvas, ARect, cl3DShadow, cl3DDkShadow, cl3DHighlight, cl3DFace);
  Canvas.SetColor(clWindow);
  with ARect do
    Canvas.FillRect(Rect(Left + 2, Top + 2, Right - 2, Bottom - 2));
end;

{ TWidget }

procedure TWidget.EvOnMouseReleased(Sender: TObject; AButton: TMouseButton;
  AShift: TShiftState; const AMousePos: TPoint);
begin
  {$IFDEF DEBUG} Writeln(ClassName + '.EvOnMouseReleased'); {$ENDIF}
  if (wsClickable in FWidgetStyle) and (wsEnabled in FWidgetState) and
    (AButton = mbLeft) then
  begin
    if wsClicked in FWidgetState then
    begin
      Exclude(FWidgetState, wsClicked);
      Exclude(FWidgetState, wsHasFocus);
      Paint;
      if Assigned(OnClick) then
        OnClick(self);
    end;
  end;
end;

procedure TWidget.EvOnMousePressed(Sender: TObject; AButton: TMouseButton;
  AShift: TShiftState; const AMousePos: TPoint);
begin
  {$IFDEF DEBUG} Writeln(ClassName + '.EvOnMousePressed'); {$ENDIF}
  if (wsClickable in FWidgetStyle) and (wsEnabled in FWidgetState) and
    (AButton = mbLeft) then
  begin
    Include(FWidgetState, wsClicked);
    SetFocus;
    Paint;
  end;
end;

procedure TWidget.EvOnMouseLeave(Sender: TObject);
begin
//  Exclude(FWidgetState, wsHasFocus);
end;

procedure TWidget.SetColor(const AValue: TGfxColor);
begin
  if FColor = AValue then exit;
  FColor := AValue;
  Paint;
end;

procedure TWidget.Paint;
var
  r: TRect;
begin
  {$IFDEF DEBUG} Writeln(ClassName + '.Paint'); {$ENDIF}
  Canvas.SetColor(FColor);
  r.Left    := 0;
  r.Top     := 0;
  r.Right   := Width;
  r.Bottom  := Height;
  Canvas.FillRect(r);
end;

constructor TWidget.Create(AParent: TFCustomWindow;
  AWindowOptions: TFWindowOptions);
begin
  inherited Create(AParent, AWindowOptions);

  FWidgetState  := [wsEnabled];
  FColor        := colLtGray;
  Title         := ClassName;
  
  // Assign some event handlers
  OnMouseReleased   := @EvOnMouseReleased;
  OnMousePressed    := @EvOnMousePressed;
  OnMouseLeave      := @EvOnMouseLeave;
end;

constructor TWidget.Create(AParent: TFCustomWindow);
begin
  Create(AParent, [woChildWindow]);
end;

destructor TWidget.Destroy;
begin
  OnMouseReleased   := nil;
  OnMousePressed    := nil;
  inherited Destroy;
end;

procedure TWidget.ProcessEvent(AEvent: TFEvent);
begin
  inherited ProcessEvent(AEvent);
  case AEvent.EventType of
   etPaint:
     begin
       Paint;
     end;
  end;  { case }

end;

procedure TWidget.SetFocus;
begin
  Include(FWidgetState, wsHasFocus);
//  FindForm.FocusedWidget := Self;
end;

{ TForm }

constructor TForm.Create(AParent: TFCustomWindow;
  AWindowOptions: TFWindowOptions);
begin
  inherited Create(AParent, AWindowOptions);
end;

constructor TForm.Create;
begin
  inherited Create(nil, [woWindow]);
end;

{ TButton }

procedure TButton.SetCaption(const AValue: string);
begin
  if FCaption=AValue then exit;
  FCaption:=AValue;
  Paint;
end;

procedure TButton.Paint;
var
  Pt: TPoint;
  lFlags: TButtonFlags;
  r: TRect;
begin
  inherited Paint;
  {$IFDEF DEBUG} Writeln('  - Painting ' + Caption); {$ENDIF}
  lFlags := [];
  r := Rect(0, 0, Width, Height);

  if (wsClicked in FWidgetState) then
    Include(lFlags, btnIsPressed);
  if (wsHasFocus in FWidgetState) {and not Embedded} then
  begin
    Include(lFlags, btnIsSelected);
  end;

  if btnIsSelected in lFlags then
  begin
    Canvas.SetColor(cl3DDkShadow);
    Canvas.DrawRect(r);
    Inc(r.Left);
    Inc(r.Top);
    Dec(r.Right);
    Dec(r.Bottom);
  end;

  if btnIsPressed in lFlags then
  begin
    Canvas.SetColor(cl3DShadow);
    Canvas.DrawRect(r);
    Inc(r.Left);
    Inc(r.Top);
    Dec(r.Right);
    Dec(r.Bottom);
  end
  else
    Draw3DFrame(TFCanvas(Canvas), r, cl3DHighlight, cl3DLight, cl3DDkShadow, cl3DShadow);
  
  Canvas.SetColor(colBlack);
  Pt.x := (Width - Canvas.TextWidth(FCaption)) div 2;
  Pt.y := ((Height - Canvas.FontCellHeight) div 2) + 1;
  if (wsClicked in FWidgetState) {and (wsMouseInside in FWidgetState)} then
    Pt := Pt + Point(1, 1);
  Canvas.TextOut(Pt, FCaption);
end;

constructor TButton.Create(AParent: TFCustomWindow; APosition: TPoint);
begin
  inherited Create(AParent);
  Include(FWidgetStyle, wsClickable);
  SetPosition(APosition);
  SetClientSize(Size(75, 25));
end;

{ TLabel }

procedure TLabel.SetCaption(const AValue: string);
var
  w, h: integer;
begin
  if FCaption=AValue then exit;
  FCaption := AValue;

  w := Canvas.TextWidth(FCaption) + 6;
  h := Canvas.FontCellHeight + 4;
  SetClientSize(Size(w, h));
  Paint;
end;

procedure TLabel.Paint;
begin
//  Color := FParent.Canvas.GetColor;
//  inherited Paint;
  Canvas.SetColor(colWhite);
  Canvas.FillRect(Rect(0,0,Width,Height));
  Canvas.SetColor(colBlack);
  Canvas.TextOut(Point(0, 0), FCaption);
end;

constructor TLabel.Create(AParent: TFCustomWindow; APosition: TPoint);
begin
  inherited Create(AParent);
  SetPosition(APosition);
  SetClientSize(Size(75, 22));
end;

{ TPopupWindow }

constructor TPopupWindow.Create;
begin
//  inherited Create(nil, [woPopup]);
  inherited Create(nil, [woWindow]);
end;

{ TCustomEdit }

procedure TCustomEdit.SetText(const AValue: string);
var
  w: integer;
begin
  if FText=AValue then exit;
  FText:=AValue;
  w := Canvas.TextWidth(FText) + 6;
  SetClientSize(Size(w, Height));
  Paint;
end;

procedure TCustomEdit.Paint;
begin
  inherited Paint;
  DrawEditBox(TFCanvas(Canvas), Rect(0, 0, Width, Height));
  Canvas.SetColor(colBlack);
  if FText <> '' then
    Canvas.TextOut(Point(2, 2), FText);
end;

constructor TCustomEdit.Create(AParent: TFCustomWindow; APosition: TPoint);
begin
  inherited Create(AParent);
//  OnMouseEntered := @EvMouseEntered
  SetPosition(APosition);
  SetClientSize(Size(100, 25));
end;

end.