Menu
▾
▴
[Pythianproject-cvsmail] CVS: Prototypes/GUISystem StartupForm.dfm,1.1,1.2 StartupForm.pas,1.1,1.2 vglClasses.pas,1.1,1.2
|
From: Michael H. <mh...@us...> - 2000-12-09 19:52:07
|
Update of /cvsroot/pythianproject/Prototypes/GUISystem In directory slayer.i.sourceforge.net:/tmp/cvs-serv18050/GUISystem Modified Files: StartupForm.dfm StartupForm.pas vglClasses.pas Log Message: GUI system update -mike Index: StartupForm.dfm =================================================================== RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/StartupForm.dfm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -r1.1 -r1.2 Binary files /tmp/cvsCwYbG2 and /tmp/cvsSkgwiV differ Index: StartupForm.pas =================================================================== RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/StartupForm.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -r1.1 -r1.2 *** StartupForm.pas 2000/12/08 19:21:40 1.1 --- StartupForm.pas 2000/12/09 19:52:04 1.2 *************** *** 10,13 **** --- 10,14 ---- TfrmStartup = class(TForm) GoButton: TButton; + Memo1: TMemo; procedure GoButtonClick(Sender: TObject); private *************** *** 31,34 **** --- 32,36 ---- procedure Panel1OnMouseEntry(Sender:TObject); procedure Panel1OnMouseExit(Sender:TObject); + procedure ButtonOnclick(Sender:TObject); end; *************** *** 67,71 **** // create test components Panel1 := TvglPanel.Create('Panel1',InterfaceManager.Desktop); ! Panel1.Bounds := Rect(50,50,350,350); Panel1.Textured := true; Panel1.OnMouseDown := Panel1OnMouseDown; --- 69,73 ---- // create test components Panel1 := TvglPanel.Create('Panel1',InterfaceManager.Desktop); ! Panel1.Bounds := Rect(50,50,250,250); Panel1.Textured := true; Panel1.OnMouseDown := Panel1OnMouseDown; *************** *** 79,89 **** c.Width := 50; c.Height := 50; ! Image1 := TvglImage.Create('Image1',Panel1); ! Image1.Bounds := Rect(200,100,500,400); ! Image1.LoadImage('group_ai.png'); Button := TvglButton.Create('Button',Panel1); ! Button.Caption := 'click me!'; Button.Bounds := Rect(10,60,0,0); Hide; --- 81,92 ---- 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; *************** *** 144,147 **** --- 147,157 ---- begin if Panel1.Color = clBlue then Panel1.Color := clGreen else Panel1.Color := clBlue; + end; + + procedure TfrmStartup.ButtonOnclick(Sender: TObject); + begin + Image1.Visible := not Image1.Visible; + if Image1.Visible then + Button.Caption := 'hide image' else Button.Caption := 'show image'; end; Index: vglClasses.pas =================================================================== RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/vglClasses.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -r1.1 -r1.2 *** vglClasses.pas 2000/12/08 19:21:41 1.1 --- vglClasses.pas 2000/12/09 19:52:04 1.2 *************** *** 117,120 **** --- 117,121 ---- FChildren :TvglObjList; 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 // events here *************** *** 122,126 **** FOnMouseUp, FOnMouseDown :TVGLMouseButtonEvent; FOnMouseMove :TVGLMouseMoveEvent; ! FOnMouseEntry,FOnMouseExit :TNotifyEvent; FVisible :boolean; --- 123,127 ---- FOnMouseUp, FOnMouseDown :TVGLMouseButtonEvent; FOnMouseMove :TVGLMouseMoveEvent; ! FOnMouseEntry,FOnMouseExit,FOnMouseClick :TNotifyEvent; FVisible :boolean; *************** *** 138,141 **** --- 139,150 ---- function GetClientBounds: TRect; virtual ; function GetComponentType:string; virtual ; abstract ; + + // events + procedure DoOnMouseMove(X,Y:integer); virtual ; + procedure DoOnMouseDown(mb, X,Y:integer); virtual ; + procedure DoOnMouseUp(mb, X,Y:integer); virtual ; + procedure DoOnMouseEntry; virtual ; // unlike the above events these do not recurse + procedure DoOnMouseExit; virtual ; + procedure DoOnMouseClick(x,y:integer); virtual ; public property Owner :TvglComponent read FOwner; *************** *** 162,171 **** function ScreenBounds :TRect; // converts the relative position into a screen based position - // events - procedure DoOnMouseMove(X,Y:integer); virtual ; - procedure DoOnMouseDown(mb, X,Y:integer); virtual ; - procedure DoOnMouseUp(mb, X,Y:integer); virtual ; - procedure DoOnMouseEntry; virtual ; // unlike the above events these do not recurse - procedure DoOnMouseExit; virtual ; published property Name :string read FName write SetName; --- 171,174 ---- *************** *** 185,188 **** --- 188,192 ---- property OnMouseEntry :TNotifyEvent read FOnMouseEntry write FOnMouseEntry; property OnMouseExit :TNotifyEvent read FOnMouseExit write FOnMouseExit; + property OnClick :TNotifyEvent read FOnMouseClick write FOnMouseClick; end; *************** *** 222,225 **** --- 226,230 ---- FImage :TGLBitmap; procedure SetImage(const Value: TGLBitmap); + procedure SetBounds(const Value: TRect); override ; function GetComponentType:string; override ; public *************** *** 233,240 **** --- 238,247 ---- end; + TvglButtonState = (vglbsUp, vglbsDown, vglbsOver); TvglButton = class(TvglComponent) protected FImage :TGLBitmap; FCaptionText :TGLText; + FButtonState :TvglButtonState; procedure SetCaption(const Value: string); procedure SetBounds(const Value: TRect); override ; *************** *** 242,245 **** --- 249,256 ---- function GetComponentType:string; override ; + + procedure DoOnMouseEntry; override ; + procedure DoOnMouseExit; override ; + procedure DoOnMouseDown(mb,x,y:integer); override ; public property Caption :string read GetCaption write SetCaption; *************** *** 318,321 **** --- 329,333 ---- inherited Create; FName := aName; + FClickGetReady := false; if AOwner <> nil then begin *************** *** 416,428 **** c:TvglComponent; begin ! i := 0; c := nil; Result := nil; if not PointInRect(ScreenBounds,X,Y) then exit; if FChildren.Count > 0 then ! while not assigned(c) and (i < FChildren.Count) do begin if PointInRect(FChildren[i].ScreenBounds,X,Y) and PointInRect(ClientBounds,X,Y) and FChildren[i].Visible then // this child may contain the final component so ask it c := FChildren[i].GetComponentAt(X,Y); ! inc(i); end; if c = nil then result := self else result := c; --- 428,441 ---- c:TvglComponent; begin ! // we want the topmost component so work backwards ! i := FChildren.Count-1; c := nil; Result := nil; if not PointInRect(ScreenBounds,X,Y) then exit; if FChildren.Count > 0 then ! while not assigned(c) and (i >= 0) do begin if PointInRect(FChildren[i].ScreenBounds,X,Y) and PointInRect(ClientBounds,X,Y) and FChildren[i].Visible then // this child may contain the final component so ask it c := FChildren[i].GetComponentAt(X,Y); ! dec(i); end; if c = nil then result := self else result := c; *************** *** 465,468 **** --- 478,483 ---- if assigned(FOnMouseDown) then OnMouseDown(mb, X,Y); + if mb = VGL_MOUSE_LEFT then + FClickGetReady := true; end; *************** *** 484,487 **** --- 499,507 ---- c.DoOnMouseUp(mb,X,Y); if assigned(FOnMouseUp) then OnMouseUp(mb,X,Y); + if FClickGetReady then + begin + DoOnMouseClick(X,Y); + FClickGetReady := false; + end; end; *************** *** 567,570 **** --- 587,595 ---- end; + procedure TvglComponent.DoOnMouseClick(x,y:integer); + begin + if assigned(FOnMouseClick) then OnClick(Self); + end; + { TvglObjList } *************** *** 858,861 **** --- 883,898 ---- end; + procedure TvglImage.SetBounds(const Value: TRect); + var tmp:TRect; + begin + tmp := Value; + if assigned(FImage) then + begin + if tmp.Right = 0 then tmp.Right := FImage.Width+tmp.Left; + if tmp.Bottom = 0 then tmp.Bottom := FImage.Height+tmp.Top; + end else if (tmp.right = 0) or (tmp.bottom = 0) then raise EVGLException.Create('TvglImage.SetBounds: Autosizing can only occur once an image is loaded'); + inherited SetBounds(tmp); + end; + { TvglButton } *************** *** 866,869 **** --- 903,907 ---- FCaptionText := TGLText.Create('Arial'); FCaptionText.SetColor(clBlack); + FButtonState := vglbsUp; end; *************** *** 874,883 **** end; procedure TvglButton.DrawSelf(where: TRect); begin inherited DrawSelf(where); ! //@@todo - text centering Canvas.DrawBitmapSubRect(where.Left,where.Top,VGL_SKINRECT_BUTTON,FImage); ! if FCaptionText.Text <> '' then Canvas.DrawText(where.Left+10,where.Top+12,FCaptionText); end; --- 912,948 ---- end; + procedure TvglButton.DoOnMouseDown(mb, x, y: integer); + begin + inherited DoOnMouseDown(mb,x,y); + FButtonState := vglbsDown; + end; + + procedure TvglButton.DoOnMouseEntry; + begin + inherited DoOnMouseEntry; + FButtonState := vglbsOver; + end; + + procedure TvglButton.DoOnMouseExit; + begin + inherited DoOnMouseExit; + FButtonState := vglbsUp; + end; + procedure TvglButton.DrawSelf(where: TRect); + var tw:integer; begin inherited DrawSelf(where); ! //@@todo - text centreing ! case FButtonState of ! vglbsUp: FImage.Intensity := 255; ! vglbsOver: FImage.Intensity := 200; ! vglbsDown: FImage.Intensity := 200; ! end; Canvas.DrawBitmapSubRect(where.Left,where.Top,VGL_SKINRECT_BUTTON,FImage); ! FImage.Intensity := 255; // remember to reset!!! ! tw := FCaptionText.Width[0]; ! if FCaptionText.Text <> '' then ! Canvas.DrawText( ((where.Right-where.Left-16))-(tw div 2), where.top+12,FCaptionText); end; *************** *** 896,900 **** begin tmp := Value; ! tmp.Right := FImage.Width+tmp.Right; tmp.Bottom := tmp.Top+FImage.Height; inherited SetBounds(tmp); end; --- 961,966 ---- begin tmp := Value; ! tmp.Right := (VGL_SKINRECT_BUTTON.Right-VGL_SKINRECT_BUTTON.Left)+tmp.Left; ! tmp.Bottom := tmp.Top+(VGL_SKINRECT_BUTTON.Bottom-VGL_SKINRECT_BUTTON.Top); inherited SetBounds(tmp); end; |
