Зарегистрирован: Пт апр 13, 2012 7:59 pm Сообщения: 394
|
Набор универсальных функций и процедур визуальной формы настроек подкаста. Та же тема что и выше, только для работы с компьютера. Это простой велосипед, чтобы не изобретать потом. Для простых настроек. Можно воспользоваться так: 1) Вставляем приведённый код набора функций в скрипт создания подкаст лент своего подкаста в верхнюю часть. 2) Сам код формирования подкаст лент оформляем отдельной процедурой, например procedure CreateMyPodcast();... 3) В главную процедуру скрипта ставим вызов показа формы настроек Код: begin ShowParametersForm(); end. 4) В первой процедуре визуальной формы ParametersFormInit настраиваем и устанавливаем параметры формы: [*]устанавливаем имя процедуры создания подкаст лент, например PARAMS.Values['ProcCreatePodcasts'] := 'CreateMyPodcast'; [*]Вписываем своё имя (Author), дату (Date) и текст приветов (About). [*]Ниже редактируем под свои нужды список параметров Список параметров может отображать визуальные элементы пока трёх классов CheckBox, ComboBox и Edit. Для простых задач этого может хватить. По образу и подобию существующих там параметров задаёте свои. Пояснения некоторых свойств параметров. P.Values['Caption'] - Заголовок P.Values['Hint' ] - всплывающая подсказка Если класс CheckBox: P.Values['Param' ] - сам параметр, который будет устанавливаться или сниматься. Если класс ComboBox: P.Values['caWidth'] - Caption width, ширина заголовка (до элемента ComboBox). P.Values['coWidth'] - ComboBox width, ширина ComboBox P.Values['Param0' ] P.Values['Param1' ] ... P.Values['ParamN ] - список параметров с их заголовком. Сначала идёт заголовок и сам параметр разделяются символом "|" Если класс Edit: P.Values['edWidth']- Edit width, ширина элемента Edit P.Values['Default'] - значение по-умолчанию P.Values['OnlyNum'] - если присвоить значение "Yes", "Y" или "1", то ввод в текстовое поле Edit будет органичен только цифрами P.Values['Param'] - в этом случае параметр может выглядеть как --param=<N> или --param=<S>. Если используется <N>, то значение после знака равно будет добавлено как есть (например цифры), если будет стоять <S>, то значение будет добавлено после знака равно в кавычках, вот так -param="значение параметра". На самом деле пользоваться просто. И куда меньше затрат по времени, чем писать для каждого случая свою форму. Ну и редактировать её под свои нужды никто не запретит. С первого взгляда может показаться чем-то замудрёным, если присмотреться - всё просто. Минимум операций для внедрения кода в свой скрипт. - [+] Набор функций визуальной формы настроек PascalScript
Код: // ============================================================================ // Форма настроек 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; // КОНЕЦ НАБОРА ВИЗУАЛЬНЫХ ФУНКЦИЙ И ПРОЦЕДУР // ============================================================================
Незнаю, понадобиться ли кому-нибудь. Кода может быть и много, но ведь удобно же.
_________________ SONY KDL-32CX520
|
|