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

Выпуск № 1104
от 28.03.2008, 07:35

Вопрос № 128.531

Уважаемые эксперты помогите узнать что значит эта ошибка " Exeption EAccessVialation in module HTMLpad.exe " Я хотел сделать программу типа HTML редактора и если есть у кого исходники пришлите кому не жалко Приложение: unit ed; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, OleCtrls, DHTMLEDLib_TLB, StdCtrls, ComCtrls, ToolWin, Menus, XPMan, ExtCtrls, SHDocVw; type TForm1 = class(TForm) MainMenu1: TMainMenu; N1: TMenuItem; N2: TMenuItem; N3: TMenuItem; N4: TMenuItem; N5: TMenuItem; N6: TMenuItem; N7: TMenuItem; N8: TMenuItem; CoolBar1: TCoolBar; ToolBar1: TToolBar; ComboBox1: TComboBox; OpenDialog1: TOpenDialog; Panel1: TPanel; Splitter1: TSplitter; Panel2: TPanel; DHTMLEdit1: TDHTMLEdit; WebBrowser1: TWebBrowser; Memo1: TMemo; ToolBar2: TToolBar; ToolBar3: TToolBar; ToolButton1: TToolButton; ToolButton2: TToolButton; ToolButton3: TToolButton; ToolButton4: TToolButton; ToolButton5: TToolButton; procedure N4Click(Sender: TObject); procedure ComboBox1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure ToolButton1Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.N4Click(Sender: TObject); begin if not OpenDialog1.Execute then Exit ; begin DHTMLedit1.LoadURL(OpenDialog1.FileName); WebBrowser1.Navigate(OpenDialog1.FileName); ComboBox1.Text:=OpenDialog1.FileName; end; end; procedure TForm1.ComboBox1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key= VK_RETURN then WebBrowser1.Navigate(ComboBox1.Text); DHTMLEdit1.LoadURL(ComboBox1.Text); end; procedure TForm1.ToolButton1Click(Sender: TObject); begin Memo1.Text:=DHtmlEdit1.DocumentHTML ; end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin Action:=CaFree; end; end.

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

Отвечает: Marked One Здравствуйте, Arturalimov! Вот статья из Delphi Russian Knowledge Base: Почему возникает ошибка Access Violation? Ошибка "Access Violation" возникает, когда идёт обращение к памяти к которой обращение запрещено. Это возможно во многих случаях, но наиболее типичные ситуации я попытаюсь перечислить: 1) Обращение к не созданному объекту. var e:TEdit; begin e.text:='Hello world!'; end; В данном случае объект e ещё не создан и идёт обращение к памяти, которая ещё не выделена. 2) Обращение к уже разрушенному объекту: var e:TEdit; begin ... e.free; ... e.text:='Hello world'; end; Тут есть хитрость, допустим вы хотите проверить есть ли объект и модернизируете код: if e<>nil then e.text:='Hello world!'; или if assigned(e) then e.text:='Hello world!'; Особенно часто приходится такое делать когда надо уничтожить объект: if e<>nil then e.free; Так вот - такой код может быть источником ошибки, так как метод Free автоматически не устанавливает указатель в Nil. Обязательно после каждого Free используйте установление указателя в nil: e.free; e:=nil; 3) При выходе за границы динамического массива обычно генерится ошибка "Index out of bound", но возможно и возникновение Access Violation, особенно когда не стоят опции компилляции для проверки границ массивов. Эта ошибка может быть очень сложна в отлаживании - дело в том что допустим у вас есть массив а длиной в 10 элементов, в пишете: a[20]:=something; И эта строка может пройти как и надо, без всяких проблем, но её выполнение повредит какой-то другой код, причём каждый раз другой! Теперь самая безобидная операция типа i:=10 может вдруг внезапно дать Access Violation. 3) На форме на onCreate вызывается что-то с других форм - эти другие формы на этот момент еще не созданы 4) На форме на onDestroy вызывается что-то с других форм - эти другие формы на этот момент уже разрушены Автор Vit Взято с Vingrad.ru http://forum.vingrad.ru

