pythianproject-cvsmail

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

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

Modified Files:
	StartupForm.pas vglClasses.pas vglEdits.pas vglStdCtrls.pas 
Log Message:
added drag'n'drop, alerts -mike

Index: StartupForm.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/StartupForm.pas,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -r1.12 -r1.13
*** StartupForm.pas	2001/01/02 21:46:20	1.12
--- StartupForm.pas	2001/01/06 19:52:48	1.13
***************
*** 48,53 ****
      procedure ButtonOnclick(Sender:TObject);
      procedure CB1OnChange(Sender:TObject);
! 
      procedure ManagerOnFocusChange(Sender:TObject);
  
      procedure go;
--- 48,55 ----
      procedure ButtonOnclick(Sender:TObject);
      procedure CB1OnChange(Sender:TObject);
!     procedure SBOnChange(Sender: TObject; ScrollCode: TvglScrollCode; var ScrollPos: Integer);
      procedure ManagerOnFocusChange(Sender:TObject);
+     procedure DragBoxOnDragOver(what:TvglDragObject; var Accept:boolean);
+     procedure DragBoxOnDragDrop(what:TvglDragObject);
  
      procedure go;
***************
*** 109,113 ****
  begin
    // test code
-   InterfaceManager.Desktop.TestText.Text := IntToStr(X)+','+IntToStr(Y)+':  '+InterfaceManager.Desktop.GetComponentAt(X,Y).Name;
    InterfaceManager.MouseMove(X,Y);
  end;
--- 111,114 ----
***************
*** 212,218 ****
  
    Label1 := TvglTextBox.Create('Label1',InterfaceManager.Desktop);
!   Label1.Top := 192;
    Label1.Left := 468;
!   Label1.Color := clBlack;
    Label1.Font := 'Courier New';
    Label1.Caption := 'FOCUS LOST!';
--- 213,219 ----
  
    Label1 := TvglTextBox.Create('Label1',InterfaceManager.Desktop);
!   Label1.Top := 220;
    Label1.Left := 468;
!   Label1.Color := clWhite;
    Label1.Font := 'Courier New';
    Label1.Caption := 'FOCUS LOST!';
***************
*** 224,229 ****
    SB.Height := 13;
    SB.Width := 150;
!   SB.Position := 15;
!   SB.PageSize := 10;
  
    LB := TvglSimpleListBox.Create('SimpleListBoxTest', InterfaceManager.Desktop);
--- 225,233 ----
    SB.Height := 13;
    SB.Width := 150;
!   SB.Max := 255;
!   SB.Min := 0;
!   SB.Position := 255;
!   SB.PageSize := 50;
!   SB.OnScroll := SBOnChange;
  
    LB := TvglSimpleListBox.Create('SimpleListBoxTest', InterfaceManager.Desktop);
***************
*** 253,256 ****
--- 257,262 ----
    DragBox := TvglDragBox.Create('DragBox1',InterfaceManager.Desktop);
    DragBox.Bounds := Rect(500,400,550,450);
+   DragBox.OnDragOver := DragBoxOnDragOver;
+   DragBox.OnDragDrop := DragBoxOnDragDrop;
  
    InterfaceManager.SetNewFocus(LB);
***************
*** 286,289 ****
--- 292,312 ----
        Label1.Lines.Text := 'FOCUS LOST!';
    end;
+ end;
+ 
+ procedure TfrmStartup.DragBoxOnDragOver(what: TvglDragObject;
+   var Accept: boolean);
+ begin
+   if what.from = Image1 then accept := true else accept := false;
+ end;
+ 
+ procedure TfrmStartup.SBOnChange(Sender: TObject; ScrollCode: TvglScrollCode;
+     var ScrollPos: Integer);
+ begin
+   Panel1.TotalAlpha := (1 / 255) * ScrollPos;
+ end;
+ 
+ procedure TfrmStartup.DragBoxOnDragDrop(what: TvglDragObject);
+ begin
+   InterfaceManager.VGLAlert('You dropped object ['+what.from.Name+'] onto the draggable box! ABCDEFGHIJKLIMNOPQRSTUVWXYZ - this is a test message to force auto alert resizing');
  end;
  

