basewin.pas

类似文明的游戏源代码。

{$INCLUDE switches}

unit BaseWin;

interface

uses
  ScreenTools,

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

type
  TBaseDlg = class(TForm)
    constructor Create(AOwner: TComponent); override;
    procedure FormCreate(Sender:TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormPaint(Sender:TObject);
    procedure SmartInvalidate;
  protected
    CaptionLeft, CaptionRight, InnerWidth, InnerHeight: integer;
    Tex: TTexture;
    WideBottom, FullCaption, TexOverride: boolean;
    procedure MarkUsedOffscreen(xMax,yMax: integer);
    procedure InitWindowRegion;
    procedure OnEraseBkgnd(var m:TMessage); message WM_ERASEBKGND;
    procedure OnHitTest(var Msg:TMessage); message WM_NCHITTEST;
    procedure OffscreenPaint; virtual;
  end;

const
yUnused=77;
NarrowFrame=11; WideFrame=36; SideFrame=9;

var
UsedOffscreenWidth, UsedOffscreenHeight: integer;
offscreen: TBitmap;
OffscreenUser: TForm;
DlgTex: TTexture;

implementation

constructor TBaseDlg.Create;
begin
OnCreate:=FormCreate;
OnPaint:=FormPaint;
OnClose:=FormClose;
inherited;
end;

procedure TBaseDlg.FormCreate(Sender:TObject);
begin
CaptionLeft:=0; CaptionRight:=$FFFF;
WideBottom:=false;
FullCaption:=true;
TexOverride:=false;
Canvas.Brush.Style:=bsClear;
InnerWidth:=ClientWidth-2*SideFrame;
InnerHeight:=ClientHeight-WideFrame-NarrowFrame;
end;

procedure TBaseDlg.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if OffscreenUser=self then OffscreenUser:=nil;
end;

procedure TBaseDlg.FormPaint(Sender:TObject);

  procedure CornerFrame(x0,y0,x1,y1: integer);
  begin
  Frame(Canvas,x0+1,y0+1,x1-2,y1-2,Tex.clBevelLight,Tex.clBevelShade);
  Frame(Canvas,x0+2,y0+2,x1-3,y1-3,Tex.clBevelLight,Tex.clBevelShade);
  Corner(Canvas,x0+1,y0+1,0,Tex);
  Corner(Canvas,x1-9,y0+1,1,Tex);
  Corner(Canvas,x0+1,y1-9,2,Tex);
  Corner(Canvas,x1-9,y1-9,3,Tex);
  end;

var
l,FrameTop,FrameBottom,InnerBottom,Cut: integer;
begin
if not TexOverride then Tex:=DlgTex;
Canvas.Font.Assign(UniFont[ftCaption]);
l:=Canvas.TextWidth(Caption);
Cut:=(ClientWidth-l) div 2;
if OffscreenUser<>self then OffscreenPaint;
if WideBottom then InnerBottom:=ClientHeight-WideFrame
else InnerBottom:=ClientHeight-NarrowFrame;
if FullCaption then begin FrameTop:=0; FrameBottom:=ClientHeight end
else
  begin
  FrameTop:=WideFrame-NarrowFrame;
  if WideBottom then FrameBottom:=ClientHeight-(WideFrame-NarrowFrame)
  else FrameBottom:=ClientHeight
  end;
Fill(Canvas,3,3+FrameTop,ClientWidth-6,WideFrame-FrameTop-4,0,0,Tex);
Fill(Canvas,3,InnerBottom+1,ClientWidth-6,ClientHeight-InnerBottom-4,0,0,Tex);
Fill(Canvas,3,WideFrame-2,SideFrame-3,InnerBottom-WideFrame+4,0,0,Tex);
Fill(Canvas,ClientWidth-SideFrame,WideFrame-2,SideFrame-3,
  InnerBottom-WideFrame+4,0,0,Tex);
Frame(Canvas,0,FrameTop,ClientWidth-1,FrameBottom-1,0,0);
CornerFrame(0,FrameTop,ClientWidth,FrameBottom);
Frame(Canvas,SideFrame-1,WideFrame-1,ClientWidth-SideFrame,
  InnerBottom,Tex.clBevelShade,Tex.clBevelLight);
RFrame(Canvas,SideFrame-2,WideFrame-2,ClientWidth-SideFrame+1,
  InnerBottom+1,Tex.clBevelShade,Tex.clBevelLight);
if not FullCaption then
  begin
  Frame(Canvas,CaptionLeft,0,ClientWidth-CaptionLeft-1,FrameTop,0,0);
  Fill(Canvas,CaptionLeft+3,3,
    ClientWidth-2*(CaptionLeft)-6,WideFrame-5,0,0,Tex);
  CornerFrame(CaptionLeft,0,ClientWidth-CaptionLeft,WideFrame+1);
  with Canvas do
    begin
    Pen.Color:=Tex.clBevelShade;
    MoveTo(CaptionLeft-1,FrameTop+2);
    LineTo(CaptionLeft-1,WideFrame-1);
    MoveTo(CaptionLeft,FrameTop+1);
    LineTo(CaptionLeft,WideFrame-1);
    Pen.Color:=Tex.clBevelLight;
    MoveTo(ClientWidth-CaptionLeft-1,FrameTop+1);
    LineTo(ClientWidth-CaptionLeft-1,WideFrame);
    MoveTo(ClientWidth-CaptionLeft,FrameTop+1);
    LineTo(ClientWidth-CaptionLeft,WideFrame-1);
    end;
  if WideBottom then
    begin
    Frame(Canvas,CaptionLeft,FrameBottom,ClientWidth-CaptionLeft-1,ClientHeight-1,0,0);
    Fill(Canvas,CaptionLeft+3,ClientHeight-3-(WideFrame-5),
      ClientWidth-2*(CaptionLeft)-6,WideFrame-5,0,0,Tex);
    Frame(Canvas,CaptionLeft+1,ClientHeight-WideFrame-1+1,
      ClientWidth-CaptionLeft-2,ClientHeight-2,Tex.clBevelLight,Tex.clBevelShade);
    Frame(Canvas,CaptionLeft+2,ClientHeight-WideFrame-1+2,
      ClientWidth-CaptionLeft-3,ClientHeight-3,Tex.clBevelLight,Tex.clBevelShade);
{    CornerFrame(CaptionLeft,ClientHeight-WideFrame-1,ClientWidth-CaptionLeft,
      ClientHeight);}
    with Canvas do
      begin
      Pen.Color:=Tex.clBevelShade;
      MoveTo(CaptionLeft-1,ClientHeight-(WideFrame-1));
      LineTo(CaptionLeft-1,FrameBottom-1);
      MoveTo(CaptionLeft,ClientHeight-WideFrame);
      LineTo(CaptionLeft,FrameBottom-1);
      Pen.Color:=Tex.clBevelLight;
      MoveTo(ClientWidth-CaptionLeft-1,ClientHeight-(WideFrame-1));
      LineTo(ClientWidth-CaptionLeft-1,FrameBottom-1);
      MoveTo(ClientWidth-CaptionLeft,ClientHeight-(WideFrame-1));
      LineTo(ClientWidth-CaptionLeft,FrameBottom-2);
      end;
    end
  end;
RisedTextOut(Canvas,Cut-1,7,Caption);
BitBlt(Canvas.Handle,SideFrame,WideFrame,ClientWidth-2*SideFrame,
  InnerBottom-WideFrame,offscreen.Canvas.Handle,0,0,SRCCOPY);
end;

procedure TBaseDlg.InitWindowRegion;
var
r0,r1: HRgn;
begin
if FullCaption then exit;
r0:=CreateRectRgn(0,0,ClientWidth,ClientHeight);
r1:=CreateRectRgn(0,0,CaptionLeft,WideFrame-NarrowFrame);
CombineRgn(r0,r0,r1,RGN_DIFF);
//DeleteObject(r1);
r1:=CreateRectRgn(ClientWidth-CaptionLeft,0,ClientWidth,WideFrame-NarrowFrame);
CombineRgn(r0,r0,r1,RGN_DIFF);
//DeleteObject(r1);
if WideBottom then
  begin
  r1:=CreateRectRgn(0,ClientHeight-(WideFrame-NarrowFrame),CaptionLeft,
    ClientHeight);
  CombineRgn(r0,r0,r1,RGN_DIFF);
  //DeleteObject(r1);
  r1:=CreateRectRgn(ClientWidth-CaptionLeft,
    ClientHeight-(WideFrame-NarrowFrame),ClientWidth,ClientHeight);
  CombineRgn(r0,r0,r1,RGN_DIFF);
  //DeleteObject(r1);
  end;
SetWindowRgn(Handle,r0,false);
//DeleteObject(r0); // causes crash with Windows 95
end;

procedure TBaseDlg.OffscreenPaint;
begin
if (OffscreenUser<>nil) and (OffscreenUser<>self) then OffscreenUser.Update;
  // complete working with old owner to prevent rebound
OffscreenUser:=self;
end;

procedure TBaseDlg.MarkUsedOffscreen(xMax,yMax: integer);
begin
if xMax>UsedOffscreenWidth then UsedOffscreenWidth:=xMax;
if yMax>UsedOffscreenHeight then UsedOffscreenHeight:=yMax;
end;

procedure TBaseDlg.SmartInvalidate;
var
i,BottomFrame: integer;
r0,r1: HRgn;
begin
if WideBottom then BottomFrame:=WideFrame else BottomFrame:=NarrowFrame;
r0:=CreateRectRgn(SideFrame,WideFrame,ClientWidth-SideFrame,
  ClientHeight-BottomFrame);
for i:=0 to ControlCount-1 do if Controls[i].Visible then
  begin
  with Controls[i].BoundsRect do
    r1:=CreateRectRgn(Left,Top,Right,Bottom);
  CombineRgn(r0,r0,r1,RGN_DIFF);
  DeleteObject(r1);
  end;
InvalidateRgn(Handle,r0,false);
DeleteObject(r0);
end;

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

procedure TBaseDlg.OnHitTest(var Msg:TMessage);
begin
if (Msg.LParamHi>=Top+WideFrame) or (Msg.LParamLo>=Left+CaptionRight)
  or (Msg.LParamLo<Left+CaptionLeft) then Msg.result:=HTCLIENT
else Msg.result:=HTCAPTION
end;

initialization
offscreen:=TBitmap.Create;
if TrueColor=1 then // unit must be initialized after ScreenTools
  Offscreen.PixelFormat:=pf24bit;
offscreen.Width:=Screen.Width;
if Screen.Height-yUnused<480 then offscreen.Height:=480
else offscreen.Height:=Screen.Height-yUnused;
offscreen.Canvas.Brush.Style:=bsClear;
OffscreenUser:=nil;

finalization
offscreen.Free;

end.