开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 游戏 > 游戏引擎 > 查看源码
C2GUIItems.pas
资源名称：CAST2SDK.rar　[点击查看]
上传用户：yj_qiu
上传日期：2022-08-08
资源大小：23636k
文件大小：31k
源码类别：

游戏引擎

开发平台：

Delphi

C2GUIItems.pas：源码内容
  1. (*
  2.  @Abstract(CAST Engine DirectX 8 GUI items unit)
  3.  (C) 2006 George "Mirage" Bakhtadze. <a href="http://www.casteng.com">www.casteng.com</a> <br>
  4.  The source code may be used under either MPL 1.1 or LGPL 2.1 license. See included license.txt file <br>
  5.  Unit contains ready to use GUI items such as button, label etc
  6. *)
  7. {$Include GDefines}
  8. {$Include C2Defines}
  9. unit C2GUIItems;
  11. interface
  13. uses
  14.   TextFile, 
  15.   Basics, Base3D, Props, BaseGraph,
  16.   C2Types, CAST2, C22D, Markup, C2Visual, C2GUI;
  18. type
  19.   TGUIPoint = class(TGUIItem)
  20.   end;
  22.   TGUILine = class(TGUIItem)
  23.     procedure Render; override;
  24.   end;
  26. {  TGUICursor = class(TUVGUIItem)
  27.     constructor Create; override;
  28.     procedure Render; override;
  29.     function ProcessInput(MX, MY: Single): Boolean; override;
  30.     procedure GetProperties(var Result: TProperties); override;
  31.     procedure SetProperties(Properties: TProperties); override;
  32.     procedure SetPosition(const AX, AY: Single); override;
  33.     procedure SetFrame(const Value: Integer); override;
  34.     procedure SetFrameRange(const AMin, AMax: Integer); virtual;
  35.     procedure SetWindow(const X1, Y1, X2, Y2: Single); virtual;
  36.   protected
  37.     CMinFrame, CMaxFrame: Integer;
  38.     HotX, HotY: Single;
  39.     WindowX1, WindowY1, WindowX2, WindowY2: Single;
  40.   end;}
  42.   TLabel = class(TWrappingText)
  43.     procedure Render; override;
  44.   end;
  46. (*  TSwitchLabel = class(TLabel)
  47. // Splits text to variants by "&". "\" threats as ""
  48.     Variants: TStringArray; TotalVariants: Integer;
  49.     procedure SetText(const AText: string); override;
  50.     procedure SetVariantIndex(const Value: Integer); virtual;
  51.     function ProcessInput(MX, MY: Single): Boolean; override;
  52.     procedure GetProperties(var Result: TProperties); override;
  53.     procedure SetProperties(Properties: TProperties); override;
  54.     function IndexOf(const Value: string): Integer; virtual;
  55.   protected
  56.     SWText: string;
  57.     FVariantIndex: Integer;
  58.   public
  59.     property VariantIndex: Integer read FVariantIndex write SetVariantIndex;
  60.   end;
  62.   TPanel = class(TUVGUIItem)
  63.     LineColor, LineHoverColor: Longword;
  64.     CurrentFrame: Integer;
  65.     procedure Render; override;
  66.     function ProcessInput(MX, MY: Single): Boolean; override;
  67.     procedure SetLineColor(const ALineColor: Longword);
  68.     procedure GetProperties(var Result: TProperties); override;
  69.     procedure SetProperties(Properties: TProperties); override;
  70.   protected
  71.     CurrentLineColor: Longword;
  72.   end;
  74.   TSwitchButton = class(TPanel)
  75.     constructor Create; override;
  76.     procedure SetFrame(const Value: Integer); override;
  77.     procedure SetFrameRange(const AMin, AMax: Integer); virtual;
  78.     procedure GetProperties(var Result: TProperties); override;
  79.     procedure SetProperties(Properties: TProperties); override;
  80.     function ProcessInput(MX, MY: Single): Boolean; override;
  81.   protected
  82.     MinSwitchFrame, MaxSwitchFrame: Integer;
  83.     function GetVariantIndex: Integer;
  84.     procedure SetVariantIndex(const Value: Integer);
  85.   public
  86.     property VariantIndex: Integer read GetVariantIndex write SetVariantIndex;
  87.   end;
  89.   TCheckBox = class(TPanel)
  90.     constructor Create; override;
  91.     function ProcessInput(MX, MY: Single): Boolean; override;
  92.     procedure GetProperties(var Result: TProperties); override;
  93.     procedure SetProperties(Properties: TProperties); override;
  94.   protected
  95.     FChecked: Boolean;
  96.     HoverFrame, CheckedFrame, HoverCheckedFrame: Integer;
  97.     procedure SetChecked(const Value: Boolean);
  98.   public
  99.     property Checked: Boolean read FChecked write SetChecked;
  100.   end;
  102.   TButton = class(TPanel)
  103.     Pressed: Boolean;
  104.     function ProcessInput(MX, MY: Single): Boolean; override;
  105.     procedure GetProperties(var Result: TProperties); override;
  106.     procedure SetProperties(Properties: TProperties); override;
  107.     procedure Process; override;
  108.   protected
  109.     HoverFrame, PressedFrame: Integer;
  110.     RepeatDelay, RepeatTimer: Integer;
  111.     RepeatsPerTick, RepeatsCounter: Single;
  112.   end;
  114.   TSlider = class(TUVGUIItem)
  115.     ValueColor, HoverValueColor: Longword;
  116.     ValueFrame: Integer;
  117.     Vertical, FreeChange, Tracking: Boolean;
  118.     constructor Create; override;
  119.     procedure Render; override;
  120.     function ProcessInput(MX, MY: Single): Boolean; override;
  121.     procedure GetProperties(var Result: TProperties); override;
  122.     procedure SetProperties(Properties: TProperties); override;
  123.     function SetValueByCoord(const MX, MY: Single): Boolean; virtual;
  124.   private
  125.     procedure SetMaxValue(const Value: Integer);
  126.     procedure SetValue(const Value: Integer);
  127.   protected
  128.     FValue, FMaxValue: Integer;
  129.     CurrentValueColor: Longword;
  130.   public
  131.     property Value: Integer read FValue write SetValue;
  132.     property MaxValue: Integer read FMaxValue write SetMaxValue;
  133.   end;*)
  135. implementation
  137. uses C2Tess2D;
  139. { TGUILine }
  141. procedure TGUILine.Render;
  142. var i, PCnt: Integer; Point: TGUIPoint;
  143. begin
  144.   Screen.SetViewport(Screen.ConstructViewport(X, Y, X + Width - 1, Y + Height - 1));
  146.   SetTechnique(CurTechnique);
  148.   PCnt := 0;
  149.   for i := 0 to TotalChilds-1 do if Childs[i] is TGUIPoint then begin
  150.     Point := Childs[i] as TGUIPoint;
  151.     Screen.SetColor(Point.CurrentColor);
  152.     if PCnt = 0 then Screen.MoveTo(Point.X, Point.Y) else Screen.LineTo(Point.X, Point.Y);
  153.     Inc(PCnt);
  154.   end;
  156.   inherited;
  158.   Screen.RestoreViewport;
  159. end;
  161. { TGUICursor }
  163. {constructor TGUICursor.Create;
  164. begin
  165.   inherited;
  166.   CMinFrame := 0; CMaxFrame := 0;
  167.   HotX := 0; HotY := 0;
  168.   SetWindow(-1, -1, -1, -1);
  169. end;
  171. function TGUICursor.GetProperties: TProperties;
  172. begin
  173.   Result := inherited GetProperties;
  174.   NewProperty(Result, 'Minimal frame number', ptInt32, Pointer(CMinFrame));
  175.   NewProperty(Result, 'Maximal frame number', ptInt32, Pointer(CMaxFrame));
  176.   NewProperty(Result, 'Hot X', ptSingle, Pointer(HotX));
  177.   NewProperty(Result, 'Hot Y', ptSingle, Pointer(HotY));
  178. end;
  180. function TGUICursor.SetProperties(AProperties: TProperties): Integer;
  181. begin
  182.   Result := -1;
  184.   SetFrameRange(Integer(GetPropertyValue(AProperties, 'Minimal frame number')), Integer(GetPropertyValue(AProperties, 'Maximal frame number')));
  186.   if inherited SetProperties(AProperties) < 0 then Exit;
  188.   HotX := Single(GetPropertyValue(AProperties, 'Hot X'));
  189.   HotY := Single(GetPropertyValue(AProperties, 'Hot Y'));
  191.   Result := 0;
  192. end;
  194. function TGUICursor.ProcessInput(MX, MY: Single): Boolean;
  195. begin
  196.   SetPosition(MX - HotX, MY - HotY);
  197.   Result := inherited ProcessInput(MX, MY);
  198. end;
  200. procedure TGUICursor.SetPosition(const AX, AY: Single);
  201. var NX, NY, WX1, WY1, WX2, WY2: Single;
  202. begin
  203.   if WindowX1 = -1 then WX1 := -HotX else WX1 := WindowX1-HotX;
  204.   if WindowY1 = -1 then WY1 := -HotY else WY1 := WindowY1-HotY;
  205.   if WindowX2 = -1 then WX2 := World.Renderer.RenderPars.ActualWidth-1-HotX else WX2 := WindowX2-HotX;
  206.   if WindowY2 = -1 then WY2 := World.Renderer.RenderPars.ActualHeight-1-HotY else WY2 := WindowY2-HotY;
  207.   NX := MinS(MaxS(AX, WX1), WX2) + 0.5;
  208.   NY := MinS(MaxS(AY, WY1), WY2) + 0.5;
  209.   inherited SetPosition(NX, NY);
  210. end;
  212. procedure TGUICursor.SetWindow(const X1, Y1, X2, Y2: Single);
  213. begin
  214.   WindowX1 := X1; WindowY1 := Y1; WindowX2 := X2; WindowY2 := Y2;
  215.   if WindowX1 > WindowX2 then Swap(WindowX1, WindowX2);
  216.   if WindowY1 > WindowY2 then Swap(WindowY1, WindowY2);
  217.   SetPosition(X, Y);
  218. end;
  220. procedure TGUICursor.SetFrame(const Value: Integer);
  221. begin
  222.   inherited SetFrame(MinI(MaxI(Value, CMinFrame), CMaxFrame));
  223.   NormalFrame := Frame;
  224. end;
  226. procedure TGUICursor.Render(const Screen: TScreen);
  227. begin
  228.   Screen.SetUV(UVMap[Frame]);
  229.   Screen.SetColor(CurrentColor);
  230.   Screen.SetRenderPasses(RenderPasses);
  231.   Screen.Bar(X, Y, X + Width, Y + Height);
  232.   inherited;
  233. end;
  235. procedure TGUICursor.SetFrameRange(const AMin, AMax: Integer);
  236. begin
  237.   CMinFrame := MinI(MaxI(AMin, 0), MaxFrame);
  238.   CMaxFrame := MinI(MaxI(AMax, 0), MaxFrame);
  239.   if CMinFrame > CMaxFrame then Swap(CMinFrame, CMaxFrame);
  240.   SetFrame(Frame);
  241. end;}
  243. { TLabel }
  245. procedure TLabel.Render;
  247. const Dg = 256;
  248. var i, j: Integer;
  249. begin
  250.   if CurTechnique = nil then Exit;
  252.   SetTechnique(CurTechnique);
  254.   if (Font = nil) or (RText = '') then Exit;
  256. //  Screen.DrawLine(Random(200), Random(200), Random(200), Random(200));
  257. //  Screen.Bar(Random(200), Random(200), Random(200), Random(200));
  258. {  for i := 0 to 15 do for j := 0 to 15 do begin
  259.     Screen.SetColor((i * 16 + (j * 16) shl 8) or $FF000000);
  260.     Screen.Bar(X + i*16, Y + j*16, X + i*16+14, Y + j*16+14);
  261.     Screen.SetColor(((15-i) * 16 + (j * 16) shl 16) or $FF000000);
  262.     Screen.Line(X + i*16, Y + j*16, X + i*16+14, Y + j*16+14);
  263.   end;
  265.   Screen.MoveTo(X + 100, Y);
  266.   for i := 0 to TicksProcessed and (Dg-1) do Screen.LineTo(X + Cos(i/Dg*2*pi)*100, Y + Sin(i/Dg*2*pi)*100);
  267.  }
  268. //  Screen.Bar(X, Y, X + 200, Y + Height);
  270.   Screen.SetColor(CurrentColor);
  271.   Screen.SetFont(Font.Font);
  272.   case WrapMode of
  273.     wmNone: if Colored then Screen.PutFormattedText(X, Y, RText) else Screen.PutText(X, Y, RText);
  274.     wmCut: ;
  275.     wmSimbolWrap, wmWordWrap: for i := 0 to TotalLines-1 do
  276.      if Colored then Screen.PutFormattedText(X, Y+i*LineHeight, Lines[i]) else Screen.PutText(X, Y+i*LineHeight, Lines[i]);
  277.     wmJustify: ;
  278.   end;
  280.   inherited;
  281. end;
  282. end.
  283. { TTextGUIItem }
  285. function TTextGUIItem.GetProperties: TProperties;
  286. begin
  287.   Result := inherited GetProperties;
  288. //  NewProperty(Result, 'Text', ptResource + World.ResourceManager.GetResourceClassIndex('TTextResource') shl 8, Pointer(TextRes));
  289.   NewProperty(Result, 'Text', ptLongString + Length(FText) shl 8, Pointer(FText));
  290.   NewProperty(Result, 'Colored', ptBoolean, Pointer(Colored));
  291.   NewProperty(Result, 'Font', ptGroupBegin, nil);
  292.     NewProperty(Result, 'UVMap', ptResource + World.ResourceManager.GetResourceClassIndex('TFontResource') shl 8, Pointer(FontRes));
  293.     NewProperty(Result, 'Characters mapping', ptResource + World.ResourceManager.GetResourceClassIndex('TCharMapResource') shl 8, Pointer(CharMapRes));
  294.     NewProperty(Result, 'X scale', ptSingle, Pointer(TextXScale));
  295.     NewProperty(Result, 'Y scale', ptSingle, Pointer(TextYScale));
  296.   NewProperty(Result, '', ptGroupEnd, nil);
  297. end;
  299. function TTextGUIItem.SetProperties(AProperties: TProperties): Integer;
  300. var Prop: TProperty; s: string;
  301. begin
  302.   Result := -1;
  303.   if inherited SetProperties(AProperties) < 0 then Exit;
  305.   FontRes := Integer(GetPropertyValue(AProperties, 'UVMap'));
  306.   CharMapRes := Integer(GetPropertyValue(AProperties, 'Characters mapping'));
  307.   TextXScale := Single(GetPropertyValue(AProperties, 'X scale'));
  308.   TextYScale := Single(GetPropertyValue(AProperties, 'Y scale'));
  309.   Colored := Boolean(GetPropertyValue(AProperties, 'Colored'));
  311.   if (FontRes >= 0) and (FontRes < World.ResourceManager.TotalResources) and (World.ResourceManager[FontRes] is TArrayResource) then
  312.    UVMap := TUVMap(World.ResourceManager[FontRes].Data);
  313.   if (CharMapRes >= 0) and (CharMapRes < World.ResourceManager.TotalResources) and (World.ResourceManager[CharMapRes] is TArrayResource) then
  314.    CharMap := TCharMap(World.ResourceManager[CharMapRes].Data);
  316.   if GetProperty(AProperties, 'Text', Prop) then begin
  317.     if Prop.ValueType and $FF = ptLongString then begin
  318.       RetrieveLongString(Prop.Value, Prop.ValueType shr 8, s);
  319.       SetText(s);
  320.     end else if Prop.ValueType and $FF = ptResource then begin
  321.       SetTextRes(Integer(Prop.Value));
  322.     end;
  323.   end;
  325.   Result := 0;
  326. end;
  328. function TTextGUIItem.GetClearedText: string;
  329. begin
  330.   if Colored then begin
  331.     if Markup = nil then Markup := TSimpleMarkup.Create;
  332.     Markup.FormattedText := RText;
  333.     Result := Markup.ClearedText
  334.   end else Result := RText;
  335. end;
  337. procedure TTextGUIItem.SetText(const AText: string);
  338. begin
  339.   FText := AText; RText := FText;
  340.   Width := GetTextWidth;
  341. end;
  343. procedure TTextGUIItem.SetTextRes(const ATextRes: Integer);
  344. begin
  345.   TextRes := ATextRes;
  346.   if (TextRes = -1) or (TextRes >= World.ResourceManager.TotalResources) or not (World.ResourceManager[TextRes] is TTextResource) then
  347.    SetText('') else
  348.     SetText(TTextResource(World.ResourceManager[TextRes]).GetText);
  349. end;
  351. function TTextGUIItem.GetTextWidth: Single;
  352. var i: Integer;
  353. begin
  354.   Result := 0;
  355.   if (FontRes = -1) or (CharMapRes = -1) or (not (World.ResourceManager[CharMapRes] is TCharMapResource)) then Exit;
  356.   for i := 0 to Length(CText)-1 do
  357. //   Result := Result + TUVMap(World.ResourceManager[FontRes].Data)[Ord(FText[i+1])-32].W * TextXScale;
  358.    Result := Result + TUVMap(World.ResourceManager[FontRes].Data)[TCharMap(World.ResourceManager[CharMapRes].Data)[Ord(CText[i+1])]].W * TextXScale;
  359. end;
  361. destructor TTextGUIItem.Free;
  362. begin
  363.   if Markup <> nil then Markup.Free;
  364. end;
  366. { TWrappingText }
  368. function TWrappingText.GetProperties: TProperties;
  369. begin
  370.   Result := inherited GetProperties;
  371.   NewProperty(Result, 'Text wrapping mode', ptInt32, Pointer(WrapMode));
  372. end;
  374. function TWrappingText.SetProperties(AProperties: TProperties): Integer;
  375. begin
  376.   Result := -1;
  377.   WrapMode := Integer(GetPropertyValue(AProperties, 'Text wrapping mode'));
  378.   if inherited SetProperties(AProperties) < 0 then Exit;
  379.   Result := 0;
  380. end;
  382. procedure TWrappingText.SetText(const AText: string);
  384. procedure DoSimbolWrap;
  385. var cc: Integer; cw: Single;
  386. begin
  387.   LineHeight := 0;
  388.   if (UVMap = nil) or (CharMap = nil) then Exit;
  389.   TotalLines := 0;
  390.   if CText = '' then Exit;
  392.   cc := 1; cw := 0;
  394.   Inc(TotalLines); SetLength(Lines, TotalLines);
  395.   Lines[TotalLines-1] := CText[cc];
  397.   cw := UVMap[CharMap[Ord(CText[cc])]].W * TextXScale;
  398.   Inc(cc); 
  400.   while cc <= Length(CText) do begin
  401.     if LineHeight < UVMap[CharMap[Ord(CText[cc])]].H * TextYScale then LineHeight := UVMap[CharMap[Ord(CText[cc])]].H * TextYScale;
  402.     cw := cw + UVMap[CharMap[Ord(CText[cc])]].W * TextXScale;
  403.     if (cw > Width) then begin
  404.       Inc(TotalLines); SetLength(Lines, TotalLines);
  405.       Lines[TotalLines-1] := CText[cc];
  406.       cw := 0;
  407.     end else Lines[TotalLines-1] := Lines[TotalLines-1] + CText[cc];
  408.     Inc(cc);
  409.   end;
  411.   Height := LineHeight * TotalLines;
  412. end;
  414. procedure DoWordWrap;         // ToFix: Separators now can violate bounds
  415. const SeparatorChars = ' +-*/<>'#10#13;          
  416. var cc, CurLineWords: Integer; cw, WordW: Single; CurWord: string;
  417. begin
  418.   LineHeight := 0; TotalLines := 0;
  419.   if (UVMap = nil) or (CharMap = nil) or (CText = '') or (MarkUp = nil) then Exit;
  421.   cc := 1; cw := 0;
  423.   Inc(TotalLines); SetLength(Lines, TotalLines);
  424.   Lines[TotalLines-1] := '';
  425.   CurLineWords := 0;
  427.   CurWord := Markup.GetTagStrAtPos(cc-1) + CText[cc];
  428.   WordW := UVMap[CharMap[Ord(CText[cc])]].W * TextXScale;
  429.   Inc(cc);
  431.   while cc <= Length(CText)+1 do begin
  432.     if (cc <= Length(CText)) and (LineHeight < UVMap[CharMap[Ord(CText[cc])]].H * TextYScale) then
  433.      LineHeight := UVMap[CharMap[Ord(CText[cc])]].H * TextYScale;
  435.     if (cc = Length(CText)+1) or (Pos(CText[cc], SeparatorChars) > 0) then begin   // Separator encountered
  436.       if (cw + WordW > Width) and (CurLineWords > 0) then begin                    // New line
  438. {        if cw + UVMap[CharMap[Ord(CText[cc])]].W * TextXScale > Width then begin  // Where to put separator character?
  439.           CurWord := CurWord + CText[cc];
  440.           WordW := WordW + UVMap[CharMap[Ord(CText[cc])]].W * TextXScale;
  441.         end else Lines[TotalLines-1] := Lines[TotalLines-1] + CText[cc];}
  443.         Inc(TotalLines); SetLength(Lines, TotalLines);
  444.         Lines[TotalLines-1] := Markup.GetResultTagStrAtPos(cc-1-Length(CurWord));
  445.         if CurWord <> '' then CurLineWords := 1 else CurLineWords := 0;
  446.         cw := 0;
  447.       end else begin                                                               // Line continued
  448.         if CurWord <> '' then Inc(CurLineWords);
  449.       end;
  451.       Lines[TotalLines-1] := Lines[TotalLines-1] + CurWord;
  452.       cw := cw + WordW;
  454.       if cc <= Length(CText) then begin                                            // Add the separator character
  455.         Lines[TotalLines-1] := Lines[TotalLines-1] + Markup.GetTagStrAtPos(cc-1) + CText[cc];
  456.         cw := cw + UVMap[CharMap[Ord(CText[cc])]].W * TextXScale;
  457.       end;
  459.       CurWord := ''; WordW := 0;
  460.     end else begin                                                                 // Alphabetical character
  461.       CurWord := CurWord + Markup.GetTagStrAtPos(cc-1) + CText[cc];
  462.       WordW := WordW + UVMap[CharMap[Ord(CText[cc])]].W * TextXScale;
  463.     end;
  465.     Inc(cc);
  466.   end;
  468.   Height := LineHeight * TotalLines;
  469. end;
  471. begin
  472.   FText := AText; RText := FText; 
  473.   case WrapMode of
  474.     wmNone: inherited;
  475.     wmCut: ;
  476.     wmSimbolWrap: DoSimbolWrap;
  477.     wmWordWrap: DoWordWrap;
  478.     wmJustify: ;
  479.   end;
  480. end;
  482. { TPanel }
  484. procedure TPanel.SetLineColor(const ALineColor: Longword);
  485. begin
  486.   LineColor := ALineColor; CurrentLineColor := LineColor;
  487. end;
  489. procedure TPanel.Render(const Screen: TScreen);
  490. begin
  491.   Screen.SetUV(UVMap[Frame]);
  492.   Screen.SetColor(CurrentColor);
  493.   Screen.SetRenderPasses(RenderPasses);
  494.   Screen.Bar(X, Y, X + Width, Y + Height);
  496.   if CurrentLineColor > 0 then begin
  497.     Screen.SetColor(CurrentLineColor);
  498.     Screen.SetUV(StdUV);
  499.     Screen.MoveTo(X, Y);
  500.     Screen.LineTo(X+Width, Y);
  501.     Screen.LineTo(X+Width, Y+Height);
  502.     Screen.LineTo(X, Y+Height);
  503.     Screen.LineTo(X, Y);
  504.   end;
  505.   inherited;
  506. end;
  508. function TPanel.GetProperties: TProperties;
  509. begin
  510.   Result := inherited GetProperties;
  511.   NewProperty(Result, 'Lines color', ptColor32, Pointer(LineColor));
  512.   NewProperty(Result, 'Lines hover color', ptColor32, Pointer(LineHoverColor));
  513. end;
  515. function TPanel.SetProperties(AProperties: TProperties): Integer;
  516. begin
  517.   Result := -1;
  518.   if inherited SetProperties(AProperties) < 0 then Exit;
  519.   SetLineColor(Longword(GetPropertyValue(AProperties, 'Lines color')));
  520.   LineHoverColor := Longword(GetPropertyValue(AProperties, 'Lines hover color'));
  522.   Result := 0;
  523. end;
  525. function TPanel.ProcessInput(MX, MY: Single): Boolean;
  526. begin
  527.   Result := inherited ProcessInput(MX, MY);
  528.   if Hover then begin
  529.     CurrentLineColor := LineHoverColor;
  530.   end else begin
  531.     CurrentLineColor := LineColor;
  532.   end;
  533. end;
  535. { TSwitchButton }
  537. constructor TSwitchButton.Create(AName: TShortName; AWorld: TWorld; AParent: TItem);
  538. begin
  539.   inherited;
  540.   CurrentFrame := 0;
  541. end;
  543. procedure TSwitchButton.SetFrameRange(const AMin, AMax: Integer);
  544. begin
  545.   MinSwitchFrame := MinI(MaxI(AMin, 0), MaxFrame);
  546.   MaxSwitchFrame := MinI(MaxI(AMax, 0), MaxFrame);
  547.   if MinSwitchFrame > MaxSwitchFrame then Swap(MinSwitchFrame, MaxSwitchFrame);
  548.   SetFrame(Frame);
  549. end;
  551. procedure TSwitchButton.SetFrame(const Value: Integer);
  552. begin
  553.   inherited SetFrame(MinI(MaxI(Value, MinSwitchFrame), MaxSwitchFrame));
  554.   NormalFrame := Frame; CurrentFrame := Frame;
  555. end;
  557. function TSwitchButton.ProcessInput(MX, MY: Single): Boolean;
  558. var i: Integer;
  559. begin
  560.   Result := inherited ProcessInput(MX, MY);
  561.   if Hover then for i := 0 to GetGUI.Commands.TotalCommands-1 do
  562.    if (GetGUI.Commands.Commands[i].CommandID = cmdLeftMouseClick) then begin
  563.      Inc(CurrentFrame);
  564.      if EOnChange then GetGUI.Commands.Add(cmdGUIChange, [Integer(Self)]);
  565.      Break;
  566.    end;
  567.   if CurrentFrame > MaxSwitchFrame then CurrentFrame := MinSwitchFrame;
  568. //  if (HoverFrame <> NormalFrame) and IsInBounds(MX, MY) then Inc(CurrentFrame);
  569.   Frame := CurrentFrame;
  570. end;
  572. function TSwitchButton.GetProperties: TProperties;
  573. begin
  574.   Result := inherited GetProperties;
  575.   NewProperty(Result, 'Minimal frame number', ptInt32, Pointer(MinSwitchFrame));
  576.   NewProperty(Result, 'Maximal frame number', ptInt32, Pointer(MaxSwitchFrame));
  577. end;
  579. function TSwitchButton.SetProperties(AProperties: TProperties): Integer;
  580. begin
  581.   Result := -1;
  582.   if inherited SetProperties(AProperties) < 0 then Exit;
  584.   SetFrameRange(Integer(GetPropertyValue(AProperties, 'Minimal frame number')), Integer(GetPropertyValue(AProperties, 'Maximal frame number')));
  586.   Result := 0;
  587. end;
  589. function TSwitchButton.GetVariantIndex: Integer;
  590. begin
  591.   Result := Frame - MinSwitchFrame;
  592. end;
  594. procedure TSwitchButton.SetVariantIndex(const Value: Integer);
  595. begin
  596.   Frame := MinSwitchFrame + Value;
  597. end;
  599. { TUVGUIItem }
  601. constructor TUVGUIItem.Create(AName: TShortName; AWorld: TWorld; AParent: TItem);
  602. begin
  603.   inherited;
  604.   UVMapRes := -1; UVMap := GetStdUVMap;
  605. end;
  607. function TUVGUIItem.GetProperties: TProperties;
  608. begin
  609.   Result := inherited GetProperties;
  610.   NewProperty(Result, 'UV map', ptResource + World.ResourceManager.GetResourceClassIndex('TFontResource') shl 8, Pointer(UVMapRes));
  611.   NewProperty(Result, 'Normal frame', ptInt32, Pointer(NormalFrame));
  612. end;
  614. function TUVGUIItem.SetProperties(AProperties: TProperties): Integer;
  615. begin
  616.   Result := -1;
  617.   if inherited SetProperties(AProperties) < 0 then Exit;
  618.   UVMapRes := Integer(GetPropertyValue(AProperties, 'UV map'));
  619.   NormalFrame := Integer(GetPropertyValue(AProperties, 'Normal frame'));
  621.   if (UVMapRes < 0) or (UVMapRes >= World.ResourceManager.TotalResources) or not (World.ResourceManager[UVMapRes] is TArrayResource) then UVMap := GetStdUVMap else begin
  622.     MaxFrame := (World.ResourceManager[UVMapRes] as TArrayResource).TotalElements - 1;
  623.     UVMap := (World.ResourceManager[UVMapRes] as TArrayResource).Data;
  624.   end;
  625.   Frame := NormalFrame;
  626. //  SetDimensions(UVMap[Frame].W, UVMap[Frame].H);
  628.   Result := 0;
  629. end;
  631. procedure TUVGUIItem.SetFrame(const Value: Integer);
  632. begin
  633.   if (Value = FFrame) or (Value > MaxFrame) then Exit;
  634.   FFrame := Value;
  635. end;
  637. { TSlider }
  639. constructor TSlider.Create(AName: TShortName; AWorld: TWorld; AParent: TItem);
  640. begin
  641.   inherited;
  642.   MaxValue := 100; Value := 0;
  643. end;
  645. function TSlider.GetProperties: TProperties;
  646. begin
  647.   Result := inherited GetProperties;
  648.   NewProperty(Result, 'Value color', ptColor32, Pointer(ValueColor));
  649.   NewProperty(Result, 'Hover value color', ptColor32, Pointer(HoverValueColor));
  650.   NewProperty(Result, 'Value frame', ptInt32, Pointer(ValueFrame));
  651.   NewProperty(Result, 'Value', ptInt32, Pointer(FValue));
  652.   NewProperty(Result, 'Max value', ptInt32, Pointer(FMaxValue));
  653.   NewProperty(Result, 'Vertical', ptBoolean, Pointer(Vertical));
  654.   NewProperty(Result, 'Free change', ptBoolean, Pointer(FreeChange));
  655.   NewProperty(Result, 'Tracking', ptBoolean, Pointer(Tracking));
  656. end;
  658. function TSlider.SetProperties(AProperties: TProperties): Integer;
  659. begin
  660.   Result := -1;
  661.   if inherited SetProperties(AProperties) < 0 then Exit;
  662.   ValueColor := Longword(GetPropertyValue(AProperties, 'Value color'));
  663.   HoverValueColor := Longword(GetPropertyValue(AProperties, 'Hover value color'));
  664.   ValueFrame := Integer(GetPropertyValue(AProperties, 'Value frame'));
  665.   SetValue(Integer(GetPropertyValue(AProperties, 'Value')));
  666.   SetMaxValue(Integer(GetPropertyValue(AProperties, 'Max value')));
  667.   Vertical := Boolean(GetPropertyValue(AProperties, 'Vertical'));
  668.   FreeChange := Boolean(GetPropertyValue(AProperties, 'Free change'));
  669.   Tracking := Boolean(GetPropertyValue(AProperties, 'Tracking'));
  671.   Result := 0;
  672. end;
  674. function TSlider.ProcessInput(MX, MY: Single): Boolean;
  675. var i: Integer;
  676. begin
  677.   Result := inherited ProcessInput(MX, MY);
  678.   if Hover then begin
  679.     CurrentValueColor := HoverValueColor;
  680.     for i := 0 to GetGUI.Commands.TotalCommands-1 do begin
  681.       if LMousePressed then begin
  682.         if (GetGUI.Commands.Commands[i].CommandID = cmdLeftMouseUp) then
  683.          if SetValueByCoord(MX, MY) then if EOnChange then GetGUI.Commands.Add(cmdGUIChange, [Integer(Self)]);
  684.       end;
  685.     end;
  686.   end else begin
  687.     CurrentValueColor := ValueColor;
  688.   end;
  689.   if LMousePressed then if Tracking then if SetValueByCoord(MX, MY) then
  690.    if EOnChange then GetGUI.Commands.Add(cmdGUIChange, [Integer(Self)]);
  691. end;
  693. procedure TSlider.Render(const Screen: TScreen);
  694. var Temp: Single; UV: TUV;
  695. begin
  696.   Screen.SetRenderPasses(RenderPasses);
  698.   if FMaxValue = 0 then Temp := 0 else Temp := FValue / FMaxValue;
  700.   if Vertical then begin
  701.     UV.U := UVMap[Frame].U; UV.W := UVMap[Frame].W;
  702.     UV.V := UVMap[Frame].V; UV.H := UVMap[Frame].H * (1-Temp);
  703.     Screen.SetUV(UV);
  704.     Screen.SetColor(CurrentColor);
  705.     Screen.Bar(X, Y, X + Width, Y + Height - Height * Temp);
  707.     UV.U := UVMap[ValueFrame].U; UV.W := UVMap[ValueFrame].W;
  708.     UV.V := UVMap[ValueFrame].V + UVMap[ValueFrame].H * (1-Temp); UV.H := UVMap[ValueFrame].H * Temp;
  709.     Screen.SetUV(UV);
  710.     Screen.SetColor(CurrentValueColor);
  711.     Screen.Bar(X, Y + Height - Height * Temp, X + Width, Y + Height);
  712.   end else begin
  713.     UV.U := UVMap[Frame].U; UV.W := UVMap[Frame].W * Temp;
  714.     UV.V := UVMap[Frame].V; UV.H := UVMap[Frame].H;
  715.     Screen.SetUV(UV);
  716.     Screen.SetColor(CurrentColor);
  717.     Screen.Bar(X, Y, X + Width * Temp, Y + Height);
  719.     UV.U := UVMap[ValueFrame].U + UVMap[ValueFrame].W * Temp; UV.W := UVMap[ValueFrame].W * (1 - Temp);
  720.     UV.V := UVMap[ValueFrame].V; UV.H := UVMap[ValueFrame].H;
  721.     Screen.SetUV(UV);
  722.     Screen.SetColor(CurrentValueColor);
  723.     Screen.Bar(X + Width * Temp, Y, X + Width, Y + Height);
  724.   end;
  726.   inherited;
  727. end;
  729. procedure TSlider.SetMaxValue(const Value: Integer);
  730. begin
  731.   FMaxValue := MaxI(0, Value);
  732. end;
  734. procedure TSlider.SetValue(const Value: Integer);
  735. begin
  736.   FValue := MaxI(0, MinI(MaxValue, Value));
  737. end;
  739. function TSlider.SetValueByCoord(const MX, MY: Single): Boolean;
  740. var OldValue: Integer;
  741. begin
  742.   Result := False;
  743.   if not FreeChange then Exit;
  745.   OldValue := Value;
  747.   if Vertical then begin
  748.     if Height = 0 then Value := 0 else Value := Trunc(0.5 + (Y + Height - MY) / Height * MaxValue);
  749.   end else begin
  750.     if Width = 0 then Value := 0 else Value := Trunc(0.5 + (MX - X) / Width * MaxValue);
  751.   end;
  752.   Result := OldValue <> Value;
  753. end;
  755. { TCheckBox }
  757. constructor TCheckBox.Create(AName: TShortName; AWorld: TWorld; AParent: TItem);
  758. begin
  759.   inherited;
  760.   Checked := False;
  761.   CurrentFrame := NormalFrame;
  762. end;
  764. procedure TCheckBox.SetChecked(const Value: Boolean);
  765. begin
  766.   FChecked := Value;
  767.   if FChecked then Frame := CheckedFrame else Frame := NormalFrame;
  768. end;
  770. function TCheckBox.GetProperties: TProperties;
  771. begin
  772.   Result := inherited GetProperties;
  773.   NewProperty(Result, 'Hover frame', ptInt32, Pointer(HoverFrame));
  774.   NewProperty(Result, 'Checked frame', ptInt32, Pointer(CheckedFrame));
  775.   NewProperty(Result, 'Hover checked frame', ptInt32, Pointer(HoverCheckedFrame));
  776.   NewProperty(Result, 'Checked', ptBoolean, Pointer(Checked));
  777. end;
  779. function TCheckBox.SetProperties(AProperties: TProperties): Integer;
  780. begin
  781.   Result := -1;
  782.   if inherited SetProperties(AProperties) < 0 then Exit;
  783.   HoverFrame := Integer(GetPropertyValue(AProperties, 'Hover frame'));
  784.   CheckedFrame := Integer(GetPropertyValue(AProperties, 'Checked frame'));
  785.   HoverCheckedFrame := Integer(GetPropertyValue(AProperties, 'Hover checked frame'));
  786.   SetChecked(Boolean(GetPropertyValue(AProperties, 'Checked')));
  788.   Result := 0;
  789. end;
  791. function TCheckBox.ProcessInput(MX, MY: Single): Boolean;
  792. var i: Integer;
  793. begin
  794.   Result := inherited ProcessInput(MX, MY);
  795.   if Hover then begin
  796.     for i := 0 to GetGUI.Commands.TotalCommands-1 do begin
  797.       if (GetGUI.Commands.Commands[i].CommandID = cmdLeftMouseClick) then begin
  798.         SetChecked(not Checked);
  799.         if EOnChange then GetGUI.Commands.Add(cmdGUIChange, [Integer(Self)]);
  800.       end; 
  801.     end;
  802.     if FChecked then Frame := HoverCheckedFrame else Frame := HoverFrame;
  803.   end else begin
  804.     if FChecked then Frame := CheckedFrame else Frame := NormalFrame;
  805.   end;
  806. end;
  808. { TButton }
  809. function TButton.GetProperties: TProperties;
  810. begin
  811.   Result := inherited GetProperties;
  812.   NewProperty(Result, 'Hover frame', ptInt32, Pointer(HoverFrame));
  813.   NewProperty(Result, 'Pressed frame', ptInt32, Pointer(PressedFrame));
  814.   NewProperty(Result, 'Repeating delay', ptInt32, Pointer(RepeatDelay));
  815.   NewProperty(Result, 'Repeats per tick', ptSingle, Pointer(RepeatsPerTick));
  816. end;
  818. function TButton.SetProperties(AProperties: TProperties): Integer;
  819. begin
  820.   Result := -1;
  821.   if inherited SetProperties(AProperties) < 0 then Exit;
  822.   HoverFrame := Integer(GetPropertyValue(AProperties, 'Hover frame'));
  823.   PressedFrame := Integer(GetPropertyValue(AProperties, 'Pressed frame'));
  824.   RepeatDelay := Integer(GetPropertyValue(AProperties, 'Repeating delay'));
  825.   RepeatsPerTick := Single(GetPropertyValue(AProperties, 'Repeats per tick'));
  827.   RepeatsCounter := 0;
  828.   Result := 0;
  829. end;
  831. function TButton.ProcessInput(MX, MY: Single): Boolean;
  832. begin
  833.   Result := inherited ProcessInput(MX, MY);
  834. //  if Transparent and (Parent <> nil) and (Parent is TButton) then LMousePressed := TGUIItem(Parent).LMousePressed;
  835.   Pressed := LMousePressed;
  836.   if Pressed then Frame := PressedFrame else if Hover then Frame := HoverFrame else Frame := NormalFrame;
  837. end;
  839. function TButton.Process: Boolean;
  840. var WasPressed: Boolean;
  841. begin
  842.   WasPressed := LMousePressed;
  843.   Result := inherited Process;
  844.   if LMousePressed then begin
  845.     if not WasPressed then begin
  846.       RepeatTimer := RepeatDelay;
  847.       RepeatsCounter := 0;
  848.     end else if RepeatTimer > 0 then Dec(RepeatTimer) else begin
  849.       RepeatsCounter := RepeatsCounter + RepeatsPerTick;
  850.       while RepeatsCounter >= 1 do begin
  851.         if EOnClick then GetGUI.Commands.Add(cmdGUIClick, [Integer(Self)]);
  852.         RepeatsCounter := RepeatsCounter - 1;
  853.       end;
  854.     end;
  855.   end else RepeatTimer := RepeatDelay;
  856. end;
  858. { TSwitchLabel }
  860. function TSwitchLabel.ProcessInput(MX, MY: Single): Boolean;
  861. var i: Integer;
  862. begin
  863.   Result := inherited ProcessInput(MX, MY);
  864.   if Hover then for i := 0 to GetGUI.Commands.TotalCommands-1 do
  865.    if (GetGUI.Commands.Commands[i].CommandID = cmdLeftMouseClick) then begin
  866.      if VariantIndex < TotalVariants-1 then VariantIndex := VariantIndex + 1 else VariantIndex := 0;
  867.      if EOnChange then GetGUI.Commands.Add(cmdGUIChange, [Integer(Self)]);
  868.      Break;
  869.    end;
  870. end;
  872. procedure TSwitchLabel.SetText(const AText: string);
  873. begin
  874.   SWText := AText;
  875.   TotalVariants := Split(SWText, '&', Variants, False);
  876.   VariantIndex := 0;
  877. end;
  879. procedure TSwitchLabel.SetVariantIndex(const Value: Integer);
  880. begin
  881.   if (Value >= 0) and (Value < TotalVariants) then FVariantIndex := Value;
  882.   if FVariantIndex >= Length(Variants) then Exit;
  883.   inherited SetText(Variants[FVariantIndex]);
  884.   FText := SWText;
  885.   if WrapMode = wmNone then Width := GetTextWidth;
  886. end;
  888. function TSwitchLabel.GetProperties: TProperties;
  889. begin
  890.   Result := inherited GetProperties;
  891.   NewProperty(Result, 'Variant index', ptInt32, Pointer(VariantIndex));
  892. end;
  894. function TSwitchLabel.SetProperties(AProperties: TProperties): Integer;
  895. begin
  896.   if inherited SetProperties(AProperties) < 0 then Exit;
  897.   VariantIndex := Integer(GetPropertyValue(AProperties, 'Variant index'));
  898.   Result := 0;
  899. end;
  901. function TSwitchLabel.IndexOf(const Value: string): Integer;
  902. var i: Integer;
  903. begin
  904.   Result := -1;
  905.   for i := 0 to TotalVariants-1 do if Variants[i] = Value then begin
  906.     Result := i;
  907.     Exit;
  908.   end;
  909. end;
  911. end.