?? drawscrn.pas
字號:
unit DrawScrn;
interface
uses
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;
type
TDrawScreen = class
private
frametime, framecount, drawframecount: longword;
SysMsg: 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;
constructor TDrawScreen.Create;
var
i: integer;
begin
CurrentScene := nil;
frametime := GetTickCount;
framecount := 0;
SysMsg := TStringList.Create;
ChatStrs := TStringList.Create;
ChatBks := TList.Create;
ChatBoardTop := 0;
HintList := TStringList.Create;
end;
destructor TDrawScreen.Destroy;
begin
SysMsg.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: ;
stLoginNotice: CurrentScene := LoginNoticeScene;
stPlayGame: CurrentScene := PlayScene;
end;
if CurrentScene <> nil then
CurrentScene.OpenScene;
end;
//添加系統信息
procedure TDrawScreen.AddSysMsg (msg: string);
begin
if SysMsg.Count >= 10 then SysMsg.Delete (0);
SysMsg.AddObject (msg, TObject(GetTickCount));
end;
//添加信息聊天板
procedure TDrawScreen.AddChatBoardString (str: string; fcolor, bcolor: integer);
var
i, len, aline: integer;
dline, temp: string;
const
BOXWIDTH = 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
SysMsg.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: integer;
actor: TActor;
str, uname: string;
dsurface: TDirectDrawSurface;
d: TDirectDrawSurface;
rc: TRect;
begin
MSurface.Fill(0);
if CurrentScene <> nil then
CurrentScene.PlayScene (MSurface);
if GetTickCount - frametime > 1000 then begin
frametime := GetTickCount;
drawframecount := framecount; //FPS
framecount := 0;
end;
Inc (framecount);
if Myself = nil then exit;
if CurrentScene = PlayScene then begin
with MSurface do begin
with PlayScene do begin
for k:=0 to ActorList.Count-1 do begin //畫出每一個人物的狀態
actor := ActorList[k];
if (actor.BoOpenHealth or actor.BoInstanceOpenHealth) and not actor.Death then begin
//畫人物的“血”(頭上的一個橫杠)
if actor.BoInstanceOpenHealth then
if GetTickCount - actor.OpenHealthStart > actor.OpenHealthTime then
actor.BoInstanceOpenHealth := FALSE;
d := FrmMain.WProgUse2.Images[HEALTHBAR_BLACK];
if d <> nil then
MSurface.Draw (actor.SayX - d.Width div 2, actor.SayY - 10, d.ClientRect, d, TRUE);
d := FrmMain.WProgUse2.Images[HEALTHBAR_RED];
if d <> nil then begin
rc := d.ClientRect;
if actor.Abil.MaxHP > 0 then
rc.Right := Round((rc.Right-rc.Left) / actor.Abil.MaxHP * actor.Abil.HP);
MSurface.Draw (actor.SayX - d.Width div 2, actor.SayY - 10, rc, d, TRUE);
end;
end;
end;
end;
//畫當前選擇的物品/人物的名字
SetBkMode (Canvas.Handle, TRANSPARENT);
if (FocusCret <> nil) and PlayScene.IsValidActor (FocusCret) then begin
uname := FocusCret.DescUserName + '\' + FocusCret.UserName;
NameTextOut (MSurface,
FocusCret.SayX, // - Canvas.TextWidth(uname) div 2,
FocusCret.SayY + 30,
FocusCret.NameColor, clBlack,
uname);
end;
//玩家名稱
if BoSelectMyself then begin
uname := Myself.DescUserName + '\' + Myself.UserName;
NameTextOut (MSurface,
Myself.SayX, // - Canvas.TextWidth(uname) div 2,
Myself.SayY + 30,
Myself.NameColor, clBlack,
uname);
end;
Canvas.Font.Color := clWhite;
//char saying
with PlayScene do begin
for k:=0 to ActorList.Count-1 do begin
actor := ActorList[k];
if actor.Saying[0] <> '' then begin
if GetTickCount - actor.SayTime < 4 * 1000 then begin
for i:=0 to actor.SayLineCount-1 do //顯示每個玩家說的話
if actor.Death then //死了的話就灰/黑色顯示
BoldTextOut (MSurface,
actor.SayX - (actor.SayWidths[i] div 2),
actor.SayY - (actor.SayLineCount*16) + i*14,
clGray, clBlack,
actor.Saying[i])
else //正常的玩家用黑/白色顯示
BoldTextOut (MSurface,
actor.SayX - (actor.SayWidths[i] div 2),
actor.SayY - (actor.SayLineCount*16) + i*14,
clWhite, clBlack,
actor.Saying[i]);
end else
actor.Saying[0] := ''; //說的話顯示4秒
end;
end;
end;
//BoldTextOut (MSurface, 0, 0, clWhite, clBlack, IntToStr(SendCount) + ' : ' + IntToStr(ReceiveCount));
//BoldTextOut (MSurface, 0, 0, clWhite, clBlack, 'HITSPEED=' + IntToStr(Myself.HitSpeed));
//BoldTextOut (MSurface, 0, 0, clWhite, clBlack, 'DupSel=' + IntToStr(DupSelection));
//BoldTextOut (MSurface, 0, 0, clWhite, clBlack, IntToStr(LastHookKey));
//BoldTextOut (MSurface, 0, 0, clWhite, clBlack,
// IntToStr(
// int64(GetTickCount - LatestSpellTime) - int64(700 + MagicDelayTime)
// ));
//BoldTextOut (MSurface, 0, 0, clWhite, clBlack, IntToStr(PlayScene.EffectList.Count));
//BoldTextOut (MSurface, 0, 0, clWhite, clBlack,
// IntToStr(Myself.XX) + ',' + IntToStr(Myself.YY) + ' ' +
// IntToStr(Myself.ShiftX) + ',' + IntToStr(Myself.ShiftY));
//System Message
//甘狼 惑怕 釬矯 (烙矯 釬矯)
if (AreaStateValue and $04) <> 0 then begin
BoldTextOut (MSurface, 0, 0, clWhite, clBlack, '傍己傈瘤開');
end;
Canvas.Release;
//顯示地圖狀態,16種:0000000000000000 從右到左,為1表示:戰斗、安全、上面的那種狀態 (當前只有這幾種狀態)
k := 0;
for i:=0 to 15 do begin
if AreaStateValue and ($01 shr i) <> 0 then begin
d := FrmMain.WProgUse.Images[AREASTATEICONBASE + i];
if d <> nil then begin
k := k + d.Width;
MSurface.Draw (SCREENWIDTH-k, 0, d.ClientRect, d, TRUE);
end;
end;
end;
end;
end;
end;
procedure TDrawScreen.DrawScreenTop (MSurface: TDirectDrawSurface);
var
i, sx, sy: integer;
begin
if Myself = nil then exit;
//游戲狀態:顯示所有系統消息(左上角顯示的)
if CurrentScene = PlayScene then begin
with MSurface do begin
SetBkMode (Canvas.Handle, TRANSPARENT);
if SysMsg.Count > 0 then begin
sx := 30;
sy := 40;
for i:=0 to SysMsg.Count-1 do begin
BoldTextOut (MSurface, sx, sy, clGreen, clBlack, SysMsg[i]);
inc (sy, 16);
end;
//3秒減少一個系統消息
if GetTickCount - longword(SysMsg.Objects[0]) >= 3000 then
SysMsg.Delete (0);
end;
Canvas.Release;
end;
end;
end;
//顯示提示信息
procedure TDrawScreen.DrawHint (MSurface: TDirectDrawSurface);
var
d: TDirectDrawSurface;
i, hx, hy, old: integer;
str: string;
begin
//顯示提示框
if HintList.Count > 0 then begin
d := FrmMain.WProgUse.Images[394];
if d <> nil then begin
if HintWidth > d.Width then HintWidth := d.Width;
if HintHeight > d.Height then HintHeight := d.Height;
if HintX + HintWidth > SCREENWIDTH then hx := SCREENWIDTH - HintWidth
else hx := HintX;
if HintY < 0 then hy := 0
else hy := HintY;
if hx < 0 then hx := 0;
DrawBlendEx (MSurface, hx, hy, d, 0, 0, HintWidth, HintHeight, 0);
end;
end;
//在提示框中顯示提示信息
with MSurface do begin
SetBkMode (Canvas.Handle, TRANSPARENT);
if HintList.Count > 0 then begin
Canvas.Font.Color := HintColor;
for i:=0 to HintList.Count-1 do begin
Canvas.TextOut (hx+4, hy+3+(Canvas.TextHeight('A')+1)*i, HintList[i]);
end;
end;
if Myself <> nil then begin
if CheckBadMapMode then begin
str := IntToStr(drawframecount) + ' '
+ ' Mouse ' + IntToStr(MouseX) + ':' + IntToStr(MouseY) + '(' + IntToStr(MCX) + ':' + IntToStr(MCY) + ')'
+ ' HP' + IntToStr(Myself.Abil.HP) + '/' + IntToStr(Myself.Abil.MaxHP)
+ ' D0 ' + IntToStr(DebugCount)
+ ' D1 ' + IntToStr(DebugCount1) + ' D2 '
+ IntToStr(DebugCount2);
end;
BoldTextOut (MSurface, 10, 0, clWhite, clBlack, str);
BoldTextOut (MSurface, 8, SCREENHEIGHT-20, clWhite, clBlack, MapTitle + ' ' + IntToStr(Myself.XX) + ':' + IntToStr(Myself.YY));
end;
Canvas.Release;
end;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -