Code: Select all
// ============================================================================
// Форма настроек 21.02.2013 | НАЧАЛО НАБОРА ВИЗУАЛЬНЫХ ФУНКИЙ И ПРОЦЕДУР
// ============================================================================
var
FORMOBJECTS: TStrings; // Глобальная переменная, для доступа из любых функций
// ----------------------------------------------------------------------------
procedure ParametersFormInit();
var
P: TStrings; PARAMS: Variant;
begin
PARAMS := GetFormObject('PARAMS');
// Размеры формы
PARAMS.Values['FormWidth' ] := '700';
PARAMS.Values['FormHeight'] := '515';
// Имя процедуры создания подкаст лент
PARAMS.Values['ProcCreatePodcasts'] := '';
// Значения, отображающиеся на вкладке "О программе"
PARAMS.Values['About' ] := ' |Подкаст|-='+mpTitle+'=-|[ Home Media Server ]|***';
PARAMS.Values['Date' ] := '19.02.2013';
PARAMS.Values['Author'] := 'NickName';
// Список параметров
P := CreateNewParam(PARAMS);
P.Values['Class' ] := 'CheckBox';
P.Values['Caption'] := 'Не показывать прогресс обновления';
P.Values['Hint' ] := 'Отключить показ окна прогресса загрузки и обновлений на компьютере';
P.Values['Param' ] := '--noprogress';
P := CreateNewParam(PARAMS);
P.Values['Class' ] := 'ComboBox';
P.Values['Caption'] := 'Группировка';
P.Values['caWidth'] := '114';
P.Values['Hint' ] := 'Включение особого способа руппировки';
P.Values['coWidth'] := '270';
P.Values['Param0' ] := 'По первым буквам названия ("А", "Б", ...)|--group=alph';
P.Values['Param1' ] := 'По группам букв ("А..Г", "Д..З", ...) |--group=alph2';
P.Values['Param2' ] := 'По годам |--group=year';
P.Values['Param3' ] := 'Отключить группировку |--group=none';
P := CreateNewParam(PARAMS);
P.Values['Class' ] := 'Edit';
P.Values['Caption'] := 'Количество элементов в группе';
P.Values['Hint' ] := 'Максимальное количество элементов в группе при обычной группировке по количнеству';
P.Values['caWidth'] := '270';
P.Values['edWidth'] := '50';
P.Values['Default'] := '100';
P.Values['OnlyNum'] := 'Yes';
P.Values['Param'] := '--maxingroup=<N>';
P := CreateNewParam(PARAMS);
P.Values['Class' ] := 'Edit';
P.Values['Caption'] := 'Макс. кол-во загружаемых страниц';
P.Values['Hint' ] := 'Максимальное количество загружаемых страниц (глубина просмотра). 0 - не ограничивать';
P.Values['caWidth'] := '270';
P.Values['edWidth'] := '50';
P.Values['OnlyNum'] := 'Yes';
P.Values['Default'] := '0';
P.Values['Param'] := '--pages=<N>';
P := CreateNewParam(PARAMS);
P.Values['Class' ] := 'ComboBox';
P.Values['Caption'] := 'Добавить год в название';
P.Values['caWidth'] := '194';
P.Values['Hint' ] := 'Добавление года в название видео, если его нет в названии и он установлен';
P.Values['coWidth'] := '190';
P.Values['Param0' ] := 'Добавлять год |--yearintitle';
P.Values['Param1' ] := 'Отключить добавление|--noyearintitle';
P := CreateNewParam(PARAMS);
P.Values['Class' ] := 'ComboBox';
P.Values['Caption'] := 'Удаление старых ссылок';
P.Values['caWidth'] := '194';
P.Values['Hint' ] := 'Очистка списка уже добавленных ссылок при обновлении';
P.Values['coWidth'] := '190';
P.Values['Param0' ] := 'Не удалять старые ссылки |--nodelitems';
P.Values['Param1' ] := 'Включить удаление ссылок |--delitems';
end;
// ----------------------------------------------------------------------------
procedure ShowParametersForm();
var
i, iFormWidth, iFormHeight: Integer; T: TStrings; s: String;
Control, frmMain, PodcastTree, PageCntrl, Page, Panel, PARAMS: Variant;
begin
frmMain := TForm.Create(Application);
FORMOBJECTS := TStringList.Create();
FORMOBJECTS.AddObject('frmMain', frmMain);
FORMOBJECTS.AddObject('Timer', TTimer.Create(frmMain));
FORMOBJECTS.AddObject('PARAMS', TStringList.Create() );
FORMOBJECTS.Values['IdStoreParams'] := IntToStr(mpiComment);
ParametersFormInit();
PARAMS := GetFormObject('PARAMS');
iFormWidth := StrToIntDef(PARAMS.Values['FormWidth' ], 700);
iFormHeight := StrToIntDef(PARAMS.Values['FormHeight'], 515);
try
frmMain.Color := $F0F0F0;
frmMain.Width := iFormWidth;
frmMain.Height := iFormHeight;
frmMain.Caption := 'Параметры подкаста '+mpTitle;
frmMain.Position := poScreenCenter;
frmMain.Font.Size := 10;
frmMain.OnResize := 'evntFormOnResize';
frmMain.OnCanResize := 'evntFormOnCanResize';
CreateControl(frmMain, frmMain, TButton, 'btnOK', 'OK', '', mrOK);
CreateControl(frmMain, frmMain, TButton, 'btnCancel', 'Отмена', '', mrCancel);
PageCntrl := CreateControl(frmMain, frmMain, TPageControl, 'PageCntrl');
PageCntrl.SetBounds(0, 0, iFormWidth, iFormHeight - 40);
// Страница "Параметры"
Page := CreateControl(PageCntrl, PageCntrl, TTabSheet, 'Page1', 'Параметры');
Page.SetBounds(0, 0, iFormWidth, iFormHeight);
Page.PageControl := PageCntrl;
Page.Visible := true;
Page.Tag := 12;
Page.OnEnter := 'evntPageOnEnter';
AddCaptionToPage(frmMain, Page, 'Установка параметров');
PodcastTree := CreateControl(frmMain, Page, TTreeView, 'PdcstTree');
PodcastTree.HideSelection := false;
PodcastTree.RowSelect := true;
PodcastTree.ReadOnly := true;
PodcastTree.OnClick := 'evntTreeOnClick';
PodcastTree.Align := alLeft;
PodcastTree.Width := 248;
PodcastTree.Hint := 'Структура подкаста. (Помните: вложенные папки наследуют параметры!)';
PodcastTree.ShowHint := true;
BuildPodcastTree(PodcastTree.Items, FolderItem, nil);
Control := CreateControl(frmMain, Page, TSplitter, 'splitter');
Control.SetBounds(50, 10, 4, iFormHeight-44);
Control.Align := alLeft;
Control := CreateControl(frmMain, Page, TScrollBox, 'prmPanel');
Control.Align := alClient;
ShowParameters();
// Страница "Сервис"
Page := CreateControl(PageCntrl, PageCntrl, TTabSheet, 'Page2', 'Сервис');
Page.SetBounds(0, 0, iFormWidth, iFormHeight);
Page.Visible := true;
Page.PageControl := PageCntrl;
Page.Tag := 12;
Page.OnEnter := 'evntPageOnEnter';
AddCaptionToPage(frmMain, Page, 'Сервисные функции');
if PARAMS.Values['ProcCreatePodcasts']<>'' then begin
Panel := CreateControl(frmMain, Page, TGroupBox, 'G1', 'Инициализация:');
Panel.Color := $F0F0F0;
Panel.SetBounds(10, 50, 300, 140);
Panel.Align := alLeft;
AddText2Panel(frmMain, Panel, 'Пересоздание структуры подкаста.', 0, 11, false, 'Tahoma');
AddText2Panel(frmMain, Panel, 'Внимание! Все добавленные ссылки будут удалены и настройки установлены по-умолчанию.', $333390, 9, true);
AddText2Panel(frmMain, Panel, 'Структура и список категорий будут созданы заного, как они есть на сайте ресурса.', 0, 9);
AddText2Panel(frmMain, Panel, '', 0, 4);
Control := CreateControl(frmMain, Panel, TButton, 'BC1', 'Создать структуру');
Control.Align := alTop;
Control.OnClick := PARAMS.Values['ProcCreatePodcasts'];
end;
// Страница "О подкасте"
Page := CreateControl(PageCntrl, PageCntrl, TTabSheet, 'Page3', 'О подкасте');
Page.SetBounds(0, 0, iFormWidth, iFormHeight);
Page.Visible := true;
Page.PageControl := PageCntrl;
Page.Tag := 33;
Page.OnEnter := 'evntPageOnEnter';
T := TStringList.Create();
s := PARAMS.Values['About'];
for i:=1 to WordCount(s, '|') do begin
Control := AddText2Panel(frmMain, Page, ExtractWord(i, s, '|'), $866649, 24, false, 'Impact', false);
end;
AddText2Panel(frmMain, Page, '________________________', $247FFF, 14, true);
AddText2Panel(frmMain, Page, PARAMS.Values['Date' ], $B8997C, 16, false, 'Impact');
AddText2Panel(frmMain, Page, PARAMS.Values['Author'], $FB8936, 20, true, 'Tahoma');
PageCntrl.ActivePage := PageCntrl.Pages[1];
PageCntrl.ActivePage := PageCntrl.Pages[0];
frmMain.ActiveControl := PodcastTree;
if (PodcastTree.Items.Count>1) then PodcastTree.Selected := PodcastTree.Items[1];
PodcastTree.Selected := PodcastTree.Items[0];
evntTreeOnClick(PodcastTree);
if (frmMain.ShowModal() = mrOK) then begin
StoreParamsToPodcast(PodcastTree, PodcastTree.Items[0]);
end;
finally
FORMOBJECTS.Free();
PodcastTree.Free();
frmMain.Free();
end;
end;
// ----------------------------------------------------------------------------
procedure AddText2Panel(frmMain, Panel: Variant; sText: String;
nColor, nFontSize: Integer=nil; bBold: Boolean=false; sFont: String=''; bWrap: Boolean=true);
var
aLabel: Variant;
begin
aLabel := CreateControl(frmMain, Panel, TLabel);
aLabel.Transparent := true;
aLabel.WordWrap := bWrap;
aLabel.Caption := sText;
aLabel.Width := Panel.Width;
aLabel.Alignment := 2;
if (bBold) then aLabel.Font.Style := fsBold;
if (nColor<>nil) then aLabel.Font.Color := nColor;
if (nFontSize<>nil) then aLabel.Font.Size := nFontSize;
if (sFont<>'') then aLabel.Font.Name := sFont;
aLabel.Align := alTop;
end;
// ----------------------------------------------------------------------------
procedure StoreParamsToPodcast(PodcastTree: TTreeView; Node: TTreeNode);
var
NodeData, PodcastItem: Variant; sParams: String; i, n, iIdStoreParams: Integer;
begin
iIdStoreParams := StrToIntDef(FORMOBJECTS.Values['IdStoreParams'], mpiComment);
for i:=0 to PodcastTree.Items.Count-1 do begin
NodeData := PodcastTree.Items[i].Data;
sParams := Trim(NodeData.Values['Params']);
n := NodeData.IndexOf('Item'); if (n<0) then continue;
PodcastItem := NodeData.Objects[n];
PodcastItem[iIdStoreParams] := sParams;
end;
end;
// ----------------------------------------------------------------------------
procedure evntFormOnResize(frm: Variant);
var
iW, iH: Integer; Control: Variant;
begin
iW := frm.ClientWidth;
iH := frm.ClientHeight;
BoundControl('PageCntrl', 0, 0, iW, iH - 44);
BoundControl('btnOK', iW - 85, iH - 35, 75, 25);
BoundControl('btnCancel', iW - 170, iH - 35, 75, 25);
Control := GetFormObject('LineAbout');
if (Control<>nil) then Control.Left := Round(iW/2 - Control.Width/2)-4;
end;
// ----------------------------------------------------------------------------
procedure AddCaptionToPage(frmMain, Page: Variant; sCapt: String='';
Color: Integer = $866649; nHeight: Integer=36; nSize: Integer=18);
var
TopPanel, aLabel, Line, aClrs1, aClrs2: Variant; iClr: Integer;
begin
// Не мог определиться с палитрой...
aClrs1 := [$866649, $555555, $FB8936, $247FFF, $2A7CCA, $666666];
aClrs2 := [$B8997C, $808077, $247FFF, $FB8936, $AA8926, $6C60EC];
frmMain.Tag := 3; // Номер набора цвета заголовков страниц
if frmMain.Tag=0 then frmMain.Tag := Round(Random()*(Length(aClrs1)-1))+1;
TopPanel := CreateControl(frmMain, Page, TPanel);
TopPanel.Color := $F0F0F0;
TopPanel.Height := nHeight;
TopPanel.Align := alTop;
Line := CreateControl(frmMain, TopPanel, TShape, Page.Name+'Line', sCapt);
Line.Brush.Color := aClrs2[frmMain.Tag-1];
Line.Pen.Style := psClear;
Line.SetBounds(10, 24, 0, 3);
aLabel := CreateControl(frmMain, TopPanel, TLabel, Page.Name+'Capt', sCapt);
aLabel.Font.Size := nSize;
aLabel.Font.Style := fsBold;
aLabel.Font.Color := aClrs1[frmMain.Tag-1];
aLabel.Font.Name := 'Trebuchet MS';
aLabel.Transparent:= true;
aLabel.AutoSize := true;
aLabel.Left := 10;
aLabel.Top := -84;
end;
// ----------------------------------------------------------------------------
procedure evntPageOnEnter(Page: Variant);
var
aLabel, Line, Timer: Variant;
begin
Timer := GetFormObject('Timer');
if (Page.Tag=33) then begin
Timer.Interval:= 33;
Timer.OnTimer := 'evntAboutFXOnTimer';
Timer.Enabled := true;
end;
if (Page.Tag=12) then begin
aLabel := GetFormObject(Page.Name+'Capt'); if (aLabel = nil) then Exit;
if (aLabel.Top >0) then Exit;
aLabel.Top := -84;
Line := GetFormObject(Page.Name+'Line'); if (Line = nil) then Exit;
Line.Width := 0;
Timer.Interval:= 20;
Timer.Tag := StrToInt(Copy(Page.Name, 5, 2));
Timer.OnTimer := 'evntPageCaptFXOnTimer';
Timer.Enabled := true;
end;
end;
// ----------------------------------------------------------------------------
function CreateNewParam(var PARAMS: TStrings; sText, sParam: String=''): TStrings;
var
NEWPARAM: TStrings;
begin
NEWPARAM := TStringList.Create();
if (sText <> '') then NEWPARAM.Values['Text' ] := sText;
if (sParam <> '') then NEWPARAM.Values['Param'] := sParam;
PARAMS.AddObject(IntToStr(PARAMS.Count), NEWPARAM);
Result := NEWPARAM;
end;
// ----------------------------------------------------------------------------
function CreateControl(aForm: TWinControl; aParent: TWinControl; CLASS: Variant;
CntrlName, sCaption, sHint: String=''; nModalResult: Integer=nil): Variant;
var
Control: Variant;
begin
Control := CLASS.Create(aForm);
Control.Parent := aParent;
if (sCaption <> '') then Control.Caption := sCaption;
if (nModalResult <>nil) then Control.ModalResult := nModalResult;
if (CntrlName <> '') then begin
Control.Name := CntrlName;
FORMOBJECTS.AddObject(CntrlName, Control);
end;
if (sHint <> '') then begin
Control.Hint := sHint;
Control.ShowHint := true;
end;
Result := Control;
end;
// ----------------------------------------------------------------------------
function GetFormObject(CntrlName: String): Variant;
var
i: Integer;
begin
i := FORMOBJECTS.IndexOf(CntrlName);
if (i<0) then Result := nil
else Result := FORMOBJECTS.Objects[i];
end;
// ----------------------------------------------------------------------------
procedure BuildPodcastTree(TreeItems: TTreeNodes; ParentItem: THmsScriptMediaItem; Root: TTreeNode; nLevel: Integer=0; bF: Boolean=false);
var
i, iIdStoreParams: Integer; Item, NodeData: Variant;
begin
iIdStoreParams := StrToIntDef(FORMOBJECTS.Values['IdStoreParams'], mpiComment);
// Фильтруем: только папки лент подкастов и подкасты
if not bF then
if ((ParentItem.ItemClassID<>51)AND(ParentItem.ItemClassID<>53)) then Exit;
NodeData := TStringList.Create();
NodeData.Values['Params'] := ParentItem[iIdStoreParams];
NodeData.AddObject('Item', ParentItem);
Item := TreeItems.AddChild(Root, GetTreeNodeName(NodeData));
Item.Data := NodeData;
if (ParentItem.HasChildItems AND (nLevel<3)) then begin
for i:=0 to ParentItem.ChildCount-1 do begin
BuildPodcastTree(TreeItems, ParentItem.ChildItems[i], Item, nLevel+1, bF);
end;
end;
end;
// ----------------------------------------------------------------------------
procedure UpdateParameters(ParamsData: String='');
var
i, n: Integer; nMaxLen: Integer=0;
P, Control, Control2, PARAMS: Variant; sParam, sValue, sPId: String;
begin
PARAMS := GetFormObject('PARAMS');
for i:=0 to PARAMS.Count-1 do begin
P := PARAMS.Objects[i]; if P = nil then continue; sPId := IntToStr(i);
if (P.Values['Class'] = 'CheckBox') then begin
Control := GetFormObject('PCheckBox'+sPId); if Control =nil then Exit;
sParam := P.Values['Param'];
Control.OnClick := nil;
Control.Checked := (Pos(sParam, ParamsData)>0);
Control.OnClick := 'evntParamChanged';
if Control.Checked then Control.Font.Style := 1 else Control.Font.Style := 0;
end else if (P.Values['Class'] = 'ComboBox') then begin
nMaxLen := 0;
Control := GetFormObject('PCheckBox'+sPId); if Control =nil then Exit;
Control.OnClick := nil;
Control.Checked := false;
Control2 := GetFormObject('PComboBox'+sPId); if Control2=nil then Exit;
Control2.OnClick := nil;
Control2.ItemIndex := 0;
sValue := Trim(P.Values['Param0']);
n:=0; while (sValue<>'') do begin
HmsRegExMatch('\|(.*?)$', sValue, sValue);
if ((Pos(sValue, ParamsData)>0) AND (Length(sValue)>nMaxLen)) then begin
Control2.ItemIndex := n;
Control.Checked := true;
nMaxLen:=Length(sValue);
end;
n := n + 1; sValue := Trim(P.Values['Param'+IntToStr(n)]);
end;;
Control2.Enabled := Control.Checked;
Control.OnClick := 'evntParamChanged';
Control2.OnClick := 'evntParamChanged';
if Control.Checked then Control.Font.Style := 1 else Control.Font.Style := 0;
end else if (P.Values['Class'] = 'Edit') then begin
Control := GetFormObject('PCheckBox'+sPId); if Control =nil then Exit;
Control2 := GetFormObject('PEdit'+sPId); if Control2=nil then Exit;
if ((Control=nil) OR (Control2=nil)) then Exit;
Control.OnClick := nil;
Control2.OnExit := nil;
Control.Checked := false;
sParam := P.Values['Param'];
sParam := ReplaceStr(sParam, '<N>', '(\d+)' );
sParam := ReplaceStr(sParam, '<S>', '"(.*?)"');
sValue := P.Values['Default'];
Control.Checked := HmsRegExMatch(sParam, ParamsData, sValue);
Control2.Text := sValue;
Control2.Enabled := Control.Checked;
Control.OnClick := 'evntParamChanged';
Control2.OnExit := 'evntParamChanged';
if Control.Checked then Control.Font.Style := 1 else Control.Font.Style := 0;
end else if (P.Values['Class'] = 'RadioButton') then begin
end;
end;
end;
// ----------------------------------------------------------------------------
function GetTreeNodeName(NodeData: TStrings): String;
var
sParamsData, PodcastItem: Variant; i: Integer;
begin
Result := '';
i := NodeData.IndexOf('Item'); if (i<0) then Exit;
PodcastItem := NodeData.Objects[i];
sParamsData := Trim(NodeData.Values['Params']);
Result := PodcastItem[mpiTitle];
if (Pos('--', sParamsData)>0) then begin
Result := '('+IntToStr(WordCount(ReplaceStr(sParamsData, '--', '\n'), '\n'))+') '+PodcastItem[mpiTitle];
end;
end;
// ----------------------------------------------------------------------------
function IsSetP(P: Variant; sName: String): Boolean;
begin
Result := (UpperCase(LeftCopy(P.Values[sName], 1))='Y');
end;
// ----------------------------------------------------------------------------
procedure ShowParameters();
var
P, Line, Control, ParamZone, frmMain, prmPanel, PARAMS: Variant;
nLeft: Integer=10; nTop: Integer=10; nHeight: Integer=36;
nWidth, i, n, naLabelWidth, nCntrlWidth: Integer; sValue, sParam: String;
begin
PARAMS := GetFormObject('PARAMS'); if (PARAMS =nil) then Exit;
frmMain := GetFormObject('frmMain' ); if (frmMain =nil) then Exit;
prmPanel := GetFormObject('prmPanel'); if (prmPanel=nil) then Exit;
nWidth := prmPanel.Width - (nLeft*2) - 16;
for i:=0 to PARAMS.Count-1 do begin
P := PARAMS.Objects[i]; if P = nil then continue;
if (P.Values['Class'] = 'CheckBox') then begin
Control := CreateControl(frmMain, prmPanel, TCheckBox, 'PCheckBox'+IntToStr(i), P.Values['Caption'], P.Values['Hint']);
Control.SetBounds(nLeft, nTop+3, nWidth, 16);
Control.Tag := i;
Control.OnClick := 'evntParamChanged';
end else if (P.Values['Class'] = 'ComboBox') then begin
naLabelWidth := StrToIntDef(P.Values['caWidth'], 80);
nCntrlWidth := StrToIntDef(P.Values['coWidth'], 160);
Control := CreateControl(frmMain, prmPanel, TCheckBox, 'PCheckBox'+IntToStr(i), P.Values['Caption']+':', P.Values['Hint']);
Control.SetBounds(nLeft, nTop+3, naLabelWidth, 18);
Control.Tag := i;
Control.OnClick := 'evntParamChanged';
Control := CreateControl(frmMain, prmPanel, TComboBox, 'PComboBox'+IntToStr(i), P.Values['Caption'], P.Values['Hint']);
Control.SetBounds(nLeft+naLabelWidth+4, nTop, nCntrlWidth, 16);
Control.Enabled := false;
Control.Style := csDropDownList;
Control.Tag := i;
sValue := P.Values['Param0'];
n:=0; while (sValue<>'') do begin
HmsRegExMatch2('^(.*?)\|(.*?)$', sValue, sValue, sParam);
Control.Items.Add(sValue);
n := n + 1;
sValue := P.Values['Param'+IntToStr(n)];
end;
Control.ItemIndex := 0;
Control.OnClick := 'evntParamChanged';
end else if (P.Values['Class'] = 'Edit') then begin
naLabelWidth := StrToIntDef(P.Values['caWidth'], 80);
nCntrlWidth := StrToIntDef(P.Values['coWidth'], 50);
Control := CreateControl(frmMain, prmPanel, TCheckBox, 'PCheckBox'+IntToStr(i), P.Values['Caption']+':', P.Values['Hint']);
Control.SetBounds(nLeft, nTop+3, naLabelWidth, 18);
Control.Tag := i;
Control.OnClick := 'evntParamChanged';
Control := CreateControl(frmMain, prmPanel, TEdit, 'PEdit'+IntToStr(i), P.Values['Caption'], P.Values['Hint']);
Control.SetBounds(nLeft+naLabelWidth+4, nTop, nCntrlWidth, 16);
Control.Enabled := false;
Control.Text := P.Values['Default'];
Control.Tag := i;
Control.OnExit := 'evntParamChanged';
if (IsSetP(P, 'OnlyNum')) then Control.OnKeyDown := 'evntOnKeyDownOnlyNum';
end else if (P.Values['Class'] = 'RadioButton') then begin
sValue := P.Values['Param0'];
n:=0; while (sValue<>'') do begin
HmsRegExMatch2('^(.*?)\|(.*?)$', sValue, sValue, sParam);
Control := CreateControl(frmMain, prmPanel, TRadioButton, 'PRB'+IntToStr(i), sValue, P.Values['Hint']);
n:=n+1; sValue := P.Values['Param'+IntToStr(n)];
Control.SetBounds(nLeft, nTop, nWidth, 16);
Control.Tag := i;
Control.OnClick := 'evntParamChanged';
nTop := nTop + 20;
end;;
end;
Control := TGroupBox.Create(frmMain);
Control.Parent := prmPanel;
Control.SetBounds(nLeft, nTop+nHeight-8, nWidth, 3);
nTop := nTop + nHeight;
end;
end;
// ----------------------------------------------------------------------------
procedure BoundControl(CntrlName: String; nLeft, nTop, nWidth, nHeight: Integer);
var
obj: Variant;
begin
obj := GetFormObject(CntrlName);
if obj<>nil then obj.SetBounds(nLeft, nTop, nWidth, nHeight);
end;
// ----------------------------------------------------------------------------
procedure evntOnKeyDownOnlyNum(obj: Variant; nKey: Integer; ShiftState: TShiftState);
begin
obj.ReadOnly := ((nKey > 30) AND not HmsRegExMatch('[\d]', Chr(nKey), ''));
end;
// ----------------------------------------------------------------------------
function SortStr4Length(S: TStrings): TStrings;
var
i, j: Integer; x: String;
begin
for i:=1 to S.Count-1 do begin
if Length(S[i]) < Length(S[i-1]) then begin
x := S[i]; j := i;
repeat begin S[j] := S[j-1]; j:=j-1; end; until not ((j>1) AND (Length(x)<=Length(S[j-1])));
S[j] := x;
end;
end;
Result := S;
end;
// ----------------------------------------------------------------------------
procedure SetUnsetParameter(sValue: String; AvaliableParams: TStrings);
var
sParam, sParams, s: String; i: Integer; Node: Variant;
begin
i := FORMOBJECTS.IndexOf('CurrentNode'); if (i<0) then Exit;
Node := FORMOBJECTS.Objects[i]; if (Node = nil) then Exit;
sParams := Node.Data.Values['Params'];
AvaliableParams.Text := ReplaceStr(AvaliableParams.Text, '<N>', '\d+' );
AvaliableParams.Text := ReplaceStr(AvaliableParams.Text, '<S>', '".*?"');
AvaliableParams := SortStr4Length(AvaliableParams);
i:=AvaliableParams.Count; while i>0 do begin
i := i - 1;
sParam := AvaliableParams[i]; if sParam='' then continue;
if (HmsRegExMatch('('+sParam+')', sParams, s)) then begin
sParams := ReplaceStr(sParams, ' '+s, '');
sParams := ReplaceStr(sParams, s, '');
end;
end;
sParams := Trim(sParams)+' '+sValue;
Node.Data.Values['Params'] := Trim(sParams);
Node.Text := GetTreeNodeName(Node.Data);
end;
// ----------------------------------------------------------------------------
procedure evntParamChanged(obj: Variant);
var
P, Control, Control2, PARAMS: Variant; AvalParams: TStrings;
sParam, sValue, sPId: String; n: Integer;
begin
PARAMS := GetFormObject('PARAMS');
sParam :=''; sPId:=IntToStr(obj.Tag);
AvalParams := TStringList.Create();
P := PARAMS.Objects[obj.Tag];
if (P.Values['Class'] = 'CheckBox') then begin
Control := GetFormObject('PCheckBox'+sPId);
AvalParams.Add(P.Values['Param']);
if Control.Checked then begin
sParam := P.Values['Param'];
Control.Font.Style := 1;
end else begin
Control.Font.Style := 0;
end;
end else if (P.Values['Class'] = 'ComboBox') then begin
Control := GetFormObject('PCheckBox'+sPId);
if Control.Checked then Control.Font.Style := 1 else Control.Font.Style := 0;
Control2 := GetFormObject('PComboBox'+sPId);
if ((Control=nil) OR (Control2=nil)) then Exit;
Control2.Enabled := Control.Checked;
sValue := Trim(P.Values['Param0']);
n:=0; while (sValue<>'') do begin
HmsRegExMatch('\|(.*?)$', sValue, sValue);
AvalParams.Add(sValue);
if (Control2.ItemIndex = n) then sParam := sValue;
n:=n+1; sValue := Trim(P.Values['Param'+IntToStr(n)]);
end;;
if not Control.Checked then sParam := '';
end else if (P.Values['Class'] = 'Edit') then begin
Control := GetFormObject('PCheckBox'+sPId);
if Control.Checked then Control.Font.Style := 1 else Control.Font.Style := 0;
Control2 := GetFormObject('PEdit'+sPId);
if ((Control=nil) OR (Control2=nil)) then Exit;
Control2.Enabled := Control.Checked;
AvalParams.Add(P.Values['Param']);
if Control.Checked then begin
sParam := P.Values['Param'];
sParam := ReplaceStr(sParam, '<N>', Trim(Control2.Text));
sParam := ReplaceStr(sParam, '<S>', '"'+Trim(Control2.Text)+'"');
end;
end else if (P.Values['Class'] = 'RadioButton') then begin
end;
SetUnsetParameter(sParam, AvalParams);
end;
// ----------------------------------------------------------------------------
procedure evntTreeOnClick(obj: Variant);
var
Node: Variant; i: Integer;
begin
Node := obj.Selected; if (Node = nil) then Exit;
i := FORMOBJECTS.IndexOf('CurrentNode');
if (i<0) then FORMOBJECTS.AddObject('CurrentNode', Node)
else FORMOBJECTS.Objects[i] := Node;
if (Node.Data <> nil) then UpdateParameters(Node.Data.Values['Params']);
end;
// ----------------------------------------------------------------------------
procedure evntFormOnCanResize(frm: Variant; nNewWidth, nNewHeight: Integer; bResize: Boolean);
var
nMinWidth, nMinHeight: Integer;
begin
nMinWidth := 344; nMinHeight := 280;
if (nNewWidth < nMinWidth ) then nNewWidth := nMinWidth;
if (nNewHeight < nMinHeight) then nNewHeight := nMinHeight;
end;
// ----------------------------------------------------------------------------
procedure evntPageCaptFXOnTimer(obj: Variant);
var
nSpeed, nTop: Integer; nLeftTo: Integer=10; nTopTo: Integer=0;
aLabel, Line: Variant;
begin
aLabel := GetFormObject('Page'+IntToStr(obj.Tag)+'Capt'); if aLabel=nil then Exit;
aLabel.Top := aLabel.Top + Round((nTopTo - aLabel.Top) / 4) + 1;
if aLabel.Top>=nTopTo then aLabel.Top := nTopTo;
Line := GetFormObject('Page'+IntToStr(obj.Tag)+'Line'); if Line=nil then Exit;
Line.Width := Line.Width + Round((aLabel.Width - Line.Width) / 4) + 1;
if Line.Width>=aLabel.Width then Line.Width := aLabel.Width;
if ((aLabel.Top=nTopTo) AND (Line.Width=aLabel.Width)) then obj.Enabled := false;
end;
// КОНЕЦ НАБОРА ВИЗУАЛЬНЫХ ФУНКЦИЙ И ПРОЦЕДУР
// ============================================================================