⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 xqsearch.pas

📁 象棋演播室1.6的dephi源码 作者 董世伟
💻 PAS
📖 第 1 页 / 共 3 页
字号:
      imgQizi[i].Visible := chkDisplayQizi.Checked;
      Continue;
    end;
    xy := AQzXY[i];
    x  := xy div 10;
    y  := xy mod 10;
    imgQizi[i].Left := QiziXYRect[x, y].Left;
    imgQizi[i].Top  := QiziXYRect[x, y].Top;
    imgQizi[i].Visible := True;
    imgQizi[i].Tag  := i;
    FCurQzXY := AQzXY;
  end;
end;

procedure TfrmXQSearch.rbtFindBrowClick(Sender: TObject);
begin
  lblSelectDriver.Visible := rbtBrowFile.Checked;
  dcbDriver.Visible       := lblSelectDriver.Visible;
  dlbDirTree.Visible      := lblSelectDriver.Visible;
  chkSubDir.Checked       := not rbtBrowFile.Checked;
  if rbtBrowFile.Checked and (FBrowseResultDir <> dlbDirTree.Directory) then
  begin
    dlbDirTree.Refresh;
    dlbDirTreeChange(dlbDirTree);    
  end;
end;

procedure TfrmXQSearch.dcbDriverChange(Sender: TObject);
var
  AOldDrive : Char;
begin
  if (FCurDrive = dcbDriver.Drive) then Exit;
  AOldDrive := FCurDrive;
  try
    dlbDirTree.Drive := dcbDriver.Drive;
  except
    dcbDriver.Drive := AOldDrive;
  end;
  FCurDrive := dcbDriver.Drive;
end;

procedure TfrmXQSearch.dlbDirTreeChange(Sender: TObject);
begin
  chkAppend.Checked       := False;
  chkResultSearch.Checked := False;
  edtDir.Text := dlbDirTree.Directory;
  if FSearchEnabled then
  begin
    btnNewSearchClick(btnNewSearch);
    btnStartSearchClick(btnStartSearch);
    FBrowseResultDir := edtDir.Text;
  end;
end;

function TFrmXQSearch.IsXqfMatched(AName: String): Boolean;
var
  AStepNo : Integer;
begin
  if (not FOpenFile) then
  begin
    Result := True;
    Exit;
  end;

  Result := False;

  FXqTree.Free;
  FXqTree       := nil;
  FXqTree       := dTXQPlayNode.Create(0,'========= ',0,0,FXqfQzXY,
                                     nil,nil,nil,nil);
  if (FXqTree = nil) then Exit;

  FXqFile.Free;
  FXqFile := nil;
  FXqFile := dTXQFILE.Create(AName, FXqTree);
  if (FXqFile = nil) then
  begin
    FXqTree.Free;
    Exit;
  end;

  Result := False;
  if (FXqFile.iLoadXQFile(not FOpenTree)=0) then
  repeat
    if (cmbRedPlayer.Text <> '') then // 红方条件
    begin
      if (Pos(cmbRedPlayer.Text, FXqFile.XQFHead.RedPlayer) < 1) then break;
    end;
    if (cmbBlkPlayer.Text <> '') then // 黑方条件
    begin
      if (Pos(cmbBlkPlayer.Text, FXqFile.XQFHead.BlkPlayer) < 1) then break;
    end;
    // 结果条件
    if (chkResultA.Checked or chkResultB.Checked or
        chkResultC.Checked or chkResultD.Checked) then
    begin
      if ((not chkResultA.Checked)and(FXqFile.XQFHead.PlayResult=1)) or
         ((not chkResultB.Checked)and(FXqFile.XQFHead.PlayResult=2)) or
         ((not chkResultC.Checked)and(FXqFile.XQFHead.PlayResult=3)) or
         ((not chkResultD.Checked)and(FXqFile.XQFHead.PlayResult=0)) then
      begin
        break;
      end;
    end;

    // 搜索局面
    if chkSearchQzXY.Checked then
    begin
      dSetSearchQzXYParam(FCurQzXY);
      if chkOnlyInitPos.Checked then    // 只在初始局面查
      begin
        if not IsQzXYSame(FCurQzXY, FXqTree.QiziXY, chkQzNumOnly.Checked, chkIgnoreYz.Checked) then break;
      end
      else                              // 深入棋局内部查
      begin
        AStepNo := GetQzXYStepNo(FXqTree, FCurQzXY);
        if AStepNo < 0 then break;
      end;
    end;
    Result := True;
  until True;
  FXqFile.Free;  FXqFile := nil;
  FXqTree.Free;  FXqTree := nil;
end;


procedure TfrmXQSearch.chkSearchQzXYClick(Sender: TObject);
begin
  chkOnlyInitPos.Enabled := chkSearchQzXY.Checked;
  chkSearchVar.Enabled   := chkSearchQzXY.Checked;
  chkQzNumOnly.Enabled   := chkSearchQzXY.Checked;
  chkIgnoreYz.Enabled    := chkSearchQzXY.Checked;
  if not chkSearchQzXY.Checked then
  begin
    chkOnlyInitPos.Checked := False;
    chkSearchVar.Checked   := False;
    chkQzNumOnly.Enabled   := False;
    chkIgnoreYz.Enabled    := False;
  end;
end;

function TFrmXQSearch.GetQzXYStepNo(ATree: dTXQPlayNode;
                                    var AQzXY: dTXQZXY): Integer;
begin
  Result := -1;
  if (ATree = nil) then Exit;
  if IsQzXYSame(AQzXY, ATree.QiziXY, chkQzNumOnly.Checked, chkIgnoreYz.Checked) then
  begin
    Result    := ATree.StepNo;
    
    Exit;
  end;

  Result := GetQzXYStepNo(ATree.LChild, AQzXY);
  if (Result >= 0) then Exit;

  if chkSearchVar.Checked then
  begin
    Result := GetQzXYStepNo(ATree.RChild, AQzXY);
    if (Result >=0 ) then Exit;
  end;

  Result := -1;
end;

procedure TfrmXQSearch.ppmBoardPopup(Sender: TObject);
begin
  // 判断是否是文本,以决定是否允许粘贴
  ppmPastePosition.Enabled := Clipboard.HasFormat(CF_TEXT);
end;

procedure TfrmXQSearch.ppmPastePositionClick(Sender: TObject);
begin
  frmXQWizard.ppmPastePositionClick(frmXQWizard.ppmPastePosition);
  if not frmXQWizard.IsPasteQituOk then Exit;
  chkDisplayQizi.Checked := True;
  dRefreshQiziXY(frmXQWizard.QiziXY)
end;

procedure TfrmXQSearch.ppmSaveAsBmpClick(Sender: TObject);
begin
  frmXQWizard.QiziXY := FCurQzXY;
  frmXQWizard.dRefreshQiziPosition;
  frmXQWizard.ppmSaveAsBmpClick(frmXQWizard.ppmSaveAsBmp);
end;

procedure TfrmXQSearch.ppmCopyClick(Sender: TObject);
begin
  frmXQWizard.QiziXY := FCurQzXY;
  frmXQWizard.dRefreshQiziPosition;
  frmXQWizard.ppmCopyClick(frmXQWizard.ppmCopy);
end;

procedure TfrmXQSearch.imgXQBoardDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var
  iLeft, iTop: Integer;
begin
  with Sender as TImage do
  begin
    iLeft := Left;
    iTop  := Top;
  end;
  imgQZMove.Left := X + iLeft - 9;
  imgQZMove.Top  := Y + iTop  - 9;
end;

procedure TfrmXQSearch.QiziEndDrag(Sender, Target: TObject; X,
  Y: Integer);
var
  iIdx, Cx, Cy: Integer;
function isPointInQiziXY(var Px, Py: Integer): Boolean;
var
  i, j: Integer;