Index: vglClasses.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/vglClasses.pas,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -r1.10 -r1.11
*** vglClasses.pas	2001/01/02 21:46:20	1.10
--- vglClasses.pas	2001/01/06 19:52:48	1.11
***************
*** 34,41 ****
  
      - Pretty much everything! :)
-     - Bitmapped controls
      - Resource sharing (done except reference counting/garbage collection)
      - Name generation/usage (!)
!     - Display list optimizations
      - Components
  
--- 34,40 ----
  
      - Pretty much everything! :)
      - Resource sharing (done except reference counting/garbage collection)
      - Name generation/usage (!)
!     - Display list optimizations (don't appear to have any effect so uncompleted)
      - Components
  
***************
*** 49,55 ****
      - Global Mouse and Keyboard events
      - Updating (many uses - f.e. Timer)
  
    History:
!     - 13/12/00 - the code size is about 50kB (vglClasses.Pas), all files
        have now about 83kB (vglClasses.pas, vglStdCtrls.pas, vglCheckBox.pas) :)
  
--- 48,60 ----
      - Global Mouse and Keyboard events
      - Updating (many uses - f.e. Timer)
+     - Bitmapped controls
+ 
+   Bugs:
+     - Severe bug with TvglAlert memory management (cannot be released without causing an External Exception in MouseMove)
+       currently causes memory leak :(
  
    History:
!     - January 2001: Drag'n'drop added. Alert box added
!     - 13th December 2000: the code size is about 50kB (vglClasses.Pas), all files
        have now about 83kB (vglClasses.pas, vglStdCtrls.pas, vglCheckBox.pas) :)
  
***************
*** 108,111 ****
--- 113,117 ----
       Graphics, // for colour constants
       OpenGL,
+      Trace,
       GLCanvas;
  
***************
*** 115,119 ****
    VGL_SKIN_1 = 'skin1.png'; // alpha skin
    VGL_SKINRECT_BACKGROUND :TRect = (Left:3;Top:51;Right:134;Bottom:175);
-   VGL_SKINRECT_BUTTON :TRect = (Left:3;Top:3;Right:153;Bottom:48);
    VGL_SKINRECT_MOUSECURSOR :TRect = (Left:3;Top:175;Right:35;Bottom:207);
  
--- 121,124 ----
***************
*** 151,154 ****
--- 156,163 ----
    end;
  
+   TvglDragObject = class; // forward
+ 
+   TVGLDragOverEvent = procedure(what:TvglDragObject; var Accept:boolean) of object;
+   TVGLDragDropEvent = procedure(what:TvglDragObject) of object;
    TVGLMouseButtonEvent = procedure(mb,x,y:integer) of object;
    TVGLMouseMoveEvent = procedure(x,y:integer) of object;
***************
*** 173,190 ****
  
  
- 
    // an abstract class from which other components are derived
    TvglComponent = class(TvglBase)
-   private
-     FOnGlobalKeyUp: TVGLKeyboardEvent;
-     FOnKeyDown: TVGLKeyboardEvent;
-     FOnKeyUp: TVGLKeyboardEvent;
-     FOnGlobalKeyDown: TVGLKeyboardEvent;
-     FCached: boolean;
-     procedure SetOnGlobalKeyDown(const Value: TVGLKeyboardEvent);
-     procedure SetOnGlobalKeyUp(const Value: TVGLKeyboardEvent);
-     procedure SetOnKeyDown(const Value: TVGLKeyboardEvent);
-     procedure SetOnKeyUp(const Value: TVGLKeyboardEvent);
-     function KeyDataToShiftState(KeyData: Longint): TShiftState;
    protected
      FFocusable: Boolean;
--- 182,187 ----
***************
*** 200,203 ****
--- 197,203 ----
      FSavedMouseDown :TvglComponent;
      FTextured :boolean; // use the skin? or use vector drawing
+     FVisible :boolean;
+     FReleased :boolean; // when true will be freed by the interface manager next cycle
+                         // use when component needs to be destroyed but from itself
  
      // cache vars here
***************
*** 212,222 ****
      FOnGlobalMouseUp, FOnGlobalMouseDown :TVGLMouseButtonEvent;
      FOnGlobalMouseMove :TVGLMouseMoveEvent;
