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

Выпуск № 1126
от 19.04.2008, 19:35

Вопрос № 132.048

Господа Программисты. такой вопрос: у меня есть два компонента (DBCheckBox1 и Button1) нужно сделать, чтоб когда DBCheckBox1 в true кнопка была утоплена (ну чтоб её нельзя было нажать)

Отправлен: 13.04.2008, 19:36 Вопрос задал: Clown-Vika (статус: Посетитель) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Marked One Здравствуйте, Clown-Vika! В обработчик события OnClick у DBCheckBox1'а введите это: Button1.Enabled:=not DBCheckBox1.Checked;

Ответ отправил: Marked One (статус: 8-ой класс) Ответ отправлен: 13.04.2008, 19:57 Оценка за ответ: 3 Комментарий оценки: спосибо

Отвечает: Esi Здравствуйте, Clown-Vika! Это делается очень просто. Нужно для DBCheckBox1 в событие OnChange написать такие строки: If DBCheckBox1.checked then Button1.visible=true else Button1.visible=false; // в этом случае кнопка станет невидимой. или по другому: If DBCheckBox1.checked then Button1.enabled=true else Button1.enabled=false; // в этом случае кнопка станет серой и ни на какие нажатия реагировать не будет. Удачи!

Ответ отправил: Esi (статус: 3-ий класс) Ответ отправлен: 13.04.2008, 20:03 Оценка за ответ: 5 Комментарий оценки: Спосибо большое

Отвечает: Drbear Здравствуйте, Clown-Vika! В дополнение к предыдущим ответам. Если Вам нужна именно утопленная кнопка, попробуйте использовать TSpeedButton с свойством GroupIndex установленном в любое значение больше 0 (например 1). Пример кода в приложении. На форме Button, SpeedButton и DBCheckBox. В этом варианте при DBCheckBox1.Checked = False SpeedButton можеть находиться в отжатом и нажатом состоянии, а при DBCheckBox1.Checked = True - только в нажатом. Приложение: procedure TForm1.DBCheckBox1Click(Sender: TObject); begin Button4.Enabled := not DBCheckBox1.Checked; if DBCheckBox1.Checked = True then SpeedButton1.AllowAllUp := False else SpeedButton1.AllowAllUp := True; SpeedButton1.Down := DBCheckBox1.Checked; end;

Ответ отправил: Drbear (статус: 9-ый класс) Ответ отправлен: 13.04.2008, 20:26 Оценка за ответ: 4

Отвечает: Genia007 Здравствуйте, Clown-Vika! Насколько мне известно простую кнопку нельзя сделать утопленной. А чтобы кнопку нельзя было нажать нужно написать: If DBCheckBox1.Checked = True then Button1.Enabled:= False else Button1.Enabled:= True;

Ответ отправил: Genia007 (статус: 7-ой класс) Ответ отправлен: 14.04.2008, 14:05

Вопрос № 132.071

