adkgui.pas

N年前有个法国小组用Delphi写了一个2D网游（AD&D类型）

unit ADKGUI;

interface

uses
 Windows,Classes,ADKImages,ADKDepth;

const
 GWidth =1024;
 GHeight=768;
 GDepth =32;

 GUIExtend=0;
 GUIBlock =1;
 GUIInvent=2;
 GUIScrollUp=3;
 GUIScrollDown=4;
 GUIScrollBorder=5;
 GUISCrollBar=6;
 GUIHLine=7;
 GUIVLine=8;

 GUIInventTitle=24; // pixels

var
 GUI:TADKImageLib;
 GUITop:integer;
 Invent:boolean;
 hsize:TPoint;
 vsize:TPoint;
 xsize:TPoint;
 isize:TPoint;
 ssize:TPoint;
 ipos :TPoint;

procedure LoadGUI;
procedure RenderGUI;
procedure RenderInvent;
function GUIMouseDown(x,y,button:integer):boolean;
procedure GUIMouseMove(dx,dy:integer);
procedure GUIMouseUp;
procedure GUIDblClick(x,y,button:integer);

type
 TXWindow=class
 private
  Left,Top,Width,Height:integer;
  function PointInside(x,y:integer):boolean;
 public
  constructor Create(x,y,w,h:integer); virtual;
  procedure Draw; virtual;
  function Click(x,y,button:integer):boolean; virtual;
  function DblClick(x,y,button:integer):boolean; virtual;
  procedure MouseMove(dx,dy:integer); virtual;
 end;

 TXResizeWindow=class(TXWindow)
 private
  rx,ry:integer;
  resize:boolean;
  fStep:integer;
  Delta:integer;
  fMinSize:integer;
  fMaxSize:integer;
  Resized:boolean;
  LastSize:integer;
  function PointResize(x,y:integer):boolean;
 public
  procedure Draw; override;
  function Click(x,y,button:integer):boolean; override;
  function DblClick(x,y,button:integer):boolean; override;
  procedure MouseMove(dx,dy:integer); override;
  property Step:integer read fStep write fStep;
  property MinSize:integer read fMinSize write fMinSize;
  property MaxSize:integer read fMaxsize write fMaxSize;
 end;

 TXInventWindow=class(TXResizeWindow)
 public
  procedure Draw; override;
 end;

 TXScrollWindow=class(TXResizeWindow)
 private
  GradCount:integer;
  GradTop:integer;
  GradBottom:integer;
  GradMove:boolean;
  InnerSize:integer;
  ScrollPos:integer;
  ScrollStep:integer;
  procedure CheckScroll(x,y:integer);
 public
  function Click(x,y,button:integer):boolean; override;
  function DblClick(x,y,button:integer):boolean; override;
  procedure Draw; override;
  procedure MouseMove(dx,dy:integer); override;
 end;

 TXMemoWindow=class(TXScrollWindow)
 private
  fLines:TStringList;
 public
  constructor Create(x,y,w,h:integer); override;
  destructor Destroy; override;
  procedure DrawText(dc:hdc);
  property Lines:TStringList read fLines;
 end;

var
 Edit:TXWindow;
 Chat:TXMemoWindow;

implementation

uses
 ADKRender, ADKScreens, ADKIniLoader;

var
 XWindows:TList=nil; // of TXWindow
 XDragWindow:TXWindow;

constructor TXWindow.Create(x,y,w,h:integer);
begin
 if XWindows=nil then XWindows:=TList.Create;
 XWindows.Add(Self);
 Left:=x;
 Top:=y;
 Width:=w;
 Height:=h;
end;

procedure TXWindow.Draw;
var
 x,y,i:integer;