! 
      FOnMouseEntry,FOnMouseExit,FOnMouseClick :TNotifyEvent;
      FOnEnter: TVGLEntryExitEvent;
      FOnExit: TVGLEntryExitEvent;
      FOnChildAdd:TVGLChildEvent;
!     FVisible :boolean;
! 
      procedure FreeChildren;
  
--- 212,226 ----
      FOnGlobalMouseUp, FOnGlobalMouseDown :TVGLMouseButtonEvent;
      FOnGlobalMouseMove :TVGLMouseMoveEvent;
!     FOnDragOver :TVGLDragOverEvent;
      FOnMouseEntry,FOnMouseExit,FOnMouseClick :TNotifyEvent;
      FOnEnter: TVGLEntryExitEvent;
      FOnExit: TVGLEntryExitEvent;
      FOnChildAdd:TVGLChildEvent;
!     FOnGlobalKeyUp: TVGLKeyboardEvent;
!     FOnKeyDown: TVGLKeyboardEvent;
!     FOnKeyUp: TVGLKeyboardEvent;
!     FOnGlobalKeyDown: TVGLKeyboardEvent;
!     FCached: boolean;
!     FOnDragDrop: TVGLDragDropEvent;
      procedure FreeChildren;
  
***************
*** 247,251 ****
--- 251,265 ----
      procedure SetOnEnter(const Value: TVGLEntryExitEvent);
      procedure SetOnExit(const Value: TVGLEntryExitEvent);
+     procedure SetOnGlobalKeyDown(const Value: TVGLKeyboardEvent);
+     procedure SetOnGlobalKeyUp(const Value: TVGLKeyboardEvent);
+     procedure SetOnKeyDown(const Value: TVGLKeyboardEvent);
+     procedure SetOnKeyUp(const Value: TVGLKeyboardEvent);
+     function KeyDataToShiftState(KeyData: Longint): TShiftState;
  
+ 
+     // drag'n'drop
+     function CanAcceptDragObject(dragObject :TvglDragObject):boolean; virtual ; // is overridden by descendants to accept drag objects
+     procedure DragDrop(dragObject:TvglDragObject); virtual ; // called when an object is dragged
+ 
      // focusing
      function GetFocused: Boolean;
***************
*** 287,290 ****
--- 301,305 ----
      constructor Create(aName:string; AOwner:TvglComponent);
      destructor Destroy; override ; // destroying an object also destroys its children
+     procedure Release;
  
      procedure MoveTo(x,y:integer);
***************
*** 337,340 ****
--- 352,357 ----
      property OnEnter: TVGLEntryExitEvent read FOnEnter write SetOnEnter;
      property OnExit: TVGLEntryExitEvent read FOnExit write SetOnExit;
+     property OnDragOver: TVGLDragOverEvent read FOnDragOver write FOnDragOver;
+     property OnDragDrop :TVGLDragDropEvent read FOnDragDrop write FOnDragDrop;
    end;
  
***************
*** 343,347 ****
      DragOrigin :TPoint;
      CurPoint :TPoint;
!     constructor Create(aDragOrigin:TPoint);
      procedure StartDrag; virtual ;
      procedure EndDrag; virtual ;
--- 360,367 ----
      DragOrigin :TPoint;
      CurPoint :TPoint;
!     from :TvglComponent;
!     Tag :integer;
!     constructor Create(aFrom:TvglComponent; aDragOrigin:TPoint);
!     destructor Destroy; override ;
      procedure StartDrag; virtual ;
      procedure EndDrag; virtual ;
***************
*** 359,363 ****
    TvglDragCopyObject = class(TvglDragObject)
      CopyComponent :TvglComponent;
!     constructor Create(aDragOrigin:TPoint; aCopyComponent:TvglComponent);
    end;
  
--- 379,383 ----
    TvglDragCopyObject = class(TvglDragObject)
      CopyComponent :TvglComponent;
!     constructor Create(aFrom:TvglComponent; aDragOrigin:TPoint; aCopyComponent:TvglComponent);
    end;
  
***************
*** 409,412 ****
--- 429,433 ----
    end;
  
+ 
    TvglDraggableImage = class(TvglImage)
    protected
***************
*** 471,474 ****
--- 492,497 ----
      NewMouseList, OldMouseList, TempMouseList :TvglObjList;
  
