/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Delphi

Выпуск № 1136
от 27.05.2008, 02:05

Вопрос № 135.961

Здравствуйте уважаемые эксперты Подскажите пожайлуста как можно сделать следующее: У меня есть переменная типа String, ей присваивается значение например 'Hello World' , мне необходимо изменить шрифт этого значения, в 'Arial', или любой другой. можно ли это сделать... Спасибо

Отправлен: 08.05.2008, 16:11 Вопрос задал: Alexandrk (статус: 1-ый класс) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Лукьяненко Алексей Валериевич Здравствуйте, Alexandrk! Изменить шрифт значения - это как Вы себе представляете? Можно изменить шрифт у компоеннта, который будет выводить данное значение, а у переменной "строка" параметра "шрифт" нет. Если Вы имеете в виду изменение шрифта компонента, то это так: Label1.Font.Name := 'Arial'; Label1.Caption := S;

Ответ отправил: Лукьяненко Алексей Валериевич (статус: Студент) Ответ отправлен: 08.05.2008, 16:17

Отвечает: Павел Шведенко Здравствуйте, Alexandrk! String - тип данных простой, только для обьектов TLabel или TEditBox можно указать шрифт Кроме самого текста как он выглядит на экране не хранится инфо. Вот Приложение: TLabel.Font.XXX = 'Arial' TLabel.Caption = String --------- Всегда

Ответ отправил: Павел Шведенко (статус: 2-ой класс) Ответ отправлен: 08.05.2008, 16:29

Вопрос № 136.038

Здраствуйте дорогие эксперты меня очень интересует работа с USB прочитав несколько ваших ответов и просмотрев коды програм я так и не увидел как отключать не только флешки а любые другие USB девайсы. Я нашел исходник на асме но так как мои знания недостаточны для его полного понимания прошу вас перевести его в делфу поскольку очнь надо и я так смотрю не тока мне... Извените за нагласть исходник прилогаю ниже и ссылку откуда я его взял. Ссылка: http://wasm.ru/article.php?article=usb_eject Исходник: Приложение: .486 .model flat, stdcall option casemap :none ; case sensitive include base.inc .data hWnd dd 0 aColum1 db '#',0 aColum2 db 'Name',0 aColum3 db 'Removeable',0 aColum4 db 'Problem',0 aColum5 db 'Device ID',0 aRemoveable db 'REMOVEABLE',0 fFiltering dd 1 GUID_REMOVEABLE dd 53F5630Dh dw 0B6BFh dw 11D0h db 94h, 0F2h, 0, 0A0h, 0C9h, 1Eh, 0FBh, 8Bh dnDevInst dd 0 DevLen dd 0 aBuffer db 200 dup (0) aDeviceId db 200 dup (0) Status dd 0 ProblemNum dd 0 aTempStr db 200 dup (0) lvc LV_COLUMN <> lvi LV_ITEM <> CM_LOCATE_DEVNODE_NORMAL equ 0 CM_DRP_DEVICEDESC equ 01h CM_DRP_FRIENDLYNAME equ 0Dh DN_REMOVABLE equ 4000h CR_NO_SUCH_DEVNODE equ 0dh CR_SUCCESS equ 0 .code start: invoke GetModuleHandle, NULL mov hInstance, eax invoke DialogBoxParam, hInstance, 101, 0, ADDR DlgProc, 0 invoke ExitProcess, eax invoke InitCommonControls ; ----------------------------------------------------------------------- AddItemDev proc invoke dwtoa,lvi.iItem,addr aTempStr lea eax, aTempStr mov lvi.pszText, eax mov lvi.iSubItem, 0 invoke SendDlgItemMessage,hWnd,1005,LVM_INSERTITEM, 1, addr lvi lea eax, aBuffer mov lvi.pszText, eax mov lvi.iSubItem, 1 invoke SendDlgItemMessage,hWnd,1005,LVM_SETITEMTEXT, lvi.iItem, addr lvi .if (Status & DN_REMOVABLE) invoke lstrcpy,addr aTempStr,addr aRemoveable .else mov aTempStr[0],0 .endif lea eax, aTempStr mov lvi.pszText, eax mov lvi.iSubItem, 2 invoke SendDlgItemMessage,hWnd,1005,LVM_SETITEMTEXT, lvi.iItem, addr lvi invoke dwtoa,ProblemNum,addr aTempStr lea eax, aTempStr mov lvi.pszText, eax mov lvi.iSubItem, 3 invoke SendDlgItemMessage,hWnd,1005,LVM_SETITEMTEXT, lvi.iItem, addr lvi lea eax, aDeviceId mov lvi.pszText, eax mov lvi.iSubItem, 4 invoke SendDlgItemMessage,hWnd,1005,LVM_SETITEMTEXT, lvi.iItem, addr lvi add lvi.iItem,1 Ret AddItemDev EndP ; ----------------------------------------------------------------------- EnumDevice proc dDevInst:DWORD LOCAL NewDevInst:DWORD LOCAL len :DWORD invoke CM_Get_DevNode_Status,addr Status,addr ProblemNum,dDevInst,0 invoke CM_Get_Device_ID_Size,addr DevLen,dDevInst,0 inc DevLen invoke CM_Get_Device_ID,dDevInst,addr aDeviceId,DevLen,0 mov len,sizeof aBuffer invoke CM_Get_DevNode_Registry_Property,dDevInst,CM_DRP_FRIENDLYNAME,0,addr aBuffer, addr len,0 .if eax!=CR_SUCCESS invoke CM_Get_DevNode_Registry_Property,dDevInst,CM_DRP_DEVICEDESC,0,addr aBuffer, addr len,0 .endif .if eax!=CR_SUCCESS mov aBuffer[0],0 .endif .if fFiltering==1 .if (Status & DN_REMOVABLE) invoke AddItemDev .endif .else invoke AddItemDev .endif invoke CM_Get_Child,addr NewDevInst,dDevInst,0 .if eax == CR_SUCCESS invoke EnumDevice,NewDevInst .endif invoke CM_Get_Sibling,addr NewDevInst,dDevInst,0 .if eax == CR_SUCCESS invoke EnumDevice,NewDevInst .endif Ret EnumDevice EndP ; ----------------------------------------------------------------------- DlgProc proc hWin :DWORD,uMsg :DWORD,wParam :DWORD,lParam :DWORD ; ----------------------------------------------------------------------- .if uMsg == WM_INITDIALOG mov eax,hWin mov hWnd,eax invoke SendDlgItemMessage,hWin,1005, LVM_SETEXTENDEDLISTVIEWSTYLE, 0, LVS_EX_FULLROWSELECT or LVS_EX_FLATSB; or LVS_EX_CHECKBOXES ;Создаем шапку mov lvc.imask, LVCF_TEXT or LVCF_WIDTH; or LVCF_FMT mov lvc.pszText, offset aColum1 mov lvc.lx, 50 invoke SendDlgItemMessage,hWin,1005,LVM_INSERTCOLUMN,1, addr lvc mov lvc.pszText, offset aColum2 mov lvc.lx, 275 invoke SendDlgItemMessage,hWin,1005,LVM_INSERTCOLUMN,2, addr lvc mov lvc.pszText, offset aColum3 mov lvc.lx, 80 invoke SendDlgItemMessage,hWin,1005,LVM_INSERTCOLUMN,3, addr lvc mov lvc.pszText, offset aColum4 mov lvc.lx, 50 invoke SendDlgItemMessage,hWin,1005,LVM_INSERTCOLUMN,4, addr lvc mov lvc.pszText, offset aColum5 mov lvc.lx, 250 invoke SendDlgItemMessage,hWin,1005,LVM_INSERTCOLUMN,4, addr lvc ;Устанавливаем CheckBox invoke SendDlgItemMessage,hWin,1006,BM_SETCHECK,BST_CHECKED,0 ;Заполняем список mov lvi.iItem, 0 mov lvi.imask, LVIF_TEXT ;or LVIF_PARAM; or LVIF_STATE invoke CM_Locate_DevNode,addr dnDevInst,CM_LOCATE_DEVNODE_NORMAL,0 invoke EnumDevice,dnDevInst ; ----------------------------------------------------------------------- .elseif uMsg == WM_NOTIFY mov ebx, lParam .if [ebx.NMHDR].code == NM_CLICK invoke SendDlgItemMessage,hWnd,1005,LVM_GETNEXTITEM,-1,LVNI_FOCUSED mov lvi.iItem, eax mov lvi.iSubItem, 1 mov lvi.imask, LVIF_TEXT lea eax, aBuffer mov lvi.pszText, eax mov lvi.cchTextMax, 200 invoke SendDlgItemMessage,hWnd,1005,LVM_GETITEM, 0, addr lvi invoke SendDlgItemMessage,hWnd,1001,WM_SETTEXT,0,addr aBuffer invoke SendDlgItemMessage,hWnd,1005,LVM_GETNEXTITEM,-1,LVNI_FOCUSED mov lvi.iItem, eax mov lvi.iSubItem, 4 mov lvi.imask, LVIF_TEXT lea eax, aBuffer mov lvi.pszText, eax mov lvi.cchTextMax, 200 invoke SendDlgItemMessage,hWnd,1005,LVM_GETITEM, 0, addr lvi invoke SendDlgItemMessage,hWnd,1002,WM_SETTEXT,0,addr aBuffer .endif ; ----------------------------------------------------------------------- .elseif uMsg == WM_COMMAND .if wParam == IDC_OK invoke SendDlgItemMessage,hWnd,1002,WM_GETTEXTLENGTH,0,0 inc eax mov edx,eax invoke SendDlgItemMessage,hWnd,1002,WM_GETTEXT,edx,addr aBuffer invoke CM_Locate_DevNode,addr dnDevInst, addr aBuffer, CM_LOCATE_DEVNODE_NORMAL invoke CM_Request_Device_Eject,dnDevInst, NULL, NULL, NULL, NULL .elseif wParam == IDC_IDCANCEL invoke EndDialog,hWin,0 .elseif wParam == IDC_REFRESH invoke SendDlgItemMessage,hWnd,IDC_CHECKBOX1006,BM_GETCHECK,0,0 .if eax==BST_CHECKED mov fFiltering,1 .else mov fFiltering,0 .endif invoke SendDlgItemMessage,hWnd,1005,LVM_DELETEALLITEMS,0,0 mov lvi.iItem, 0 mov lvi.imask, LVIF_TEXT invoke CM_Locate_DevNode,addr dnDevInst,NULL,CM_LOCATE_DEVNODE_NORMAL invoke EnumDevice,dnDevInst .endif .elseif uMsg == WM_CLOSE invoke EndDialog,hWin,0 .endif xor eax,eax ret DlgProc endp end start

Отправлен: 08.05.2008, 23:38 Вопрос задала: Vampirrenok (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 4)

Отвечает: PavelGM Здравствуйте, Vampirrenok! Код в приложении. Файл формы тоже. Сначала Enum, потом выбираете устройство, потом Eject. Проверял на флэшках. Спасибо за ссылку на код. Приложение: ////// MainUnit.pas ////////////////////////////////////////////////////// unit MainUnit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, StdCtrls; type TUSBRemoveForm = class(TForm) BtnEnum: TButton; LV: TListView; BtnEject: TButton; procedure BtnEnumClick(Sender: TObject); procedure BtnEjectClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var USBRemoveForm: TUSBRemoveForm; implementation {$R *.dfm} const CM_LOCATE_DEVNODE_NORMAL = 0; CM_DRP_DEVICEDESC = $01; CM_DRP_FRIENDLYNAME = $0D; DN_REMOVABLE = $4000; CR_NO_SUCH_DEVNODE = $0d; CR_SUCCESS = $00; function CM_Locate_DevNodeA(var pdnDevInst : THandle; pDeviceID : DWORD; ulFlags : DWORD) : DWORD; stdcall; external 'setupapi.dll'; function CM_Get_DevNode_Status(var pulStatus : DWORD; var pulProblemNumber : DWORD; dnDevInst : THandle; ulFlags : DWORD) : DWORD; stdcall; external 'setupapi.dll'; function CM_Get_Device_ID_Size(var pulLen : DWORD; dnDevInst : DWORD; ulFlags : DWORD) : DWORD; stdcall; external 'setupapi.dll'; function CM_Get_Device_IDA(dnDevInst : THandle; Buffer : PChar; BufferLen : DWORD; ulFlags : DWORD) : DWORD; stdcall; external 'setupapi.dll'; function CM_Get_DevNode_Registry_PropertyA(dnDevInst : THandle; ulProperty : DWORD; pulRegDataType : PDWORD; Buffer : Pointer; var pulLength : DWORD; ulFlags : DWORD) : DWORD; stdcall; external 'setupapi.dll'; function CM_Get_Child(var pdnDevInst : THandle; dnDevInst : THandle; ulFlags : DWORD) : DWORD; stdcall; external 'setupapi.dll'; function CM_Get_Sibling(var pdnDevInst : THandle; dnDevInst : THandle; ulFlags : DWORD) : DWORD; stdcall; external 'setupapi.dll'; function CM_Request_Device_EjectA(dnDevInst : THandle; pVetoType : Pointer; pszVetoName : Pointer; ulNameLength : DWORD; ulFlags : DWORD) : DWORD; stdcall; external 'setupapi.dll'; procedure EnumDevice(dDevInst:DWORD); var Status, ProblemNum, DevLen, Len : DWORD; aDeviceId, aBuffer : String; NewDevInst : THandle; begin CM_Get_DevNode_Status(Status,ProblemNum,dDevInst,0); CM_Get_Device_ID_Size(DevLen,dDevInst,0); Inc(DevLen); SetLength(aDeviceID, DevLen); CM_Get_Device_IDA(dDevInst,PChar(aDeviceId),DevLen,0); Len := 200; SetLength(aBuffer, 200); if CM_Get_DevNode_Registry_PropertyA(dDevInst,CM_DRP_FRIENDLYNAME,nil,PChar(aBuffer),len,0) <> CR_SUCCESS then if CM_Get_DevNode_Registry_PropertyA(dDevInst,CM_DRP_DEVICEDESC,nil,PChar(aBuffer),len,0) <> CR_SUCCESS then aBuffer := '<Unnamed>'; if Status and DN_REMOVABLE <> 0 then with USBRemoveForm.LV.Items.Add do begin Caption := IntToStr(USBRemoveForm.LV.Items.Count); SubItems.Add(aBuffer); SubItems.Add(IntToStr(ProblemNum)); SubItems.Add(aDeviceID); end; if CM_Get_Child(NewDevInst,dDevInst,0) = CR_SUCCESS then EnumDevice(NewDevInst); if CM_Get_Sibling(NewDevInst,dDevInst,0) = CR_SUCCESS then EnumDevice(NewDevInst); end; procedure TUSBRemoveForm.BtnEnumClick(Sender: TObject); var dnDevInst : THandle; begin LV.Clear; CM_Locate_DevNodeA(dnDevInst,CM_LOCATE_DEVNODE_NORMAL,0); EnumDevice(dnDevInst); end; procedure TUSBRemoveForm.BtnEjectClick(Sender: TObject); var aBuffer : String; dnDevInst : THandle; begin if not Assigned(LV.Selected) then Exit; aBuffer := LV.Selected.SubItems[2]; CM_Locate_DevNodeA(dnDevInst, DWORD(Addr(aBuffer[1])), CM_LOCATE_DEVNODE_NORMAL); CM_Request_Device_EjectA(dnDevInst, nil, nil, 0, 0); end; end. ////// MainUnit.dfm ////////////////////////////////////////////////////// object USBRemoveForm: TUSBRemoveForm Left = 276 Top = 114 Width = 560 Height = 406 Caption = 'Enum devices' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.style="[]" OldCreateOrder = False PixelsPerInch = 96 TextHeight = 13 object BtnEnum: TButton Left = 8 Top = 12 Width = 129 Height = 25 Caption = 'Enum devices' TabOrder = 0 OnClick = BtnEnumClick end object LV: TListView Left = 8 Top = 44 Width = 529 Height = 285 Columns = < item Caption = '#' Width = 24 end item Caption = 'Name' Width = 180 end item Caption = 'Problem' end item Caption = 'DeviceID' Width = 250 end> ReadOnly = True RowSelect = True TabOrder = 1 Viewstyle="vsReport" end object BtnEject: TButton Left = 148 Top = 12 Width = 109 Height = 25 Caption = 'Eject selected' TabOrder = 2 OnClick = BtnEjectClick end end

Ответ отправил: PavelGM (статус: Студент) Ответ отправлен: 11.05.2008, 00:29 Оценка за ответ: 5

Вопрос № 136.096

Нужно построить круговую диаграмму с 7 секторами: 10% 15% 25% 10% 20% 10% 10%. Напишите весь код плиз.

Отправлен: 09.05.2008, 16:14 Вопрос задал: Трошин Денис Алексеевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Gh0stik Здравствуйте, Трошин Денис Алексеевич! Для построения диаграмм рекомендую использовать объект TChar (вкладка Additional), далее написать такой обработчик (например, OnClick для кнопки): procedure TForm1.Button1Click(Sender: TObject); const data:array [1..7] of integer=(10,15,25,10,20,10,10); //массив с данными var i:integer;     MySeries:TPieSeries; //серия для круговой диаграммы begin   MySeries:=TPieSeries.Create(Chart1); //создаем серию   with MySeries do begin     ParentChart:=Chart1;     for i:=1 to 7 do Add(data[i]); //заполняем данными из массива   end; end; Good Luck! --------- Непечатный жаргон - это тот язык, которым решительно все программисты владеют в совершенстве.

Ответ отправил: Gh0stik (статус: Академик) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) WWW: http://gh0stik.rusfaq.ru/ ICQ: 289363162 ---- Ответ отправлен: 09.05.2008, 23:58 Оценка за ответ: 3 Комментарий оценки: Программа не запускается и ссылается на эту строчку MySeries:TPieSeries; и на create.

Вопрос № 136.154

Здравствуйте эксперты. Где можно скачать о пакетах(.bpl) (книги, статьи, исходники).

Отправлен: 10.05.2008, 08:16 Вопрос задал: Жалолиддин Усмонов (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Антон Александрович Волков Здравствуйте, Жалолиддин Усмонов! А что конкретно интересует "о пакетах"? Пакет - это разновидность динамически подключаемой библиотеки (DLL) для Windows. О пакетах, достаточно подробно говорится в справочной системе Delphi. Пример справочной системы Delphi 7: Файл справки "Delphi Help"->раздел "Delphi Language Guide"->"Libraries and packages", а также файл справки "Programming with Delphi"->раздел "Working with packages and components". Там же приведены примеры кода.

Ответ отправил: Антон Александрович Волков (статус: 2-ой класс) Ответ отправлен: 12.05.2008, 04:13

Вопрос № 136.165

Нужна помощь!!!! Необходимо целое число умножить на число с запятой(0,005). как это сделать, не могу вспомнить.

Отправлен: 10.05.2008, 09:40 Вопрос задал: Богомолов Алексей (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 7)

Отвечает: Drbear Здравствуйте, Богомолов Алексей! Попробуйте развить такую функцию: function multiply(i: Integer; fX: Float): Float; begin Result := i * fX; end; Надеюсь, помог Вам. Удалено пустое приложение. ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессор) ∙ Дата редактирования: 13.05.2008, 20:52