begin
 ADKScreen.Trame(Left,Top,Width,Height);
 x:=Left+Width-hsize.x;
 y:=Top+Height-hsize.y;
 GUI.Draw(GUIHLine,{@dib[Pitch*Top+BPP*x]}ADKScreen.Pixels[x,Top],ADKScreen.Pitch,1);
 GUI.Draw(GUIHLine,{@dib[Pitch*y+BPP*x]}ADKScreen.Pixels[x,y],ADKScreen.Pitch,1);
 for x:=0 to (Width div hsize.X)-1 do begin
  GUI.Draw(GUIHLine,{@dib[Pitch*Top+BPP*(Left+x*hsize.x)]}ADKScreen.Pixels[Left+x*hsize.x,Top],ADKScreen.Pitch,1);
  GUI.Draw(GUIHLine,{@dib[Pitch*y+BPP*(Left+x*hsize.x)]}ADKScreen.Pixels[Left+x*hsize.x,y],ADKScreen.Pitch,1);
 end;
 if Height<40 then exit; // there's a little bug for the Edit box with a Height < 40 pixels ...
 x:=Left+Width-vsize.x;
 y:=Top+Height-vsize.y;
 GUI.Draw(GUIVLine,{@dib[Pitch*Top+BPP*Left]}ADKScreen.Pixels[Left,Top],ADKScreen.Pitch,1);
 GUI.Draw(GUIVLine,{@dib[Pitch*Top+BPP*x]}ADKScreen.Pixels[x,Top],ADKScreen.Pitch,1);
 for i:=0 to (Height div vsize.y)-1 do begin
  GUI.Draw(GUIVLine,{@dib[Pitch*(y-i*vsize.y)+BPP*Left]}ADKScreen.Pixels[Left,y-i*vsize.y],ADKScreen.Pitch,1);
  GUI.Draw(GUIVLine,{@dib[Pitch*(y-i*vsize.y)+BPP*x]}ADKScreen.Pixels[x,y-i*vsize.y],ADKScreen.Pitch,1);
 end;
end;

function TXWindow.PointInside(x,y:integer):boolean;
begin
 Result:=(x>=Left)and(y>=Top)and(x<=Left+Width)and(y<=Top+Height);
end;

function TXWindow.Click(x,y,button:integer):boolean;
begin
 Result:=(Button=0)and PointInside(x,y);
end;

function TXWindow.DblClick(x,y,button:integer):boolean;
begin
 Result:=(Button=0)and PointInside(x,y);
end;

procedure TXWindow.MouseMove(dx,dy:integer);
begin
end;

procedure TXResizeWindow.Draw;
begin
 inherited;
 rx:=(Left+(Width-xsize.x) div 2);
 ry:=(Top-xsize.y);
 ADKScreen.Trame(rx+8,ry+xsize.Y div 2,xsize.x-16,xsize.Y div 2);
 if ADKScreen.Lock then begin
  GUI.Draw(GUIExtend,{@dib[Pitch*ry+BPP*rx]}ADKScreen.Pixels[rx,ry],ADKScreen.Pitch,1);
  ADKScreen.UnLock;
 end;
end;

function TXResizeWindow.PointResize(x,y:integer):boolean;
begin
 Result:=(y<Top) and (y>=Top-xsize.y) and (x>=rx) and (x<=rx+xsize.x)
end;

function TXResizeWindow.Click(x,y,button:integer):boolean;
begin
 Result:=inherited Click(x,y,button);
 if (Result=False)and(button=0) and PointResize(x,y) then begin
  result:=true;
  resize:=true;
  delta:=0;
 end else
  resize:=false;
end;

function TXResizeWindow.DblClick(x,y,button:integer):boolean;
begin
 Result:=inherited Click(x,y,button);
 if (not Result) and (button=0) and PointResize(x,y) then begin
  if Resized then begin
   Resized:=False;
   inc(Top,Height-LastSize);
   Height:=LastSize;
  end else begin
   Resized:=True;
   LastSize:=Height;
   inc(Top,Height-MinSize);
   Height:=MinSize;
  end;
  Result:=True;
 end;
end;

procedure TXResizeWindow.MouseMove(dx,dy:integer);
begin
 if resize then begin
  resized:=false;
  inc(Delta,dy);
  while (delta>fStep)and(Top+fStep<ADKScreen.Height)and(Height-fStep>=fMinSize) do begin
   inc(Top,fStep);
   dec(Height,fStep);
   dec(delta,fStep);
  end;

  while (delta<-fStep)and(Top-fStep>=0)and(Height+fStep<=fMaxSize) do begin
   dec(Top,fStep);
   inc(Height,fStep);
   inc(Delta,fStep);
  end;

 end;
end;

procedure TXInventWindow.Draw;
var
 x,y:integer;
   p:pointer;
