-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathuFrmTextureProperties.pas
More file actions
151 lines (116 loc) · 4.4 KB
/
uFrmTextureProperties.pas
File metadata and controls
151 lines (116 loc) · 4.4 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
unit uFrmTextureProperties;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, ES.BaseControls, ES.Layouts, Vcl.StdCtrls, uEditorLoader,
Engine.UnCamera, Vcl.ExtCtrls;
type
TfrmTextureProperties = class(TForm)
ScrollBox1: TScrollBox;
btnClear: TButton;
TextureVP: TEsPanel;
cmbZoom: TComboBox;
Label1: TLabel;
btnClose: TButton;
pnlTexProps: TEsPanel;
EsPanel2: TEsPanel;
Splitter1: TSplitter;
// New procedures
procedure SetTexture(const aName: string);
procedure IntegrateWindowToPanel(ChildWindow: HWND; ParentPanel: HWND);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnClearClick(Sender: TObject);
procedure cmbZoomChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure Splitter1Moved(Sender: TObject);
private
{ Private declarations }
public
var PropertiesWndtHandle: HWND;
{ Public declarations }
end;
var
frmTextureProperties: TfrmTextureProperties;
implementation
{$R *.dfm}
procedure TfrmTextureProperties.SetTexture(const aName: string);
var
S: string;
iPos: Integer;
Zoom: Double;
begin
Caption := AName;
S := ServerGetProp('Texture', 'SIZE TEXTURE=' + AnsiQuotedStr(Caption, '"'));
Zoom := StrToInt(cmbZoom.Items[cmbZoom.ItemIndex]) / 100;
iPos := Pos(',', S);
var TexHeight := StrToInt(Copy(S, iPos + 1, Length(S)));
var TexWidth := StrToInt(Copy(S, 1, iPos - 1));
if iPos > 0 then
begin
TextureVP.Visible := False;
TextureVP.Height := Round(TexHeight * Zoom);
TextureVP.Width := Round(TexWidth * Zoom);
ServerCmd('CAMERA OPEN ' +
' TEXTURE=' + AnsiQuotedStr(Caption, '"') +
' NAME=TexPropCam_' + IntToStr(TextureVP.Handle) +' X=0 Y=0' +
' XR=' + IntToStr(TextureVP.Width) +
' YR=' + IntToStr(TextureVP.Height) +
' REN=' + Trim(IntToStr(REN_TEXVIEW)) +
' FLAGS=' + Trim(IntToStr(SHOW_ChildWindow + SHOW_NOBUTTONS + SHOW_REALTIME)) +
' HWND=' + Trim(IntToStr(TextureVP.Handle)));
TextureVP.Visible := True;
Show();
end
else
Close();
end;
procedure TfrmTextureProperties.Splitter1Moved(Sender: TObject);
begin
if PropertiesWndtHandle = 0 then Exit();
var Rect: TRect;
Winapi.Windows.GetClientRect(pnlTexProps.Handle, Rect);
// Óñòàíàâëèâàåì ðàçìåðû äî÷åðíåãî îêíà ïîä ðàçìåðû ïàíåëè
SetWindowPos(PropertiesWndtHandle, HWND_TOP, Rect.Left, Rect.Top, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top, SWP_NOZORDER or SWP_NOACTIVATE);
end;
procedure TfrmTextureProperties.IntegrateWindowToPanel(ChildWindow: HWND; ParentPanel: HWND);
var
Style: LongInt;
begin
Style := GetWindowLong(ChildWindow, GWL_STYLE);
Style := Style and not (WS_CAPTION or WS_THICKFRAME or WS_BORDER); // Óáèðàåì ðàìêè
Style := Style or WS_CHILD;
SetWindowLong(ChildWindow, GWL_STYLE, Style);
// Óñòàíàâëèâàåì ðîäèòåëåì äëÿ íàéäåííîãî îêíà ïàíåëü
Winapi.Windows.SetParent(ChildWindow, ParentPanel);
var Rect: TRect;
Winapi.Windows.GetClientRect(ParentPanel, Rect);
// Óñòàíàâëèâàåì ðàçìåðû äî÷åðíåãî îêíà ïîä ðàçìåðû ïàíåëè
SetWindowPos(ChildWindow, HWND_TOP, Rect.Left, Rect.Top, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top, SWP_NOZORDER or SWP_NOACTIVATE);
// Óáåäèìñÿ, ÷òî îêíî áóäåò ïðàâèëüíî îòîáðàæàòüñÿ
ShowWindow(ChildWindow, SW_SHOW);
end;
procedure TfrmTextureProperties.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if PropertiesWndtHandle <> 0 then
SendMessage(PropertiesWndtHandle, WM_CLOSE, 0, 0);
ServerCmd('CAMERA CLOSE NAME=TexPropCam_' + IntToStr(TextureVP.Handle));
Action := caFree;
end;
procedure TfrmTextureProperties.FormCreate(Sender: TObject);
begin
cmbZoom.ItemIndex := 2; // 100
end;
procedure TfrmTextureProperties.btnClearClick(Sender: TObject);
begin
ServerCmd('TEXTURE CLEAR NAME=' + AnsiQuotedStr(Caption, '"'));
end;
procedure TfrmTextureProperties.btnCloseClick(Sender: TObject);
begin
Close();
end;
procedure TfrmTextureProperties.cmbZoomChange(Sender: TObject);
begin
SetTexture(Caption);
end;
end.