Ответ отправил: Drbear (статус: 10-ый класс) Ответ отправлен: 10.05.2008, 09:47

Вопрос № 136.284

Здравствуйте! У меня проблема. Очень простая, но я не могу ее решить. function opt11(x0: single; i4:integer):single; begin идет ряд вычислений, заканчивается примерно так: Gy_:=G_0+C0_*(Gk1+Gk2); Ktr:=Kob*(Kob*(Gk1_+Gk2_)+Kst*Kotx*Cst*G_0); Zp:=0.213*gy*Gy_+k_beta*Zx*P0*0.001+Kd*Zk*Pk*0.001; end; Я хочу вызвать переменную Zp и делаю это таким образом в другой процедуре: Zp0:=opt11(x0,i4); Результат выдает "0". Чило отличное от нуля. Помогите разобраться. Спасибо большое!

Отправлен: 10.05.2008, 22:43 Вопрос задал: Oricardo (статус: 1-ый класс) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 6)

Отвечает: Selya Здравствуйте, Oricardo! Перепишите функцию opt11(), вместо Zp:=0.213*gy.... напишите Result:=0.213*gy..... и всё будет в порядке :)

Ответ отправил: Selya (статус: 7-ой класс) Ответ отправлен: 11.05.2008, 10:54 Оценка за ответ: 4 Комментарий оценки: А Result - это какая-то особая переменная?

Отвечает: Павел Шведенко Здравствуйте, Oricardo! ZP - глобальная, или локальная для каждой процедуры, если локальная для каждой - то в каждой процедуре значения ZP - свои.Вот --------- Всегда

Ответ отправил: Павел Шведенко (статус: 2-ой класс) Ответ отправлен: 12.05.2008, 09:11 Оценка за ответ: 1 Комментарий оценки: Zp глобальная переменная, но значение все равно не передается. Вопрос был задан с целью узнать, каким образом передавать значения из функций переменным

Вопрос № 136.441

Здравствуйте, Эксперты! У меня два вопроса: 1) Как сделать, чтобы форма не изменяла своих размеров? (Утопить или убрать кнопку "Развернуть на весь экран" и не реагировала на двойной щелчек на заголовке) 2) Вопрос более сложный: в программе организован вывод результата (вещественное число) в TEdit, но Delphi представляет его в экспоненциальной форме (Например, 0,36674*E12), а как сделать вывод в "человеческой" форме?

Отправлен: 12.05.2008, 10:51 Вопрос задал: Марков Александр Сергеевич (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Selya Здравствуйте, Марков Александр Сергеевич! 1. У формы есть свойства BorderStyle и BorderIcons. Поиграйтесь с ними, почитайте справку Delphi. 2. В таком виде представляются или очень большие или очень маленькие числа. В этом случае, если точность не важна (для маленьких), попробуйте отформатировать число функцией Format (см.прил. и справку Delphi) Приложение: var D: Double; begin D := 0,36674e12; Edit1.Text := Format('%f', [D]); // получим что-то вроде 366740000000,00

Ответ отправил: Selya (статус: 7-ой класс) Ответ отправлен: 12.05.2008, 11:11

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Марков Александр Сергеевич! По первому вопросу. Раскройте в испекторе объектов (Object Inspector) свойство BorderIcons формы и установите biMaximize = false. Свойство BorderStyle установите равным bsSingle. Больше размеры формы нельзя будет изменять. Удачи!

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессор) Россия, Москва WWW: nvsoft.org ---- Ответ отправлен: 16.05.2008, 19:31

Вопрос № 136.487

Необходимо разобраться в программе TRegSvr.dpr (папка вашего компилятора: BorlandDelphi7DemosActiveXTRegSvr). В чём заключается функция программы и папки в целом. Прокомментируйте построчно если возможно: Код перенесен в приложение. ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессор) ∙ Дата редактирования: 13.05.2008, 20:51 Приложение: program TRegSvr; {$APPTYPE CONSOLE} uses SysUtils, Windows, ActiveX, ComObj, RegConst; type TRegType = (rtAxLib, rtTypeLib, rtExeLib); TRegAction = (raReg, raUnreg); TRegProc = function : HResult; stdcall; TUnRegTlbProc = function (const libID: TGUID; wVerMajor, wVerMinor: Word; lcid: TLCID; syskind: TSysKind): HResult; stdcall; const ProcName: array[TRegAction] of PChar = ( 'DllRegisterServer', 'DllUnregisterServer'); ExeFlags: array[TRegAction] of string = (' /regserver', ' /unregserver'); var RegType: TRegType = rtAxLib; RegAction: TRegAction = raReg; QuietMode: Boolean = False; FileName: string; RegProc: TRegProc; LibHandle: THandle; OleAutLib: THandle; UnRegTlbProc: TUnRegTlbProc; procedure OutputStr(S: string); begin if not QuietMode then begin CharToOEM(PChar(S), PChar(S)); Writeln(S); end; end; function DecodeOptions: Boolean; var i: Integer; FileStart: Boolean; Param, FileExt: string; begin Result := False; if ParamCount = 0 then Exit; FileName := ''; for i := 1 to ParamCount do begin Param := ParamStr(i); FileStart := not (Param[1] in ['-', '/']); if FileStart then begin if FileName = '' then FileName := Param else FileName := FileName + ' ' + Param; // strip open and/or close quote if present if (FileName[1] = '"') then begin if (FileName[Length(FileName)] = '"') then FileName := Copy(FileName, 2, Length(FileName) - 2) else if FileName[1] = '"' then Delete(FileName, 1, 1); end; end else begin if Length(Param) < 2 then Exit; case Param[2] of 'U', 'u': RegAction := raUnreg; 'Q', 'q': QuietMode := True; 'T', 't': RegType := rtTypeLib; end; end; end; FileExt := ExtractFileExt(FileName); if FileExt = '' then raise Exception.CreateFmt(SNeedFileExt, [FileName]); if RegType <> rtTypeLib then begin if CompareText(FileExt, '.TLB') = 0 then RegType := rtTypeLib else if CompareText(FileExt, '.EXE') = 0 then RegType := rtExeLib else RegType := rtAxLib; end; Result := True; end; procedure RegisterAxLib; begin LibHandle := LoadLibrary(PChar(FileName)); if LibHandle = 0 then raise Exception.CreateFmt(SLoadFail, [FileName]); try @RegProc := GetProcAddress(LibHandle, ProcName[RegAction]); if @RegProc = Nil then raise Exception.CreateFmt(SCantFindProc, [ProcName[RegAction], FileName]); if RegProc <> 0 then raise Exception.CreateFmt(SRegFail, [ProcName[RegAction], FileName]); OutputStr(Format(SRegSuccessful, [ProcName[RegAction]])) finally FreeLibrary(LibHandle); end; end; procedure RegisterTLB; const RegMessage: array[TRegAction] of string = (SRegStr, SUnregStr); var WFileName, DocName: WideString; TypeLib: ITypeLib; LibAttr: PTLibAttr; DirBuffer: array[0..MAX_PATH] of char; begin if ExtractFilePath(FileName) = '' then begin GetCurrentDirectory(SizeOf(DirBuffer), DirBuffer); FileName := '' + FileName; FileName := DirBuffer + FileName; end; if not FileExists(FileName) then raise Exception.CreateFmt(SFileNotFound, [FileName]); WFileName := FileName; OleCheck(LoadTypeLib(PWideChar(WFileName), TypeLib)); OutputStr(Format(STlbName, [WFileName])); OleCheck(TypeLib.GetLibAttr(LibAttr)); try OutputStr(Format(STlbGuid, [GuidToString(LibAttr^.Guid)]) + #13#10); if RegAction = raReg then begin OleCheck(TypeLib.GetDocumentation(-1, nil, nil, nil, @DocName)); DocName := ExtractFilePath(DocName); OleCheck(RegisterTypeLib(TypeLib, PWideChar(WFileName), PWideChar(DocName))); end else begin OleAutLib := GetModuleHandle('OLEAUT32.DLL'); if OleAutLib <> 0 then @UnRegTlbProc := GetProcAddress(OleAutLib, 'UnRegisterTypeLib'); if @UnRegTlbProc = nil then raise Exception.Create(SCantUnregTlb); with LibAttr^ do OleCheck(UnRegTlbProc(Guid, wMajorVerNum, wMinorVerNum, LCID, SysKind)); end; finally TypeLib.ReleaseTLibAttr(LibAttr); end; OutputStr(Format(STlbRegSuccessful, [RegMessage[RegAction]])); end; procedure RegisterEXE; var SI: TStartupInfo; PI: TProcessInformation; RegisterExitCode: BOOL; begin FillChar(SI, SizeOf(SI), 0); SI.cb := SizeOf(SI); RegisterExitCode := Win32Check(CreateProcess(PChar(FileName), PChar(FileName + ExeFlags[RegAction]), nil, nil, True, 0, nil, nil, SI, PI)); CloseHandle(PI.hThread); CloseHandle(PI.hProcess); if RegisterExitCode then OutputStr(Format(SExeRegSuccessful, [PChar(FileName + ExeFlags[RegAction])])) else OutputStr(Format(SExeRegUnsuccessful, [PChar(FileName + ExeFlags[RegAction])])); end; begin try if not DecodeOptions then raise Exception.Create(SAbout + #13#10 + SUsage); OutputStr(SAbout); if not FileExists(FileName) then raise Exception.CreateFmt(SFileNotFound, [FileName]); case RegType of rtAxLib: RegisterAxLib; rtTypeLib: RegisterTLB; rtExeLib: RegisterEXE; end; except on E:Exception do OutputStr(E.Message); end; end.

