pythianproject-cvsmail

[Michael H. <mh...@us...>]

Update of /cvsroot/pythianproject/Prototypes/GUISystem
In directory slayer.i.sourceforge.net:/tmp/cvs-serv836/GUISystem

Modified Files:
	StartupForm.pas skin1.png vglClasses.pas 
Log Message:
GUI system update :
now has mouse cursor
fixed clipping/window size bug
clipping test
  -mike

Index: StartupForm.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/StartupForm.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** StartupForm.pas	2000/12/09 19:52:04	1.2
--- StartupForm.pas	2000/12/09 22:13:38	1.3
***************
*** 3,6 ****
--- 3,8 ----
  interface
  
+ { bug: Doesn't work in fullscreen mode - probably because of fault in GLForms }
+ 
  uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
***************
*** 18,21 ****
--- 20,25 ----
      Button :TvglButton;
      Panel1:TvglPanel;
+ 
+     ClipTestP1,ClipTestP2,ClipTestP3,ClipTestP4 :TvglPanel;
    public
      { Public declarations }
***************
*** 33,36 ****
--- 37,42 ----
      procedure Panel1OnMouseExit(Sender:TObject);
      procedure ButtonOnclick(Sender:TObject);
+ 
+     procedure go;
    end;
  
***************
*** 48,102 ****
  procedure TfrmStartup.GoButtonClick(Sender: TObject);
  begin
!   GLForm := TGLForm.Create;
!   GLForm.FullScreen := false;
!   GLForm.SetBounds(0,0,640,480);
!   GLForm.Caption := 'VGL Demo 1';
!   GLForm.OnPaint := GLFormPaint;
!   GLForm.OnKeyPress := GLKeypress;
!   GLForm.OnMouseButton := GLMousebutton;
!   GLForm.OnMouseMove := GLMouseMove;
! 
!   // run the program
!   GLForm.Open;
! 
!   FontsDirectory := '..\GLCanvas\';
!   GLC := TGLCanvas.Create(634,455); // must take into account window borders
!   Wallpaper := TGLBitmap.Create;
!   Wallpaper.LoadFromBitmap('..\GLCanvas\scene.png');
! 
!   InterfaceManager := TvglInterfaceManager.Create(Rect(0,0,634,455));
! 
!   // create test components
!   Panel1 := TvglPanel.Create('Panel1',InterfaceManager.Desktop);
!   Panel1.Bounds := Rect(50,50,250,250);
!   Panel1.Textured := true;
!   Panel1.OnMouseDown := Panel1OnMouseDown;
!   Panel1.OnMouseEntry := Panel1OnMouseEntry;
!   Panel1.OnMouseExit := Panel1OnMouseExit;
! 
!   c := TvglPanel.Create('Panel2',Panel1);
!   TvglPanel(c).Color := clYellow;
!   TvglPanel(c).Textured := false;
!   c.Top := 0; c.Left := 30;  // this shows a panel being clipped to its owner
!   c.Width := 50; c.Height := 50;
! 
!   Image1 := TvglImage.Create('Image1',InterfaceManager.Desktop);
!   Image1.LoadImage('olog.png');
!   Image1.Bounds := Rect(500,20,0,0);
! 
!   Button := TvglButton.Create('Button',Panel1);
!   Button.Caption := 'hide image';
!   Button.Bounds := Rect(10,60,0,0);
!   Button.OnClick := ButtonOnClick;
! 
!   Hide;
!   GLForm.Run;
! 
!   // clear up
!   GLForm.Close;
!   GLForm.Free;
!   InterfaceManager.Free;
! 
!   Close;
  end;
  
--- 54,58 ----
  procedure TfrmStartup.GoButtonClick(Sender: TObject);
  begin
!   Go;
  end;
  
***************
*** 154,157 ****
--- 110,189 ----
    if Image1.Visible then
      Button.Caption := 'hide image' else Button.Caption := 'show image'; 
+ end;
+ 
+ procedure TfrmStartup.go;
+ begin
+   GLForm := TGLForm.Create;
+   GLForm.FullScreen := false;
+   //GLForm.SetBounds(0,0,800,600);
+   GLForm.SetBounds(0,0,640,480);
+   GLForm.Caption := 'VGL Demo 1';
+   GLForm.OnPaint := GLFormPaint;
+   GLForm.OnKeyPress := GLKeypress;
+   GLForm.OnMouseButton := GLMousebutton;
+   GLForm.OnMouseMove := GLMouseMove;
+ 
+   // run the program
+   GLForm.Open;
+ 
+   FontsDirectory := '..\GLCanvas\';
+   if not GLForm.FullScreen then
+     GLC := TGLCanvas.Create(GLForm.Width-6,GLForm.Height-25) // must take into account window borders
+   else GLC := TGLCanvas.Create(638,480);
+   Wallpaper := TGLBitmap.Create;
+   Wallpaper.LoadFromBitmap('..\GLCanvas\scene.png');
+ 
+   //##InterfaceManager := TvglInterfaceManager.Create(Rect(0,0,634,455));
+   InterfaceManager := TvglInterfaceManager.Create(GLC);
+ 
+   // create test components
+   Panel1 := TvglPanel.Create('Panel1',InterfaceManager.Desktop);
+   Panel1.Bounds := Rect(50,50,250,250);
+   Panel1.Textured := true;
+   Panel1.OnMouseDown := Panel1OnMouseDown;
+   Panel1.OnMouseEntry := Panel1OnMouseEntry;
+   Panel1.OnMouseExit := Panel1OnMouseExit;
+ 
+   c := TvglPanel.Create('Panel2',Panel1);
+   TvglPanel(c).Color := clYellow;
+   TvglPanel(c).Textured := false;
+   c.Top := 0; c.Left := 30;  // this shows a panel being clipped to its owner
+   c.Width := 50; c.Height := 50;
+ 
+   Image1 := TvglImage.Create('Image1',InterfaceManager.Desktop);
+   Image1.LoadImage('olog.png');
+   Image1.Bounds := Rect(500,20,0,0);
+ 
+   Button := TvglButton.Create('Button',Panel1);
+   Button.Caption := 'hide image';
+   Button.Bounds := Rect(10,60,0,0);
+   Button.OnClick := ButtonOnClick;
+ 
+   // now for clipping test panels
+   ClipTestP1 := TvglPanel.Create('ClipTest1',InterfaceManager.Desktop);
+   ClipTestp1.Color := clRed;
+   ClipTestp1.Bounds := Rect(270,290,580,450);
+   ClipTestP4 := TvglPanel.Create('ClipTest4',ClipTestP1);
+   ClipTestP4.Textured := true;
+   ClipTestP4.Bounds := Rect(80,80,150,150);
+   ClipTestP2 := TvglPanel.Create('ClipTest2',ClipTestP1);
+   ClipTestP2.Color := clBlue;
+   ClipTestP2.Bounds := Rect(10,10,100,100);
+   ClipTestP3 := TvglPanel.Create('ClipTest3',ClipTestP2);
+   ClipTestP3.Color := clGreen;
+   ClipTestP3.Bounds := Rect(-60,-60,60,60);
+ 
+ 
+   Hide;
+   ShowCursor(false);
+   GLForm.Run;
+   ShowCursor(true);
+ 
+   // clear up
+   GLForm.Close;
+   GLForm.Free;
+   InterfaceManager.Free;
+ 
+   Close;
  end;
  

Index: skin1.png
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/skin1.png,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
Binary files /tmp/cvsOiSEKO and /tmp/cvsqMB82s differ

Index: vglClasses.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/vglClasses.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** vglClasses.pas	2000/12/09 19:52:04	1.2
--- vglClasses.pas	2000/12/09 22:13:38	1.3
***************
*** 77,80 ****
--- 77,81 ----
    VGL_SKINRECT_BACKGROUND :TRect = (Left:0;Top:48;Right:131;Bottom:172);
    VGL_SKINRECT_BUTTON :TRect = (Left:0;Top:0;Right:150;Bottom:45);
+   VGL_SKINRECT_MOUSECURSOR :TRect = (Left:0;Top:172;Right:32;Bottom:204);
  
  type
***************
*** 101,112 ****
    TVGLMouseButtonEvent = procedure(mb,x,y:integer) of object;
    TVGLMouseMoveEvent = procedure(x,y:integer) of object;
  
    // an abstract class from which other components are derived
    TvglComponent = class(TvglBase)
    private
!     function GetLeft: integer;
!     function GetTop: integer;
!     procedure SetLeft(const Value: integer);
!     procedure SetTop(const Value: integer);
    protected
      FAcceptsChildren :boolean;
--- 102,111 ----
    TVGLMouseButtonEvent = procedure(mb,x,y:integer) of object;
    TVGLMouseMoveEvent = procedure(x,y:integer) of object;
+   TVGLChildEvent = procedure(Child:TvglComponent) of object;
  
    // an abstract class from which other components are derived
    TvglComponent = class(TvglBase)
    private
!     procedure SetOwner(const Value: TvglComponent);
    protected
      FAcceptsChildren :boolean;
***************
*** 124,127 ****
--- 123,127 ----
      FOnMouseMove :TVGLMouseMoveEvent;
      FOnMouseEntry,FOnMouseExit,FOnMouseClick :TNotifyEvent;
+     FOnChildAdd:TVGLChildEvent;
      FVisible :boolean;
  
***************
*** 137,140 ****
--- 137,144 ----
      function GetHeight: integer; virtual ;
      procedure SetHeight(const Value: integer); virtual ;
+     function GetLeft: integer;
+     function GetTop: integer;
+     procedure SetLeft(const Value: integer);
+     procedure SetTop(const Value: integer);
      function GetClientBounds: TRect; virtual ;
      function GetComponentType:string; virtual ; abstract ;
***************
*** 148,152 ****
      procedure DoOnMouseClick(x,y:integer); virtual ;
    public
!     property Owner :TvglComponent read FOwner;
      property Canvas :TGLCanvas read FCanvas write FCanvas;
      property Manager :TvglInterfaceManager read FManager write FManager;
--- 152,156 ----
      procedure DoOnMouseClick(x,y:integer); virtual ;
    public
!     property Owner :TvglComponent read FOwner write SetOwner;
      property Canvas :TGLCanvas read FCanvas write FCanvas;
      property Manager :TvglInterfaceManager read FManager write FManager;
***************
*** 189,192 ****
--- 193,197 ----
      property OnMouseExit :TNotifyEvent read FOnMouseExit write FOnMouseExit;
      property OnClick :TNotifyEvent read FOnMouseClick write FOnMouseClick;
+     property OnChildAdd :TVGLChildEvent read FOnChildAdd write FOnChildAdd;
    end;
  
***************
*** 262,265 ****
--- 267,280 ----
    end;
  
+   TvglMouseCursor = class(TvglComponent)
+   protected
+     FImage :TGLBitmap;
+     function GetComponentType:string; override ;
+   public
+     constructor Create(aName:string; aOwner:TvglComponent);
+ 
+     procedure DrawSelf(where:TRect); override ;
+   end;
+ 
    { ********************************************************************** }
    {    Interface Manager                                                   }
***************
*** 277,280 ****
--- 292,296 ----
      FCanvas: TGLCanvas;
      FResources :TStringList;
+     FMouseCursor :TvglMouseCursor;
  
      // these are used to generate onMouseEntry, onMouseExit events
***************
*** 292,296 ****
      property Desktop :TvglDesktop read FDesktop; // the root component the VGL uses
  
!     constructor Create(aScreenBounds:TRect);
      destructor Destroy; override ;
  
--- 308,313 ----
      property Desktop :TvglDesktop read FDesktop; // the root component the VGL uses
  
!     constructor Create(aScreenBounds:TRect); overload;
!     constructor Create(aCanvas:TGLCanvas); overload;
      destructor Destroy; override ;
  
***************
*** 323,326 ****
--- 340,344 ----
    if not AcceptsChildren then raise EVGLException.Create('TvglComponent.AddChild: Adding children to this component is not allowed');
    Result := FChildren.Add(child);
+   if assigned(FOnChildAdd) then OnChildAdd(child);
  end;
  
***************
*** 345,348 ****
--- 363,368 ----
    FOnMouseExit := nil;
    FOnMouseMove := nil;
+   FOnMouseClick := nil;
+   FOnChildAdd := nil;
  
    FChildren := TvglObjList.Create;
***************
*** 517,526 ****
  var r:TRect;
  begin
!   // get the parents rect and add
!   if assigned(Owner) then
      r := Owner.ClientBounds
!   else r := Manager.ScreenBounds;
! 
!   Result := Rect(r.left+Bounds.Left,r.Top+Bounds.Top,r.left+Bounds.Left+Width,r.Top+Bounds.Top+Height);
  end;
  
--- 537,549 ----
  var r:TRect;
  begin
!   // get the parents rect and add, thanks to kk here for reformatting
!   if Assigned(Owner) then
      r := Owner.ClientBounds
!   else
!     r := Manager.ScreenBounds;
!   Result := Rect(r.left + Bounds.Left,
!                  r.Top + Bounds.Top,
!                  r.left + Bounds.Left + Width,
!                  r.Top + Bounds.Top + Height);
  end;
  
***************
*** 592,595 ****
--- 615,626 ----
  end;
  
+ procedure TvglComponent.SetOwner(const Value: TvglComponent);
+ begin
+   // remove from old owner
+   FOwner.RemoveChild(self);
+   FOwner := Value;
+   if assigned(Fowner) then Fowner.AddChild(self);
+ end;
+ 
  { TvglObjList }
  
***************
*** 616,621 ****
    OldMouseList := TvglObjList.Create;
    TempMouseList := TvglObjList.Create;
!   
!   FCanvas := TGLCanvas.Create(aScreenBounds.Right-aScreenBounds.left,aScreenBounds.Bottom-aScreenBounds.Top);
    FResources := TStringList.Create;
    // build the desktop now
--- 647,653 ----
    OldMouseList := TvglObjList.Create;
    TempMouseList := TvglObjList.Create;
! 
!   if FCanvas = nil then
!     FCanvas := TGLCanvas.Create(aScreenBounds.Right-aScreenBounds.left,aScreenBounds.Bottom-aScreenBounds.Top);
    FResources := TStringList.Create;
    // build the desktop now
***************
*** 624,627 ****
--- 656,667 ----
    FDesktop.Canvas := Canvas;
    FDesktop.Manager := Self;
+ 
+   FMouseCursor := TvglMouseCursor.Create('MouseCursor',Desktop);
+ end;
+ 
+ constructor TvglInterfaceManager.Create(aCanvas: TGLCanvas);
+ begin
+   FCanvas := aCanvas;
+   Create(Rect(0,0,aCanvas.Width,aCanvas.Height));
  end;
  
***************
*** 644,647 ****
--- 684,688 ----
    Canvas.InitMatrix;
    FDesktop.Draw;
+   FMouseCursor.Draw;
  end;
  
***************
*** 697,700 ****
--- 738,746 ----
    t:integer;
  begin
+   // update the cursor
+   FMouseCursor.Left := X;
+   FMouseCursor.Top := Y;
+ 
+   // send event
    Desktop.DoOnMouseMove(X,Y);
  
***************
*** 824,828 ****
  begin
    Result := inherited GetClientBounds;
-   Result.Top := Result.Top+10;
  end;
  
--- 870,873 ----
***************
*** 969,972 ****
--- 1014,1036 ----
  begin
    FCaptionText.Text := Value;
+ end;
+ 
+ { TvglMouseCursor }
+ 
+ constructor TvglMouseCursor.Create(aName: string; aOwner: TvglComponent);
+ begin
+   inherited Create(aName,aOwner);
+   FImage := TGLBitmap(Manager.GetResource(VGL_SKIN_1));
+ end;
+ 
+ procedure TvglMouseCursor.DrawSelf(where: TRect);
+ begin
+   inherited DrawSelf(where);
+   Canvas.DrawBitmapSubRect(where.Left,where.Top,VGL_SKINRECT_MOUSECURSOR,FImage);
+ end;
+ 
+ function TvglMouseCursor.GetComponentType: string;
+ begin
+   Result := 'MouseCursor';
  end;