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

Выпуск № 456
от 27.04.2006, 17:35

Вопрос № 40.949

Подскажите, как сформировать сочетания. Например, для 4 имеем следующее: 1 2 3 4 1 3 4 1 2 3 1 2 4 1 2 1 3 1 4 1 Главное чтобы в каждом из них присутствовала 1.

Отправлен: 21.04.2006, 17:29 Вопрос задал: Иванов Михаил Викторович (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Евгения Здравствуйте, Иванов Михаил Викторович! Привожу программу на Паскале ниже - написана конечно через н-ное место - но делает то,ч то вам надо :) под себя преобразуете. Приложение: const n=5; //кол-во чисел, которые надо перебрать type arr=array[1..n] of integer; var x: arr; m,j,k: integer; function find1(x: arr): boolean; var q: boolean; i: integer; begin q:=false; for i:=m downto 2 do if x[i]<>n-m+i then q:=true; find1:=q; end; function find2(x: arr): integer; var i: integer; begin i:=m; while not(x[i]<n-m+i) do i:=i-1; find2:=i; end; procedure print(x: arr); var i: integer; begin for i:=1 to n do if x[i]<>0 then write(x[i]); writeln; end; begin x[1]:=1; for m:=1 to n do begin for j:=2 to m do x[j]:=j; print(x); while find1(x) do begin k:=find2(x); x[k]:=x[k]+1; for j:=k+1 to m do x[j]:=x[j-1]+1; print(x); end; end; readln; end. --------- Я не волшебник, я только учусь... А разве кто-то обещал, что будет легко?

Ответ отправила: Евгения (статус: 4-ый класс) Ответ отправлен: 22.04.2006, 00:11

Отвечает: Полховский Александр Владимирович Здравствуйте, Иванов Михаил Викторович! Попытаюсь объяснить в общих чертах (без кода, ибо Вам его пример уже предоставили). Нужно в цикле for k1:=2 to N сформировать все возможные комбинации, имеющие k1 разряд. Делается это очень просто: фактически, мы имеем число в k1-той системе счисления. То есть, чтобы подобрать все варианты, достаточно перебирать цифры в первом разряде, изменяя их в других разрядах, если цифра дошла до максимального значения. Естественно, необходимо сделать проверку на совпадение цифр в разных разрядах. ну и Ваше условие с единицей туда воткнуть. Нет единицы - пропускаем число. Для формирования числа я бы пользовался типом string. Или же переводил число (очередное) в string и там обрабатывал условия. Хотелось бы верить, что для решения задачи этого хватит. --------- Спасём нашу хрупкую планету !

Ответ отправил: Полховский Александр Владимирович (статус: Практикант) Ответ отправлен: 23.04.2006, 17:19

Вопрос № 40.989

Как сделать чтобы Timer1 обрабатывал не только перемещение "мыши", но и нажатие на кнопку "мыши"? Короче, я сделал проц. MoveMouse(O:TObject); В ней обрабатываются координаты - всё OK. Теперь мне нужно сделать обработку на нажатие кнопок "мыши". Я сделал сначала это через в событиях Image1.OnMouseDown procedure ClickMouse(O:TObject;Button:TMouseButton;Shift:TShiftState;X,Y:Integer); Она конечно, реагирует на нажатие но не в ДИНАМИКЕ, а только при "Click'e". Короче, нужно как-то "объединить" эти две процедуры в одну и поставить в обработку Timer1. Я не могу поставить проц. ClickMouse на обработку в Timer1 - она попросту не ставиться. В итоге я хочу перещать объект по Image1 мышкой (левая кнопка). Само перемещение я уже сделал (относительно нач. координаты "мыши" и текущей), но оно реагирует только в "конце", когда нажимаешь кнопку еще раз. Это естественно, потому что опрос "мыши" идёт не динамически, а только при "Click'e". Как видите, я быстро учусь. Мне главное примеры несложные увидеть, а дальше я уже сам доведу. (Медленно запрягаю - быстро еду) Алекс

Отправлен: 22.04.2006, 00:43 Вопрос задал: AlexD (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 5)

Отвечает: Дмитриев Алексей Иванович Здравствуйте, AlexD! А почему бы Вам не использывать событие OnMouseMove, вместо OnTimer? Таким образом снижается и процессорное время, иснользуемое программой. В приложении привожу что-то вроде кода программы. Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; type TForm1 = class(TForm) Image1: TImage; procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; leftButton: Boolean; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); begin leftButton:=false; end; procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if leftButton xor (ssLeft in Shift) then leftButton:=ssLeft in Shift; if leftButton then ... //перемещаем объект в координаты X, Y, //которые уже определены при вызове этой процедуры автоматически end; end.

Ответ отправил: Дмитриев Алексей Иванович (статус: 1-ый класс) Ответ отправлен: 23.04.2006, 15:35