Отправлен: 12.05.2008, 15:45 Вопрос задал: Mirimas (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Denisss Здравствуйте, Mirimas! Код с комментариями находится в приложении. По своей сути, программа TRegSvr является аналогом программы RegSvr32 от Microsoft. Основные функции программы: DecodeOptions - анализирует параметры запуска. RegisterAxLib - производит регистрацию или отмену регистрации DLL или OCX файла путем вызова одной из ее функций: DllRegisterServer или DllUnRegisterServer соответственно. RegisterTLB - регистрация или ее отмена TLB (Type Library) файла путем вызова функции RegisterTypeLib или функции UnRegisterTypeLib библиотеки OLEAUT32. RegisterEXE - регистрация или ее отмена EXE-файла путем запуска данного файла с параметрами /regserver или /unregserver Удачи! Приложение: program TRegSvr; // Тип приложения - консольный {$APPTYPE CONSOLE} ... // Процедура вывода текста procedure OutputStr(S: string); begin // Если "тихий режим", // то ничего не выводим if not QuietMode then begin // Преобразуем текст в DOS-кодировку CharToOEM(PChar(S), PChar(S)); // Выводим Writeln(S); end; end; // Проверяем входные параметры function DecodeOptions: Boolean; var i: Integer; FileStart: Boolean; Param, FileExt: string; begin Result := False; if ParamCount = 0 then Exit; FileName := ''; for i := 1 to ParamCount do begin Param := ParamStr(i); // Проверяем, является ли параметр именем файла FileStart := not (Param[1] in ['-', '/']); if FileStart then begin if FileName = '' then FileName := Param else FileName := FileName + ' ' + Param; // Убираем двойные кавычки из // начала и конца имени файла if (FileName[1] = '"') then begin if (FileName[Length(FileName)] = '"') then FileName := Copy(FileName, 2, Length(FileName) - 2) else if FileName[1] = '"' then Delete(FileName, 1, 1); end; end else // Если параметр не является // именем файла begin // Если параметр имеет длину меньше двух // символов, значит он неправильный if Length(Param) < 2 then Exit; case Param[2] of // Отмена регистрации 'U', 'u': RegAction := raUnreg; // "Тихий режим" 'Q', 'q': QuietMode := True; // Тип файла - TLB 'T', 't': RegType := rtTypeLib; end; end; end; // Определяем расширение файла FileExt := ExtractFileExt(FileName); // Если отсутствует, генерируем исключение if FileExt = '' then raise Exception.CreateFmt(SNeedFileExt, [FileName]); // Если тип файла не определен, // определяем его по расширению if RegType <> rtTypeLib then begin if CompareText(FileExt, '.TLB') = 0 then RegType := rtTypeLib else if CompareText(FileExt, '.EXE') = 0 then RegType := rtExeLib else RegType := rtAxLib; end; // Если дошли до конца функции, // значит ошибок не было замечено Result := True; end; // Регистрация ActiveX библиотеки procedure RegisterAxLib; begin // Загружаем регистрируемую библиотеку LibHandle := LoadLibrary(PChar(FileName)); // Если загрузка не удалась, генерируем исключение if LibHandle = 0 then raise Exception.CreateFmt(SLoadFail, [FileName]); try // Получаем адрес функции, в зависимости // от действия (регистрация / отмена регистрации) @RegProc := GetProcAddress(LibHandle, ProcName[RegAction]); // Если адрес функции не получен, // генерируем исключение if @RegProc = Nil then raise Exception.CreateFmt(SCantFindProc, [ProcName[RegAction], FileName]); // Вызываем саму функцию // Если неудачно, генерируем исключение if RegProc <> 0 then raise Exception.CreateFmt(SRegFail, [ProcName[RegAction], FileName]); // Выводим сообщение об удачной операции OutputStr(Format(SRegSuccessful, [ProcName[RegAction]])) finally // Выгружаем библиотеку FreeLibrary(LibHandle); end; end; // Регистрация TLB-файла procedure RegisterTLB; const RegMessage: array[TRegAction] of string = (SRegStr, SUnregStr); var WFileName, DocName: WideString; TypeLib: ITypeLib; LibAttr: PTLibAttr; DirBuffer: array[0..MAX_PATH] of char; begin // Если полный путь не указан, // указываем его if ExtractFilePath(FileName) = '' then begin GetCurrentDirectory(SizeOf(DirBuffer), DirBuffer); FileName := '' + FileName; FileName := DirBuffer + FileName; end; // Если файла не существует, // геренируем исключение if not FileExists(FileName) then raise Exception.CreateFmt(SFileNotFound, [FileName]); WFileName := FileName; // Загружаем библиотеку OleCheck(LoadTypeLib(PWideChar(WFileName), TypeLib)); OutputStr(Format(STlbName, [WFileName])); // Получаем атрибуты библиотеки OleCheck(TypeLib.GetLibAttr(LibAttr)); try OutputStr(Format(STlbGuid, [GuidToString(LibAttr^.Guid)]) + #13#10); // Регистрация if RegAction = raReg then begin OleCheck(TypeLib.GetDocumentation(-1, nil, nil, nil, @DocName)); DocName := ExtractFilePath(DocName); OleCheck(RegisterTypeLib(TypeLib, PWideChar(WFileName), PWideChar(DocName))); end // Отмена регистрации else begin // Подключаемся к библиотеке OLEAUT32.DLL OleAutLib := GetModuleHandle('OLEAUT32.DLL'); // Получаем адрес функции отмены регистрации if OleAutLib <> 0 then @UnRegTlbProc := GetProcAddress(OleAutLib, 'UnRegisterTypeLib'); if @UnRegTlbProc = nil then raise Exception.Create(SCantUnregTlb); // Отменяем регистрацию TLB with LibAttr^ do OleCheck(UnRegTlbProc(Guid, wMajorVerNum, wMinorVerNum, LCID, SysKind)); end; finally TypeLib.ReleaseTLibAttr(LibAttr); end; OutputStr(Format(STlbRegSuccessful, [RegMessage[RegAction]])); end; // Регистрация EXE-файла procedure RegisterEXE; var SI: TStartupInfo; PI: TProcessInformation; RegisterExitCode: BOOL; begin FillChar(SI, SizeOf(SI), 0); SI.cb := SizeOf(SI); // Запускаем EXE файл с соответствующими параметрами RegisterExitCode := Win32Check(CreateProcess(PChar(FileName), PChar(FileName + ExeFlags[RegAction]), nil, nil, True, 0, nil, nil, SI, PI)); CloseHandle(PI.hThread); CloseHandle(PI.hProcess); // Выдаем сообщение if RegisterExitCode then // о успехе выполнения задачи OutputStr(Format(SExeRegSuccessful, [PChar(FileName + ExeFlags[RegAction])])) else // о неудаче OutputStr(Format(SExeRegUnsuccessful, [PChar(FileName + ExeFlags[RegAction])])); end; begin try // Проверяем входные параметры if not DecodeOptions then // Если неправильные параметры, генерируем исключение raise Exception.Create(SAbout + #13#10 + SUsage); // Выводим сообщение "О программе" OutputStr(SAbout); // Проверяем наличие файла if not FileExists(FileName) then // Если отсутствует, генерируем исключение raise Exception.CreateFmt(SFileNotFound, [FileName]); case RegType of // Регистрируем ActiveX библиотеку rtAxLib: RegisterAxLib; // Регистрируем TLB-файл rtTypeLib: RegisterTLB; // Регистрируем EXE-файл rtExeLib: RegisterEXE; end; except // Если произошла ошибка, // выводим соответствующее сообщение on E:Exception do OutputStr(E.Message); end; end. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 12.05.2008, 20:43 Оценка за ответ: 5

Вопрос № 136.539

Помогите пожалуйста с 2 заданиями: 1) Дан список, состоящий из чисел. Прибавить к каждому элементу данного списка его порядковый номер. 2)Дано целое число размером I байт. Перевернуть его двоичную запись. Заранее спасибо! Правописание. ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессор) ∙ Дата редактирования: 13.05.2008, 20:50

Отправлен: 12.05.2008, 20:35 Вопрос задал: Кузнецов Дмитрий Александрович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Тимошенко Александр Васильевич Здравствуйте, Кузнецов Дмитрий Александрович 1)Если список представлен в виде динамического массива тогда var i:integer; x:array of integer; begin //инициализация массива for i:=0 to high(x) do x[i]:=x[i]+i; end; 2)Перевод из десятичной в двоичную и вывод результата в оббратном порядке Function convertbinary(int:integer):String; var i:Integer; s,s_out:String; begin s:=''; while int<>0 do begin s:=s+inttostr(int mod 2); int:=int div 2; end; result:=s; end;

Ответ отправил: Тимошенко Александр Васильевич (статус: 1-ый класс) Ответ отправлен: 13.05.2008, 16:52 Оценка за ответ: 4

Вопрос № 136.574

Здравствуйте уважаемые эксперты! Как можно: - удалить не пустой каталог на диске (вариант с предварительным поиском и удалением содержимого нежелателен); - переименовать пустой/не пустой каталог на диске (желательно без физического перемещения содержимого). Заранее спасибо.

