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

Выпуск № 788
от 22.04.2007, 20:35

Вопрос № 82.866

Как определить сколько Мб на видеокарте?

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

Отвечает: PGM Здравствуйте, AndrewSOOF! Я пользуюсь таким методом - инициализировать DirectDraw и спросить у него GetCaps, там в структуре TDDCaps есть dwVidMemTotal. Есть еще и сколько свободной - dwVidMemFree и много другой интересной информации.

Ответ отправил: PGM (статус: 5-ый класс) Ответ отправлен: 17.04.2007, 00:26 Оценка за ответ: 3 Комментарий оценки: Не совсем понятно как инициализировать DirectDraw

Отвечает: Gh0stik Здравствуйте, AndrewSOOF! Вот привожу Вам кусок кода который показывает объем видео карты, а также количество свободного пространства в текущий момент: var DDC,DDH:TDDCaps; pDirDraw: IDirectDraw; HR : HResult; begin pDirDraw := nil; DDC.dwSize := sizeof(TDDCaps); DDH.dwSize := sizeof(TDDCaps); HR := DirectDrawCreate(nil, pDirDraw, nil); if(HR <> DD_OK) then ShowMessage('ERROR'); HR := pDirDraw.GetCaps(@DDC, @DDH); if(HR <> DD_OK) then ShowMessage('ERROR'); ShowMessage(Format('Total=%d',[DDC.dwVidMemTotal])+#13+Format('Free=%d',[DDC.dwVidMemFree ])); end; Данный код возвращает объем видеопамяти в байтах, поэтому чтобы получить размер в килобайтах результат нужно разделить на 210, а для мегабайт на 220. Также пусть Вас не смущает то что результат будет немного меньше чем тот который показывается в диспетчере устройств, поскольку из справки по данной структуре видим: dwVidMemTotal Total amount of display memory on the device, in bytes, minus the memory reserved for the primary surface and any private data structures reserved by the driver. (This value is the same as the total video memory reported by the IDirectDraw::GetAvailableVidMem method.) Т.е. определенный размер зарезервирован под драйвер. Да и также не забудьте подключить модули: uses DXTypes, DirectDraw; Для того чтобы модули работали нормально нужно также подключить заголовочные файлы DirectX, найти их можно в сети (если не найдете обращайтесь вышлю), а подключаются они путем выполнения таких действий: меню Tools\Environment Options\Library\Library path\ кнопка(...)\прописать путь и нажать Add. Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Профессионал) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) ICQ: 289363162 ---- Ответ отправлен: 18.04.2007, 23:38

Вопрос № 82.882

будьте добры рассудите эту задачку. нужно подсчитать след матрицы. кто неуверен в точности понимания этого математического понятия обьясю самим заданием. Для заданной квадратной матрицы сформировать одномерный массив из ее диагональных элементов. Найти след матрицы, суммируя элементы одномерного массива. Матрицу ввести с клавиатуры. я пытался сделать то что нужно в задании но не получается. просто недодумал procedure TForm1.Button1Click(Sender: TObject); var i,j: integer; sl: integer; begin // это 1 диагональ for i:=0 to stringGrid1.ColCount do for i:=0 to stringGrid1.RowCount do sl:=sl+ stringGrid1.Cells[i,j]; //вторую я не придумал +) первая еще не работает даже end; end; будьте добры подскажите как это можно реализовать

Отправлен: 17.04.2007, 01:23 Вопрос задал: 12rus (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Gh0stik Здравствуйте, 12rus! Во-первых если Вы начинаете с нуля то необходимо на один меньше ставить и вторую границу. Далее Вы не проверяете что элементы стоят на диагонали. Смотрите исправления. procedure TForm1.Button1Click(Sender: TObject); var i,j: integer; sl: integer; begin sl:=0; for i:=0 to stringGrid1.ColCount-1 do for j:=0 to stringGrid1.RowCount-1 do sl:=sl+ stringGrid1.Cells[i,j]; if i=j then sl:=sl+ stringGrid1.Cells[i,j]; end; end; {а вот ввод с клавиатуры можно организовать примерно так} const n=3; var a:array [1..n,1..n] of integer; ........ procedure TForm1.Button3Click(Sender: TObject); var i,j: integer; begin for i:=0 to n-1 do for j:=0 to n-1 do a[i,j]:=strtoint(InputBox('Input array', format('A[%d%d]',[i,j]),'')); end; Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Профессионал) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) ICQ: 289363162 ---- Ответ отправлен: 17.04.2007, 01:42

Вопрос № 82.900

Уважаемые эксперты! Подскажите, как сделать чтобы процедура выполнялась в фоне, т.е. по нажатию на кнопку отправляется почта и пока почта не отправится я с формой (и на форме) ничего не могу изменить, как исправит эту проблему?

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

Отвечает: PGM Здравствуйте, Bee.line! Вот пара способов: 1. Использовать ожидание в цикле по флагу и Application.ProcessMessages, например так (пример из кода, который как раз почту отправляет) FSending := True; FError := False; while FSending and not FError do begin Application.ProcessMessages; Sleep(1000); end; FSending снимается при отсылке, FError ставится в обработке ошибок сокета или при нажатии на кнопку "Прервать" (чтобы не застрять в цикле навсегда :)) 2. Использовать потоки и ожидание события завершения потока - по похожей схеме, только с WaitForSingleObject вместо флага отсылки Приложение:

Ответ отправил: PGM (статус: 5-ый класс) Ответ отправлен: 17.04.2007, 10:35 Оценка за ответ: 2 Комментарий оценки: Ответ 1. Бесмысленен, так как он опять таки будет ждать пока почта (физически) отправится и следовательно прога будет подвисать

Вопрос № 82.927

Доброго времени суток! код с проблемой в приложении. если DateAction ставить сегодняшним или датой раньше то все нормально работает. Если ставлю дату завтрашней и время, допустим 10:00:00, то срабатывает по дате правильно а по времени в 1:00:00. проверка идет по таймеру каждую секунду. Приложение: var DateAction, TimeAction:TDateTime; ... if DateToStr(DateAction)<DateToStr(Now) then DoIt else begin if DateToStr(DateAction)=DateToStr(Now) then if TimeToStr(TimeAction)<=TimeToStr(Now) then DoIt; end;

Отправлен: 17.04.2007, 11:26 Вопрос задал: Dush (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 5)

Отвечает: Сухомлин Кирилл Владимирович Здравствуйте, Dush! Как уже было сказано, делаете вы сравнение достаточно криво. Однако, иногда такое может быть нужно. Например, я делал на базе TStringList класс "расписание", записывая время в самое начало строки. Использовать готовое сравнение строк и готовую сортировку TStringList проще, чем писать что-то свое. Впрочем, такие трюки эффективны, когда вы уже хорошо знаете как работают стандартные функции, как сравниваются строки и уже не задаете подобные вопросы. Теперь по сути. Надо использовать преобразование даты к типу с определенным типом форматировнания. Как это сделать, можно почитать тут. И хотя в статье написано, что значение по умлочанию для LongTimeFormat = 'hh:mm:ss';. Это чушь. Хотя бы потому, что буква 'm' предназначена для месяцев, а 'n' — для минут. Так вот, вам надо сделать следующее: ShortTimeFormat := 'hh:nn'; LongTimeFormat := 'hh:nn:ss'; Остальные детали использования этой функции можете прочесть в статье. там не все чушь ;-) --------- Не узнаешь - не попробуешь.

Ответ отправил: Сухомлин Кирилл Владимирович (статус: Специалист) Ответ отправлен: 17.04.2007, 12:20

Вопрос № 82.960

Доброе время суток. Подскажите пожалуйсто, как с помощью компонента TImage сделать некю кнопку. Т.е. хочу сделать чтобы при наведении мыши на кнопку картинка в компоненте менялась на другую, при уходе мыши с компонента картинка опять востанавливалась, и чтобы картинки были в TImageList Спасибо.

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