Отвечает: Полховский Александр Владимирович Здравствуйте, AlexD! Рискну предложить метод Drag'n'Drop. Вот простой пример (подробнее в справке можно узнать). unit Unit15; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TForm1 = class(TForm) Button1: TButton; procedure Button1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure Button1StartDrag(Sender: TObject; var DragObject: TDragObject); procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure Button1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Button1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private { Private declarations } public { Public declarations } end; var Form1: TForm1; dx, dy: integer; pressed1: boolean; implementation {$R *.dfm} procedure TForm1.Button1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin accept:=true; Button1.Left:=screentoclient(mouse.CursorPos).X-dx; Button1.Top:=screentoclient(mouse.CursorPos).Y-dy; end; procedure TForm1.Button1StartDrag(Sender: TObject; var DragObject: TDragObject); begin dx:=screentoclient(mouse.CursorPos).x-button1.Left; dy:=screentoclient(mouse.CursorPos).y-button1.Top; end; procedure TForm1.Button1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if pressed1 then Button1.BeginDrag(true); end; procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin pressed1:=true; end; procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin pressed1:=false; end; end. Надеюсь, обработчики сами сможете связать. --------- Спасём нашу хрупкую планету !

Ответ отправил: Полховский Александр Владимирович (статус: Практикант) Ответ отправлен: 23.04.2006, 16:03

Вопрос № 40.991

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

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

Отвечает: Лучников Ю.В. Здравствуйте, Stan! Почитайте на CodeNet ветку форума "SFX-архив в Delphi. Методы создания". Там же вы сможете найти рабочий пример обсуждаемого. Если какие-либо моменты нужно будет уточнить - пишите в мини-форум, поможем;) Успехов!

Ответ отправил: Лучников Ю.В. (статус: *Мастер-Эксперт) Россия, Киров WWW: нЧат - Наш Чат! ICQ: 176308580 ---- Ответ отправлен: 22.04.2006, 01:41

Вопрос № 41.017

Здравствуйте, вы не могля бы мне помочь? Мне нужно отправить почту с помощью моей программы. Как мне это лучше сделать? ( я просто не очень разбираюсь в протоколах, для меня что SMTP что POP3 разницы нет).

Отправлен: 22.04.2006, 15:30 Вопрос задал: Toxic~Fire (статус: 2-ой класс) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: mvp Здравствуйте, Toxic~Fire! Не помню, с какого сайта брал, но честно признаюсь, что не моё. Консольное приложение, которое отправляет простое письмо. Если вы знакомы с Delphi, то не составит труда оформить это в виде функции. Прада ошибки связи и т. п. придётся ловить самому Приложение: program SendMail; {$APPTYPE CONSOLE} uses SysUtils, nmsmtp; var NMSMTP1 : TNMSMTP; begin NMSMTP1 := TNMSMTP.Create(nil); with NMSMTP1 do begin try Host := 'freemail.ukr.net';{smtp-сервер вашего провайдера} UserID := 'vasya@ukr.net'; {ваша учётная запись почты} TimeOut := 5000; PostMessage.FromAddress := 'vasya@ukr.net';// адрес, который будет отображаться в теле от кого. Можно любой, т. е. он может не совпадать с vasya@ukr.net PostMessage.ToAddress.Text := 'fedya@mail.ru'; //кому PostMessage.Body.Text := 'this is test'; //текст сообщения PostMessage.Subject := 'test'; //тема Connect; SendMail; NMSMTP1.Disconnect; finally NMSMTP1.Free; end; end; { TODO -oUser -cConsole Main : Insert code here } end. --------- Моя совесть чиста - не бывшая в употреблении

Ответ отправил: mvp (статус: 10-ый класс) Ответ отправлен: 22.04.2006, 16:15

