xbase.pas

工廠採購管理系統

{=======================================================}
{                                                       }
{          ZhaoSoft Messenger                           }
{                                                       }
{          版权所有 (c) 2005 赵建稳                     }
{                                                       }
{=======================================================}

unit xBASE;

interface

uses
  Windows, Messages, SysUtils, CommDlg, Classes, Graphics, Controls,
  Forms, StdCtrls;

type
  xMessageID = (
    xMIDConnect,        // 连接请求
    xMIDConnectS,       // 连接成功
    xMIDClientData,     // 来自客户端的用户信息
    xMIDClientDataS,    // 客户端的用户信息发送成功
    xMIDClientLogout,   // 客户端注销
    xMIDChat,           // 聊天信息
    xMIDClientCheck,    // 客户在线检测
    xMIDClientCheckS,   // 客户在线检测成功
    xMIDServerExit,     // 服务器关闭通知
    xMIDBChat           // 广播消息
  );

  {============================================================}

  TxClientData = record
    ClientID: Integer;                  // 用户标识
    NickName: array [0..15] of Char;    // 昵称
    Portrait: Integer;                  // 头像
    Expression: Integer;                // 表情
    FontColor: TColor;                  // 聊天记录字体颜色
    BKColor: TColor;                    // 聊天记录背景色
    IPAddress: array [0..15] of Char;   // IP 地址
  end;

  PxClientData = ^TxClientData;

  {============================================================}

  TxChatProperty = record
    NickName: string;
    Portrait: Integer;
    Expression: Integer;
    FontColor: TColor;
    BKColor: TColor;
  end;

  PxChatProperty = ^TxChatProperty;

var
  MessageID: xMessageID;
  xClientData: TxClientData;
  ServerAddress: string;
  UDPClientServerPort: Integer;
  UDPServerPort: Integer;

const
  MAX_CHAT_RECORD = 1024;
  BROADCAST_ADDRESS = '192.168.0.255';

function InputDialog(const ACaption, APrompt: string;
  var Value: string): Boolean;

procedure Delay(MSecs: Longint);

implementation

function InputDialog(const ACaption, APrompt: string;
  var Value: string): Boolean;
var
  Form: TForm;
  Prompt: TLabel;
  Edit: TEdit;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;

function GetAveCharSize(Canvas: TCanvas): TPoint;
var
  I: Integer;
  Buffer: array[0..51] of Char;
begin
  for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
  for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
  GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
  Result.X := Result.X div 52;
end;

begin
  Result := False;
  Form := TForm.Create(Application);
  with Form do
    try
      Font := Application.MainForm.Font;
      Canvas.Font := Font;
      DialogUnits := GetAveCharSize(Canvas);
      BorderStyle := bsDialog;
      Caption := ACaption;
      ClientWidth := MulDiv(180, DialogUnits.X, 4);
      ClientHeight := MulDiv(63, DialogUnits.Y, 8);
      Position := poScreenCenter;
      Prompt := TLabel.Create(Form);
      with Prompt do
      begin
        Parent := Form;
        AutoSize := True;
        Left := MulDiv(8, DialogUnits.X, 4);
        Top := MulDiv(8, DialogUnits.Y, 8);
        Caption := APrompt;
      end;
      Edit := TEdit.Create(Form);
      with Edit do
      begin
        Parent := Form;
        Left := Prompt.Left;
        Top := MulDiv(19, DialogUnits.Y, 8);
        Width := MulDiv(164, DialogUnits.X, 4);
        MaxLength := 255;
        Text := Value;
        SelectAll;
      end;
      ButtonTop := MulDiv(41, DialogUnits.Y, 8);
      ButtonWidth := MulDiv(50, DialogUnits.X, 4);
      ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := '确定';
        ModalResult := mrOk;
        Default := True;
        SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);
      end;
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := '取消';
        ModalResult := mrCancel;
        Cancel := True;
        SetBounds(MulDiv(92, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);
      end;
      if ShowModal = mrOk then
      begin
        Value := Edit.Text;
        Result := True;
      end;
    finally
      Form.Free;
    end;
end;

procedure Delay(MSecs: Longint);
var
  FirstTickCount, Now: Longint;
begin
  FirstTickCount := GetTickCount;
  repeat
    Application.ProcessMessages;
    Now := GetTickCount;
  until (Now - FirstTickCount >= MSecs) or (Now < FirstTickCount);
end;

end.