messg.pas

类似文明的游戏源代码。

{$INCLUDE switches}

unit Messg;

interface

uses
  ScreenTools,

  Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,ButtonA,
  ButtonBase;

type
  TBaseMessgDlg = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender:TObject);
  public
    MessgText: string;
    Tex: TTexture;
  protected
    Lines, TopSpace: integer;
    procedure SplitText(preview: boolean);
    procedure CorrectHeight;
    procedure OnEraseBkgnd(var m:TMessage); message WM_ERASEBKGND;
    procedure OnHitTest(var Msg:TMessage); message WM_NCHITTEST;
  end;

  TMessgDlg = class(TBaseMessgDlg)
    Button1: TButtonA;
    Button2: TButtonA;
    procedure FormCreate(Sender:TObject);
    procedure FormPaint(Sender:TObject);
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: char);
  public
    Kind: integer;
  end;

const
// message kinds
mkWelcome=0; mkOK=1; mkOKCancel=2; mkYesNo=3; 

Border=3;

var
  MessgDlg:TMessgDlg;

procedure SimpleMessage(SimpleText, SoundItem: string);


implementation

{$R *.DFM}

procedure TBaseMessgDlg.FormCreate(Sender: TObject);
begin
Left:=(Screen.Width-ClientWidth) div 2;
Canvas.Font.Assign(UniFont[ftNormal]);
MessgText:='';
Tex.Height:=0;
TopSpace:=0;
InitButtons(self);
end;

procedure TBaseMessgDlg.FormPaint(Sender:TObject);
begin
with Canvas do
  begin
  Brush.Color:=0;
  FillRect(Rect(0,0,ClientWidth,ClientHeight));
  if Tex.Height>0 then
    Fill(Canvas,3+Border,3+Border,ClientWidth-(6+2*Border),
      ClientHeight-(6+2*Border), 0,0,Tex)
  else
    begin
    Brush.Color:=Tex.clBevelLight and $FEFEFE shr 1
      +Tex.clBevelShade and $FEFEFE shr 1;
    FillRect(Rect(3+Border,3+Border,ClientWidth-(3+Border),
      ClientHeight-(3+Border)));
    end;
  Brush.Style:=bsClear;
  end;
Frame(Canvas,Border+1,Border+1,ClientWidth-(2+Border),ClientHeight-(2+Border),
  Tex.clBevelLight,Tex.clBevelShade);
Frame(Canvas,2+Border,2+Border,ClientWidth-(3+Border),ClientHeight-(3+Border),
  Tex.clBevelLight,Tex.clBevelShade);
SplitText(false);
end;

procedure TBaseMessgDlg.SplitText(preview: boolean);
var
x,Start,Stop,LinesCount: integer;
s,s0:string;
begin
Start:=1;
LinesCount:=0;
while Start<Length(MessgText) do
  begin
  Stop:=Start;
  while(Stop<Length(MessgText)) and (MessgText[Stop]<>'\')
    and (Canvas.TextWidth(Copy(MessgText,Start,Stop-Start+1))<ClientWidth-56) do inc(Stop);
  if Stop<>Length(MessgText) then
    repeat dec(Stop) until (MessgText[Stop+1]=' ') or (MessgText[Stop+1]='\');
  if not preview then
    begin
    s:=Copy(MessgText,Start,Stop-Start+1);
    s0:=s;
    while pos('%c',s)>0 do
      begin x:=pos('%c',s); s[x]:=' '; s[x+1]:=' '; Insert('  ',s,x); end;
    while pos('%c',s0)>0 do
      begin
      x:=pos('%c',s0);
      s0[x]:=' '; s0[x+1]:=' ';
      Insert('  ',s0,x);
      x:=(ClientWidth-Canvas.TextWidth(s)) div 2+1
        +Canvas.TextWidth(Copy(s0,1,x-1));
      BitBlt(Canvas.Handle,x,25+Border+TopSpace+LinesCount*20,10,10,
        GrExt[HGrSystem].Mask.Canvas.Handle,132,115,SRCAND);
      BitBlt(Canvas.Handle,x,25+Border+TopSpace+LinesCount*20,10,10,
        GrExt[HGrSystem].Data.Canvas.Handle,132,115,SRCPAINT);
      end;
    RisedTextOut(Canvas,
      (ClientWidth-Canvas.TextWidth(s)) div 2,19+Border+TopSpace+LinesCount*20,s);
    end;
  Start:=Stop+2;
  inc(LinesCount)
  end;
if preview then Lines:=LinesCount;
end;

procedure TBaseMessgDlg.CorrectHeight;
var
i: integer;
begin
ClientHeight:=72+Border+TopSpace+Lines*20;
Top:=(Screen.Height-ClientHeight) div 2;
for i:=0 to ControlCount-1 do
  Controls[i].Top:=ClientHeight-(34+Border);
end;

procedure TBaseMessgDlg.OnEraseBkgnd(var m:TMessage);
begin
end;

procedure TBaseMessgDlg.OnHitTest(var Msg:TMessage);
begin
if (Msg.LParamHi>=Top+ClientHeight-(34+Border)) then Msg.result:=HTCLIENT
else Msg.result:=HTCAPTION
end;

procedure TMessgDlg.FormCreate(Sender:TObject);
begin
{don't remove this comment!}
inherited;
end;

procedure TMessgDlg.FormShow(Sender: TObject);
begin
Button1.Visible:=true;
Button2.Visible:= not (Kind in [mkOK,mkWelcome]);
if Button2.Visible then Button1.Left:=97
else Button1.Left:=155;
if Kind=mkYesNo then
  begin
  Button1.Caption:=Phrases.Lookup('BTN_YES');
  Button2.Caption:=Phrases.Lookup('BTN_NO')
  end
else
  begin
  Button1.Caption:=Phrases.Lookup('BTN_OK');
  Button2.Caption:=Phrases.Lookup('BTN_CANCEL');
  end;

SplitText(true);
if Kind=mkWelcome then
  inc(Lines);
CorrectHeight;
end;

procedure TMessgDlg.FormPaint(Sender:TObject);
var
x,y: integer;
s: string;
begin
inherited;
if Kind=mkWelcome then
  begin
  Canvas.Font.Assign(UniFont[ftCaption]);
  s:='c-evo.org';
  x:=(ClientWidth-Canvas.TextWidth(s)) div 2;
  y:=19+Border+TopSpace+(Lines-1)*20;
  with Canvas do
    begin
    Font.Color:=$000000;
    Textout(x+1,y+1,s);
    Font.Color:=$A05830; //$3FDDEF;
    Textout(x,y,s);
    end;
  Canvas.Font.Assign(UniFont[ftNormal]);
  end;

if Button1.Visible then BtnFrame(Canvas,Button1.BoundsRect,Tex);
if Button2.Visible then BtnFrame(Canvas,Button2.BoundsRect,Tex);
end; {FormPaint}

procedure TMessgDlg.Button1Click(Sender: TObject);
begin
ModalResult:=mrOK;
end;

procedure TMessgDlg.Button2Click(Sender: TObject);
begin
ModalResult:=mrIgnore;
end;

procedure TMessgDlg.FormKeyPress(Sender: TObject; var Key: char);
begin
if Key=#13 then ModalResult:=mrOK
//else if (Key=#27) and (Button2.Visible) then ModalResult:=mrCancel
end;

procedure SimpleMessage(SimpleText, SoundItem: string);
begin
with MessgDlg do
  begin
  Play(SoundItem);
  MessgText:=SimpleText;
  Kind:=mkOK;
  ShowModal;
  end
end;

end.