Адрес этой странички : http://spcalc.narod.ru/spcalc_intscr_examples.htm
spCalc.exe
Простой программируемый калькулятор.  

Примеры скриптов.

"Строки".

Инверсия строки :

function InversionString(Sx : string) : string; {Инвертирует строку} Var i : integer; begin Result:=Sx; if Length(Sx)>0 then begin Result:=''; for i:=Length(Sx) downto 1 do begin Result:=Result+Sx[i]; end; end; end;

Удаление НЕсимволов из строки слева :

function LTrimUnChar(UnChar , Sx : string) : string; {Удаляет НЕсимволы слева} //UnChar - строка разделителей(не символов). Аналог множества //Sx - входная строка Var YesExit : byte; begin Result:=Sx; if (length(Sx)>0) and (length(UnChar)>0) then begin YesExit:=0; while YesExit<=0 do begin if POS(Result[1],UnChar)>0 then begin Delete(Result,1,1); end else begin YesExit:=2; end; if length(Result)<=0 then YesExit:=1; end; end; end;

Удаление НЕсимволов из строки справа :

function RTrimUnChar(UnChar , Sx : string) : string; {Удаляет НЕсимволы справа} //UnChar - строка разделителей(не символов). Аналог множества //Sx - входная строка begin Result:=InversionString(Sx); Result:=LTrimUnChar(UnChar,Result); Result:=InversionString(Result); end;

Удаление НЕсимволов из строки слева и справа :

function AllTrimUnChar(UnChar , Sx : string) : string; {Удаляет НЕсимволы слева и справа} //UnChar - строка разделителей(не символов). Аналог множества //Sx - входная строка begin Result:=LTrimUnChar(UnChar,Sx); Result:=RTrimUnChar(UnChar,Result); end;

Получить количество слов в строке :

function GetCountWordInString(UnChar , Sx : string) : integer; //Определяет кол-во слов в строке //UnChar - строка разделителей(не символов). Аналог множества //Sx - входная строка var InWord : byte; i : integer; begin Result:=0; InWord := 0; i:=0; while i<length(Sx) do begin i:=i+1; if POS(Sx[i],UnChar)<=0 then begin if InWord<=0 then Result:=Result+1; //переход на начало слова InWord:=1; //Мы внутри слова end else begin InWord:=0; //Мы снаружи слова end; end; end;

Выделить слово из строки по номеру :

function GetWordFromString(UnChar , Sx : string; NumWord : integer) : string; //Получить слово из строки по номеру //UnChar - строка разделителей(не символов). Аналог множества //Sx - входная строка //NumWord - номер слова var InWord : byte; NumWordCur, i : integer; begin Result:=''; if NumWord>0 then begin InWord := 0; NumWordCur:=0; i:=0; while i<length(Sx) do begin i:=i+1; if POS(Sx[i],UnChar)<=0 then begin if InWord<=0 then NumWordCur:=NumWordCur+1; //переход на начало слова InWord:=1; //Мы внутри слова if NumWordCur=NumWord then begin //Это - наше слово Result:=Result+Sx[i]; //и мы его выдираем из строки end; end else begin InWord:=0; //Мы снаружи слова if NumWordCur=NumWord then begin //Это было - наше слово i:=length(Sx)+1; //поэтому, выходим из цикла и функции end; end; end; end; end;

Дополнить строку символами :

function String_Append(S : String; CodeChar : byte; CountChar : integer; Nr : integer) : string; {Дополняет строку S символами (ascii=CodeChar) до CountChar} {Nr<=0 - слева, >0 - справа} Var i,m : integer; begin Result:=S; m:=Length(S); if CountChar>m then begin for i:=1 to (CountChar-m) do begin if Nr>0 then Result := Result + Chr(CodeChar); if Nr<=0 then Result := Chr(CodeChar) + Result; end; end; end;

Выравнивание текста в строке:

function String_Align(S : String; CodeChar : byte; CountChar:integer; Nr:integer) : string; {Выравнивание текста в строке S (Nr<0 - влево, =0 - по центру, >0 - вправо)} {если длина строки S меньше CountChar : строка S "наращивается"} {если длина строки S больше CountChar : игнорируется } {Результирующая строка заполняется символами (ascii=CodeChar)} Var cc,c1,c2, i,m : integer; begin Result:=S; if Nr<0 then Result:=String_Append(Result,CodeChar,CountChar,1); if Nr>0 then Result:=String_Append(Result,CodeChar,CountChar,0); if Nr=0 then begin m:=Length(Result); if m<CountChar then begin cc:=CountChar-m; c1:=trunc(cc/2); c2:=cc-c1; Result:=String_Append(Result,CodeChar,m+c1,0); {Left} Result:=String_Append(Result,CodeChar,CountChar,1); {Right} end; end; end;

Сравнение двух строк:

function Compare2String(Nr : integer; YesPartEQ,YesUpCase : Boolean; S1,S2 : String) : Boolean; //Сравнение строк //S1,S2 - сравниваемые строки //Nr - режим : // <=0 - вхождение S1 в S2 // >0 - совпадение S1 и S2 //YesUpCase=TRUE - не учитывать регистр символов //YesPartEQ=TRUE - частичное сравнение строк (только для Nr>0) // При этом - S2 усекается до длины S1 //Возвращаемое значение: TRUE - строки равны. Иначе - нет begin Result:=FALSE; S1:=Trim(S1); S2:=Trim(S2); if (Length(S1)>0) and (Length(S2)>0) then begin if YesUpCase then begin S1:=Uppercase(S1); S2:=Uppercase(S2); end; if Nr<=0 then begin if POS(S1,S2)>0 then Result:=TRUE; end else begin if YesPartEQ then begin Delete(S2,Length(S1)+1,4096); end; if S1=S2 then Result:=TRUE; end; end; end;

"Математика".

Реализация алгоритма вычисления : 10 в степени N  (N - целое число) :function Power10_ext(N : Integer) : extended; {Y=10^N -> N=[-4951..+4932] -> автонормализация N} Var i : integer; begin Result:=1; if (N<(-4951)) then N:=(-4951); if (N>4932) then N:=4932; if N<>0 then begin if N>0 then begin for i:=1 to N do begin Result:=Result*10; end; end else begin for i:=1 to trunc(ABS(N)) do begin Result:=Result/10; end; end; end; end;

Реализация алгоритма вычисления : X в степени N  для целых чисел :function XpowerN_int(X, N :integer ): cardinal; //X в степени N для целых чисел var i : integer; begin Result:=1; for i:=1 to N do begin Result:=Result*X; end; end;

Перевод целого 10-чного числа (v10) в систему счисления с основанием BaseAnother :function Convert_Int10_to_Another(v10 : integer; BaseAnother : integer) : string; //Перевод целого 10-чного числа (v10) в систему счисления //с основанием (BaseAnother) //Функция возвращает представление числа //в заданной системе счисления Var vFrac : integer; //остаток по модулю (основание) vFracStr : string;//строковое представления остатка begin Result:=''; if (BaseAnother>1) and (BaseAnother<=36) then begin repeat vFrac:=v10 MOD BaseAnother; //v10 – (v10 div BaseAnother)*BaseAnother v10:=v10 DIV BaseAnother; //trunc(v10/BaseAnother) if vFrac>9 then begin //Это буква латинского алфавита vFracStr:=CHR(ORD('A')-10+vFrac) end else begin //переводим остаток в строковое представление vFracStr:=IntToStr(vFrac); end; Result:=Result+vFracStr; until v10=0; //Инвертируем результат Result:=InversionString(Result); end; end;

Перевод целого числа (vAnother) из системы счисления BaseAnother в десятичную систему счисления :
function Convert_IntAnother_to_10(vAnother : string; BaseAnother : integer) : integer; //Перевод целого числа (vAnother) из системы счисления BaseAnother //в десятичную систему счисления //Функция возвращает представление числа //в десятичной системе счисления var i : integer; Res, ValNum : integer; begin Result:=0; if (BaseAnother>1) and (BaseAnother<=36) then begin vAnother:=Trim(vAnother); if length(vAnother)>0 then begin vAnother:=UpperCase(vAnother); for i:=1 to length(vAnother) do begin //Конвертируем текущий символ в число if POS(vAnother[i],'0123456789')>0 then begin ValNum:=StrToInt(vAnother[i]); end else begin //если это не число - считаем, //что буква латинского алфавита //и вычисляем по позиции ValNum:=10+ORD(vAnother[i])-ORD('A'); end; //Вычисляем соответствующую степень и суммируем Result:=Result+XpowerN_int(BaseAnother,length(vAnother)-i)*ValNum; end; end; end; end;

Вычисление коэффициентов регрессии линейной функции :
function Regres_Lin(List : TStrings;sSep : string;Var A,B : real) : Boolean; //Регресс-анализ {Вычисление коэфф.A,B по Регресс-Функции : Y=A*X+B} //A, B - коэффицинты регрессии //Пары значений X и Y хранятся в списке List //Разделители значений - символы в строке sSep //Если sSep - пустая строка, то по умолчанию: // | // пробел // ; // = // #9 Var S0 : string; Sx : string; X,Y, S1,S2,S3,S4,Z : extended; N,i : integer; begin Result:=FALSE; A:=0; B:=0; if List<>NIL then begin if List.Count>2 then begin if length(sSep)<=0 then sSep:='| ;='+#9; S1:=0; S2:=0; S3:=0; S4:=0; N:=0; i:=-1; while i<(List.Count-1) do begin i:=i+1; S0 := Trim(List[i]); if length(S0)>0 then begin if S0[1]<>'*' then begin Sx:=GetWordFromString(sSep,S0,1); X:=StrToFloat(Sx); Sx:=GetWordFromString(sSep,S0,2); Y:=StrToFloat(Sx); N:=N+1; s1:=s1+X; s2:=s2+Y; s3:=s3+X*Y; s4:=s4+X*X; end; end; end; if N>2 then begin Z:=N*s4-s1*s1; if Z<>0 then begin Result:=TRUE; A:=(N*s3-s1*s2)/z; B:=(s2*s4-s3*s1)/z; end; end; end; end; end;

Линейная интерполяция :
function Interpol_Lin(X1,Y1,X2,Y2,Xx : real) : real; //Линейная интерполяция между двумя точками begin Result:=Y1; if ABS(X2-X1)>0.000001 then begin Result:=Y1+(Y2-Y1)*(Xx-X1)/(X2-X1); end; end;

Сравнение двух чисел с заданной точностью :
function Compare2ext(X1,X2,E : extended) : integer; {Сравнение двух чисел с заданной точностью} //E - заданная точность {Возвращает:} { 0 - если X1=X2} { 1 - если X1>X2} { -1 - если X1<X2} Var dX : extended; begin Result:=-1; //X1<X2 E:=ABS(E); dX:=X1-X2; if ABS(dX)<=E then begin {X1=X2} Result:=0; end else begin if X1>X2 then begin {X1>X2} Result:=1; end; end; end;

Получить номер квадранта (декартова система координат), для точки с коорд. X,Y :
function Get_NumKvadrant(X,Y : real) : integer; //Получить номер квадранта (декартова система координат), //для точки с коорд. X,Y begin Result:=0; if X>=0 then begin if Y>=0 then begin Result:=1; end else begin Result:=2; end; end else begin if Y>=0 then begin Result:=4; end else begin Result:=3; end; end; end;

вычислить значение арктангенса (градусы: 0-360) : function Get_ArcTan_grad(X,Y : real) : real; //вычислить значение арктангенса (градусы: 0-360) Var N : integer; begin Result:=0; N:=Get_NumKvadrant(X,Y); //ShowMessage('N='+IntToStr(N)); if N>0 then begin if ABS(X)>0.0001 then begin Result:=ABS(ArcTan(ABS(Y)/ABS(X))); end else begin if ABS(Y)>0.0001 then begin Result:=PI/2; end else begin end; end; Result:=Result/(2*PI)*360; //ShowMessage('Угол='+saRealToStrA(Result,6)); //if N=1 then Result:=Result; // + + if N=2 then Result:=360-Result; //+ - if N=3 then Result:=180+Result; // - - if N=4 then Result:=180-Result; // - + //ShowMessage('Угол полн='+saRealToStrA(Result,6)); end; end;

"Прочие".

Визуализация, редактирование и выбор в списке TStrings :