begin
 inherited;
 for y:=0 to (Height div vsize.Y)-1 do begin
  for x:=0 to (Width div hsize.X)-1 do begin
   p:=ADKScreen.Pixels[Left+x*hsize.x,Top+y*vsize.y];//@dib[Pitch*(Top+y*vsize.y)+BPP*(Left+x*hsize.x)];
   GUI.Draw(GUIHLine,p,ADKScreen.Pitch,1);
   GUI.Draw(GUIVLine,p,ADKScreen.Pitch,1);
  end;
 end;
end;

procedure TXScrollWindow.Draw;
var
 x,y,h,i:integer;
 //x,w,y1,y2,h:integer;
begin
 inherited;
 // zone d'affichage
 h:=Height-2*hsize.y;
 // effacer l'ascenseur quand il ne sert a rien...
 if InnerSize<h-4 then begin
  ScrollPos:=0;
  exit;
 end;
 // repositionner le scrolling (en cas de redimensionnement de la fen阾re)
 if ScrollPos>InnerSize-h+4 then ScrollPos:=InnerSize-h+4;
 // dessin des boutons de l'ascenseur
 dec(h,2*ssize.y);
 x:=Left+Width-vsize.x-ssize.x;
 y:=Top+hsize.y;
 GUI.Draw(GUIScrollUp,{@dib[Pitch*y+BPP*x]}ADKScreen.Pixels[x,y],ADKScreen.Pitch,1);
 inc(y,ssize.y);
 ClearRect(x,y,ssize.x,h);
 inc(y,h);
 GUI.Draw(GUIScrollDown,{@dib[Pitch*y+BPP*x]}ADKScreen.Pixels[x,y],ADKScreen.Pitch,1);
 // dessin du curseur de l'ascenseur
 dec(h,Step);
 dec(y,((ScrollPos*h) div (InnerSize-2*ssize.y))+1);
 GradBottom:=y;
 GUI.Draw(GUIScrollBorder,{@dib[Pitch*y+BPP*x]}ADKScreen.Pixels[x,y],ADKScreen.Pitch,1);
 GradCount:=h div 2;
 GradCount:=(GradCount*h) div (InnerSize-2*ssize.y);
 for i:=0 to GradCount-1 do begin
  dec(y,2);
  GUI.Draw(GUIScrollBar,{@dib[Pitch*y+BPP*x]}ADKScreen.Pixels[x,y],ADKScreen.Pitch,1);
 end;
 GUI.Draw(GUIScrollBorder,{@dib[Pitch*y+BPP*x]}ADKScreen.Pixels[x,y],ADKScreen.Pitch,1);
 GradTop:=y;
end;

function TXScrollWindow.Click(x,y,button:integer):boolean;
begin
 GradMove:=False;
 Result:=inherited Click(x,y,button);
 if Result then CheckScroll(x,y);
end;

function TXScrollWindow.DblClick(x,y,button:integer):boolean;
begin
 GradMove:=False;
 Result:=inherited DblClick(x,y,button);
 if Result then CheckScroll(x,y);
end;

procedure TXScrollWindow.CheckScroll(x,y:integer);
var
 h:integer;
begin
 if (x>Left+Width-vsize.x-ssize.x) then begin
  if (y<top+hsize.y) then exit;
  if (y>top+height-hsize.y) then exit;
  h:=Height-2*hsize.y+4;
 // scrollup
  if (y<top+hsize.y+ssize.y) then begin
   if ScrollPos<InnerSize-h then inc(ScrollPos,ScrollStep);
   exit;
  end;
 // scrolldown
  if (y>top+height-hsize.y-ssize.y) then begin
   if ScrollPos>ScrollStep then dec(ScrollPos,ScrollStep) else ScrollPos:=0;
   exit;
  end;
 // thumber
  if (y>GradTop)and(y<GradBottom) then GradMove:=True;
 end;
end;

procedure TXScrollWindow.MouseMove(dx,dy:integer);
var
 h:integer;
begin
 if not GradMove then
  inherited
 else begin
  h:=Height-2*(hsize.y+ssize.y+2);
  dec(ScrollPos,(dy*InnerSize) div h);
  if ScrollPos<0 then ScrollPos:=0 else
  if ScrollPos>InnerSize-h then ScrollPos:=InnerSize-h;
 end;
end;

procedure LoadGUI;
var
 w,h:integer;