Отвечает: Gladiator Здравствуйте, Глеб! Додумаешь указаный ниже код под свою задачу: Огромный исходник перенесён в приложение. (Ерёмин А.) Приложение: unit Unit1; interface uses Windows, Classes, Graphics, Forms, ExtCtrls, GIFImage, SysUtils, StdCtrls, Controls, Messages; type TMyImage = class(TImage) public procedure CMMouseEnter(var msg:TMessage); message CM_MOUSEENTER; procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE; end; type TForm1 = class(TForm) Label1: TLabel; procedure FormShow(Sender: TObject); procedure ImageClick(Sender: TObject); procedure ImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ImageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private procedure SetText(const FontColor: TColor; Image: TImage); public end; var Form1: TForm1; Image2: TMyImage; resourcestring HintText='Информация о компьютере'; BtnText='INFO'; implementation {$R *.dfm} {$R bmp.res} procedure TMyImage.CMMouseEnter(var Msg:TMessage); begin inherited; Form1.SetText(clBlue,Image2) end; procedure TMyImage.CMMouseLeave(var Msg: TMessage); begin inherited; Form1.SetText(clBlack,Image2) end; procedure LoadBMPImage(Instance: cardinal; const ResName: PChar; Image: TImage); var Picture: TBitmap; begin try Picture:=TBitmap.Create; Picture.LoadFromResourceName(Instance,ResName); Image.Picture.Assign(Picture) finally Picture.Free end; end; procedure TForm1.FormShow(Sender: TObject); begin Image2:=TMyImage.Create(Self); with Image2 do begin Parent:=Form1; AutoSize:=true; Top:=10; Left:=10; Hint:=HintText; ShowHint:=true; OnMouseDown:=ImageMouseDown; OnMouseUp:=ImageMouseUp; OnClick:=ImageClick; end; LoadBMPImage(hInstance,'ID_BMP1',Image2); SetText(clBlack,Image2) end; const osName: array[1..3] of string = ('NT','2000','XP'); var F: function(lpBuffer: PChar; var nSize: DWORD): BOOL; stdcall; procedure TForm1.ImageClick(Sender: TObject); var Buff: PChar; PCInfo: array[1..15] of string; Version: OSVERSIONINFO; i,j,bSize: cardinal; begin i:=1; for j:=1 to 2 do begin bSize:=15; FillChar(Buff,0,bSize); case j of 1: F:=GetComputerName; 2: F:=GetUserName; end; if F(Buff,bSize) then PCInfo[j]:=StrPas(Buff); end; Buff:=nil; with Version do begin dwOSVersionInfoSize:=Sizeof(OSVERSIONINFO); if GetVersionEx(Version) then begin Case dwMajorVersion of 5: if dwMinorVersion = 0 then i:=2 else i:=3; end; PCInfo[3]:=#9+'Microsoft Windows '+osName[i]+ #13#10#9#9+IntToStr(dwMajorVersion)+'.0'+ IntToStr(dwMinorVersion)+'.'+IntToStr(dwBuildNumber)+ #13#10#9#9+szCSDVersion; end; end; Label1.Caption:=Format('Компьютер '+#9+'%s'+#13#10+'Пользователь '+#9+'%s'+ #13#10+'ОС '+#9+'%s',[PCInfo[1],PCInfo[2],PCInfo[3]]); end; procedure TForm1.ImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbLeft then begin LoadBMPImage(hInstance,'ID_BMP2',TImage(Sender)); Form1.SetText(clBlue,Image2) end; end; procedure TForm1.ImageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbLeft then begin LoadBMPImage(hInstance,'ID_BMP1',TImage(Sender)); Form1.SetText(clBlue,Image2) end; end; procedure TForm1.SetText(const FontColor: TColor; Image: TImage); var Size: tSize; OffSet: DWord; begin Size:=Image.Canvas.TextExtent(BtnText); Offset:=MakeWord((Image.Height - Size.cy) div 2, (Image.Width - Size.cx) div 2); Image.Canvas.Brush.Color := clBtnFace; Image.Canvas.Font.Color := FontColor; Image.Canvas.TextOut(Hi(OffSet),Lo(OffSet),BtnText); end; end.

Ответ отправил: Gladiator (статус: 9-ый класс) Ответ отправлен: 17.04.2007, 15:40

Отвечает: Dragon Здравствуйте, Глеб! Можно, например, так: procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin Image1.Picture.LoadFromFile('C:end; procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin image1.Picture.LoadFromFile('C:end;

Ответ отправил: Dragon (статус: 1-ый класс) Ответ отправлен: 17.04.2007, 15:41

Отвечает: PGM Здравствуйте, Глеб! У TImage есть событие OnMouseMove, его и надо отлавливать и делать нужную картинку (и ставить флаг какая из картинок сейчас, чтобы не делать лишнюю работу и ничего не мигало). Не забывайте Image.Invalidate. OnMouseDown/OnMouseUp позволят работать как кнопка. Из TImageList получать картинку можно с помощью ImageList.GetBitmap(Index, ABmp), где ABmp - временный битмап или Image.Picture.Bitmap, если он инициализирован (есть картинка или установлены размеры).

Ответ отправил: PGM (статус: 5-ый класс) Ответ отправлен: 17.04.2007, 16:09

Отвечает: Werewolf Здравствуйте, Глеб! Если у вас Delphi 6-7: прийдется переопределять WndProc главной формы для перехвата сообщений входа и выхода курсора в пределы Image Если более новая версия: см. Приложение. на главной форме ImageList1: TImageList; Panel1: TPanel; на панели Image1: TImage; Панель используется для эмуляции втапливания кнопки при нажатой кнопке мыши. ImageList1 содержит 4 картинки 16*16 Image1.Height и Image1.Width=16; Panel1.Autosize=true Удачи. Приложение: unit main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, ImgList; type TForm1 = class(TForm) Image1: TImage; ImageList1: TImageList; Panel1: TPanel; procedure Image1MouseEnter(Sender: TObject); procedure Image1MouseLeave(Sender: TObject); procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private procedure SetImageButton(ImageIndex: integer); public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin SetImageButton(2); Panel1.BevelInner := bvLowered; end; procedure TForm1.Image1MouseEnter(Sender: TObject); begin SetImageButton(0); end; procedure TForm1.Image1MouseLeave(Sender: TObject); begin SetImageButton(1); end; procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin SetImageButton(3); Panel1.BevelInner := bvNone; end; procedure TForm1.SetImageButton(ImageIndex: integer); begin Image1.Picture.Bitmap.Canvas.FillRect(Image1.ClientRect); ImageList1.GetBitmap(ImageIndex, Image1.Picture.Bitmap); Image1.Update; end; end.

Ответ отправил: Werewolf (статус: Студент) Ответ отправлен: 17.04.2007, 16:30

Вопрос № 82.961

Здраствуйте уважаемые эксперты. Меня интересует несколько вопросов. 1) Как можно передовать параметры фрейму. 2) У меня есть небольшая програмка в ней всего 1 форма и 2 фрейма. На Форме я создаю программно фрейм(CurrentFrame). При показе формы я включаю 1 фрейм смотреть приложение. Мне необходимо при нажати на 1 фрейме кнопки закрыть его нормально и показать 2 фрейм Приложение: if Assign(CurrentFrame) then FreeandNil(CurrentFrame) CurrentFrame :=TFrame2.Create(nil);

