一个导通机的控制程序

一个导通机的控制程序

打印用了 FastReport

编辑器用了 AdvMemo

皮肤用了 VclSkin

主窗体代码 

unit U_main;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, ImgList, ComCtrls, StdCtrls, ExtCtrls, RzPanel,RzTabs, AdvMemo, ActnList, Buttons, AAFont, AACtrls, RM_class, AppEvnts,SkinCaption, Mask, Grids, WinSkinData, FR_Class, FR_DSet, Menus;
constwm_begin_rec = wm_user + 101;
typetmyStringGrid = class(TStringGrid);TFrm_main = class(TForm)ImageList1: TImageList;StatusBar1: TStatusBar;RzPanel1: TRzPanel;RzPanel2: TRzPanel;ActionList1: TActionList;Action1: TAction;Action2: TAction;Action3: TAction;Action4: TAction;Action5: TAction;Action6: TAction;Action7: TAction;Action8: TAction;Action9: TAction;BitBtn1: TBitBtn;BitBtn2: TBitBtn;BitBtn3: TBitBtn;BitBtn4: TBitBtn;BitBtn7: TBitBtn;BitBtn9: TBitBtn;Shape1: TShape;AAScrollText1: TAAScrollText;OpenDialog1: TOpenDialog;Action10: TAction;BitBtn10: TBitBtn;BitBtn11: TBitBtn;Action11: TAction;RMReport1: TRMReport;ApplicationEvents1: TApplicationEvents;RzTabControl1: TRzTabControl;RzPageControl1: TRzPageControl;TabSheet1: TRzTabSheet;RzPanel4: TRzPanel;Image2: TImage;Label_zhu: TLabel;Label9: TLabel;TabSheet2: TRzTabSheet;RzPanel5: TRzPanel;Image1: TImage;Label_er: TLabel;Label10: TLabel;RzPanel3: TRzPanel;Label1: TLabel;Label2: TLabel;Label3: TLabel;Label4: TLabel;Label5: TLabel;Label6: TLabel;Label7: TLabel;Label8: TLabel;Edit1: TEdit;Edit2: TEdit;Edit4: TEdit;Edit_type: TEdit;Edit6: TEdit;Edit7: TEdit;Edit8: TEdit;Label11: TLabel;Edit9: TEdit;Label12: TLabel;Edit5: TEdit;Label13: TLabel;Edit10: TEdit;BitBtn6: TBitBtn;BitBtn5: TBitBtn;Edit3: TMaskEdit;StringGrid1: TStringGrid;StringGrid2: TStringGrid;Button1: TButton;SaveDialog1: TSaveDialog;SkinData1: TSkinData;SkinCaption1: TSkinCaption;frReport1: TfrReport;frReport_all: TfrReport;frUserDataset1: TfrUserDataset;frReport2: TfrReport;frReport3: TfrReport;frReport4: TfrReport;PopupMenu1: TPopupMenu;N1: TMenuItem;N2: TMenuItem;Memo1: TMemo;procedure AdvMemo1GutterDraw(Sender: TObject; ACanvas: TCanvas;LineNo: Integer; rct: TRect);procedure Action2Execute(Sender: TObject);procedure Action9Execute(Sender: TObject);procedure Action1Execute(Sender: TObject);procedure Action3Execute(Sender: TObject);procedure Action7Execute(Sender: TObject);procedure AdvMemo1Change(Sender: TObject);procedure AdvMemo2Change(Sender: TObject);procedure FormCreate(Sender: TObject);procedure Action10Execute(Sender: TObject);procedure FormDestroy(Sender: TObject);procedure Action4Execute(Sender: TObject);procedure Action11Execute(Sender: TObject);procedure RMReport1GetValue(const ParName: string;var ParValue: Variant);procedure RMReport1UserFunction(const Name: string; p1, p2,p3: Variant; var Val: Variant);procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);procedure RzTabControl1Change(Sender: TObject);procedure RzTabControl1Changing(Sender: TObject; NewIndex: Integer;var AllowChange: Boolean);procedure FormActivate(Sender: TObject);procedure BitBtn5Click(Sender: TObject);procedure Action5Execute(Sender: TObject);procedure Action6Execute(Sender: TObject);procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;Rect: TRect; State: TGridDrawState);procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);procedure StringGrid1Click(Sender: TObject);procedure StringGrid1KeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);procedure Button1Click(Sender: TObject);procedure StringGrid1KeyUp(Sender: TObject; var Key: Word;Shift: TShiftState);procedure StringGrid2KeyUp(Sender: TObject; var Key: Word;Shift: TShiftState);procedure frReport1GetValue(const ParName: string;var ParValue: Variant);procedure frReport1UserFunction(const Name: string; p1, p2,p3: Variant; var Val: Variant);procedure frUserDataset1First(Sender: TObject);procedure frUserDataset1Next(Sender: TObject);procedure frUserDataset1Prior(Sender: TObject);procedure frUserDataset1CheckEOF(Sender: TObject; var Eof: Boolean);procedure PopupMenu1Popup(Sender: TObject);procedure N1Click(Sender: TObject);procedure N2Click(Sender: TObject);privatesl_log: TStringList;FPath: string;ms_Head: TMemoryStream;ms_ZHU: TMemoryStream;ms_ER: TMemoryStream;sl_Print: TStringList;sl_p_all: TStringList;sl_e_all: TStringList;Buff: array of array of integer;ms_Head_list: array of TMemoryStream;ms_ZHU_list: array of TMemoryStream;ms_er_list: array of TMemoryStream;text_ZHU_list: array of string;text_er_list: array of string;edit_v_list: array of string;procedure beginrec(var Message: TMessage); message wm_begin_rec;function geteditv: string;procedure seteditv(v: string);procedure initForm(count: integer);function findFileByName(p, name, ver: string): string;function getnewfn(p: string): string;procedure setheadtoms(ms: TMemoryStream);function slheadtoeditv(sl: TStringList): string;procedure setlinecount(sg: TStringGrid; v: integer);function sgtotext(sg: TStringGrid): string;procedure texttosg(sl: TStringList; sg: TStringGrid);procedure stringtosg(s: string; sg: TStringGrid);procedure witeLog(v: string);publicfunction LoadDT(fn: string; sl_head, sl_zhu, sl_er: TStringList): boolean;function Check_zhu(willDisply: boolean = false): string;function Check_er(willDisply: boolean = false): string;procedure disPlay_Count;procedure save;procedure Load(V: string);procedure Del(V: string);procedure clearBuff;function getFirst(V: integer): integer;end;varFrm_main: TFrm_main;implementationuses u_dm, U_Device, U_new, U_SelectDeviceType,U_selectDir, u_pub, U_Export, FileCtrl, U_pass, U_h, U_copy;{$R *.dfm}procedure saveDt(fn, name: string; ms_Head, ms_zhu, ms_er: TMemoryStream);
varms: TMemoryStream;i: integer;b: Byte;s: string;
beginif ms_Head.Size <= 0 thenbeginShowMessage('保存失败(ms_Head.Size <= 0)！');exit;end;if ms_zhu.Size <= 0 thenbeginShowMessage('保存失败(ms_zhu.Size <= 0)！');exit;end;ms := TMemoryStream.Create;ms_Head.Position := 0;ms.CopyFrom(ms_Head, ms_Head.Size);ms_ZHU.Position := 0;ms.CopyFrom(ms_ZHU, ms_ZHU.Size);ms_ER.Position := 0;ms.CopyFrom(ms_ER, ms_ER.Size);s := ExtractFileName(fn);s := UpperCase(s);if pos('.DS', s) > 0 thenbeginb := 0;ms.Position := 63;ms.WriteBuffer(b, 1);end;
{b := 0;ms.Position := 32;for i := 1 to 18 doms.WriteBuffer(b, 1);name := copy(name, 1, 28);ms.Position := 32;ms.WriteBuffer(name[1], length(name));}ms.SaveToFile(fn);FreeAndNil(ms);end;function WTOW(V: word): Word;beginPChar(@Result)[0] := PChar(@V)[1];PChar(@Result)[1] := PChar(@V)[0];end;procedure TFrm_main.AdvMemo1GutterDraw(Sender: TObject; ACanvas: TCanvas;LineNo: Integer; rct: TRect);
begin
//ACanvas.Pen.Color := clBlack;inc(rct.Top);DrawText(ACanvas.Handle, pchar(IntToStr(LineNo + 1)), -1, rct, DT_CENTER or DT_SINGLELINE or DT_VCENTER);ACanvas.MoveTo(0, rct.Bottom);ACanvas.LineTo(rct.Right, rct.Bottom);
end;procedure TFrm_main.Action2Execute(Sender: TObject);
varFHlCount_now, i, m: integer;sl: TStringList;s: string;
beginFrm_new := TFrm_new.Create(nil);if Frm_new.ShowModal = mrok thenbeginedit1.Text := Trim(Frm_new.Edit1.Text);FHlCount_now := Frm_new.getHlCount;for i := 0 to RzTabControl1.Tabs.Count - 1 dobeginRzTabControl1.Tabs[i].Caption := '第' + IntToStr(i + 1) + '次导通';end;initForm(FHlCount_now);Edit2.Text := Trim(Frm_new.Edit2.Text);Edit3.Text := FormatDateTime('YYYY-MM-DD', Date);Edit4.Text := IntToStr(FHlCount_now);Edit_type.Text := getV('Device_type', Frm_new.ComboBox1.Text);Edit5.Text := '0';Edit6.Text := '0';Edit7.Text := '0';Edit8.Text := '0';Edit9.Text := '0';trym := strtoint(getV('Device_PCount', Frm_new.ComboBox1.Text));exceptm := 128;end;Edit10.Text := IntToStr(m);sl := TStringList.Create;for i := 1 to m dosl.Add('');for i := 0 to high(text_ZHU_list) dobegintext_ZHU_list[i] := sl.Text;end;for i := 0 to high(text_er_list) dobegintext_er_list[i] := sl.Text;end;s := geteditv;for i := 0 to high(edit_v_list) dobeginedit_v_list[i] := s;end;Label_er.Caption := '';Label_zhu.Caption := '';texttosg(sl, StringGrid1);texttosg(sl, StringGrid2);RzPageControl1.ActivePageIndex := 0;FreeAndNil(sl);BitBtn4.Enabled := true;end;FreeAndNil(Frm_new);
end;procedure TFrm_main.Action9Execute(Sender: TObject);
beginclose;
end;procedure TFrm_main.Action1Execute(Sender: TObject);
varerrmsg_1: string;errmsg_2: string;s: string;
begin
//Label_zhu.Caption := Check_zhu(true);Label_er.Caption := Check_er(true);Label_er.Caption := Check_er(true);errmsg_1 := Label_zhu.Caption;errmsg_2 := Label_er.Caption;if errmsg_1 <> '' thenbegins := '导通回路:' + #13 + errmsg_1;end;if errmsg_2 <> '' thenbeginif s <> '' thens := s + '二极管回路:' + #13;s := s + errmsg_2;end;// MessageDlg('回路检查完成!');// MessageDlg('回路检查完成!', mtInformation, [mbOK], 0);Application.MessageBox(pchar('回路检查完成!' + #13 + s), '提示', mb_OK)end;procedure TFrm_main.Action3Execute(Sender: TObject);beginFrm_selectDir := TFrm_selectDir.Create(nil);Frm_selectDir.StringGrid1.Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine];Frm_selectDir.StringGrid1.ColCount := Frm_selectDir.StringGrid1.ColCount + 1;Frm_selectDir.StringGrid1.Cells[Frm_selectDir.StringGrid1.ColCount - 1, 0] := '选择';Frm_selectDir.StringGrid1.ColWidths[Frm_selectDir.StringGrid1.ColCount - 1] := 54;Frm_selectDir.Button1.OnClick := Frm_selectDir.Button_delClick;Frm_selectDir.Button1.Caption := '删除';Frm_selectDir.Button2.Caption := '返回';Frm_selectDir.Caption := '删除';Frm_selectDir.setp(FPath);Frm_selectDir.ShowModal;FreeAndNil(Frm_selectDir);end;procedure TFrm_main.Action7Execute(Sender: TObject);
beginFrm_pass := TFrm_pass.Create(nil);if Frm_pass.ShowModal = mrok thenbeginFrm_device := TFrm_device.Create(nil);Frm_device.ShowModal;FreeAndNil(Frm_device);end;FreeAndNil(Frm_pass);
//
end;function TFrm_main.LoadDT(fn: string; sl_head, sl_zhu, sl_er: TStringList): boolean;
vari, oldi, m, FilePCount: integer;ms: TMemoryStream;count_zhu, count_er: word;PortType: byte;zhuList: array of word;str: string;w, w2, iNext: Word;sl_Device: tstringlist;WillDo: Boolean;beginResult := false;WillDo := false;sl_zhu.Clear;sl_er.Clear;ms := TMemoryStream.Create;ms.LoadFromFile(fn);getHead(ms, sl_head);count_zhu := StrToInt(sl_head.Values['设备点数']);PortType := StrToInt(sl_head.Values['接口方式']);count_er := StrToInt(sl_head.Values['二极管数']);WillDo := true;if WillDo thenbegintryFilePCount := getPCount_File(count_zhu, PortType);SetLength(zhuList, FilePCount + 1);ms.Position := 64;for i := 1 to FilePCount dobeginms.Read(w, sizeof(w));w := WTOW(w);zhuList[i] := w;end;for i := 1 to FilePCount doif zhuList[i] > 0 thenbeginstr := '';iNext := i;repeatif str <> '' thenstr := str + ',';m := From64(iNext, PortType);str := str + format('%3d', [m]);oldi := iNext;iNext := zhuList[iNext];if (oldi >= 0) and (oldi <= FilePCount) thenzhuList[oldi] := 0;until (iNext <= 0) or (iNext > FilePCount);sl_zhu.Add(str);end;for i := 1 to count_er dobeginms.Read(w, sizeof(w));ms.Read(w2, sizeof(w2));w := WTOW(w);w2 := WTOW(w2);str := format('%3d,%3d', [From64(w, PortType), From64(w2, PortType)]);sl_er.Add(str);end;while sl_zhu.Count < count_zhu dosl_zhu.Add('');while sl_er.Count < count_zhu dosl_er.Add('');Result := true;exceptend;end;SetLength(zhuList, 0);FreeAndNil(ms);
end;procedure TFrm_main.AdvMemo1Change(Sender: TObject);
beginAction5.Enabled := false;Label_zhu.Caption := Check_zhu;end;procedure TFrm_main.AdvMemo2Change(Sender: TObject);
beginAction5.Enabled := false;Label_er.Caption := Check_er;
end;function TFrm_main.Check_er(willDisply: boolean = false): string;
varmaxP_Count_shebei, oldLineCount, idx_2, idx, i, j, m, n: integer;sl, slTmp, slAll: TStringList;stmp2, strV: string;w: Word;ptype: byte;b: Byte;
beginEdit7.Text := '';Result := '';sl := TStringList.Create;sl_e_all.Clear;slTmp := TStringList.Create;slAll := TStringList.Create;sl.Text := sgtotext(StringGrid2); // AdvMemo2.Lines.Text;oldLineCount := StringGrid2.RowCount;maxP_Count_shebei := 999;if Edit1.Text <> '' thenbeginTryStrToInt(Edit10.Text, maxP_Count_shebei);end;tryfor i := 0 to sl.Count - 1 dobeginstrV := sl[i];strv := StringReplace(strV, ' ', #13, [rfReplaceAll]);strv := StringReplace(strV, ',', #13, [rfReplaceAll]);slTmp.Text := strV;for j := slTmp.Count - 1 downto 0 dobeginstrV := trim(slTmp[j]);if strV = '' thenslTmp.Delete(j)elsebeginif not TryStrToInt(strV, m) thenbeginResult := format('第%d行存在无效的数字"%s"', [i + 1, strV]);abort;endelsebeginif (m < 0) thenbeginResult := format('第%d行存在无效的点号"%s"(小于0)', [i + 1, strV]);abort;end;if (m = 0) thenbeginResult := format('第%d行存在无效的点号"%s"(等于0)', [i + 1, strV]);abort;end;if (m > maxP_Count_shebei) thenbeginResult := format('第%d行存在无效的点号"%s"(大于%d)', [i + 1, strV, maxP_Count_shebei]);abort;end;slTmp[j] := Format('%6s', [strV]);end;end;end;if (slTmp.Count <> 2) and (slTmp.Count > 0) thenbeginResult := format('第%d行不是2个数字', [i + 1]);abort;end;strv := '';for j := 0 to slTmp.Count - 1 dobeginstmp2 := trim(slTmp[j]);if sl_e_all.IndexOf(stmp2) < 0 thensl_e_all.Add(stmp2);if j > 0 thenstrv := strv + ',';strv := strv + Format('%3s', [stmp2]);end;if strV <> '' thenbeginj := slAll.IndexOf(strV);if j >= 0 thenbeginResult := format('第%d行和第%d行有相同二极管', [j + 1, i + 1]);Abort;end;end;sl[i] := strV;if strV <> '' thenslAll.Add(strV);end;for i := sl.Count - 1 downto 0 dobeginstrv := sl[i];if strv = '' thensl.Delete(i)elsebeginn := pos(',', strv);m := strtoint(trim(copy(strv, 1, n - 1)));n := strtoint(trim(copy(strv, n + 1, MaxInt)));m := getFirst(m);n := getFirst(n);if m = n thensl.Delete(i)elsesl[i] := Format('%3d,%3d', [m, n]);end;end;sl.Sort;Edit6.Text := IntToStr(sl.Count);if Edit1.Text <> '' thenbeginw := sl.Count; ;w := WTOW(w);if RzTabControl1.Tabs[1].Enabled thenb := 2elseb := 1;ms_ER.Size := sl.Count * 4;w := 0;ms_ER.Position := 0;for i := 1 to sl.Count dobeginms_ER.Write(w, sizeof(w));ms_ER.Write(w, sizeof(w));end;ptype := StrToInt(Edit_type.Text);for i := 0 to sl.Count - 1 dobeginstrV := sl[i];strv := StringReplace(strV, ',', #13, [rfReplaceAll]);slTmp.Text := strV;idx := StrToInt(Trim(slTmp[0]));idx_2 := StrToInt(Trim(slTmp[1]));ms_ER.Position := 4 * (i);w := To64(idx, ptype);w := WTOW(w);ms_ER.Write(w, sizeof(w));w := To64(idx_2, ptype);w := WTOW(w);ms_ER.Write(w, sizeof(w));end;end;if willDisply thenbeginwhile sl.Count < oldLineCount dosl.Add('');texttosg(sl, StringGrid2);end;disPlay_Count;exceptend;FreeAndNil(sl);FreeAndNil(slTmp);
end;function TFrm_main.Check_zhu(willDisply: boolean = false): string;
varmaxP_Count_shebei, ptype, oldLineCount, idx, idx_old, i, j, m, n, maxP_Count: integer;sl, slTmp, sl_Line: TStringList;strV: string;w: Word;BuffL: integer;
beginEdit7.Text := '';Result := '';clearBuff;sl := TStringList.Create;slTmp := TStringList.Create;sl_p_all.Clear;sl_Line := TStringList.Create;sl.Text := sgtotext(StringGrid1); //AdvMemo1.Lines.Text;oldLineCount := StringGrid1.RowCount;witeLog('Check_zhu:oldLineCount=' + IntToStr(oldLineCount));witeLog('Check_zhu:sl.Count=' + IntToStr(sl.Count));maxP_Count_shebei := 999;if Edit1.Text <> '' thenbeginTryStrToInt(Edit10.Text, maxP_Count_shebei);end;tryfor i := 0 to sl.Count - 1 dobeginstrV := sl[i];strv := StringReplace(strV, ' ', #13, [rfReplaceAll]);strv := StringReplace(strV, ',', #13, [rfReplaceAll]);slTmp.Text := strV;for j := slTmp.Count - 1 downto 0 dobeginstrV := trim(slTmp[j]);if strV = '' thenslTmp.Delete(j)elsebeginif not TryStrToInt(strV, m) thenbeginResult := format('第%d行存在无效的数字"%s"', [i + 1, strV]);abort;endelsebegin//if (m < 0) thenbeginResult := format('第%d行存在无效的点号"%s"(小于0)', [i + 1, strV]);abort;end;if (m = 0) thenbeginResult := format('第%d行存在无效的点号"%s"(等于0)', [i + 1, strV]);abort;end;if (m > maxP_Count_shebei) thenbeginResult := format('第%d行存在无效的点号"%s"(大于%d)', [i + 1, strV, maxP_Count_shebei]);abort;end;n := sl_p_all.IndexOf(strV);if n >= 0 thenbeginResult := format('第%s行和第%d行存在相同的数字"%s"', [sl_Line[n], i + 1, strV]);Abort;endelsebeginslTmp[j] := Format('%6s', [strV]);sl_p_all.Add(strV);sl_Line.Add(IntToStr(i + 1));end;end;end;end;slTmp.Sort;if slTmp.Count = 1 thenbeginResult := format('第%d行只有1个数字', [i + 1]);abort;end;strv := '';if slTmp.Count > 0 thenbeginBuffL := length(buff);setLength(buff, BuffL + 1);setlength(buff[BuffL], slTmp.Count);for j := 0 to slTmp.Count - 1 dobeginif willDisply thenbeginif j > 0 thenstrv := strv + ',';strv := strv + Format('%3s', [trim(slTmp[j])]);end;buff[BuffL][j] := StrToInt(trim(slTmp[j]));end;end;if willDisply thensl[i] := strV;end;if willDisply thenbeginwiteLog('for 1');for i := sl.Count - 1 downto 0 dobeginif sl[i] = '' thensl.Delete(i);end;witeLog('Sort');sl.Sort;Edit5.Text := IntToStr(sl.Count);endelsebeginm := 0;for i := 0 to sl.Count - 1 doif sl[i] <> '' theninc(m);Edit5.Text := IntToStr(m);end;if Edit1.Text <> '' thenbeginmaxP_Count := getPCount_File(StrToInt(Edit10.Text), StrToInt(Edit_type.Text));ptype := StrToInt(Edit_type.Text);w := StrToInt(Edit10.Text);w := WTOW(w);ms_ZHU.Size := maxP_Count * 2;w := 0;ms_ZHU.Position := 0;for i := 1 to maxP_Count doms_ZHU.Write(w, sizeof(w));if willDisply thenbeginwiteLog('to ms_ZHU');for i := 0 to sl.Count - 1 dobeginstrV := sl[i];strv := StringReplace(strV, ',', #13, [rfReplaceAll]);slTmp.Text := strV;for j := 0 to slTmp.Count - 1 dobeginidx_old := idx;idx := To64(StrToInt(Trim(slTmp[j])), ptype);if j > 0 thenbeginms_ZHU.Position := 2 * (idx_old - 1);w := idx;w := WTOW(w);ms_ZHU.Write(w, sizeof(w));end;end;end;end;end;if willDisply thenbeginwhile sl.Count < oldLineCount dosl.Add('');texttosg(sl, StringGrid1);end;disPlay_Count;excepton E: Exception dobeginwiteLog(e.Message);clearBuff;end;end;FreeAndNil(sl);FreeAndNil(slTmp);// sl_p_all.Clear;
end;procedure TFrm_main.FormCreate(Sender: TObject);
vari: integer;b: Byte;sl: TStringList;
beginsl_log := TStringList.Create;sl_Print := TStringList.Create;sl_p_all := TStringList.Create;sl_e_all := TStringList.Create;Label_er.Caption := '';Label_zhu.Caption := '';RzPageControl1.ActivePageIndex := 0;SetLength(ms_Head_list, RzTabControl1.Tabs.Count);for i := 0 to high(ms_Head_list) dobeginms_Head_list[i] := TMemoryStream.Create;end;SetLength(ms_ZHU_list, RzTabControl1.Tabs.Count);for i := 0 to high(ms_ZHU_list) dobeginms_ZHU_list[i] := TMemoryStream.Create;end;SetLength(ms_ER_list, RzTabControl1.Tabs.Count);for i := 0 to high(ms_ER_list) dobeginms_ER_list[i] := TMemoryStream.Create;end;SetLength(text_ZHU_list, RzTabControl1.Tabs.Count);for i := 0 to high(text_ZHU_list) dobegintext_ZHU_list[i] := '';end;SetLength(text_er_list, RzTabControl1.Tabs.Count);for i := 0 to high(text_er_list) dobegintext_er_list[i] := '';end;SetLength(edit_v_list, RzTabControl1.Tabs.Count);for i := 0 to high(edit_v_list) dobeginedit_v_list[i] := '';end;ms_Head := ms_Head_list[0];ms_ZHU := ms_ZHU_list[0];ms_er := ms_er_list[0];b := 0;for i := 1 to 64 doms_Head.Write(b, 1);setlinecount(StringGrid1, 128);setlinecount(StringGrid2, 128);
end;procedure TFrm_main.Action10Execute(Sender: TObject);
varv: string;i: integer;
beginLabel_er.Caption := '';Label_zhu.Caption := '';Frm_selectDir := TFrm_selectDir.Create(nil);Frm_selectDir.setp(FPath);if Frm_selectDir.ShowModal = mrok thenbeginv := Frm_selectDir.getfn;endelsebegin;end;FreeAndNil(Frm_selectDir);if not FileExists(v) thenexit;load(v);StringGrid1.Row := 0;StringGrid2.Row := 0;Check_zhu(true);Check_er(true);
//BitBtn4.Enabled := true;Action5.Enabled := true;
end;procedure TFrm_main.FormDestroy(Sender: TObject);
vari: integer;
beginfor i := 0 to high(ms_Head_list) dobeginms_Head_list[i].Free;end;for i := 0 to high(ms_ZHU_list) dobeginms_ZHU_list[i].Free;end;for i := 0 to high(ms_ZHU_list) dobeginms_ER_list[i].Free;end;for i := 0 to high(text_ZHU_list) dobegintext_ZHU_list[i] := '';end;for i := 0 to high(text_er_list) dobegintext_er_list[i] := '';end;FreeAndNil(sl_Print);FreeAndNil(sl_p_all);FreeAndNil(sl_e_all);FreeAndNil(sl_log);clearBuff;
end;procedure TFrm_main.Action4Execute(Sender: TObject);
varstr, str2, errmsg, fn: string;isTAB: boolean;l, i, m, idx, j: integer;idxlist: array of integer;
begintryBitBtn4.Enabled := false;if Edit1.Text = '' thenbegin//ShowMessage('请先新建线束!');Application.MessageBox('请先新建线束!', '提示', mb_OK);exit;end;F_H := TF_H.Create(nil);F_H.Show;Enabled := false;for j := 1 to 1000 dobeginApplication.ProcessMessages;end;sleep(10);for j := 1 to 1000 dobeginApplication.ProcessMessages;end;SetLength(idxlist, 1);idxlist[0] := RzTabControl1.TabIndex;F_H.Label1.Caption := '正在准备数据';F_H.Update;Application.ProcessMessages;for i := 0 to RzTabControl1.Tabs.Count - 1 dobeginif RzTabControl1.Tabs[i].Enabled thenif i <> idxlist[0] thenbeginl := length(idxlist);setlength(idxlist, l + 1);idxlist[l] := i;F_H.Label1.Caption := '读取数据 第' + IntToStr(i + 1) + '段';F_H.Update;Application.ProcessMessages;end;end;idx := RzTabControl1.TabIndex;text_ZHU_list[idx] := sgtotext(StringGrid1); // AdvMemo1.Lines.Text;text_er_list[idx] := sgtotext(StringGrid2); //AdvMemo2.Lines.Text;edit_v_list[idx] := geteditv;F_H.Label1.Caption := '正在分析数据！';Application.ProcessMessages;for m := 0 to high(idxlist) dobeginidx := idxlist[m];RzTabControl1.OnChange := nil;RzTabControl1.OnChanging := nil;RzTabControl1.TabIndex := idx;RzTabControl1Change(RzTabControl1);RzTabControl1.Refresh;RzTabControl1.Update;RzPanel3.Refresh;RzPanel3.Update;RzPageControl1.Refresh;RzPageControl1.Update;for j := 1 to 1000 dobeginApplication.ProcessMessages;end;Sleep(100);RzTabControl1.OnChange := RzTabControl1Change;RzTabControl1.OnChanging := RzTabControl1Changing;seteditv(edit_v_list[idx]);errmsg := Check_zhu(true);if errmsg <> '' thenbegin//ShowMessage(errmsg);Application.MessageBox(pchar(errmsg), '提示', mb_OK);SetLength(idxlist, 0);BitBtn4.Enabled := true;Enabled := true;FreeAndNil(F_H);Exit;end;errmsg := Check_er(true);errmsg := Check_er(true);if errmsg <> '' thenbegin//        ShowMessage(errmsg);Application.MessageBox(pchar(errmsg), '提示', mb_OK);SetLength(idxlist, 0);BitBtn4.Enabled := true;Enabled := true;FreeAndNil(F_H);Exit;end;setheadtoms(ms_Head);end;F_H.Label1.Caption := '正在生成文件！';Application.ProcessMessages;if pos(' ', RzTabControl1.Tabs[0].Caption) < 1 thenbeginfn := findFileByName(FPath, Edit1.Text, Edit2.Text);if fn <> '' thenbeginstr := '已经存在' + fn + str + '(线束名称:' + Edit1.Text + ' 版本号:' + Edit2.Text + ')';str := str + ',是否覆盖？';if Application.MessageBox(pchar(str), '提示', MB_OKCANCEL) <> IDOK thenbeginBitBtn4.Enabled := true;Enabled := true;FreeAndNil(F_H);Exit;end;endelsebeginfn := getnewfn(FPath);end;RzTabControl1.Tabs[0].Caption := RzTabControl1.Tabs[0].Caption + ' ' + fn;if RzTabControl1.Tabs[1].Enabled thenbeginstr := ExtractFilePath(fn);str2 := ExtractFileName(fn);str2[1] := 'S';str2[10] := 'S';RzTabControl1.Tabs[1].Caption := RzTabControl1.Tabs[1].Caption + ' ' + str + str2;end;end;save;F_H.Label1.Caption := '保存成功！';F_H.Button1.Enabled := true;Application.ProcessMessages;Action5.Enabled := true;if Length(idxlist) > 0 thenbeginRzTabControl1.TabIndex := idxlist[0];end;SetLength(idxlist, 0);BitBtn4.Enabled := true;exceptend;end;procedure TFrm_main.save;
vars, p, Fn, fn_now: string;i, j: integer;
beginfor i := 0 to RzTabControl1.Tabs.Count - 1 doif RzTabControl1.Tabs[i].Enabled thenbeginfn_now := RzTabControl1.Tabs[i].Caption;j := pos(' ', fn_now);if j > 0 thenbeginfn_now := copy(fn_now, j + 1, MaxInt);end;saveDt(fn_now, trim(Edit1.Text), ms_Head_list[i], ms_ZHU_list[i], ms_er_list[i]);end;
end;procedure TFrm_main.Del(V: string);
vars: string;fn: string;
beginDeleteFile(fn);
end;procedure TFrm_main.Load(V: string);
vars, p, Fn, str, str2: string;sl_head, sl_zhu, sl_er: TStringList;i, j: integer;
beginfn := v;sl_head := TStringList.Create;sl_zhu := TStringList.Create;sl_er := TStringList.Create;LoadDT(fn, sl_head, sl_zhu, sl_er);text_ZHU_list[0] := sl_zhu.Text;text_er_list[0] := sl_er.Text;edit_v_list[0] := slheadtoeditv(sl_head);initForm(StrToInt(sl_head.Values['导通次数']));for i := 0 to RzTabControl1.Tabs.Count - 1 dobeginRzTabControl1.Tabs[i].Caption := '第' + IntToStr(i + 1) + '次导通';end;RzTabControl1.Tabs[0].Caption := RzTabControl1.Tabs[0].Caption + ' ' + fn;if sl_head.Values['导通次数'] = '2' thenbeginstr := ExtractFilePath(fn);str2 := ExtractFileName(fn);str2[1] := 'S';str2[10] := 'S';fn := str + str2;RzTabControl1.Tabs[1].Caption := '第2次导通' + ' ' + fn;if FileExists(fn) thenbeginLoadDT(fn, sl_head, sl_zhu, sl_er);text_ZHU_list[1] := sl_zhu.Text;text_er_list[1] := sl_er.Text;edit_v_list[1] := slheadtoeditv(sl_head);endelsebeginedit_v_list[1] := slheadtoeditv(sl_head);end;end;stringtosg(text_ZHU_list[0], StringGrid1);stringtosg(text_er_list[0], StringGrid2);Action5.Enabled := false;seteditv(edit_v_list[0]);Label_zhu.Caption := Check_zhu;Label_er.Caption := Check_er;
end;procedure TFrm_main.Action11Execute(Sender: TObject);
vari, m, line: integer;str, str2, strLine: string;slTmp: TStringList;
beginsl_Print.Clear;frReport_all.EMFPages.Clear;RzTabControl1.TabIndex := 0;Check_zhu(true);Check_er(true);sl_Print.Text := sgtotext(StringGrid1);for i := sl_Print.count - 1 downto 0 dobeginstr := trim(sl_Print[i]);if str = '' thensl_Print.Delete(i)elsesl_Print[i] := str;end;frReport1.PrepareReport;frReport_all.EMFPages.AddFrom(frReport1);sl_Print.Text := sgtotext(StringGrid2);for i := sl_Print.count - 1 downto 0 dobeginstr := trim(sl_Print[i]);if str = '' thensl_Print.Delete(i)elsesl_Print[i] := str;end;if sl_Print.Count > 0 thenbeginfrReport2.PrepareReport;frReport_all.EMFPages.AddFrom(frReport2);end;if RzTabControl1.Tabs[1].Enabled thenbeginRzTabControl1.TabIndex := 1;Check_zhu(true);Check_er(true);sl_Print.Text := sgtotext(StringGrid1);for i := sl_Print.count - 1 downto 0 dobeginstr := trim(sl_Print[i]);if str = '' thensl_Print.Delete(i)elsesl_Print[i] := str;end;frReport3.PrepareReport;frReport_all.EMFPages.AddFrom(frReport3);sl_Print.Text := sgtotext(StringGrid2);for i := sl_Print.count - 1 downto 0 dobeginstr := trim(sl_Print[i]);if str = '' thensl_Print.Delete(i)elsesl_Print[i] := str;end;if sl_Print.Count > 0 thenbeginfrReport4.PrepareReport;frReport_all.EMFPages.AddFrom(frReport4);end;end;frReport_all.ShowPreparedReport;exit;sl_Print.Clear;slTmp := TStringList.Create;sl_Print.Add('序号 导通回路');line := 0;for i := 0 to StringGrid1.RowCount - 1 dobeginstr := StringGrid1.Cells[1, i];if str = '' thenContinue;str := StringReplace(str, ' ', #13, [rfReplaceAll]);str := StringReplace(str, ',', #13, [rfReplaceAll]);slTmp.Text := str;inc(line);strLine := IntToStr(line);str := '';for m := 0 to slTmp.Count - 1 dobeginstr2 := trim(slTmp[m]);if str2 = '' thenContinue;if str <> '' thenstr := str + ',';str := str + str2;if length(str) > 90 thenbeginsl_Print.Add(Format('%3s %s', [strLine, str]));str := '';strLine := '';end;end;if str <> '' thensl_Print.Add(Format('%3s %s', [strLine, str]));end;sl_Print.Add('序号 二极管回路');line := 0;for i := 0 to StringGrid2.RowCount - 1 dobeginstr := trim(StringGrid2.Cells[1, i]);if str = '' thenContinue;inc(line);sl_Print.Add(Format('%3d %s', [line, str]));end;TRMBandView(RMReport1.Pages[0].FindObject('MasterData1')).DataSet := IntToStr(sl_Print.Count);RMReport1.ShowReport;FreeAndNil(slTmp);sl_Print.Clear;
end;procedure TFrm_main.RMReport1GetValue(const ParName: string;var ParValue: Variant);
beginif SameText(ParName, '线束名称') thenbeginParValue := Edit1.Text;exit;end;if SameText(ParName, '设备型号') thenbeginParValue := Edit2.Text;exit;end;if SameText(ParName, '设备编号') thenbeginParValue := Edit3.Text;exit;end;if SameText(ParName, '版本号') thenbeginParValue := Edit4.Text;exit;end;if SameText(ParName, '回路数量') thenbeginParValue := Edit5.Text;exit;end;if SameText(ParName, '二极管数') thenbeginParValue := Edit6.Text;exit;end;if SameText(ParName, '使用点数') thenbeginParValue := Edit7.Text;exit;end;if SameText(ParName, '修改时间') thenbeginParValue := Edit8.Text;exit;end;
end;procedure TFrm_main.RMReport1UserFunction(const Name: string; p1, p2,p3: Variant; var Val: Variant);
varidx: integer;
beginif SameText(Name, 'MyLine') thenbeginidx := RMParser.Calc(p1) - 1;if (idx >= 0) and (idx < sl_Print.Count) thenbeginVal := sl_Print[idx];endelsebeginVal := '';end;exit;end;
end;procedure TFrm_main.disPlay_Count;
varc, i: integer;
beginc := sl_p_all.Count;for i := 0 to sl_e_all.Count - 1 dobeginif sl_p_all.IndexOf(sl_e_all[i]) < 0 theninc(c);end;Edit7.Text := IntToStr(c);
end;procedure TFrm_main.clearBuff;
vari: integer;
beginfor i := 0 to high(Buff) dobeginSetLength(Buff[i], 0);end;setlength(Buff, 0);
end;function TFrm_main.getFirst(V: integer): integer;
vari, j: integer;
beginResult := v;for i := 0 to high(Buff) dobeginfor j := 0 to high(Buff[i]) dobeginif v = Buff[i][j] thenbeginResult := Buff[i][0];exit;end;end;end;//
end;procedure TFrm_main.ApplicationEvents1Exception(Sender: TObject;E: Exception);
begin
//
end;procedure TFrm_main.RzTabControl1Change(Sender: TObject);
varidx: integer;
beginidx := RzTabControl1.TabIndex;ms_Head := ms_Head_list[idx];ms_ZHU := ms_ZHU_list[idx];ms_ER := ms_ER_list[idx];seteditv(edit_v_list[idx]);stringtosg(text_ZHU_list[idx], StringGrid1);stringtosg(text_er_list[idx], StringGrid2);StringGrid1.Row := 0;StringGrid2.Row := 0;RzPageControl1.ActivePageIndex := 0;
end;procedure TFrm_main.RzTabControl1Changing(Sender: TObject;NewIndex: Integer; var AllowChange: Boolean);
varidx: integer;
beginidx := RzTabControl1.TabIndex;text_ZHU_list[idx] := sgtotext(StringGrid1);text_er_list[idx] := sgtotext(StringGrid2);edit_v_list[idx] := geteditv;
end;procedure TFrm_main.FormActivate(Sender: TObject);
beginOnActivate := nil;FPath := Path_DT;if length(FPath) > 0 thenbeginif FPath[length(FPath)] = '\' thenbeginSetLength(FPath, length(FPath) - 1);end;end;StatusBar1.Panels[1].Text := ' 数据文件目录: ' + FPath;
end;procedure TFrm_main.beginrec(var Message: TMessage);
beginend;function TFrm_main.geteditv: string;
vari: integer;e: TEdit;
beginResult := '';for i := 0 to RzPanel3.ControlCount - 1 dobeginif RzPanel3.Controls[i] is TEdit thenbeginif Result <> '' thenResult := Result + #13#10;e := TEdit(RzPanel3.Controls[i]);Result := Result + e.Name + '=' + e.Text;endelseif RzPanel3.Controls[i] is TMaskEdit thenbeginif Result <> '' thenResult := Result + #13#10;Result := Result + TMaskEdit(RzPanel3.Controls[i]).Name + '=' + TMaskEdit(RzPanel3.Controls[i]).Text;endend
end;procedure TFrm_main.seteditv(v: string);
vare: TEdit;i: integer;sl: TStringList;
beginsl := TStringList.Create;sl.Text := v;for i := 0 to RzPanel3.ControlCount - 1 dobeginif RzPanel3.Controls[i] is TEdit thenbegine := TEdit(RzPanel3.Controls[i]);e.Text := sl.Values[e.Name];endelseif RzPanel3.Controls[i] is TMaskEdit thenbeginTMaskEdit(RzPanel3.Controls[i]).Text := sl.Values[RzPanel3.Controls[i].Name];end;end;FreeAndNil(sl);
end;procedure TFrm_main.initForm(count: integer);
vari: integer;
beginRzTabControl1.OnChange := nil;RzTabControl1.OnChanging := nil;for i := 0 to RzTabControl1.Tabs.Count - 1 dobeginRzTabControl1.Tabs[i].Enabled := i < count;end;RzTabControl1.TabIndex := 0;RzTabControl1.OnChange := RzTabControl1Change;RzTabControl1.OnChanging := RzTabControl1Changing;end;function TFrm_main.findFileByName(p, name, ver: string): string;
varsr: TSearchRec;ss, sv: TStringList;ms: TMemoryStream;s, fn: string;i: integer;
beginResult := '';ss := TStringList.Create;sv := TStringList.Create;if FindFirst(pchar(p + '\TAB????.DT'), faAnyFile, sr) = 0 thenbeginrepeatif length(sr.Name) = length('TAB????.DT') thenbegins := sr.Name;s := copy(s, 4, 4);tryStrToInt(s);ss.Add(sr.Name);exceptend;end;until FindNext(sr) <> 0;FindClose(sr);end;ms := TMemoryStream.Create;if ss.Count > 0 thenfor i := 0 to ss.Count - 1 dobeginfn := p + '\' + ss[i];ms.LoadFromFile(fn);trygetHead(ms, sv);if SameText(sv.Values['线束名'], name) and SameText(sv.Values['版本号'], ver) thenbeginResult := fn;Break;end;exceptend;end;FreeAndNil(ss);FreeAndNil(sv);FreeAndNil(ms);
end;function TFrm_main.getnewfn(p: string): string;
varsr: TSearchRec;ss: TStringList;i: integer;fn: string;
beginResult := '';ss := TStringList.Create;if FindFirst(pchar(p + '\TAB????.DT'), faAnyFile, sr) = 0 thenbeginrepeatss.Add(UpperCase(sr.Name));until FindNext(sr) <> 0;FindClose(sr);end;for i := 0 to 9999 dobeginfn := 'TAB' + copy(IntToStr(i + 10000), 2, 4) + '.DT';if ss.IndexOf(fn) < 0 thenbeginResult := p + '\' + fn;Break;end;end;if Result = '' thenbeginResult := p + '\TAB9999.DT';end;FreeAndNil(ss);end;procedure TFrm_main.setheadtoms(ms: TMemoryStream);
varsl: TStringList;
beginsl := TStringList.Create;sl.Values['合格数'] := Edit8.Text;sl.Values['不合格数'] := Edit9.Text;sl.Values['二极管数'] := Edit6.Text;sl.Values['设备点数'] := Edit10.Text;sl.Values['接口方式'] := Edit_type.Text;sl.Values['版本号'] := Edit2.Text;sl.Values['日期'] := Edit3.Text;sl.Values['线束名'] := Edit1.Text;sl.Values['导通次数'] := Edit4.Text;setHead(ms, sl);FreeAndNil(sl);
end;function TFrm_main.slheadtoeditv(sl: TStringList): string;
varsl_result: TStringList;
beginsl_result := TStringList.Create;sl_result.Values['Edit8'] := sl.Values['合格数'];sl_result.Values['Edit9'] := sl.Values['不合格数'];sl_result.Values['Edit6'] := sl.Values['二极管数'];sl_result.Values['Edit10'] := sl.Values['设备点数'];sl_result.Values['Edit_type'] := sl.Values['接口方式'];sl_result.Values['Edit2'] := sl.Values['版本号'];sl_result.Values['Edit3'] := sl.Values['日期'];sl_result.Values['Edit1'] := sl.Values['线束名'];sl_result.Values['Edit4'] := sl.Values['导通次数'];Result := sl_result.Text;
end;procedure TFrm_main.BitBtn5Click(Sender: TObject);
begin
//
end;procedure TFrm_main.Action5Execute(Sender: TObject);
vari: integer;str, s, errmsg, fromfn, d, fn1, fn2, fn1_to, fn2_to: string;
beginif Edit1.Text = '' thenbegin// ShowMessage('请先新建线束!');Application.MessageBox('请先新建线束!', '提示', mb_OK);exit;end;d := '';Frm_Export := TFrm_Export.Create(nil);if Frm_Export.ShowModal = mrok thenbegin//save;d := Frm_Export.DriveComboBox1.Drive + ':';end;FreeAndNil(Frm_Export);if d = '' thenexit;fn1 := RzTabControl1.Tabs[0].Caption;i := pos(' ', fn1);if i > 0 thenfn1 := copy(fn1, i + 1, MaxInt)elsefn1 := '';fn2 := RzTabControl1.Tabs[1].Caption;i := pos(' ', fn2);if i > 0 thenfn2 := copy(fn2, i + 1, MaxInt)elsefn2 := '';fn1_to := findFileByName(d, Edit1.Text, Edit2.Text);if fn1_to <> '' thenbeginstr := '已经存在' + fn1_to + str + '(线束名称:' + Edit1.Text + ' 版本号:' + Edit2.Text + ')';str := str + ',是否覆盖？';if Application.MessageBox(pchar(str), '提示', MB_OKCANCEL) <> IDOK thenbeginexit;end;endelsebeginfn1_to := getnewfn(d)end;if fn1 <> '' thenfn1_to := d + '\' + ExtractFileName(fn1_to);if fn2 <> '' thenbeginfn2_to := ExtractFileName(fn1_to);fn2_to[1] := 'S';fn2_to[10] := 'S';fn2_to := d + '\' + fn2_to;end;if fn1_to <> '' thenCopyFile(pchar(fn1), pchar(fn1_to), false);if fn2_to <> '' thenCopyFile(pchar(fn2), pchar(fn2_to), false);s := '导出为';if fn1_to <> '' thens := s + fn1_to;if fn2_to <> '' thens := s + ',' + fn2_to;
//  ShowMessage(s);Application.MessageBox(pchar(s), '提示', mb_OK);end;procedure TFrm_main.Action6Execute(Sender: TObject);
varv, fn, d: string;strname, strver, str, s, fn1, fn2, fn1_to, fn2_to: string;
begind := '';Frm_Export := TFrm_Export.Create(nil);Frm_Export.Caption := '导入';if Frm_Export.ShowModal = mrok thenbegin//save;d := Frm_Export.DriveComboBox1.Drive + ':';end;FreeAndNil(Frm_Export);if d = '' thenexit;Frm_selectDir := TFrm_selectDir.Create(nil);Frm_selectDir.setp(d);if Frm_selectDir.ShowModal = mrok thenbeginv := Frm_selectDir.getfn;strname := Frm_selectDir.StringGrid1.Cells[1, Frm_selectDir.StringGrid1.Row];strver := Frm_selectDir.StringGrid1.Cells[2, Frm_selectDir.StringGrid1.Row];endelsebegin;end;FreeAndNil(Frm_selectDir);if not FileExists(v) thenexit;fn1 := v;fn2 := ExtractFileName(v);fn2[1] := 'S';fn2[10] := 'S';fn2 := ExtractFilePath(fn1) + fn2;if not FileExists(fn2) thenfn2 := '';fn1_to := findFileByName(FPath, strname, strver);if fn1_to <> '' thenbeginstr := '已经存在' + fn1_to + str + '(线束名称:' + strname + ' 版本号:' + strver + ')';str := str + ',是否覆盖？';if Application.MessageBox(pchar(str), '提示', MB_OKCANCEL) <> IDOK thenbeginexit;end;endelsebeginfn1_to := getnewfn(FPath)end;if fn1 <> '' thenfn1_to := FPath + '\' + ExtractFileName(fn1_to);if fn2 <> '' thenbeginfn2_to := ExtractFileName(fn1_to);fn2_to[1] := 'S';fn2_to[10] := 'S';fn2_to := FPath + '\' + fn2_to;end;if fn1_to <> '' thenCopyFile(pchar(fn1), pchar(fn1_to), false);if fn2_to <> '' thenCopyFile(pchar(fn2), pchar(fn2_to), false);s := '导入为';if fn1_to <> '' thens := s + fn1_to;if fn2_to <> '' thens := s + ',' + fn2_to;//ShowMessage(s);Application.MessageBox(pchar(s), '提示', mb_OK);end;procedure TFrm_main.StringGrid1DrawCell(Sender: TObject; ACol,ARow: Integer; Rect: TRect; State: TGridDrawState);
beginif ACol = 0 thenbeginTStringGrid(Sender).Canvas.Draw(Rect.Right - 5, Rect.Top, Image2.Picture.Bitmap);end;
end;procedure TFrm_main.setlinecount(sg: TStringGrid; v: integer);
vari: integer;
beginsg.RowCount := v;for i := 0 to v - 1 dobeginsg.Cells[0, i] := Format('%4d', [i + 1]);sg.Cells[1, i] := '';end;end;procedure TFrm_main.StringGrid1KeyPress(Sender: TObject; var Key: Char);
varsg: tmyStringGrid;s, s1, s2: string;idx, i: integer;
beginif Key = #13 thenbeginKey := #0;sg := tmyStringGrid(Sender);s := sg.InplaceEditor.Text;idx := sg.InplaceEditor.SelStart;if s = '' thenbegins1 := '';s2 := '';endelsebegins1 := copy(s, 1, idx);s2 := copy(s, idx + 1, MaxInt);end;sg.Cells[1, sg.Row] := s1;for i := sg.RowCount - 1 downto sg.row + 1 dosg.Cells[1, i] := sg.Cells[1, i - 1];sg.Cells[1, sg.Row + 1] := s2;if sg.Row < sg.RowCount - 1 thensg.Row := sg.Row + 1;sg.InplaceEditor.SelLength := 0;exit;end;if Key = #8 thenbeginsg := tmyStringGrid(Sender);if (sg.Row > 0) and (sg.InplaceEditor.SelStart = 0) thenbeginKey := #0;s := sg.Cells[1, sg.Row - 1];sg.Cells[1, sg.Row - 1] := s + sg.Cells[1, sg.Row];for i := sg.row to sg.RowCount - 2 dosg.Cells[1, i] := sg.Cells[1, i + 1];sg.Cells[1, sg.RowCount - 1] := '';sg.Row := sg.Row - 1;sg.InplaceEditor.SelStart := length(s);exit;end;end;
end;procedure TFrm_main.StringGrid1Click(Sender: TObject);
varsg: tmyStringGrid;
beginsg := tmyStringGrid(Sender);sg.InplaceEditor.SelLength := 0;
end;procedure TFrm_main.StringGrid1KeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
varsg: tmyStringGrid;s: string;idx, i: integer;
beginStringGrid1.OnKeyUp := StringGrid1KeyUp;StringGrid2.OnKeyUp := StringGrid2KeyUp;if Key = 46 thenbeginsg := tmyStringGrid(Sender);s := sg.InplaceEditor.Text;idx := sg.InplaceEditor.SelStart;if (sg.Row < sg.RowCount - 1) and (idx >= length(s)) thenbeginKey := 0;sg.Cells[1, sg.Row] := s + sg.Cells[1, sg.Row + 1];for i := sg.row + 1 to sg.RowCount - 2 dosg.Cells[1, i] := sg.Cells[1, i + 1];sg.Cells[1, sg.RowCount - 1] := '';sg.InplaceEditor.SelStart := length(s);end;end;
end;function TFrm_main.sgtotext(sg: TStringGrid): string;
vari: integer;sl: TStringList;
beginsl := TStringList.Create;for i := 0 to sg.RowCount - 1 dobeginsl.Add(sg.Cells[1, i]);end;Result := sl.Text;FreeAndNil(sl);
end;procedure TFrm_main.texttosg(sl: TStringList; sg: TStringGrid);
vari: integer;
beginif sg.RowCount <> sl.Count thensetlinecount(sg, sl.Count);for i := 0 to sl.Count - 1 dobeginsg.Cells[1, i] := sl[i];end;
end;procedure TFrm_main.stringtosg(s: string; sg: TStringGrid);
varsl: TStringList;
beginsl := TStringList.Create;sl.Text := s;texttosg(sl, sg);FreeAndNil(sl);
end;procedure TFrm_main.witeLog(v: string);
vars: string;
beginif sl_log.Count >= 1000 thensl_log.Delete(0);s := FormatDateTime('hh:nn:ss.zzz:', now);s := s + v;sl_log.Add(s);
end;procedure TFrm_main.Button1Click(Sender: TObject);
beginif SaveDialog1.Execute thenbeginsl_log.SaveToFile(SaveDialog1.FileName);end;
end;procedure TFrm_main.StringGrid1KeyUp(Sender: TObject; var Key: Word;Shift: TShiftState);
beginAction5.Enabled := false;Label_zhu.Caption := Check_zhu;witeLog('StringGrid1KeyUp');StringGrid1.OnKeyUp := StringGrid1KeyUp;
end;procedure TFrm_main.StringGrid2KeyUp(Sender: TObject; var Key: Word;Shift: TShiftState);
beginAction5.Enabled := false;Label_er.Caption := Check_er;witeLog('StringGrid2SetEditText');StringGrid2.OnKeyUp := StringGrid2KeyUp;
end;procedure TFrm_main.frReport1GetValue(const ParName: string;var ParValue: Variant);
beginif SameText(ParName, '次数') thenbeginif RzTabControl1.Tabs[1].Enabled thenParValue := '(第1次)'elseParValue := '';exit;end;if SameText(ParName, '线束名称') or SameText(ParName, '线束名') thenbeginParValue := Edit1.Text;exit;end;if SameText(ParName, '设备型号') thenbeginParValue := Edit2.Text;exit;end;if SameText(ParName, '设备编号') thenbeginParValue := Edit3.Text;exit;end;if SameText(ParName, '版本号') thenbeginParValue := Edit2.Text;exit;end;if SameText(ParName, '回路数量') or SameText(ParName, '回路数') thenbeginParValue := Edit5.Text;exit;end;if SameText(ParName, '二极管数') thenbeginParValue := Edit6.Text;exit;end;if SameText(ParName, '使用点数') thenbeginParValue := Edit7.Text;exit;end;if SameText(ParName, '修改时间') or SameText(ParName, '日期') thenbeginParValue := Edit3.Text;exit;end;if SameText(ParName, '导通次数') thenbeginif RzTabControl1.Tabs[1].Enabled thenParValue := '2'elseParValue := '1';exit;end;
end;procedure TFrm_main.frReport1UserFunction(const Name: string; p1, p2,p3: Variant; var Val: Variant);
varidx: integer;
beginif SameText(Name, 'MyLine') thenbeginidx := frParser.Calc(p1) - 1;if (idx >= 0) and (idx < sl_Print.Count) thenbeginVal := sl_Print[idx];endelsebeginVal := '';end;exit;end;
end;procedure TFrm_main.frUserDataset1First(Sender: TObject);
beginfrUserDataset1.Tag := 0;
end;procedure TFrm_main.frUserDataset1Next(Sender: TObject);
beginfrUserDataset1.Tag := frUserDataset1.Tag + 1;
end;procedure TFrm_main.frUserDataset1Prior(Sender: TObject);
beginfrUserDataset1.Tag := frUserDataset1.Tag - 1;
end;procedure TFrm_main.frUserDataset1CheckEOF(Sender: TObject;var Eof: Boolean);
varc: integer;
beginc := sl_Print.Count;c := ((c - 1) div 60 + 1) * 60;Eof := frUserDataset1.Tag >= c;
end;procedure TFrm_main.PopupMenu1Popup(Sender: TObject);
beginMemo1.Text := '';Memo1.PasteFromClipboard;n2.Enabled := Memo1.Text <> '';
end;procedure TFrm_main.N1Click(Sender: TObject);
beginFrm_copy := TFrm_copy.Create(nil);if RzPageControl1.ActivePageIndex = 0 thenbeginFrm_copy.Memo1.Text := sgtotext(StringGrid1);Frm_copy.Memo1.CaretPos := Point(0, StringGrid1.Row);endelsebeginFrm_copy.Memo1.Text := sgtotext(StringGrid2);Frm_copy.Memo1.CaretPos := Point(0, StringGrid2.Row);end;Frm_copy.ShowModal;FreeAndNil(Frm_copy);
end;procedure TFrm_main.N2Click(Sender: TObject);
vari, c: integer;sl: TStringList;sg: TStringGrid;
beginif Memo1.Text = '' thenexit;if RzPageControl1.ActivePageIndex = 0 thenbeginsg := StringGrid1;endelsebeginsg := StringGrid2;end;sl := TStringList.Create;sl.Text := Memo1.Text;c := sl.Count;for i := sg.RowCount - 1 - c downto sg.Row dobeginsg.Cells[1, i + c] := sg.Cells[1, i];end;for i := 0 to c - 1 dosg.Cells[1, i + sg.Row] := sl[i];FreeAndNil(sl);
end;end.