Отвечает: Diman_A Здравствуйте, Toxic~Fire! Возможны следующие варианты: - Вызвать почтовую программу по умолчанию с заполненными полями - Использовать MAPI - Использовать SMTP - Использовать COM интерфейс Outlook Автозаполнение формы письма в почтовой программе установленной по умолчанию: uses shellapi; ... procedure TForm1.Button1Click(Sender: TObject); begin shellexecute(handle, 'Open', 'mailto:necto@ya.com?subject=Regarding your advice&Body=First%20Line%0D%0ASecond%20line&CC=vnecto@server.com', nil, nil, sw_restore); end; Пробелы в тексте надо заполнять сочетанием %20 Конец строки обозначать как %0D%0A Поля отделять друг от друга символом & Работа через MAPI (Пример с delphi.mastak.ru) unit Email; interface uses Windows, SusUtils, Classes; function SendEmail(const RecipName, RecipAddress, Subject, Attachment: string): Boolean; function IsOnline: Boolean; implementation uses Mapi; function SendEmail(const RecipName, RecipAddress, Subject, Attachment: string): Boolean; var MapiMessage: TMapiMessage; MapiFileDesc: TMapiFileDesc; MapiRecipDesc: TMapiRecipDesc; i: integer; s: string; begin with MapiRecipDesc do begin ulRecerved:= 0; ulRecipClass:= MAPI_TO; lpszName:= PChar(RecipName); lpszAddress:= PChar(RecipAddress); ulEIDSize:= 0; lpEntryID:= nil; end; with MapiFileDesc do begin ulReserved:= 0; flFlags:= 0; nPosition:= 0; lpszPathName:= PChar(Attachment); lpszFileName:= nil; lpFileType:= nil; end; with MapiMessage do begin ulReserved := 0; lpszSubject := nil; lpszNoteText := PChar(Subject); lpszMessageType := nil; lpszDateReceived := nil; lpszConversationID := nil; flFlags := 0; lpOriginator := nil; nRecipCount := 1; lpRecips := @MapiRecipDesc; if length(Attachment) > 0 then begin nFileCount:= 1; lpFiles := @MapiFileDesc; end else begin nFileCount:= 0; lpFiles:= nil; end; end; Result:= MapiSendMail(0, 0, MapiMessage, MAPI_DIALOG or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0) = SUCCESS_SUCCESS; end; function IsOnline: Boolean; var RASConn: TRASConn; dwSize,dwCount: DWORD; begin RASConns.dwSize:= SizeOf(TRASConn); dwSize:= SizeOf(RASConns); Res:=RASEnumConnectionsA(@RASConns, @dwSize, @dwCount); Result:= (Res = 0) and (dwCount > 0); end; end. Пример отправки письма используя COM объект Outlook uses Outlook_TLB; var outlook : _application; Procedure Init;begin outlook := Coapplication_.Create; end; procedure SendEmail;begin with Outlook.CreateItem(olMailItem) as mailitem do begin To_ := 'email@email.com'; cc:='email2@email.com'; Subject := 'This is subject line'; Attachments.Add('FileName',1,1,'This is attachment'); Body :='This is email body'; Send; end; end; Пример работы с SMTP и исходник формы к нему смотри в приложении. Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, Psock, NMsmtp; type TForm1 = class(TForm) Memo: TRichEdit; Panel1: TPanel; SMTP: TNMSMTP; Panel2: TPanel; FromAddress: TEdit; predefined: TLabel; FromName: TEdit; Subject: TEdit; LocalProgram: TEdit; ReplyTo: TEdit; islog: TCheckBox; Host: TEdit; Port: TEdit; userid: TEdit; Button1: TButton; procedure Button1Click(Sender: TObject); private Procedure CleanContext; procedure PerformConnection; procedure AddMessage(msg:string; color:integer); procedure log(inpt :string); Procedure SetSMTP; public function SendEmail(_to, cc, bcc, Subject, body, attachment:string; HTMLFormat:boolean):boolean; end; var Form1: TForm1; implementation {$R *.DFM} Procedure TForm1.SetSMTP; begin SMTP.Host:=Host.Text; SMTP.Port:=strtoint(Port.text); SMTP.UserID:=userid.text; end; Function GetEmailDateTime:string; var tz:_time_Zone_information; s:string; begin GetTimeZoneInformation(tz); if (tz.Bias*100 div 60)<1000 then s:=format(' -0%d',[tz.Bias*100 div 60]) else s:=format(' -%d',[tz.Bias*100 div 60]); result:=formatdatetime('ddd, dd mmm yyyy hh:nn:ss',now)+s; end; Procedure TForm1.CleanContext; {set default values, some of them comes from "Setup" form} begin SMTP.PostMessage.FromAddress:=FromAddress.text; SMTP.PostMessage.FromName:=FromName.text; SMTP.PostMessage.ToAddress.Clear; SMTP.PostMessage.ToCarbonCopy.clear; SMTP.PostMessage.ToBlindCarbonCopy.clear; SMTP.PostMessage.Body.clear; SMTP.PostMessage.Attachments.clear; SMTP.PostMessage.Subject:=Subject.text; SMTP.PostMessage.LocalProgram:=LocalProgram.text; (*Mon, 27 Nov 2000 12:37:46 -0700*) SMTP.PostMessage.Date:=GetEmailDateTime; SMTP.PostMessage.ReplyTo:=ReplyTo.Text; end; procedure TForm1.log(inpt :string); var outf:textfile; begin {writing in the log file} if not islog.checked then exit; assignfile(outf, changefileext(paramstr(0), '.log')); if fileexists(changefileext(paramstr(0), '.log')) then append(outf) else rewrite(outf); writeln(outf, datetimetostr(now)+'|'+inpt); closefile(outf); end; procedure TForm1.AddMessage(msg:string; color:integer); begin {showing in the memo field progress...} while memo.lines.Count>2000 do memo.lines.Delete(0); memo.sellength:=0; memo.selstart:=length(memo.text); memo.selattributes.Color:=Color; memo.seltext:=#13#10+DateTimeTostr(now)+' '+msg; memo.perform($00B7,0,0); Application.ProcessMessages; if color<>clRed then log(DateTimeTostr(now)+' '+msg) else log('Error: '+DateTimeTostr(now)+' '+msg); end; procedure TForm1.PerformConnection; begin while (not SMTP.connected) do begin SetSMTP; AddMessage('Connecting to SMTP',clBlue); application.processmessages; try SMTP.Connect; AddMessage('No Errors',clBlue); except on e:exception do AddMessage('Error conection: '+e.message,clBlue); end; end; end; Function TForm1.SendEmail(_to, cc, bcc, Subject, body, attachment:string; HTMLFormat:boolean):boolean; begin PerformConnection; result:=true; CleanContext; try if (attachment<>'') and (not Fileexists(attachment)) then begin AddMessage('Attachment is not ready yet ('+ attachment+') ', clNavy); sleep(300); result:=false; exit; end; SMTP.PostMessage.ToAddress.text:=StringReplace(_to, ';',#13#10, [rfReplaceAll, rfIgnoreCase]); if cc<>'' then SMTP.PostMessage.ToCarbonCopy.text:=StringReplace(cc, ';',#13#10, [rfReplaceAll, rfIgnoreCase]); if bcc<>'' then SMTP.PostMessage.ToBlindCarbonCopy.text:=StringReplace(bcc, ';',#13#10, [rfReplaceAll, rfIgnoreCase]); if Subject<>'' then SMTP.PostMessage.Subject:=Subject; if HTMLFormat then SMTP.SubType:=mtPlain else SMTP.SubType:=mtHtml; SMTP.PostMessage.Body.Text:=Body; if attachment<>'' then SMTP.PostMessage.Attachments.add(attachment); AddMessage('Sending to '+ _to, clGreen); SMTP.SendMail; AddMessage('Complete.'+#13#10, clGreen); except on e:sysutils.exception do begin AddMessage(e.message, clRed); result:=false; end; end; end; procedure TForm1.Button1Click(Sender: TObject); begin SendEmail('necto@ya.com', '', '', 'test', 'body', '', False); end; end. object Form1: TForm1 Left = 278 Top = 108 Width = 539 Height = 480 Caption = 'Form1' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.style="[]" OldCreateOrder = False PixelsPerInch = 96 TextHeight = 13 object Memo: TRichEdit Left = 0 Top = 0 Width = 346 Height = 420 Align = alClient Lines.Strings = ('Memo') TabOrder = 0 end object Panel1: TPanel Left = 0 Top = 420 Width = 531 Height = 33 Align = alBottom Caption = 'Panel1' TabOrder = 1 object Button1: TButton Left = 440 Top = 8 Width = 75 Height = 25 Caption = 'Button1' TabOrder = 0 OnClick = Button1Click end end object Panel2: TPanel Left = 346 Top = 0 Width = 185 Height = 420 Align = alRight Caption = 'Panel2' TabOrder = 2 object predefined: TLabel Left = 8 Top = 8 Width = 87 Height = 13 Caption = 'predefined values:' end object FromAddress: TEdit Left = 24 Top = 32 Width = 121 Height = 21 TabOrder = 0 Text = 'FromAddress' end object FromName: TEdit Left = 24 Top = 56 Width = 121 Height = 21 TabOrder = 1 Text = 'FromName' end object Subject: TEdit Left = 24 Top = 80 Width = 121 Height = 21 TabOrder = 2 Text = 'Subject' end object LocalProgram: TEdit Left = 24 Top = 104 Width = 121 Height = 21 TabOrder = 3 Text = 'LocalProgram' end object ReplyTo: TEdit Left = 24 Top = 128 Width = 121 Height = 21 TabOrder = 4 Text = 'ReplyTo' end object islog: TCheckBox Left = 32 Top = 168 Width = 97 Height = 17 Caption = 'islog' TabOrder = 5 end object Host: TEdit Left = 24 Top = 240 Width = 121 Height = 21 TabOrder = 6 Text = 'Host' end object Port: TEdit Left = 24 Top = 264 Width = 121 Height = 21 TabOrder = 7 Text = 'Port' end object userid: TEdit Left = 24 Top = 288 Width = 121 Height = 21 TabOrder = 8 Text = 'userid' end end object SMTP: TNMSMTP Port = 25 ReportLevel = 0 EncodeType = uuMime ClearParams = True SubType = mtPlain Charset = 'us-ascii' Left = 296 Top = 32 end end

Ответ отправил: Diman_A (статус: 9-ый класс) Ответ отправлен: 22.04.2006, 17:27

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