Отправлен: 17.04.2007, 14:58 Вопрос задал: CoolBick (статус: 1-ый класс) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Лукьяненко Алексей Валериевич Здравствуйте, CoolBick! 2. Вам нужно указать родительское окно для нового фрейма (окно, на котором будет отображаться фрейм), а также желательно указать владельца (того, кто удалит фрейм при завершении приложения, если Вы этого не сделаете явно): if Assigned(CurrentFrame) then FreeandNil(CurrentFrame) CurrentFrame :=TFrame2.Create(Self); CurrentFrame.Parent := Self; // Устанавливаем родительское окно 1. Смотря как Вам нужно передать параметры... Можно перекрыть (или объявить свой) конструктор и передавать ему нужные парметры, а можно создать фрейм и настроить его свойства

Ответ отправил: Лукьяненко Алексей Валериевич (статус: 8-ой класс) Ответ отправлен: 17.04.2007, 15:16 Оценка за ответ: 3

Отвечает: Химяк Виктор Васильевич Здравствуйте, CoolBick! У меня есть прекрасная статья по роботе с фреймами, изучив ее, я сам активно применяю фреймы. Статья в Word, могу скинуть. Выдержка в приложении, но без полного текста возможно будет трудно понять.Сама статья: Применение фреймов для написания “правильных” приложений Автор: Жук Андрей Приложение: unit UnitFrameBase; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, shellapi, DB, DBGrids, UnitConstTypes_etc; type TFrameBase = class(TFrame) private {описание фрейма - для вывода в заголовке программы} FrameDescription: string; {основной источник данных} FrameCurrentDataSet: TDataSet; {флаг загрузки данных} LoadingData: Boolean; {флаг выполнения длительной работы - например генерации очень большого отчёта} MakeLongTimeWork: Boolean; public { функция, выполняющаяся сразу после создания фрейма} procedure InitialisationFrame(Param1, Param2: Integer); virtual; { виртуальная функция фильтра данных } procedure Filter(Param1, Param2: Integer); virtual; { виртуальная функция показа дополнительной информации} procedure ShowAdditionalInformation(); virtual; { виртуальная функция скрытия/показа наследуемых контролов} procedure ShowContols(); virtual; { виртуальная функция открытия наборов данных (подключения к уже открытым} procedure OpenNeededTables(Param1, Param2: Integer); virtual; {процедуры работы с наборами данных} {добавление} function AddRecord(): TFunctionResult; virtual; {редактирование} function EditRecord(): TFunctionResult; virtual; {удаление} function DeleteRecord(): TFunctionResult; virtual; {Сохранить} function PostRecord(): TFunctionResult; virtual; {Отменить} function CancelRecord(): TFunctionResult; virtual; {Открыть свойства} function GetProperty(): boolean; virtual; {функции экспорта в различные форматы} function ExportData(Parameter: string): TFunctionResult; virtual; {функции импорта из различных форматов} function ImportData(Parameter: string): TFunctionResult; virtual; {Комментарий: функции записи/чтения заголовка фрейма} function GetDesc: string; procedure SetDesc(Description: string); {Процедуры перехода к следующей, предыдущей, первой, последней записи} procedure GotoNextElement; virtual; procedure GotoPrevElement; virtual; procedure GotoFirstElement; virtual; procedure GotoLastElement; virtual; {функция, возвращающая главный Grid фрейма} function GetMainGrid: TDBGrid;virtual; {функции установки состояния загрузки данных} procedure SetLoadingData(LD: boolean); function GetLoadingData: boolean; {функции установки состояния длительного процесса} procedure SetMakeLongTimeWork (LTW: boolean); function GetMakeLongTimeWork : boolean; {функции возвращающие текущий источник данных} procedure SetFrameCurrentDataSet(DS: TDataSet); function GetFrameCurrentDataSet: TDataSet; {виртуальный деструктор} destructor Destroy;override; {процедуры записи/чтения настроек фрейма в файлы} {эти процедуры не вызываются автоматически в конструкторах/деструкторах} {вызов этих функций лучше покласть на процедуру вывода фрейма} function SaveFrameToFile(FileName: TFileName): TFunctionResult; virtual; function LoadFromFileToFrame(FileName: TFileName): TFunctionResult; virtual; published {описание фрейма – для отображения режима в заголовке} property FrameDesc: string read GetDesc write SetDesc; end; implementation uses UnitFormMain, MyDBGrid; {$R *.dfm} procedure TFrameBase.ShowAdditionalInformation(); begin //---в принципе часто нужно что-то помещать в статусбар end; procedure TFrameBase.Filter(Param1, Param2: Integer); begin //---фильтрация текущего набора данных //---два параметра передаются через SendMessage end; procedure TFrameBase.ShowContols(); begin //---чтобы скрывать/отображать нужные в текущем режиме контролы end; procedure TFrameBase.OpenNeededTables(Param1, Param2: Integer); begin // по умолчанию откроем текущий датасет фрейма if Assigned(FrameCurrentDataSet) then FrameCurrentDataSet.Active := true; end; procedure TFrameBase.InitialisationFrame(Param1, Param2: Integer); begin //------------- SetLoadingData(true); //откроем нужные таблицы OpenNeededTables(Param1, Param2); //отфильтруем их Filter(Param1, Param2); //покажем нужные контролы ShowContols; SetLoadingData(false); end; {процедуры работы с наборами данных} {добавление} function TFrameBase.AddRecord(): TFunctionResult; var E: Exception; begin //попытаемся добавить запись в текущий датасет фрейма Result.Successful := false; if Assigned(FrameCurrentDataSet) then begin try FrameCurrentDataSet.Append; Result.Successful := true; except on E:Exception do Result.MessageOnError := E.Message; end; end; end; {редактирование} function TFrameBase.EditRecord(): TFunctionResult; var E: Exception; begin //попытаемся изменить запись в текущем датасете фрейма Result.Successful := false; if Assigned(FrameCurrentDataSet)then begin try FrameCurrentDataSet.Edit; Result.Successful := true; except on E:Exception do Result.MessageOnError := E.Message; end; end; end; {удаление} function TFrameBase.DeleteRecord(): TFunctionResult; var E: Exception; begin //попытаемся удалить запись из текущего датасета фрейма Result.Successful := false; if Assigned(FrameCurrentDataSet) then begin try FrameCurrentDataSet.Delete; Result.Successful := true; except on E:Exception do Result.MessageOnError := E.Message; end; end; end; {Сохранить} function TFrameBase.PostRecord(): TFunctionResult; var E: Exception; begin //попытаемся послать Post Result.Successful := false; if Assigned(FrameCurrentDataSet) then begin try FrameCurrentDataSet.Post; Result.Successful := true; except on E:Exception do Result.MessageOnError := E.Message; end; end; end; {Отменить} function TFrameBase.CancelRecord(): TFunctionResult; var E: Exception; begin //попытаемся послать Cancel Result.Successful := false; if Assigned(FrameCurrentDataSet) then begin try FrameCurrentDataSet.Cancel; Result.Successful := true; except on E:Exception do Result.MessageOnError := E.Message; end; end; end; {Открыть свойства} function TFrameBase.GetProperty(): boolean; begin Result := false; if Assigned(FrameCurrentDataSet) then if not FrameCurrentDataSet.IsEmpty then Result := true; end; {функции экспорта в различные форматы} function TFrameBase.ExportData(Parameter: string): TFunctionResult; var FResult: TFunctionResult; begin Result.Successful := False; Result.MessageOnError := 'Not Save'; //если передан параметр AsIs //то сохранить текущий грид в xls if (Parameter = 'AsIs') then begin with TSaveDialog.Create(Self) do try begin Filter := 'Файли гіпертексту|*.htm'; Title := 'Вкажіть назву файлу'; DefaultExt := 'htm'; Options := Options + [ofPathMustExist]; if Execute then begin FResult := TMyDBGrid(GetMainGrid).SaveToHTML(FileName, false); Result := FResult; ShellExecute(Self.Handle, 'open', PChar(FileName), nil, nil, SW_SHOW); end end; finally Free; end; end; end; function TFrameBase.ImportData(Parameter: string): TFunctionResult; begin Result.Successful := False; Result.MessageOnError := 'Not implemented method'; end; {Комментарий: функции записи/чтения заголовка фрейма} function TFrameBase.GetDesc: string; begin Result := FrameDescription end; procedure TFrameBase.SetDesc(Description: string); begin FrameDescription := Description end; procedure TFrameBase.GotoNextElement; begin if Assigned(FrameCurrentDataSet) then if not FrameCurrentDataSet.Eof then FrameCurrentDataSet.Next; end; procedure TFrameBase.GotoPrevElement; begin if Assigned(FrameCurrentDataSet) then if not FrameCurrentDataSet.Bof then FrameCurrentDataSet.Prior; end; procedure TFrameBase.GotoFirstElement; begin if Assigned(FrameCurrentDataSet) then if not FrameCurrentDataSet.Bof then FrameCurrentDataSet.First; end; procedure TFrameBase.GotoLastElement; begin if Assigned(FrameCurrentDataSet) then if not FrameCurrentDataSet.Eof then FrameCurrentDataSet.Last; end; procedure TFrameBase.SetLoadingData(LD: boolean); begin LoadingData := LD; end; function TFrameBase.GetLoadingData: boolean; begin Result := LoadingData; end; function TFrameBase.GetMainGrid: TDBGrid; begin Result := nil; end; procedure TFrameBase.SetMakeLongTimeWork (LTW: boolean); begin MakeLongTimeWork := LTW; end; function TFrameBase.GetMakeLongTimeWork : boolean; begin Result := MakeLongTimeWork; end; {функции возвращающие текущий источник данных} procedure TFrameBase.SetFrameCurrentDataSet(DS: TDataSet); begin FrameCurrentDataSet := DS; end; function TFrameBase.GetFrameCurrentDataSet: TDataSet; begin Result := FrameCurrentDataSet; end; destructor TFrameBase.Destroy; begin if Assigned(FrameCurrentDataSet) then FrameCurrentDataSet.Active := false; inherited Destroy; end; {процедуры записи/чтения настроек фрейма в файлы} function TFrameBase.SaveFrameToFile(FileName: TFileName): TFunctionResult; var E: Exception; ms: TMemoryStream; fs: TFileStream; begin try fs := TFileStream.Create(FileName, fmCreate or fmOpenWrite); ms := TMemoryStream.Create; try ms.WriteComponent(self); ms.Seek(0, soFromBeginning); ObjectBinaryToText(ms, fs); finally ms.Free; fs.free; end; Result.Successful := true; Except on E:Exception do begin Result.Successful := false; Result.MessageOnError := E.Message; end; end; end; function TFrameBase.LoadFromFileToFrame(FileName: TFileName): TFunctionResult; var ComponentIdx: integer; ms: TMemoryStream; fs: TFileStream; begin //уничтожим все существующие на фрейме компоненты //чтобы не было конфликтов for ComponentIdx := self.ComponentCount-1 downto 0 do self.Components[ComponentIdx].Free; try //загрузим фрейм из файла ms := TMemoryStream.Create; fs := TFileStream.Create(FileName, fmOpenRead); try ObjectTextToBinary(fs, ms); ms.Seek(0, soFromBeginning); ms.ReadComponent(self); finally ms.Free; fs.free; end; Result.Successful := true; except on E:Exception do begin Result.Successful := false; Result.MessageOnError := E.Message; end; end; end; end.

Ответ отправил: Химяк Виктор Васильевич (статус: 4-ый класс) Ответ отправлен: 17.04.2007, 19:52 Оценка за ответ: 5 Комментарий оценки: Спасиб большое очень хороший материал! Если есть что-то еще на счет фреймов пиши на Madmouse@list.ru

Вопрос № 82.988

Уважаемые! Подскажите как сделать Бутоны как Виндовс (т.е. округлыми), а не прямоугольными как в Делфи, без использования картинок, спидбутон и др. заморочек.

Отправлен: 17.04.2007, 17:17 Вопрос задал: Bee.line (статус: Посетитель) Всего ответов: 6 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Jakoni Здравствуйте, Bee.line! Используйте XPManifest со вкладки Win32 я использую Delphi 7 , там есть данный компанент, он изменяет вид всех контролов под стиль XP. Но есть одна загвоздка работать будет только под XP , если запускать под меньшими версиями Windows контролы будут стандартной формы

Ответ отправил: Jakoni (статус: 1-ый класс) Ответ отправлен: 17.04.2007, 17:27

Отвечает: Лукьяненко Алексей Валериевич Здравствуйте, Bee.line! Судя по всему, вы хотите сделать кнопки в стиле XP под Windows XP. Если так, то если у Вас Delphi 7 и выше, то поместите на форму компонент TXPManifest (страница Win32 палитры компонентов) Если у Вас Delphi до версии 7, то Вы можете скопировать один из файлов *.manifest из каталога Windows и переименовав его в имя_вашего_проекта.manifest положить его в каталог с .exe файлом Вашего проекта

Ответ отправил: Лукьяненко Алексей Валериевич (статус: 8-ой класс) Ответ отправлен: 17.04.2007, 17:28

Отвечает: Ерёмин Андрей Здравствуйте, Bee.line! В дополнение: есть компонент XPMan, который можно установить в более ранние версии Delphi, чем 7, и там так же просто подключить XP-стиль. Скачать можно здесь ». --------- Нет правила без исключений. Правило без исключений - исключение из правил.

Ответ отправил: Ерёмин Андрей (статус: Профессор) Россия, Тула WWW: Программирование на Delphi. Помощь, советы, обмен опытом. ICQ: 286867644 ---- Ответ отправлен: 17.04.2007, 17:51

Отвечает: W@NDeReR Здравствуйте, Bee.line! Могу предложить два способа: 1. В Delphi 7 на вкладке Win32 есть компанент XPManifest поместите его на форму и все на ней будет в стиле XP 2. Найти в директории с Виндовс файл с расширение *.Manifest ( например WindowsShell.Manifest) скопировать его в папку с программой и назвать её также как и исполняемый файл (например programma.exe.manifest) результат аналогичен пункту 1 --------- Опыт — дитя мысли, а мысль — дитя действия. Нельзя учиться по книгам.

Ответ отправил: W@NDeReR (статус: 3-ий класс) Ответ отправлен: 17.04.2007, 17:52

Отвечает: Павлов Сергей Сергеевич Здравствуйте, Bee.line! Если у вас Delphi 7 то на вкладке Win32 есть компонент XPManifest......поставте его на форму и все

Ответ отправил: Павлов Сергей Сергеевич (статус: 1-ый класс) Ответ отправлен: 17.04.2007, 21:58

Отвечает: василий1 Здравствуйте, Bee.line! используйте компонент xpmanifest(закладка win32) только на компьютере должна быть установлена тема ХР а не вин2к

Ответ отправил: василий1 (статус: 3-ий класс) Ответ отправлен: 18.04.2007, 03:43

Вопрос № 82.989

Добрый день! Скажите возможно это или нет, оПисание ниже? Программа открывает Интернет, определенный сайт. Можно это делать как в отдельной форме программы, так и открывать IE. Открывается страница, на этой старницы есть формы для заполнения данных, надо в определенные окошки внести инфрмацию. Скажите возможно это сделать и самое главное как это сделать. Заранее спасибо, всем кто откликнеться.

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

Отвечает: Bingo Здравствуйте, AllexZ! Все, что Вы описали, сделать вполне реально. 1. Чтобы открыть страницу в IE, разместите, к примеру, label1, в разделе uses напишите shellapi, а Label1.Caption будет равна ссылке к Вашему сайту. При щелчке вот что произойдет: --- procedure TForm2.Label1Click(Sender: TObject); begin shellexecute(application.Handle,'open',pchar(label1.caption),nil,nil,1); end; --- 2. Если хотите открыть страницу в своей прграмме, то Вам придется использовать TWebbrowser на вкладке Internet (или Fastnet). Разместите его на форме и при щелчке по Label1 вот что произойдет: ---- procedure TForm2.Label1Click(Sender: TObject); begin webbrowser1.Navigate(label1.Caption,0); end; ---- Если у Вас Delphi7 и ниже, то есть хороший пример своего браузера в папке Delphi7/ Demos/CoolStuff. 3. Если Вам необходима помощь для создания своей страницы, попробуйте задать вопрос в другую рассылку (Языки программированияHTML). Удачи! --------- C темным пивом в светлое будущее!

Ответ отправил: Bingo (статус: 4-ый класс) Ответ отправлен: 17.04.2007, 21:02 Оценка за ответ: 5 Комментарий оценки: Да это все понятно. Но Остается под вопросом вторая часть вопроса, внесение информации в определенные поля ввода. Спасибо за примеры как открывать интернет.

Отвечает: василий1 Здравствуйте, AllexZ! не претендую на оригинальность, но когда то делал себе подключалку к интернету исходников не нашел смысл был примерно такой создавал ярлык для подключения и запускал его из программы(зачем - были какие то проблемы с запуском приложения напрямую) потом находил запущенное приложение по заголовку окна('Подключение DSL' - например. в вашем случае IE) там было определенное колво полей в них я передавал нажатия клавиатуры ('1234' TAB 'asfdewfwe' TAB 'jkjljl' ENTER) ну и собственно таймеры понадобятся возможно сделать можно гораздо проще и компактнее(просьба не пинать))