+     TestData :string;
+ 
      procedure SetOnCreateDesktop(const Value: TCreateDesktopEvent);
  
***************
*** 483,486 ****
--- 506,513 ----
      procedure UpdateDragObjects(newPos:TPoint);
      procedure OverlayDragCopyObjects;
+     procedure ReleaseDragObjects;
+     function DragObjectOver(component:TvglComponent):TvglDragObject;
+ 
+     procedure VGLAlertFree(Sender:TObject);
    public
      property Focused: TvglComponent read FFocusedComponent;
***************
*** 501,504 ****
--- 528,532 ----
      procedure DrawAll; virtual;
      procedure DrawBorder(where:TRect; FImage:TGLBitmap); virtual ;
+     procedure VGLAlert(msg:string); // displays a general purpose alert
  
      // resource management
***************
*** 525,529 ****
--- 553,559 ----
  procedure CopyList(src,dest:TList);
  function PointInRectInAcc(R: TRect; X, Y, XINACC, YINACC: Integer): Boolean;
+ 
  implementation
+ uses vglStdCtrls;
  
  function PointInRectInAcc(R: TRect; X, Y, XINACC, YINACC: Integer): Boolean;
***************
*** 641,649 ****
  
  procedure TvglComponent.FreeChildren;
- var a:integer;
  begin
!   a := 0;
!   while a < FChildren.Count do
!     FChildren[a].Free;
  end;
  
--- 671,679 ----
  
  procedure TvglComponent.FreeChildren;
  begin
!   while FChildren.Count > 0 do
!   begin
!     FChildren[0].Free;
!   end;
  end;
  
***************
*** 763,769 ****
  var i:integer;
  begin
    i := FChildren.IndexOf(child);
!   if i = -1 then raise EVGLException.Create('TvglComponent.RemoveChild: Unknown child component');
!   FChildren.Delete(i);  
  end;
  
--- 793,802 ----
  var i:integer;
  begin
+   TraceString('REMOVECHILD');
+   if not assigned(child) then raise EVGLException.Create('TvglComponent.RemoveChild: NIL parameter');
+   TraceString('   for '+child.name);
    i := FChildren.IndexOf(child);
!   if i = -1 then raise EVGLException.Create('TvglComponent.RemoveChild: Unknown child component ['+child.name+']');
!   FChildren.Delete(i);
  end;
  
***************
*** 877,880 ****
--- 910,923 ----
      if FChildren[i] <> nil then
        FChildren[i].Update(ElapsedTime);
+   i := 0;
+   while i < FChildren.Count do
+   begin
+     if FChildren[i].FReleased then
+     begin
+       TraceString('Releasing: '+Fchildren[i].name);
+       FChildren[i].Free;
+     end else
+     inc(i);
+   end;
  end;
  
***************
*** 1111,1116 ****
--- 1154,1175 ----
  end;
  
+ function TvglComponent.CanAcceptDragObject(
+   dragObject: TvglDragObject): boolean;
+ begin
+   if assigned(FOnDragOver) then
+     FOnDragOver(dragObject,result)
+   else Result := false;
+ end;
  
+ procedure TvglComponent.DragDrop(dragObject: TvglDragObject);
+ begin
+   if assigned(FOnDragDrop) then FOnDragDrop(dragObject);
+ end;
  
+ procedure TvglComponent.Release;
+ begin
+   FReleased := true;
+ end;
+ 
  { TvglObjList }
  
***************
*** 1140,1144 ****
    DefaultTextured := true;
    FDragObjects := TList.Create;
! 
    FLeft := 0; FTop := 0;
  
--- 1199,1203 ----
    DefaultTextured := true;
    FDragObjects := TList.Create;
!   TestData := '';
    FLeft := 0; FTop := 0;
  
***************
*** 1159,1163 ****
--- 1218,1227 ----
  
  procedure TvglInterfaceManager.EndDrag(dragObj: TvglDragObject);
+ var c:TvglComponent;
  begin
+   c := Desktop.GetComponentAt(dragObj.CurPoint.X,dragObj.CurPoint.Y);
+   if assigned(c) then
+     if c.CanAcceptDragObject(dragObj) then
+       c.DragDrop(dragObj);
    dragObj.EndDrag;
    if FDragObjects.IndexOf(DragObj) <> -1 then