Отправлен: 12.05.2008, 22:45 Вопрос задал: Кабанов Денис Николаевич (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: PavelGM Здравствуйте, Кабанов Денис Николаевич! 1. Можно воспользоваться консольной командой "rmdir /S/Q <путь к каталогу>". И каталог с содержимым исчезнет без вопросов. Хотя система все равно за вас будет искать и удалять содержимое. 2. Обычные функции API MoveFile/MoveFileEx так и работают (если диски источника и приемника одинаковы).

Ответ отправил: PavelGM (статус: Студент) Ответ отправлен: 13.05.2008, 10:32 Оценка за ответ: 5

Отвечает: Denisss Здравствуйте, Кабанов Денис Николаевич! См. примеры функций в приложении. rmDir - удаление каталога. mvDir - переименование каталога. Операции реализованы с помощью системной функции SHFileOperation, описанной в модуле ShellAPI (необходимо прописать в uses). Установка флагов FOF_NOERRORUI + FOF_NOCONFIRMMKDIR + FOF_SILENT + FOF_NOCONFIRMATION отключает все возможные уведомления пользователя и сообщения об ошибках. Удачи! Приложение: uses ShellAPI; ...... function rmDir(Dir: string): Boolean; var sh: TSHFileOpStruct; begin if Dir <> '' then if Dir[Length(Dir)] = '' then Delete(Dir, Length(Dir), 1); sh.Wnd:= 0; sh.wFunc:= FO_DELETE; sh.pFrom:= PChar(Dir + #0#0); sh.pTo:= #0#0; sh.fFlags:= FOF_NOERRORUI or FOF_NOCONFIRMMKDIR or FOF_SILENT or FOF_NOCONFIRMATION; sh.hNameMappings:= nil; sh.lpszProgressTitle:= nil; SHFileOperation(sh); Result:= not DirectoryExists(Dir); end; function mvDir(dFrom, dTo: string): Boolean; var sh: TSHFileOpStruct; begin if (dFrom <> '') then if (dFrom[Length(dFrom)] = '') then Delete(dFrom, Length(dFrom), 1); if (dTo <> '') then if (dTo[Length(dTo)] = '') then Delete(dTo, Length(dTo), 1); sh.Wnd:= 0; sh.wFunc:= FO_MOVE; sh.pFrom:= PChar(dFrom + #0#0); sh.pTo:= PChar(dTo + #0#0);; sh.fFlags:= FOF_NOERRORUI or FOF_NOCONFIRMMKDIR or FOF_SILENT or FOF_NOCONFIRMATION; sh.hNameMappings:= nil; sh.lpszProgressTitle:= nil; SHFileOperation(sh); Result:= (not DirectoryExists(dFrom)) and DirectoryExists(dTo); end; --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 13.05.2008, 20:46 Оценка за ответ: 5

Вопрос № 136.579

Здравстуйте эксперты Не могу написать (1 курс) " Написать программу которая вычисляет стоимость проезла автомобиля, на дачу." Спасибо

Отправлен: 12.05.2008, 23:24 Вопрос задал: Евгений Попов (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Тимошенко Александр Васильевич Здравствуйте, Евгений Попов! Подробней объесните суть задачи. Если есть расстояние до дачи и стоимость километра то так:расстояние*стоимость

Ответ отправил: Тимошенко Александр Васильевич (статус: 1-ый класс) Ответ отправлен: 13.05.2008, 16:24 Оценка за ответ: 5 Комментарий оценки: Да

Вопрос № 136.799

Здравствуйте, уважаемые эксперты! Создаю форму fm2 с эффектом прозрачности (AlphaBlended:=True; AlphaBlendvalue:=100), но когда свойству Parent этой формы присваиваю указатель на другую форму fm1(чтобы fm1 определяла границы перемещения и отрисовки "прозрачной" fm2), эффект прозрачности почему-то пропадает. Пожалуйста, помогите решить данную проблему. Заранее благодарен, Олег. Приложение: procedure Tfm1.Button1Click(Sender: TObject); //fm1-ограничивает перемещение и отрисовку fm2 //fm2 -"прозрачная" форма begin fm2:=Tfm2.Create(Self); fm2.Parent:=fm1;//эта строка убирает "прозрачность" fm2 fm2.Show; end;

Отправлен: 14.05.2008, 14:58 Вопрос задал: Олег Семёнович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 4)

Отвечает: Denisss Здравствуйте, Олег Семёнович! Для установки прозрачности формы, Delphi использует функцию SetLayeredWindowAttributes. Данная функция работает только с окнами, у которых применен расширенный стиль WS_EX_LAYERED. Данный стиль можно указать либо при создании окна (CreateWindowEx), либо с помощью функции SetWindowLong. В описании данного стиля есть строчка: Windows 2000/XP: Note that this cannot be used for child windows. Переводится это так: "Учтите, данный стиль не может применяться для дочерних окон". При вызове функции SetLayeredWindowAttributes для дочерних окон возникает ошибка 87 (Параметр задан неверно). Т.е., к сожалению, прозрачность дочерних окон устанавливать нельзя. Удачи! --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 14.05.2008, 21:28

Вопрос № 136.948

Здравствуйте ув. эксперты. Нужна срочная помощь по лабораторной. Преподаватель сейчас болеет, и если раньше он мог дать подсказку и натолкнуть на правильный путь, то теперь нет такой возможности. А лабораторную надо отправить завтра вечером, т.к. в понедельник уже будет выставляться промежуточная аттестация. Мне осталось по сути только добавлять данные в вычисляемые поля на основе введённых данных и проверять введённые данные на формат (цифры или символы). Значит при разработке лабораторной в Delphi 7.0 с использованием БД, для занесение в БД используются компоненты DBGrig и DBNavigator. Так вот, проблема в следующем: я не знаю как обратится к полям таблицы. Ну например нужно проверять введённые значения и заносить данные в вычисляемые поля. В связи с эти несколько вопросов: 1) Это нужно делать в самой форме или в модуле данных? 2) Как обратится к полям таблицы? Какие свойства использовать и т.д.? Т.е. чтобы я мог проверить введённые значения 3) Для вычисляемых полей. Нужно сначала считать данные из необходимых полей, провести расчет, а потом занести эти данные в необходимые вычисляемые поля. Как сделать именно добавление данных в вычисляемые поля? 4) Внутри каких обработчиков таблицы это нужно делать? У DBGrig, например есть обработчик события OnEnter, я думал что можно использовать его, но оказывается он задействуется только тогда, когда первый раз кликаешь на сам DBGrig, чтобы ввести туда значения. Пожалуйста, подскажите как решить эти проблемы. Конечно и за лабораторную в таком виде я баллов 70-75 получу, но хотелось бы побольше. А учебных пособий по Делфи у меня при себе нет((( Если необходима какя-то доп информация, спрашивайте в мини-форуме. Просто очень нужно завтра до 20.00 отправить максимально сделанную лабораторную.

Отправлен: 15.05.2008, 14:39 Вопрос задал: Стас Тельнов/[анти]КИЛЛЕР (статус: 5-ый класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Mukomelo Yevgeniy Bogdanovich Здравствуйте, Стас Тельнов/[анти]КИЛЛЕР! 1) Не имеет значения, в каком модуле писать процедуру, главное привязать её к правильному событию. 2) DataModul.YourDataSet.FieldByName('ColName').Value - Это и есть значение поля ColName. Далее можете с ним делать все что пожелаете, только перед редактированием нужно будет ввести дата сет в режим редактирования (Edit;). 3) Дважны щёлкаете по датаСету. Создаете новое поле. Тип выдираете "Calcula...", по русски говоря "Вычисляемое". Затем тип поля. Затем у ДатаСета есть событие "OnCalcFields", в нём Вы и пишите ваше вычисление. Например: DataModl.DataSet.FieldByName('Sum').Value := DataModl.DataSet.FieldByName('Kol').Value * DataModl.DataSet.FieldByName('Prime').Value; //Sum - Вычисляемое поле. Если возникнут ещё вопросы, пишите. --------- Никогда не бойся делать то, что ты не умеешь. Помни, ковчег был построен любителем. Профессионалы построили 'Титаник'.

Ответ отправил: Mukomelo Yevgeniy Bogdanovich (статус: 1-ый класс) Ответ отправлен: 15.05.2008, 15:00 Оценка за ответ: 5 Комментарий оценки: Большое спасибоза чёткий, ясный и своевременный ответ. Всё сделал, всё работает.

Вопрос № 136.961

Из каких мест(папок) программы могут автоматически запускаться при старте винди ХР. А также куда надо прописать в реестре или в какую папку скопировать программу для того чтоб она стартовала для всех пользователей в том числе и тогда когда загружается из безопасного режима.

Отправлен: 15.05.2008, 16:13 Вопрос задал: Делий Роман (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Drbear Здравствуйте, Делий Роман ! Программы могут находится в любом месте. Пример кода в приложении. Если Вы замените строку RootKey := HKEY_LOCAL_MACHINE; на RootKey := HKEY_CURRENT_USER; приложение будет запускаться только для текущего пользователя. Приложение: procedure AutoRun(); var r: TRegistry; begin r := TRegistry.Create; with r do begin RootKey := HKEY_LOCAL_MACHINE; OpenKey('SoftwareMicrosoftWindowsCurrentVersionRun', true); WriteString('Отображаемое имя', 'Путь к программе') // DeleteValue('Отображаемое имя'); CloseKey; Free; end; // with r end;

Ответ отправил: Drbear (статус: 10-ый класс) Ответ отправлен: 15.05.2008, 17:25 Оценка за ответ: 5 Комментарий оценки: Спасибо за код)) Токо я не пойму а что делает этот код: DeleteValue(Отображаемое имя); Буду рад если объяснишь.

Вопрос № 137.010