Ответ отправил: василий1 (статус: 3-ий класс) Ответ отправлен: 18.04.2007, 03:56 Оценка за ответ: 5 Комментарий оценки: Оригенальный ответ. Один из крайних случаев, я бы сказа. Но вот интереснее как именно обратиться к каждому полю вводу, ведь каждое поле ввода имеет свое имя.

Отвечает: Сухомлин Кирилл Владимирович Здравствуйте, AllexZ! Почитайте статьи на DelphiWorld В частности про сети (про Бразуер там же): Вот ссылик на 2 конкретные статьи оттуда: Автоматическое заполнение HTML-форм в браузере Автоматическое заполнение web-форм в запущенном IE --------- Не узнаешь - не попробуешь.

Ответ отправил: Сухомлин Кирилл Владимирович (статус: Специалист) Ответ отправлен: 18.04.2007, 16:32 Оценка за ответ: 5 Комментарий оценки: Большое спасибо за ссылки и примеры. Почитаем, попробуем

Вопрос № 83.010

Здравствуйте, Эксперты. Помогите чем сможете. Пишу свой дисп. задач. ListBox обновляется по таймеру. 1) Задача: как при каждом обновлении сохранять выделение элемента. Как сие реализовать. 2) будет ли эта программа работать в Win 9X. Временами есть необходимость