***************
*** 1283,1286 ****
--- 1347,1352 ----
    i:integer;
    t:integer;
+   d:TvglDragObject;
+   c:TvglComponent;
  begin
    // send event
***************
*** 1327,1330 ****
--- 1393,1406 ----
    // do drag ops
    UpdateDragObjects(Point(X,Y));
+   c := Desktop.GetComponentAt(X,Y);
+   d := DragObjectOver(c);
+   if assigned(d) then
+     if c.CanAcceptDragObject(d) then
+       TestData := ' |accepts|'
+     else testData :=  ' |no accept|'
+   else testdata := '';
+ 
+   // update test label
+   Desktop.TestText.Text := IntToStr(X)+','+IntToStr(Y)+':  '+Desktop.GetComponentAt(X,Y).Name + TestData;
  end;
  
***************
*** 1334,1337 ****
--- 1410,1414 ----
    Desktop.DoOnMouseUp(Button, x, y);
    Desktop.DoOnGlobalMouseUp(button, X, Y);
+   ReleaseDragObjects;
  end;
  
***************
*** 1595,1603 ****
  { TvglDragObject }
  
! constructor TvglDragObject.Create(aDragOrigin: TPoint);
  begin
    inherited Create;
    DragOrigin := aDragOrigin;
    CurPoint := DragOrigin;
  end;
  
--- 1672,1688 ----
  { TvglDragObject }
  
! constructor TvglDragObject.Create(aFrom:TvglComponent; aDragOrigin: TPoint);
  begin
    inherited Create;
    DragOrigin := aDragOrigin;
    CurPoint := DragOrigin;
+   From := aFrom;
+ end;
+ 
+ 
+ destructor TvglDragObject.Destroy;
+ begin
+   inherited;
+   From := nil; // release from object
  end;
  
***************
*** 1643,1647 ****
  
    if assigned(FDragObj) then raise Exception.Create('TvglDragBox.doOnMouseDown: cannot drag more than once at a time!');
!   FDragObj := TvglDragBroadcasterObject.Create(Point(X,Y));
    FDragObj.OnDrag := DragHandler;
    Manager.StartDrag(FDragObj);
--- 1728,1732 ----
  
    if assigned(FDragObj) then raise Exception.Create('TvglDragBox.doOnMouseDown: cannot drag more than once at a time!');
!   FDragObj := TvglDragBroadcasterObject.Create(Self,Point(X,Y));
    FDragObj.OnDrag := DragHandler;
    Manager.StartDrag(FDragObj);
***************
*** 1680,1687 ****
  { TvglDragCopyObject }
  
! constructor TvglDragCopyObject.Create(aDragOrigin: TPoint;
    aCopyComponent: TvglComponent);
  begin
!   inherited Create(aDragOrigin);
    CopyComponent := aCopyComponent;
  end;
--- 1765,1772 ----
  { TvglDragCopyObject }
  
! constructor TvglDragCopyObject.Create(aFrom:TvglComponent; aDragOrigin: TPoint;
    aCopyComponent: TvglComponent);
  begin
!   inherited Create(aFrom,aDragOrigin);
    CopyComponent := aCopyComponent;
  end;
***************
*** 1693,1697 ****
    inherited;
    if assigned(FDragObj) then FDragObj.Free;
!   FDragObj := TvglDragCopyObject.Create(Point(x,y),self);
    Manager.StartDrag(FDragObj);
  end;
--- 1778,1782 ----
    inherited;
    if assigned(FDragObj) then FDragObj.Free;
!   FDragObj := TvglDragCopyObject.Create(self,Point(x,y),self);
    Manager.StartDrag(FDragObj);
  end;
***************
*** 1722,1725 ****
--- 1807,1851 ----
          CopyComponent.Bounds := b;
        end;