Здравствуйте! Купил диск с дистрибутивом Kylix или как его там........ RPM пакеты не устанавливаются. Знающие люди сказали, что дистрибутив битый. А не подскажет ли кто, где в интернете можно найти нормальный дистрибутив данной среды программирования? Исправлена ошибка в названии продукта. ----- ∙ Отредактировал: Gh0stik (Академик) ∙ Дата редактирования: 15.05.2008, 22:18

Отправлен: 15.05.2008, 22:10 Вопрос задал: KuchumHan (статус: Студент) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Витомский Вадим Викторович Здравствуйте, KuchumHan! Kylix можно скачать на сайте производителя - http://info.borland.com/devsupport/kylix/downloads/ Однако это "мертвый" проект, который уже несколько лет не развивается , и если Вам необходимо перенести программы, наисанные на Delphi в Линукс, то я бы посоветовал Вам использовать среду разработки Lazarus, которая на данном этапе интенсивно развивается и к тому же абсолютно бесплатна. Для более подробной информации посетите сайт http://freepascal.ru/ - там есть статьи по установке и использованию этой среды разработки, также форум, посвященный работе с компилятором Free Pascal Compiler и всему, что с ним связанно. Удачи! --------- Не так страшен черт, как его чертовка!

Ответ отправил: Витомский Вадим Викторович (статус: Студент) Ответ отправлен: 16.05.2008, 10:13 Оценка за ответ: 5 Комментарий оценки: Ну что сказать, отличный ответ. Дело в том , что отдел К не спит и уже даже смотрит на чём программа написанна................

Вопрос № 137.132

Нужно подробно написать код программы, выводящей на экран график функции у=ах^2-2. И координатную сетку с осями координат. "а" может быть так же отрицательным.(P.S. пожалуста напишите весь код а то не рублю в дельфи).

Отправлен: 16.05.2008, 20:14 Вопрос задал: Jim Turny Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Drbear Здравствуйте, Jim Turny! Пример кода здесь: http://rusfaq.ru/upload/692 По вопросу №137131 здесь: http://rusfaq.ru/upload/693

Ответ отправил: Drbear (статус: 10-ый класс) Ответ отправлен: 16.05.2008, 20:45

Вопрос № 137.236

код программы в которой дан файл из его элементов составить двумерный массив на языке delphi

Отправлен: 17.05.2008, 17:48 Вопрос задала: RaduGa (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 10)

Отвечает: SHERRY Здравствуйте, RaduGa! Вот, написал код. В каталоге программы создайте текстовый файл "input.txt", цифры запишите, разделяя их пробелом. Для демонстрации результата - выношу считанные значения в Memo. Приложение: procedure TForm1.FormCreate(Sender: TObject); var f: TextFile; ms: array[1..100, 1..100] of integer; i,j: integer; s: string; begin Memo1.Clear; // чистим мемо AssignFile(f, 'input.txt'); // задаём файловой переменной файл на диске Reset(f); // открываем файл для чтения i:=1; j:=1; s:=''; // инициализируем вспомогательные переменные While not EOF(f) do // до тех пор, пока не достигнут конец файла выполняем алгоритм begin while not EOLn(f) do // читаем числа до конца строки begin read(f, ms[i,j]); // чтение s:=s + IntToStr(ms[i,j]) + ' '; // заношу в строку (можно убрать, т.к. делалось для проверки) inc(j); // передвигаемся вправо по матрице end; readln(f); // достигнут конец строки - переходим на следующую inc(i); j:=1;// передвигаемся в первый столбец следующей строки Memo1.Lines.Add(s); // заносим считанные числа, переведённые в строку, в мемо s:=''; // чистим строку end; CloseFile(f); // закрываем файл end; --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: 9-ый класс) Ответ отправлен: 18.05.2008, 10:47 Оценка за ответ: 5 Комментарий оценки: =)))

Вопрос № 137.244

Здравствуйте! Помогите, пожалуйста, решить 2 задачки: 1.Записи Имеется информация об итогах зимней сессии в гр . Написать программу, которая вводит эту информацию и печатает данные о "качестве" успеваемости, т.е. процент студентов, сдавших все экзамены на "4" и "5" 2.Функции и процедуры. Даны две квадратные матрицы n-го порядка. Напечатать ту из них у которой больше сумма элементов на побочной диагонали.

Отправлен: 17.05.2008, 18:24 Вопрос задала: Ljubchenka (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: SHERRY Здравствуйте, Ljubchenka! Решил первую задачку. Однако, вначале были непонятки: Вы говорите "Имеется информация об итогах..." А вот где она имеется: у Вас на листике или в файле на Вашем ПК - непонятно. Старайтесь писать условие как можно точнее. Я сделал ввод данных с клавиатуры. Код программы в приложении. Удачи! Приложение: const n = 5; {количество предметов на сессии} k = 3; {количество студентов} Type TStud = record {наш тип содержит} fio: string[50]; {имя студента} uspev: array [1..n] of byte; {оценки на сессии} good: boolean; {пометка хорошист (или отличник)} end; var ms: array [1..k] of TStud; {в этой переменной будем хранить данные} i,j: integer; {переменныая-счётчик} begin for i:=1 to k do {в цикле заполняем информацию о студентах} begin write('Vvesti FIO studenta #', i, ': '); readln(ms[i].fio); {считываем ФИО} writeln('Vvesti ', n, ' ocenok studenta ', ms[i].fio, ': '); ms[i].good := TRUE; {предполагаем изначально, что студент отличник :) } for j:=1 to n do {считываем оценки} begin readln(ms[i].uspev[j]); { записываем оценку по предмету номер j } ms[i].good := ms[i].good and ((ms[i].uspev[j] = 4) or (ms[i].uspev[j] = 5)); {вычисляем успеваемость студента} end; end; writeln; writeln('Oni sdali na "4" i "5": '); for i:=1 to k do {выводим результат запроса на экран} if ms[i].good then write(ms[i].fio, ' '); readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: 9-ый класс) Ответ отправлен: 18.05.2008, 08:00 Оценка за ответ: 4

Вопрос № 137.291

Уважаемые Эксперты!!!Я недавно начал программировать 3D графику при помощи библеотеки OpenGl.Растолкуйте мне пожалуйста что значит вектор UP в функции glulookat который задаётся 7-9 оргументами.За это буду вам очень признателен.

Отправлен: 18.05.2008, 01:10 Вопрос задал: Лукашик Юрий Аркадьевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Антон Александрович Волков Здравствуйте, Лукашик Юрий Аркадьевич! Вектор UP - это вектор положительного направления оси Y Обычно система координат в OpenGL выглядит так: ось X - слева направо ось Y - снизу вверх ось Z - от наблюдателя ("вглубь" экрана) Для изучения OpenGL, рекомендую установить бесплатный набор компонентов GLScene, который можно взять на http://glscene.org C помощью этих компонентов можно экспериментировать "в реальном времени" и видеть как влияют на конечный результат изменения параметров. Также, изучая исходники, можно решить многие "а как ...?", возникающие в процессе освоения OpenGL.

Ответ отправил: Антон Александрович Волков (статус: 2-ой класс) Ответ отправлен: 20.05.2008, 02:57

Вопрос № 137.321

Здравствуйте. У меня вопрос: при выполнении программы на выделенной строчке (!!..!!) возникает ошибка Project raised exception class EinvalidOp with message 'Invalid floating point operation'. что нужно делать , чтобы её устранить? Заранее благодарен Код перенесен в приложение. ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессор) ∙ Дата редактирования: 18.05.2008, 18:39 Приложение: var Form1: TForm1; type vec=array[1..10] of real; mas=array[1..10] of vec; var a:mas;b,x:vec; d:real; i,j,k,n:integer; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin n:=3; a[1,1]:=strtofloat(edit1.text); a[1,2]:=strtofloat(edit2.text); a[1,3]:=strtofloat(edit3.text); a[2,1]:=strtofloat(edit4.Text); a[2,2]:=strtofloat(edit5.Text); a[2,3]:=strtofloat(edit6.Text); a[3,1]:=strtofloat(edit7.Text); a[3,2]:=strtofloat(edit8.Text); a[3,3]:=strtofloat(edit9.Text); b[1]:=strtofloat(edit10.text); b[2]:=strtofloat(edit11.text); b[3]:=strtofloat(edit12.Text);for i:=1 to n-1 do begin for k:=i+1 to n do begin !! d:=a[k,i]/a[i,i];!! for j:=i+1 to n do a[k,j]:=a[k,j]-a[i,j]*d; b[k]:=b[k]-b[i]*d; end; end; for i:=n downto 1 do begin for j:=i+1 to n do b[i]:=b[i]-a[i,j]*x[j]; x[i]:=b[i]/a[i,i]; end; label20.caption:='x1='+floattostr(x[1]); label21.caption:='x2='+floattostr(x[2]); label22.caption:='x3='+floattostr(x[3]); end; end.

