dxwstatobj.pas

Delphi Engine for games.

begin
For i:=0 to Count-1 do
if Items[i].Focused then
 begin
  Items[i].KeyDown(Key,Shift);
 end
end;

procedure TDXWObjectList.KeyPress(var Key: char);
Var
 i         : integer;
begin
For i:=0 to Count-1 do
if Items[i].Focused then
 begin
  Items[i].KeyPress(Key);
 end
end;

procedure TDXWObjectList.KeyUp(var Key: Word; Shift: TShiftState);
Var
 i         : integer;
begin
For i:=0 to Count-1 do
if Items[i].Focused then
 begin
  Items[i].KeyUp(Key,Shift);
 end
end;

procedure TDXWObjectList.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
Var
 i         : integer;
 DownPoint : TPoint;
begin
 DownPoint:=Point(x,y);

 //For i:=0 to Count-1 do Items[i].Focused:=false;

 For i:=0 to Count-1 do
  begin
   if ( PtInRect(Items[i].BoundsRect,DownPoint) ) and
      (Items[i].Visible) and
      (Items[i].Enabled) then
    begin
     Items[i].MouseDown(Button,Shift,X,Y);
     if Items[i].MouseCaptured then CapturedObjectID:=i;
    end
    else
    begin
     Items[i].Focused:=false;
    end;

  end;
end;

procedure TDXWObjectList.MouseMove(Shift: TShiftState; X, Y: Integer);
Var
 i         : integer;
 MousePoint : TPoint;
begin
 MousePoint:=Point(x,y);

 if CapturedObjectID<0
 then
 For i:=0 to Count-1 do
  begin
   if ( PtInRect(Items[i].BoundsRect,MousePoint) ) and
      ( Items[i].Visible ) and
      ( Items[i].Enabled ) then
    begin
     Items[i].MouseMove(Shift,X,Y);
    end
    else
     Items[i].MouseInControl:=false;
  end
  else
     Items[CapturedObjectID].MouseMove(Shift,X,Y);

end;

procedure TDXWObjectList.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
Var
 i         : integer;
 DownPoint : TPoint;
begin
 CapturedObjectID:=-1;
 DownPoint:=Point(x,y);

 For i:=0 to Count-1 do
  begin
   if //( PtInRect(Items[i].BoundsRect,DownPoint) ) and
      //( Items[i].Visible ) and
      (Items[i].Down) then
    begin
     Items[i].MouseUp(Button,Shift,X,Y);
     break;
    end;
  end;

end;

function TDXWObjectList.Remove(ADXWObject: TDXWObject):
  Integer;
begin
  Result := inherited Remove(ADXWObject);
end;

procedure TDXWObjectList.SetItems(Index: Integer;
  ADXWObject: TDXWObject);
begin
   inherited Items[Index] := ADXWObject;
end;


/////////////////////////////////////////////////////////////////////////

constructor TDXImageButton.Create;
begin
  inherited Create;
  FCaption:='';
end;

function TDXImageButton.GetDrawImageIndex: Integer;
begin
  if Selected then Result :=1 else Result :=0;
end;

procedure TDXImageButton.DoDraw;
var
  ImageIndex: Integer;
begin
if Not FVisible then Exit;
  ImageIndex := GetDrawImageIndex;
  Image.Draw( FSurface, X, Y, ImageIndex);
  if FCaption<>'' then
   begin
    with FSurface.Canvas do
    begin
     Brush.Style := bsClear;
     if HighLighted then
     begin
      Font.Color := clWhite;
      Font.Style:=[fsBold];
     end
     else
     begin
      Font.Style:=[];
      Font.Color := clYellow;
     end;

     Font.Size := 12;
     Font.Name:='Times New Roman';
     TextOut(X+(Width-TextWidth(FCaption))div 2 ,
             Y+(Height-TextHeight('A'))div 2, FCaption);
     Release;
    end;
   end;
end;

{
procedure TDXImageButton.DrawSelf;
begin
 DoDraw;
end;
}

procedure TDXImageButton.SetSurface(Value: TDirectDrawSurface);
begin
  FSurface := Value;
end;

/////////////////////////////////////////////////////////////////////////

function TDXWImageObject.GetDrawImageIndex: Integer;
begin
  if FDown then Result :=1 else Result :=0;
end;

procedure TDXWImageObject.DoDraw;
var
 ImageIndex: Integer;
