|
From: Michael H. <mh...@us...> - 2001-08-10 22:06:47
|
Update of /cvsroot/pythianproject/PythianProject/Source/Conversation/GUI
In directory usw-pr-cvs1:/tmp/cvs-serv23470/Conversation/GUI
Added Files:
ConversationGUIComponents.pas GUIMockup.cfg GUIMockup.dof
GUIMockup.dpr GUIMockup.res StartupForm.dfm StartupForm.pas
Log Message:
Adding conversation stuff -mike
--- NEW FILE ---
unit ConversationGUIComponents;
interface
uses Windows, Classes, Math, GLCanvas, vglClasses, Graphics, SysUtils, Trace;
type
TvglConversationLogItem = record
Name :string;
Color :TColor;
Content :string;
end;
TvglConversationLogItemList = array of TvglConversationLogItem;
TvglConversationLog = class(TvglComponent)
protected
FText :TGLText; // for each line
FLines :TvglConversationLogItemList;
FLineSpacing: integer;
FMaxLines: integer;
function GetComponentType:string; override;
public
property Lines :TvglConversationLogItemList read FLines;
property LineSpacing :integer read FLineSpacing write FLineSpacing;
property MaxLines :integer read FMaxLines write FMaxLines;
constructor Create(aName:string; AOwner:TvglComponent);
destructor Destroy; override;
procedure DrawSelf(where:TRect); override;
procedure AddLine(aName,aContent:string; aColor:TColor);
end;
TvglConversationSelectEvent = procedure (Item:integer; Sender:TObject) of object;
TvglConversationSelector = class(TvglComponent)
protected
FSkin :TGLBitmap;
FText :TGLText;
FOptions :TStringList;
FOptionSpacing :integer;
FOptionsButtonWidth :integer;
FHighlightedItem :integer;
FOnItemSelect: TvglConversationSelectEvent;
function GetComponentType:string; override;
procedure DoOnMouseMove(X, Y: Integer); override ;
procedure DoOnMouseClick(x,y:integer); override ;
public
property Options :TStringList read FOptions;
property OptionSpacing :integer read FOptionSpacing write FOptionSpacing;
property HighlightedItem :integer read FHighlightedItem write FHighlightedItem;
// called when a conversation object is selected
property OnItemSelect :TvglConversationSelectEvent read FOnItemSelect write FOnItemSelect;
constructor Create(aName:string; AOwner:TvglComponent);
destructor Destroy; override;
procedure DrawSelf(where:TRect); override;
end;
implementation
{ TvglConversationLog }
procedure TvglConversationLog.AddLine(aName,aContent:string; aColor:TColor);
var i:TvglConversationLogItem;
a:integer;
begin
SetLength(Flines,Length(FLines)+1);
i.Name := aName;
i.Content := aContent;
i.Color := aColor;
FLines[Length(FLines)-1] := i;
if Length(FLines) > MaxLines then
begin
// shift them all down by one, and then remove last item.
for a := 0 to Length(FLines)-1 do
FLines[a] := FLines[Min(a+1,Length(Flines)-1)];
SetLength(FLines,Length(FLines)-1);
end;
end;
constructor TvglConversationLog.Create(aName:string; AOwner: TvglComponent);
begin
inherited Create(aName,AOwner);
SetLength(FLines,0);
LineSpacing := 12;
FText := TGLText.Create('Arial8');
MaxLines := 5;
end;
destructor TvglConversationLog.Destroy;
begin
FText.Free;
inherited;
end;
procedure TvglConversationLog.DrawSelf(where: TRect);
const Gap = 6; // left hand border
var i,w:integer;
begin
inherited DrawSelf(where);
// discover longest line for name alignment
w := 0;
for i := 0 to Length(FLines)-1 do
begin
FText.Text := FLines[i].Name;
if FText.Width[0] > w then w := FText.Width[0];
end;
for i := 0 to Length(FLines)-1 do
begin
FText.Text := FLines[i].Name+':';
FText.SetColor(Flines[i].Color);
Canvas.DrawText(where.left+Gap+w-FText.Width[0],where.top+(i*LineSpacing),FText);
FText.Text := FLines[i].Content;
FText.SetColor(clWhite);
Canvas.DrawText(where.left+Gap+w,where.top+(i*LineSpacing),FText);
end;
end;
function TvglConversationLog.GetComponentType: string;
begin
Result := 'ConversationLog';
end;
{ TvglConversationSelector }
constructor TvglConversationSelector.Create(aName: string;
AOwner: TvglComponent);
begin
inherited Create(aName,aOwner);
FSkin := TGLBitmap(Manager.GetResource(VGL_SKIN_1));
FText := TGLText.Create('Arial8');
FOptions := TStringList.Create;
FOptionSpacing := 20;
FOptionsButtonWidth := 90;
HighlightedItem := 0; // no highlight
FOnItemSelect := nil;
end;
destructor TvglConversationSelector.Destroy;
begin
FSkin := nil;
FOptions.Free;
FText.Free;
inherited;
end;
procedure TvglConversationSelector.DoOnMouseClick(x, y: integer);
var h:integer;
begin
inherited DoOnMouseClick(x,y);
if not assigned(FOnItemSelect) then exit;
if not ((X >= Bounds.Left) and (X <= Bounds.Right) and (Y >= Bounds.Top) and (Y <= Bounds.Bottom)) then exit;
if (Y - Bounds.Top) > 20 then
h := (Y - Bounds.Top) div 20 // which item to highlight?
else h := 0;
TraceString(IntToStr(h));
if (h > 0) and (h <= Options.Count) then
FOnItemSelect(h,self);
end;
procedure TvglConversationSelector.DoOnMouseMove(X, Y: Integer);
begin
inherited DoOnMouseMove(x,y);
if not ((X >= Bounds.Left) and (X <= Bounds.Right) and (Y >= Bounds.Top) and (Y <= Bounds.Bottom)) then exit;
if (Y - Bounds.Top) > 20 then
HighlightedItem := (Y - Bounds.Top) div 20 // which item to highlight?
else HighlightedItem := 0;
end;
procedure TvglConversationSelector.DrawSelf(where: TRect);
var i:integer;
procedure Splat(x,y:integer);
begin
Canvas.DrawBitmapSubRect(x,y,VGL_SKINRECT_SMALLBUTTON1,FSkin);
end;
procedure SplatWithNum(x,y,n:integer);
begin
Splat(x,y);
FText.SetColor(clWhite);
FText.Text := IntToStr(n);
Canvas.DrawText(x+3,y-3,FText);
end;
begin
inherited DrawSelf(where);
// Draw top line and options button
Canvas.Line(where.left,where.top+7,where.right - FOptionsButtonWidth,where.top+7);
SplatWithNum(where.right - FOptionsButtonWidth + 5, where.top, 0 );
FText.Text := 'Options';
Canvas.DrawText(where.right - FOptionsButtonWidth + 20, where.top-3,FText);
// Draw options
for i := 0 to FOptions.Count-1 do
begin
SplatWithNum(where.left,where.top+ (OptionSpacing*(i+1)),i+1);
FText.Text := FOptions[i];
if HighlightedItem-1 = i then
FText.SetColor(clYellow)
else FText.SetColor(clWhite);
Canvas.DrawText(where.left+20,where.top+ (OptionSpacing*(i+1)) - 3, FText);
end;
end;
function TvglConversationSelector.GetComponentType: string;
begin
Result := 'ConversationSelector';
end;
end.
--- 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
-E..\..\..\Bin
-LNe:\program files\borland\delphi4\Lib
-U..\..\VGL;..\..\GLCanvas;..\..\Units;..\..\Textures
-O..\..\VGL;..\..\GLCanvas;..\..\Units;..\..\Textures
-I..\..\VGL;..\..\GLCanvas;..\..\Units;..\..\Textures
-R..\..\VGL;..\..\GLCanvas;..\..\Units;..\..\Textures
--- NEW FILE ---
[Compiler]
A=1
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=..\..\..\Bin
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=..\..\VGL;..\..\GLCanvas;..\..\Units;..\..\Textures
Packages=VCL40;VCLX40;VCLDB40;VCLDBX40;VCLSMP40;QRPT40;TEEUI40;TEEDB40;TEE40;ibevnt40;nmfast40;TreeNTControl;glPanelPkg
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=2057
CodePage=1252
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=
[Excluded Packages]
E:\cvs\pythianproject\Prototypes\AI\Flocking\Flocking.bpl=RiverSoftAVG Flocking Components
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlSearchPath]
Count=3
Item0=..\..\VGL;..\..\GLCanvas;..\..\Units;..\..\Textures
Item1=..\Units;..\GLForm;..\GLCanvas;..\Textures
Item2=..\Units;..\GLForm;..\GLCanvas
[HistoryLists\hlOutputDirectorry]
Count=7
Item0=..\..\..\Bin
Item1=E:\cvs\pythianproject-openave\PythianProject\Bin
Item2=E:\cvs\pythianproject\PythianProject\Bin
Item3=E:\cvs\pythianproject-\PythianProject\Bin
Item4=..\..\Bin
Item5=.\..\..\Bin
Item6="..\..\Bin"
--- NEW FILE ---
program GUIMockup;
uses
Forms,
StartupForm in 'StartupForm.pas' {Form1},
ConversationGUIComponents in 'ConversationGUIComponents.pas';
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
--- NEW FILE ---
--- NEW FILE ---
ÿ
Font.ColorclWindowTextFont.Heightõ Font.Name
MS Sans Serif
Font.Style
TextHeight
--- NEW FILE ---
unit StartupForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, GLForms, GLCanvas, OpenGL, vglClasses, vglStdCtrls, vglEdits,
vglAnimatedImage, DeviceModes, Trace, ConversationGUIComponents;
{$DEFINE DEVELOPMENT}
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
GLForm :TGLForm;
InterfaceManager :TvglInterfaceManager;
GLC: TGLCanvas;
Wallpaper :TvglImage;
ConvLog :TvglConversationLog;
ConvSelector :TvglConversationSelector;
Elapsed,FirstTime:Cardinal;
public
{ Public declarations }
procedure Go;
procedure OnItemSelect(Item:integer; Sender:TObject);
procedure GLFormPaint(Sender:TObject);
procedure GLKeypress(Sender: TObject; KeyCode, KeyData: LongInt;
ButtonState: TButtonState; Modifiers: TKBModifiers);
procedure GLMouseMove(Sender: TObject; X, Y: Integer;
Modifiers: TKBModifiers);
procedure GLMousebutton(Sender: TObject; Button: TMouseButton;
X, Y: Integer; ButtonState: TButtonState;
Modifiers: TKBModifiers);
end;
var
Form1: TForm1;
function timeGetTime: Cardinal; external 'winmm.dll' name 'timeGetTime';
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
go;
end;
procedure TForm1.GLFormPaint(Sender: TObject);
begin
glClear(GL_DEPTH_BUFFER_BIT);
Elapsed := timeGetTime - FirstTime; // elapsed time from beginning - GLForm.Run
InterfaceManager.Update(Elapsed);
InterfaceManager.DrawAll;
end;
procedure TForm1.GLKeypress(Sender: TObject; KeyCode, KeyData: Integer;
ButtonState: TButtonState; Modifiers: TKBModifiers);
begin
if keycode = vk_escape then DestroyWindow(GLForm.Handle)
else begin
case ButtonState of
bsUp: InterfaceManager.KeyUp(KeyCode, KeyData);
bsDown: InterfaceManager.KeyDown(KeyCode, KeyData);
end;
end;
end;
procedure TForm1.GLMousebutton(Sender: TObject; Button: TMouseButton; X,
Y: Integer; ButtonState: TButtonState; Modifiers: TKBModifiers);
begin
case Button of
mbLeft: if ButtonState = bsUp then InterfaceManager.MouseUp(VGL_MOUSE_LEFT,X,Y) else InterfaceManager.MouseDown(VGL_MOUSE_LEFT,X,Y);
mbRight: if ButtonState = bsUp then InterfaceManager.MouseUp(VGL_MOUSE_RIGHT,X,Y) else InterfaceManager.MouseDown(VGL_MOUSE_RIGHT,X,Y);
end;
end;
procedure TForm1.GLMouseMove(Sender: TObject; X, Y: Integer;
Modifiers: TKBModifiers);
begin
InterfaceManager.MouseMove(X,Y);
end;
procedure TForm1.Go;
begin
// Begin initialization of GUI
GetDeviceModes;
GLForm := TGLForm.Create;
GLForm.FullScreen := True;
GLForm.SetBounds(0,0,640,480);
GLForm.DeviceMode := FindMode(640,480,16);
GLForm.Caption := 'Conversation Demo v1';
GLForm.OnPaint := GLFormPaint;
GLForm.OnKeyPress := GLKeypress;
GLForm.OnMouseButton := GLMousebutton;
GLForm.OnMouseMove := GLMouseMove;
GLForm.ShowFPS := true;
// run the program
GLForm.Open;
{$IFDEF DEVELOPMENT}
VGL_DATADIR := 'data\gui\';
FontsDirectory := 'data\gui\';
{$ENDIF}
VGL_SKIN_1 := VGL_DATADIR + 'skin1.png';
VGL_SKIN_2 := VGL_DATADIR + 'newskin-background.png';
if not GLForm.FullScreen then
GLC := TGLCanvas.Create(GLForm.Width-6,GLForm.Height-25) // must take into account window borders
else
GLC := TGLCanvas.Create(638,478);
InterfaceManager := TvglInterfaceManager.Create(GLForm.Handle, GLC);
// Create components
Wallpaper := TvglImage.Create('Wallpaper',InterfaceManager.Desktop);
Wallpaper.Bounds := Rect(0,0,640,480);
Wallpaper.LoadImage('data\gui\ConversationGUIMockupBackground.png');
ConvLog := TvglConversationLog.Create('ConvLog',InterfaceManager.Desktop);
ConvLog.Bounds := Rect(10,10,630,100);
ConvLog.AddLine('Player','Who is that fox?',clRed);
ConvLog.AddLine('Mike','Nelly Furtardo - she is a goddess',clAqua);
ConvSelector := TvglConversationSelector.Create('ConvSelector',InterfaceManager.Desktop);
ConvSelector.Bounds := Rect(10,370,630,470);
ConvSelector.Options.Add('Yes, I agree, Nelly totally rocks');
ConvSelector.Options.Add('As always Mike you are totally correct.');
ConvSelector.Options.Add('Indeed, I went to worship her at Bargain CD Basement only the other day!');
ConvSelector.OnItemSelect := OnItemSelect;
Hide;
ShowCursor(false);
FirstTime := timeGetTime;
GLForm.Run;
ShowCursor(true);
// clear up
GLForm.Close;
GLForm.Free;
InterfaceManager.Free;
Close;
end;
procedure TForm1.OnItemSelect(Item: integer; Sender: TObject);
begin
ConvLog.AddLine('Player',ConvSelector.Options[item-1],clRed);
ConvLog.AddLine('Mike','So what are you waiting for - go and buy her album!',clAqua);
end;
end.
|