Отправлен: 18.05.2008, 12:04 Вопрос задал: Aptemka (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: PavelGM Здравствуйте, Aptemka! Invalid floating point происходит при потере значимой части (слишком близко к 0) или переполнении (деление на числа близкие к 0). Чтобы устранить проблему нужны проверки, что Abs(a[i,i]) больше, скажем 0.000001, или поставить секцию обработки исключений, например так Приложение: try d:=a[k,i]/a[i,i]; except d := 0.0; // или что там надо по условиям задачи end

Ответ отправил: PavelGM (статус: Студент) Ответ отправлен: 18.05.2008, 16:09

Вопрос № 137.371

Дана функция у=ах^2-2. Нужно построить график и координатную сетку с осями координат. "а" может быть и отрицательной. (P.S. скиньте весь код а то я сам не справлюсь. не рублю в дельфи)

Отправлен: 18.05.2008, 17:05 Вопрос задал: Андрей Радион (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Тимошенко Александр Васильевич Здравствуйте, Андрей Радион! График строится на компоненте TChart в интервале от х1 до х2 с шагом h var x1,a,x2,y,h:real; begin chart1.Series[0].Clear; x1:=strtofloat(edit1.Text); x2:=strtofloat(edit2.Text); h:=strtofloat(edit4.Text); a:=strtofloat(edit3.Text); while x1<=x2 do begin y:=a*x1*x1-2; Chart1.Series[0].AddXY(x1,y); x1:=x1+h; end; end;

Ответ отправил: Тимошенко Александр Васильевич (статус: 1-ый класс) Ответ отправлен: 19.05.2008, 15:34 Оценка за ответ: 5

Вопрос № 137.436

Помогите пожалуиста!!! Возникли проблемы с написанием программ: 1) нужно построить график ( y=1/sin x ) 2) график ( y=a/sin x ) Буду очень благодарен за вашу помощь!!!!!!!!!!!!! (Если не трудно, было бы очень хорошо если программы будут сделаны не в консоле, а будут иметь вид типо : окно с кнопкой "постройть график такой-то") Ещё раз спасибо, очень выручите!!!!!!!!!!!!!!!

