unit KM_ControlsForm; {$I KaM_Remake.inc} interface uses Classes, Controls, KM_Controls, KM_ControlsBase, KM_CommonTypes, KM_Points, KM_ResFonts; type TKMFormBackgroundType = ( fbGray, // Dark grey scroll with big header roll fbYellow, // Yellow scroll without header roll fbScroll // Yellow scroll with small header roll ); TKMForm = class(TKMPanel) const DEFAULT_CAPTION_FONT = fntOutline; private fDragging: Boolean; fDragStartPos: TKMPoint; fBackground: TKMFormBackgroundType; fHandleCloseKey: Boolean; fCapOffsetY: Integer; fOnClose: TKMEvent; procedure UpdateSizes; procedure Close(Sender: TObject); procedure HandleOtherControlMouseMove(Sender: TObject; X,Y: Integer; Shift: TShiftState); procedure HandleOtherControlMouseDown(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); procedure HandleOtherControlMouseUp(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); function MarginMainLeftRight: Integer; function MarginMainTop: Integer; function MarginMainBottom: Integer; function MarginCrossTop: Integer; function MarginCrossRight: Integer; function GetActualWidth: Integer; procedure SetActualWidth(aValue: Integer); function GetActualHeight: Integer; procedure SetActualHeight(aValue: Integer); procedure SetHandleCloseKey(aValue: Boolean); procedure SetCapOffsetY(aValue: Integer); function GetCaption: string; procedure SetCaption(const aValue: string); protected Bevel_Contents: TKMBevel; Bevel_ModalBackground: TKMBevel; Image_Background, Image_Close: TKMImage; Label_Caption: TKMLabel; procedure SetWidth(aValue: Integer); override; procedure SetHeight(aValue: Integer); override; public ItemsPanel: TKMPanel; DragEnabled: Boolean; constructor Create(aParent: TKMPanel; aContentWidth, aContentHeight: Integer; const aCaption: UnicodeString = ''; aBackground: TKMFormBackgroundType = fbYellow; aCloseIcon: Boolean = False; aBevelForContents: Boolean = True; aModalBackground: Boolean = True); procedure MouseDown (X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; procedure MouseMove (X,Y: Integer; Shift: TShiftState); override; procedure MouseUp (X,Y: Integer; Shift: TShiftState; Button: TMouseButton); override; function KeyUp(Key: Word; Shift: TShiftState): Boolean; override; property OnClose: TKMEvent read fOnClose write fOnClose; property ActualHeight: Integer read GetActualHeight write SetActualHeight; property ActualWidth: Integer read GetActualWidth write SetActualWidth; property CapOffsetY: Integer read fCapOffsetY write SetCapOffsetY; property Caption: string read GetCaption write SetCaption; property HandleCloseKey: Boolean read fHandleCloseKey write SetHandleCloseKey; end; implementation uses Math, KM_RenderUI, KM_ResTexts, KM_ResKeys, KM_ResTypes; { TKMForm } constructor TKMForm.Create(aParent: TKMPanel; aContentWidth, aContentHeight: Integer; const aCaption: UnicodeString = ''; aBackground: TKMFormBackgroundType = fbYellow; aCloseIcon: Boolean = False; aBevelForContents: Boolean = True; aModalBackground: Boolean = True); const BG_RX: array [TKMFormBackgroundType] of TRXType = (rxGuiMain, rxGuiMain, rxGui); BG_ID: array [TKMFormBackgroundType] of Word = (15, 18, 409); begin fBackground := aBackground; var desiredWidth := aContentWidth + 2 * MarginMainLeftRight; var desiredHeight := aContentHeight + MarginMainBottom + MarginMainTop; var desiredLeft := Max(0, (aParent.Width - desiredWidth) div 2); var desiredTop := Max(0, (aParent.Height - desiredHeight) div 2); // Create panel with calculated sizes inherited Create(aParent, desiredLeft, desiredTop, desiredWidth, desiredHeight); // Fix its base sizes as a desired one BaseWidth := desiredWidth; BaseHeight := desiredHeight; // FitInParent := True; not sure if this is ever needed DragEnabled := False; fHandleCloseKey := False; fCapOffsetY := 0; if aModalBackground then Bevel_ModalBackground := TKMBevel.Create(Self, -5000, -5000, 10000, 10000); Image_Background := TKMImage.Create(Self, 0, 0, desiredWidth, desiredHeight, BG_ID[fBackground], BG_RX[fBackground]); Image_Background.AnchorsStretch; Image_Background.ImageStretch; if aCloseIcon then begin Image_Close := TKMImage.Create(Self, Width - MarginCrossRight, MarginCrossTop, 31, 30, 52); Image_Close.Anchors := [anTop, anRight]; Image_Close.Hint := gResTexts[TX_MSG_CLOSE_HINT]; Image_Close.OnClick := Close; Image_Close.HighlightOnMouseOver := True; end; ItemsPanel := TKMPanel.Create(Self, MarginMainLeftRight, MarginMainTop, Width - 2*MarginMainLeftRight, Height - MarginMainTop - MarginMainBottom); ItemsPanel.AnchorsStretch; if aBevelForContents then begin Bevel_Contents := TKMBevel.Create(ItemsPanel, 0, 0, ItemsPanel.Width, ItemsPanel.Height); Bevel_Contents.AnchorsStretch; end; Label_Caption := TKMLabel.Create(ItemsPanel, 0, -25, ItemsPanel.Width, 20, aCaption, DEFAULT_CAPTION_FONT, taCenter); AnchorsCenter; Hide; fMasterControl.SubscribeOnOtherMouseMove(HandleOtherControlMouseMove); fMasterControl.SubscribeOnOtherMouseDown(HandleOtherControlMouseDown); fMasterControl.SubscribeOnOtherMouseUp(HandleOtherControlMouseUp); end; function TKMForm.MarginMainLeftRight: Integer; const MARGIN_SIDE: array [TKMFormBackgroundType] of Byte = (20, 35, 20); begin Result := MARGIN_SIDE[fBackground]; end; function TKMForm.MarginMainTop: Integer; const MARGIN_TOP: array [TKMFormBackgroundType] of Byte = (40, 80, 50); begin Result := MARGIN_TOP[fBackground]; end; function TKMForm.MarginMainBottom: Integer; const MARGIN_BOTTOM: array [TKMFormBackgroundType] of Byte = (20, 50, 20); begin Result := MARGIN_BOTTOM[fBackground]; end; function TKMForm.MarginCrossTop: Integer; const CROSS_TOP: array [TKMFormBackgroundType] of Byte = (24, 40, 24); begin Result := CROSS_TOP[fBackground]; end; function TKMForm.MarginCrossRight: Integer; const // Margin from right side, depends on bg graphics CROSS_RIGHT: array [TKMFormBackgroundType] of Byte = (50, 130, 55); begin Result := CROSS_RIGHT[fBackground]; end; function TKMForm.GetCaption: string; begin Result := Label_Caption.Caption; end; procedure TKMForm.Close(Sender: TObject); begin Hide; if Assigned(fOnClose) then fOnClose; end; procedure TKMForm.HandleOtherControlMouseDown(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); begin if Sender = Image_Background then MouseDown(X, Y, Shift, Button); end; procedure TKMForm.HandleOtherControlMouseMove(Sender: TObject; X, Y: Integer; Shift: TShiftState); begin inherited; MouseMove(X, Y, Shift); end; procedure TKMForm.HandleOtherControlMouseUp(Sender: TObject; X,Y: Integer; Shift: TShiftState; Button: TMouseButton); begin MouseUp(X, Y, Shift, Button); end; procedure TKMForm.MouseDown(X, Y: Integer; Shift: TShiftState; Button: TMouseButton); begin inherited; if not DragEnabled then Exit; fDragging := True; fDragStartPos := TKMPoint.New(X,Y); end; procedure TKMForm.MouseMove(X, Y: Integer; Shift: TShiftState); begin inherited; if not DragEnabled or not fDragging then Exit; Left := EnsureRange(Left + X - fDragStartPos.X, 0, fMasterControl.MasterPanel.Width - Width); Top := EnsureRange(Top + Y - fDragStartPos.Y, -Image_Background.Top, fMasterControl.MasterPanel.Height - Height); fDragStartPos := TKMPoint.New(X,Y); end; procedure TKMForm.MouseUp(X, Y: Integer; Shift: TShiftState; Button: TMouseButton); begin inherited; if not DragEnabled then Exit; fDragging := False; end; function TKMForm.KeyUp(Key: Word; Shift: TShiftState): Boolean; begin Result := inherited; if Result then Exit; // Key already handled if not fHandleCloseKey then Exit; if Key = gResKeys[kfCloseMenu] then begin Close(nil); Result := True; end; end; procedure TKMForm.SetHeight(aValue: Integer); begin inherited; UpdateSizes; end; procedure TKMForm.SetWidth(aValue: Integer); begin inherited; UpdateSizes; end; procedure TKMForm.UpdateSizes; begin // Reposition buttons? end; function TKMForm.GetActualWidth: Integer; begin Result := ItemsPanel.Width; end; procedure TKMForm.SetActualWidth(aValue: Integer); var baseW: Integer; begin baseW := aValue + MarginMainLeftRight*2; SetWidth(Min(Parent.Width, baseW)); end; function TKMForm.GetActualHeight: Integer; begin Result := ItemsPanel.Height; end; procedure TKMForm.SetActualHeight(aValue: Integer); var baseH, h: Integer; begin baseH := aValue + MarginMainBottom + MarginMainTop; h := Min(Parent.Height, baseH); SetHeight(h); end; procedure TKMForm.SetHandleCloseKey(aValue: Boolean); begin fHandleCloseKey := aValue; Focusable := aValue; end; procedure TKMForm.SetCapOffsetY(aValue: Integer); begin Label_Caption.Top := Label_Caption.Top + aValue - fCapOffsetY; fCapOffsetY := aValue; end; procedure TKMForm.SetCaption(const aValue: string); begin Label_Caption.Caption := aValue; end; end.