begin
if Not FVisible then Exit;
  ImageIndex := GetDrawImageIndex;
  Image.Draw( FSurface, FLEft, FTop, ImageIndex);
  if FText<>'' then
   begin
    with FSurface.Canvas do
    begin
     Font.Assign(Self.Font);

     Brush.Style := bsClear;
     if MouseInControl and CanHighLighted then
     begin
      Font.Style:=[fsBold];
      Font.Color := clWhite;
     end
     else
     begin
      Font:=Self.Font
     end;

     {
     TextOut(FLeft+(FWidth-TextWidth(FText))div 2 ,
             FTop+(FHeight-TextHeight('A'))div 2, FText);
     }

     TextRect(BoundsRect,FLeft+(FWidth-TextWidth(FText))div 2 ,
                         FTop+(FHeight-TextHeight('A'))div 2, FText);

     Release;
    end;
   end;
end;

procedure TDXWImageObject.SetSurface(Value: TDirectDrawSurface);
begin
  FSurface := Value;
end;




{ TDXWEdit }

procedure TDXWEdit.Change;
begin
 if Assigned(FOnChange) then FOnChange(Self);
end;

constructor TDXWEdit.Create(AOwner: TObject);
begin
 inherited Create(AOwner);
 FCaretPos:=0;
end;

procedure TDXWEdit.DoDraw;
begin
  inherited DoDraw;
end;

function TDXWEdit.GetDrawImageIndex: Integer;
begin
 if Focused then Result :=1 else Result :=0;
end;

procedure TDXWEdit.KeyDown(var Key: Word; Shift: TShiftState);
Var
S: string;
begin

Case key of
 //vk_left  :
 //vk_right :
 vk_back    : Text:=Shorten(FText,1);
end;

 inherited KeyDown(Key,Shift);
end;

procedure TDXWEdit.KeyPress(var Key: char);
Var
S: string;
begin
 //ShowMessage(IntToStr( Ord(key) ));
 if ( Ord(key)=8 ) or //BackSpace pressed
    ( Ord(key)=13 )//Enter pressed
  then Exit;

 Text:=FText+Key;
 inherited KeyPress(Key);
end;

procedure TDXWEdit.KeyUp(var Key: Word; Shift: TShiftState);
begin
  inherited;
end;

procedure TDXWEdit.SetText(const Value: String);
begin
  if FText=Value then Exit;

  FText := Value;
  Change;
end;

{ TDXWLabel }

constructor TDXWLabel.Create(AOwner:TObject);
begin
  inherited Create(AOwner);
  FAutoSize:=true;
end;

procedure TDXWLabel.DoDraw;
begin
if Not FVisible then Exit;

with FSurface.Canvas do
begin
 Brush.Style := bsClear;
 Font.Assign(Self.Font);
 if FAutoSize
  then TextOut(FLeft,FTop,FText)
   else TextRect(BoundsRect,0,0,FText);
 Release;
end;

end;

procedure TDXWLabel.SetSurface(Value: TDirectDrawSurface);
begin
 FSurface := Value;
end;


{ TDXWPanel }

function TDXWPanel.GetDrawImageIndex: Integer;
begin
 Result :=0;
end;

{ TDXWButton }

constructor TDXWButton.Create(AOwner: TObject);
begin
 inherited Create(AOwner);
 FCanHighLighted:=true;
 Font.Color:=clYellow;
end;

procedure TDXWObject.SetHeight(const Value: Integer);
begin
  FHeight := Value;
  SetBounds;
end;

procedure TDXWObject.SetLeft(const Value: Integer);
begin
  FLeft := Value;
  SetBounds;
end;

procedure TDXWObject.SetTop(const Value: Integer);
begin
  FTop := Value;
  SetBounds;
end;

procedure TDXWObject.SetWidth(const Value: Integer);
begin
  FWidth := Value;
  SetBounds;
end;

procedure TDXWObject.SetBoundsRect(const Value: TRect);
begin
 FLeft:=Value.Left;
 FTop:=Value.Top;
 FWidth:=Value.Right-Value.Left;
 FHeight:=Value.Bottom-Value.Top;
 SetBounds;
end;

procedure TDXWObject.SetBounds;
begin
 FBoundsRect:=Bounds(FLeft,FTop,FWidth,FHeight);
end;

procedure TDXWImageObject.SetImage(const Value: TPictureCollectionItem);
begin
  FImage := Value;
  Width:=Value.Width;
  Height:=Value.Height;
end;

end.