+ end;
+ 
+ function TvglInterfaceManager.DragObjectOver(
+   component: TvglComponent): TvglDragObject;
+ var i:integer;
+ begin
+   // scan the drag objects to find if any of them intersect with this object
+   Result := nil;
+   for i := 0 to FDragObjects.Count-1 do
+     if PointInRectInAcc(component.Bounds,TvglDragObject(FDragObjects[i]).CurPoint.X,TvglDragObject(FDragObjects[i]).CurPoint.Y,0,0) then
+       Result := TvglDragObject(FDragObjects[i]);
+ end;
+ 
+ procedure TvglInterfaceManager.ReleaseDragObjects;
+ var i:integer;
+ begin
+   // end all drag objects
+   while FDragObjects.Count > 0 do
+   begin
+     EndDrag(TvglDragObject(FDragObjects[0]));
+     TvglDragObject(FDragObjects[0]).Free;
+     FDragObjects.Delete(0);
+   end;
+ end;
+ 
+ procedure TvglInterfaceManager.VGLAlert(msg: string);
+ var alert:TvglAlert;
+ begin
+   TraceString(' [mark 1] - VGLAlert');
+   alert := TvglAlert.Create('Alert',Desktop,msg);
+   TraceString(' [mark 2] - Created');
+   alert.OnClose := VGLAlertFree;
+   TraceString(' [mark 3] - about to show');
+   alert.Show;
+   TraceString(' [mark 4] - shown');
+ end;
+ 
+ procedure TvglInterfaceManager.VGLAlertFree(Sender: TObject);
+ begin
+   TraceString('[destroy]');
+   //TvglAlert(sender).Release; // WARNING: SEVERE BUG HERE!!!!
  end;
  

Index: vglEdits.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/vglEdits.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** vglEdits.pas	2000/12/17 21:03:00	1.2
--- vglEdits.pas	2001/01/06 19:52:48	1.3
***************
*** 399,402 ****
--- 399,403 ----
    Cnt, a, i: Integer;
  begin
+   Result := -1;
    if not PointInRect(where, X, Y) then
      Exit;

Index: vglStdCtrls.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/vglStdCtrls.pas,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -r1.9 -r1.10
*** vglStdCtrls.pas	2001/01/02 21:46:20	1.9
--- vglStdCtrls.pas	2001/01/06 19:52:48	1.10
***************
*** 6,10 ****
--- 6,14 ----
    - Michael Hearn (mh...@su...)
  
+   To do:
+     * true word wrapping in TvglTextbox
+ 
    Notes:
+     * Added TvglAlert + enhanced text box 6th January 2001
      * Changed scrollbar to use skins - 11th December 2000
      * Changed listbox to use one TGLText object for increased efficiency,
***************
*** 32,36 ****
  
  interface
! uses Windows, GLCanvas, Classes, vglClasses, Graphics, SysUtils;
  
  const
--- 36,40 ----
  
  interface
! uses Windows, GLCanvas, Classes, vglClasses, Graphics, SysUtils{, Trace};
  
  const
***************
*** 40,43 ****
--- 44,48 ----
    VGL_SKINRECT_SCROLLBUTTON_DOWN :TRect = (Left:59;Top:183;Right:72;Bottom:202);
    VGL_SKINRECT_SCROLL_TAB :TRect = (Left:93;Top:188;Right:119;Bottom:201);
+   VGL_SKINRECT_BUTTON :TRect = (Left:3;Top:3;Right:153;Bottom:48);
  
    VGL_SKINRECT_CHECKBOXSET: TRect = (Left: 3; Top: 208; Right: 16; Bottom: 220);
***************
*** 288,304 ****
  
    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;
--- 293,311 ----
  
    TvglTextBox = class(TvglComponent)
    protected
      FText :TGLText;
+     FAutoSize :boolean;
+     FProcessing :boolean; // used to flag that we should ignore line changes for a while
      function GetCaption: string;
      procedure SetCaption(const Value: string);
      function GetComponentType:string; override ;
      function GetLines: TStringList;
+     function GetFont: string;
+     procedure SetFont(const Value: string);
+     procedure SetColor(const Value: TColor);
  
      procedure LinesOnChange(Sender:TObject);
      procedure UpdateBounds;
+     procedure DrawSelf(where:TRect); override ;
    public
      property Lines:TStringList read GetLines;
***************
*** 306,313 ****
      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;
  
--- 313,321 ----
      property Font :string read GetFont write SetFont;
      property Color :TColor write SetColor;
+     property AutoSize :boolean read FAutoSize write FAutoSize;
  
      constructor Create(aName:string; aOwner:TVGLComponent);
      destructor Destroy; override ;