Отправлен: 17.04.2007, 20:05 Вопрос задал: Beginner (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Ерёмин Андрей Здравствуйте, Beginner! 1) В том же событии OnTimer() объявляем локальную переменную: var i: integer; и затем добавляем в код события следующее: - перед обновлением: i:=ListBox1.ItemIndex; - после обновления: ListBox1.ItemIndex:=i; Вот и всё - выделенная строка останется выделенной и после обновления. 2) Конечно будет, а почему же и нет? Проблемы могут возникнуть только в случае, если вы задействуете дополнительные библиотеки, которых на Win9x нет. Удачи! --------- Нет правила без исключений. Правило без исключений - исключение из правил.

Ответ отправил: Ерёмин Андрей (статус: Профессор) Россия, Тула WWW: Программирование на Delphi. Помощь, советы, обмен опытом. ICQ: 286867644 ---- Ответ отправлен: 17.04.2007, 20:15

Отвечает: Gh0stik Здравствуйте, Beginner! 1) Вам достаточно во внешней процедуре, допустим по нажатию на ListBox сохранить положение выделенной строки в переменную, например: var iv:integer; ListBox1.ItemIndex:=iv; А в самом таймере после обновления просто добавить такую строку: ListBox1.Selected[iv]:=true; 2) Если Вы не используете библиотеки и ресурсы которые специфичны для текущей ОС, то проблем не будет. В противном случае Ваш проект будет не работоспособен, но при запуске приложения может появиться ошибка с причиной ее возникновения и после анализа этой ошибки вполне возможно ее локализовать иногда вполне достаточно вместе с проектом переносить недостающую динамическую библиотеку (dll). Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Профессионал) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) ICQ: 289363162 ---- Ответ отправлен: 17.04.2007, 20:21

Отвечает: PGM Здравствуйте, Beginner! Добавление к ответам на первый вопрос: вероятнее всего вам нужно сохранить выделение того же процесса, а не элемента по индексу, как предлагают в ответах (некоторые процессы ведь могут и исчезнуть, и индексы сместятся). Поэтому мое предложение - сохранять PID выделенного процесса (он есть в получаемой информации о процессах и его можно сохранить, например в Data элемента, если используете элементы управления или StringList) и потом искать его в обновленном списке и ставить выделение на него, если он еще работает, и не ставить выделение вообще, если не найден.

Ответ отправил: PGM (статус: 5-ый класс) Ответ отправлен: 18.04.2007, 10:27

© 2001-2007, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Email: support@rusfaq.ru, тел.: +7 (926) 535-23-31 Авторские права | Реклама на портале Версия системы: 4.50 (beta) от 15.04.2007