sync: restore source from Google Drive
Sync changed files to Google Drive / sync (push) Successful in 1h45m13s
Sync changed files to Google Drive / sync (push) Successful in 1h45m13s
This commit is contained in:
admin_d committed
1 parent
e2d8247e91
commit
7063d1b1c9
993 files changed
+949976
No files matched your search
+350
@@ -0,0 +1,350 @@
|
||||
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.
|
||||
|
||||
Reference in new issue
Block a user