RusFAQ.ru: Программирование на Delphi

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

Выпуск № 348
от 07.01.2006, 23:00

Вопрос № 32.513

Здравствуйте, добрые люди! Не подскажете, как можно сделать UNDO, в основном работа идёт в TStringGrid. Спасибо.

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

Отвечает: Toxic~Fire Здравствуйте, SuperMaxx! Нужно создать переменную, или массив и записывать туда старое действие перед тем, как выполнить новое, а когда понадобится undo, то просто вернись к старой переменной(ным).

Ответ отправил: Toxic~Fire (статус: 2-ой класс) Отправлен: 02.01.2006, 11:38 Оценка за ответ: 4

Отвечает: Лучников Юрий Владимирович Здравствуйте, SuperMaxx! Для начала нужно запоминать то, в отношении к чему нужно UNDO;) Удобнее всего для этого использовать стек. Успехов!

Ответ отправил: Лучников Юрий Владимирович (статус: 8-ой класс) Отправлен: 02.01.2006, 14:02 Оценка за ответ: 2 Комментарий оценки: Бесполезный совет, ощущение что ответ ради ответа :-( < запоминать то, в отношении к чему нужно UNDO ну запомнил, в отношении StringGrid, а дальше что?, удалил человек строку, а потом отменил своё действие, и что я вытащу из стека? Это не текстовый редактор, уж намного и проще иметь несколько копий таблицы в памяти (или дампов).

Вопрос № 32.521

Здравствуйте уважаемые эксперты! С наступившим Вас 2006 годом. Вчера долго искал ошибку в своей программе. Всё время вылетала Range Check Error. Потом наконец понял, что дело тут в аттрибутах файла. Вот в чём вопрос: Есть переменная типа TSearchRec. Поле Attr у неё типа integer, хотя в принципе для задания известных мне аттрибутов хвати и одного байта. Так вот вчера выползла ошибка. Jpeg файл имеет аттрибуты 8224, что явно не вписывается ни в какие рамки. В файловом менеджере ничего необычного у этого файла нет. Он имеет аттрибуты -a--(32). Что означает аттрибут 8224 этого файла? Приложение: WinXP SP2, NTFS

Отправлен: 02.01.2006, 08:53 Вопрос задал: Schmak (статус: Практикант) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Toxic~Fire Здравствуйте, Schmak! Извини, но я не совсем понял проблему, попробуй так: в FindFirst FindNext в атрибутах поставь faAnyFile А потом фильтруй файлы по маске *.jpg, *.jpeg Или тебе самому нужно определять атрибуты файла? У меня где-то был список всех атрибутов, могу выслать если что (их кстати не много)

Ответ отправил: Toxic~Fire (статус: 2-ой класс) Отправлен: 02.01.2006, 11:47

Отвечает: sir henry Здравствуйте, Schmak! С аттрибутом какой-то явный непорядок. Вот смотрите: faReadOnly 1 faHidden 2 faSysFile 4 faVolumeID 8 faDirectory 16 faArchive 32 faSymLink 64 faAnyFile 71 ------------------------------ Итого 198 Т.е. макимум, что Вы можете получить в аттрибуте - цифра 198, т.к. каждый аттрибут занимает свой собственный разряд и для его описания действительно хватит всего одного байта.

Ответ отправил: sir henry (статус: Академик) Отправлен: 02.01.2006, 12:58 Оценка за ответ: 4 Комментарий оценки: Я вот тоже не могу понять, что за дела. Решил просто отсекать первые байты, т.е. брать остаток от деления на 256. Как ни странно, но 8224 mod 256=32, что мне и надо.

Вопрос № 32.537

На форме есть TTrackBar, как сделать что бы TrackBar.Position ровнялось тому месту, где щёлкнули мышкой(как во всех медиа-плеерах)?

Отправлен: 02.01.2006, 15:52 Вопрос задал: Клёмин Сергей (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Архангельский Андрей Германович Здравствуйте, Клёмин Сергей! procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); В этом событии X,Y - координаты мышки на момент клика Сопоставь их с координатами TrackBar и сможешь вычислить позицию, на которой должен быть TrackBar и соответственно перейти в файле на это место

Ответ отправил: Архангельский Андрей Германович (статус: Студент) Отправлен: 02.01.2006, 16:01 Оценка за ответ: 5

Отвечает: Сергей Т. Здравствуйте, Клёмин Сергей! Поставь процедуру в TrackBar на событие MouseDown, в процедуре есть X и Y, бери что тебе нужно (зависит от расположения TrackBar'a) и используй.

Ответ отправил: Сергей Т. (статус: 1-ый класс) Отправлен: 02.01.2006, 16:13 Оценка за ответ: 3 Комментарий оценки: У TrackBar'а нет события MouseDown.....

Вопрос № 32.544

Здравствуйте, уважаемые эксперты. Нужна Ваша помощь. Есть модуль TrayIcon. Какой код и где необходимо написать в другом модуле, чтобы использовать процедуры TrayIcon. Спасибо за ответы. Приложение: unit TrayIcon; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ShellAPI, Menus; const Wm_Callback_Message = Wm_User + 1; type TTrayIcon = class(TComponent) private TTrayIconData: TNotifyIconData; TTrayIconca: TIcon; TTrayHint: string; TTrayIconVisible: boolean; TTrayShowMin: boolean; TTrayPopup: TPopupMenu; protected procedure AppMinimize(Sender: TObject); procedure ProcessInput (var Msg: TMessage); virtual; procedure SetVisible (NewValue: boolean); procedure SetHint (NewValue: string); procedure SetIcon (NewValue: TIcon); procedure IconChanged(Sender: TObject); function StoreIcon: Boolean; procedure Modify; procedure ShowPopupMenu; public constructor Create(TheOwner:TComponent); override; destructor Destroy; override; procedure Show; procedure Hide; published property Visible: boolean read TTrayIconVisible write SetVisible default false; property ActOnMinimize: boolean read TTrayShowMin write TTrayShowMin; property Hint: string read TTrayHint write SetHint; property Icon: TIcon read TTrayIconca write SetIcon stored StoreIcon; property PopupMenu: TPopupMenu read TTrayPopup write TTrayPopup; end; procedure Register; implementation constructor TTrayIcon.Create(TheOwner:TComponent); begin inherited Create(TheOwner); TTrayHint:=Application.Title; TTrayIconVisible:=False; TTrayIconca:=TIcon.Create; TTrayIconData.Wnd:=AllocateHwnd(ProcessInput); TTrayIconData.cbSize:=SizeOf(TTrayIconData); TTrayIconData.uID:=0; TTrayIconData.uFlags:=NIF_ICON or NIF_TIP or NIF_MESSAGE; TTrayIconData.uCallBackMessage:=Wm_Callback_Message; Self.TTrayIconca.OnChange:=Self.IconChanged; TTrayPopup:=nil; Application.OnMinimize:=AppMinimize; end; destructor TTrayIcon.Destroy; begin Self.Hide; DeallocateHWnd(TTrayIconData.Wnd); Self.TTrayIconca.Free; inherited Destroy; end; procedure TTrayIcon.ShowPopupMenu; var MousePos: TPoint; begin if (Self.PopupMenu <> nil) then begin GetCursorPos(MousePos); TTrayPopup.Alignment := paLeft; SetForegroundWindow(TTrayIconData.Wnd); TTrayPopup.Popup(MousePos.X, MousePos.Y - (GetSystemMetrics(SM_CYMENUSIZE) * TTrayPopup.Items.Count)); PostMessage(TTrayIconData.Wnd, WM_NULL, 0, 0); end; end; procedure TTrayIcon.AppMinimize(Sender: TObject); begin if TTrayShowMin=true and TTrayIconVisible=false then Self.Show; end; procedure TTrayIcon.IconChanged(Sender: TObject); begin Self.Modify; end; procedure TTrayIcon.SetHint (NewValue: string); begin if NewValue <> TTrayHint then begin TTrayHint:=NewValue; Self.Modify; end; end; function TTrayIcon.StoreIcon: Boolean; begin Result := (not Self.TTrayIconca.Empty); end; procedure TTrayIcon.SetIcon (NewValue: TIcon); begin Self.TTrayIconca.Assign(NewValue); end; procedure TTrayIcon.SetVisible (NewValue: boolean); begin if NewValue <> TTrayIconVisible then begin if NewValue = false then Self.Hide else Self.Show; end; end; procedure TTrayIcon.Modify; begin TTrayIconData.hIcon:=TTrayIconca.Handle; StrPLCopy(TTrayIconData.szTip, TTrayHint, SizeOf(TTrayIconData.szTip)-1); if TTrayIconVisible=true then Shell_NotifyIcon(NIM_MODIFY, @TTrayIconData); end; procedure TTrayIcon.Show; begin TTrayIconData.hIcon:=TTrayIconca.Handle; StrPLCopy(TTrayIconData.szTip, TTrayHint, SizeOf(TTrayIconData.szTip)-1); Shell_NotifyIcon(NIM_ADD, @TTrayIconData); TTrayIconVisible:=true; Application.Minimize; ShowWindow(Application.Handle,SW_HIDE); end; procedure TTrayIcon.Hide; begin Shell_NotifyIcon(NIM_DELETE, @TTrayIconData); ShowWindow(Application.Handle,SW_SHOW); Application.Restore; TTrayIconVisible:=false; end; procedure TTrayIcon.ProcessInput (var Msg: TMessage); begin if Msg.Msg = Wm_Callback_Message then begin case (Msg.lParam) of { WM_LBUTTONDBLCLK: Self.DoubleClick(mbLeft); WM_MBUTTONDBLCLK: Self.DoubleClick(mbMiddle); WM_RBUTTONDBLCLK: Self.DoubleClick(mbRight); } WM_LBUTTONDOWN: Self.Hide; { WM_MBUTTONDOWN: Self.MouseDown(mbMiddle);} WM_RBUTTONDOWN: Self.ShowPopupMenu; { WM_LBUTTONUP: Self.MouseUp(mbLeft); WM_MBUTTONUP: Self.MouseUp(mbMiddle); WM_RBUTTONUP: Self.MouseUp(mbRight); WM_MOUSEMOVE: Self.MouseMove;} end; end else begin Msg.Result := DefWindowProc(TTrayIconData.Wnd, Msg.Msg, Msg.wParam, Msg.lParam); end; end; procedure Register; begin RegisterComponents('Standard', [TTrayIcon]); end; end.

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

Отвечает: Ерёмин Андрей Здравствуйте, Mybestpostbox! Ой. Это же модуль компонента. Его нужно просто установить. Открывайте Component - Install component. В поле Unit file name щёлкайте Browse и выбирайте этот модуль. Потом Compile, Install. Если установка пройдёт без проблем, на вкладке Standard этот компонент появится. А если будут проблемы - возьмите компонент CoolTrayIcon. Он очень удобный. --------- Работа - не волк, а произведение силы на расстояние!

Ответ отправил: Ерёмин Андрей (статус: Профессионал) Отправлен: 02.01.2006, 21:41

Вопрос № 32.546

Доброго времени суток! Как можно узнать какое процесс породил окно. Спасибо.

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

Отвечает: Diman_A Здравствуйте, Mybestpostbox! Вот программа, которая узнает многое о чужих окнах, в т.ч. и имя exe-шника Пиши мне aganovdiman@mail.ru, вышлю полные исходники Приложение: unit WndInfoFrm; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, PsAPI, TlHelp32, StdCtrls; const RsSystemIdleProcess = 'System Idle Process'; RsSystemProcess = 'System Process'; type TForm1 = class(TForm) Timer1: TTimer; Panel1: TPanel; Label1: TLabel; LabelLeft: TLabel; LabelTop: TLabel; Label2: TLabel; LabelWidth: TLabel; LabelHeight: TLabel; LabelName: TLabel; LabelClass: TLabel; LabelHandle: TLabel; Label3: TLabel; LabelParentHandle: TLabel; LabelParentName: TLabel; LabelParentClass: TLabel; Label4: TLabel; LabelParentLeft: TLabel; LabelParentTop: TLabel; Label5: TLabel; LabelParentWidth: TLabel; LabelParentHeight: TLabel; LabelPosX: TLabel; LabelPosY: TLabel; Label6: TLabel; procedure Timer1Timer(Sender: TObject); end; var Form1: TForm1; implementation {$R *.dfm} function IsWinXP: Boolean; begin Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion = 5) and (Win32MinorVersion = 1); end; function IsWin2k: Boolean; begin Result := (Win32MajorVersion >= 5) and (Win32Platform = VER_PLATFORM_WIN32_NT); end; function IsWinNT4: Boolean; begin Result := Win32Platform = VER_PLATFORM_WIN32_NT; Result := Result and (Win32MajorVersion = 4); end; function IsWin3X: Boolean; begin Result := Win32Platform = VER_PLATFORM_WIN32_NT; Result := Result and (Win32MajorVersion = 3) and ((Win32MinorVersion = 1) or (Win32MinorVersion = 5) or (Win32MinorVersion = 51)); end; function RunningProcessesList(const List: TStrings; FullPath: Boolean): Boolean; function ProcessFileName(PID: DWORD): string; var Handle: THandle; begin Result := ''; Handle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, PID); if Handle <> 0 then try SetLength(Result, MAX_PATH); if FullPath then begin if GetModuleFileNameEx(Handle, 0, PChar(Result), MAX_PATH) > 0 then SetLength(Result, StrLen(PChar(Result))) else Result := ''; end else begin if GetModuleBaseNameA(Handle, 0, PChar(Result), MAX_PATH) > 0 then SetLength(Result, StrLen(PChar(Result))) else Result := ''; end; finally CloseHandle(Handle); end; end; function BuildListTH: Boolean; var SnapProcHandle: THandle; ProcEntry: TProcessEntry32; NextProc: Boolean; FileName: string; begin SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); Result := (SnapProcHandle <> INVALID_HANDLE_VALUE); if Result then try ProcEntry.dwSize := SizeOf(ProcEntry); NextProc := Process32First(SnapProcHandle, ProcEntry); while NextProc do begin if ProcEntry.th32ProcessID = 0 then begin FileName := RsSystemIdleProcess; end else begin if IsWin2k or IsWinXP then begin FileName := ProcessFileName(ProcEntry.th32ProcessID); if FileName = '' then FileName := ProcEntry.szExeFile; end else begin FileName := ProcEntry.szExeFile; if not FullPath then FileName := ExtractFileName(FileName); end; end; List.AddObject(FileName, Pointer(ProcEntry.th32ProcessID)); NextProc := Process32Next(SnapProcHandle, ProcEntry); end; finally CloseHandle(SnapProcHandle); end; end; function BuildListPS: Boolean; var PIDs: array [0..1024] of DWORD; Needed: DWORD; I: Integer; FileName: string; begin Result := EnumProcesses(@PIDs, SizeOf(PIDs), Needed); if Result then begin for I := 0 to (Needed div SizeOf(DWORD)) - 1 do begin case PIDs[I] of 0: // PID 0 is always the "System Idle Process" but this name cannot be // retrieved from the system and has to be fabricated. FileName := RsSystemIdleProcess; 2: if IsWinNT4 then FileName := RsSystemProcess else FileName := ProcessFileName(PIDs[I]); 8: // On Win2K PID 8 is the "System Process" but this name cannot be // retrieved from the system and has to be fabricated. if IsWin2k or IsWinXP then FileName := RsSystemProcess else FileName := ProcessFileName(PIDs[I]); else FileName := ProcessFileName(PIDs[I]); end; if FileName <> '' then List.AddObject(FileName, Pointer(PIDs[I])); end; end; end; begin if IsWin3X or IsWinNT4 then Result := BuildListPS else Result := BuildListTH; end; function GetProcessNameFromWnd(Wnd: HWND): string; var List: TStringList; PID: DWORD; I: Integer; begin Result := ''; if IsWindow(Wnd) then begin PID := INVALID_HANDLE_VALUE; GetWindowThreadProcessId(Wnd, @PID); List := TStringList.Create; try if RunningProcessesList(List, True) then begin I := List.IndexOfObject(Pointer(PID)); if I > -1 then Result := List[I]; end; finally List.Free; end; end; end; procedure TForm1.Timer1Timer(Sender: TObject); var Wnd: HWND; Pos: TPoint; Rect: TRect; buff: array[0..255] of char; WndText: string; NameClass: string; begin // Получаем позицию курсора GetCursorPos( Pos ); // Получаем Handle окна под курсором Wnd := WindowFromPoint( Pos ); GetWindowRect( Wnd, Rect ); GetWindowText( Wnd, buff, SizeOf( buff ) ); WndText := StrPas( buff ); GetClassName( Wnd, buff, SizeOf( buff ) ); NameClass := StrPas( buff ); // Выводим координаты курсора LabelPosX.Caption := 'X: ' + IntToStr( Pos.X ); LabelPosY.Caption := 'Y: ' + IntToStr( Pos.Y ); LabelHandle.Caption := 'Handle: ' + IntToStr( Wnd ); LabelName.Caption := 'Name: ' + WndText; LabelClass.Caption := 'Class: ' + NameClass; LabelLeft.Caption := 'Left = ' + IntToStr( Rect.Left ); LabelTop.Caption := 'Top = ' + IntToStr( Rect.Top ); LabelWidth.Caption := 'Width = ' + IntToStr( Rect.Right - Rect.Left ); LabelHeight.Caption := 'Height = ' + IntToStr( Rect.Bottom - Rect.Top ); // Получаем Handle родительского окна Wnd := GetParent( Wnd ); GetWindowRect( Wnd, Rect ); GetWindowText( Wnd, buff, SizeOf( buff ) ); WndText := StrPas( buff ); GetClassName( Wnd, buff, SizeOf( buff ) ); NameClass := StrPas( buff ); LabelParentHandle.Caption := 'ParentHandle: ' + IntToStr( Wnd ); LabelParentName.Caption := 'ParentName: ' + WndText; LabelParentClass.Caption := 'ParentClass: ' + NameClass; LabelParentLeft.Caption := 'ParentLeft = ' + IntToStr( Rect.Left ); LabelParentTop.Caption := 'ParentTop = ' + IntToStr( Rect.Top ); LabelParentWidth.Caption := 'ParentWidth = ' + IntToStr( Rect.Right - Rect.Left ); LabelParentHeight.Caption := 'ParentHeight = ' + IntToStr( Rect.Bottom - Rect.Top ); label6.Caption:='Путь к exe =' + GetProcessNameFromWnd (wnd); end; end.

Ответ отправил: Diman_A (статус: 2-ой класс) Отправлен: 03.01.2006, 11:01

© 2001-2006, Портал RusFAQ.ru, Россия, Москва. Идея, дизайн, программирование: Калашников О.А. Email: adm@rusfaq.ru, Тел.: +7 (926) 535-23-31 Авторские права | Реклама на портале

---

Subscribe.Ru Поддержка подписчиков Другие рассылки этой тематики Другие рассылки этого автора

Подписан адрес: Код этой рассылки: comp.soft.prog.delphiplus Архив рассылки

Отписаться Вебом Почтой Вспомнить пароль

---

В избранное