Отправлен: 19.05.2008, 00:09 Вопрос задал: Mica Antoni (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Тимошенко Александр Васильевич Здравствуйте, Mica Antoni! графики строятся на компоненте TChart в интервале от Х1 до Х2 с шагом h y=1/sinx var x1,x2,y,h:real; begin chart1.Series[0].Clear; x1:=strtofloat(edit1.Text); x2:=strtofloat(edit2.Text); h:=strtofloat(edit4.Text); while x1<=x2 do begin y:=1/sin(x1); Chart1.Series[0].AddXY(x1,y); x1:=x1+h; end; y:=a/sinx var x1,a,x2,y,h:real; begin chart1.Series[0].Clear; x1:=strtofloat(edit1.Text); x2:=strtofloat(edit2.Text); h:=strtofloat(edit4.Text); a:=strtofloat(edit3.Text); while x1<=x2 do begin y:=a/sin(x1); Chart1.Series[0].AddXY(x1,y); x1:=x1+h; end; end;

Ответ отправил: Тимошенко Александр Васильевич (статус: 1-ый класс) Ответ отправлен: 19.05.2008, 15:31

Вопрос № 137.451

Здравствуйте! Имееться ASCII-файл с разделителями и состоит из записей. Как можно перекодировать в делфи для дальнейшего использования(надо будет в нём читать построчно и искать нужное)?

Отправлен: 19.05.2008, 06:03 Вопрос задал: Иванов Дмитрий Иванович (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Santa Здравствуйте, Иванов Дмитрий Иванович! Нужно создать структурированный файл. для этого нужно описать свой тип. Код который я привел использовался для БД. если нужно более подробно пиши. Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,menus; type TForm1 = class(TForm) Button1: TButton; Edit1: TEdit; Edit2: TEdit; Edit3: TEdit; procedure FormActivate(Sender: TObject); procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; type //задаем свой тип Basa = record //запись nameUser:string[20]; //1ое поле записи fnameUser:string[20]; //2ое поле записи altnameUser:string[20]; //3е поле записи end; FileBase= file of basa; //типизированный файл var Form1: TForm1; MyBasa:FileBase; dat:basa; implementation {$R *.dfm} procedure TForm1.FormActivate(Sender: TObject); //подключение базы при активации формы begin assignFile (MyBasa,'c:1.dat'); reset(MyBasa); end; procedure TForm1.Button1Click(Sender: TObject); //добавление записи begin dat.nameUser:=edit1.Text; dat.fnameUser:=edit2.Text; dat.altnameUser:=edit3.Text; assignFile (MyBasa,'c:1.dat'); reset(MyBasa); seek(MyBasa,filesize(MyBasa)); //находим последнюю запись (можно задать любую строку) write(MyBasa,dat); //записываем в конец файла closefile(MyBasa); end; end.

Ответ отправил: Santa (статус: 1-ый класс) Ответ отправлен: 19.05.2008, 08:58 Оценка за ответ: 5

Отвечает: PavelGM Здравствуйте, Иванов Дмитрий Иванович! Можно еще так (если записи разделены переводом каретки): // 1. Загрузка данных строками LS := TStringList.Create; LS.LoadFromFile(); // 2. Обработка построчно (для примера вывод на экран в диалог) for i := 0 to LS.Count-1 do ShowMessage(LS[i]); // 3. Освобождение строк LS.Free; Если записи сплошным текстом, а разделитель например ",", то чуть посложней - LS := TStringList.Create; LS.LoadFromFile(); LS.CommaText := LS.Text; Правда при этом кроме запятых, разделителем являются также и пробелы. Для более точного управления выбором разделителей используйте свойства Delimeter и DelimitedText объекта StringList. Если и запятые, и переводы каретки - то комбинируйте приведенные выше способы, используя два StringList.

Ответ отправил: PavelGM (статус: Студент) Ответ отправлен: 19.05.2008, 17:33 Оценка за ответ: 5

Вопрос № 137.471

В Delphi есть компонент использующий движок IE для просмотра сайтов, а есть ли альтернатива?

Отправлен: 19.05.2008, 11:12 Вопрос задал: Романов Александр Вячеславович (статус: 1-ый класс) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Raptor3 Здравствуйте, Alexo! EmbeddedWB - расширенный вариант движка IE - на мой взгляд лучший http://www.bsalsa.com/index.html --------- Программист - это человек который решает проблему, о которой вы не знаете, способом который вы не понимаете

Ответ отправил: Raptor3 (статус: 8-ой класс) Ответ отправлен: 19.05.2008, 12:33 Оценка за ответ: 5 Комментарий оценки: Спасибо

Отвечает: Gaolong Здравствуйте, Alexo! Есть TwebBrowser на закладке internet. Эллемент управления ACTIVEX,входит в склад Microsoft Internet Explorer. Тоесть, этот компонент есть на любом компьютере, где есть Microsoft Internet Explorer, тоесть почти в каждом.

Ответ отправил: Gaolong (статус: 1-ый класс) Ответ отправлен: 19.05.2008, 22:05 Оценка за ответ: 1 Комментарий оценки: я спрашивал про альтернативу ему, а не где и что он такое.

Вопрос № 137.567

Добрый день уважаемые эксперты. Тупо не пойму в чем может быть проблема. Пишу программу, отображающую время в разных часовых поясах в зависимости от системного времени: procedure TForm1.Timer2Timer(Sender: TObject); var GrinvichSTime : tsystemtime; GrinvichDtime : tdatetime; begin getsystemtime(GrinvichSTime); //получаю время по Гринвичу grinvichDtime:=SystemTimeToDateTime(GrinvichSTime); // label1.Caption:='Лондон '+formatdatetime('hh:mm:ss',grinvichDtime); // Лондон label2.Caption:='Париж '+formatdatetime('hh:mm:ss',grinvichDtime+1/24);//прибавляю час Париж label3.Caption:='Стамбул '+formatdatetime('hh:mm:ss',grinvichDtime+2/24);//прибавляю два Стамбул label4.Caption:='Москва '+formatdatetime('hh:mm:ss',grinvichDtime+3/24);//прибавляю три Москва // и так далее end; программа выводит на экран Лондон 10:00 Париж 11:00 Стамбул 12:00 Москва 13:00 Системное время на компьютере 14:00 часовой пояс Москва GMT+3 Ставлю часовой пояс Гринвич GMT 0 системное время 11:00, а программа показывает 10:00 по Гринвичу. Вопрос: Почему время по Гринвичу на 4 часа меньше чем текущее системное, хотя должно быть на 3 часа меньше и соответственно московское время на час меньше, чем текущее системное в первом случае и откуда разница в 1 час во втором? Где у меня ошибка? Подскажите, пожалуйста, правильный алгоритм, для решения моей задачи или ссылку на пример. Заранее всем спасибо.

Отправлен: 19.05.2008, 22:03 Вопрос задал: Perlena (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: PavelGM Здравствуйте, Perlena! Да у вас почти все правильно, просто: The system time is expressed in Coordinated Universal Time (UTC). Т.е. системное время выдается в универсальном времени, привязанном к координатам, а сейчас лето и все, включая Лондон, перевели стрелки на летнее время. Вот и кажущаяся проблема. Могу предложить для коррекции и понимания ситуации воспользоваться функцией Win32 GetTimeZoneInformation - из нее можно получить информацию и о StandardDate и о DaylightDate и смещение для текущих настроек в минутах (далеко не всегда смещение в целых часах - например, Кабул +4:30 или Аделаида +9:30).

Ответ отправил: PavelGM (статус: Студент) Ответ отправлен: 19.05.2008, 23:07

Вопрос № 137.614

Здравствуйте, уважаемые эксперты. На форме лежит TPageControl, у которого есть контекстное меню. Как сделать так, чтобы при нажатии на правую кнопку мыши над PageControl'ом сначала активизировалась закладка, находящаяся под курсором, а потом появлялось как обычно контекстное меню компонента? Спасибо за ответы.

Отправлен: 20.05.2008, 12:09 Вопрос задал: Alexander L. (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Louken Здравствуйте, Alexander L.! Код в приложении. Только учтите, что задавать свойство PopupMenu у PageControl не надо, вызывать контекстное меню будет обработчик события OnMouseDown. Приложение: //Подключение обязательно uses CommCtrl; //Получение номера закладки над которой находится курсор function ItemAtPos(PageControlHandle: HWND; X, Y: Integer): Integer; var Info: TTCHitTestInfo; begin Info.pt.x:=X; Info.pt.y:=Y; Info.flags:=0; Result:=SendMessage(PageControlHandle, TCM_HITTEST, 0, Longint(@Info)); end; //При щелчке на PageControl1 становиться активной та закладка, на которой был щелчок procedure TForm1.PageControl1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var num: Integer; begin //Реагируем только на правую клавишу мыши if button=mbRight then begin //Получаем номер закладки num:=ItemAtPos(PageControl1.Handle, x, y); //Устанавливаем ее активной PageControl1.ActivePageIndex:=num; //Показываем контекстное меню With PageControl1.ClientToScreen(point(X, Y)) do PopupMenu1.Popup(X, Y); end; end;

Ответ отправил: Louken (статус: Студент) Ответ отправлен: 20.05.2008, 19:59

Вопрос № 137.642

Здраствуйте, я знаю что тут много умных людей, которые могут помочь новичку. Помогите пожалуйста составить программу на delphi (задача на моделирование): "Услуги телефонной сети оплачиваются по следующему правилу: за разговоры до A минут в месяц оплачивают B рублей, а разговоры сверх установленной нормы оплачиваются из расчета C рублей в минуту. Напишите программу, вычисляющую оплату за телефонные разговоры."

Отправлен: 20.05.2008, 15:42 Вопрос задал: Сараев Лаврентий Александрович (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Владик Здравствуйте, Сараев Лаврентий Александрович! t:integer; //всего минут St:integer; // Итоговая стоимость a,b,c: integer; //исходные данные if a<t then St:=a*b+(t-a)*c else St:=a*b;

Ответ отправил: Владик (статус: 2-ой класс) Ответ отправлен: 20.05.2008, 16:02 Оценка за ответ: 4 Комментарий оценки: Спасибо, но немогли бы Вы написать куда и что вставлять? P.S. Вообще то это не на "4" а на "3" ИМХО, но всетаки помочь хотели...

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Сараев Лаврентий Александрович! Код в приложении. На форме 5 LabeledEdit'ов (аналог обычного Edit'а, но только с подписью) и кнопка. В Edit'ы вводятся значения A, B, C, минуты и выводится результат. Главное в программе это условный оператор, он имеет такой вид: if условие then  //Это выполняется если условие верно else  //Это если условие не выполняется Часть else может быть отпущена, тогда если условие не выполняется, то программа просто продолжит работу. Вот пример: procedure ifTest; var   b: bool; begin   b:= false;   if b=true then     ShowMessage('b=true')   else     ShowMessage('b=false'); end; Здесь мы объявляем логическую переменную b и присваиваем ей false потом проверяем равна ли она true, если равна, то показываем сообщение b=true, иначе b=false. Т.к. в начале программы мы присвоили b false, то всегда будет выполнятся то что стоит за else. Удачи!!! Приложение: unit Unit2; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls; type TForm2 = class(TForm) eA: TLabeledEdit; eC: TLabeledEdit; eB: TLabeledEdit; EMin: TLabeledEdit; bFind: TBitBtn; eRes: TLabeledEdit; procedure bFindClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form2: TForm2; implementation {$R *.dfm} procedure TForm2.bFindClick(Sender: TObject); var //Здесь хранятся A, B, C, кол-во минут и оплата a, b, c, min, sum: integer; begin //Получаем значения A, B, C из Edit'ов a:=StrToInt(eA.Text); b:=StrToInt(eB.Text); c:=StrToInt(eC.Text); //Получаем кол-во минут min:=StrToInt(eMin.Text); //Если минут больше A, то C рублей в минуту if Min > a then sum:=min*c else //Иначе B рублей в минуту sum:=min*b; //Выводим рез-тат eRes.Text:=IntToStr(sum); end; end. Код в приложении. На форме 5 LabeledEdit'ов(аналог обычного Edit'а, но только с подписью) и кнопка. В Edit'ы вводятся значения A, B, C, минуты и выводится результат. Главное в программе это условный оператор, он имеет такой вид: if условие then //Это выполняется если условие верно else //Это если условие не выполняется Часть else может быть отпущена, тогда если условие не выполняется, то программа просто продолжит работу. Вот пример: procedure ifTest; var b:bool; begin b:=false; if b=true then ShowMessage('b=true') else ShowMessage('b=false'); end;

Ответ отправил: Абельхарисов Руслан / Marked One (статус: Студент) Ответ отправлен: 20.05.2008, 22:18

Вопрос № 137.649

Здравствуйте! Очень необходима Ваша помощь. Пишу курсовую работу, нужно создать в делфи текстовый редактор с подсветкой HTML синтаксиса. Сам простенький блокнот я написал, а вот как сделать подсветку тегов не понимаю. Многие рекомендуют использовать SynEdit, но я не понимаю, как прикрутить подсветку из SynEdit к моему memo1. Пожалуйста, помогите это сделать, курсовую уже сдавать надо, а я все сижу, бьюсь, но не получается. Вот ссылка на SynEdit: http://sourceforge.net/project/showfiles.php?group_id=3221&package_id=86350 Заранее огромное спасибо! Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus, ComCtrls; type TForm1 = class(TForm) MainMenu1: TMainMenu; A1: TMenuItem; N1: TMenuItem; N2: TMenuItem; N3: TMenuItem; N4: TMenuItem; N5: TMenuItem; N6: TMenuItem; N7: TMenuItem; N8: TMenuItem; N9: TMenuItem; N10: TMenuItem; N11: TMenuItem; N12: TMenuItem; OpenDialog1: TOpenDialog; SaveDialog1: TSaveDialog; Memo1: TMemo; procedure N1Click(Sender: TObject); procedure N5Click(Sender: TObject); procedure N2Click(Sender: TObject); procedure N3Click(Sender: TObject); procedure N12Click(Sender: TObject); procedure N8Click(Sender: TObject); procedure N9Click(Sender: TObject); procedure N10Click(Sender: TObject); procedure N7Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation uses Unit2; {$R *.dfm} procedure TForm1.N1Click(Sender: TObject); begin Memo1.Lines.Clear; // Очищаем строки Memo Form1.Caption:=('HTML Editor'); // Востанавливаем заголовок формы. end; procedure TForm1.N5Click(Sender: TObject); begin Close; end; procedure TForm1.N2Click(Sender: TObject); begin If OpenDialog1.Execute Then // Открываем диалоговое окно If OpenDialog1.Filename<>'' Then Begin Memo1.Lines.LoadFromFile(OpenDialog1.Filename); // Загружаем файл в Memo Form1.Caption:=(OpenDialog1.Filename+' - HTML Editor'); // Добавляем имя файла в заголовок. End; end; procedure TForm1.N3Click(Sender: TObject); begin IF SaveDialog1.Execute then // Открываем диалоговое окно IF SaveDialog1.Filename<>'' then Begin Memo1.Lines.SaveToFile(SaveDialog1.Filename); Form1.Caption:=(SaveDialog1.Filename+' - HTML Editor'); // Добавляем имя файла в заголовок. End; end; procedure TForm1.N12Click(Sender: TObject); begin Form2.Visible:=true; end; procedure TForm1.N8Click(Sender: TObject); begin Memo1.CutToClipBoard; //Вырезаем выделенный текст в буфер обмена end; procedure TForm1.N9Click(Sender: TObject); begin Memo1.CopyToClipBoard; // Копируем текст в буфер обмена end; procedure TForm1.N10Click(Sender: TObject); begin Memo1.PasteFromClipBoard; // Вставляем текст из буфера обмена end; procedure TForm1.N7Click(Sender: TObject); begin Memo1.SelectAll; // Выделяем весь текст end; end.

Отправлен: 20.05.2008, 18:18 Вопрос задал: Soontir (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Soontir! На закладке SynEdit есть компоненты SynMemo и SynEdit, ставьте любой из них на форму, с закладки SynEdit Highlighters поставьте на форму TSynHTMLSyn. В свойстве SynMemo(SynEdit) Highlighter укажите компонент TSynHTMLSyn. Все, подсветка подключена. Свойство Gutter.ShowLineNumbers отвечает за показ номеров строк. Удачи!!!

Ответ отправил: Абельхарисов Руслан / Marked One (статус: Студент) Ответ отправлен: 20.05.2008, 22:57

Вопрос № 137.815

Здравствуйте Уважаемые эксперты. Как обратиться к открытой в браузере странице (скажем в IE) из программы Delphi (процедурой например на нажатие клавиши), чтобы эта страница имелась в memo или еще где (в виде кода html или откомпилированная), чтобы после считать текстовую информацию из тегов. Заранее благодарен за проявленное внимание к моей проблеме. Буду признателен, если дадите скорый ответ (дипломирование как ни как).

Отправлен: 21.05.2008, 21:58 Вопрос задал: Bartonfink (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Raptor3 Здравствуйте, Bartonfink! Вот хорошая статья как подключиться к IE http://www.delphikingdom.com/asp/viewitem.asp?catalogid=1134 --------- Программист - это человек который решает проблему, о которой вы не знаете, способом который вы не понимаете

Ответ отправил: Raptor3 (статус: 8-ой класс) Ответ отправлен: 22.05.2008, 06:11

© 2001-2008, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале ∙ Версия системы: 4.92 pre 5.0 RC2 от 09.05.2008
RusFAQ.ru | MosHoster.ru | MosDesigner.ru | RusIRC.ru Kalashnikoff.ru | RadioLeader.ru | RusFUCK.ru