Menu
▾
▴
[Pythianproject-cvsmail] CVS: Prototypes/GUISystem StartupForm.pas,1.3,1.4 VGLDemo1.dpr,1.1,1.2 skin1.png,1.2,1.3 vglClasses.pas,1.3,1.4
|
From: Michael H. <mh...@us...> - 2000-12-11 19:15:15
|
Update of /cvsroot/pythianproject/Prototypes/GUISystem In directory slayer.i.sourceforge.net:/tmp/cvs-serv2707/GUISystem Modified Files: StartupForm.pas VGLDemo1.dpr skin1.png vglClasses.pas Log Message: vgl update: scrollbars etc. -mike Index: StartupForm.pas =================================================================== RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/StartupForm.pas,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -r1.3 -r1.4 *** StartupForm.pas 2000/12/09 22:13:38 1.3 --- StartupForm.pas 2000/12/11 19:15:12 1.4 *************** *** 7,11 **** uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ! StdCtrls, GLForms, GLCanvas, OpenGL, vglClasses; type --- 7,11 ---- uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ! StdCtrls, GLForms, GLCanvas, OpenGL, vglClasses, vglStdCtrls; type *************** *** 20,24 **** --- 20,28 ---- Button :TvglButton; Panel1:TvglPanel; + Label1:TvglTextBox; + SB :TvglScrollbar; + Elapsed,FirstTime:Cardinal; + ClipTestP1,ClipTestP2,ClipTestP3,ClipTestP4 :TvglPanel; public *************** *** 48,51 **** --- 52,57 ---- InterfaceManager :TvglInterfaceManager; + function timeGetTime: Integer; external 'winmm.dll' name 'timeGetTime'; + implementation *************** *** 60,66 **** begin glClear(GL_DEPTH_BUFFER_BIT); - GLC.InitMatrix; GLC.DrawBitmap(0,0,Wallpaper); InterfaceManager.DrawAll; end; --- 66,73 ---- begin glClear(GL_DEPTH_BUFFER_BIT); GLC.InitMatrix; GLC.DrawBitmap(0,0,Wallpaper); + Elapsed := timeGetTime - FirstTime; // elapsed time from beginning - GLForm.Run + InterfaceManager.Update(Elapsed); InterfaceManager.DrawAll; end; *************** *** 130,139 **** 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 --- 137,147 ---- 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,478); Wallpaper := TGLBitmap.Create; Wallpaper.LoadFromBitmap('..\GLCanvas\scene.png'); ! if GLForm.FullScreen then ! InterfaceManager := TvglInterfaceManager.Create(GLForm.Handle, GLC) ! else InterfaceManager := TvglInterfaceManager.Create(GLForm.Handle, GLC); // create test components *************** *** 174,180 **** --- 182,203 ---- ClipTestP3.Bounds := Rect(-60,-60,60,60); + Label1 := TvglTextBox.Create('Label1',InterfaceManager.Desktop); + Label1.Top := 200; + Label1.Left := 60; + Label1.Color := clWhite; + Label1.Caption := 'Hello World'#13'This is Mike speaking to you'; + + SB := TvglScrollBar.Create('ScrollBar1', InterfaceManager.Desktop); + SB.Kind := sbHorizontal; + SB.Left := 260; + SB.Top := 60; + SB.Height := 13; + SB.Width := 200; + SB.Position := 15; + SB.PageSize := 10; Hide; ShowCursor(false); + FirstTime := timeGetTime; GLForm.Run; ShowCursor(true); Index: VGLDemo1.dpr =================================================================== RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/VGLDemo1.dpr,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -r1.1 -r1.2 *** VGLDemo1.dpr 2000/12/08 19:21:41 1.1 --- VGLDemo1.dpr 2000/12/11 19:15:12 1.2 *************** *** 3,8 **** uses Forms, ! StartupForm in 'StartupForm.pas' {frmStartup}, ! vglClasses in 'vglClasses.pas'; {$R *.RES} --- 3,7 ---- uses Forms, ! StartupForm in 'StartupForm.pas' {frmStartup}; {$R *.RES} Index: skin1.png =================================================================== RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/skin1.png,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -r1.2 -r1.3 Binary files /tmp/cvsuqJGGW and /tmp/cvsKIyesO differ Index: vglClasses.pas =================================================================== RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/vglClasses.pas,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -r1.3 -r1.4 *** vglClasses.pas 2000/12/09 22:13:38 1.3 --- vglClasses.pas 2000/12/11 19:15:12 1.4 *************** *** 108,111 **** --- 108,112 ---- private procedure SetOwner(const Value: TvglComponent); + function GetChildClipRect: TRect; protected FAcceptsChildren :boolean; *************** *** 117,120 **** --- 118,122 ---- FManager :TvglInterfaceManager; FClickGetReady :boolean; // set to true when mouse is down, reset to false when mouse goes up (triggers a click), reset to false when mouse moves + FSavedMouseDown :TvglComponent; // events here *************** *** 144,147 **** --- 146,151 ---- function GetComponentType:string; virtual ; abstract ; + procedure Update(const ElapsedTime: Cardinal); virtual; // good for implementing timer etc. + // events procedure DoOnMouseMove(X,Y:integer); virtual ; *************** *** 156,159 **** --- 160,164 ---- property Manager :TvglInterfaceManager read FManager write FManager; property ClientBounds :TRect read GetClientBounds; + property ChildClipRect :TRect read GetChildClipRect; property AcceptsChildren :boolean read FAcceptsChildren; property ComponentType :string read GetComponentType; *************** *** 267,270 **** --- 272,300 ---- end; + TvglTextBox = class(TvglComponent) + private + function GetFont: string; + procedure SetFont(const Value: string); + procedure SetColor(const Value: TColor); + protected + FText :TGLText; + function GetCaption: string; + procedure SetCaption(const Value: string); + function GetComponentType:string; override ; + function GetLines: TStringList; + + procedure LinesOnChange(Sender:TObject); + procedure UpdateBounds; + public + property Lines:TStringList read GetLines; + property Caption:string read GetCaption write SetCaption; + property Font :string read GetFont write SetFont; + property Color :TColor write SetColor; + + constructor Create(aName:string; aOwner:TVGLComponent); + destructor Destroy; override ; + procedure DrawSelf(where:TRect); override ; + end; + TvglMouseCursor = class(TvglComponent) protected *************** *** 293,297 **** FResources :TStringList; FMouseCursor :TvglMouseCursor; ! // these are used to generate onMouseEntry, onMouseExit events NewMouseList, OldMouseList, TempMouseList :TvglObjList; --- 323,329 ---- FResources :TStringList; FMouseCursor :TvglMouseCursor; ! FLeft: integer; ! FTop: integer; ! FWinHandle: HWND; // these are used to generate onMouseEntry, onMouseExit events NewMouseList, OldMouseList, TempMouseList :TvglObjList; *************** *** 307,315 **** property Canvas :TGLCanvas read FCanvas; property Desktop :TvglDesktop read FDesktop; // the root component the VGL uses ! constructor Create(aScreenBounds:TRect); overload; ! constructor Create(aCanvas:TGLCanvas); overload; destructor Destroy; override ; procedure DrawAll; virtual ; --- 339,349 ---- property Canvas :TGLCanvas read FCanvas; property Desktop :TvglDesktop read FDesktop; // the root component the VGL uses + property WinHandle :HWND read FWinHandle write FWinHandle; ! constructor Create(aWinHandle:HWND; aScreenBounds:TRect); overload; ! constructor Create(aWinHandle:HWND; aCanvas:TGLCanvas); overload; destructor Destroy; override ; + procedure Update(Elapsed:Cardinal); procedure DrawAll; virtual ; *************** *** 348,351 **** --- 382,386 ---- FName := aName; FClickGetReady := false; + FSavedMouseDown := nil; if AOwner <> nil then begin *************** *** 385,391 **** if not CompareRect(Bounds,Rect(0,0,0,0)) and Visible then begin ! // setup clipping here for client area if assigned(FOwner) then ! Canvas.SetClipping(FOwner.ClientBounds) else Canvas.CancelClipping; --- 420,426 ---- if not CompareRect(Bounds,Rect(0,0,0,0)) and Visible then begin ! // setup clipping here for the owners ChildClipRect if assigned(FOwner) then ! Canvas.SetClipping(FOwner.ChildClipRect) else Canvas.CancelClipping; *************** *** 403,407 **** begin if assigned(FOwner) then ! Canvas.SetClipping(FOwner.ClientBounds); FChildren[i].Draw; end; --- 438,442 ---- begin if assigned(FOwner) then ! Canvas.SetClipping(FOwner.ChildClipRect); FChildren[i].Draw; end; *************** *** 494,497 **** --- 529,533 ---- // if point X,Y is in child then forward event c := GetComponentAt(X,Y); + FSavedMouseDown := c; if (c <> nil) and (c <> self) then c.DoOnMouseDown(mb, X,Y); *************** *** 512,524 **** procedure TvglComponent.DoOnMouseUp(mb, X, Y: integer); ! var c:TvglComponent; begin // if point X,Y is in child then forward event ! c := GetComponentAt(X,Y); if (c <> nil) and (c <> self) then c.DoOnMouseUp(mb,X,Y); ! if assigned(FOnMouseUp) then OnMouseUp(mb,X,Y); ! if FClickGetReady then begin DoOnMouseClick(X,Y); FClickGetReady := false; --- 548,565 ---- procedure TvglComponent.DoOnMouseUp(mb, X, Y: integer); ! var ! c: TvglComponent; begin // if point X,Y is in child then forward event ! c := FSavedMouseDown; if (c <> nil) and (c <> self) then c.DoOnMouseUp(mb,X,Y); ! if assigned(FOnMouseUp) then ! OnMouseUp(mb,X,Y); ! if FClickGetReady and PointInRect(ScreenBounds, X, Y) then begin + c := GetComponentAt(X, Y); + if (c <> nil) and (c <> Self) then + Exit; DoOnMouseClick(X,Y); FClickGetReady := false; *************** *** 623,626 **** --- 664,684 ---- end; + function TvglComponent.GetChildClipRect: TRect; + begin + // this is formed by fitting the clientbounds into the parents cliprect + if assigned(FOwner) then + Result := FitRectToRect(ClientBounds,FOwner.ChildClipRect) + else Result := ClientBounds; + end; + + procedure TvglComponent.Update(const ElapsedTime: Cardinal); + var + i: Integer; + begin + for i := 0 to FChildren.Count - 1 do + if FChildren[i] <> nil then + FChildren[i].Update(ElapsedTime); + end; + { TvglObjList } *************** *** 640,644 **** { ************************************************************************** } ! constructor TvglInterfaceManager.Create(aScreenBounds:TRect); begin inherited Create; --- 698,702 ---- { ************************************************************************** } ! constructor TvglInterfaceManager.Create(aWinHandle:HWND; aScreenBounds:TRect); begin inherited Create; *************** *** 647,650 **** --- 705,711 ---- OldMouseList := TvglObjList.Create; TempMouseList := TvglObjList.Create; + WinHandle := aWinHandle; + + FLeft := 0; FTop := 0; if FCanvas = nil then *************** *** 660,667 **** end; ! constructor TvglInterfaceManager.Create(aCanvas: TGLCanvas); begin FCanvas := aCanvas; ! Create(Rect(0,0,aCanvas.Width,aCanvas.Height)); end; --- 721,728 ---- end; ! constructor TvglInterfaceManager.Create(aWinHandle:HWND; aCanvas: TGLCanvas); begin FCanvas := aCanvas; ! Create(aWinHandle, Rect(0,0,aCanvas.Width,aCanvas.Height)); end; *************** *** 739,744 **** begin // update the cursor - FMouseCursor.Left := X; - FMouseCursor.Top := Y; // send event --- 800,803 ---- *************** *** 789,792 **** --- 848,867 ---- end; + procedure TvglInterfaceManager.Update(Elapsed: Cardinal); + var x,y:integer; + p:TPoint; + begin + Desktop.Update(Elapsed); + // update mouse cursor position + GetCursorPos(p); + ScreenToClient(WinHandle,p); + x := p.X; y := p.Y; + x := x - FLeft; + y := y - FTop; + if x > FCanvas.Width-1 then x := FCanvas.Width; // window borders + if y > FCanvas.Height then y := FCanvas.Height; + FMouseCursor.Left := x; FMouseCursor.Top := y; + end; + { TvglDesktop } *************** *** 1033,1036 **** --- 1108,1186 ---- begin Result := 'MouseCursor'; + end; + + { TvglTextBox } + + constructor TvglTextBox.Create(aName: string; aOwner: TVGLComponent); + begin + inherited Create(aName,aOwner); + FText := TGLText.Create('Arial'); + FText.Lines.OnChange := LinesOnChange; + end; + + destructor TvglTextBox.Destroy; + begin + FText.Free; + inherited Destroy; + end; + + procedure TvglTextBox.DrawSelf(where: TRect); + begin + inherited DrawSelf(where); + Canvas.DrawText(where.Left,where.Top,FText); + end; + + function TvglTextBox.GetCaption: string; + begin + Result := Lines.Text; + end; + + function TvglTextBox.GetComponentType: string; + begin + Result := 'Label'; + end; + + function TvglTextBox.GetFont: string; + begin + Result := FText.FontName; + end; + + function TvglTextBox.GetLines: TStringList; + begin + Result := FText.Lines; + end; + + procedure TvglTextBox.LinesOnChange(Sender: TObject); + begin + // update bounds + UpdateBounds; + end; + + procedure TvglTextBox.SetCaption(const Value: string); + begin + Lines.Text := Value; + end; + + procedure TvglTextBox.SetColor(const Value: TColor); + begin + FText.SetColor(Value); + end; + + procedure TvglTextBox.SetFont(const Value: string); + begin + FText.FontName := Value; + end; + + procedure TvglTextBox.UpdateBounds; + var + i:integer; + longest:integer; + begin + // locate longest line + longest := 0; + for i := 0 to FText.Lines.Count-1 do + if FText.Width[i] > longest then longest := FText.Width[i]; + Width := longest; + Height := FText.Lines.Count*FText.QT.GridSquareHeight; end; |