Ответ отправил: Marked One (статус: 9-ый класс) Ответ отправлен: 22.03.2008, 14:17 Оценка за ответ: 5

Вопрос № 128.544

Здравствуйте эксперты! Помогите написать программу: реализовать функцию поиска элемента Е в односвязном списке L. Зарнее спасибо!

Отправлен: 22.03.2008, 13:04 Вопрос задал: АлексейN Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Кудинов Антон Павлович Здравствуйте, АлексейN! Вот пример такого кода... type t_direct_list=class next:t_direct_list; function seek(s:t_direct_list):t_direct_list; end; function t_diret_list.seek(s:t_direct_list):t_direct_list; begin result:=self; while (result<>nil)and(result<>s) do result:=result.next; end;

Ответ отправил: Кудинов Антон Павлович (статус: 3-ий класс) Ответ отправлен: 22.03.2008, 15:42 Оценка за ответ: 5 Комментарий оценки: Спасибо за ответ.

Вопрос № 128.545

Здравствуйте, уважаемые эксперты. не могли бы Вы мне помочь написать программу на Delphi, которая наглядно иллюстрирует работу следующих методов сортировки:  пузырьковая;  шейкерная. Провести сравнение этих сортировок по количеству сравнений, по количеству обменов. Для этого построить графики зависимостей данных величин от количества элементов массива. Очень рассчитываю на Вашу помощь.

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

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Никонова Наталья Николаевна! Приведу ссылки на алгоритмы данных сортировок: Сортировка пузырьком, программа-пример Шейкерная сортировка + программа Также очень советую ознакомиться с этой статьей: Задача сортировки. В ней очень подробно описаны сортировки и приведены примеры. Удачи!

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

Вопрос № 128.616

Здраствуйте експерти!Есть вопросик. Нужно в Дельфи в обьекте StringGrid (сетка) вивести в нужной ячейке текст не горизонтально а вертикально...есть ли в такие методы и как ето зделать?что-то похоже есть в Excel когда делаем формат ячеейки и ставим текст по 90 градусов.Если можна пример покажите. Спс.

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

Отвечает: Louken Здравствуйте, Coda89! Обработайте событие OnDrawCell. Не забудьте сделать высоту строк побольше. Код в приложении: Приложение: procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); var lf: TLogFont; fnt: HFont; begin //Если нужно поворачивать текст не в каждой ячейке, //то поработайте с ACol, ARow - это координаты отрисовываемой ячейки StringGrid1.Canvas.FillRect(Rect); //стираем стандартную надпись //Заполняем параметры шрифта FillChar(lf, SizeOf(lf), 0); With lf do begin lfHeight:=StringGrid1.Canvas.Font.Height; // размер символов lfEscapement:=-900; //Угол поворота*10 StrPCopy(lfFaceName, 'Arial'); //Имя шрифта // StrPCopy(lfFaceName, StringGrid1.Canvas.Font.Name); lfCharSet:=StringGrid1.Canvas.Font.Charset; //набор символов end; fnt:=CreateFontIndirect(lf); //создаем шрифт With StringGrid1 do begin Canvas.Font.Handle:=fnt; Canvas.TextOut(Rect.Left+2+DefaultColWidth div 2, Rect.Top+2, Cells[Acol, ARow]); end; DeleteObject(fnt); //Удаляем ненужный шрифт end;

Ответ отправил: Louken (статус: Студент) Ответ отправлен: 22.03.2008, 23:06 Оценка за ответ: 5 Комментарий оценки: Ставлю 5...спасибки!Бегу експерементировать..