begin
 GUI:=TADKImageLib.Create;
 GUI.LoadFromFile(StringProperty('Path','Root')+'GUI2.IML');
 GUITop:=GHeight-GUI.Size[0].Y-1;
 hsize:=GUI.Size[GUIHLine];
 vsize:=GUI.Size[GUIVLine];
 xsize:=GUI.Size[GUIExtend];
 isize:=GUI.Size[GUIInvent];
 ssize:=GUI.Size[GUIScrollUp];

// TXWindow.Create(10,10,150,60);
 w:=GUI.Size[GUIBlock].X;
 h:=GUI.Size[GUIBlock].Y;
 Edit:=TXWindow.Create(0,GHeight-22,GWidth-w,22);
 Chat:=TXMemoWindow.Create(0,GHeight-55-20,GWidth-w,55);
 Chat.Step:=2;
 Chat.MinSize:=41;
 Chat.Maxsize:=GHeight-xsize.y;
 with TXInventWindow.Create(GWidth-3*40,GHeight-h,3*40,0*10*40) do begin
  Step:=40;
  MaxSize:=40*(Top div 40);
  MinSize:=0;
 end;
end;

procedure RenderGUI;
var
 i:integer;
begin
  // block de droite
  with GUI.Size[GUIBlock] do GUI.Draw(GUIBlock,{@dib[Pitch*(Height-Y)+BPP*(Width-X)]}ADKScreen.Pixels[ADKScreen.Width-x,ADKScreen.Height-y],ADKScreen.Pitch,1);

  if XWindows<>nil then
   for i:=0 to XWindows.Count-1 do
    TXWindow(XWindows[i]).Draw;
end;

// fen阾re d'inventaire
procedure RenderInvent;
begin
 ADKScreen.Trame(ipos.x,ipos.y,isize.x,isize.y);
 GUI.Draw(GUIInvent,{@dib[Pitch*ipos.y+BPP*ipos.x]}ADKScreen.Pixels[ipos.x,ipos.y],ADKScreen.Pitch,1);
end;

function GUIMouseDown(x,y,button:integer):boolean;
var
 i:integer;
begin
 if XWindows<>nil then begin
  for i:=0 to XWindows.Count-1 do begin
   XDragWindow:=XWindows[i];
   if XDragWindow.Click(x,y,button) then begin
    Result:=True;
    exit;
   end;
  end;
 end;
 Result:=False;
 XDragWindow:=nil;
end;

procedure GUIMouseMove(dx,dy:integer);
begin
 if XDragWindow<>nil then XDragWindow.MouseMove(dx,dy);
end;

procedure GUIMouseUp;
begin
 if XDragWindow<>nil then begin
  //XDragWindow.MouseUp;
  XDragWindow:=nil;
 end;
end;

procedure GUIDblClick(x,y,button:integer);
var
 i:integer;
begin
 if XWindows<>nil then begin
  for i:=0 to XWindows.Count-1 do begin
   XDragWindow:=XWindows[i];
   if XDragWindow.DblClick(x,y,button) then begin
    //Result:=True;
    exit;
   end;
  end;
 end;
end;

constructor TXMemoWindow.Create(x,y,w,h:integer);
begin
 inherited;
 fLines:=TStringList.Create;
end;

destructor TXMemoWindow.Destroy;
begin
 fLines.Clear;
 inherited;
end;

procedure TXMemoWindow.DrawText(dc:hdc);
var
 y:integer;
 i:integer;
 s:string;
 ts:TSize;
 r:TRect;
begin
 // blabla dans la zone de chat...
 SetBkMode(dc,TRANSPARENT);
 SetTextColor(dc,$00FF00);

 GetTextExtentPoint(dc,'AWX',3,ts);
 InnerSize:=fLines.count*ts.cy;
 ScrollStep:=ts.cy;

 r.Left:=Left+4;
 r.Right:=Left+Width-4;
 y:=Top+Height-4+ScrollPos;
 for i:=fLines.count-1 downto 0 do begin
  s:=fLines[i];
  if y>Top+Height-4 then r.Bottom:=Top+Height-4 else r.Bottom:=y;
  dec(y,ts.cy);
  if y<Top+4 then r.Top:=Top+4 else r.Top:=y;
  ExtTextOut(dc,r.Left,y,ETO_CLIPPED,@r,@s[1],length(s),nil);
  if y<Top+4 then exit;
  r.Bottom:=y;
 end;
end;

end.