[Pythianproject-cvsmail] CVS: Prototypes/GUISystem StartupForm.pas,1.15,1.16 vglClasses.pas,1.13,1.14 vglConversation.pas,1.1,1.2 vglStdCtrls.pas,1.12,1.13

[Michael H. <mh...@us...>]

Update of /cvsroot/pythianproject/Prototypes/GUISystem
In directory usw-pr-cvs1:/tmp/cvs-serv14795/GUISystem

Modified Files:
	StartupForm.pas vglClasses.pas vglConversation.pas 
	vglStdCtrls.pas 
Log Message:
added anti-aliased VinerHand ITC font -mike

Index: StartupForm.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/StartupForm.pas,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -r1.15 -r1.16
*** StartupForm.pas	2001/01/12 21:10:35	1.15
--- StartupForm.pas	2001/01/16 20:39:16	1.16
***************
*** 40,43 ****
--- 40,44 ----
      ConvPage :TvglPage;
      ConvOptions :TvglConvOptionsPicker;
+     ConvOut :TvglConversationOut;
  
      Elapsed,FirstTime:Cardinal;
***************
*** 64,67 ****
--- 65,69 ----
  
      procedure go;
+     procedure OptionsSelect(selected:integer);
    end;
  
***************
*** 311,317 ****
--- 313,324 ----
    ConvOptions.Options.Add('Hello World!');
    ConvOptions.Options.Add('Second option');
+   ConvOptions.OnSelectOption := OptionsSelect;
  
+   ConvOut := TvglConversationOut.Create('ConvOut',ConvPage);
+   ConvOut.Bounds := Rect(20,InterfaceManager.Desktop.Bounds.Bottom - 200, InterfaceManager.Desktop.Bounds.Right - 20,InterfaceManager.Desktop.Bounds.Bottom - 60);
+   ConvOut.AddSpeech('test test test'); 
  
    InterfaceManager.SetNewFocus(LB);
+   InterfaceManager.DefaultFocused := LB;
    Hide;
    ShowCursor(false);
***************
*** 367,373 ****
  begin
    if Sender = SelectTestPage then
!     MultiPage.CurrentPage := TestPage
!   else if Sender = SelectConvPage then
      MultiPage.CurrentPage := ConvPage;
  end;
  
--- 374,394 ----
  begin
    if Sender = SelectTestPage then
!   begin
!     MultiPage.CurrentPage := TestPage;
!     InterfaceManager.DefaultFocused := LB;
!     InterfaceManager.SetNewFocus(LB);
!   end else if Sender = SelectConvPage then
!   begin
      MultiPage.CurrentPage := ConvPage;
+     InterfaceManager.DefaultFocused := ConvOptions;
+     InterfaceManager.SetNewFocus(ConvOptions);
+   end;
+ end;
+ 
+ procedure TfrmStartup.OptionsSelect(selected: integer);
+ begin
+   // write it out
+   ConvOut.AddSpeech(ConvOptions.Options[selected-1]);
+   ConvOptions.ClearSelected;
  end;
  

Index: vglClasses.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/vglClasses.pas,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -r1.13 -r1.14
*** vglClasses.pas	2001/01/12 21:10:35	1.13
--- vglClasses.pas	2001/01/16 20:39:16	1.14
***************
*** 472,477 ****
    TCreateDesktopEvent = procedure(AManager: TvglInterfaceManager; var ADesktop: TvglDesktop) of object;
    TvglInterfaceManager = class(TvglBase)
-   private
-     FDefaultTextured: boolean;
    protected
      FDesktop :TvglDesktop;
--- 472,475 ----
***************
*** 489,492 ****
--- 487,492 ----
      FOnFocusChange: TNotifyEvent;
      FDragObjects :TList;
+     FDefaultTextured: boolean;
+     FDefaultFocused: TvglComponent;
      LastDragPos :TPoint;
      // these are used to generate onMouseEntry, onMouseExit events
***************
*** 520,523 ****
--- 520,524 ----
      property WinHandle :HWND read FWinHandle write FWinHandle;
      property DefaultTextured :boolean read FDefaultTextured write FDefaultTextured;
+     property DefaultFocused :TvglComponent read FDefaultFocused write FDefaultFocused;
      property DragObjects :TList read FDragObjects;
  
***************
*** 1616,1620 ****
  begin
    if Assigned(C) and not C.FFocusable then