//Визуализация, редактирование и выбор в списке TStrings //Файл: Dlg_ListView.pas //Вызывать функцию : // function ListView_01(sCaption,sHead : string; List : TStrings; YesEdit : boolean) : integer; //Пример : // Nr:=ListView_01('Выберите строку из списка','Список чего-то', List, FALSE); //============================================ //About : Этот текст сгенерирован компонентом TSP_fs_FormDesign (Delphi-5) //Version : 1.04 (04.03.2005) for FastScript-1.4 (Freeware) //Comment : Форма для импорта табличной информации из Excel //Date : 26.01.2007 12:54:22 //Prefix : ListView_ //Suffics : _01 //Примечание : // Запускаемая функция модуля (модально) : ListView_FormMain_Execute_01 // Функция тестирования корректности инфы на форме : ListView_TestInfo_01 // Функция обработки входных параметров : ListView_TreatmentInputParam_01 // Для тестирования - убрать комментарий между BEGIN и END. (в конце исходника) //............................................ Const ListView_IdThisForm_01 = 'ThisForm_Is_Unknown'; //Идентификатор формы (произвольно) //............................................ //Список переменных Var ListView_ParamsIN_01 : TStrings; //Входные параметры ListView_ParamsOUT_01 : TStrings; //Выходные параметры ListView_NrRes_01 : integer; //Возвращаемое значение, если ShowModal ListView_FormMain_01 : TForm; //Создаваемая форма ListView_Panel1_01 : TPanel; ListView_OKBtn_01 : TButton; ListView_CancelBtn_01 : TButton; ListView_GroupBox_Head_01 : TGroupBox; ListView_ListBox1_01 : TListBox; ListView_SB_Line_Add_01 : TSpeedButton; ListView_YesEdit_01 : boolean; ListView_NumLineSel_01 : integer; //Номер выбранной строки в списке (Возвращаемый параметр) //............................................ //............................................ function ListView_TreatmentInputParam_01 : boolean; //Обрабатываем входные параметры begin Result := TRUE; if ListView_ParamsIN_01 <> NIL then begin //Result:=FALSE; //TRUE выставим только, если все входные параметры Ok ListView_ListBox1_01.Items.Assign(ListView_ParamsIN_01); end; end; //ListView_TreatmentInputParam_01 //............................................ //............................................ function ListView_TestInfo_01 : boolean; //Функция проверки информации на этой форме (запускается по нажатию кнопки Ok) //Если TRUE, то все OK //Если FALSE, то инфа на форме некорректная begin Result := TRUE; end; //ListView_TestInfo_01 //............................................ //************************************* //Обработчики событий для элементов управления на форме //...................................... //SB_Line_Add procedure ListView_SB_Line_Add_01_Click(Sender: TSpeedButton); //Event : OnClick Var Sx : string; begin Sx:='?'; if InputQuery('Новая строка'+IntToStr(ListView_ListBox1_01.ItemIndex),'Введите',Sx) then begin ListView_ListBox1_01.Items.Add(Sx); ListView_ListBox1_01.ItemIndex:=ListView_ListBox1_01.Items.Count-1; end; end; procedure ListView_SB_Line_Add_01_MouseMove(Sender: TSpeedButton); //Event : OnMouseMove begin end; //...................................... //...................................... //ListBox1 procedure ListView_ListBox1_01_Click(Sender: TListBox); //Event : OnClick begin end; procedure ListView_ListBox1_01_DblClick(Sender: TListBox); //Event : OnDblClick Var Nr : integer; Sx : string; begin if ListView_YesEdit_01 then begin if ListView_ListBox1_01.ItemIndex>=0 then begin //ShowMessage(ListView_ListBox1_01.Items[ListView_ListBox1_01.ItemIndex]); Nr:=MessageDlg('Yes-редактировать, No-удалить, Cancel-выход',mtConfirmation,mbYesNoCancel); if Nr=mrYes then begin Sx:=ListView_ListBox1_01.Items[ListView_ListBox1_01.ItemIndex]; if InputQuery('Строка N '+IntToStr(ListView_ListBox1_01.ItemIndex),'Отредактируйте',Sx) then begin ListView_ListBox1_01.Items[ListView_ListBox1_01.ItemIndex]:=Sx; end; end; if Nr=mrNo then begin ListView_ListBox1_01.Items.Delete(ListView_ListBox1_01.ItemIndex); end; end; end; end; procedure ListView_ListBox1_01_MouseMove(Sender: TListBox); //Event : OnMouseMove begin end; procedure ListView_ListBox1_01_Enter(Sender: TListBox); //Event : OnEnter begin end; procedure ListView_ListBox1_01_Exit(Sender: TListBox); //Event : OnExit begin end; //...................................... //************************************* //======================== procedure ListView_Free_FormMain_01; //Освобождаем ресурсы ... begin TRY if ListView_FormMain_01<>NIL then begin ListView_FormMain_01.Free; ListView_FormMain_01:=NIL; end; FINALLY if ListView_ParamsIN_01 <> NIL then begin ListView_ParamsIN_01.Clear; ListView_ParamsIN_01.Free; ListView_ParamsIN_01:=NIL end; if ListView_ParamsOUT_01 <> NIL then begin ListView_ParamsOUT_01.Clear; ListView_ParamsOUT_01.Free; ListView_ParamsOUT_01:=NIL end; END; end; //ListView_Free_FormMain_01 //======================== //======================== function ListView_Create_FormMain_01 : TForm; //Создаем форму и соотв. компоненты на ней ... Var Yes : boolean; //Признак, что форма и компоненты корректно "создались" begin Yes := FALSE; //По умолчанию укажем, что FigVam Result := TForm.Create(nil); //Создаем форму TRY //------------------------ //Свойства формы Result.Caption := 'Список'; Result.Left := 626; Result.Top := 185; Result.Width := 271; Result.Height := 304; Result.FormStyle := fsNormal; Result.Position := poScreenCenter; Result.BorderStyle := bsSizeable; Result.BorderWidth := 0; Result.WindowState := wsNormal; Result.Color := clBtnFace; Result.Font.Name := 'MS Sans Serif'; Result.Font.Size := 8; Result.Font.Color := clWindowText; Result.Font.CharSet := 1; //------------------------ //Создание и инициализация компонентов формы //...................................... //ListView_Panel1_01 ListView_Panel1_01 := TPanel.Create(Result); ListView_Panel1_01.Parent := Result; ListView_Panel1_01.Left := 0; ListView_Panel1_01.Top := 250; ListView_Panel1_01.Width := 263; ListView_Panel1_01.Height := 27; ListView_Panel1_01.Visible := TRUE; ListView_Panel1_01.Tag := 0; ListView_Panel1_01.Enabled := TRUE; ListView_Panel1_01.Hint := ''; ListView_Panel1_01.ShowHint := FALSE; ListView_Panel1_01.Caption := ''; ListView_Panel1_01.Align := alBottom; ListView_Panel1_01.Color := clBtnFace; ListView_Panel1_01.Font.Name := 'MS Sans Serif'; ListView_Panel1_01.Font.Size := 8; ListView_Panel1_01.Font.Color := clWindowText; ListView_Panel1_01.Font.CharSet := 1; ListView_Panel1_01.BevelWidth := 1; ListView_Panel1_01.BorderWidth := 0; ListView_Panel1_01.BevelInner := bvLowered; ListView_Panel1_01.BevelOuter := bvRaised; ListView_Panel1_01.TabOrder := 0; ListView_Panel1_01.TabStop := FALSE; ListView_Panel1_01.AutoSize := FALSE; //...................................... //...................................... //ListView_SB_Line_Add_01 ListView_SB_Line_Add_01 := TSpeedButton.Create(Result); ListView_SB_Line_Add_01.Parent := ListView_Panel1_01; ListView_SB_Line_Add_01.Left := 136; ListView_SB_Line_Add_01.Top := 2; ListView_SB_Line_Add_01.Width := 25; ListView_SB_Line_Add_01.Height := 22; ListView_SB_Line_Add_01.Visible := TRUE; ListView_SB_Line_Add_01.Tag := 0; ListView_SB_Line_Add_01.Caption := '+'; ListView_SB_Line_Add_01.Hint := 'Добавить строку ...'; ListView_SB_Line_Add_01.ShowHint := TRUE; ListView_SB_Line_Add_01.Font.Name := 'MS Sans Serif'; ListView_SB_Line_Add_01.Font.Size := 8; ListView_SB_Line_Add_01.Font.Color := clWindowText; ListView_SB_Line_Add_01.Font.CharSet := 1; ListView_SB_Line_Add_01.GroupIndex := 0; ListView_SB_Line_Add_01.Margin := -1; ListView_SB_Line_Add_01.NumGlyphs := 1; ListView_SB_Line_Add_01.Spacing := 4; ListView_SB_Line_Add_01.Transparent := TRUE; ListView_SB_Line_Add_01.AllowAllUp := FALSE; ListView_SB_Line_Add_01.OnClick := @ListView_SB_Line_Add_01_Click; ListView_SB_Line_Add_01.OnMouseMove := @ListView_SB_Line_Add_01_MouseMove; //...................................... //...................................... //ListView_OKBtn_01 ListView_OKBtn_01 := TButton.Create(Result); ListView_OKBtn_01.Parent := ListView_Panel1_01; ListView_OKBtn_01.Left := 7; ListView_OKBtn_01.Top := 1; ListView_OKBtn_01.Width := 42; ListView_OKBtn_01.Height := 25; ListView_OKBtn_01.Visible := TRUE; ListView_OKBtn_01.Tag := 0; ListView_OKBtn_01.Enabled := TRUE; ListView_OKBtn_01.Hint := ''; ListView_OKBtn_01.ShowHint := FALSE; ListView_OKBtn_01.Caption := 'OK'; ListView_OKBtn_01.Font.Name := 'MS Sans Serif'; ListView_OKBtn_01.Font.Size := 8; ListView_OKBtn_01.Font.Color := clWindowText; ListView_OKBtn_01.Font.CharSet := 1; ListView_OKBtn_01.TabOrder := 0; ListView_OKBtn_01.TabStop := TRUE; ListView_OKBtn_01.Cancel := FALSE; ListView_OKBtn_01.ModalResult := 1; //...................................... //...................................... //ListView_CancelBtn_01 ListView_CancelBtn_01 := TButton.Create(Result); ListView_CancelBtn_01.Parent := ListView_Panel1_01; ListView_CancelBtn_01.Left := 63; ListView_CancelBtn_01.Top := 1; ListView_CancelBtn_01.Width := 50; ListView_CancelBtn_01.Height := 25; ListView_CancelBtn_01.Visible := TRUE; ListView_CancelBtn_01.Tag := 0; ListView_CancelBtn_01.Enabled := TRUE; ListView_CancelBtn_01.Hint := ''; ListView_CancelBtn_01.ShowHint := FALSE; ListView_CancelBtn_01.Caption := 'Cancel'; ListView_CancelBtn_01.Font.Name := 'MS Sans Serif'; ListView_CancelBtn_01.Font.Size := 8; ListView_CancelBtn_01.Font.Color := clWindowText; ListView_CancelBtn_01.Font.CharSet := 1; ListView_CancelBtn_01.TabOrder := 1; ListView_CancelBtn_01.TabStop := TRUE; ListView_CancelBtn_01.Cancel := TRUE; ListView_CancelBtn_01.ModalResult := 2; //...................................... //...................................... //ListView_GroupBox_Head_01 ListView_GroupBox_Head_01 := TGroupBox.Create(Result); ListView_GroupBox_Head_01.Parent := Result; ListView_GroupBox_Head_01.Left := 0; ListView_GroupBox_Head_01.Top := 0; ListView_GroupBox_Head_01.Width := 263; ListView_GroupBox_Head_01.Height := 250; ListView_GroupBox_Head_01.Visible := TRUE; ListView_GroupBox_Head_01.Tag := 0; ListView_GroupBox_Head_01.Enabled := TRUE; ListView_GroupBox_Head_01.Hint := ''; ListView_GroupBox_Head_01.ShowHint := FALSE; ListView_GroupBox_Head_01.Caption := '...'; ListView_GroupBox_Head_01.Align := alClient; ListView_GroupBox_Head_01.Color := clBtnFace; ListView_GroupBox_Head_01.Font.Name := 'MS Sans Serif'; ListView_GroupBox_Head_01.Font.Size := 8; ListView_GroupBox_Head_01.Font.Color := clWindowText; ListView_GroupBox_Head_01.Font.CharSet := 1; ListView_GroupBox_Head_01.TabOrder := 1; ListView_GroupBox_Head_01.TabStop := FALSE; //...................................... //...................................... //ListView_ListBox1_01 ListView_ListBox1_01 := TListBox.Create(Result); ListView_ListBox1_01.Parent := ListView_GroupBox_Head_01; ListView_ListBox1_01.Left := 2; ListView_ListBox1_01.Top := 15; ListView_ListBox1_01.Width := 259; ListView_ListBox1_01.Height := 233; ListView_ListBox1_01.Visible := TRUE; ListView_ListBox1_01.Tag := 0; ListView_ListBox1_01.Enabled := TRUE; ListView_ListBox1_01.Hint := 'Двойной щелчок мышкой - редактировать список'; ListView_ListBox1_01.ShowHint := TRUE; ListView_ListBox1_01.Font.Name := 'MS Sans Serif'; ListView_ListBox1_01.Font.Size := 8; ListView_ListBox1_01.Font.Color := clWindowText; ListView_ListBox1_01.Color := clWhite; ListView_ListBox1_01.TabOrder := 0; ListView_ListBox1_01.TabStop := TRUE; ListView_ListBox1_01.Align := alClient; ListView_ListBox1_01.Columns := 0; ListView_ListBox1_01.ExtendedSelect := TRUE; ListView_ListBox1_01.MultiSelect := FALSE; ListView_ListBox1_01.Sorted := FALSE; ListView_ListBox1_01.ItemHeight := 13; ListView_ListBox1_01.TabWidth := 0; ListView_ListBox1_01.OnClick := @ListView_ListBox1_01_Click; ListView_ListBox1_01.OnDblClick := @ListView_ListBox1_01_DblClick; ListView_ListBox1_01.OnMouseMove := @ListView_ListBox1_01_MouseMove; ListView_ListBox1_01.OnEnter := @ListView_ListBox1_01_Enter; ListView_ListBox1_01.OnExit := @ListView_ListBox1_01_Exit; //...................................... Yes := TRUE; //Все Ok. "Доползли" до конца FINALLY if not Yes then begin //Были проблемы при создании и инициализации формы или компонентов //Освобождаем ресурсы, если неудачно ... if Result<>NIL then begin //Форма Result.Free; Result:=NIL; end; if ListView_ParamsIN_01 <> NIL then begin //Входные параметры ListView_ParamsIN_01.Clear; ListView_ParamsIN_01.Free; ListView_ParamsIN_01:=NIL end; if ListView_ParamsOUT_01 <> NIL then begin //Выходные параметры ListView_ParamsOUT_01.Clear; ListView_ParamsOUT_01.Free; ListView_ParamsOUT_01:=NIL end; end; END; end; //ListView_Create_FormMain_01 //======================== //======================== function ListView_FormMain_Execute_01(sCaption,sHead : string; InParam, OutParam : TStrings; YesEdit : boolean) : boolean; //Главная функция модуля. Создаем, выполняем и уничтожаем форму //Входные параметры получаем через список InParam (может быть NIL) //Выходные параметры передаем через список OutParam (может быть NIL) begin Result := FALSE; ListView_NumLineSel_01 := -1; ListView_YesEdit_01 := YesEdit; ListView_NrRes_01 := -1; ListView_ParamsIN_01 := NIL; ListView_ParamsOUT_01 := NIL; if InParam<>NIL then begin //Получаем входные параметры ListView_ParamsIN_01 := TStringList.Create; ListView_ParamsIN_01.Assign(InParam); end; if OutParam<>NIL then begin OutParam.Clear; ListView_ParamsOUT_01 := TStringList.Create; end; TRY ListView_FormMain_01:=ListView_Create_FormMain_01; //Создаем форму if ListView_TreatmentInputParam_01 then begin //Обрабатываем входные параметры if length(sCaption)>0 then ListView_FormMain_01.Caption:=sCaption; if length(sHead)>0 then ListView_GroupBox_Head_01.Caption:=sHead; if not ListView_YesEdit_01 then begin ListView_SB_Line_Add_01.Visible := FALSE; ListView_ListBox1_01.ShowHint := FALSE; end; ListView_NrRes_01:=ListView_FormMain_01.ShowModal; //"Запускаем" форму ... if ListView_NrRes_01 = mrOk then begin //Выход по кнопке Ok if ListView_TestInfo_01 then begin //Проверка корректности инфы на форме Result := TRUE; InParam.Assign(ListView_ListBox1_01.Items); ListView_NumLineSel_01:=ListView_ListBox1_01.ItemIndex; if ListView_ParamsOUT_01 <> NIL then begin //Формируем выходные параметры ListView_ParamsOUT_01.ADD('Date='+DateToStr(NOW)); ListView_ParamsOUT_01.ADD('Time='+TimeToStr(NOW)); ListView_ParamsOUT_01.ADD('About='+ListView_IdThisForm_01); ListView_ParamsOUT_01.ADD('Result=OK'); ListView_ParamsOUT_01.ADD('Error=0'); //Далее (точно также), нужно передать всю необходимую выходную инфу end; end else begin RaiseException('Некорректная информация на этой форме !'); end; end; if OutParam<>NIL then begin if ListView_ParamsOUT_01<>NIL then begin //Возвращаем выходные параметры OutParam.Assign(ListView_ParamsOUT_01); end; end; end else begin ShowMessage('Некорректные входные параметры'); end; FINALLY ListView_Free_FormMain_01; //Освобождаем ресурсы END; end; //ListView_FormMain_Execute_01 //======================== function ListView_01(sCaption,sHead : string; List : TStrings; YesEdit : boolean) : integer; //Главная функция begin Result:=-1; ListView_NumLineSel_01:=-1; if List<>NIL then begin sCaption:=Trim(sCaption); sHead:=Trim(sHead); if ListView_FormMain_Execute_01(sCaption,sHead,List,NIL,YesEdit) then begin //Создать и открыть форму модально if ListView_NrRes_01 = mrOk then begin //Ok Result:=ListView_NumLineSel_01; end; if ListView_NrRes_01 = mrCancel then begin //Cancel end; end; end; end; //================== //-------------------------------- //Для тестирования формы ! Var List : TStrings; //-------------------------------- BEGIN //Для тестирования формы ! List:=TStringList.Create; TRY List.add('111'); List.add('222'); List.add('333'); List.add('444'); List.add('555'); List.add('ааа'); List.add('ббб'); List.add('ввв'); ShowMessage(IntToStr(ListView_01('Заголовок диалога','Заголовок списка', List,TRUE))); ListView_01('Рез.','Рез.', List,FALSE); FINALLY if List<>NIL then begin List.Clear; List.Free; List:=NIL; end; END; END.

Получить список дисков

#language PascalScript //Получить список дисков Var Sx : string; List : TStrings; N : integer; BEGIN List:=TStringList.Create; TRY //-------------------------------------------------------------- //Получить список всех логических дисков, которые имеют корневой каталог N := GetListDrives('', true, List, false); List_View('Список логических дисков и их типов',List); //-------------------------------------------------------------- //-------------------------------------------------------------- //Получить список приводов CD ROM (DVD ROM) N := GetListDrives(IntToStr(DRIVE_CDROM), false, List, false); List_View('Список приводов CD ROM (DVD ROM)',List); //-------------------------------------------------------------- //-------------------------------------------------------------- //Получить список приводов CD ROM (DVD ROM) и сетевых дисков N := GetListDrives(IntToStr(DRIVE_CDROM)+','+IntToStr(DRIVE_REMOTE), true, List, false); List_View('Список приводов CD ROM (DVD ROM) и сетевых дисков',List); //-------------------------------------------------------------- FINALLY List_Clear(List); //Освободить ресурсы, занимаемые объектом List END; END.

Пример использования TQuery

#language PascalScript //Пример использования TQuery Var Q : TQuery; i : integer; BEGIN Q := TQuery.Create(nil); try Q.DatabaseName := 'DBDEMOS'; Q.SQL.ADD('SELECT '); Q.SQL.ADD('*'); Q.SQL.ADD('FROM '); Q.SQL.ADD('animals'); Q.Open; ShowMessage('Кол-во строк в таблице='+IntToStr(DB_RecordCount(Q))); for i:=0 to (Q.FieldCount-1) do begin //Имена полей открытого набора данных ShowMessage(IntToStr(i)+' '+Q.Fields[i].FieldName); end; finally Query_Clear(Q); end; END.

© Sergey Popov, Usinsk, Komi, 2007