Quelle Mainboard.pas Sprache: Delphi

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);
    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;

//------------------------------------------------------------------
//
//------------------------------------------------------------------
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 := newselect[1].x-1;
      rightcol := newselect[2].x-1;
      MatchString := ListView1.Items[newselect[1].y].SubItems[leftcol];
      //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 := opt.r.ergfile;
      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;
  Sender.Repaint;
end;

//-------------------------------------------------------
//
//-------------------------------------------------------
procedure TMainboard.ListView1Click(Sender: TObject);
var
  LI: TListItem;
  LV: TListView;
  Tex: String;
  inx, cap: integer;
  MP, CP: TPoint;
  hittestinfo: TLVHitTestInfo;
  subit: integer;
  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
      if (inx = 2) and (newselect[1].y >= 0) and (newselect[1].x <> subit) then
        ShowMessage(trans(82, 'Linke und rechte Spalte müssen gleich sein'))
      else if (inx = 1) and (newselect[2].y >= 0) and
        (newselect[2].x <> subit) then
        ShowMessage(trans(82, 'Linke und rechte Spalte müssen gleich sein'))
      else begin
        newselect[inx].x := subit;
        newselect[inx].y := LI.Index;
        if (newselect[1].y >= 0) and (newselect[2].y >= 0) then begin
          cap1 := ListView1.Items[newselect[1].y].Caption;
          cap2 := ListView2.Items[newselect[2].y].Caption;
          StatusBar1.SimpleText := trans(80, 'Neues Paar') + ' <' + cap1 + ',' +
            cap2 + '> ' + trans(81, 'Zum Hinzufügen Manuell drücken');
        end
      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;
    LV.perform(LVM_SUBITEMHITTEST, 0, lparam(@hittestinfo));
    subit := hittestinfo.iSubItem;
    if LV=ListView2 then Dec(subit,2);
    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();
  if not Abgeglichen then begin
    LoadBoth();
    gesichert := false;
  end;
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
//-------------------------------------------------------

quality88%

¤ Dauer der Verarbeitung: 0.22 Sekunden (vorverarbeitet) ¤

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.