!     procedure WordWrap; // forces text to fit to bounds as much as possible
    end;
  
***************
*** 339,342 ****
--- 347,372 ----
    end;
  
+   TvglAlert = class(TvglComponent)
+   protected
+     FAlertResult: integer;
+     FBoxBounds :TRect;
+     FImage :TGLBitmap;
+     FOKButton :TvglButton;
+     FTextBox :TvglTextBox;
+     FOnClose: TNotifyEvent;
+     function GetComponentType:string; override ;
+     procedure OKOnClick(Sender:TObject);
+   public
+     property MessageTextBox :TvglTextBox read FTextBox;
+     property AlertResult :integer read FAlertResult;
+     property OnClose :TNotifyEvent read FOnClose write FOnClose;
+ 
+     constructor Create(aName:string; AOwner:TvglComponent; Msg:string);
+     destructor Destroy; override ;
+     procedure Show;
+     procedure DrawSelf(where:TRect); override ;
+   end;
+ 
+ 
  implementation
  uses
***************
*** 1553,1559 ****
--- 1583,1591 ----
  begin
    inherited Create(aName,aOwner);
+   FAutoSize := true;
    FText := TGLText.Create('Arial');
    FText.Precache := true;
    FText.Lines.OnChange := LinesOnChange;
+   FProcessing := false;
  end;
  
***************
*** 1567,1570 ****
--- 1599,1604 ----
  begin
    inherited DrawSelf(where);
+   // CLIP
+   Canvas.SetClipping(where);
    Canvas.DrawText(where.Left,where.Top,FText);
  end;
***************
*** 1594,1598 ****
    // update bounds
    FText.LinesOnChange(Sender); //call text handler to prevent overriding
!   UpdateBounds;
  end;
  
--- 1628,1633 ----
    // update bounds
    FText.LinesOnChange(Sender); //call text handler to prevent overriding
!   if not FProcessing then
!     UpdateBounds;
  end;
  
***************
*** 1617,1628 ****
    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;
  
  { TvglEdit }
  
--- 1652,1703 ----
    longest:integer;
  begin
!   if FAutoSize then
!   begin
!     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;
  end;
  
+ procedure TvglTextBox.WordWrap;
+ var
+   i,j:integer;
+   s,r:string;
+ begin
+   i := 0;
+   FProcessing := true;
+   while i < FText.Lines.Count do
+   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
+       //TraceString('line '+IntToStr(i)+' needs breaking: '+FText.Lines[i]);
+       s := '';
+       for j := 1 to Length(FText.Lines[i]) do
+       begin
+         s := s + FText.Lines[i][j];
+         if qtGetStringWidth(FText.QT,s) >= Width then
+         begin
+           // break the line here
+           r := Copy(FText.Lines[i],j+1,Length(FText.Lines[i])); // r now has the rest of the line in
+           //TraceString('   line '+IntToStr(i)+' replaced with '+s);
+           FText.Lines[i] := s;
+           if i+1 = FText.Lines.Count then
+             FText.Lines.Add(trim(r))
+           else FText.Lines.Insert(i+1,trim(r));
+           //TraceString('   [inserted at '+IntToStr(i+1)+']'+r);
+           break;
+         end;
+       end;
+     end;
+     inc(i);
+   end;
+   if AutoSize then Height := FText.Lines.Count*FText.QT.GridSquareHeight; // make correct height
+   FProcessing := false;
+ end;
+ 
  { TvglEdit }
  
***************
*** 1721,1724 ****
--- 1796,1877 ----
    if CursorY > FLines.Count then CursorY := FLines.Count;
    if CursorX > Length(Flines[CursorY-1]) then CursorX := Length(Flines[CursorY-1]);
