![]() |
|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
![]() |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
![]() Есть код программы, нужно реализовать эту программу в реальность. Форумчане помогите новичку
Код:
unit U_Main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls,strUtils, iniFiles, Buttons; type TReadThread = class(TThread) private protected procedure Execute; override; end; type TFm_Main = class(TForm) Panel1: TPanel; Ed_Ch1: TEdit; Label1: TLabel; Ed_Ch2: TEdit; Label2: TLabel; Tm_Reg: TTimer; Panel2: TPanel; SpeedButton1: TSpeedButton; Tm_Read: TTimer; ComboBox1: TComboBox; Label8: TLabel; Label7: TLabel; Label6: TLabel; Bevel1: TBevel; Label9: TLabel; Tm_Screen: TTimer; Label10: TLabel; Ed_Ch3: TEdit; Bevel2: TBevel; Bevel3: TBevel; SpeedButton2: TSpeedButton; Label3: TLabel; Label4: TLabel; Label5: TLabel; Ed_Ch4: TEdit; Ed_Ch5: TEdit; Ed_Ch6: TEdit; procedure FormCreate(Sender: TObject); procedure Tm_RegTimer(Sender: TObject); procedure SpeedButton1Click(Sender: TObject); procedure Tm_ReadTimer(Sender: TObject); procedure ComboBox1Change(Sender: TObject); procedure Tm_ScreenTimer(Sender: TObject); private { Private declarations } public { Public declarations } end; const Count_Ch=6; Time_delay=50; var Fm_Main: TFm_Main; DCB : TDCB; CT: TCommTimeouts; hPort : THandle; RegFile:TFileStream; ReadThread:TReadThread; NamePatch:String; ByteWritten,ByteReaded:dword; RegStart:boolean=false; ReadByte:array [0..255] of char; Value:array[0..16] of string; RegFileName,StrFile:string; str,s:string; tick:integer=0; tick_reg:integer=0; INI:TIniFile; Path:string; RSPort:string; Cycle:integer; implementation {$R *.dfm} function parse_date_time(str:string):string; begin if(length(str) = 1) then result:='0'+ str else result:=str; end; function DeleteLineBreaks(const S: string): string; var Source, SourceEnd: PChar; begin Source := Pointer(S); SourceEnd := Source + Length(S); while Source < SourceEnd do begin case Source^ of #10: Source^ :=#32; #13: Source^ :=#32; end; Inc(Source); end; Result := S; end; Function DeleteProbel(s: string): string; var i, n, L : integer; st:string; begin for i := 1 To length(s) do begin n:=pos(' ',s); If n<>0 Then begin Delete(s,n,2); n:=0; end; n:=pos(' ',s); If n<>0 Then begin Delete(s,n,1); n:=0; end; end; Result:=s; end; procedure StartRead; begin ReadThread:=TReadThread.Create(True); with ReadThread do begin Priority:=tpNormal; FreeOnTerminate:=True; Resume; end end; Procedure Create_RegFile; begin RegFileName:='Micron_'+datetostr(now)+'.csv'; if FileExists(RegFileName) Then begin RegFile := TFileStream.Create(RegFileName,fmOpenWrite or fmShareDenyRead); RegFile.Seek(0,soFromEnd); end else begin RegFile:=TFileStream.Create(RegFileName, fmCreate or fmOpenReadWrite or fmShareDenyNone); StrFile:=StrFile+'Время;SW;LW;RTO;WT;Alarm;Dtemp;'; // SW LW RTO WT Alarm Dtemp StrFile:= StrFile +#13+#10; RegFile.Write(PChar(StrFile)^, Length(StrFile)); end; end; Procedure Write_RegFile; var str:string; i:integer; Min, Hour, Sec, Msec: word; begin DecodeTime(Now, Hour, Min, Sec,Msec); StrFile:=''; StrFile:=StrFile+parse_date_time(IntToStr(Hour))+':'+parse_date_time(IntToStr(Min))+':'+parse_date_time(IntToStr(Sec))+'.'+parse_date_time(IntToStr(Msec))+';' +Value[1]+';'+Value[2]+';'+Value[3]+';'+Value[4]+';'+Value[5]+';'+Value[6]+';'; StrFile:= StrFile +#13; RegFile.Write(PChar(StrFile)^, Length(StrFile)); end; procedure clr_com; begin {PurgeComm(hPort,PURGE_TXCLEAR); PurgeComm(hPort,PURGE_RXCLEAR); PurgeComm(hPort,PURGE_RXABORT); PurgeComm(hPort,PURGE_TXABORT);} PurgeComm(hPort, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR); str:=''; s:=''; end; Function Init_Device():boolean; begin NamePatch:=ExtractFilePath('..\'); hPort := CreateFile(PChar(RSPort),GENERIC_READ + GENERIC_WRITE,0, nil,OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); if hPort = INVALID_HANDLE_VALUE then begin exit; end; if not GetCommState(hPort, DCB) then ShowMessage('Ошибка чтения настроек порта') else begin DCB.BaudRate :=CBR_19200; DCB.ByteSize :=8; DCB.StopBits :=ONESTOPBIT; DCB.Parity :=0; if not SetCommState(hPort, DCB) then ShowMessage('Ошибка записи настроек порта'); CT.ReadTotalTimeoutConstant:=80; CT.ReadIntervalTimeout := 80; CT.ReadTotalTimeoutMultiplier :=80; CT.WriteTotalTimeoutMultiplier := 80; CT.WriteTotalTimeoutConstant := 80; If Not SetCommTimeouts(hPort, CT) Then ShowMessage('Ошибка конфигурации таймаутов !!!'); if not SetupComm(hPort, 2048, 2048) then ShowMessage('Ошибка записи настроек буферов порта'); if PurgeComm(hPort, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR) then ; end; Result:=True; Fm_Main.Tm_Read.Interval:=Cycle; Fm_Main.Tm_Read.Enabled:=True; end; Procedure TReadThread.Execute; var index:integer; i:integer; s1:string; ch:byte; begin clr_com; str:=''; str:='яяM01R001'+#13; // Получить данные со всех каналов с устройства с адресом 01 WriteFile(hPort,pchar(str)^,Length(Str),ByteWritten,Nil); ReadFile(hport,ReadByte,SizeOf(ReadByte),ByteReaded,Nil); s:=ReadByte; s:=DeleteLineBreaks(s); s:=DeleteProbel(s); Value[1]:=MidStr(s,7,5); Value[2]:=MidStr(s,12,5); Value[3]:=MidStr(s,17,5); Value[4]:=MidStr(s,22,5); Value[5]:=MidStr(s,27,5); Value[6]:=MidStr(s,33,5); //яяM01R001 -запрос //01R001100001000000982000000000000020 - ответ //01 R001 10000 10000 00982 00000 00000 00020 // SW LW RTO WT Alarm Dtemp end; procedure TFm_Main.FormCreate(Sender: TObject); begin Path:=GetCurrentDir; INI := TIniFile.Create(Path+'\Settings.ini'); RSPort:=INI.ReadString('Main','Rsport','COM1'); Cycle:=INI.ReadInteger('Main','Cycle',1000); Init_Device; Create_RegFile; SpeedButton1.Caption:='ЗАПУСТИТЬ'+#13+#10+'РЕГИСТРАЦИЮ'; Label10.Caption:='Период регистрации'; end; procedure TFm_Main.Tm_RegTimer(Sender: TObject); begin If RegStart Then begin Write_RegFile; inc(tick_reg); Label8.Caption:='Регистрация: '+IntToStr(tick_reg); end; end; procedure TFm_Main.SpeedButton1Click(Sender: TObject); begin If SpeedButton1.Down Then begin RegStart:=True; SpeedButton1.Font.Color:=clRed; SpeedButton1.Caption:='ОСТАНОВИТЬ'+#13+#10+'РЕГИСТРАЦИЮ'; end Else begin RegStart:=False; SpeedButton1.Font.Color:=clGreen; SpeedButton1.Caption:='ЗАПУСТИТЬ'+#13+#10+'РЕГИСТРАЦИЮ'; end; end; procedure TFm_Main.Tm_ReadTimer(Sender: TObject); begin inc(tick); Label7.Caption:='Опрос Micron: '+IntToStr(tick); StartRead; end; procedure TFm_Main.ComboBox1Change(Sender: TObject); begin Case ComboBox1.ItemIndex Of 0: Tm_Reg.Interval:=100; 1: Tm_Reg.Interval:=500; 2: Tm_Reg.Interval:=1000; 3: Tm_Reg.Interval:=5000; 4: Tm_Reg.Interval:=10000; 5: Tm_Reg.Interval:=30000; 6: Tm_Reg.Interval:=60000; 7: Tm_Reg.Interval:=300000; 8: Tm_Reg.Interval:=1000000; end; end; function after(const Search, Find: string): string; var index: byte; begin index := Pos(Find, Search); if index = 0 then Result := '' else Result := Copy(Search, index + Length(Find), 255); end; procedure TFm_Main.Tm_ScreenTimer(Sender: TObject); begin Fm_Main.Ed_Ch1.Text:=Value[1]; Fm_Main.Ed_Ch2.Text:=Value[2]; Fm_Main.Ed_Ch3.Text:=Value[3]; Fm_Main.Ed_Ch4.Text:=Value[4]; Fm_Main.Ed_Ch5.Text:=Value[5]; Fm_Main.Ed_Ch6.Text:=Value[6]; end; end. Последний раз редактировалось Admin, 05.02.2014 в 19:36. |
#2
|
||||
|
||||
![]() а че не получается-то?
Я за здоровый экстрим! Спасибо за "спасибо") |
#3
|
||||
|
||||
![]() Кнопку с зеленой стрелочкой (на которой красный жучок) не видит.
— Как тебя понимать? — Понимать меня не обязательно. Обязательно меня любить и кормить вовремя. На Delphi, увы, больше не программирую. Рекомендуемая литература по программированию |
#4
|
|||
|
|||
![]() Форму не удается построить мне((,
|
#5
|
||||
|
||||
![]() Цитата:
|
#6
|
|||
|
|||
![]() Я даже компонентов таких не нашел таких как например Ed_ch1...Ed_ch6,
Tm_reg, Tm_read(( |
#7
|
||||
|
||||
![]() Это их имена в программе, а сами копоненты
Код:
Ed_Ch1: TEdit;// Это едит, поле для ввода Я не понял Вашего вопроса, но всё же Вам на него отвечу! |
#8
|
|||
|
|||
![]() Я поставил все кнопки панели и т.д, но все равно ничего не получается, выдает все время ошибку. Помогите с написанием этой программы((.
|
#9
|
||||
|
||||
![]() Цитата:
Цитата:
|
#10
|
|||
|
|||
![]() Error in module : Declaration of class TForm1 is missing or incorrect
|
#11
|
|||
|
|||
![]() Ну форму построить же можно?? Как это сделать
|
#12
|
||||
|
||||
![]() Цитата:
|
#13
|
||||
|
||||
![]() А вы кстати комбобокс заполнили? На всякий случай, нужно 9 строчек добавить - нажать на items и набрать их плюс записать в Text дефолтное значение интервала - иначе не будет у таймера выбора
Я не понял Вашего вопроса, но всё же Вам на него отвечу! |
#14
|
|||
|
|||
![]() Сейчас попробую заново сделать
![]() |
#15
|
|||
|
|||
![]() Да ну нафиг, ничего не получается!
|