pythianproject-cvsmail Mailing List for The Pythian Project (Page 6)

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

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;

2000	Jan	Feb	Mar	Apr	May	Jun	Jul	Aug	Sep (18)	Oct (33)	Nov (27)	Dec (26)
2001	Jan (22)	Feb	Mar	Apr	May	Jun	Jul	Aug (46)	Sep	Oct	Nov	Dec
2002	Jan	Feb	Mar	Apr	May	Jun	Jul	Aug	Sep	Oct	Nov (1)	Dec
2008	Jan	Feb	Mar	Apr (13)	May (7)	Jun (9)	Jul (23)	Aug (5)	Sep (4)	Oct (6)	Nov (1)	Dec
2009	Jan (1)	Feb	Mar	Apr	May (2)	Jun	Jul	Aug	Sep	Oct	Nov	Dec
2010	Jan	Feb	Mar	Apr (1)	May	Jun	Jul	Aug	Sep	Oct	Nov	Dec

pythianproject-cvsmail Mailing List for The Pythian Project (Page 6)

pythianproject-cvsmail — receives automatic CVS updates