+ end;
+ 
+ { TvglAlert }
+ 
+ constructor TvglAlert.Create(aName: string; AOwner: TvglComponent; Msg:string);
+ var ALERT_WIDTH :integer;
+     ALERT_HEIGHT :integer;
+ begin
+   inherited Create(aName,aOwner);
+   ALERT_WIDTH := 300;
+   Visible := false;
+   FBounds := Manager.Desktop.Bounds;
+   FAlertResult := -1;
+   FImage := TGLBitmap(Manager.GetResource(VGL_SKIN_1));
+ 
+   ALERT_HEIGHT := 100; //FTextBox.Height + 10 + (VGL_SKINRECT_BUTTON.Bottom-VGL_SKINRECT_BUTTON.Top);
+   FBoxBounds := Rect(Manager.ScreenBounds.Right div 2 - (ALERT_WIDTH div 2),Manager.ScreenBounds.Bottom div 2 - (ALERT_HEIGHT div 2),Manager.ScreenBounds.Right div 2 + (ALERT_WIDTH div 2),Manager.ScreenBounds.Bottom div 2 + (ALERT_HEIGHT div 2));
+ 
+   FOKButton := TvglButton.Create('vglAlert_OKButton',Self);
+   FOKButton.Caption := '|O|K';
+   FOKButton.HotKey := Ord('O');
+   FOKButton.HasHotkey := true;
+   FOKButton.Bounds := Rect((Width div 2) - (VGL_SKINRECT_BUTTON.Right-VGL_SKINRECT_BUTTON.Left) div 2,FBoxBounds.Bottom - 5 - (VGL_SKINRECT_BUTTON.Bottom-VGL_SKINRECT_BUTTON.Top),0,0);
+   FOKButton.OnClick := OKOnClick;
+ 
+   FTextBox := TvglTextbox.Create('vglAlert_TextBox',Self);
+   FTextBox.AutoSize := false;
+   FTextBox.Bounds := Rect(FBoxBounds.Left+10,FBoxBounds.Top+10,FBoxBounds.Right-10,FBoxBounds.Bottom-FOKButton.Height-10);
+   FTextbox.Lines.Text := msg;
+   FTextBox.Color := clBlack;
+   //tracestring('* height before = '+inttostr(Ftextbox.height));
+   FTextBox.AutoSize := true;
+   FTextBox.WordWrap;
+   //tracestring('* height after = '+inttostr(Ftextbox.height));
+   //tracestring('* text after = '+ftextbox.lines.text);
+   // recalculate
+   ALERT_HEIGHT := 20 + FOKButton.Height + FTextBox.Height;
+   FBoxBounds := Rect(Manager.ScreenBounds.Right div 2 - (ALERT_WIDTH div 2),Manager.ScreenBounds.Bottom div 2 - (ALERT_HEIGHT div 2),Manager.ScreenBounds.Right div 2 + (ALERT_WIDTH div 2),Manager.ScreenBounds.Bottom div 2 + (ALERT_HEIGHT div 2));
+   FOKButton.Bounds := Rect((Width div 2) - (VGL_SKINRECT_BUTTON.Right-VGL_SKINRECT_BUTTON.Left) div 2,FBoxBounds.Bottom - 5 - (VGL_SKINRECT_BUTTON.Bottom-VGL_SKINRECT_BUTTON.Top),0,0);
+   FTextBox.Bounds := Rect(FBoxBounds.Left+10,FBoxBounds.Top+10,FBoxBounds.Right-10,FBoxBounds.Bottom-FOKButton.Height-10);
+ end;
+ 
+ destructor TvglAlert.Destroy;
+ begin
+   FImage := nil;
+   inherited;
+ end;
+ 
+ procedure TvglAlert.DrawSelf(where: TRect);
+ begin
+   inherited DrawSelf(where);
+   where := FBoxBounds;
+   // draw backpanel
+   Canvas.CurrentColor := clBlack;
+   Canvas.FillAlpha := 0.5;
+   Canvas.Rectangle(Manager.Desktop.ScreenBounds);
+   // draw "window"
+   Canvas.ImageAlpha := TotalAlpha;
+   Canvas.TileBitmapSubRect(where,VGL_SKINRECT_BACKGROUND,FImage);
+   Manager.DrawBorder(where,FImage);
+ end;
+ 
+ function TvglAlert.GetComponentType: string;
+ begin
+   Result := 'Alert';
+ end;
+ 
+ procedure TvglAlert.OKOnClick(Sender: TObject);
+ begin
+   // user wants to cancel alert so tidy up
+   FAlertResult := 0;
+   Visible := false;
+   if assigned(FOnClose) then FOnClose(self);
+ end;
+ 
+ procedure TvglAlert.Show;
+ begin
+   Visible := true;
  end;