Menu
▾
▴
[Pythianproject-cvsmail] CVS: Prototypes/GUISystem StartupForm.pas,1.2,1.3 skin1.png,1.1,1.2 vglClasses.pas,1.2,1.3
|
From: Michael H. <mh...@us...> - 2000-12-09 22:13:41
|
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; |