Отвечает: Genia007 Здравствуйте, Coda89! Нашёл такой вот код, который поварачивает строку в ячейки на 90 градусов, возможно он Вам подойдёт, проверил работает. Приложение: uses {...} Grids; type TForm1 = class(TForm) StringGrid1: TStringGrid; procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); end; {...} implementation {...} // Display text vertically in StringGrid cells // Vertikale Textausgabe in den Zellen eines StringGrid procedure StringGridRotateTextOut2(Grid:TStringGrid;ARow,ACol:Integer;Rect:TRect; Schriftart:String;Size:Integer;Color:TColor;Alignment:TAlignment); var NewFont, OldFont : Integer; FontStyle, FontItalic, FontUnderline, FontStrikeout: Integer; begin // if the font is to big, resize it // wenn Schrift zu gro? dann anpassen If (Size > Grid.ColWidths[ACol] DIV 2) Then Size := Grid.ColWidths[ACol] DIV 2; with Grid.Canvas do begin // Set font // Font setzen If (fsBold IN Font.Style) Then FontStyle := FW_BOLD Else FontStyle := FW_NORMAL; If (fsItalic IN Font.Style) Then FontItalic := 1 Else FontItalic := 0; If (fsUnderline IN Font.Style) Then FontUnderline := 1 Else FontUnderline := 0; If (fsStrikeOut IN Font.Style) Then FontStrikeout:=1 Else FontStrikeout:=0; Font.Color := Color; NewFont := CreateFont(Size, 0, 900, 0, FontStyle, FontItalic, FontUnderline, FontStrikeout, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, PChar(Schriftart)); OldFont := SelectObject(Handle, NewFont); // fill the rectangle // Rechteck fullen FillRect(Rect); // Write text depending on the alignment // Text nach Ausrichtung ausgeben If Alignment = taLeftJustify Then TextRect(Rect,Rect.Left+2,Rect.Bottom-2,Grid.Cells[ACol,ARow]); If Alignment = taCenter Then TextRect(Rect,Rect.Left+Grid.ColWidths[ACol] DIV 2 - Size + Size DIV 3, Rect.Bottom-2,Grid.Cells[ACol,ARow]); If Alignment = taRightJustify Then TextRect(Rect,Rect.Right-Size - Size DIV 2 - 2,Rect.Bottom-2,Grid.Cells[ACol,ARow]); // Recreate reference to the old font // Referenz auf alten Font wiederherstellen SelectObject(Handle, OldFont); // Recreate reference to the new font // Referenz auf neuen Font loschen DeleteObject(NewFont); end; end; // Call the method in OnDrawCell // Methode im OnDrawCell aufrufen procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); begin // In the second column: Rotate Text by 90° and left align the text // Text um 90°gedreht ausgeben, linksbundig in der zweiten Spalte if ACol = 1 then StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12,clRed, taLeftJustify); // In the third column: Center the text // Ausgabe zentriert in der dritten Spalte if ACol = 2 then StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12, clBlue, taCenter); // In all other columns third row: right align the text // Ausgabe rechtsbundig in den restlichen Spalten if ACol > 2 then StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12,clGreen, taRightJustify); end; end.

Ответ отправил: Genia007 (статус: 8-ой класс) Ответ отправлен: 24.03.2008, 13:45

Вопрос № 128.627

здравствуйте! У меня к Вам 2 вопроса: 1. Мне нужно на форме сделать проигрывание видео. 2. На форме сделать "мини" проигрыватель для звука, т.е чтобы был плейлист, и я мог выбрать нужный мне мп3 трек, и он играл.

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

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Makavely! По первому вопросу. Скачайте готовый пример - в нем несложно будет разобраться. Также посмотрите эту страницу. Там приведено довольно много примеров по работе с мультимедиа в Delphi. Удачи!

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

