Menu
▾
▴
pythianproject-cvsmail — receives automatic CVS updates
You can subscribe to this list here.
| 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
|
|
From: Michael H. <mh...@us...> - 2001-08-08 18:30:58
|
Update of /cvsroot/pythianproject/PythianProject/Source In directory usw-pr-cvs1:/tmp/cvs-serv23949/Source Removed Files: units.txt Log Message: removed old versions of files -mike --- units.txt DELETED --- |
|
From: Michael H. <mh...@us...> - 2001-08-08 18:30:58
|
Update of /cvsroot/pythianproject/PythianProject/Bin In directory usw-pr-cvs1:/tmp/cvs-serv23949/Bin Removed Files: Credits.txt ErrorLog.txt TimeLog.txt aifile.aiml ailibgen.aiml bass.dll data.cml python15.dll readme.txt testscript.py whrandom.py Log Message: removed old versions of files -mike --- Credits.txt DELETED --- --- ErrorLog.txt DELETED --- --- TimeLog.txt DELETED --- --- aifile.aiml DELETED --- --- ailibgen.aiml DELETED --- --- bass.dll DELETED --- --- data.cml DELETED --- --- python15.dll DELETED --- --- readme.txt DELETED --- --- testscript.py DELETED --- --- whrandom.py DELETED --- |
|
From: Michael H. <mh...@us...> - 2001-08-08 18:30:58
|
Update of /cvsroot/pythianproject/PythianProject In directory usw-pr-cvs1:/tmp/cvs-serv23949 Removed Files: readme.txt to-do.txt Log Message: removed old versions of files -mike --- readme.txt DELETED --- --- to-do.txt DELETED --- |
|
From: Luiz P. <lui...@us...> - 2001-01-17 13:08:07
|
Update of /cvsroot/pythianproject/Prototypes/SkillEditor In directory usw-pr-cvs1:/tmp/cvs-serv1157 Modified Files: SkillEditorCode.pas Log Message: no message Index: SkillEditorCode.pas =================================================================== RCS file: /cvsroot/pythianproject/Prototypes/SkillEditor/SkillEditorCode.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -r1.1 -r1.2 *** SkillEditorCode.pas 2001/01/16 04:05:23 1.1 --- SkillEditorCode.pas 2001/01/17 13:08:05 1.2 *************** *** 438,442 **** TdDoc.ParentNode.RemoveChild(TdDoc); TreeView.Selected.Parent.Item[TreeView.Selected.Index].Delete; ! TreeView.Selected := TreeView.Selected.Parent; end; --- 438,442 ---- TdDoc.ParentNode.RemoveChild(TdDoc); TreeView.Selected.Parent.Item[TreeView.Selected.Index].Delete; ! //TreeView.Selected := TreeView.Selected.Parent; end; |
|
From: Luiz P. <lui...@us...> - 2001-01-16 22:42:23
|
Update of /cvsroot/pythianproject/Prototypes/SkillEditor
In directory usw-pr-cvs1:/tmp/cvs-serv1060
Modified Files:
skills.xml SkillFormulaEditorCode.pas
Log Message:
no message
Index: skills.xml
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/SkillEditor/skills.xml,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** skills.xml 2001/01/16 04:05:23 1.1
--- skills.xml 2001/01/16 22:41:43 1.2
***************
*** 1,2 ****
<?xml version="1.0" encoding="UTF-8"?>
! <Skilllist><General name="Combat"><General name="Weapons"><General name="Sword"><Skill name="Short Sword" formula="[x=30][y=55][Endurance (Running)=30][Memory=45]" gaintrain="[x=30][Induction=40][Endurance (Health)=55]" gainuse="[x=35][Comeliness=45]" losegainwithouttrain="[x=66][Wit=0][Endurance (Health)=10]" losewithoutuse="[x=20][Induction=30]" timestogeneral="0"></Skill><Skill name="Long Sword" formula="" gaintrain="" gainuse="" losegainwithouttrain="" losewithoutuse="" timestogeneral="0"></Skill></General><General name="Axe"><Skill name="Short Axe" formula="" gaintrain="" gainuse="" losegainwithouttrain="" losewithoutuse="" timestogeneral="0"></Skill><Skill name="Long Axe" formula="" gaintrain="" gainuse="" losegainwithouttrain="" losewithoutuse="" timestogeneral="0"></Skill></General></General></General><General name="Test General"><General name="New Test!!"></General></General></Skilllist>
--- 1,2 ----
<?xml version="1.0" encoding="UTF-8"?>
! <Skilllist><General name="Combat"><General name="Weapons"><General name="Sword"><Skill name="Short Sword" formula="[x=30][y=55]" gaintrain="[x=30][Induction=40][Endurance (Health)=55]" gainuse="[x=35][Comeliness=45]" losegainwithouttrain="[x=66][Wit=0][Endurance (Health)=10]" losewithoutuse="[x=20][Induction=30]" timestogeneral="0"></Skill><Skill name="Long Sword" formula="" gaintrain="" gainuse="" losegainwithouttrain="" losewithoutuse="" timestogeneral="0"></Skill></General><General name="Axe"><Skill name="Short Axe" formula="" gaintrain="" gainuse="" losegainwithouttrain="" losewithoutuse="" timestogeneral="0"></Skill><Skill name="Long Axe" formula="" gaintrain="" gainuse="" losegainwithouttrain="" losewithoutuse="" timestogeneral="0"></Skill></General></General></General><General name="Test General"><General name="New Test!!"></General></General></Skilllist>
Index: SkillFormulaEditorCode.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/SkillEditor/SkillFormulaEditorCode.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** SkillFormulaEditorCode.pas 2001/01/16 04:05:23 1.1
--- SkillFormulaEditorCode.pas 2001/01/16 22:41:43 1.2
***************
*** 203,206 ****
--- 203,208 ----
//else
// begin
+ if (FormulaType = 'xy-form') then
+ exit;
if Grid.RowCount = 13 then
exit;
***************
*** 247,251 ****
if FormulaType = 'xy-form' then
begin
! if (Grid.Cells[1,0] = '') or (Grid.Cells[1,1] = '') or (Grid.Cells[0,2] = '') then
exit;
end
--- 249,253 ----
if FormulaType = 'xy-form' then
begin
! if (Grid.Cells[1,0] = '') or (Grid.Cells[1,1] = '') then
exit;
end
***************
*** 290,295 ****
if FormulaType = 'xy-form' then
begin
! Grid.RowCount := 3;
! Grid.Height := 66;
Grid.Cells[0,0] := 'x';
Grid.Cells[1,0] := '0';
--- 292,297 ----
if FormulaType = 'xy-form' then
begin
! Grid.RowCount := 2;
! Grid.Height := 45;
Grid.Cells[0,0] := 'x';
Grid.Cells[1,0] := '0';
|
|
From: Michael H. <mh...@us...> - 2001-01-16 20:39:20
|
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"
|
|
From: Michael H. <mh...@us...> - 2001-01-16 20:39:20
|
Update of /cvsroot/pythianproject/Prototypes/GLCanvas
In directory usw-pr-cvs1:/tmp/cvs-serv14795/GLCanvas
Modified Files:
QuadTextUnit.pas glCanvas.pas
Added Files:
VinerHand ITC Grid antialiased.bmp
Log Message:
added anti-aliased VinerHand ITC font -mike
***** Bogus filespec: VinerHand
***** Bogus filespec: ITC
***** Bogus filespec: Grid
***** Error reading new file: [Errno 2] No such file or directory: 'antialiased.bmp'
Index: QuadTextUnit.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GLCanvas/QuadTextUnit.pas,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -r1.8 -r1.9
*** QuadTextUnit.pas 2001/01/12 21:10:35 1.8
--- QuadTextUnit.pas 2001/01/16 20:39:16 1.9
***************
*** 88,91 ****
--- 88,92 ----
procedure qtDrawGridString(QT:TQuadText; s:String);
function qtGetStringWidth(QT:TQuadText; s:string):integer; // in pixels
+ function qtGetHeight(QT:TQuadText):integer;
implementation
***************
*** 96,99 ****
--- 97,105 ----
blStore :TGLBoolean;
txStore :TGLBoolean;
+
+ function qtGetHeight(QT:TQuadText):integer;
+ begin
+ result := qt.GridSquareHeight;
+ end;
function qtGetStringWidth(QT:TQuadText; s:string):integer; // in pixels
Index: glCanvas.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GLCanvas/glCanvas.pas,v
retrieving revision 1.19
retrieving revision 1.20
diff -C2 -r1.19 -r1.20
*** glCanvas.pas 2001/01/12 21:10:35 1.19
--- glCanvas.pas 2001/01/16 20:39:16 1.20
***************
*** 197,200 ****
--- 197,201 ----
class procedure FreeRegisteredFonts;
function GetHeight: integer;
+ function GetLineHeight: integer;
public
***************
*** 209,212 ****
--- 210,214 ----
property Width[index:integer]:integer read GetWidth;
property Height :integer read GetHeight;
+ property LineHeight :integer read GetLineHeight;
property Red: byte read FRed write SetRed;
***************
*** 1178,1182 ****
function TGLText.GetHeight: integer;
begin
! result := 20*Lines.Count;
end;
--- 1180,1189 ----
function TGLText.GetHeight: integer;
begin
! result := qtGetHeight(QT)*Lines.Count;
! end;
!
! function TGLText.GetLineHeight: integer;
! begin
! result := qtGetHeight(QT);
end;
|
|
From: Luiz P. <lui...@us...> - 2001-01-16 04:05:29
|
Update of /cvsroot/pythianproject/Prototypes/SkillEditor
In directory usw-pr-cvs1:/tmp/cvs-serv1848
Added Files:
SkillEditor.cfg SkillEditor.dpr SkillEditor.res
SkillEditorCode.dfm SkillEditorCode.pas
SkillFormulaEditorCode.dfm SkillFormulaEditorCode.pas
readme.txt skills.xml
Log Message:
no message
--- NEW FILE ---
-$A+
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J+
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-LE"c:\arquivos de programas\borland\delphi5\Projects\Bpl"
-LN"c:\arquivos de programas\borland\delphi5\Projects\Bpl"
-U"C:\Delphi LPMP\Componentes"
-O"C:\Delphi LPMP\Componentes"
-I"C:\Delphi LPMP\Componentes"
-R"C:\Delphi LPMP\Componentes"
--- NEW FILE ---
program SkillEditor;
uses
Forms,
SkillEditorCode in 'SkillEditorCode.pas' {SkillEditorForm},
SkillFormulaEditorCode in 'SkillFormulaEditorCode.pas' {FormulaForm};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TSkillEditorForm, SkillEditorForm);
Application.CreateForm(TFormulaForm, FormulaForm);
Application.Run;
end.
--- NEW FILE ---
--- NEW FILE ---
ÿ
Font.Color clWindowText Font.Heightõ Font.Name
MS Sans Serif
Font.Style
FormCreate
PixelsPerInch`
TextHeight
OnDblClickTreeViewDblClickOnEditedTreeViewEditedOnKeyUp
TreeViewKeyUp
BevelInnerbvRaised
BevelOuter bvLoweredTabOrderVisible
Font.Color clWindowText Font.Heightó Font.Name
Comic Sans MS
Font.Style fsBold
ParentFont
Font.Color clWindowText Font.Heightõ Font.Name
Comic Sans MS
Font.Style
ParentFont
BevelInnerbvRaised
BevelOuter bvLoweredTabOrderVisible
Font.Color clWindowText Font.Heightó Font.Name
Comic Sans MS
Font.Style fsBold
ParentFont
Font.Color clWindowText Font.Heightõ Font.Name
Comic Sans MS
Font.Style
ParentFont
Font.Color clWindowText Font.Heightõ Font.Name
Comic Sans MS
Font.Style
ParentFont
Font.Color clWindowText Font.Heightõ Font.Name
Comic Sans MS
Font.Style
ParentFont
Font.Color clWindowText Font.Heightõ Font.Name
Comic Sans MS
Font.Style
ParentFont
Font.Color clWindowText Font.Heightõ Font.Name
Comic Sans MS
Font.Style
ParentFont
Font.Color clWindowText Font.Heightõ Font.Name
Comic Sans MS
Font.Style
ParentFont
Font.Color clWindowText Font.Heightõ Font.Name
Comic Sans MS
Font.Style
ParentFont
FormulaBtnLeftTop]WidthHeightFlat OnClickFormulaBtnClick
GainUseBtnLeftTop®
nameChangeOnExitnameExit
Font.Color clWindowText Font.Heightõ Font.Name
MS Sans Serif
Font.Style
ParentFontTabOrderValue
TImageList ImageListLeftTop Bitmap
&
ImageIndex
New &Skill
ImageIndexShortCutS@OnClickNewSkill1Click
SaveToXML1Caption Save To &XML
ImageIndexShortCutX@OnClickSaveToXML1Click
ImageIndexShortCutQ@OnClick
Exit1Click
ImageIndexShortCutD@OnClickDeleteSelected1Click
ImageIndexShortCutF@OnClickEditFormula1Click
ImageIndexOnClick About1Click
--- NEW FILE ---
unit SkillEditorCode;
{*******************************************************}
{ }
{ Skill Editor }
{ }
{ Copyright (c) 2001- The Pythian Project }
{ }
{*******************************************************}
// This program is free software; you can redistribute it and/or modify it //
// under the terms of the GNU General Public License as published by the //
// Free Software Foundation; either version 2 of the License, or (at your //
// option) any later version. This program is distributed in the hope that //
// it will be useful, but WITHOUT ANY WARRANTY; without even the implied //
// warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with this program; if not, write to the Free Software Foundation, //
// Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
// ---------------------------------------------------------------------
{Skill Editor that uses XML to store it's stuff
Contributors -
Luiz Paulo Monteiro Pires
}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ComCtrls, ImgList, Menus, XDOM, StdCtrls, Spin, Buttons;
type
TSkillEditorForm = class(TForm)
TreeView: TTreeView;
GeneralPanel: TPanel;
SecondaryPanel: TPanel;
ImageList: TImageList;
MainMenu: TMainMenu;
File1: TMenuItem;
NewGeneralSkill1: TMenuItem;
NewSkill1: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
Edit1: TMenuItem;
DeleteSelected1: TMenuItem;
Help1: TMenuItem;
About1: TMenuItem;
DomImplementation: TDomImplementation;
XmlToDomParser: TXmlToDomParser;
SaveToXML1: TMenuItem;
N2: TMenuItem;
LabelTestGeneral: TLabel;
name: TEdit;
formula: TEdit;
gaintrain: TEdit;
losegainwithouttrain: TEdit;
losewithoutuse: TEdit;
gainuse: TEdit;
GeneralNameField: TEdit;
LabelTestSecondary: TLabel;
Label1: TLabel;
timestogeneral: TSpinEdit;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
FormulaBtn: TSpeedButton;
GainTrainBtn: TSpeedButton;
GainUseBtn: TSpeedButton;
LoseGainWithoutTrainBtn: TSpeedButton;
LoseWithoutUseBtn: TSpeedButton;
N3: TMenuItem;
EditFormula1: TMenuItem;
Splitter: TSplitter;
procedure FormCreate(Sender: TObject);
procedure UpdateTreeView(const Doc: TdomDocument);
procedure TreeViewChange(Sender: TObject; Node: TTreeNode);
procedure nameExit(Sender: TObject);
procedure SaveToXML1Click(Sender: TObject);
function GetMaxValue: Integer;
procedure NewGeneralSkill1Click(Sender: TObject);
procedure GeneralNameFieldExit(Sender: TObject);
procedure NewSkill1Click(Sender: TObject);
procedure DeleteSelected1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormulaBtnClick(Sender: TObject);
procedure EditFormula1Click(Sender: TObject);
procedure nameChange(Sender: TObject);
procedure GeneralNameFieldChange(Sender: TObject);
procedure TreeViewEdited(Sender: TObject; Node: TTreeNode;
var S: String);
procedure TreeViewDblClick(Sender: TObject);
procedure TreeViewKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure About1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const
GEN = 0;
SEC = 1;
RT = 5;
var
SkillEditorForm: TSkillEditorForm;
Doc: TDomDocument;
TdDoc: TDomNode;
implementation
uses SkillFormulaEditorCode;
{$R *.DFM}
procedure TSkillEditorForm.FormCreate(Sender: TObject);
begin
Doc := XmlToDomParser.FileToDom(ExtractFilePath(Application.ExeName) + 'skills.xml');
UpdateTreeView(Doc);
ImageList.GetBitmap(7, FormulaBtn.Glyph);
ImageList.GetBitmap(7, GainTrainBtn.Glyph);
ImageList.GetBitmap(7, GainUseBtn.Glyph);
ImageList.GetBitmap(7, LoseGainWithoutTrainBtn.Glyph);
ImageList.GetBitmap(7, LoseWithoutUseBtn.Glyph);
end;
procedure TSkillEditorForm.UpdateTreeView(const Doc: TdomDocument);
procedure HandleNodeList(Parent:TTreeNode; DomNodeList:TDomNodeList);
var
i: Integer;
DomNode: TDomNode;
Tn: TTreeNode;
TnName: string;
Te: TDomElement;
begin
for i := 0 to DomNodeList.length -1 do
begin
DomNode := DomNodeList.Item(i);
Te := TDomElement(DomNode);
TnName := Te.GetAttribute('name');
Tn := parent.owner.AddChild(Parent, TnName);
Tn.Data := DomNode;
if DomNode.prefix = 'Skill' then
begin
Tn.ImageIndex := SEC;
Tn.SelectedIndex := SEC;
end;
if assigned(DomNode.ChildNodes) then
HandleNodeList(Tn, DomNode.childNodes);
end;
end;
var
Root:TTreeNode;
begin
TreeView.Items.Clear;
Root := TreeView.Items.Add(nil, 'Skills List');
Root.ImageIndex := RT;
Root.SelectedIndex := RT;
Root.StateIndex := RT;
HandleNodeList(Root,Doc.documentElement.childNodes);
end;
procedure TSkillEditorForm.TreeViewChange(Sender: TObject;
Node: TTreeNode);
var
Place: array[0..10] of Integer;
Td: TDomNode;
Te: TDomElement;
Tn: TTreeNode;
i: Integer;
begin
if Node.Level = 0 then
begin
GeneralPanel.Visible := False;
SecondaryPanel.Visible := False;
exit;
end;
SkillEditorForm.SetFocusedControl(TreeView);
Tn := Node;
for i := Node.Level -1 downto 0 do
begin
Place[i] := Tn.Index;
Tn := Tn.Parent;
end;
Td := Doc.documentElement;
for i := 0 to Node.Level -1 do
begin
Td := Td.childNodes.Item(Place[i]);
end;
TdDoc := Td;
Te := TDomElement(Td);
if Te.TagName = 'General' then
begin
SecondaryPanel.Visible := False;
GeneralPanel.Visible := True;
LabelTestGeneral.Caption := Te.GetAttribute('name');
GeneralNameField.Text := Te.GetAttribute('name');
end
else if Te.TagName = 'Skill' then
begin
GeneralPanel.Visible := False;
SecondaryPanel.Visible := True;
LabelTestSecondary.Caption := Te.GetAttribute('name');
Name.Text := Te.GetAttribute('name');
Formula.Text := Te.GetAttribute('formula');
GainTrain.Text := Te.GetAttribute('gaintrain');
gainuse.Text := Te.GetAttribute('gainuse');
losegainwithouttrain.Text := Te.GetAttribute('losegainwithouttrain');
losewithoutuse.Text := Te.GetAttribute('losewithoutuse');
timestogeneral.MaxValue := GetMaxValue;
try
timestogeneral.Value := StrToInt(Te.GetAttribute('timestogeneral'));
except
timestogeneral.Value := 0;
end;
end;
end;
{
Name
Formula
Base Gain per period of training
Base Gain per period of use
Loss of Gain per period of Use per period without training
Loss per time period without use
% of to General Skill (make sure that sec skills add up to a max total of a 100%)
-XML-
name=
formula=
gaintrain=
gainuse=
losegainwithouttrain=
losewithouttrain=
timestogeneral=
}
procedure TSkillEditorForm.nameExit(Sender: TObject);
var
Te: TDomElement;
begin
if (Sender as TCustomEdit).Name = 'timestogeneral' then
begin
if timestogeneral.Value > timestogeneral.MaxValue then
timestogeneral.Value := timestogeneral.MaxValue;
if timestogeneral.MaxValue = 0 then
timestogeneral.Value := 0;
end;
Te := TDomElement(TdDoc);
Te.SetAttribute((Sender as TCustomEdit).Name, (Sender as TCustomEdit).Text);
//if (Sender as TCustomEdit).Name = 'name' then
// begin
// TreeView.Selected.Text := (Sender as TCustomEdit).Text;
// LabelTestSecondary.Caption := (Sender as TCustomEdit).Text;
// end;
end;
procedure TSkillEditorForm.SaveToXML1Click(Sender: TObject);
var
Memo: TMemo;
begin
SkillEditorForm.SetFocusedControl(TreeView);
Memo := TMemo.Create(Self); //I'm in no mood to handle files so I just made a Memo to do it for me
Memo.Text := Doc.codeAsString;
Memo.Lines.SaveToFile(ExtractFilePath(Application.ExeName) + 'skills.xml');
Memo.Free;
end;
function TSkillEditorForm.GetMaxValue: Integer;
var
Dad: TDomNode;
Son: TDomElement;
i, max: integer;
begin
Dad := TdDoc.parentNode;
max := 100;
for i := 0 to Dad.childNodes.Length -1 do
begin
if i <> TreeView.Selected.Index then
begin
Son := TDomElement(Dad.childNodes.Item(i));
max := max - StrToInt(Son.GetAttribute('timestogeneral'));
end;
end;
//ShowMessage(IntToStr(max));
Result := max;
end;
procedure TSkillEditorForm.NewGeneralSkill1Click(Sender: TObject);
var
UpTe, DownTe: TDomElement;
Tr: TTreeNode;
i: integer;
begin
if TreeView.Selected.ImageIndex = SEC then
begin
ShowMessage('Sorry boys. No can do.');
exit;
end;
if (TreeView.Selected.HasChildren) then
begin
for i := 0 to TreeView.Selected.Count -1 do
begin
if TreeView.Selected.Item[i].ImageIndex = SEC then
begin
ShowMessage('Sorry boys. No can do.');
exit;
end;
end;
end;
if TreeView.Selected.Level <> 0 then
DownTe := TDomElement(TdDoc);
UpTe := TDomDocument(Doc).CreateElement('General');
UpTe.SetAttribute('name', 'NewGeneralSkill');
if TreeView.Selected.Level = 0 then
begin
Doc.DocumentElement.AppendChild(UpTe);
UpdateTreeView(Doc);
TreeView.Items.Item[0].Expand(False);
TreeView.Selected := TreeView.Items.Item[0];
exit;
end
else
DownTe.AppendChild(UpTe);
Tr := TreeView.Selected;
TreeView.Items.AddChild(Tr, 'NewGeneralSkill');
Tr.ImageIndex := GEN;
Tr.Expand(False);
end;
{
all x-y/v1-vN go from 0-1
Formula
--xGen*yTrain/Use(this part starts with 0)
Base Gain per period of training
-x = Base Gain per period of training
--Gain = x * Training Time * Trainer Skill * (v1 * Stat1 + ... + vn * Statn) / 100 (v1 + v2 +...+vN is 1)
Base Gain per period of use
-x = Base Gain per period of use
--Gain = x * Use Time * (v1 * Stat1 + ... + vn * Statn) / 100 - y * Time since last training (v1 + v2 +...+vN is 1)
Loss of Gain per period of Use per period without training
-y = Loss of Gain per period of Use per period without training
--y * Time since last training * (v1 * Memory / 100)
Loss per time period without use
--Loss = x * Time without use * (v1 * Memory) / 100
}
procedure TSkillEditorForm.GeneralNameFieldExit(Sender: TObject);
var
Te: TDomElement;
begin
Te := TDomElement(TdDoc);
Te.SetAttribute('name', GeneralNameField.Text);
end;
procedure TSkillEditorForm.NewSkill1Click(Sender: TObject);
var
UpTe, DownTe: TDomElement;
Tr: TTreeNode;
i: integer;
begin
if TreeView.Selected.ImageIndex = SEC then
begin
ShowMessage('Sorry boys. No can do.');
exit;
end;
if (TreeView.Selected.HasChildren) then
begin
for i := 0 to TreeView.Selected.Count -1 do
begin
if TreeView.Selected.Item[i].ImageIndex = GEN then
begin
ShowMessage('Sorry boys. No can do.');
exit;
end;
end;
end;
if TreeView.Selected.Level <> 0 then
DownTe := TDomElement(TdDoc);
UpTe := TDomDocument(Doc).CreateElement('Skill');
UpTe.SetAttribute('name', 'NewSkill');
UpTe.SetAttribute('formula', '');
UpTe.SetAttribute('gaintrain', '');
UpTe.SetAttribute('gainuse', '');
UpTe.SetAttribute('losegainwithouttrain', '');
UpTe.SetAttribute('losewithoutuse', '');
UpTe.SetAttribute('timestogeneral', '0');
if TreeView.Selected.Level = 0 then
begin
Doc.DocumentElement.AppendChild(UpTe);
UpdateTreeView(Doc);
TreeView.Items.Item[0].Expand(False);
TreeView.Selected := TreeView.Items.Item[0];
exit;
end
else
DownTe.AppendChild(UpTe);
Tr := TreeView.Selected;
TreeView.Items.AddChild(Tr, 'NewSkill');
Tr.GetLastChild.ImageIndex := SEC;
Tr.GetLastChild.SelectedIndex := SEC;
Tr.Expand(False);
end;
procedure TSkillEditorForm.DeleteSelected1Click(Sender: TObject);
begin
//if not TreeView.Focused then
// begin
// (SkillEditorForm.ActiveControl as TCustomEdit).SelText := '';
// exit;
// end;
if (TreeView.Selected.Level = 0) then
begin
ShowMessage('Sorry boys. No can do.');
exit;
end;
TdDoc.ParentNode.RemoveChild(TdDoc);
TreeView.Selected.Parent.Item[TreeView.Selected.Index].Delete;
TreeView.Selected := TreeView.Selected.Parent;
end;
procedure TSkillEditorForm.Exit1Click(Sender: TObject);
begin
SkillEditorForm.Close;
end;
procedure TSkillEditorForm.FormClose(Sender: TObject;
var Action: TCloseAction);
var
check: integer;
begin
check := MessageDlg('Wanna Save?', mtConfirmation, mbYesNoCancel, 0);
if check = mrYes then
SaveToXML1Click(Self)
else if check = mrCancel then
Action := caNone;
end;
procedure TSkillEditorForm.FormulaBtnClick(Sender: TObject);
begin
case (Sender as TSpeedButton).Top of
93:
begin
SkillFormulaEditorCode.FormulaType := 'xy-form';
SkillFormulaEditorCode.FormulaValue := formula.Text;
end;
134:
begin
SkillFormulaEditorCode.FormulaType := 'xstat-gtrain';
SkillFormulaEditorCode.FormulaValue := gaintrain.Text;
end;
174:
begin
SkillFormulaEditorCode.FormulaType := 'xstat-guse';
SkillFormulaEditorCode.FormulaValue := gainuse.Text;
end;
215:
begin
SkillFormulaEditorCode.FormulaType := 'xstat-lwtrain';
SkillFormulaEditorCode.FormulaValue := losegainwithouttrain.Text;
end;
255:
begin
SkillFormulaEditorCode.FormulaType := 'xstat-lwuse';
SkillFormulaEditorCode.FormulaValue := losewithoutuse.Text;
end;
end;
FormulaForm.LoadFormula;
FormulaForm.ShowModal;
end;
procedure TSkillEditorForm.EditFormula1Click(Sender: TObject);
begin
if (formula.Focused) then
begin
SkillFormulaEditorCode.FormulaType := 'xy-form';
SkillFormulaEditorCode.FormulaValue := formula.Text;
FormulaForm.LoadFormula;
FormulaForm.ShowModal;
end;
if (gaintrain.Focused) then
begin
SkillFormulaEditorCode.FormulaType := 'xstat-gtrain';
SkillFormulaEditorCode.FormulaValue := gaintrain.Text;
FormulaForm.LoadFormula;
FormulaForm.ShowModal;
end;
if (gainuse.Focused) then
begin
SkillFormulaEditorCode.FormulaType := 'xstat-guse';
SkillFormulaEditorCode.FormulaValue := gainuse.Text;
FormulaForm.LoadFormula;
FormulaForm.ShowModal;
end;
if (losegainwithouttrain.Focused) then
begin
SkillFormulaEditorCode.FormulaType := 'xstat-lwtrain';
SkillFormulaEditorCode.FormulaValue := losegainwithouttrain.Text;
FormulaForm.LoadFormula;
FormulaForm.ShowModal;
end;
if (losewithoutuse.Focused) then
begin
SkillFormulaEditorCode.FormulaType := 'xstat-lwuse';
SkillFormulaEditorCode.FormulaValue := losewithoutuse.Text;
FormulaForm.LoadFormula;
FormulaForm.ShowModal;
end;
end;
procedure TSkillEditorForm.nameChange(Sender: TObject);
begin
TreeView.Selected.Text := (Sender as TCustomEdit).Text;
LabelTestSecondary.Caption := (Sender as TCustomEdit).Text;
end;
procedure TSkillEditorForm.GeneralNameFieldChange(Sender: TObject);
begin
TreeView.Selected.Text := GeneralNameField.Text;
LabelTestGeneral.Caption := GeneralNameField.Text;
end;
procedure TSkillEditorForm.TreeViewEdited(Sender: TObject; Node: TTreeNode;
var S: String);
begin
if Node.ImageIndex = GEN then
begin
GeneralNameField.Text := S;
SkillEditorForm.SetFocusedControl(GeneralNameField);
SkillEditorForm.SetFocusedControl(TreeView);
end
else if Node.ImageIndex = SEC then
begin
name.Text := S;
SkillEditorForm.SetFocusedControl(name);
SkillEditorForm.SetFocusedControl(TreeView);
end;
end;
procedure TSkillEditorForm.TreeViewDblClick(Sender: TObject);
begin
TreeView.Selected.EditText;
end;
procedure TSkillEditorForm.TreeViewKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = Word(VK_F2) then
TreeView.Selected.EditText;
end;
procedure TSkillEditorForm.About1Click(Sender: TObject);
begin
ShowMessage(' Skill Editor' + #13 + #13 +
'Copyright (c) 2001- The Pythian Project' + #13 + #13 +
' v1.0 - Jan/2001');
end;
end.
--- NEW FILE ---
ÿ
Font.Color clWindowText Font.Heightõ Font.Name
MS Sans Serif
Font.Style
TextHeight
ScrollBars
ssVerticalTabOrder
OnDrawCell GridDrawCell
OnKeyPress GridKeyPress
SkillsListLeft0ToppWidth
ItemHeight
TabOrderOnChangeSkillsListChange
Items.StringsLiftingCarryingEndurance (Running)Reaction speedGraceEndurance (Health)
Comeliness
Healing speedWitProblem-solvingMemory InductionMagic
--- NEW FILE ---
unit SkillFormulaEditorCode;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Grids, Spin;
type
TFormulaForm = class(TForm)
Grid: TStringGrid;
SkillsList: TComboBox;
Add: TButton;
Delete: TButton;
Multi: TSpinEdit;
Ok: TButton;
Cancel: TButton;
procedure GridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure FormShow(Sender: TObject);
procedure SkillsListChange(Sender: TObject);
procedure GridKeyPress(Sender: TObject; var Key: Char);
procedure AddClick(Sender: TObject);
procedure DeleteClick(Sender: TObject);
procedure LoadFormula;//(FormType: String; FormValue: String);
procedure SaveFormula;
procedure OkClick(Sender: TObject);
procedure CancelClick(Sender: TObject);
procedure MultiExit(Sender: TObject);
function GetMax(Row: Integer): Integer;
private
{ Private declarations }
public
{ Public declarations }
end;
var
FormulaForm: TFormulaForm;
FormulaType: String;
FormulaValue: String;
implementation
uses SkillEditorCode;
{$R *.DFM}
{
a) Physical
(1) Lifting
(2) Carrying
(3) Endurance (Running)
(4) Reaction speed
(5) Grace
(6) Endurance (Health)
(7) Comeliness
(8) Healing speed
b) Intellectual
(1) Wit
(2) Problem-solving
(3) Memory
(4) Induction
(5) Magic
}
procedure TFormulaForm.GridDrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
var
tmpStr : String;
tmpRect : TRect;
begin
SkillsList.Visible := False;
Multi.Visible := False;
tmpStr := Grid.Cells[ACol,ARow];
tmpRect := Rect;
Grid.Canvas.Brush.Color := clWindow;
if (gdFocused in State) and (ACol = 0) then
begin
if (tmpStr = 'x') or (tmpStr = 'y') then
begin
Grid.Canvas.Brush.Color := clHighLight;
Grid.Canvas.FillRect(tmpRect);
DrawText(Grid.Canvas.Handle, pChar(tmpStr), Length(tmpStr), tmpRect, DT_CENTER);
Grid.Canvas.Brush.Color := clWindow;
exit;
end;
SetWindowPos(SkillsList.Handle,
0,
Rect.Left + Grid.Left + 1,
Rect.Top + Grid.top + 1,
Rect.Right - Rect.Left + 2,
Rect.Bottom - Rect.top + 2,
SWP_NOZORDER or SWP_SHOWWINDOW);
SkillsList.Show;
SkillsList.ItemIndex := SkillsList.Items.IndexOf(tmpStr);
if SkillsList.ItemIndex = -1 then
SkillsList.ItemIndex := 0;
exit;
end;
if (gdFocused in State) and (ACol = 1) then
begin
SetWindowPos(Multi.Handle,
0,
Rect.Left + Grid.Left + 1,
Rect.Top + Grid.top + 1,
Rect.Right - Rect.Left + 2,
Rect.Bottom - Rect.top + 2,
SWP_NOZORDER or SWP_SHOWWINDOW);
Multi.Show;
if tmpStr = '' then
begin
Multi.MaxValue := 0;
Multi.Value := 0;
Multi.MaxValue := GetMax(ARow);
// MultiEnter(Self);
end
else
begin
Multi.MaxValue := 0;
Multi.Value := StrToInt(tmpStr);
Multi.MaxValue := GetMax(ARow);
// MultiEnter(Self);
end;
exit;
end;
if ACol = 0 then
begin
if tmpStr = '' then
begin
tmpStr := 'Lifting';
Grid.Cells[ACol, ARow] := 'Lifting'
end;
end;
if ACol = 1 then
begin
if tmpStr = '' then
begin
tmpStr := '0';
Grid.Cells[ACol, ARow] := '0'
end;
end;
//if SkillsList.Visible then
// SkillsList.Visible := False;
Grid.Canvas.FillRect(tmpRect);
DrawText(Grid.Canvas.Handle, pChar(tmpStr), Length(tmpStr), tmpRect, DT_CENTER);
//if (gdFocused in State) then
// begin
// Grid.Canvas.Brush.Color := clHighLight;
// Grid.Canvas.FillRect(tmpRect);
// Grid.Canvas.Brush.Color := clWindow;
// end;
end;
procedure TFormulaForm.FormShow(Sender: TObject);
begin
SkillsList.Visible := False;
Multi.Visible := False;
if FormulaType = 'xy-form' then
Caption := 'Formula of Skill'
else if FormulaType = 'xstat-gtrain' then
Caption := 'Formula of Base Gain per period of training'
else if FormulaType = 'xstat-guse' then
Caption := 'Formula of Base Gain per period of use'
else if FormulaType = 'xstat-lwtrain' then
Caption := 'Formula of Loss of Gain per period of Use per period without training'
else if FormulaType = 'xstat-lwuse' then
Caption := 'Formula of Loss per time period without use';
end;
procedure TFormulaForm.SkillsListChange(Sender: TObject);
begin
if Grid.Col = 0 then
Grid.Cells[Grid.Col,Grid.Row] := SkillsList.Text
else
Grid.Cells[Grid.Col,Grid.Row] := Multi.Text;
end;
procedure TFormulaForm.GridKeyPress(Sender: TObject; var Key: Char);
begin
if (Grid.Cells[Grid.Col, Grid.Row] = 'x') or (Grid.Cells[Grid.Col, Grid.Row] = 'y') then
exit;
if (Key <> chr(9)) then
begin
if Grid.Col = 0 then
begin
SkillsList.SetFocus;
SendMessage(SkillsList.Handle, WM_Char, word(Key), 0);
end
else
begin
Multi.SetFocus;
SendMessage(Multi.Handle, WM_Char, word(Key), 0);
end;
end;
end;
procedure TFormulaForm.AddClick(Sender: TObject);
begin
//if Grid.RowCount = 0 then
// begin
// Grid.RowCount := 1;
// Grid.Height := 24;
// end
//else
// begin
if Grid.RowCount = 13 then
exit;
Grid.RowCount := Grid.RowCount +1;
Grid.Height := Grid.Height + 21;
// end;
Grid.Cells[1, Grid.RowCount-1] := '0';
end;
procedure TFormulaForm.DeleteClick(Sender: TObject);
var
i: Integer;
begin
if (Grid.RowCount = 0) or (Grid.RowCount = 1) then
exit;
if (FormulaType = 'xy-form') and (Grid.RowCount = 2) then
exit;
if Grid.Row = 0 then
exit;
if (FormulaType = 'xy-form') and (Grid.Row = 1) then
exit;
//if Grid.RowCount = 1 then
// begin
// Grid.RowCount := 0;
// Grid.Height := 0;
// exit;
// end;
for i := Grid.Row to Grid.RowCount -1 do
begin
Grid.Cells[0, i] := Grid.Cells[0, i+1];
Grid.Cells[1, i] := Grid.Cells[1, i+1];
end;
Grid.RowCount := Grid.RowCount -1;
Grid.Height := Grid.Height - 21;
//Grid.
end;
procedure TFormulaForm.SaveFormula;
var
i: Integer;
Str: String;
begin
Str := '';
if FormulaType = 'xy-form' then
begin
if (Grid.Cells[1,0] = '') or (Grid.Cells[1,1] = '') or (Grid.Cells[0,2] = '') then
exit;
end
else
begin
if (Grid.Cells[1,0] = '') or (Grid.Cells[1,1] = '') then
exit;
end;
for i := 0 to Grid.RowCount -1 do
begin
if (Grid.Cells[0, i] <> '') and (Grid.Cells[1, i] <> '') then
begin
Str := Str + '[' + Grid.Cells[0, i];
Str := Str + '=' + Grid.Cells[1, i] + ']';
end
else
begin
Grid.RowCount := Grid.RowCount -1;
Grid.Height := Grid.Height - 21;
end;
end;
if FormulaType = 'xy-form' then
SkillEditorForm.formula.Text := Str
else if FormulaType = 'xstat-gtrain' then
SkillEditorForm.gaintrain.Text := Str
else if FormulaType = 'xstat-guse' then
SkillEditorForm.gainuse.Text := Str
else if FormulaType = 'xstat-lwtrain' then
SkillEditorForm.losegainwithouttrain.Text := Str
else if FormulaType = 'xstat-lwuse' then
SkillEditorForm.losewithoutuse.Text := Str;
end;
procedure TFormulaForm.LoadFormula;//(FormType: String; FormValue: String);
var
i: Integer;
Str, Str2: String;
begin
Str := FormulaValue;
if Str = '' then
begin
if FormulaType = 'xy-form' then
begin
Grid.RowCount := 3;
Grid.Height := 66;
Grid.Cells[0,0] := 'x';
Grid.Cells[1,0] := '0';
Grid.Cells[0,1] := 'y';
Grid.Cells[1,1] := '0';
Grid.Cells[2,0] := '';
Grid.Cells[2,1] := '0';
end
else
begin
Grid.RowCount := 2;
Grid.Height := 45;
Grid.Cells[0,0] := 'x';
Grid.Cells[1,0] := '0';
Grid.Cells[0,1] := '';
Grid.Cells[1,1] := '0';
end;
exit;
end;
i := 0;
//else
// begin
// if FormulaType = 'xy-form' then
// i := 2
// else
// i := 1;
// end;
//Grid.RowCount := 1;
//Grid.Height := 24;
while Pos('[', Str) > 0 do
begin
if i > Grid.RowCount -1 then
begin
Grid.RowCount := Grid.RowCount +1;
Grid.Height := Grid.Height + 21;
end;
System.Delete(Str, 1, 1);
Str2 := Str;
System.Delete(Str2, Pos('=', Str2), Length(Str2));
Grid.Cells[0, i] := Str2;
Str2 := Str;
System.Delete(Str2, 1, Pos('=', Str2));
System.Delete(Str2, Pos(']', Str2), Length(Str2));
Grid.Cells[1, i] := Str2;
System.Delete(Str, 1, Pos(']', Str));
Inc(i);
end;
while i < Grid.RowCount do
begin
Grid.Cells[0, Grid.RowCount -1] := '';
Grid.Cells[1, Grid.RowCount -1] := '';
Grid.RowCount := Grid.RowCount -1;
Grid.Height := Grid.Height - 21;
end;
end;
//[Endurance (Running)-30][Wit-20][Memory-50]
procedure TFormulaForm.OkClick(Sender: TObject);
begin
SaveFormula;
Close;
end;
procedure TFormulaForm.CancelClick(Sender: TObject);
begin
Close;
end;
procedure TFormulaForm.MultiExit(Sender: TObject);
begin
if FormulaType = 'xy-form' then
begin
if (Multi.MaxValue = 0) and (Grid.Row > 1) then
Multi.Value := 0
else
exit;
end
else
begin
if (Multi.MaxValue = 0) and (Grid.Row > 0) then
Multi.Value := 0
else
exit;
end;
if Multi.Value > Multi.MaxValue then
Multi.Value := Multi.MaxValue;
if Multi.MaxValue = 0 then
Multi.Value := 0;
end;
function TFormulaForm.GetMax(Row: Integer): Integer;
var
i, max: Integer;
begin
if FormulaType = 'xy-form' then
i := 2
else
i := 1;
max := 100;
if FormulaType = 'xy-form' then
begin
if (Row = 0) or (Row = 1) then
begin
Result := 0;
exit;
end;
end
else
begin
if (Grid.Row = 0) then
begin
Result := 0;
exit;
end;
end;
for i := i to Grid.RowCount -1 do
begin
if i <> Row then
max := max - StrToInt(Grid.Cells[1, i]);
end;
Result := max;
end;
end.
--- NEW FILE ---
Skill Editor v1.0
This skill editor uses XML to store it's data. Check the skills.xml
to see the structure if you want.
Oh yeah after you change add/change stuff(and save these changes)
remember to update cvs so we can all have the same version of the
skill's list.
As you'll see there are those general/secondary skills that we talked
about. Also you'll see that there are formulas on the secondary skills.
These are what the formulas are like:
--xGen*yTrain/Use(this part starts with 0)
Base Gain per period of training
-x = Base Gain per period of training
--Gain = x * Training Time * Trainer Skill * (v1 * Stat1 + ... + vn * Statn) / 100 (v1 + v2 +...+vN is 1)
Base Gain per period of use
-x = Base Gain per period of use
--Gain = x * Use Time * (v1 * Stat1 + ... + vn * Statn) / 100 - y * Time since last training (v1 + v2 +...+vN is 1)
Loss of Gain per period of Use per period without training
-x = Loss of Gain per period of Use per period without training
--x * Time since last training * (v1 * Memory / 100)
You can also add some more stats here but it's mostily memory
Loss per time period without use
--Loss = x * Time without use * (v1 * Memory) / 100
You can also add some more stats here but it's mostily memory
You can easily do this stuff with the Formula editor.
I know this should explain more, but oh well...
Luiz Paulo
--- NEW FILE ---
<?xml version="1.0" encoding="UTF-8"?>
<Skilllist><General name="Combat"><General name="Weapons"><General name="Sword"><Skill name="Short Sword" formula="[x=30][y=55][Endurance (Running)=30][Memory=45]" gaintrain="[x=30][Induction=40][Endurance (Health)=55]" gainuse="[x=35][Comeliness=45]" losegainwithouttrain="[x=66][Wit=0][Endurance (Health)=10]" losewithoutuse="[x=20][Induction=30]" timestogeneral="0"></Skill><Skill name="Long Sword" formula="" gaintrain="" gainuse="" losegainwithouttrain="" losewithoutuse="" timestogeneral="0"></Skill></General><General name="Axe"><Skill name="Short Axe" formula="" gaintrain="" gainuse="" losegainwithouttrain="" losewithoutuse="" timestogeneral="0"></Skill><Skill name="Long Axe" formula="" gaintrain="" gainuse="" losegainwithouttrain="" losewithoutuse="" timestogeneral="0"></Skill></General></General></General><General name="Test General"><General name="New Test!!"></General></General></Skilllist>
|
|
From: Luiz P. <lui...@us...> - 2001-01-16 04:04:22
|
Update of /cvsroot/pythianproject/Prototypes/SkillEditor In directory usw-pr-cvs1:/tmp/cvs-serv1737/SkillEditor Log Message: Directory /cvsroot/pythianproject/Prototypes/SkillEditor added to the repository |
|
From: Michael H. <mh...@us...> - 2001-01-12 21:15:53
|
Update of /cvsroot/pythianproject/PythianProject/Source/GameEngine
In directory usw-pr-cvs1:/tmp/cvs-serv10713/Source/GameEngine
Modified Files:
ScriptingEngineState.pas
Log Message:
antialiased text, resized SLE, added vglConversation.pas -mike
Index: ScriptingEngineState.pas
===================================================================
RCS file: /cvsroot/pythianproject/PythianProject/Source/GameEngine/ScriptingEngineState.pas,v
retrieving revision 1.16
retrieving revision 1.17
diff -C2 -r1.16 -r1.17
*** ScriptingEngineState.pas 2000/08/31 17:17:52 1.16
--- ScriptingEngineState.pas 2001/01/12 21:16:18 1.17
***************
*** 272,276 ****
'print "Python Dll: ", sys.version'+LF+
'print sys.copyright'+LF+
- 'print'+LF+
'print "Python Loaded OK! Let''s rock!"'+LF;
LoadDLL;
--- 272,275 ----
|
|
From: Michael H. <mh...@us...> - 2001-01-12 21:15:53
|
Update of /cvsroot/pythianproject/PythianProject/Source/Units
In directory usw-pr-cvs1:/tmp/cvs-serv10713/Source/Units
Modified Files:
Textures.pas
Log Message:
antialiased text, resized SLE, added vglConversation.pas -mike
Index: Textures.pas
===================================================================
RCS file: /cvsroot/pythianproject/PythianProject/Source/Units/Textures.pas,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -r1.9 -r1.10
*** Textures.pas 2000/12/01 18:34:56 1.9
--- Textures.pas 2001/01/12 21:16:19 1.10
***************
*** 61,64 ****
--- 61,65 ----
FUseAlpha: Boolean;
FBitDepth: TBitDepth;
+ FMirrorAlpha: boolean;
procedure SetFilterMode(const Value: Single);
procedure SetMipmap(Const Value: Boolean);
***************
*** 87,90 ****
--- 88,92 ----
property Width: Integer read FWidth;
property TexID: TGLuInt read FTexID write FTexID;
+ property MirrorAlpha :boolean read FMirrorAlpha write FMirrorAlpha; // when true the alpha will be a copy of the red component (used for greyscales only)
end;
***************
*** 108,111 ****
--- 110,114 ----
FUseMipmaps := False;
FUseAlpha := True;
+ FMirrorAlpha := false;
end;
***************
*** 373,382 ****
TestColor[2] := TempBuffer^[Size*3 - 3*lx-3];
! if (TestColor[0] = FAlphaColor[0])
! and (TestColor[1] = FAlphaColor[1])
! and (TestColor[2] = FAlphaColor[2]) then
! TestColor[3] := 0
! else
! TestColor[3] := 255;
FImage^[4*lx+0] := TestColor[0];
--- 376,391 ----
TestColor[2] := TempBuffer^[Size*3 - 3*lx-3];
! if FMirrorAlpha then
! begin
! TestColor[3] := TestColor[0];
! end else
! begin
! if (TestColor[0] = FAlphaColor[0])
! and (TestColor[1] = FAlphaColor[1])
! and (TestColor[2] = FAlphaColor[2]) then
! TestColor[3] := 0
! else
! TestColor[3] := 255;
! end;
FImage^[4*lx+0] := TestColor[0];
|
|
From: Michael H. <mh...@us...> - 2001-01-12 21:10:11
|
Update of /cvsroot/pythianproject/Prototypes/GUISystem
In directory usw-pr-cvs1:/tmp/cvs-serv10022/GUISystem
Modified Files:
StartupForm.pas VGLDemo1.dpr skin1.png vglClasses.pas
vglStdCtrls.pas
Added Files:
vglConversation.pas
Log Message:
antialiased text, resized SLE, added vglConversation.pas -mike
--- NEW FILE ---
unit vglConversation;
interface
uses Windows,classes,Graphics,SysUtils,
vglClasses,vglStdCtrls, glCanvas;
const
VGL_SKINRECT_NLEFT = 135;
VGL_SKINRECT_NTOP = 50;
VGL_SKINRECT_1 :TRect = (Left:VGL_SKINRECT_NLEFT; Top:VGL_SKINRECT_NTOP; Right:VGL_SKINRECT_NLEFT+22;Bottom:VGL_SKINRECT_NTOP+20);
VGL_SKINRECT_2 :TRect = (Left:VGL_SKINRECT_NLEFT; Top:VGL_SKINRECT_NTOP+19;Right:VGL_SKINRECT_NLEFT+22;Bottom:VGL_SKINRECT_NTOP+(19*2));
type
TvglConvOptionsPicker = class(TvglComponent)
protected
FOptions: TStringList;
FImage :TGLBitmap;
FText :TGLText;
FAutoResize: boolean;
function GetComponentType:string; override ;
procedure DrawNumber(num,left,top:integer);
procedure OnOptionsChange(Sender:TObject);
procedure Update(const ElapsedTime: Cardinal); override ;
procedure DoOnKeyDown(KeyCode, KeyData: Integer; KBMod: TVGLKBModifiers; var AllowHP: Boolean); override; // for focused obj only
procedure SelectOption(num:integer);
public
property Options :TStringList read FOptions write FOptions;
property AutoResize :boolean read FAutoResize write FAutoResize;
constructor Create(aName:string; aOwner:TvglComponent);
destructor Destroy; override ;
procedure DrawSelf(where:TRect); override ;
end;
implementation
{ TvglConvOptionsPicker }
constructor TvglConvOptionsPicker.Create(aName: string;
aOwner: TvglComponent);
begin
inherited Create(aName,aOwner);
FOptions := TStringList.Create;
FOptions.OnChange := OnOptionsChange;
FImage := TGLBitmap(Manager.GetResource(VGL_SKIN_1));
FText := TGLText.Create('VinerHand ITC');
FText.SetColor(clBlack);
FAutoResize := true;
end;
destructor TvglConvOptionsPicker.Destroy;
begin
FOptions.Free;
FText.Free;
inherited;
end;
procedure TvglConvOptionsPicker.DoOnKeyDown(KeyCode, KeyData: Integer;
KBMod: TVGLKBModifiers; var AllowHP: Boolean);
begin
case KeyCode of
Ord('1') :SelectOption(1);
Ord('2') :SelectOption(2);
Ord('3') :SelectOption(3);
Ord('4') :SelectOption(4);
Ord('5') :SelectOption(5);
Ord('6') :SelectOption(6);
Ord('7') :SelectOption(7);
Ord('8') :SelectOption(8);
Ord('9') :SelectOption(9);
end;
end;
procedure TvglConvOptionsPicker.DrawNumber(num, left, top: integer);
begin
case num of
1 :Canvas.DrawBitmapSubRect(left,top,VGL_SKINRECT_1,FImage);
2 :Canvas.DrawBitmapSubRect(left,top,VGL_SKINRECT_2,FImage);
{ 3 :Canvas.DrawBitmapSubRect(left,top,VGL_SKINRECT_3,FImage);
4 :Canvas.DrawBitmapSubRect(left,top,VGL_SKINRECT_4,FImage);
5 :Canvas.DrawBitmapSubRect(left,top,VGL_SKINRECT_5,FImage);
6 :Canvas.DrawBitmapSubRect(left,top,VGL_SKINRECT_6,FImage);
7 :Canvas.DrawBitmapSubRect(left,top,VGL_SKINRECT_7,FImage);
8 :Canvas.DrawBitmapSubRect(left,top,VGL_SKINRECT_8,FImage);
9 :Canvas.DrawBitmapSubRect(left,top,VGL_SKINRECT_9,FImage); }
end;
end;
procedure TvglConvOptionsPicker.DrawSelf(where: TRect);
var i:integer;
begin
Canvas.CurrentColor := clBlue;
Canvas.Solid := false;
Canvas.Rectangle(where.left,where.top,where.right,where.bottom+5);
Canvas.Solid := true;
Canvas.Rectangle(where.left,where.top,where.right,where.bottom+5);
// display options
for i := 0 to FOptions.Count-1 do
begin
// DrawNumber(i+1,where.left,where.top+i*22);
Canvas.DrawTextLine(where.left+10,where.top+i*20,i,FText);
end;
end;
function TvglConvOptionsPicker.GetComponentType: string;
begin
Result := 'ConvOptionsPicker';
end;
procedure TvglConvOptionsPicker.OnOptionsChange(Sender: TObject);
var i:integer;
begin
// update the text object and possibly resize here
FText.Lines.Assign(FOptions);
// add option numbers
for i := 0 to FText.Lines.Count-1 do
begin
FText.Lines[i] := '|'+IntToStr(i+1)+'| '+ FText.Lines[i];
end;
if FautoResize then Height := FText.Height;
end;
procedure TvglConvOptionsPicker.SelectOption(num: integer);
begin
// TODO
end;
procedure TvglConvOptionsPicker.Update(const ElapsedTime: Cardinal);
begin
inherited Update(ElapsedTime);
end;
end.
Index: StartupForm.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/StartupForm.pas,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -r1.14 -r1.15
*** StartupForm.pas 2001/01/07 16:19:27 1.14
--- StartupForm.pas 2001/01/12 21:10:35 1.15
***************
*** 9,13 ****
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
! StdCtrls, GLForms, GLCanvas, OpenGL, vglClasses, vglStdCtrls, vglEdits;
type
--- 9,14 ----
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
! StdCtrls, GLForms, GLCanvas, OpenGL, vglClasses, vglStdCtrls, vglEdits,
! vglConversation;
type
***************
*** 18,21 ****
--- 19,29 ----
private
{ Private declarations }
+
+ MultiPage :TvglMultiPage;
+ SelectTestPage :TvglTextbox;
+ SelectConvPage :TvglTextbox;
+
+ // test page
+ TestPage :TvglPage;
c:TvglComponent;
Image1:TvglDraggableImage;
***************
*** 28,33 ****
cc: TvglComponent;
SLE :TvglSingleLineEdit;
-
DragBox :TvglDragBox;
Elapsed,FirstTime:Cardinal;
--- 36,43 ----
cc: TvglComponent;
SLE :TvglSingleLineEdit;
DragBox :TvglDragBox;
+ // conversation engine page
+ ConvPage :TvglPage;
+ ConvOptions :TvglConvOptionsPicker;
Elapsed,FirstTime:Cardinal;
***************
*** 51,54 ****
--- 61,65 ----
procedure DragBoxOnDragOver(what:TvglDragObject; var Accept:boolean);
procedure DragBoxOnDragDrop(what:TvglDragObject);
+ procedure SelectPage(Sender:TObject);
procedure go;
***************
*** 166,170 ****
else GLC := TGLCanvas.Create(638,478);
Wallpaper := TGLBitmap.Create;
! Wallpaper.LoadFromBitmap('..\GLCanvas\scene.png');
if GLForm.FullScreen then
--- 177,185 ----
else GLC := TGLCanvas.Create(638,478);
Wallpaper := TGLBitmap.Create;
! {$IFDEF DEVELOPMENT}
! Wallpaper.LoadFromBitmap('..\GLCanvas\scene.png');
! {$ELSE}
! Wallpaper.LoadFromBitmap('scene.png');
! {$ENDIF}
if GLForm.FullScreen then
***************
*** 175,179 ****
// create test components
! Panel1 := TvglPanel.Create('Panel1',InterfaceManager.Desktop);
Panel1.Bounds := Rect(10,30,460,400);
Panel1.Textured := true;
--- 190,218 ----
// create test components
!
! MultiPage := TvglMultipage.Create('Pages',InterfaceManager.Desktop);
! MultiPage.Bounds := InterfaceManager.Desktop.Bounds;
! MultiPage.Bounds := Rect(MultiPage.Bounds.Left,MultiPage.Bounds.Top +15,MultiPage.Bounds.Right,MultiPage.Bounds.Bottom);
! TestPage := MultiPage.AddPage;
! ConvPage := MultiPage.AddPage;
! MultiPage.CurrentPage := TestPage;
!
! SelectTestPage := TvglTextBox.Create('SelectTestPage',InterfaceManager.Desktop);
! SelectTestPage.Bounds := Rect(0,30,0,0);
! SelectTestPage.AutoSize := true;
! SelectTestPage.Lines.Add('|Test page|');
! SelectTestPage.OnClick := SelectPage;
! SelectTestPage.Color := clBlue;
!
! SelectConvPage := TvglTextBox.Create('SelectConvPage',InterfaceManager.Desktop);
! SelectConvPage.Bounds := Rect(100,30,0,0);
! SelectConvPage.AutoSize := true;
! SelectConvPage.Lines.Add('|Conversation page|');
! SelectConvPage.OnClick := SelectPage;
! SelectConvPage.Color := clBlue;
!
!
! // test page
! Panel1 := TvglPanel.Create('Panel1',TestPage);
Panel1.Bounds := Rect(10,30,460,400);
Panel1.Textured := true;
***************
*** 191,200 ****
c.Cached := True; }
! Image1 := TvglDraggableImage.Create('Image1',InterfaceManager.Desktop);
Image1.LoadImage('olog.png');
Image1.Bounds := Rect(500,20,0,0);
Image1.Cached := True;
! CB := TvglCheckBox.Create('CheckBox1', InterfaceManager.Desktop);
CB.Left := 20;
CB.Top := 210;
--- 230,239 ----
c.Cached := True; }
! Image1 := TvglDraggableImage.Create('Image1',TestPage);
Image1.LoadImage('olog.png');
Image1.Bounds := Rect(500,20,0,0);
Image1.Cached := True;
! CB := TvglCheckBox.Create('CheckBox1', TestPage);
CB.Left := 20;
CB.Top := 210;
***************
*** 202,206 ****
CB.Checked := True;
CB.Color := clBlack;
! CB.Caption := 'This is a checkbox';
CB.OnChanged := CB1OnChange;
CB.Text.FontName := 'VinerHand ITC';
--- 241,245 ----
CB.Checked := True;
CB.Color := clBlack;
! CB.Caption := 'Checkbox';
CB.OnChanged := CB1OnChange;
CB.Text.FontName := 'VinerHand ITC';
***************
*** 215,219 ****
Button.HasHotkey := True;
! Label1 := TvglTextBox.Create('Label1',InterfaceManager.Desktop);
Label1.Top := 220;
Label1.Left := 468;
--- 254,258 ----
Button.HasHotkey := True;
! Label1 := TvglTextBox.Create('Label1',TestPage);
Label1.Top := 220;
Label1.Left := 468;
***************
*** 222,226 ****
Label1.Caption := 'FOCUS LOST!';
! SB := TvglScrollBar.Create('ScrollBar1', InterfaceManager.Desktop);
SB.Kind := sbHorizontal;
SB.Left := 60;
--- 261,265 ----
Label1.Caption := 'FOCUS LOST!';
! SB := TvglScrollBar.Create('ScrollBar1', TestPage);
SB.Kind := sbHorizontal;
SB.Left := 60;
***************
*** 235,239 ****
SB.Cached := True;
! LB := TvglSimpleListBox.Create('SimpleListBoxTest', InterfaceManager.Desktop);
LB.Items.BeginUpdate;
LB.Items.Clear;
--- 274,278 ----
SB.Cached := True;
! LB := TvglSimpleListBox.Create('SimpleListBoxTest', TestPage);
LB.Items.BeginUpdate;
LB.Items.Clear;
***************
*** 255,268 ****
Edit1.Bounds := Rect(20,300,220,400);
Edit1.Lines.Add('Hello World 1');
! Edit1.Lines.Add('Hello World 2'); }
! // SLE := TvglSingleLineEdit.Create('SLE1',InterfaceManager.Desktop);
! // SLE.Bounds := Rect(20,300,220,400);
! DragBox := TvglDragBox.Create('DragBox1',InterfaceManager.Desktop);
! DragBox.Bounds := Rect(500,400,550,450);
DragBox.OnDragOver := DragBoxOnDragOver;
DragBox.OnDragDrop := DragBoxOnDragDrop;
DragBox.Cached := True;
InterfaceManager.SetNewFocus(LB);
Hide;
--- 294,316 ----
Edit1.Bounds := Rect(20,300,220,400);
Edit1.Lines.Add('Hello World 1');
! Edit1.Lines.Add('Hello World 2');
! Edit1.Text.FontName := 'VinerHand ITC'; }
! SLE := TvglSingleLineEdit.Create('SLE1',TestPage);
! SLE.Bounds := Rect(20,300,420,320);
! SLE.FontName := 'VinerHand ITC';
! DragBox := TvglDragBox.Create('DragBox1',TestPage);
! DragBox.Bounds := Rect(500,350,550,400);
DragBox.OnDragOver := DragBoxOnDragOver;
DragBox.OnDragDrop := DragBoxOnDragDrop;
DragBox.Cached := True;
+ // now for conversation engine mockups
+ ConvOptions := TvglConvOptionsPicker.Create('OptionsPicker',ConvPage);
+ ConvOptions.Bounds := Rect(10,60,630,200);
+ ConvOptions.Options.Add('Hello World!');
+ ConvOptions.Options.Add('Second option');
+
+
InterfaceManager.SetNewFocus(LB);
Hide;
***************
*** 314,317 ****
--- 362,373 ----
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;
+
+ procedure TfrmStartup.SelectPage(Sender: TObject);
+ begin
+ if Sender = SelectTestPage then
+ MultiPage.CurrentPage := TestPage
+ else if Sender = SelectConvPage then
+ MultiPage.CurrentPage := ConvPage;
end;
Index: VGLDemo1.dpr
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/VGLDemo1.dpr,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** VGLDemo1.dpr 2000/12/11 19:15:12 1.2
--- VGLDemo1.dpr 2001/01/12 21:10:35 1.3
***************
*** 3,7 ****
uses
Forms,
! StartupForm in 'StartupForm.pas' {frmStartup};
{$R *.RES}
--- 3,8 ----
uses
Forms,
! StartupForm in 'StartupForm.pas' {frmStartup},
! vglConversation in 'vglConversation.pas';
{$R *.RES}
Index: skin1.png
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/skin1.png,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -r1.7 -r1.8
Binary files /tmp/cvsSiW77g and /tmp/cvsAHyIIn differ
Index: vglClasses.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/vglClasses.pas,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -r1.12 -r1.13
*** vglClasses.pas 2001/01/07 16:19:27 1.12
--- vglClasses.pas 2001/01/12 21:10:35 1.13
***************
*** 398,404 ****
TvglPanel = class(TvglComponent)
protected
- //FTextured: boolean;
FColor: TColor;
FTexture :TGLBitmap;
procedure SetColor(const Value: TColor);
function GetComponentType:string; override;
--- 398,404 ----
TvglPanel = class(TvglComponent)
protected
FColor: TColor;
FTexture :TGLBitmap;
+ FStyleShown: boolean;
procedure SetColor(const Value: TColor);
function GetComponentType:string; override;
***************
*** 407,411 ****
public
property Color :TColor read FColor write SetColor;
! //property Textured :boolean read FTextured write FTextured;
constructor Create(aName:string; AOwner:TvglComponent);
--- 407,411 ----
public
property Color :TColor read FColor write SetColor;
! property StyleShown :boolean read FStyleShown write FStyleShown;
constructor Create(aName:string; AOwner:TvglComponent);
***************
*** 1477,1480 ****
--- 1477,1481 ----
inherited Create(aName,AOwner);
Color := clBlue;
+ StyleShown := true;
Textured := false;
FFocusable := False;
***************
*** 1493,1496 ****
--- 1494,1499 ----
begin
inherited DrawSelf(where);
+ if not StyleShown then exit;
+
if Textured then
begin
Index: vglStdCtrls.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/vglStdCtrls.pas,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -r1.11 -r1.12
*** vglStdCtrls.pas 2001/01/07 16:19:27 1.11
--- vglStdCtrls.pas 2001/01/12 21:10:35 1.12
***************
*** 36,40 ****
interface
! uses Windows, GLCanvas, Classes, vglClasses, Graphics, SysUtils{, Trace};
const
--- 36,40 ----
interface
! uses Windows, GLCanvas, Classes, vglClasses, Graphics, SysUtils, Trace;
const
***************
*** 368,372 ****
--- 368,397 ----
end;
+ { Allows multiple components to be collected and hidden/shown as a group }
+ TvglPage = class(TvglPanel)
+ constructor Create(aName:string; aOwner:TvglComponent);
+ end;
+
+ TvglMultipage = class(TvglComponent)
+ protected
+ FCurrentPage: TvglPage;
+ procedure SetCurrentPage(const Value: TvglPage);
+ function GetPage(index: integer): TvglPage;
+
+ function GetComponentType:string; override ;
+ procedure DrawChildren; override ;
+ function GetComponentAt(X, Y: integer): TvglComponent;
+ public
+ property Pages[index:integer] :TvglPage read GetPage; default;
+ property CurrentPage :TvglPage read FCurrentPage write SetCurrentPage;
+
+ constructor Create(aName:string; AOwner:TvglComponent);
+ destructor Destroy; override ;
+
+ function AddPage:TvglPage;
+ end;
+
+
implementation
uses
***************
*** 1866,1869 ****
--- 1891,1895 ----
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);
+ FAcceptsChildren := false;
end;
***************
*** 1880,1884 ****
// draw backpanel
Canvas.CurrentColor := clBlack;
! Canvas.FillAlpha := 0.5;
Canvas.Rectangle(Manager.Desktop.ScreenBounds);
// draw "window"
--- 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"
***************
*** 1904,1907 ****
--- 1930,2004 ----
begin
Visible := true;
+ end;
+
+ { TvglMultipage }
+
+ function TvglMultipage.AddPage: TvglPage;
+ var newpage :TvglPage;
+ begin
+ FAcceptsChildren := true;
+ newPage := TvglPage.Create(Name+'_Page'+IntToStr(FChildren.Count+1),self);
+ newPage.Bounds := Bounds;
+ FAcceptsChildren := false;
+ result := newPage;
+ if CurrentPage = nil then CurrentPage := newPage;
+ end;
+
+ constructor TvglMultipage.Create(aName: string; AOwner: TvglComponent);
+ begin
+ inherited Create(aName,aOwner);
+ FAcceptsChildren := false;
+ FcurrentPage := nil;
+ end;
+
+ destructor TvglMultipage.Destroy;
+ begin
+ inherited;
+ end;
+
+ procedure TvglMultipage.DrawChildren;
+ var i:integer;
+ begin
+ if assigned(FOwner) then
+ Canvas.SetClipping(FOwner.ChildClipRect);
+ CurrentPage.Draw;
+ end;
+
+ function TvglMultipage.GetComponentAt(X, Y: integer): TvglComponent;
+ begin
+ if assigned(CurrentPage) then
+ result := CurrentPage.GetComponentAt(x,y)
+ else result := self;
+ end;
+
+ function TvglMultipage.GetComponentType: string;
+ begin
+ result := 'MultiPage';
+ end;
+
+ function TvglMultipage.GetPage(index: integer): TvglPage;
+ begin
+ Result := TvglPage(FChildren[index]);
+ end;
+
+ procedure TvglMultipage.SetCurrentPage(const Value: TvglPage);
+ var i:integer;
+ begin
+ FCurrentPage := Value;
+ // make all but this one invisible
+ for i := 0 to FChildren.Count-1 do
+ begin
+ if TvglPage(FChildren[i]) = CurrentPage then
+ TvglPage(FChildren[i]).Visible := true
+ else TvglPage(FChildren[i]).Visible := false;
+ end;
+ end;
+
+ { TvglPage }
+
+ constructor TvglPage.Create(aName:string; aOwner: TvglComponent);
+ begin
+ inherited Create(aName,aOwner);
+ StyleShown := false;
end;
|
|
From: Michael H. <mh...@us...> - 2001-01-12 21:10:10
|
Update of /cvsroot/pythianproject/Prototypes/GLCanvas
In directory usw-pr-cvs1:/tmp/cvs-serv10022/GLCanvas
Modified Files:
QuadTextUnit.pas glCanvas.pas
Log Message:
antialiased text, resized SLE, added vglConversation.pas -mike
Index: QuadTextUnit.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GLCanvas/QuadTextUnit.pas,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -r1.7 -r1.8
*** QuadTextUnit.pas 2000/12/13 22:34:11 1.7
--- QuadTextUnit.pas 2001/01/12 21:10:35 1.8
***************
*** 61,71 ****
15);
VINERHAND_WIDTHS :TQuadTextWidthsArray = (
! 14, 11, 10, 12, 10, 10, 8, 13, 7, 8, 14, 11,
! 20, 20, 20, 20, 20, 20, 20, 11, 10, 10, 16, 10,
! 10, 10, 8, 8, 8, 8, 8, 5, 8, 8, 2, 3,
! 8, 2, 12, 8, 8, 8, 8, 5, 8, 5, 8, 8,
! 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
! 8, 8, 4, 6, 7, 2, 2, 3, 3, 2, 13, 14,
! 12, 5, 7, 2, 8, 8, 2, 2, 4, 4, 12, 15,
15);
--- 61,71 ----
15);
VINERHAND_WIDTHS :TQuadTextWidthsArray = (
! 14, 11, 12, 12, 10, 10, 8, 13, 7, 8, 14, 11,
! 14, 14, 8, 10, 14, 11, 10, 8, 10, 10, 16, 10,
! 10, 10, 8, 8, 7, 8, 6, 5, 8, 8, 2, 3,
! 8, 2, 12, 8, 7, 8, 8, 5, 8, 5, 8, 8,
! 8, 8, 8, 8, 6, 8, 8, 8, 8, 8, 8, 8,
! 8, 8, 4, 6, 7, 2, 2, 3, 3, 2, 13, 14,
! 12, 5, 7, 2, 8, 8, 2, 2, 4, 4, 12, 15,
15);
***************
*** 202,206 ****
--- 202,217 ----
glTranslatef(QT.TexWidths[o]+QT.GridCharSpacing,0,0)
end else // translate for space character
+ begin
+ if underline then
+ begin
+ glDisable(GL_TEXTURE_2D);
+ glBegin(GL_LINES);
+ glVertex2i(0,QT.GridSquareHeight);
+ glVertex2i(QT.SpaceWidth,QT.GridSquareHeight);
+ glEnd;
+ glEnable(GL_TEXTURE_2D);
+ end;
glTranslatef(QT.SpaceWidth,0,0);
+ end;
end;
inc(a);
Index: glCanvas.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GLCanvas/glCanvas.pas,v
retrieving revision 1.18
retrieving revision 1.19
diff -C2 -r1.18 -r1.19
*** glCanvas.pas 2001/01/02 21:46:20 1.18
--- glCanvas.pas 2001/01/12 21:10:35 1.19
***************
*** 196,199 ****
--- 196,200 ----
function GetWidth(index: integer): integer;
class procedure FreeRegisteredFonts;
+ function GetHeight: integer;
public
***************
*** 207,210 ****
--- 208,212 ----
property Text:string read GetText write SetText;
property Width[index:integer]:integer read GetWidth;
+ property Height :integer read GetHeight;
property Red: byte read FRed write SetRed;
***************
*** 842,846 ****
--- 844,850 ----
if not assigned(f.Texture) then
begin
+ // WARNING: alpha mirroring is experimental! -mike
FTexture := TTexture.Create;
+ FTexture.MirrorAlpha := true;
FTexture.LoadFromFile(FontsDirectory + f.FileName);
f.Texture := FTexture;
***************
*** 1172,1175 ****
--- 1176,1184 ----
end;
+ function TGLText.GetHeight: integer;
+ begin
+ result := 20*Lines.Count;
+ end;
+
{ TGLTexturedFont }
***************
*** 1195,1199 ****
TGLText.RegisterFont('Arial','Arial Grid.bmp',ARIAL_WIDTHS);
TGLText.RegisterFont('Courier New','CourierNew Grid.bmp',COURIERNEW_WIDTHS);
! TGLText.RegisterFont('VinerHand ITC','VinerHand ITC Grid.bmp',VINERHAND_WIDTHS);
finalization
--- 1204,1208 ----
TGLText.RegisterFont('Arial','Arial Grid.bmp',ARIAL_WIDTHS);
TGLText.RegisterFont('Courier New','CourierNew Grid.bmp',COURIERNEW_WIDTHS);
! TGLText.RegisterFont('VinerHand ITC','VinerHand ITC Grid antialiased.bmp',VINERHAND_WIDTHS);
finalization
|
|
From: Kamil K. <kkr...@us...> - 2001-01-07 16:19:19
|
Update of /cvsroot/pythianproject/Prototypes/GUISystem
In directory usw-pr-cvs1:/tmp/cvs-serv23676
Modified Files:
StartupForm.pas vglClasses.pas vglStdCtrls.pas
Log Message:
kk - added caching for globaly all panel - like controls;
ScrollBar, ListBox, CheckBox - now it should be faster
Index: StartupForm.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/StartupForm.pas,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -r1.13 -r1.14
*** StartupForm.pas 2001/01/06 19:52:48 1.13
--- StartupForm.pas 2001/01/07 16:19:27 1.14
***************
*** 27,31 ****
CB: TvglCheckBox;
cc: TvglComponent;
- Edit1:TvglEdit;
SLE :TvglSingleLineEdit;
--- 27,30 ----
***************
*** 182,187 ****
Panel1.OnMouseEntry := Panel1OnMouseEntry;
Panel1.OnMouseExit := Panel1OnMouseExit;
! c := TvglPanel.Create('Panel2',Panel1);
TvglPanel(c).Color := clYellow;
TvglPanel(c).Textured := false;
--- 181,187 ----
Panel1.OnMouseEntry := Panel1OnMouseEntry;
Panel1.OnMouseExit := Panel1OnMouseExit;
+ Panel1.Cached := True;
! { c := TvglPanel.Create('Panel2',Panel1);
TvglPanel(c).Color := clYellow;
TvglPanel(c).Textured := false;
***************
*** 189,196 ****
--- 189,198 ----
c.Top := 5; c.Left := 30; // this shows a panel being clipped to its owner
c.Width := 50; c.Height := 50;
+ c.Cached := True; }
Image1 := TvglDraggableImage.Create('Image1',InterfaceManager.Desktop);
Image1.LoadImage('olog.png');
Image1.Bounds := Rect(500,20,0,0);
+ Image1.Cached := True;
CB := TvglCheckBox.Create('CheckBox1', InterfaceManager.Desktop);
***************
*** 203,206 ****
--- 205,209 ----
CB.OnChanged := CB1OnChange;
CB.Text.FontName := 'VinerHand ITC';
+ CB.Cached := True;
Button := TvglButton.Create('Button',Panel1);
***************
*** 230,238 ****
SB.PageSize := 50;
SB.OnScroll := SBOnChange;
LB := TvglSimpleListBox.Create('SimpleListBoxTest', InterfaceManager.Desktop);
LB.Items.BeginUpdate;
LB.Items.Clear;
! for i := 0 to 99 do
begin
LB.Items.Add('Item '+IntToStr(i));
--- 233,242 ----
SB.PageSize := 50;
SB.OnScroll := SBOnChange;
+ SB.Cached := True;
LB := TvglSimpleListBox.Create('SimpleListBoxTest', InterfaceManager.Desktop);
LB.Items.BeginUpdate;
LB.Items.Clear;
! for i := 0 to 25 do
begin
LB.Items.Add('Item '+IntToStr(i));
***************
*** 245,250 ****
LB.Textured := true;
LB.Text.SetColor(clBlack);
- LB.Cached := false; // EXPERIMENTAL!!
LB.ScrollBars := ssBoth;
{ Edit1 := TvglEdit.Create('Edit1',InterfaceManager.Desktop);
--- 249,254 ----
LB.Textured := true;
LB.Text.SetColor(clBlack);
LB.ScrollBars := ssBoth;
+ LB.Cached := True; // EXPERIMENTAL!!
{ Edit1 := TvglEdit.Create('Edit1',InterfaceManager.Desktop);
***************
*** 252,257 ****
Edit1.Lines.Add('Hello World 1');
Edit1.Lines.Add('Hello World 2'); }
! SLE := TvglSingleLineEdit.Create('SLE1',InterfaceManager.Desktop);
! SLE.Bounds := Rect(20,300,220,400);
DragBox := TvglDragBox.Create('DragBox1',InterfaceManager.Desktop);
--- 256,261 ----
Edit1.Lines.Add('Hello World 1');
Edit1.Lines.Add('Hello World 2'); }
! // SLE := TvglSingleLineEdit.Create('SLE1',InterfaceManager.Desktop);
! // SLE.Bounds := Rect(20,300,220,400);
DragBox := TvglDragBox.Create('DragBox1',InterfaceManager.Desktop);
***************
*** 259,262 ****
--- 263,267 ----
DragBox.OnDragOver := DragBoxOnDragOver;
DragBox.OnDragDrop := DragBoxOnDragDrop;
+ DragBox.Cached := True;
InterfaceManager.SetNewFocus(LB);
Index: vglClasses.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/vglClasses.pas,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -r1.11 -r1.12
*** vglClasses.pas 2001/01/06 19:52:48 1.11
--- vglClasses.pas 2001/01/07 16:19:27 1.12
***************
*** 231,234 ****
--- 231,235 ----
procedure CacheInit; dynamic;
procedure CacheFinalize; dynamic;
+ procedure CacheInvalidate; virtual;
procedure DrawSelf(where:TRect); virtual; // where is screen relative, bounds is parent relative
***************
*** 580,583 ****
--- 581,585 ----
Result := FChildren.Add(child);
if assigned(FOnChildAdd) then OnChildAdd(child);
+ CacheInvalidate;
end;
***************
*** 799,802 ****
--- 801,805 ----
if i = -1 then raise EVGLException.Create('TvglComponent.RemoveChild: Unknown child component ['+child.name+']');
FChildren.Delete(i);
+ CacheInvalidate;
end;
***************
*** 931,934 ****
--- 934,938 ----
procedure TvglComponent.DoDeFocus;
begin
+ CacheInvalidate;
if Assigned(FOnExit) then
FOnExit(Self, Manager.SwitchingTo);
***************
*** 937,940 ****
--- 941,945 ----
procedure TvglComponent.DoSetBounds;
begin
+ CacheInvalidate;
if assigned(FOnResize) then
OnResize(self);
***************
*** 943,946 ****
--- 948,952 ----
procedure TvglComponent.DoSetFocus;
begin
+ CacheInvalidate;
if Assigned(FOnEnter) then
FOnEnter(Self, Manager.LastFocused);
***************
*** 1143,1146 ****
--- 1149,1153 ----
FBounds.Top := y;
Width := w; Height := h;
+ DoSetBounds;
end;
***************
*** 1152,1155 ****
--- 1159,1163 ----
FBounds.Top := FBounds.Top + y;
Width := w; Height := h;
+ DoSetBounds;
end;
***************
*** 1170,1173 ****
--- 1178,1186 ----
begin
FReleased := true;
+ end;
+
+ procedure TvglComponent.CacheInvalidate;
+ begin
+ FCacheInvalid := True;
end;
Index: vglStdCtrls.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/vglStdCtrls.pas,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -r1.10 -r1.11
*** vglStdCtrls.pas 2001/01/06 19:52:48 1.10
--- vglStdCtrls.pas 2001/01/07 16:19:27 1.11
***************
*** 445,448 ****
--- 445,449 ----
procedure TvglScrollBar.DoChange;
begin
+ CacheInvalidate;
if Assigned(FOnChange) then
FOnChange(Self);
***************
*** 512,517 ****
if PointInRectInAcc(ScreenBounds, X, Y, XA, YA) then
HandleMousePositioning(X, Y)
! else
FScrollingPos := Position;
end
else begin
--- 513,520 ----
if PointInRectInAcc(ScreenBounds, X, Y, XA, YA) then
HandleMousePositioning(X, Y)
! else begin
FScrollingPos := Position;
+ DoScroll(scTrack, FScrollingPos);
+ end;
end
else begin
***************
*** 540,543 ****
--- 543,547 ----
FMousePositioning := False;
end;
+ CacheInvalidate;
end;
***************
*** 545,548 ****
--- 549,553 ----
var ScrollPos: Integer);
begin
+ CacheInvalidate;
if Assigned(FOnScroll) then
FOnScroll(Self, ScrollCode, ScrollPos);
***************
*** 776,779 ****
--- 781,785 ----
FPosition := APosition;
FScrollingPos := FPosition;
+ CacheInvalidate;
end;
***************
*** 893,896 ****
--- 899,903 ----
FScrollBar.Left := FBounds.Right - 13{FScrollBar.Width} - 2;
FScrollBar.Color := clAqua; // @@BUG - cannot set scrollbar to invisible.
+ FScrollBar.Cached := True;
FItems := TStringList.Create;
FItems.OnChange := ItemsChanged;
***************
*** 920,926 ****
if button = VGL_MOUSE_LEFT then
begin
! TimerReset;
FMouseDown := True;
ItemIndex := ItemIndexAt(X, Y, 0, 0, ScreenBounds);
end;
end;
--- 927,934 ----
if button = VGL_MOUSE_LEFT then
begin
! TimerReset;
FMouseDown := True;
ItemIndex := ItemIndexAt(X, Y, 0, 0, ScreenBounds);
+
end;
end;
***************
*** 1059,1063 ****
procedure TvglSimpleListBox.ScrollBarChanged(Sender: TObject);
begin
! //
end;
--- 1067,1071 ----
procedure TvglSimpleListBox.ScrollBarChanged(Sender: TObject);
begin
! CacheInvalidate;
end;
***************
*** 1065,1069 ****
ScrollCode: TvglScrollCode; var ScrollPos: Integer);
begin
! //
end;
--- 1073,1077 ----
ScrollCode: TvglScrollCode; var ScrollPos: Integer);
begin
! CacheInvalidate;
end;
***************
*** 1077,1080 ****
--- 1085,1089 ----
begin
FColor := Value;
+ CacheInvalidate;
end;
***************
*** 1088,1091 ****
--- 1097,1101 ----
begin
FItemHeight := Max(Value, 1);
+ CacheInvalidate;
end;
***************
*** 1093,1096 ****
--- 1103,1107 ----
begin
FItemIndex := Max(Min(Value, FItems.Count - 1), 0);
+ CacheInvalidate;
end;
***************
*** 1098,1101 ****
--- 1109,1113 ----
begin
FItems := Value;
+ CacheInvalidate;
end;
***************
*** 1118,1121 ****
--- 1130,1134 ----
FScrollBar.Visible := False;
end;
+ CacheInvalidate;
end;
***************
*** 1123,1126 ****
--- 1136,1140 ----
begin
FSelBgColor := Value;
+ CacheInvalidate;
end;
***************
*** 1128,1131 ****
--- 1142,1146 ----
begin
FSelBgTranslulency := Max(Min(Value, 1), 0);
+ CacheInvalidate;
end;
***************
*** 1133,1136 ****
--- 1148,1152 ----
begin
FSelFgColor := Value;
+ CacheInvalidate;
end;
***************
*** 1141,1144 ****
--- 1157,1161 ----
FItems.Sorted := Value;
FItems.EndUpdate;
+ CacheInvalidate;
end;
***************
*** 1167,1170 ****
--- 1184,1188 ----
FScrollBar.Max := FItems.Count - FScrollBar.PageSize;
FScrollBar.LargeChange := FScrollBar.PageSize;
+ CacheInvalidate;
end;
***************
*** 1176,1179 ****
--- 1194,1198 ----
FMouseDown := False;
FTimerScrolling := -1;
+ CacheInvalidate;
end;
end;
***************
*** 1237,1245 ****
0: begin
FScrollBar.Trigger(scLineUp);
! FItemIndex := FScrollBar.Position;
end;
1: begin
FScrollBar.Trigger(scLineDown);
! FItemIndex := (Height div FItemHeight) + FScrollBar.Position - 1;
end;
end;
--- 1256,1264 ----
0: begin
FScrollBar.Trigger(scLineUp);
! ItemIndex := FScrollBar.Position;
end;
1: begin
FScrollBar.Trigger(scLineDown);
! ItemIndex := (Height div FItemHeight) + FScrollBar.Position - 1;
end;
end;
***************
*** 1311,1315 ****
procedure TvglCheckBox.CheckMarkOver(X, Y: Integer);
begin
! FMouseMarkOver := PointInRect(GetCheckMarkBounds(ScreenBounds), X, Y);
end;
--- 1330,1338 ----
procedure TvglCheckBox.CheckMarkOver(X, Y: Integer);
begin
! if PointInRect(GetCheckMarkBounds(ScreenBounds), X, Y) <> FMouseMarkOver then
! begin
! FMouseMarkOver := not FMouseMarkOver;
! CacheInvalidate;
! end;
end;
***************
*** 1337,1340 ****
--- 1360,1364 ----
procedure TvglCheckBox.DoChanged;
begin
+ CacheInvalidate;
if Assigned(FOnChanged) then
FOnChanged(Self);
***************
*** 1355,1358 ****
--- 1379,1383 ----
if PointInRect(GetCheckMarkBounds(ScreenBounds), X, Y) then
FMouseMarkDown := True;
+ CacheInvalidate;
end;
***************
*** 1361,1364 ****
--- 1386,1390 ----
inherited DoOnMouseEntry;
FMouseOver := True;
+ CacheInvalidate;
end;
***************
*** 1368,1371 ****
--- 1394,1398 ----
FMouseOver := False;
FMouseMarkOver := False;
+ CacheInvalidate;
end;
***************
*** 1380,1383 ****
--- 1407,1411 ----
inherited DoOnMouseUp(mb, x, y);
FMouseMarkDown := False;
+ CacheInvalidate;
end;
***************
*** 1442,1445 ****
--- 1470,1474 ----
begin
FChecked := Value;
+ CacheInvalidate;
end;
***************
*** 1447,1450 ****
--- 1476,1480 ----
begin
FCaptionText.SetColor(Value);
+ CacheInvalidate;
end;
|
|
From: Michael H. <mh...@us...> - 2001-01-06 19:52:41
|
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;
|
|
From: Luiz P. <lui...@us...> - 2001-01-03 07:09:12
|
Update of /cvsroot/pythianproject/PythianProject/Bin In directory usw-pr-cvs1:/tmp/cvs-serv3697 Added Files: whrandom.py TimeLog.txt testscript.py readme.txt python15.dll Log Message: no message --- NEW FILE --- Total Time: 30171 Bass Music Engine: 1 (0,00%) Input Engine: 8 (0,00%) Camera Engine: 520 (0,02%) Map Engine: 15 (0,00%) AI Engine: 7 (0,00%) Dynamic Objects Engine: 23 (0,00%) Physics Engines: 98 (0,00%) Scripting Engine: 5 (0,00%) Graphics Engine: 29304 (0,97%) |
|
From: Luiz P. <lui...@us...> - 2001-01-03 07:08:26
|
Update of /cvsroot/pythianproject/PythianProject/Bin In directory usw-pr-cvs1:/tmp/cvs-serv3635 Added Files: ErrorLog.txt data.cml Credits.txt bass.dll ailibgen.aiml aifile.aiml Log Message: no message --- NEW FILE --- @958482 fatal exception in "Camera Engine" - GetSectorAtXZ co-ords out of bounds |
|
From: Luiz P. <lui...@us...> - 2001-01-03 06:25:49
|
Update of /cvsroot/pythianproject/PythianProject/Bin/DATA/models In directory usw-pr-cvs1:/tmp/cvs-serv31696/DATA/models Removed Files: Guy.bmp Guy.pmf Guy.tex Hueteotl.bmp Hueteotl.pmf Hueteotl.tex rock1.bmp rock1.pmf rock1_0.tex tree1.bmp tree1.pmf tree1_0.tex Log Message: no message --- Guy.bmp DELETED --- --- Guy.pmf DELETED --- --- Guy.tex DELETED --- --- Hueteotl.bmp DELETED --- --- Hueteotl.pmf DELETED --- --- Hueteotl.tex DELETED --- --- rock1.bmp DELETED --- --- rock1.pmf DELETED --- --- rock1_0.tex DELETED --- --- tree1.bmp DELETED --- --- tree1.pmf DELETED --- --- tree1_0.tex DELETED --- |
|
From: Luiz P. <lui...@us...> - 2001-01-03 06:25:49
|
Update of /cvsroot/pythianproject/PythianProject/Bin/DATA/maps In directory usw-pr-cvs1:/tmp/cvs-serv31696/DATA/maps Removed Files: IslandSmall.pmm IslandSmall0.pmp islandsmall.bmp Log Message: no message --- IslandSmall.pmm DELETED --- --- IslandSmall0.pmp DELETED --- --- islandsmall.bmp DELETED --- |
|
From: Luiz P. <lui...@us...> - 2001-01-03 06:25:49
|
Update of /cvsroot/pythianproject/PythianProject/Bin/DATA/images In directory usw-pr-cvs1:/tmp/cvs-serv31696/DATA/images Removed Files: logo1.bmp Log Message: no message --- logo1.bmp DELETED --- |
|
From: Luiz P. <lui...@us...> - 2001-01-03 06:25:48
|
Update of /cvsroot/pythianproject/PythianProject/Bin/DATA/fonts In directory usw-pr-cvs1:/tmp/cvs-serv31696/DATA/fonts Removed Files: arial1.glf courier1.glf crystal1.glf techno0.glf techno1.glf times_new1.glf Log Message: no message --- arial1.glf DELETED --- --- courier1.glf DELETED --- --- crystal1.glf DELETED --- --- techno0.glf DELETED --- --- techno1.glf DELETED --- --- times_new1.glf DELETED --- |
Update of /cvsroot/pythianproject/PythianProject/Bin In directory usw-pr-cvs1:/tmp/cvs-serv31696 Removed Files: Credits.txt aifile.aiml ailibgen.aiml bass.dll data.cml python15.dll readme.txt testscript.py whrandom.py Log Message: no message --- Credits.txt DELETED --- --- aifile.aiml DELETED --- --- ailibgen.aiml DELETED --- --- bass.dll DELETED --- --- data.cml DELETED --- --- python15.dll DELETED --- --- readme.txt DELETED --- --- testscript.py DELETED --- --- whrandom.py DELETED --- |
|
From: Luiz P. <lui...@us...> - 2001-01-03 06:24:19
|
Update of /cvsroot/pythianproject/PythianProject/Bin/DATA/textures/256x256 In directory usw-pr-cvs1:/tmp/cvs-serv31524 Removed Files: Skybk.bmp Skyft.bmp Skylf.bmp Skyrt.bmp Skyup.bmp Log Message: no message --- Skybk.bmp DELETED --- --- Skyft.bmp DELETED --- --- Skylf.bmp DELETED --- --- Skyrt.bmp DELETED --- --- Skyup.bmp DELETED --- |
|
From: Michael H. <mh...@us...> - 2001-01-02 21:46:24
|
Update of /cvsroot/pythianproject/Prototypes/GUISystem
In directory usw-pr-cvs1:/tmp/cvs-serv18544/GUISystem
Modified Files:
StartupForm.pas vglClasses.pas vglStdCtrls.pas
Log Message:
added drag'n'drop -mike
Index: StartupForm.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/StartupForm.pas,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -r1.11 -r1.12
*** StartupForm.pas 2000/12/22 20:06:40 1.11
--- StartupForm.pas 2001/01/02 21:46:20 1.12
***************
*** 19,23 ****
{ Private declarations }
c:TvglComponent;
! Image1:TvglImage;
Button :TvglButton;
Panel1:TvglPanel;
--- 19,23 ----
{ Private declarations }
c:TvglComponent;
! Image1:TvglDraggableImage;
Button :TvglButton;
Panel1:TvglPanel;
***************
*** 28,34 ****
cc: TvglComponent;
Edit1:TvglEdit;
- ClipTestP1,ClipTestP2,ClipTestP3,ClipTestP4 :TvglPanel;
SLE :TvglSingleLineEdit;
Elapsed,FirstTime:Cardinal;
public
--- 28,35 ----
cc: TvglComponent;
Edit1:TvglEdit;
SLE :TvglSingleLineEdit;
+ DragBox :TvglDragBox;
+
Elapsed,FirstTime:Cardinal;
public
***************
*** 78,82 ****
Elapsed := timeGetTime - FirstTime; // elapsed time from beginning - GLForm.Run
InterfaceManager.Update(Elapsed);
!
InterfaceManager.DrawAll;
end;
--- 79,83 ----
Elapsed := timeGetTime - FirstTime; // elapsed time from beginning - GLForm.Run
InterfaceManager.Update(Elapsed);
!
InterfaceManager.DrawAll;
end;
***************
*** 188,192 ****
c.Width := 50; c.Height := 50;
! Image1 := TvglImage.Create('Image1',InterfaceManager.Desktop);
Image1.LoadImage('olog.png');
Image1.Bounds := Rect(500,20,0,0);
--- 189,193 ----
c.Width := 50; c.Height := 50;
! Image1 := TvglDraggableImage.Create('Image1',InterfaceManager.Desktop);
Image1.LoadImage('olog.png');
Image1.Bounds := Rect(500,20,0,0);
***************
*** 210,227 ****
Button.HasHotkey := True;
- { // now for clipping test panels
- ClipTestP1 := TvglPanel.Create('ClipTest1',InterfaceManager.Desktop);
- ClipTestp1.Color := clRed;
- ClipTestp1.Bounds := Rect(270,290,580,450);
- ClipTestP4 := TvglPanel.Create('ClipTest4',ClipTestP1);
- ClipTestP4.Textured := true;
- ClipTestP4.Bounds := Rect(80,80,150,150);
- ClipTestP2 := TvglPanel.Create('ClipTest2',ClipTestP1);
- ClipTestP2.Color := clBlue;
- ClipTestP2.Bounds := Rect(10,10,100,100);
- ClipTestP3 := TvglPanel.Create('ClipTest3',ClipTestP2);
- ClipTestP3.Color := clGreen;
- ClipTestP3.Bounds := Rect(-60,-60,60,60); }
-
Label1 := TvglTextBox.Create('Label1',InterfaceManager.Desktop);
Label1.Top := 192;
--- 211,214 ----
***************
*** 263,266 ****
--- 250,256 ----
SLE := TvglSingleLineEdit.Create('SLE1',InterfaceManager.Desktop);
SLE.Bounds := Rect(20,300,220,400);
+
+ DragBox := TvglDragBox.Create('DragBox1',InterfaceManager.Desktop);
+ DragBox.Bounds := Rect(500,400,550,450);
InterfaceManager.SetNewFocus(LB);
Index: vglClasses.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/vglClasses.pas,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -r1.9 -r1.10
*** vglClasses.pas 2001/01/01 19:07:21 1.9
--- vglClasses.pas 2001/01/02 21:46:20 1.10
***************
*** 194,197 ****
--- 194,198 ----
FBounds: TRect; // this is relative to the owner
FCanvas: TglCanvas;
+ FTotalAlpha :Single; // global alpha filter. should be added to any alpha drawing ops
FChildren :TvglObjList;
FManager :TvglInterfaceManager;
***************
*** 225,229 ****
procedure CacheEnd; dynamic ;
procedure CacheInit; dynamic;
! procedure CacheFinalize; dynamic;
procedure DrawSelf(where:TRect); virtual; // where is screen relative, bounds is parent relative
--- 226,230 ----
procedure CacheEnd; dynamic ;
procedure CacheInit; dynamic;
! procedure CacheFinalize; dynamic;
procedure DrawSelf(where:TRect); virtual; // where is screen relative, bounds is parent relative
***************
*** 275,278 ****
--- 276,280 ----
property Focused: Boolean read GetFocused write SetFocused;
property Focusable: Boolean read FFocusable;
+ property TotalAlpha :Single read FTotalAlpha write FTotalAlpha;
property Owner :TvglComponent read FOwner write SetOwner;
property Canvas :TGLCanvas read FCanvas write FCanvas;
***************
*** 286,289 ****
--- 288,294 ----
destructor Destroy; override ; // destroying an object also destroys its children
+ procedure MoveTo(x,y:integer);
+ procedure MoveBy(x,y:integer);
+
{ child management }
function AddChild(child:TvglComponent):integer; // connects object to this object as child, returns index in list
***************
*** 334,337 ****
--- 339,365 ----
end;
+ { Drag objects can be descended from this to allow ghost drags and movement drags }
+ TvglDragObject = class
+ DragOrigin :TPoint;
+ CurPoint :TPoint;
+ constructor Create(aDragOrigin:TPoint);
+ procedure StartDrag; virtual ;
+ procedure EndDrag; virtual ;
+ procedure Move(amountX,amountY:integer); virtual ;
+ end;
+
+ TVGLDragBroadcastEvent = procedure(amountX,amountY:integer) of object;
+
+ TvglDragBroadcasterObject = class(TvglDragObject)
+ OnDrag :TVGLDragBroadcastEvent;
+ procedure Move(amountX,amountY:integer); override ;
+ end;
+
+ // copy drags are redrawn in their correct pos by the interface manager
+ TvglDragCopyObject = class(TvglDragObject)
+ CopyComponent :TvglComponent;
+ constructor Create(aDragOrigin:TPoint; aCopyComponent:TvglComponent);
+ end;
+
{ Desktop component, basic container that displays a wallpaper
and child components (all components are children of the desktop) }
***************
*** 381,384 ****
--- 409,419 ----
end;
+ TvglDraggableImage = class(TvglImage)
+ protected
+ FDragObj :TvglDragCopyObject;
+ procedure DoOnMouseDown(mb, X,Y:integer); override ;
+ procedure DoOnMouseUp(mb, X,Y:integer); override ;
+ end;
+
TvglMouseCursor = class(TvglComponent)
protected
***************
*** 391,394 ****
--- 426,443 ----
end;
+ // test component
+ TvglDragBox = class(TvglComponent)
+ protected
+ FDragObj :TvglDragBroadcasterObject;
+ Color :TColor;
+ function GetComponentType:string; override ;
+ procedure DoOnMouseDown(mb, X,Y:integer); override ;
+ procedure DoOnMouseUp(mb, X,Y:integer); override ;
+ procedure DragHandler(amountX,amountY:integer);
+ public
+ constructor Create(aName:string; aOwner:TvglComponent);
+ procedure DrawSelf(where:TRect); override ;
+ end;
+
{ ********************************************************************** }
{ Interface Manager }
***************
*** 417,420 ****
--- 466,471 ----
FLastFocused: TvglComponent;
FOnFocusChange: TNotifyEvent;
+ FDragObjects :TList;
+ LastDragPos :TPoint;
// these are used to generate onMouseEntry, onMouseExit events
NewMouseList, OldMouseList, TempMouseList :TvglObjList;
***************
*** 429,432 ****
--- 480,486 ----
function DoCreateDesktop: TvglDesktop; virtual;
function GetKBMod(KeyData: Integer): TVGLKBModifiers;
+
+ procedure UpdateDragObjects(newPos:TPoint);
+ procedure OverlayDragCopyObjects;
public
property Focused: TvglComponent read FFocusedComponent;
***************
*** 438,441 ****
--- 492,496 ----
property WinHandle :HWND read FWinHandle write FWinHandle;
property DefaultTextured :boolean read FDefaultTextured write FDefaultTextured;
+ property DragObjects :TList read FDragObjects;
constructor Create(aWinHandle:HWND; aScreenBounds:TRect); overload;
***************
*** 453,456 ****
--- 508,515 ----
procedure SetNewFocus(C: TvglComponent);
+ // dragging
+ procedure StartDrag(dragObj:TvglDragObject); // begins a new drag operation with the object specified
+ procedure EndDrag(dragObj:TvglDragObject); // guess
+
// events - called by host environment
procedure MouseDown(Button:byte; X,Y:integer); virtual;
***************
*** 459,463 ****
function KeyDown(KeyCode, KeyData: Integer): Boolean; virtual; // used the key?
function KeyUp(KeyCode, KeyData: Integer): Boolean; virtual;
-
published
property OnCreateDesktop: TCreateDesktopEvent read FOnCreateDesktop write SetOnCreateDesktop;
--- 518,521 ----
***************
*** 500,503 ****
--- 558,562 ----
FClickGetReady := false;
FSavedMouseDown := nil;
+ FTotalAlpha := 1.0;
FCached := false;
FCacheInvalid := true;
***************
*** 1034,1037 ****
--- 1093,1116 ----
end;
+ procedure TvglComponent.MoveTo(x, y: integer);
+ var w,h:integer;
+ begin
+ w := Width; h := Height;
+ FBounds.Left := x;
+ FBounds.Top := y;
+ Width := w; Height := h;
+ end;
+
+ procedure TvglComponent.MoveBy(x, y: integer);
+ var w,h:integer;
+ begin
+ w := Width; h := Height;
+ FBounds.Left := FBounds.Left + x;
+ FBounds.Top := FBounds.Top + y;
+ Width := w; Height := h;
+ end;
+
+
+
{ TvglObjList }
***************
*** 1060,1063 ****
--- 1139,1143 ----
WinHandle := aWinHandle;
DefaultTextured := true;
+ FDragObjects := TList.Create;
FLeft := 0; FTop := 0;
***************
*** 1078,1081 ****
--- 1158,1191 ----
end;
+ procedure TvglInterfaceManager.EndDrag(dragObj: TvglDragObject);
+ begin
+ dragObj.EndDrag;
+ if FDragObjects.IndexOf(DragObj) <> -1 then
+ FDragObjects.Delete(FDragObjects.IndexOf(DragObj));
+ end;
+
+ procedure TvglInterfaceManager.StartDrag(dragObj: TvglDragObject);
+ begin
+ FDragObjects.Add(dragObj);
+ dragObj.StartDrag;
+ end;
+
+ procedure TvglInterfaceManager.UpdateDragObjects(newPos:TPoint);
+ var
+ i:integer;
+ dx,dy:integer;
+ begin
+ // tell all drag objects about new move
+ for i := 0 to FDragObjects.Count-1 do
+ // work out difference
+ with TvglDragObject(FDragObjects[i]) do
+ begin
+ dX := newPos.x - CurPoint.x;
+ dY := newPos.Y - CurPoint.y;
+ Move(dX,dY);
+ CurPoint := newPos;
+ end;
+ end;
+
function TvglInterfaceManager.DoCreateDesktop: TvglDesktop;
begin
***************
*** 1109,1112 ****
--- 1219,1223 ----
OldMouseList.Free;
TempMouseList.Free;
+ FDragObjects.Free;
inherited;
end;
***************
*** 1117,1120 ****
--- 1228,1232 ----
Canvas.InitMatrix;
FDesktop.Draw;
+ OverlayDragCopyObjects;
FMouseCursor.Draw;
end;
***************
*** 1172,1177 ****
t:integer;
begin
- // update the cursor
-
// send event
Desktop.DoOnMouseMove(X, Y);
--- 1284,1287 ----
***************
*** 1214,1217 ****
--- 1324,1330 ----
CopyList(NewMouseList,OldMouseList);
// done!
+
+ // do drag ops
+ UpdateDragObjects(Point(X,Y));
end;
***************
*** 1291,1299 ****
inherited DrawSelf(where);
if Textured then
! Canvas.TileBitmapSubRect(FitRectToRect(where,Canvas.ClipRect),VGL_SKINRECT_BACKGROUND,FTexture)
! else begin
Canvas.CurrentColor := FColor;
Canvas.Solid := true;
! Canvas.FillAlpha := 0.5;
Canvas.Rectangle(where.Left,where.Top,where.Right,where.Bottom);
Canvas.Solid := false;
--- 1404,1414 ----
inherited DrawSelf(where);
if Textured then
! begin
! Canvas.ImageAlpha := TotalAlpha;
! Canvas.TileBitmapSubRect(FitRectToRect(where,Canvas.ClipRect),VGL_SKINRECT_BACKGROUND,FTexture);
! end else begin
Canvas.CurrentColor := FColor;
Canvas.Solid := true;
! Canvas.FillAlpha := TotalAlpha - 0.5;
Canvas.Rectangle(where.Left,where.Top,where.Right,where.Bottom);
Canvas.Solid := false;
***************
*** 1335,1338 ****
--- 1450,1454 ----
begin
inherited DrawSelf(where);
+ Canvas.ImageAlpha := TotalAlpha;
Canvas.DrawBitmap(where.Left,where.Top,FImage);
end;
***************
*** 1389,1392 ****
--- 1505,1509 ----
begin
inherited DrawSelf(where);
+ Canvas.ImageAlpha := 1.0;
Canvas.DrawBitmapSubRect(where.Left,where.Top,VGL_SKINRECT_MOUSECURSOR,FImage);
end;
***************
*** 1474,1477 ****
--- 1591,1725 ----
r := rect(where.left+3,where.top,where.right-2,where.top+3);
FCanvas.TileBitmapSubRect(r,VGL_SKINRECT_BORDER1_TOP,FImage);
+ end;
+
+ { TvglDragObject }
+
+ constructor TvglDragObject.Create(aDragOrigin: TPoint);
+ begin
+ inherited Create;
+ DragOrigin := aDragOrigin;
+ CurPoint := DragOrigin;
+ end;
+
+ procedure TvglDragObject.EndDrag;
+ begin
+ // abstract
+ end;
+
+ procedure TvglDragObject.Move(amountX, amountY: integer);
+ begin
+ CurPoint.X := CurPoint.X + amountX;
+ CurPoint.Y := CurPoint.Y + amountY;
+ end;
+
+ procedure TvglDragObject.StartDrag;
+ begin
+ // abstract
+ end;
+
+ { TvglDragBroadcasterObject }
+
+ procedure TvglDragBroadcasterObject.Move(amountX, amountY: integer);
+ begin
+ inherited Move(amountX,amountY);
+ // call event handler
+ if assigned(OnDrag) then OnDrag(amountX,amountY);
+ end;
+
+
+
+ { TvglDragBox }
+
+ constructor TvglDragBox.Create(aName: string; aOwner: TvglComponent);
+ begin
+ inherited Create(aName,aOwner);
+ Color := clBlue;
+ end;
+
+ procedure TvglDragBox.DoOnMouseDown(mb, X, Y: integer);
+ begin
+ // start the drag op
+ inherited DoOnMouseDown(mb,x,y);
+
+ 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);
+ Color := clRed;
+ end;
+
+ procedure TvglDragBox.DoOnMouseUp(mb, X, Y: integer);
+ begin
+ inherited DoOnMouseUp(mb,x,y);
+
+ Manager.EndDrag(FDragObj);
+ FDragObj.Free; FDragObj := nil;
+ Color := clBlue;
+ end;
+
+ procedure TvglDragBox.DragHandler(amountX,amountY:integer);
+ begin
+ MoveBy(amountX,amountY);
+ end;
+
+ procedure TvglDragBox.DrawSelf(where: TRect);
+ begin
+ Canvas.CurrentColor := Color;
+ Canvas.Rectangle(where);
+ Canvas.Solid := false;
+ Canvas.FillAlpha := TotalAlpha - 0.5;
+ Canvas.Solid := true;
+ Canvas.Rectangle(where);
+ end;
+
+ function TvglDragBox.GetComponentType: string;
+ begin
+ result := 'DragBox';
+ end;
+
+ { TvglDragCopyObject }
+
+ constructor TvglDragCopyObject.Create(aDragOrigin: TPoint;
+ aCopyComponent: TvglComponent);
+ begin
+ inherited Create(aDragOrigin);
+ CopyComponent := aCopyComponent;
+ end;
+
+ { TvglDraggableImage }
+
+ procedure TvglDraggableImage.DoOnMouseDown(mb, X, Y: integer);
+ begin
+ inherited;
+ if assigned(FDragObj) then FDragObj.Free;
+ FDragObj := TvglDragCopyObject.Create(Point(x,y),self);
+ Manager.StartDrag(FDragObj);
+ end;
+
+ procedure TvglDraggableImage.DoOnMouseUp(mb, X, Y: integer);
+ begin
+ inherited;
+ Manager.EndDrag(FDragObj);
+ FDragObj.Free; FDragObj := nil;
+ end;
+
+ procedure TvglInterfaceManager.OverlayDragCopyObjects;
+ var
+ i:integer;
+ b:TRect;
+ a:single;
+ begin
+ for i := 0 to FDragObjects.Count-1 do
+ if TObject(FDragObjects[i]) is TvglDragCopyObject then
+ with TvglDragCopyObject(FDragObjects[i]) do
+ begin
+ b := CopyComponent.Bounds;
+ CopyComponent.MoveTo(CurPoint.X - (DragOrigin.X - CopyComponent.Bounds.Left),CurPoint.Y - (DragOrigin.Y - CopyComponent.Bounds.Top));
+ a := CopyComponent.TotalAlpha;
+ CopyComponent.TotalAlpha:= 0.5;
+ CopyComponent.Draw;
+ CopyComponent.TotalAlpha := a;
+ CopyComponent.Bounds := b;
+ end;
end;
Index: vglStdCtrls.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GUISystem/vglStdCtrls.pas,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -r1.8 -r1.9
*** vglStdCtrls.pas 2001/01/01 19:26:11 1.8
--- vglStdCtrls.pas 2001/01/02 21:46:20 1.9
***************
*** 527,539 ****
if Kind = sbHorizontal then
begin
! FCanvas.DrawBitmapSubRect(tempr.Left,tempr.Top,VGL_SKINRECT_SCROLLBUTTON_RIGHT,FImage);
! FCanvas.SetClipping(FOwner.ChildClipRect);
! //FCanvas.Rectangle(tempr.Left, tempr.Top, tempr.Right, tempr.Bottom);
tempr := GetMaxBtnRect(where);
! FCanvas.DrawBitmapSubRect(tempr.Left,tempr.Top,VGL_SKINRECT_SCROLLBUTTON_LEFT,FImage);
! FCanvas.SetClipping(FOwner.ChildClipRect);
! //FCanvas.Rectangle(tempr.Left, tempr.Top, tempr.Right, tempr.Bottom);
end else if Kind = sbVertical then
begin
FCanvas.DrawBitmapSubRect(tempr.Left,tempr.Top,VGL_SKINRECT_SCROLLBUTTON_UP,FImage);
FCanvas.SetClipping(FOwner.ChildClipRect);
--- 527,539 ----
if Kind = sbHorizontal then
begin
! Canvas.ImageAlpha := TotalAlpha;
! Canvas.DrawBitmapSubRect(tempr.Left,tempr.Top,VGL_SKINRECT_SCROLLBUTTON_RIGHT,FImage);
! Canvas.SetClipping(FOwner.ChildClipRect);
tempr := GetMaxBtnRect(where);
! Canvas.DrawBitmapSubRect(tempr.Left,tempr.Top,VGL_SKINRECT_SCROLLBUTTON_LEFT,FImage);
! Canvas.SetClipping(FOwner.ChildClipRect);
end else if Kind = sbVertical then
begin
+ Canvas.ImageAlpha := TotalAlpha;
FCanvas.DrawBitmapSubRect(tempr.Left,tempr.Top,VGL_SKINRECT_SCROLLBUTTON_UP,FImage);
FCanvas.SetClipping(FOwner.ChildClipRect);
***************
*** 550,554 ****
FCanvas.Solid := True;
FCanvas.CurrentColor := FColor;
! FCanvas.FillAlpha := FPageAlpha;
tempr := GetBodyRect(where);
FCanvas.Rectangle(tempr.Left, tempr.Top, tempr.Right, tempr.Bottom);
--- 550,554 ----
FCanvas.Solid := True;
FCanvas.CurrentColor := FColor;
! FCanvas.FillAlpha := FPageAlpha - (1-TotalAlpha);
tempr := GetBodyRect(where);
FCanvas.Rectangle(tempr.Left, tempr.Top, tempr.Right, tempr.Bottom);
***************
*** 559,566 ****
FCanvas.Solid := True;
FCanvas.CurrentColor := clNavy;
! FCanvas.FillAlpha := 0.5;
tempr := GetPageRect(where);
FCanvas.Rectangle(tempr.Left, tempr.Top, tempr.Right, tempr.Bottom);
! FCanvas.Solid := False; FCanvas.FillAlpha := 1.0;
FCanvas.Rectangle(tempr.Left, tempr.Top+1, tempr.Right-1, tempr.Bottom);
if FHighLightPaging and FMouseOver then
--- 559,566 ----
FCanvas.Solid := True;
FCanvas.CurrentColor := clNavy;
! FCanvas.FillAlpha := TotalAlpha - 0.5;
tempr := GetPageRect(where);
FCanvas.Rectangle(tempr.Left, tempr.Top, tempr.Right, tempr.Bottom);
! FCanvas.Solid := False; FCanvas.FillAlpha := TotalAlpha;
FCanvas.Rectangle(tempr.Left, tempr.Top+1, tempr.Right-1, tempr.Bottom);
if FHighLightPaging and FMouseOver then
***************
*** 577,581 ****
end;
FCanvas.CurrentColor := clBlack;
! FCanvas.FillAlpha := 1;
FCanvas.Rectangle(HP.Left, HP.Top, HP.Right, HP.Bottom);
end;
--- 577,581 ----
end;
FCanvas.CurrentColor := clBlack;
! FCanvas.FillAlpha := TotalAlpha;
FCanvas.Rectangle(HP.Left, HP.Top, HP.Right, HP.Bottom);
end;
***************
*** 902,906 ****
begin
FCanvas.CurrentColor := FColor;
! FCanvas.FillAlpha := 1 - Translucency;
FCanvas.Solid := True;
FCanvas.Rectangle(where.Left, where.Top, where.Right, where.Bottom);
--- 902,906 ----
begin
FCanvas.CurrentColor := FColor;
! FCanvas.FillAlpha := TotalAlpha - Translucency;
FCanvas.Solid := True;
FCanvas.Rectangle(where.Left, where.Top, where.Right, where.Bottom);
***************
*** 909,912 ****
--- 909,913 ----
// border code here
// background
+ FCanvas.Imagealpha := TotalAlpha;
FCanvas.TileBitmapSubRect(where,VGL_SKINRECT_BACKGROUND,FImage);
Manager.DrawBorder(where,FImage);
***************
*** 928,932 ****
begin
FCanvas.CurrentColor := FSelBgColor;
! FCanvas.FillAlpha := 1 - FSelBgTranslulency;
FCanvas.Solid := True;
FCanvas.Rectangle(DC.Left, DC.Top, DC.Right, DC.Bottom);
--- 929,933 ----
begin
FCanvas.CurrentColor := FSelBgColor;
! FCanvas.FillAlpha := TotalAlpha - FSelBgTranslulency;
FCanvas.Solid := True;
FCanvas.Rectangle(DC.Left, DC.Top, DC.Right, DC.Bottom);
***************
*** 983,986 ****
--- 984,988 ----
begin
inherited;
+ FScrollBar.TotalAlpha := TotalAlpha;
DrawClient(where);
DrawItems(where);
***************
*** 1364,1367 ****
--- 1366,1370 ----
SkinRect := GetCheckMarkSkinRect;
MarkRect := GetCheckMarkBounds(where);
+ Canvas.Imagealpha := TotalALpha;
Canvas.DrawBitmapSubRect(MarkRect.Left, MarkRect.Top, SkinRect, FImage);
if FCaptionText.Text <> '' then
***************
*** 1493,1496 ****
--- 1496,1500 ----
begin
inherited DrawSelf(where);
+ Canvas.ImageAlpha := TotalAlpha;
case FButtonState of
vglbsUp: FImage.Intensity := 255;
|
|
From: Michael H. <mh...@us...> - 2001-01-02 21:46:24
|
Update of /cvsroot/pythianproject/Prototypes/GLCanvas
In directory usw-pr-cvs1:/tmp/cvs-serv18544/GLCanvas
Modified Files:
glCanvas.pas
Log Message:
added drag'n'drop -mike
Index: glCanvas.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GLCanvas/glCanvas.pas,v
retrieving revision 1.17
retrieving revision 1.18
diff -C2 -r1.17 -r1.18
*** glCanvas.pas 2001/01/02 19:09:46 1.17
--- glCanvas.pas 2001/01/02 21:46:20 1.18
***************
*** 231,234 ****
--- 231,236 ----
TGLCanvas = class
+ private
+ FImageAlpha: Single;
protected
FWidth, FHeight :integer;
***************
*** 247,250 ****
--- 249,253 ----
property CurrentColor :TColor read GetColor write SetColor;
property FillAlpha:Single read FFillAlpha write FFillAlpha;
+ property ImageAlpha:Single read FImageAlpha write FImageAlpha;
property ClipRect :TRect read FClipRect;
***************
*** 513,517 ****
begin
glEnable(GL_SCISSOR_TEST);
! glColor3ub(bmp.Red,bmp.Green,bmp.Blue);
glScissor(x,Height-y-aHeight,aWidth-1,aHeight);
DrawTexBmp(offsetx,offsety,aWidth,aHeight,bmp.TexData);
--- 516,520 ----
begin
glEnable(GL_SCISSOR_TEST);
! glColor4ub(bmp.Red,bmp.Green,bmp.Blue,Round(255 * ImageAlpha));
glScissor(x,Height-y-aHeight,aWidth-1,aHeight);
DrawTexBmp(offsetx,offsety,aWidth,aHeight,bmp.TexData);
***************
*** 522,526 ****
r := FitRectToRect(Rect(x,y,x+aWidth,y+aHeight),FClipRect);
glPushAttrib(GL_SCISSOR_TEST);
! glColor3ub(bmp.Red,bmp.Green,bmp.Blue);
glScissor(r.left,Height-r.bottom,r.right-r.left-1,r.bottom-r.top);
DrawTexBmp(offsetx,offsety,aWidth,aHeight,bmp.TexData);
--- 525,529 ----
r := FitRectToRect(Rect(x,y,x+aWidth,y+aHeight),FClipRect);
glPushAttrib(GL_SCISSOR_TEST);
! glColor4ub(bmp.Red,bmp.Green,bmp.Blue,Round(255 * ImageAlpha));
glScissor(r.left,Height-r.bottom,r.right-r.left-1,r.bottom-r.top);
DrawTexBmp(offsetx,offsety,aWidth,aHeight,bmp.TexData);
|
16 messages has been excluded from this view by a project administrator.
