| products/Sources/formale Sprachen/Delphi/Bille 0.71/__history/ |
|
Quellcode-Bibliothek
© Kompilation durch diese Firma
[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]
Datei: vscode_model.scala Sprache: Unknown
|
Spracherkennung für: .~1036~ vermutete Sprache: CS {CS[104] Ada[121] Abap[828]} [Methode: Schwerpunktbildung, einfache Gewichte, sechs Dimensionen] unit Mainboard; interface //------------------------------------------------------- // //------------------------------------------------------- uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, Grids, ValEdit, Menus, Options, ComCtrls, DateUtils,CommCtrl, //------------------------------------------------------- // //------------------------------------------------------- AboutBox, Utilities, StdCtrls, Math, Language, Matching, ImgList, Lizenz, Gendefs, Search; //------------------------------------------------------- // //------------------------------------------------------- type TMainboard = class(TForm) MainMenu1: TMainMenu; Datei1: TMenuItem; ersteDatei1: TMenuItem; zweiteDatei1: TMenuItem; N1: TMenuItem; Ende1: TMenuItem; Ansicht1: TMenuItem; Hilfe1: TMenuItem; Splitter1: TSplitter; StatusBar1: TStatusBar; Optionen1: TMenuItem; Hilfe2: TMenuItem; ber1: TMenuItem; N3: TMenuItem; Font1: TMenuItem; FontDialog1: TFontDialog; OpenDialog1: TOpenDialog; Panel1: TPanel; Abgleich1: TButton; Beenden1: TButton; ListView1: TListView; ListView2: TListView; Feedback1: TMenuItem; Spende1: TMenuItem; Beispiele1: TMenuItem; N4: TMenuItem; Ergebnis1: TMenuItem; Speichern1: TButton; IconImageList1: TImageList; Panelbuttons: TPanel; SaveDialog1: TSaveDialog; Edit1: TMenuItem; Suchen1: TMenuItem; Weitersuchen1: TMenuItem; N2: TMenuItem; Reset1: TButton; Manuell: TButton; procedure ExceptionHandler(Sender: TObject; E: Exception); function getfilename(ini: String; isinput: boolean): String; procedure showStatus(); procedure switchLanguage(); procedure ber1Click(Sender: TObject); procedure Hilfe2Click(Sender: TObject); procedure Font1Click(Sender: TObject); procedure ersteDatei1Click(Sender: TObject); procedure zweiteDatei1Click(Sender: TObject); procedure Optionen1Click(Sender: TObject); procedure Ende1Click(Sender: TObject); procedure Beenden1Click(Sender: TObject); procedure FormShow(Sender: TObject); procedure LoadBoth(); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormCreate(Sender: TObject); procedure Feedback1Click(Sender: TObject); procedure DonateItemClick(Sender: TObject); procedure Abgleichen(Sender: TObject); procedure ExchangeMatches(); procedure Beispiele1Click(Sender: TObject); procedure Ergebnis1Click(Sender: TObject); procedure FormResize(Sender: TObject); procedure Splitter1Moved(Sender: TObject); procedure initColumnwidths(LV: TListView; inx: integer); procedure setColumnwidths(LV: TListView; inx: integer); procedure getColumnwidths(LV: TListView; inx: integer); function MouseOver(var Obj: TListView): boolean; procedure CustomDrawSubItem(Sender: TCustomListView; Item: TListItem; SubItem: Integer; State: TCustomDrawState; var DefaultDraw: Boolean); procedure CustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); procedure ListMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure clearMatches(); procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); procedure Suchen1Click(Sender: TObject); procedure Clearselected(LV: TCustomListView); procedure ListView1Click(Sender: TObject); function finditem(LV: tlistview; inx: integer): integer; procedure ListViewColumnClick(Sender: TObject; Column: TListColumn); procedure ResetMatching(Sender: TObject); procedure SortLV(LV: TListView); procedure ExItems(Left, Right: TListItem); procedure scrollin(LV: TListView; x: integer); procedure ManuellClick(Sender: TObject); procedure addtoMatches(man: boolean; in1, in2: integer); procedure removefromMatches(mat: integer); private Abgeglichen, gesichert: boolean; Lizenz1: TLizenzForm; searcher: TSearchReplace; newselect: array [1 .. 2] of TPoint; public // end; //------------------------------------------------------- // //------------------------------------------------------- var Mainform: TMainboard; AboutDialog: TAboutBox; //------------------------------------------------------- // //------------------------------------------------------- implementation {$R *.dfm} //------------------------------------------------------------------ //- - //- Handle Failure - //- - //------------------------------------------------------------------ procedure TMainboard.ExceptionHandler(Sender: TObject; E: Exception); begin //MessageDlg('ERROR: ' + E.Message, mtError, mbAbortRetryIgnore, 0); //you could also call the default //exception handler: //Application.ShowException( E ); end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.Beispiele1Click(Sender: TObject); begin opt.R.leftfile := getfilename(opt.getSamplesDir(Application.Title), true); if FileExists(Opt.R.leftfile) then begin importfile(1, opt.R.leftfile, ListView1, opt.r.firstlinenames); Abgeglichen := false; showStatus(); end; end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.ber1Click(Sender: TObject); begin if AboutDialog = nil then AboutDialog := TAboutBox.Create(Owner); with AboutDialog do begin Label1.Caption := Application.Title + ' ' + opt.R.Version; DLLVersion := String(Utilities.GetFileVersion(ParamStr(0))); Edition.Caption := EditionStrings[opt.R.Edition] + ' ' + 'Edition'; Edition.Caption := 'Freeeware' + ' ' + 'Edition'; Caption := 'Über ' + Application.Title; ShowModal end end; //------------------------------------------------------------------ // //------------------------------------------------------------------ function TMainboard.finditem(LV: tlistview; inx: integer): integer; var i, res, zwi: integer; begin res := inx; i := 0; while (i < LV.Items.Count) do begin zwi := StrToInt(LV.Items[i].Caption); if zwi = inx then begin res := i; i := lv.Items.Count end; Inc(i) end; result := res end; //------------------------------------------------------------------ // //------------------------------------------------------------------ procedure TMainboard.ExItems(Left, Right: TListItem); var Cap: String; j, k, diff: integer; TA: array of string; begin if left <> right then begin Cap := Left.Caption; Left.Caption := Right.Caption; Right.Caption := Cap; //save left line for k := 0 to left.SubItems.Count - 1 do begin setlength(TA, k + 1); TA[k] := Left.SubItems[k]; end; // diff := Right.SubItems.Count - Left.SubItems.Count; for j := 1 to diff do Left.SubItems.add(''); // for k := 0 to Right.SubItems.Count - 1 do Left.SubItems[k] := Right.SubItems[k]; // for j := 1 to diff do Right.SubItems.Delete(Right.SubItems.Count - 1); // for k := 0 to Right.SubItems.Count - 1 do Right.SubItems[k] := TA[k]; end; end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.ExchangeMatches(); procedure Changer(left: boolean); var i, ll, le, ri, lex, rix, fnd: integer; begin i := 0; ll := length(Matches); fnd := 0; while (i < ll) do begin if Matches[i].valid then begin le := Matches[i].leftline; ri := Matches[i].rightline; if left then begin lex := finditem(ListView1, le); with ListView1 do ExItems(Items[fnd], Items[lex]); Inc(fnd) end else begin rix := finditem(ListView2, ri); with ListView2 do ExItems(Items[fnd], Items[rix]); Inc(fnd) end; end; Inc(i) end; end; begin // changer(true); // changer(false); // end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.removefromMatches(mat: integer); var i, ll: integer; oneleft: boolean; begin Matches[mat].valid := false; oneleft := false; ll := Length(Matches); for i := 0 to ll - 1 do oneleft := oneleft or matches[i].valid; if not oneleft then ResetMatching(nil); end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.addtoMatches(man: boolean; in1, in2: integer); var it1, it2, ll: integer; begin if man then begin new(ActMatch); with ActMatch^ do begin valid := true; manuell := true; it1 := StrToInt(ListView1.Items[newselect[1].y].Caption); leftline := it1; it2 := StrToInt(ListView2.Items[newselect[2].y].Caption); rightline := it2; leftcol := 0; rightcol := 0; MatchString := ''; //deselect ListView1.Items[newselect[1].y].Selected := false; ListView2.Items[newselect[2].y].Selected := false; end; end; // ll := length(Matches); SetLength(Matches, ll + 1); Matches[ll] := ActMatch; // Abgeglichen := true; gesichert := false; // if man then begin ExchangeMatches(); ListView1.Repaint; ListView2.Repaint; newselect[1].y := -1; newselect[2].y := -1; end; end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.Abgleichen(Sender: TObject); var i, j, ll, mi, mj, sb, ten: integer; Sim: String; begin screen.Cursor := crHourGlass; Sim := trans(70, 'Fortschritt') + ' '; sb := max(ListView1.Items.Count, ListView2.Items.Count); ten := ((sb div 10) * 8) div 10; ll := 0; SetLength(Matches, ll); // for j := 1 to 2 do for i := 0 to Length(Pivot[j]) - 1 do Pivot[j][i] := 0; // i := 0; while i < ListView1.Items.Count do begin j := 0; while (j < ListView2.Items.Count) do begin mi := isinmatches(i, -1); mj := isinMatches(-1, j); if (mi < 0) and (mj < 0) then begin ActMatch := hasMatch(ListView1.Items[i], ListView2.Items[j]); if (ActMatch <> nil) then if (isinMatches(i, -1) < 0) and (isinMatches(-1, j) < 0) then addtoMatches(false, i, j); end; Inc(j) end; Inc(i); if (ten > 0) and (i mod (2 * ten) = 0) then begin Sim := Sim + '***'; StatusBar1.SimpleText := inttostr((100 * i) div ((sb * 12) div 10)) + '% ' + Sim; end end; // getmatchingColumns(); // setPivotOnly(); // ExchangeMatches(); if not Abgeglichen then errorn(45, 'keine Übereinstimmung gefunden'); screen.Cursor := crDefault; showStatus(); // Clearselected(ListView1); Clearselected(ListView2); // Reset1.enabled := Abgeglichen; Abgleich1.Enabled := not Abgeglichen; Speichern1.Enabled := Abgeglichen; Manuell.Enabled := Abgeglichen; newselect[1].y := -1; newselect[2].y := -1; ListView1.Repaint; ListView2.Repaint; end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.Beenden1Click(Sender: TObject); begin Close() end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.Ende1Click(Sender: TObject); begin Close end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.Ergebnis1Click(Sender: TObject); var done: integer; begin if Abgeglichen then begin repeat opt.R.ergfile := getfilename(opt.R.ergfile, false); done := exportfile(opt.R.ergfile, ListView1, ListView2, opt.R.leftkeys, opt.R.rightkeys, opt.R.recordnumbersonly); until (exportcancel = mrcancel) or (done > 0); if done > 0 then begin StatusBar1.SimpleText := IntToStr(done) + ' ' + Trans(63, 'Sätze geschrieben'); gesichert := true; end; end else errorn(43, 'kein Abgleich erfolgt, Ergebnis ist leer'); end; //------------------------------------------------------- // //------------------------------------------------------- function TMainboard.getfilename(ini: String; isinput: boolean): String; var res, ext: String; begin res := ini; if ini > '' then ini := ExtractFilePath(ini) else ini := Opt.getSamplesDir(Title); if isinput then with OpenDialog1 do begin InitialDir := ini; Options := []; Options := Options - [ofNoDereferenceLinks]; if isinput then Options := Options + [ofReadOnly, ofFileMustExist] else Options := Options + [ofOverwritePrompt, ofPathMustExist]; Filter := trans(7, 'Komma separierte Dateien') + '|*.csv'; FileName := ''; if Execute() then res := OpenDialog1.FileName; end else with SaveDialog1 do begin InitialDir := ini; Options := []; Options := Options - [ofNoDereferenceLinks]; if isinput then Options := Options + [ofReadOnly, ofFileMustExist] else Options := Options + [ofOverwritePrompt, ofPathMustExist]; Filter := trans(7, 'Komma separierte Dateien') + '|*.csv'; FileName := ''; if Execute() then res := FileName; end; ext := ExtractFileExt(res); if (ext = '') and (res <> '') then res := res + '.csv'; result := res end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.showstatus(); var l, r, f: String; begin l := trans(3, 'linke'); r := trans(4, 'rechte'); f := ' ' + trans(5, 'Datei') + ' = '; if (opt.R.leftfile > '') and (opt.R.rightfile > '') then StatusBar1.SimpleText := l + f + ExtractFileName(opt.R.leftfile) + '(' + IntToStr(ListView1.Items.Count) + ')' + ' --- ' + r + f + ExtractFileName(opt.R.rightfile) + '(' + IntToStr(ListView2.Items.Count) + ')' else if (opt.R.leftfile > '') then StatusBar1.SimpleText := l + f + ExtractFileName(opt.R.leftfile) + '(' + IntToStr(ListView1.Items.Count) + ')' else if (opt.R.rightfile > '') then StatusBar1.SimpleText := r + f + ExtractFileName(opt.R.rightfile) + '(' + IntToStr(ListView2.Items.Count) + ')' else StatusBar1.SimpleText := trans(2, 'Keine Datei geladen'); if Abgeglichen then StatusBar1.SimpleText := StatusBar1.SimpleText + ' * ' + trans(53, 'Anzahl Paare = ') + IntToStr(Length(Matches)); end; //------------------------------------------------------- // //------------------------------------------------------- procedure sizeit(LV: TListView); var lw, j, rat: integer; begin lw := 0; for j := 0 to LV.Columns.Count - 1 do lw := lw + LV.Columns[j].Width; if lw > 0 then begin rat := (LV.Width * 100) div lw; for j := 0 to LV.Columns.Count - 1 do LV.Columns[j].Width := (LV.Columns[j].Width * rat) div 100; end; end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.Splitter1Moved(Sender: TObject); begin sizeit(ListView1); sizeit(ListView2); opt.R.splitterleft := Splitter1.Left end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.scrollin(LV: TListView; x: integer); var cnt, sign: integer; //-------------------------------------------------- function isgoodvis(): boolean; begin with LV do result := (x >= TopItem.Index) and (x < TopItem.Index + visibleRowCount) end; begin cnt := 0; if x >= 0 then with LV do begin sign := 1; if x < LV.TopItem.Index then sign := -1; while not isgoodvis() do begin Scroll(0, sign * 10); Inc(cnt); if cnt > 1000 then ShowMessage('hi'); end end; LV.Items[x].Selected := true; end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.Suchen1Click(Sender: TObject); var fund: TPoint; //-------------------------------------------------- function findin(LV: TListView; lf: TPoint): TPoint; var i, j, anf: integer; res: TPoint; begin res.x := -1; res.y := -1; with LV do if Searcher.Search > '' then begin anf := lf.Y + 1; i := lf.x + 1; while (res.x < 0) and (i < Items.Count) do with Items[i] do begin j := anf; while (res.x < 0) and (j < SubItems.Count) do begin if pos(Searcher.Search, SubItems[j]) > 0 then begin res.x := i; res.y := j end; Inc(j); end; anf := 1; Inc(i) end; end; result := res end; begin //if (searcher.lastlist=2) and (searcher.lastfund.x<0) then if sender = Suchen1 then begin Clearselected(ListView1); Clearselected(ListView2); with searcher do begin lastlist := 1; lastfund.x := -1; lastfund.y := -1; end; searcher.ShowModal(); opt.R.searchstring := searcher.Search; end; // if searcher.lastlist = 1 then begin fund := findin(ListView1, searcher.lastfund); if fund.X < 0 then begin searcher.lastfund.X := 0; searcher.lastfund.Y := 0; searcher.lastlist := 2; fund := findin(ListView2, searcher.lastfund); end end else fund := findin(ListView2, searcher.lastfund); // if fund.X >= 0 then begin if searcher.lastlist = 1 then scrollin(ListView1, fund.X) else if searcher.lastlist = 2 then scrollin(ListView2, fund.X); end else begin ShowMessage(trans(62, 'Nicht gefunden')); with searcher do begin lastlist := 1; lastfund.x := -1; lastfund.y := -1; end; end; searcher.lastfund := fund; end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.clearMatches(); var i: integer; begin with ListView1 do begin for i := 0 to Items.Count - 1 do Items[i].Selected := false; end; with ListView2 do begin for i := 0 to Items.Count - 1 do Items[i].Selected := false; end; end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.getColumnwidths(LV: TListView; inx: integer); var j, ll: integer; begin ll := LV.Columns.Count - 1; with LV do for j := 0 to ll do opt.R.Colwidths[inx, j] := Columns[j].Width; if lv = ListView1 then opt.R.Colleftfile := opt.R.leftfile; if lv = ListView2 then opt.R.Colrightfile := opt.R.rightfile; end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.initColumnwidths(LV: TListView; inx: integer); var j, ll: integer; begin ll := LV.Columns.Count - 1; with LV do for j := 0 to ll do Columns[j].Width := LV.Width div (Columns.Count + 1) end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.setColumnwidths(LV: TListView; inx: integer); var j, ll, lw: integer; begin ll := LV.Columns.Count - 1; if opt.R.leftfile = opt.R.Colleftfile then with LV do for j := 0 to ll do begin if opt.R.Colwidths[inx, j] = 0 then Columns[j].Width := LV.Width div (Columns.Count + 1) else Columns[j].Width := opt.R.Colwidths[inx, j]; end else initColumnwidths(LV, inx); //measure total width lw := 0; for j := 0 to LV.Columns.Count - 1 do lw := lw + LV.Columns[j].Width; if abs(lw - LV.Width) > 10 then sizeit(LV); end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.ersteDatei1Click(Sender: TObject); begin opt.R.leftfile := getfilename(opt.R.leftfile, true); if FileExists(Opt.R.leftfile) then begin importfile(1, opt.R.leftfile, ListView1, opt.r.firstlinenames); ResetMatching(nil); end; end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.zweiteDatei1Click(Sender: TObject); begin opt.R.rightfile := getfilename(opt.R.leftfile, true); if FileExists(Opt.R.rightfile) then begin importfile(2, opt.R.rightfile, ListView2, opt.R.firstlinenames); ResetMatching(nil); end; end; //------------------------------------------------------- // //Style ist der Software vorbehalten // //------------------------------------------------------- procedure TMainboard.Font1Click(Sender: TObject); begin if sender <> nil then begin FontDialog1.Options := [fdNoStyleSel]; if FontDialog1.Execute() then begin opt.R.FontName := FontDialog1.Font.Name; opt.R.FontColor := FontDialog1.Font.Color; opt.R.FontSize := FontDialog1.Font.Size; //opt.R.FontStyle := FontDialog1.Font.Style; end; end; with ListView1 do begin Font.Name := opt.R.FontName; Font.Color := opt.R.FontColor; Font.Size := opt.R.FontSize; Font.Style := []; end; with ListView2 do begin Font.Name := opt.R.FontName; Font.Color := opt.R.FontColor; Font.Size := opt.R.FontSize; Font.Style := []; end; end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.FormClose(Sender: TObject; var Action: TCloseAction); begin getColumnwidths(ListView1, 1); getColumnwidths(ListView2, 2); opt.R.Width := Width; opt.R.Height := Height; opt.R.Top := top; opt.R.Left := left; Action := caFree end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.FormCreate(Sender: TObject); begin Lizenz1 := TLizenzForm.Create(self); Application.OnException := ExceptionHandler; PreventDebuggerinRelease(); searcher := TSearchReplace.create(self); searcher.Search := opt.R.searchstring; Font1Click(nil); opt.SetDaysUsed('x', '', 'a'); Reset1.Enabled := false; Manuell.Enabled := false; end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.ManuellClick(Sender: TObject); begin if (newselect[1].y >= 0) and (newselect[2].y >= 0) then addtomatches(true, newselect[1].y, newselect[2].y) else if (newselect[1].y < 0) then ShowMessage(trans(77, 'Bitte linken Satz auswählen')) else if (newselect[2].y < 0) then ShowMessage(trans(78, 'Bitte rechten Satz auswählen')); showStatus(); end; //--------------------------------------------------------------- //Mouse over Control? //--------------------------------------------------------------- function TMainboard.MouseOver(var Obj: TListView): boolean; var MP, OP: TPoint; isit, c1, c2: boolean; begin MP := Mouse.CursorPos; OP := ScreentoClient(MP); c1 := (OP.x >= Obj.left) and (OP.x <= Obj.left + Obj.Width); c2 := (OP.y >= Obj.top) and (OP.y <= Obj.top + Obj.Height); isit := c1 and c2; Result := isit end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); begin if MouseOver(Listview1) then ListView1.Scroll(0, -WheelDelta) else if MouseOver(Listview2) then ListView2.Scroll(0, -WheelDelta); end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.FormResize(Sender: TObject); begin sizeit(ListView1); sizeit(ListView2); if ListView1.Width < width div 4 then ListView1.Width := width div 4; if ListView2.Width < width div 4 then ListView2.Width := width div 4; // Panelbuttons.Left := width div 2 - Panelbuttons.Width div 2; end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.Clearselected(LV: TCustomListView); var ix: integer; begin for ix := 0 to LV.Items.Count - 1 do with LV.items[ix] do begin Selected := false; Checked := false; Canvas.Font.Color := clBlack; Canvas.Font.Style := [] end; end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.CustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); //var //ix, six: integer; begin //ix := Item.Index; //six := StrToInt(Item.Caption); end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.CustomDrawSubItem(Sender: TCustomListView; Item: TListItem; SubItem: Integer; State: TCustomDrawState; var DefaultDraw: Boolean); var six, ile, iri: integer; begin six := StrToInt(Item.Caption); Sender.Canvas.Font.Color := clBlack; Sender.Canvas.Font.Style := []; if (Sender = ListView1) then begin ile := isinMatches(six, -1); if (ile >= 0) and Matches[ile].valid then begin if (SubItem = Matches[ile].leftcol + 1) then begin Sender.Canvas.Font.Color := clBlue; Sender.Canvas.Font.Style := [fsBold] end else Sender.Canvas.Font.Color := clBlack; end else Sender.Canvas.Font.Color := clBlack; end else if (Sender = ListView2) then begin iri := isinMatches(-1, six); if (iri >= 0) and Matches[iri].valid then begin if (SubItem = Matches[iri].rightcol + 1) then begin Sender.Canvas.Font.Color := clRed; Sender.Canvas.Font.Style := [fsBold] end else Sender.Canvas.Font.Color := clBlack; end else Sender.Canvas.Font.Color := clBlack; end end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.ListView1Click(Sender: TObject); var LI: TListItem; LV: TListView; Tex: String; inx, cap: integer; MP, CP: TPoint; hittestinfo: TLVHitTestInfo; procedure AbgleichFrage(inx: integer); var re: Cardinal; mat: integer; cap1, cap2: String; begin cap := StrToInt(LI.Caption); if inx = 1 then mat := isinMatches(cap, -1) else mat := isinMatches(-1, cap); if mat >= 0 then begin re := ask(79, 'Soll das Paar aus dem Abgleich entfernt werden?', ' ', [mbYes, mbNo]); if re = mrYes then removefromMatches(mat) end else if Abgeglichen then begin newselect[inx].y := LI.Index; if (newselect[1] >= 0) and (newselect[2] >= 0) then begin cap1 := ListView1.Items[newselect[1]].Caption; cap2 := ListView2.Items[newselect[2]].Caption; StatusBar1.SimpleText := trans(80, 'Neues Paar') + ' <' + cap1 + ',' + cap2 + '> ' + trans(81, 'Zum Hinzufügen Manuell drücken'); end; end; LI.Selected := Abgeglichen; end; begin LV := (Sender as TListView); MP := mouse.CursorPos; CP := ScreenToClient(MP); with CP do LI := LV.GetItemAt(x, y); if LI <> nil then begin FillChar(hittestinfo, sizeof(hittestinfo), 0); hittestinfo.pt := CP; If -1 <> listview1.perform(LVM_SUBITEMHITTEST, 0, lparam(@hittestinfo)) Then Begin ShowMessage(IntToStr(hittestinfo.iSubItem)) end; if lv = ListView1 then abgleichFrage(1) else abgleichFrage(2); Tex := ListRec(LV, LI.Index, LV = ListView1); LV.Hint := Tex; if (LV = ListView1) then begin cap := StrToInt(LI.Caption); inx := isinMatches(cap, -1); if inx >= 0 then scrollin(ListView2, finditem(ListView2, matches[inx].rightline)); end else if (LV = ListView2) then begin cap := StrToInt(LI.Caption); inx := isinMatches(-1, cap); if inx >= 0 then scrollin(ListView1, matches[inx].leftline); end; end; end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.ListViewColumnClick(Sender: TObject; Column: TListColumn); var LV: TListView; begin LV := (Sender as TListView); LV.Hint := trans(68, 'Spalte') + '=' + IntToStr(Column.Index); end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.ListMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var LV: TListView; LI: TListItem; begin LV := (Sender as TListView); LI := LV.GetItemAt(x, y); if (LI <> nil) and (LV.Selected <> nil) and (LI <> LV.Selected) then LV.Hint := ''; end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.LoadBoth(); begin setmatchbounds(opt.R.lineseparator, opt.R.recordseparator, opt.R.fielddelimiter, opt.R.escapecharacter); if opt.R.leftfile > '' then importfile(1, opt.R.leftfile, ListView1, opt.R.firstlinenames); if opt.R.rightfile > '' then importfile(2, opt.R.rightfile, ListView2, opt.R.firstlinenames); showstatus(); end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.FormShow(Sender: TObject); begin if opt.R.splitterleft < Width div 5 then opt.R.splitterleft := Width div 5; Width := opt.R.Width; Height := opt.R.Height; Top := opt.R.top; Left := opt.R.left; LoadBoth(); setColumnwidths(ListView1, 1); setColumnwidths(ListView2, 2); ListView1.Width := opt.R.splitterleft; Abgeglichen := false; Gesichert := true; switchLanguage(); Screen.Cursor := crDefault; Speichern1.Enabled := Abgeglichen; Lizenz1.Checklicense(); end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.Hilfe2Click(Sender: TObject); begin HtmlHelpW(0, PChar(Application.helpfile), 0, 0); end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.Optionen1Click(Sender: TObject); begin opt.ShowModal(); switchLanguage(); LoadBoth(); gesichert := false; end; //------------------------------------------------------------------ //- - //------------------------------------------------------------------ procedure TMainboard.SortLV(LV: TListView); var i, j, ll, ca1, ca2: integer; begin ll := lV.Items.Count; for i := 0 to ll - 1 do for j := i + 1 to ll - 1 do begin ca1 := StrToInt(LV.Items[i].Caption); ca2 := StrToInt(LV.Items[j].Caption); if ca1 > ca2 then ExItems(LV.Items[i], LV.Items[j]); end; end; //------------------------------------------------------------------ //- - //------------------------------------------------------------------ procedure TMainboard.ResetMatching(Sender: TObject); begin setlength(Matches, 0); sortlv(ListView1); sortlv(ListView2); ListView1.Repaint; ListView2.Repaint; Abgeglichen := false; gesichert := false; Abgleich1.Enabled := not Abgeglichen; Manuell.Enabled := Abgeglichen; Abgeglichen := false; clearmatches(); if opt.R.leftfile <> opt.R.Colleftfile then initColumnwidths(ListView1, 1) else setColumnwidths(ListView1, 1); Speichern1.Enabled := false; showStatus(); end; //------------------------------------------------------------------ //- - //- FeedBack - //- - //------------------------------------------------------------------ procedure TMainboard.Feedback1Click(Sender: TObject); begin if Opt.netallowed then Browser('http://cococo.de/Context_IT_GmbH/index.jsp?content=contact&topic=' + Title + ' ' + Version); end; //------------------------------------------------------------------ //- - //- Donation Click - //- - //------------------------------------------------------------------ procedure TMainboard.DonateItemClick(Sender: TObject); begin if Opt.netallowed then Browser('http://www.sos-kinderdorf.de/?sponsor=cococo.de') end; //------------------------------------------------------- // //------------------------------------------------------- procedure TMainboard.switchLanguage(); begin language.lang := opt.r.language; Datei1.Caption := trans(11, 'Datei'); ersteDatei1.Caption := trans(12, 'erste Datei'); zweiteDatei1.Caption := trans(13, 'zweite Datei'); Ende1.Caption := trans(14, 'Ende'); Ansicht1.Caption := trans(15, 'Ansicht'); Font1.Caption := trans(16, 'Font'); Optionen1.Caption := trans(17, 'Optionen'); Hilfe1.Caption := trans(18, 'Hilfe'); Hilfe2.Caption := trans(18, 'Hilfe'); ber1.Caption := trans(19, 'Über'); Opt.Caption := trans(30, 'Optionen'); Beispiele1.Caption := trans(39, 'Beispiele ansehen'); Ergebnis1.Caption := trans(41, 'Ergebnis speichern'); SaveDialog1.Title := trans(48, 'Ergebnis sichern'); OpenDialog1.Title := trans(49, 'Datei laden'); // Abgleich1.Caption := trans(20, 'Abgleichen'); Beenden1.Caption := trans(22, 'Benden'); Speichern1.Caption := trans(51, 'Speichern'); Reset1.Caption := trans(69, 'Zurücksetzen'); Edit1.Caption := trans(57, 'Edit'); Suchen1.Caption := trans(58, 'Suchen'); Weitersuchen1.Caption := trans(61, 'Weitersuchen'); Manuell.Caption := trans(76, 'Manuell'); // With Opt do begin Label3.Caption := trans(23, 'Feldtrenner'); Label2.Caption := trans(24, 'Satztrennung'); Label1.Caption := trans(25, 'erste Zeie enthält Feldnamen'); Sprache.Caption := trans(26, 'Sprache'); OKButton.Caption := trans(27, 'OK'); Reset.Caption := trans(28, 'Zurücksetzen'); Button2.Caption := trans(29, 'Abbrechen'); Label4.Caption := trans(34, 'Feldbegrenzer'); Label5.Caption := trans(35, 'Ausweichzeichen'); Label6.Caption := trans(44, 'Nur die Schlüssel exportieren'); Label7.Caption := trans(56, 'Dezimalpunkt'); Label8.Caption := trans(65, 'Schlüssel linke Datei'); Label9.Caption := trans(66, 'Schlüssel rechte Datei'); Edit6.Hint := trans(67, 'Geben Sie eine Folge von Spaltenzahlen ein'); Edit7.Hint := trans(67, 'Geben Sie eine Folge von Spaltenzahlen ein'); Label10.Caption := trans(74, 'bevorzugte Spalten'); Label11.Caption := trans(75, 'Suchausdruck'); end; // with searcher do begin Caption := trans(58, 'Suchen'); Naechstes.Caption := trans(60, 'Nächstes'); end; end; end. //------------------------------------------------------- //Ende dieser Quelle //------------------------------------------------------- [ Verzeichnis aufwärts0.305unsichere Verbindung ] |