Menu
▾
▴
[Pythianproject-cvsmail] CVS: Prototypes/GUISystem StartupForm.pas,1.9,1.10 vglClasses.pas,1.6,1.7 vglStdCtrls.pas,1.4,1.5
|
From: Michael H. <mh...@us...> - 2000-12-15 18:36:33
|
Update of /cvsroot/pythianproject/Prototypes/GUISystem In directory slayer.i.sourceforge.net:/tmp/cvs-serv31590/GUISystem Modified Files: StartupForm.pas vglClasses.pas vglStdCtrls.pas Log Message: added multi-line edit -mike Index: StartupForm.pas =================================================================== RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/StartupForm.pas,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -r1.9 -r1.10 *** StartupForm.pas 2000/12/13 22:34:12 1.9 --- StartupForm.pas 2000/12/15 18:36:31 1.10 *************** *** 3,7 **** interface ! { bug: Doesn't work in fullscreen mode - probably because of fault in GLForms } uses --- 3,9 ---- interface ! // undefine this to force fonts directory to be same as app directory ! // when defined fonts are in ..\GLCanvas ! {$DEFINE DEVELOPMENT} uses *************** *** 25,31 **** CB: TvglCheckBox; cc: TvglComponent; ! Elapsed,FirstTime:Cardinal; ! ClipTestP1,ClipTestP2,ClipTestP3,ClipTestP4 :TvglPanel; public { Public declarations } --- 27,34 ---- CB: TvglCheckBox; cc: TvglComponent; ! Edit1:TvglEdit; ClipTestP1,ClipTestP2,ClipTestP3,ClipTestP4 :TvglPanel; + + Elapsed,FirstTime:Cardinal; public { Public declarations } *************** *** 44,47 **** --- 47,52 ---- procedure CB1OnChange(Sender:TObject); + procedure ManagerOnFocusChange(Sender:TObject); + procedure go; end; *************** *** 72,83 **** Elapsed := timeGetTime - FirstTime; // elapsed time from beginning - GLForm.Run InterfaceManager.Update(Elapsed); ! if cc <> InterfaceManager.Focused then ! begin ! cc := InterfaceManager.Focused; ! if cc <> nil then ! Label1.Lines.Text := cc.Name ! else ! Label1.Lines.Text := 'FOCUS LOST!'; ! end; InterfaceManager.DrawAll; end; --- 77,81 ---- Elapsed := timeGetTime - FirstTime; // elapsed time from beginning - GLForm.Run InterfaceManager.Update(Elapsed); ! InterfaceManager.DrawAll; end; *************** *** 159,163 **** --- 157,163 ---- GLForm.Open; + {$IFDEF DEVELOPMENT} FontsDirectory := '..\GLCanvas\'; + {$ENDIF} if not GLForm.FullScreen then GLC := TGLCanvas.Create(GLForm.Width-6,GLForm.Height-25) // must take into account window borders *************** *** 170,176 **** else InterfaceManager := TvglInterfaceManager.Create(GLForm.Handle, GLC); // create test components Panel1 := TvglPanel.Create('Panel1',InterfaceManager.Desktop); ! Panel1.Bounds := Rect(50,50,250,250); Panel1.Textured := True; Panel1.OnMouseDown := Panel1OnMouseDown; --- 170,178 ---- else InterfaceManager := TvglInterfaceManager.Create(GLForm.Handle, GLC); + InterfaceManager.OnFocusChange := ManagerOnFocusChange; + // create test components Panel1 := TvglPanel.Create('Panel1',InterfaceManager.Desktop); ! Panel1.Bounds := Rect(10,30,200,200); Panel1.Textured := True; Panel1.OnMouseDown := Panel1OnMouseDown; *************** *** 221,226 **** Label1 := TvglTextBox.Create('Label1',InterfaceManager.Desktop); ! Label1.Top := 320; ! Label1.Left := 20; Label1.Color := clBlack; Label1.Font := 'Courier New'; --- 223,228 ---- Label1 := TvglTextBox.Create('Label1',InterfaceManager.Desktop); ! Label1.Top := 192; ! Label1.Left := 468; Label1.Color := clBlack; Label1.Font := 'Courier New'; *************** *** 249,252 **** --- 251,259 ---- LB.ScrollBars := ssBoth; + Edit1 := TvglEdit.Create('Edit1',InterfaceManager.Desktop); + Edit1.Bounds := Rect(20,300,220,400); + Edit1.Lines.Add('Hello World 1'); + Edit1.Lines.Add('Hello World 2'); + InterfaceManager.SetNewFocus(LB); Hide; *************** *** 269,272 **** --- 276,291 ---- CB.Caption := 'Checked' else CB.Caption := 'Unchecked'; + end; + + procedure TfrmStartup.ManagerOnFocusChange(Sender: TObject); + begin + if cc <> InterfaceManager.Focused then + begin + cc := InterfaceManager.Focused; + if cc <> nil then + Label1.Lines.Text := cc.Name + else + Label1.Lines.Text := 'FOCUS LOST!'; + end; end; Index: vglClasses.pas =================================================================== RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/vglClasses.pas,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -r1.6 -r1.7 *** vglClasses.pas 2000/12/13 20:25:21 1.6 --- vglClasses.pas 2000/12/15 18:36:31 1.7 *************** *** 37,46 **** - Resource sharing (done except reference counting/garbage collection) - Name generation/usage (!) - - Events (pretty much done) - Display list optimizations - Components - - Improve name creation algorithm - Done: - Decent parent/child relationships implementation, drawing etc. --- 37,43 ---- *************** *** 179,182 **** --- 176,180 ---- procedure SetOnKeyDown(const Value: TVGLKeyboardEvent); procedure SetOnKeyUp(const Value: TVGLKeyboardEvent); + function KeyDataToShiftState(KeyData: Longint): TShiftState; protected FFocusable: Boolean; *************** *** 392,395 **** --- 390,394 ---- FSwitchingTo, FLastFocused: TvglComponent; + FOnFocusChange: TNotifyEvent; // these are used to generate onMouseEntry, onMouseExit events NewMouseList, OldMouseList, TempMouseList :TvglObjList; *************** *** 422,425 **** --- 421,426 ---- // resource management function GetResource(aName:string):TObject; + + // focus procedure SetNewFocus(C: TvglComponent); *************** *** 433,436 **** --- 434,438 ---- published property OnCreateDesktop: TCreateDesktopEvent read FOnCreateDesktop write SetOnCreateDesktop; + property OnFocusChange :TNotifyEvent read FOnFocusChange write FOnFocusChange; end; *************** *** 955,958 **** --- 957,970 ---- end; + function TvglComponent.KeyDataToShiftState(KeyData: Longint): TShiftState; + const + AltMask = $20000000; + begin + Result := []; + if GetKeyState(VK_SHIFT) < 0 then Include(Result, ssShift); + if GetKeyState(VK_CONTROL) < 0 then Include(Result, ssCtrl); + if KeyData and AltMask <> 0 then Include(Result, ssAlt); + end; + { TvglObjList } *************** *** 993,996 **** --- 1005,1009 ---- FMouseCursor := TvglMouseCursor.Create('MouseCursor',Desktop); FFocusedComponent := nil; + FOnFocusChange := nil; FSwitchingTo := nil; FLastFocused := nil; *************** *** 1207,1232 **** procedure TvglPanel.DrawSelf(where:TRect); - var - curClip,newClip:TRect; - tilex,tiley:integer; - texwidth,texheight:integer; begin inherited DrawSelf(where); if Textured then ! begin ! CurClip := Canvas.ClipRect; ! NewClip := FitRectToRect(where,CurClip); ! Canvas.SetClipping(NewClip); ! ! // tile the texture ! texwidth := VGL_SKINRECT_BACKGROUND.Right-VGL_SKINRECT_BACKGROUND.Left-1; ! texheight := VGL_SKINRECT_BACKGROUND.Bottom-VGL_SKINRECT_BACKGROUND.Top-1; ! for tilex := 0 to ((where.Right-where.Left) div texWidth) do ! for tiley := 0 to ((where.bottom-where.top) div texHeight) do ! Canvas.DrawBitmapSubRect(where.Left+(tilex*texwidth),where.Top+(tiley*texHeight),VGL_SKINRECT_BACKGROUND,FTexture); ! ! Canvas.SetClipping(CurClip); ! end else ! begin Canvas.CurrentColor := FColor; Canvas.Solid := true; --- 1220,1228 ---- procedure TvglPanel.DrawSelf(where:TRect); begin inherited DrawSelf(where); if Textured then ! Canvas.TileBitmapSubRect(FitRectToRect(where,Canvas.ClipRect),VGL_SKINRECT_BACKGROUND,FTexture) ! else begin Canvas.CurrentColor := FColor; Canvas.Solid := true; *************** *** 1353,1356 **** --- 1349,1354 ---- if Assigned(FFocusedComponent) then FFocusedComponent.DoSetFocus; + + if assigned(FOnFocusChange) then FOnFocusChange(FFocusedComponent); end; Index: vglStdCtrls.pas =================================================================== RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/vglStdCtrls.pas,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -r1.4 -r1.5 *** vglStdCtrls.pas 2000/12/13 22:34:12 1.4 --- vglStdCtrls.pas 2000/12/15 18:36:31 1.5 *************** *** 32,36 **** interface ! uses Windows, GLCanvas, Classes, vglClasses, Graphics; const --- 32,36 ---- interface ! uses Windows, GLCanvas, Classes, vglClasses, Graphics, SysUtils; const *************** *** 311,317 **** end; implementation uses ! Consts, Math; const --- 311,344 ---- end; + TvglEdit = class(TVGLComponent) + protected + FCursorX: integer; + FCursorY: integer; + FLines :TStringList; + FText :TGLText; + FColor: TColor; + function GetComponentType:string; override ; + procedure SetCursorX(const Value: integer); + procedure SetCursorY(const Value: integer); + procedure DoOnKeyDown(KeyCode, KeyData: Integer; KBMOD: TVGLKBModifiers; var AllowHP: Boolean); override; + public + constructor Create(aName:String; aOwner:TvglComponent); + destructor Destroy; override ; + + procedure DrawSelf(where:TRect); override ; + procedure Update(const ElapsedTime: Cardinal); override; + + { these specify the character "after" which the cursor appears } + property CursorX :integer read FCursorX write SetCursorX; + property CursorY :integer read FCursorY write SetCursorY; + published + property Lines :TStringList read FLines; + property Text :TGLText read FText; + property Color :TColor read FColor write FColor; + end; + implementation uses ! Consts, Math, QuadTextUnit; const *************** *** 1266,1274 **** begin inherited DoOnMouseClick(x, y); ! if PointInRect(GetCheckMarkBounds(ScreenBounds), X, Y) then ! begin ! FChecked := not FChecked; ! DoChanged; ! end; end; --- 1293,1298 ---- begin inherited DoOnMouseClick(x, y); ! FChecked := not FChecked; ! DoChanged; end; *************** *** 1450,1454 **** begin inherited DrawSelf(where); - //@@todo - text centreing case FButtonState of vglbsUp: FImage.Intensity := 255; --- 1474,1477 ---- *************** *** 1460,1464 **** tw := FCaptionText.Width[0]; if FCaptionText.Text <> '' then ! Canvas.DrawText( ((where.Right-where.Left-16))-(tw div 2), where.top+12,FCaptionText); end; --- 1483,1487 ---- tw := FCaptionText.Width[0]; if FCaptionText.Text <> '' then ! Canvas.DrawText( where.left+((where.Right-where.Left) div 2)-(tw div 2), where.top+12,FCaptionText); end; *************** *** 1577,1580 **** --- 1600,1701 ---- Width := longest; Height := FText.Lines.Count*FText.QT.GridSquareHeight; + end; + + { TvglEdit } + + constructor TvglEdit.Create(aName:String; aOwner:TvglComponent); + begin + inherited Create(aName,aOwner); + FText := TGLText.Create('Arial'); + Color := clGreen; + FLines := FText.Lines; + CursorX := 3; CursorY := 2; + FFocusable := true; + FAcceptsChildren := false; + end; + + destructor TvglEdit.Destroy; + begin + FText.Free; + inherited; + end; + + procedure TvglEdit.DoOnKeyDown(KeyCode, KeyData: Integer; + KBMOD: TVGLKBModifiers; var AllowHP: Boolean); + var s:string; + begin + inherited; + AllowHP := false; + case KeyCode of + VK_LEFT :if CursorX > 0 then dec(FCursorX); + VK_RIGHT:if CursorX < Length(Lines[FCursorY-1]) then inc(FCursorX); + VK_UP :if CursorY > 1 then CursorY := CursorY - 1; + VK_DOWN :if CursorY < Lines.Count then CursorY := CursorY + 1; + else + if (KeyCode = VK_BACK) then + begin + if CursorX > 0 then + begin + s := FLines[CursorY-1]; + Delete(s,CursorX,1); + FLines[CursorY-1] := s; + CursorX := CursorX - 1; + end; + end else if (KeyCode = VK_RETURN) then + begin + FLines.Insert(CursorY,Copy(Flines[CursorY-1],CursorX,Length(FLines[CursorY-1]))); // add new line + FLines[CursorY-1] := Copy(FLines[CursorY-1],0,CursorX); + CursorX := 0; CursorY := CursorY + 1; + end else if (KeyCode <> VK_SHIFT) and (KeyCode <> VK_MENU) and (KeyCode <> VK_CONTROL) then + begin + s := FLines[CursorY-1]; + Insert(Char(KeyCode),s,CursorX+1); // BUG: shift key has no effect :( + FLines[CursorY-1] := s; + CursorX := CursorX + 1; + end; + end; + end; + + procedure TvglEdit.DrawSelf(where: TRect); + var + i,cx,cy:integer; + begin + inherited DrawSelf(where); + Canvas.CurrentColor := Color; + Canvas.Solid := false; + Canvas.Rectangle(where.left,where.top,where.right,where.bottom); + Canvas.Solid := true; + Canvas.FillAlpha := 0.5; + Canvas.Rectangle(where.left,where.top,where.right,where.bottom); + + Canvas.SetClipping(Where); + Canvas.DrawText(where.left+2,where.top,FText); + + // draw the cursor + cx := FText.StringWidth(Copy(FText.Lines[CursorY-1],0,CursorX)); + Canvas.CurrentColor := clWhite; + Canvas.Line(where.left+cx+1,where.Top+((CursorY-1)*FText.QT.GridSquareHeight)+3,where.left+cx+1,where.Top + (CursorY*FText.QT.GridSquareHeight)-3); + end; + + function TvglEdit.GetComponentType: string; + begin + result := 'Edit'; + end; + + procedure TvglEdit.SetCursorX(const Value: integer); + begin + FCursorX := Value; + end; + + procedure TvglEdit.SetCursorY(const Value: integer); + begin + FCursorY := Value; + end; + + procedure TvglEdit.Update(const ElapsedTime: Cardinal); + begin + // check cursor bounds are ok + if CursorY > FLines.Count then CursorY := FLines.Count; + if CursorX > Length(Flines[CursorY-1]) then CursorX := Length(Flines[CursorY-1]); end; |