Отвечает: Genia007 Здравствуйте, Makavely! Проигрывание видео и звука можно сделать с помощью компанента TMediaPlayer. 1. Про воспроизведение видео на форме, можно сделать так: procedure TFormPlay.N1Click(Sender: TObject);{Нажатие кнопки выбора видеофайла} begin MediaPlayer1.DeviceType:=dtAutoSelect; MediaPlayer1.Display:=panel1; if OpenDialog1.Execute then begin Label3.Caption:=OpenDialog1.FileName;{Показываем выбранный файл} Panel1.Color:=clblack; with MediaPlayer1 do begin FileName:=Label3.Caption; // имя выбранного файла Panel1.Refresh; MediaPlayer1.DisplayRect := Panel1.ClientRect; Open; // открыть и проиграть звуковой или видео файл Play; end; end; end; Видео воспроизводится на компаненте Panel1. 2. По воспроизведению звука с плэй листом, предлагаю код плэйера, который я когда-то смастерил, смотрите приложение: Приложение: unit Unit1_1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, MPlayer, ComCtrls, ExtCtrls, Menus, XPMan, MMSystem; type TForm1 = class(TForm) mp3player: TMediaPlayer; btnOpenFolder: TBitBtn; txtFolder: TStaticText; Progress: TProgressBar; ProgresTimer: TTimer; Label7: TLabel; Timer1: TTimer; Label8: TLabel; MainMenu1: TMainMenu; N1: TMenuItem; TrackBar1: TTrackBar; XPManifest1: TXPManifest; TrackBar3: TTrackBar; TrackBar2: TTrackBar; Label1: TLabel; Timer2: TTimer; mp3List: TListBox; Label2: TLabel; Label3: TLabel; procedure btnOpenFolderClick(Sender: TObject); procedure mp3ListClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure ProgresTimerTimer(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure mp3playerNotify(Sender: TObject); procedure N1Click(Sender: TObject); procedure N4Click(Sender: TObject); procedure mp3playerClick(Sender: TObject; Button: TMPBtnType; var DoDefault: Boolean); procedure TrackBar2Change(Sender: TObject); procedure TrackBar1Enter(Sender: TObject); procedure Timer2Timer(Sender: TObject); procedure TrackBar3Change(Sender: TObject); procedure TrackBar1Change(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } public { Public declarations } end; var Form1: TForm1; mm,ss:integer; implementation uses ShellAPI, ShlObj; // нужен для BrowseForFolder function {$R *.DFM} procedure GetVolume(var volL, volR: Word); var hWO: HWAVEOUT; waveF: TWAVEFORMATEX; vol: DWORD; begin volL := 0; volR := 0; // init TWAVEFORMATEX FillChar(waveF, SizeOf(waveF), 0); // open WaveMapper = std output of playsound waveOutOpen(@hWO, WAVE_MAPPER, @waveF, 0, 0, 0); // get volume waveOutGetVolume(hWO, @vol); volL := vol and $FFFF; volR := vol shr 16; waveOutClose(hWO); end; procedure FillMP3FileList(Folder: string; sl: TStrings); var Rec : TSearchRec; begin sl.Clear; if SysUtils.FindFirst(Folder + '*.mp3', faAnyFile, Rec) = 0 then try repeat sl.Add(Rec.Name); until SysUtils.FindNext(Rec) <> 0; finally SysUtils.FindClose(Rec); end; end; function BrowseDialog(const Title: string; const Flag: integer): string; var lpItemID : PItemIDList; BrowseInfo : TBrowseInfo; DisplayName : array[0..MAX_PATH] of char; TempPath : array[0..MAX_PATH] of char; begin Result:=''; FillChar(BrowseInfo, sizeof(TBrowseInfo), #0); with BrowseInfo do begin hwndOwner := Application.Handle; pszDisplayName := @DisplayName; lpszTitle := PChar(Title); ulFlags := Flag; end; lpItemID := SHBrowseForFolder(BrowseInfo); if lpItemId <> nil then begin SHGetPathFromIDList(lpItemID, TempPath); Result := IncludeTrailingBackslash(TempPath); GlobalFreePtr(lpItemID); end; end; procedure TForm1.btnOpenFolderClick(Sender: TObject); var mp3Folder : string; begin mp3Folder := BrowseDialog('Выберите папку с mp3 файлами', BIF_RETURNONLYFSDIRS); if mp3Folder = '' then Exit; txtFolder.Caption := mp3Folder; FillMP3FileList(mp3Folder, mp3List.Items); end; procedure TForm1.mp3ListClick(Sender: TObject); var mp3File:string; begin if mp3List.Items.Count=0 then exit; mp3File := Concat(txtFolder.Caption, mp3List.Items.Strings[mp3List.ItemIndex]); if not FileExists(mp3File) then begin ShowMessage('MP3 файлы '+#13#10+ mp3File +#13#10+'не найдены!'); exit; end; mp3player.Close; mp3player.FileName:=mp3File; mp3player.Open; mp3player.Play; Timer2.Enabled:= true; Progress.Max := mp3player.Length; TrackBar1.Max:= mp3player.Length; mm:= (mp3player.Length div 1000) div 60; ss:=(mp3player.Length div 1000)mod 60; mp3List.Hint:=mp3List.Items.Strings[mp3List.ItemIndex]; end; procedure TForm1.FormCreate(Sender: TObject); var voll,volr:word; begin txtFolder.Caption := ExtractFilePath(Application.ExeName); FillMP3FileList(txtFolder.Caption, mp3List.Items); Progress.Max:=0; TrackBar1.Max:=0; GetVolume(volL, volR); trackbar2.Position:=131070-volr+voll; end; procedure TForm1.ProgresTimerTimer(Sender: TObject); begin if Progress.Max<>0 then Progress.Position := mp3player.Position; end; procedure TForm1.Timer1Timer(Sender: TObject); begin Label7.Caption:=TimeToStr(Time); Label8.Caption:=DateToStr(Date); end; procedure TForm1.mp3playerNotify(Sender: TObject); var mp3File:string; begin with mp3player do if NotifyValue=nvSuccessful then begin Close; if mp3List.ItemIndex = mp3List.Items.Count-1 then begin timer2.Enabled:=false; exit; end else begin mp3List.ItemIndex:=mp3List.ItemIndex+1; mp3File := Concat(txtFolder.Caption, mp3List.Items.Strings[mp3List.ItemIndex]); FileName:=mp3File; Open; Progress.Max := Length; TrackBar1.Max:= Length; Play; mm:= (mp3player.Length div 1000) div 60; ss:=(mp3player.Length div 1000)mod 60; end;end; mp3List.Hint:=mp3List.Items.Strings[mp3List.ItemIndex]; end; procedure TForm1.N1Click(Sender: TObject); begin ShowMessage('Программа mp3Player является простейшим проигрывателем mp3-файлов'); end; procedure TForm1.mp3playerClick(Sender: TObject; Button: TMPBtnType; var DoDefault: Boolean); begin with mp3player do begin if button = btStop then Next; if button = btPlay then Timer2.Enabled:=true; end; end; procedure TForm1.TrackBar2Change(Sender: TObject); var LValue, RValue:DWord;hWO: HWAVEOUT; waveF: TWAVEFORMATEX; begin RValue:=TrackBar2.Position; LValue:=TrackBar2.Position; FillChar(waveF, SizeOf(waveF), 0); waveOutOpen(@hWO, WAVE_MAPPER, @waveF, 0, 0, 0); waveOutSetVolume(hWO, LValue + RValue shl 16); waveOutClose(hWO); end; procedure TForm1.TrackBar1Enter(Sender: TObject); begin TrackBar1.Position:=mp3player.Position; end; procedure TForm1.Timer2Timer(Sender: TObject); var m,s:integer; begin s:=mp3player.Position div 1000; m:=s div 60; if s=60 then begin s:=00; end else if s>60 then begin s:=s mod 60; end; Label1.Caption := Format('%.2d:%.2d',[M,S])+ ' из '+ Format('%.2d:%.2d',[mm,ss]); end; procedure TForm1.TrackBar3Change(Sender: TObject); var LValue, RValue:DWord;hWO: HWAVEOUT; waveF: TWAVEFORMATEX; begin RValue:=TrackBar3.Position; LValue:=65535-TrackBar3.Position; FillChar(waveF, SizeOf(waveF), 0); waveOutOpen(@hWO, WAVE_MAPPER, @waveF, 0, 0, 0); waveOutSetVolume(hWO, LValue + RValue shl 16); waveOutClose(hWO); end; procedure TForm1.TrackBar1Change(Sender: TObject); begin mp3player.Pause; mp3player.Position:=TrackBar1.Position; mp3player.Play; end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin application.Terminate; end; end.

Ответ отправил: Genia007 (статус: 8-ой класс) Ответ отправлен: 24.03.2008, 13:48

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