begin
  for i:=0 to 8 do for j:=0 to 9 do
  begin
    with QiziXYRect[i,j] do
    begin
      if ((Px>Left) and (Px<Right) and (Py>Top) and (Py<Bottom)) then
      begin
        isPointInQiziXY := True;
        Px := i;  Py := j;
        Exit;
      end;
    end;
  end;
  isPointInQiziXY := False;
end;

function iQiziIdxAtXY(XYx, XYy: Integer): Integer;
var
  i: Integer;
begin
  for i:=1 to 32 do if (FCurQzXY[i]=(XYx*10+XYy)) then
  begin
    iQiziIdxAtXY := i;
    Exit;
  end;
  iQiziIdxAtXY := 0;
end;
begin
  imgQZMove.Visible := False;
  with Sender as TImage do
  begin
    Visible := True;
    Cx   := imgQZMove.Left + (Width  div 2);
    Cy   := imgQZMove.Top  + (Height div 2);
    if not isPointInQiziXY(Cx, Cy) then
    begin
      //if ((Tag=05) or (Tag=21)) then Exit;      // 帅、将不可以移出宫外
      if (Cx > (imgXQBoard.Left + imgXQBoard.Width - 6)) or
         (Cx < (imgXQBoard.Left + 6)) or
         (Cy > (imgXQBoard.Top  + imgXQBoard.Height - 32)) or
         (Cy < (imgXQBoard.Top  + 32)) then
      begin
        chkDisplayQizi.Checked := True;
        FCurQzXY[Tag] := $FF;
        Left := pntQizi[tag].X;
        Top  := pntQizi[tag].Y;
      end;
      Exit;
    end;
    iIdx := iQiziIdxAtXY(Cx, Cy);
    if (iIdx>0) then
    begin
      if (((Tag<17)and(iIdx>16))or((Tag>16)and(iIdx<17))) then
      begin
        FCurQzXY[iIdx]    := $FF;
        imgQizi[iIdx].Left:= pntQizi[iIdx].X;
        imgQizi[iIdx].Top := pntQizi[iIdx].Y;
        imgQizi[iIdx].Visible := chkDisplayQizi.Checked;
      end
      else
      begin
        Exit;
      end;
    end;
    if not isQiziCanAtXY(tag, Cx, Cy) then Exit;
    FCurQzXY[Tag] := Cx*10 + Cy;
    Left := QiziXYRect[Cx, Cy].Left;
    Top  := QiziXYRect[Cx, Cy].Top;
  end;;
end;

procedure TfrmXQSearch.QiziStartDrag(Sender: TObject;
  var DragObject: TDragObject);
begin
  with Sender as TImage do
  begin
    StartMoveLeft     := Left;
    StartMoveTop      := Top;
    Visible           := False;
    imgQZMove.Picture := Picture;
    imgQZMove.Left    := Left;
    imgQZMove.Top     := Top;
    imgQZMove.Visible := True;
  end;
end;

procedure TfrmXQSearch.chkDisplayQiziClick(Sender: TObject);
var
  ABool: Boolean;
  i    : Integer;
begin
  ABool := not chkDisplayQizi.Checked;
  bvlStepInfo.Visible   := ABool;
  lblStepNo.Visible     := ABool;
  edtStepNo.Visible     := ABool;
  updStepNo.Visible     := ABool;
  lblStepInfo.Visible   := ABool;
  if chkDisplayQizi.Checked then
  begin
    lblBlkName.Visible    := False;
    lblRedName.Visible    := False;
    lblXqfEndHint.Visible := False;
    lblTitle.Caption      := '拖拽棋子摆放不同的局面';
    lblPlayer.Caption     := '不用的棋子可拖拽到棋盘下方空的地方';
    lblTimeAddr.Caption   := '棋盘上单击右键可弹出选单';
  end
  else
  begin
    lblTitle.Caption      := '';
    lblPlayer.Caption     := '没有指定XQF文件';
    lblTimeAddr.Caption   := '';
  end;

  for i:=1 to 32 do
  begin
    if (FCurQzXY[i] = $FF) then
    begin
      imgQizi[i].Visible := chkDisplayQizi.Checked;
    end;
  end;
end;

procedure TfrmXQSearch.ppm32QiziClick(Sender: TObject);
begin
  chkDisplayQizi.Checked := True;
  dRefreshQiziXY(dCXqzXY);
end;

procedure TfrmXQSearch.ppm1MaClick(Sender: TObject);
begin
  chkDisplayQizi.Checked := True;
  FCurQzXY := dCXqzXY;
  FCurQzXY[2] := $FF;
  dRefreshQiziXY(FCurQzXY);
end;

procedure TfrmXQSearch.ppm2MaClick(Sender: TObject);
begin
  chkDisplayQizi.Checked := True;
  FCurQzXY := dCXqzXY;
  FCurQzXY[2] := $FF;
  FCurQzXY[8] := $FF;
  dRefreshQiziXY(FCurQzXY);
end;

function TFrmXQSearch.OpenFocused: Boolean;
var
  AFileName: String;
begin
  Result := False;
  if (lvwResult.ItemFocused = nil) then Exit;
  AFileName := lvwResult.ItemFocused.SubItems[0] + '\' +
               lvwResult.ItemFocused.Caption + '.XQF';
  Result := Self.OpenXQF(AFileName);
end;

procedure TfrmXQSearch.chkResultSearchClick(Sender: TObject);
begin
  if chkResultSearch.Checked then chkAppend.Checked := False;
end;


function TFrmXQSearch.getDestDir: String;
var
  DirStr: string;
  DirLen: integer;
begin
  DirStr := '';
  if SelectDirectory('请选择目标文件夹', '', DirStr) then
  begin
    DirLen := Length(DirStr);  if DirLen < 1 then Exit;
    if (DirStr[DirLen] = '\') then SetLength(DirStr, DirLen-1);
  end;
  Result := DirStr;
end;

function TFrmXQSearch.getCopyMoveAnswer(AHint, ADir: String): Boolean;
begin
  Result :=
    (Application.MessageBox(PChar(
      '确实把指定的文件'+AHint+'到文件夹“'+ADir+'”中吗?') ,
      PChar(AHint+'指定的文件?'),
      MB_OKCANCEL + MB_ICONQUESTION + MB_DEFBUTTON1) = IDOK);
end;

function TFrmXQSearch.getReplaceAnswer(AFile: String): Integer;
begin
  Result := Application.MessageBox(PChar(
             '文件“'+AFile+'”已经存在于'+
             '指定的文件夹中,是否替换该文件?'),
             '替换文件吗?',
             MB_YESNOCANCEL + MB_ICONQUESTION);
end;

procedure TfrmXQSearch.ppmCopyAllClick(Sender: TObject);
var
  DirStr: string;
begin
  DirStr := getDestDir; if (DirStr='') then Exit;
  if not getCopyMoveAnswer('复制', DirStr) then Exit;
  copyFileList(DirStr);
end;

procedure TfrmXQSearch.ppmCopySelectedClick(Sender: TObject);
var
  DirStr: string;
begin
  DirStr := getDestDir; if (DirStr='') then Exit;
  if not getCopyMoveAnswer('复制', DirStr) then Exit;
  copyFileList(DirStr, True);
end;

procedure TfrmXQSearch.ppmMoveAllClick(Sender: TObject);
var
  DirStr: string;
begin
  DirStr := getDestDir; if (DirStr='') then Exit;
  if not getCopyMoveAnswer('移动', DirStr) then Exit;
  copyFileList(DirStr, False, True);
end;

procedure TfrmXQSearch.ppmMoveSelectedClick(Sender: TObject);
var
  DirStr: string;
begin
  DirStr := getDestDir; if (DirStr='') then Exit;
  if not getCopyMoveAnswer('移动', DirStr) then Exit;
  copyFileList(DirStr, True, True);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -