?? drawscrn.pas
字號:
unit DrawScrn;
interface
uses
svn, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DXDraws, DXClass, DirectX, IntroScn, Actor, cliUtil, clFunc,
HUtil32;
const
MAXSYSLINE = 8;
BOTTOMBOARD = 1;
VIEWCHATLINE = 9;
AREASTATEICONBASE = 150;
HEALTHBAR_BLACK = 0;
HEALTHBAR_RED = 1;
HEALTHBAR_BLUE = 10;
HEALTHBAR_YELLOW = 11;
HEALTHBAR_GREEN = 12;
HEALTHBAR_PINK = 13;
HEALTHBAR_SEA = 14;
type
TDrawScreen = class
private
m_dwFrameTime :LongWord;
m_dwFrameCount :LongWord;
m_dwDrawFrameCount :LongWord;
m_SysMsgList :TStringList;
public
CurrentScene: TScene;
ChatStrs: TStringList;
ChatBks: TList;
ChatBoardTop: integer;
HintList: TStringList;
HintX, HintY, HintWidth, HintHeight: integer;
HintUp: Boolean;
HintColor: TColor;
constructor Create;
destructor Destroy; override;
procedure KeyPress (var Key: Char);
procedure KeyDown (var Key: Word; Shift: TShiftState);
procedure MouseMove (Shift: TShiftState; X, Y: Integer);
procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Initialize;
procedure Finalize;
procedure ChangeScene (scenetype: TSceneType);
procedure DrawScreen (MSurface: TDirectDrawSurface);
procedure DrawScreenTop (MSurface: TDirectDrawSurface);
procedure AddSysMsg (msg: string);
procedure AddChatBoardString (str: string; fcolor, bcolor: integer);
procedure ClearChatBoard;
procedure ShowHint (x, y: integer; str: string; color: TColor; drawup: Boolean);
procedure ClearHint;
procedure DrawHint (MSurface: TDirectDrawSurface);
end;
implementation
uses
ClMain, MShare, Share;
constructor TDrawScreen.Create;
var
i: integer;
begin
CurrentScene := nil;
m_dwFrameTime := GetTickCount;
m_dwFrameCount := 0;
m_SysMsgList := TStringList.Create;
ChatStrs := TStringList.Create;
ChatBks := TList.Create;
ChatBoardTop := 0;
HintList := TStringList.Create;
end;
destructor TDrawScreen.Destroy;
begin
m_SysMsgList.Free;
ChatStrs.Free;
ChatBks.Free;
HintList.Free;
inherited Destroy;
end;
procedure TDrawScreen.Initialize;
begin
end;
procedure TDrawScreen.Finalize;
begin
end;
procedure TDrawScreen.KeyPress (var Key: Char);
begin
if CurrentScene <> nil then
CurrentScene.KeyPress (Key);
end;
procedure TDrawScreen.KeyDown (var Key: Word; Shift: TShiftState);
begin
if CurrentScene <> nil then
CurrentScene.KeyDown (Key, Shift);
end;
procedure TDrawScreen.MouseMove (Shift: TShiftState; X, Y: Integer);
begin
if CurrentScene <> nil then
CurrentScene.MouseMove (Shift, X, Y);
end;
procedure TDrawScreen.MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if CurrentScene <> nil then
CurrentScene.MouseDown (Button, Shift, X, Y);
end;
procedure TDrawScreen.ChangeScene (scenetype: TSceneType);
begin
if CurrentScene <> nil then
CurrentScene.CloseScene;
case scenetype of
stIntro: CurrentScene := IntroScene;
stLogin: CurrentScene := LoginScene;
stSelectCountry: ;
stSelectChr: CurrentScene := SelectChrScene;
stNewChr: ;
// stLoading: CurrentScene := LoadingScene;
// stLoginNotice: CurrentScene := LoginNoticeScene;
stPlayGame: CurrentScene := PlayScene;
end;
if CurrentScene <> nil then begin
CurrentScene.OpenScene;
if (scenetype = stLogin) and g_boAutoLogin then FrmMain.SendLogin(LowerCase(g_sAutoID),g_sAutoPass);
end;
end;
procedure TDrawScreen.AddSysMsg (msg: string);
begin
if m_SysMsgList.Count >= 10 then m_SysMsgList.Delete (0);
m_SysMsgList.AddObject (msg, TObject(GetTickCount));
end;
procedure TDrawScreen.AddChatBoardString (str: string; fcolor, bcolor: integer);
var
i, len, aline: integer;
dline, temp: string;
const
BOXWIDTH = (SCREENWIDTH div 2 - 214) * 2{374}; //41 聊天框文字寬度
begin
len := Length (str);
temp := '';
i := 1;
while TRUE do begin
if i > len then break;
if byte (str[i]) >= 128 then begin
temp := temp + str[i];
Inc (i);
if i <= len then temp := temp + str[i]
else break;
end else
temp := temp + str[i];
aline := FrmMain.Canvas.TextWidth (temp);
if aline > BOXWIDTH then begin
ChatStrs.AddObject (temp, TObject(fcolor));
ChatBks.Add (Pointer(bcolor));
str := Copy (str, i+1, Len-i);
temp := '';
break;
end;
Inc (i);
end;
if temp <> '' then begin
ChatStrs.AddObject (temp, TObject(fcolor));
ChatBks.Add (Pointer(bcolor));
str := '';
end;
if ChatStrs.Count > 200 then begin
ChatStrs.Delete (0);
ChatBks.Delete (0);
if ChatStrs.Count - ChatBoardTop < VIEWCHATLINE then Dec(ChatBoardTop);
end else if (ChatStrs.Count-ChatBoardTop) > VIEWCHATLINE then begin
Inc (ChatBoardTop);
end;
if str <> '' then
AddChatBoardString (' ' + str, fcolor, bcolor);
end;
procedure TDrawScreen.ShowHint (x, y: integer; str: string; color: TColor; drawup: Boolean);
var
data: string;
w, h: integer;
begin
ClearHint;
HintX := x;
HintY := y;
HintWidth := 0;
HintHeight := 0;
HintUp := drawup;
HintColor := color;
while TRUE do begin
if str = '' then break;
str := GetValidStr3 (str, data, ['\']);
w := FrmMain.Canvas.TextWidth (data) + 4 * 2;
if w > HintWidth then HintWidth := w;
if data <> '' then
HintList.Add (data)
end;
HintHeight := (FrmMain.Canvas.TextHeight('A') + 1) * HintList.Count + 3 * 2;
if HintUp then
HintY := HintY - HintHeight;
end;
procedure TDrawScreen.ClearHint;
begin
HintList.Clear;
end;
procedure TDrawScreen.ClearChatBoard;
begin
m_SysMsgList.Clear;
ChatStrs.Clear;
ChatBks.Clear;
ChatBoardTop := 0;
end;
procedure TDrawScreen.DrawScreen (MSurface: TDirectDrawSurface);
procedure NameTextOut (surface: TDirectDrawSurface; x, y, fcolor, bcolor: integer; namestr: string);
var
i, row: integer;
nstr: string;
begin
row := 0;
for i:=0 to 10 do begin
if namestr = '' then break;
namestr := GetValidStr3 (namestr, nstr, ['\']);
BoldTextOut (surface,
x - surface.Canvas.TextWidth(nstr) div 2,
y + row * 12,
fcolor, bcolor, nstr);
Inc (row);
end;
end;
var
i, k, line, sx, sy, fcolor, bcolor, hh: integer;
actor: TActor;
str, uname: string;
dsurface: TDirectDrawSurface;
d: TDirectDrawSurface;
rc: TRect;
infoMsg :String;
begin
MSurface.Fill(0);
if CurrentScene <> nil then
CurrentScene.PlayScene (MSurface);
if GetTickCount - m_dwFrameTime > 1000 then begin
m_dwFrameTime := GetTickCount;
m_dwDrawFrameCount := m_dwFrameCount;
m_dwFrameCount := 0;
end;
Inc (m_dwFrameCount);
if g_MySelf = nil then exit;
if CurrentScene = PlayScene then begin
with MSurface do begin
with PlayScene do begin
for k:=0 to m_ActorList.Count-1 do begin
actor := m_ActorList[k];
?? 快捷鍵說明
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -