fbottom.pas

千年源代码,只缺少控件,可以做二次开发用,好不容易得来的

unit FBottom;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  adeftype, deftype, StdCtrls, A2Form, ExtCtrls, Autil32, A2Img, CharCls,
  uAnsTick, DXDraws, Gauges, Buttons, Cltype, ctable, log, Acibfile, clmap,
  AtzCls, uPerSonBat;

type

  TFrmBottom = class(TForm)
    Image1: TImage;
    PGEnergy: TGauge;
    PGInPower: TGauge;
    PgOutPower: TGauge;
    PgMagic: TGauge;
    PgLife: TGauge;
    BtnItem: TSpeedButton;
    BtnMagic: TSpeedButton;
    BtnBasic: TSpeedButton;
    BtnAttrib: TSpeedButton;
    BtnSkill: TSpeedButton;
    LbChat: TListBox;
    ListboxUsedMagic: TListBox;
    EdChat: TEdit;
    LbPos: TLabel;
    BtnSelMagic: TA2Button;
    BtnWAttrib: TA2Button;
    procedure FormCreate(Sender: TObject);
    procedure AddChat ( astr: string; fcolor, bcolor: integer);
    procedure LBChatDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
    procedure EdChatKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure ListBoxUsedMagicEnter(Sender: TObject);
    procedure EdChatKeyPress(Sender: TObject; var Key: Char);
    procedure EdChatKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure BtnItemClick(Sender: TObject);
    procedure BtnMagicClick(Sender: TObject);
    procedure BtnDefMagicClick(Sender: TObject);
    procedure BtnAttribClick(Sender: TObject);
    procedure BtnSkillClick(Sender: TObject);
    procedure BtnItemMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure BtnWAttribClick(Sender: TObject);
    procedure BtnSelMagicClick(Sender: TObject);
    procedure EdChatEnter(Sender: TObject);
    procedure LbChatMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure LbChatClick(Sender: TObject);
    procedure LbChatDblClick(Sender: TObject);
    procedure ListboxUsedMagicDblClick(Sender: TObject);
    procedure LbChatEnter(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    procedure capture(bitmap : Tbitmap);
  public
    { Public declarations }
    curlife, maxlife : integer;
    procedure MessageProcess (var code: TWordComData);
    procedure SetFormText;

    procedure ClientCapture;
  end;

var
   FrmBottom: TFrmBottom;
   chat_outcry, chat_Guild, chat_notice, chat_normal : Boolean;
   MapName : string;
   SaveChatList : TStringList;
   CloseFlag : Boolean = FALSE;

implementation

uses
   FMain, FLogOn, FAttrib, FExchange, FSound, FDepository, FSearchUser,
   FmuOffer, FBatList, FMuMagicOffer;
//   FmunpaCreate, FcMessageBox, FNpcView, FQView, FItemStoreView, FMunpaimpo,
//   FmunpaWarOffer, FMunpaChallenger;

{$R *.DFM}


function Get10000To100 (avalue: integer): string;
var
   n : integer;
   str : string;
begin
   str := InttoStr (avalue div 100) + '.';
   n := avalue mod 100;
   if n >= 10 then str := str + IntToStr (n)
   else str := str + '0'+InttoStr(n);

   Result := str;
end;

procedure TFrmBottom.SetFormText;
begin
   // FrmBottom Set Font
   FrmBottom.Font.Name := mainFont;
   ListboxUsedMagic.Font.Name := mainFont;
   LbChat.Font.Name := mainFont;
   EdChat.Font.Name := mainFont;
   LbPos.Font.Name := mainFont;
   chat_outcry := TRUE;
   chat_Guild := TRUE;
   chat_notice := TRUE;
   chat_normal := TRUE;

   BtnItem.Hint := Conv('酒捞袍');
   BtnMagic.Hint := Conv('公傍');
   BtnBasic.Hint := Conv('扁夯公傍');
   BtnAttrib.Hint := Conv('加己');
   BtnSkill.Hint := Conv('扁贱');
end;

procedure TFrmBottom.FormCreate(Sender: TObject);
begin
   Color := clBlack;
   Parent := FrmM;
//   FrmM.AddA2Form (Self, A2form);
   Left := 0; Top := 480-Height;
   SetFormText;
   MapName := '';
   SaveChatList := TStringList.Create;
end;

procedure TFrmBottom.FormDestroy(Sender: TObject);
begin
   SaveChatList.Free;
end;

procedure TFrmBottom.MessageProcess (var code: TWordComData);
var
   str, rdstr: string;
   cstr : string[1];
   pckey : PTCKey;
   psSay : PTSSay;
   psChatMessage : PTSChatMessage;
   psAttribBase : PTSAttribBase;
   psAttriblife : PTSAttribLife;
   psEventString : PTSEventString;
begin
   pckey := @Code.Data;
   case pckey^.rmsg of
      SM_USEDMAGICSTRING :
         begin
            ListboxUsedMagic.Clear;
            psEventString := @Code.data;

            str := GetWordString (psEventString^.rWordString);
            while TRUE do begin
               str := GetValidStr3 (str, rdstr, ',');
               if rdstr = '' then break;
               if ListboxUsedMagic.Items.Count < 4 then
                  ListboxUsedMagic.Items.Add (rdstr);
            end;
         end;
      SM_ATTRIBBASE :
         begin
            psAttribBase := @Code.Data;
            with psAttribBase^ do begin
               maxlife := psAttribBase^.rlife;
               curlife := psAttribBase^.rcurlife;

//               LbAge.Caption := IntToStr (psattribBase^.rage div 100);
//               PGAge.Progress := psattribBase^.rage mod 100;

//               LbEnergy.Caption := IntToStr (psattribBase^.rCurEnergy div 100);
//               LbEnergy.Caption := IntToStr(rCurEnergy div 100) + '/' + IntToStr(rEnergy div 100);
               PGEnergy.MaxValue := psattribBase^.rEnergy;
               PGEnergy.Progress := psattribBase^.rCurEnergy;
//               PGEnergy.Hint := IntToStr(rCurEnergy div 100) + '/' + IntToStr(rEnergy div 100);
               PGEnergy.Hint := Get10000To100(rCurEnergy) + '/' + Get10000To100(rEnergy);


//               LbInPower.Caption := IntToStr(rCurInPower div 100) + '/' + IntToStr(rInPower div 100);
               PGInPower.MaxValue := psattribBase^.rInPower;
               PGInPower.Progress := psattribBase^.rCurInPower;
//               PGInPower.Hint := IntToStr(rCurInPower div 100) + '/' + IntToStr(rInPower div 100);
               PGInPower.Hint := Get10000To100(rCurInPower) + '/' + Get10000To100(rInPower);

//               LbOutPower.Caption := IntToStr(rCurOutPower div 100) + '/' + IntToStr(rOutPower div 100);
               PGOutPower.MaxValue := psattribBase^.rOutPower;
               PGOutPower.Progress := psattribBase^.rCurOutPower;
//               PGOutPower.Hint := IntToStr(rCurOutPower div 100) + '/' + IntToStr(rOutPower div 100);
               PGOutPower.Hint := Get10000To100(rCurOutPower) + '/' + Get10000To100(rOutPower);

//               LbMagic.Caption := IntToStr(psattribbase^.rCurMagic div 100) + '/' + IntToStr(psattribbase^.rMagic div 100);
               PGMagic.MaxValue := psattribBase^.rMagic;
               PGMagic.Progress := psattribBase^.rCurMagic;
//               PGMagic.Hint := IntToStr(psattribbase^.rCurMagic div 100) + '/' + IntToStr(psattribbase^.rMagic div 100);
               PGMagic.Hint := Get10000To100(psattribbase^.rCurMagic) + '/' + Get10000To100(psattribbase^.rMagic);

//               LbLife.Caption := IntToStr(curlife div 100) + '/' + IntToStr(maxlife div 100);
               PGLife.MaxValue := maxlife;
               PGLife.Progress := curlife;
//               PGLife.Hint := IntToStr(curlife div 100) + '/' + IntToStr(maxlife div 100);
               PGLife.Hint := Get10000To100(curlife) + '/' + Get10000To100(maxlife);
            end;
         end;
      SM_ATTRIB_LIFE :
         begin
            psAttribLife := @Code.Data;
            curlife := psAttribLife^.rcurlife;
            PGLife.Progress := curlife;
            PGLife.Hint := IntToStr(curlife) + '/' + IntToStr(maxlife);
//            LbLife.Caption := IntToStr(curlife) + '/' + IntToStr(maxlife);
         end;
      SM_CHATMESSAGE :
         begin

            psChatMessage := @Code.data;

            str := GetwordString(psChatMessage^.rWordstring);
            cstr := str;
            if (cstr = '[') or (cstr = '<') then begin
               if pos(':', str) > 1 then begin
                  str := GetValidStr3 (str, rdstr, ':');
                  str := ChangeDontSay (str);
                  rdstr := rdstr + ':' + str
               end else rdstr := str;
            end else begin
               str := ChangeDontSay (str);
               rdstr := str;
            end;
            AddChat (rdstr, psChatMessage^.rFColor, psChatMessage^.rBColor);
            str := ''; rdstr := '';
         end;
      SM_SAY :
         begin
            psSay := @Code.data;
            str := GetwordString(psSay^.rWordstring);
            str := GetValidStr3 (str, rdstr, ':');
            str := ChangeDontSay (str);
            rdstr := rdstr + ' :' + str;
            AddChat (rdstr, WinRGB (28,28,28), 0);
            str := ''; rdstr := '';
//            Cl := CharList.GetChar (psSay^.rid);
//            if Cl <> nil then Cl.Say (GetwordString(pssay^.rWordstring));
         end;
   end;
end;

procedure TFrmBottom.AddChat ( astr: string; fcolor, bcolor: integer);
var
   str, rdstr: string;
   col : Integer;
   addflag : Boolean;
begin
//   FrmChatList.AddChat (astr, fcolor, bcolor);
   addflag := FALSE;
   str := astr;
   while TRUE do begin
      str := GetValidStr3 (str, rdstr, #13);
      if rdstr = '' then break;

      if chat_outcry then begin // 寇摹扁
         if rdstr[1] = '[' then begin
            addflag := TRUE;
         end;
      end;

      if chat_Guild then begin  // 辨靛
         if rdstr[1] = '<' then begin
            addflag := TRUE;
         end;
      end;

      if chat_notice then begin // 傍瘤荤亲
         if bcolor = 16912 then begin
            addflag := TRUE;
         end;
      end;

      if chat_normal then begin  // 老馆蜡历
         if not(bcolor = 16912) and not(rdstr[1] = '<') and not(rdstr[1] = '[') then begin
            addflag := TRUE;
         end;
      end;

      if Addflag then begin
         if LbChat.Items.Count >= 4 then LbChat.Items.delete (0);
         col := MakeLong (fcolor, bcolor);
         LbChat.Items.addObject (rdstr, TObject (col) );
      end;

      LbChat.Itemindex := LbChat.Items.Count -1;
      LbChat.Itemindex := -1;
   end;
{ // 寇摹扁 救焊捞扁 眠啊肺 官柴
   str := astr;
   while TRUE do begin
      str := GetValidStr3 (str, rdstr, #13);
      if rdstr = '' then break;
      if LbChat.Items.Count >= 4 then LbChat.Items.delete (0);

      col := MakeLong (fcolor, bcolor);
      LbChat.Items.addObject (rdstr, TObject (col) );

      LbChat.Itemindex := LbChat.Items.Count -1;
      LbChat.Itemindex := -1;
   end;
}
end;


function  savefilename: string;
var
   year, mon, day,hour, min, sec, dummy : word;
   str : string;
   function  num(n : integer): string;
   begin
      Result := '';
      if n >= 10 then Result := IntToStr (n)
      else Result := '0'+InttoStr(n);
   end;
begin
   str := '';
   DecodeDate(Date, year, mon, day);
   DecodeTime(Time, hour, min, sec, dummy);
   str := num(year)+Conv('斥')+num(mon)+Conv('岿')+num(day)+Conv('老');
   str := str + num(hour)+Conv('矫')+num(min)+Conv('盒')+num(sec)+Conv('檬');
   Result := str;
end;

function DirExists(Name: string): Boolean;
var
   Code: Integer;
begin
   Code := GetFileAttributes(PChar(Name));
   Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;

procedure TFrmBottom.capture(bitmap : Tbitmap);
var
   FrmMRect : TRect;
   FrmMDC : HDC;
   FrmMDCcanvas : TCanvas;
begin
   BitMap.Width := FrmM.Width;
   BitMap.Height := FrmM.Height;
   FrmMRect:= Rect(0, 0, FrmM.Width, FrmM.Height);

   FrmMDC := GetWindowDC(FrmM.Handle);
   FrmMDCcanvas := TCanvas.Create;