!     C := nil;
    // this proc is called by C.SetFocus
    FSwitchingTo := C; // if the DeFocused control wanted to know, who steals him the focus
--- 1617,1622 ----
  begin
    if Assigned(C) and not C.FFocusable then
!     C := FDefaultFocused
!   else if C = nil then C := FDefaultFocused;
    // this proc is called by C.SetFocus
    FSwitchingTo := C; // if the DeFocused control wanted to know, who steals him the focus

Index: vglConversation.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/vglConversation.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** vglConversation.pas	2001/01/12 21:10:35	1.1
--- vglConversation.pas	2001/01/16 20:39:16	1.2
***************
*** 3,7 ****
  interface
  uses Windows,classes,Graphics,SysUtils,
!      vglClasses,vglStdCtrls, glCanvas;
  
  const
--- 3,7 ----
  interface
  uses Windows,classes,Graphics,SysUtils,
!      vglClasses,vglStdCtrls, glCanvas, Trace;
  
  const
***************
*** 12,15 ****
--- 12,17 ----
  
  type
+   TVGLSelectOptionEvent = procedure(selected:integer) of object;
+ 
    TvglConvOptionsPicker = class(TvglComponent)
    protected
***************
*** 18,21 ****
--- 20,25 ----
      FText :TGLText;
      FAutoResize: boolean;
+     FOnSelectOption: TVGLSelectOptionEvent;
+     FSelectedItem: integer;
      function GetComponentType:string; override ;
      procedure DrawNumber(num,left,top:integer);
***************
*** 27,40 ****
--- 31,65 ----
      property Options :TStringList read FOptions write FOptions;
      property AutoResize :boolean read FAutoResize write FAutoResize;
+     property OnSelectOption :TVGLSelectOptionEvent read FOnSelectOption write FOnSelectOption;
+     property SelectedItem :integer read FSelectedItem;
  
      constructor Create(aName:string; aOwner:TvglComponent);
      destructor Destroy; override ;
      procedure DrawSelf(where:TRect); override ;
+     procedure ClearSelected;
    end;
  
+   TvglConversationOut = class(TvglComponent)
+   protected
+     FTextBox :TvglTextBox;
+     function GetComponentType:string; override ;
+     procedure SetBounds(const Value: TRect); override ;
+   public
+     constructor Create(aName:string; aOwner:TvglComponent);
+     destructor Destroy; override ;
+     procedure DrawSelf(where:TRect); override ;
+ 
+     procedure AddSpeech(str:String);
+   end;
+ 
  implementation
  
  { TvglConvOptionsPicker }
  
+ procedure TvglConvOptionsPicker.ClearSelected;
+ begin
+   FSelectedItem := -1;
+ end;
+ 
  constructor TvglConvOptionsPicker.Create(aName: string;
    aOwner: TvglComponent);
***************
*** 47,50 ****
--- 72,77 ----
    FText.SetColor(clBlack);
    FAutoResize := true;
+   FFocusable := true;
+   OnSelectOption := nil;
  end;
  
***************
*** 94,97 ****
--- 121,125 ----
    Canvas.Rectangle(where.left,where.top,where.right,where.bottom+5);
    Canvas.Solid := true;
+   Canvas.FillAlpha := FTotalAlpha - 0.5;
    Canvas.Rectangle(where.left,where.top,where.right,where.bottom+5);
    // display options
***************
*** 99,102 ****
--- 127,131 ----
    begin
  //    DrawNumber(i+1,where.left,where.top+i*22);
+     if i = FSelectedItem-1 then FText.SetColor(clYellow) else FText.SetColor(clBlack);
      Canvas.DrawTextLine(where.left+10,where.top+i*20,i,FText);
    end;
***************
*** 124,127 ****
--- 153,158 ----
  begin
    // TODO
+   FSelectedItem := num;
+   if assigned(FOnSelectOption) then OnSelectOption(num);
  end;
  
***************
*** 129,132 ****
--- 160,207 ----
  begin
    inherited Update(ElapsedTime);
+ end;
+ 
+ { TvglConversationOut }
+ 
+ procedure TvglConversationOut.AddSpeech(str: String);
+ begin
+   FTextBox.Lines.Add(str);
+   FTextBox.WordWrap;
+ end;
+ 
+ constructor TvglConversationOut.Create(aName: string;
+   aOwner: TvglComponent);
+ begin
+   inherited Create(aName,aOwner);
+   FAcceptsChildren := true;
+   FTextBox := TvglTextBox.Create(Name+'_TextBox',self);
+   FTextBox.AutoSize := false;
+   FTextBox.Bounds := Bounds;
+   FTextBox.Color := clBlack;
+   FAcceptsChildren := false;
+ end;
+ 
+ destructor TvglConversationOut.Destroy;
+ begin
+   inherited Destroy;
+ end;
+ 
+ procedure TvglConversationOut.DrawSelf(where: TRect);
+ begin
+   // pictures here?
+   Canvas.CurrentColor := clRed;
+   Canvas.FillAlpha := TotalAlpha - 0.5;
+   Canvas.Rectangle(where);
+ end;
+ 
+ function TvglConversationOut.GetComponentType: string;
+ begin
+   Result := 'ConversationOut';
+ end;
+ 
+ procedure TvglConversationOut.SetBounds(const Value: TRect);
+ begin
+   inherited SetBounds(Value);
+   FTextBox.Bounds := Rect(5,5,Width-5,Height-5);
  end;
  

Index: vglStdCtrls.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/vglStdCtrls.pas,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -r1.12 -r1.13
*** vglStdCtrls.pas	2001/01/12 21:10:35	1.12
--- vglStdCtrls.pas	2001/01/16 20:39:16	1.13
***************
*** 8,11 ****
--- 8,12 ----
    To do:
      * true word wrapping in TvglTextbox
+     * optimisation (don't draw unneeded lines in TvglTextBox)
  
    Notes:
***************
*** 297,300 ****
--- 298,302 ----
      FAutoSize :boolean;
      FProcessing :boolean; // used to flag that we should ignore line changes for a while
+     FTopLine: integer;
      function GetCaption: string;
      procedure SetCaption(const Value: string);
***************
*** 314,317 ****
--- 316,320 ----
      property Color :TColor write SetColor;
      property AutoSize :boolean read FAutoSize write FAutoSize;
+     property TopLine :integer read FTopLine write FTopLine; // used for scrolling - starts at 1
  
      constructor Create(aName:string; aOwner:TVGLComponent);
***************
*** 1639,1642 ****
--- 1642,1646 ----
    inherited Create(aName,aOwner);
    FAutoSize := true;
+   FTopLine := 1;
    FText := TGLText.Create('Arial');
    FText.Precache := true;
***************
*** 1652,1660 ****
  
  procedure TvglTextBox.DrawSelf(where: TRect);
  begin
    inherited DrawSelf(where);
    // CLIP
    Canvas.SetClipping(where);
!   Canvas.DrawText(where.Left,where.Top,FText);
  end;
  
--- 1656,1669 ----
  
  procedure TvglTextBox.DrawSelf(where: TRect);
+ var i:integer;
  begin
    inherited DrawSelf(where);
    // CLIP
    Canvas.SetClipping(where);
!   for i := TopLine-1 to FText.Lines.Count-1 do
!   begin
!     // optimise here!
!     Canvas.DrawText(where.left,where.top,FText)
!   end;
  end;
  
***************
*** 1727,1731 ****
    begin
      //TraceString('scanning line: '+FText.Lines[i]+'   ['+IntToStr(FText.Width[i])+'/'+IntToStr(Width)+']');
!     if FText.Width[i] > Width-5 then { 5 is a tolerance value, increase to reduce chance of letter clipping }
      begin
        // we need to locate where the line needs breaking
--- 1736,1740 ----
    begin
      //TraceString('scanning line: '+FText.Lines[i]+'   ['+IntToStr(FText.Width[i])+'/'+IntToStr(Width)+']');
!     if FText.Width[i] > Width then { 5 is a tolerance value, increase to reduce chance of letter clipping }
      begin
        // we need to locate where the line needs breaking
***************
*** 1906,1910 ****
    // draw backpanel
    Canvas.CurrentColor := clBlack;
!   Canvas.FillAlpha := 0.5; // BUG: should be partially transparent, but isn't ?
    Canvas.Rectangle(Manager.Desktop.ScreenBounds);
    // draw "window"
--- 1915,1920 ----
    // draw backpanel
    Canvas.CurrentColor := clBlack;
!   Canvas.FillAlpha := TotalAlpha - 0.5; // BUG: should be partially transparent, but isn't ?
!   Canvas.Solid := true;
    Canvas.Rectangle(Manager.Desktop.ScreenBounds);
    // draw "window"