Здравствуйте уважаемые эксперты. Подскажите как из Delphi в Word`е сделать замену.

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

Отвечает: Coupler Здравствуйте, Коробин Алексей Игумнович! В приложении функция (используется запуск word и взаимодействие с ним через OLE) и пример ее использования. Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComObj, StdCtrls; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; TWordReplaceFlags = set of (wrfReplaceAll, wrfMatchCase, wrfMatchWildcards); var Form1: TForm1; implementation {$R *.dfm} function Word_StringReplace(ADocument: TFileName; SearchString, ReplaceString: string; Flags: TWordReplaceFlags): Boolean; const wdFindContinue = 1; wdReplaceOne = 1; wdReplaceAll = 2; wdDoNotSaveChanges = 0; var WordApp: OLEVariant; begin application.ProcessMessages; Result := False; //Проверка на существование файла if not FileExists(ADocument) then begin ShowMessage('Документ не найден'); Exit; end; //Создание объекта OLE try WordApp := CreateOLEObject('Word.Application'); except on E: Exception do begin E.Message := 'Ошибка. Приложение Microsoft Word не доступно'; raise; end; end; try //скрываем окно word WordApp.Visible := False; //открытие документа WordApp.Documents.Open(ADocument); //параметры поиска WordApp.Selection.Find.ClearFormatting; WordApp.Selection.Find.Text := SearchString; WordApp.Selection.Find.Replacement.Text := ReplaceString; WordApp.Selection.Find.Forward := True; WordApp.Selection.Find.Wrap := wdFindContinue; WordApp.Selection.Find.Format := False; WordApp.Selection.Find.MatchCase := wrfMatchCase in Flags; WordApp.Selection.Find.MatchWholeWord := False; WordApp.Selection.Find.MatchWildcards := wrfMatchWildcards in Flags; WordApp.Selection.Find.MatchSoundsLike := False; WordApp.Selection.Find.MatchAllWordForms := False; //поиск с заменой if wrfReplaceAll in Flags then WordApp.Selection.Find.Execute(Replace := wdReplaceAll) else WordApp.Selection.Find.Execute(Replace := wdReplaceOne); //сохранение WordApp.ActiveDocument.SaveAs(ADocument); Result := True; //закрытие докуметна WordApp.ActiveDocument.Close(wdDoNotSaveChanges); finally //выход из word'а WordApp.Quit; WordApp := Unassigned; end; end; procedure TForm1.Button1Click(Sender: TObject); begin Word_StringReplace('c: est.doc', '123', '321', [wrfReplaceAll]); end; end.

Ответ отправил: Coupler (статус: Специалист) Ответ отправлен: 14.04.2008, 05:13 Оценка за ответ: 5 Комментарий оценки: Большое спасибо. Очень помогло.

Вопрос № 132.158

Прівет експерти. 1. Как мне отследить изменения файлов на всех дисках, которие производит пользователь, системние изменения нада отсеять. 2. Как отследить роботу с флешками (подключения,отключения,запись). 3. Как в DBGrid сделать автоподгон ширини столбцов по содержимому. 4. Как із програмы без окна(процеса) получить заголовок всех окон програм запущеных в системе. Всем зарания благодарен.

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

Отвечает: SHERRY Здравствуйте, Мельник Виктор ! Почитайте вопрос #131328 --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: 9-ый класс) Ответ отправлен: 14.04.2008, 16:17

Вопрос № 132.162

Как достать картинку из кеша TWebbrowser. Смысл такой. В Webbrowser показывается картинка (captcha) хотелось бы ее вывести в TImage. Вопрос: как это сделать? Делать запрос по src картинки не пройдет. Сгенерится новая картинка, а нужна старая.

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

Отвечает: Sosedov A.I. Здравствуйте, Selax! Если Source картинки Вам известен, то предлагаю следующий способ. 1. Создайте форму, поместите на нее: Edit1: TEdit (Source картинки) LB: TListBox (для наглядности) Button2: TButton. 2. Добавьте в uses WinInet. 3. Обработчик Button2 вставьте из приложения. Вначале поэкспериментируйте. Пусть Edit1.Text:='.ru'. Посмотрите после нажатия Button2 на список. Вы увидите в нечетных строках URL сайтов, а в четных - полный путь и имена файлов кэшированных элементов. В именах файлов присутствуют квадратные скобки и номер внутри. Чем больше номер, тем новее файл. Теперь пусть Edit1.Text:='www.source.of.my.image.ru/filename.gif'. Нажмите кнопку. Ищите в списке имя самого свежего файла. Работайте с ним. Есть еще идея. Подумайте, нужен ли вообще TWebBrowser? Может, проще просто загружать картинку по ее URL? В таком случае ее не нужно искать в кэше. Приложение: procedure TForm1.Button2Click(Sender: TObject); var lpEntryInfo: PInternetCacheEntryInfo; hCacheDir: LongWord; dwEntrySize: LongWord; dwLastError: LongWord; AC1: PAnsiChar; L: TList; i: integer; begin // искать все с маской *.* AC1:=nil; // Здесь будут собраны все указатели на структуры TInternetCacheEntryInfo L:=TList.Create; // будет фиктивный вызов, только с целью узнать dwEntrySize dwEntrySize := 0; FindFirstUrlCacheEntry(AC1, TInternetCacheEntryInfo(nil^), dwEntrySize); // узнали, выделяем память GetMem(lpEntryInfo, dwEntrySize); // и запуск: hCacheDir := FindFirstUrlCacheEntry(AC1, lpEntryInfo^, dwEntrySize); L.Add(lpEntryInfo); repeat // будет фиктивный вызов, только с целью узнать dwEntrySize dwEntrySize := 0; FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^),dwEntrySize); // узнали, выделяем память GetMem(lpEntryInfo, dwEntrySize); if FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize) then if lpEntryInfo^.lpszLocalFileName <> nil then begin L.Add(lpEntryInfo); end; // обнаружение конца кэша dwLastError := GetLastError(); until (dwLastError = ERROR_NO_MORE_ITEMS); for i:=0 to L.Count-1 do begin if Pos(Edit1.Text ,PInternetCacheEntryInfo(L.Items[i])^.lpszSourceUrlName) > 0 then begin LB.Items.Add(PInternetCacheEntryInfo(L.Items[i])^.lpszSourceUrlName); LB.Items.Add(' ' + PInternetCacheEntryInfo(L.Items[i])^.lpszLocalFileName); end; end; L.Free; end;

Ответ отправил: Sosedov A.I. (статус: 5-ый класс) Ответ отправлен: 18.04.2008, 11:15 Оценка за ответ: 5 Комментарий оценки: Спасибо. Я бы отказался от TWebBrowser, но тогда нужно самому принимать куки и код формы авторизации.

Вопрос № 132.188

Здравствуйте! Вот вроде бы обычная ситуация с копированием файлов, а возникли трудности. Необходимо скопировать файл на рабочий стол текущего юзера. Проблема в том что нужный путь ни как не определяется. Посмотрите пожалуйста. Приложение: u,a,b,sUserName: string; c:PAnsiChar; //Определяем текущего юзера function GetCurrentUserName: string; const cnMaxUserNameLen = 254; var dwUserNameLen: DWORD; begin dwUserNameLen := cnMaxUserNameLen - 1; SetLength(sUserName, cnMaxUserNameLen); GetUserName(PAnsiChar(sUserName), dwUserNameLen); SetLength(sUserName, dwUserNameLen); Result := sUserName; u := Result; end; procedure TForm1.Button3Click(Sender: TObject); begin ShowMessage(GetCurrentUserName); end; //копируем файл procedure TForm1.Button4Click(Sender: TObject); begin a:='C:Documents and Settings'; b:='Рабочий столfile.txt'; a:=a+u; b:=a+b; c:=PAnsiChar(b); if not CopyFile('file.txt',c,true) then ShowMessage('Ошибак копирования!') else ShowMessage('Файл скопирован.'); end;

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

Отвечает: Mishell Здравствуйте, Lammer! см. пример функции, которая возвращает путь к рабочему столу текущего пользователя в приложении кстати откуда Вы копируете файл? из текущего каталога? лучше все-таки задавать четкий путь, а то мало ли какой каталог будет в данный момент установллен как текущий... т.е. примерно так: var fname:string; ... fname:=ExtractFilePath(ParamStr(0))+'file.txt'; // копируем из каталога программы if fileexists(fname) // проверяем есть ли файл в указанном каталоге then CopyFile(PAnsiChar(fname),GetDeskTopPath+ExtractFileName(fname),true); Приложение: function GetDeskTopPath:string; var shellMalloc:IMalloc; ppidl:PItemIdList; PerDir:string; begin ppidl:=nil; try if SHGetMalloc(shellMalloc)=NOERROR then begin SHGetSpecialFolderLocation(Form1.Handle, CSIDL_DESKTOP, ppidl); SetLength(Result, MAX_PATH); if SHGetPathFromIDList(ppidl, PChar(Result)) then SetLength(Result, lStrLen(PChar(Result))); end; finally if ppidl<>nil then shellMalloc.free(ppidl); end; end;

Ответ отправил: Mishell (статус: 10-ый класс) Ответ отправлен: 14.04.2008, 19:26 Оценка за ответ: 5

Отвечает: Drbear Здравствуйте, Lammer! Желательно указывать полное имя файла и, перед копированием, проверять, существует ли он. Рабочий код в приложении. Указан исходный файл, лежащий в папке с программой. Процедура GetEnvString вернет Вам значение любой системной переменной. В процедуре ShortcutPatch при tipLnk = 1 - рабочий стол, 2 - меню программы, 3 - быстрый запуск. Если сходите по указанному пути (SoftwareMicroSoftWindowsCurrentVersionExplorerShell Folders) - найдете еще несколько системных папок. Если измение UAll на True - получите пути к общим каталогам. Надеюсь, помог Вам. Приложение: function ShortcutPatch(const tipLnk: Byte): String; const HLM = HKEY_LOCAL_MACHINE; HKU = HKEY_CURRENT_USER; SHELL = 'SoftwareMicroSoftWindowsCurrentVersionExplorerShell Folders'; RUN = 'SoftwareMicrosoftWindowsCurrentVersionRun'; var R: TRegIniFile; common: String; UAll: Boolean; begin UAll := False; R := TRegIniFile.Create(''); try with R do begin if UAll = true then begin RootKey := HLM; common := 'Common '; end else begin RootKey := HKU; common := ''; end; case tipLnk of 1: Result := ReadString(SHELL, common + 'Desktop', '') + ''; 2: Result := ReadString(SHELL, common + 'Programs', '') + ''; 3: begin Result := ReadString(SHELL, common + 'AppData', ''); if Result <> '' then Result := Result + 'MicrosoftInternet ExplorerQuick Launch' end; else Result := ''; end; end; finally R.Free; end; end; function GetEnvString(s: String): String; var ptr: PChar; sTmp: String; Done: Boolean; begin Result := ''; if trim(s) = '' then Exit; Done := False; s := AnsiUpperCase(s); ptr := Windows.GetEnvironmentStrings; while Done = False do begin if ptr^ = #0 then Done := True; inc(ptr, lStrLen(ptr) + 1); sTmp := ptr; if pos('=', sTmp) > 0 then begin sTmp := copy(sTmp, 0, pos('=', sTmp) - 1); if AnsiUpperCase(sTmp) = s then begin Result := copy(ptr, pos('=', ptr) + 1, length(ptr)); Done := True; end; end; end; end; procedure TForm1.Button3Click(Sender: TObject); begin ShowMessage(GetEnvString('USERNAME')); end; procedure TForm1.Button4Click(Sender: TObject); var sDeskTopPath: String; sFilePath: String; sFileName: String; begin sDeskTopPath := ShortcutPatch(1); sFilePath := ExtractFilePath(ParamStr(0)); sFileName := 'file.txt'; sFilePath := sFilePath + sFileName; sDeskTopPath := sDeskTopPath + sFileName; if FileExists(sFilePath) then if not CopyFile(PAnsiChar(sFilePath), PAnsiChar(sDeskTopPath), True) then ShowMessage('Ошибка копирования!') else ShowMessage('Файл скопирован.'); end;

Ответ отправил: Drbear (статус: 9-ый класс) Ответ отправлен: 14.04.2008, 19:43 Оценка за ответ: 5

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