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

📄 xqsearch.pas

📁 象棋演播室1.6的dephi源码 作者 董世伟
💻 PAS
📖 第 1 页 / 共 3 页
字号:
///////////////////////////////////////////////////////////////////////////////
//
// XQStduio Source Code (http://www.qipaile.net/xqstudio)
//
// Copyright (c) 1998-2008, DONG Shiwei (董世伟 or 过河象)
// All rights reserved.
// 
// Redistribution and use in source and binary forms, with or without
// modification, are permitted provided that the following conditions
// are met:
// 
//    1) Redistributions of source code must retain the above copyright
//       notice, this list of conditions and the following disclaimer.
//    2) Redistributions in binary form must reproduce the above copyright
//       notice, this list of conditions and the following disclaimer
//       in the documentation and/or other materials provided with the
//       distribution.
//    3) Neither the name of the XQStudio nor the names of its contributors
//       may be used to endorse or promote products derived from this
//       software without specific prior written permission.
// 
// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
// "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
// LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
// FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
// OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
// SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
// TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
// PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
// LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
// NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
// SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
//
///////////////////////////////////////////////////////////////////////////////
//
// Note: Some characters of this file are Simplified Chinese characters 
//       encoded with GB2312/GB18030 standard
//

unit XQSearch;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, XQDataT, Clipbrd, ComCtrls, FileCtrl, XQPNode, XQSystem, XQFileRW,
  XQFileP, Menus, dDelphiS;

type
  TfrmXQSearch = class(TForm)
    pnlWorkSpace: TPanel;
    grbXqfInfo: TGroupBox;
    Bevel1: TBevel;
    grbSearchResult: TGroupBox;
    imgXQBoard: TImage;
    btnStartSearch: TButton;
    btnNewSearch: TButton;
    lvwResult: TListView;
    Label1: TLabel;
    edtFileName: TEdit;
    Label2: TLabel;
    Label5: TLabel;
    Label3: TLabel;
    Label6: TLabel;
    chkResultA: TCheckBox;
    chkResultB: TCheckBox;
    chkResultC: TCheckBox;
    chkResultD: TCheckBox;
    chkSubDir: TCheckBox;
    btnBrowse: TButton;
    cmbRedPlayer: TComboBox;
    cmbBlkPlayer: TComboBox;
    edtDir: TEdit;
    lblOpenHint: TLabel;
    lblResultCount: TLabel;
    aniSearch: TAnimate;
    lblTitle: TLabel;
    lblPlayer: TLabel;
    lblTimeAddr: TLabel;
    Bevel2: TBevel;
    Bevel3: TBevel;
    lblStepNo: TLabel;
    edtStepNo: TEdit;
    bvlStepInfo: TBevel;
    updStepNo: TUpDown;
    lblBlkName: TLabel;
    lblRedName: TLabel;
    lblFileCount: TLabel;
    lblStepInfo: TLabel;
    chkAppend: TCheckBox;
    lblXqfEndHint: TLabel;
    dlbDirTree: TDirectoryListBox;
    rbtFindFile: TRadioButton;
    rbtBrowFile: TRadioButton;
    lblSelectDriver: TLabel;
    dcbDriver: TDriveComboBox;
    chkSearchQzXY: TCheckBox;
    Label7: TLabel;
    chkOnlyInitPos: TCheckBox;
    ppmBoard: TPopupMenu;
    ppmCopy: TMenuItem;
    ppmSaveAsBmp: TMenuItem;
    ppmLine1: TMenuItem;
    ppmPastePosition: TMenuItem;
    imgQZMove: TImage;
    chkDisplayQizi: TCheckBox;
    imgClient: TImage;
    N1: TMenuItem;
    ppm32Qizi: TMenuItem;
    ppm1Ma: TMenuItem;
    ppm2Ma: TMenuItem;
    chkResultSearch: TCheckBox;
    ppmResult: TPopupMenu;
    ppmCopyAll: TMenuItem;
    ppmMoveAll: TMenuItem;
    ppmCopySelected: TMenuItem;
    ppmMoveSelected: TMenuItem;
    N4: TMenuItem;
    chkSearchVar: TCheckBox;
    chkQzNumOnly: TCheckBox;
    chkIgnoreYz: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormActivate(Sender: TObject);
    procedure imgXQBoardClick(Sender: TObject);
    procedure btnBrowseClick(Sender: TObject);
    procedure btnStartSearchClick(Sender: TObject);
    procedure lvwResultDblClick(Sender: TObject);
    procedure btnNewSearchClick(Sender: TObject);
    procedure lvwResultChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure lvwResultClick(Sender: TObject);
    procedure edtStepNoChange(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure rbtFindBrowClick(Sender: TObject);
    procedure dcbDriverChange(Sender: TObject);
    procedure dlbDirTreeChange(Sender: TObject);
    procedure chkSearchQzXYClick(Sender: TObject);
    procedure ppmBoardPopup(Sender: TObject);
    procedure ppmPastePositionClick(Sender: TObject);
    procedure ppmSaveAsBmpClick(Sender: TObject);
    procedure ppmCopyClick(Sender: TObject);
    procedure imgXQBoardDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure QiziEndDrag(Sender, Target: TObject; X, Y: Integer);
    procedure QiziStartDrag(Sender: TObject;
      var DragObject: TDragObject);
    procedure chkDisplayQiziClick(Sender: TObject);
    procedure ppm32QiziClick(Sender: TObject);
    procedure ppm1MaClick(Sender: TObject);
    procedure ppm2MaClick(Sender: TObject);
    procedure chkResultSearchClick(Sender: TObject);
    procedure ppmCopyAllClick(Sender: TObject);
    procedure ppmCopySelectedClick(Sender: TObject);
    procedure ppmMoveAllClick(Sender: TObject);
    procedure ppmMoveSelectedClick(Sender: TObject);
  private
    { Private declarations }
    FXqFile     : dTXQFile;
    FXqTree     : dTXQPlayNode;
    FXqfQzXY    : dTXQZXY;
    FCurQzXY    : dTXQZXY;
    FOpenFile   : Boolean;
    FOpenTree   : Boolean;
    FXqfEnd     : Boolean;
    FFileNum    : integer;
    FCurItem    : TListItem;
    FCurStep    : Integer;
    FCurDrive   : Char;
    imgQizi     : array [1..32] of TImage;
    QiziXYRect  : array [0..8, 0..9] of TRect;
    pntQizi     : array [1..32] of TPoint;              // 棋盘外的位置
    StartMoveLeft, StartMoveTop : Integer;
    FSearchEnabled  : Boolean;
    FSearching      : Boolean;
    FBrowseResultDir: String;
    FFileList   : TStringList;

    procedure ReSearch;
    procedure AddFileNames(ADir: String);
    procedure dRefreshXqfInfo;
    function  IsXqfMatched(AName: String): Boolean;
    function  GetQzXYStepNo(ATree: dTXQPlayNode; var AQzXY: dTXQZXY): Integer;
    procedure GetFileListFromResult;
    procedure copyFileList(ADir: String; OnlySelected: Boolean = False;
                           DeleteSource: Boolean = False);
  public
    QiziXY : dTXQZXY;


    procedure dRefreshQiziXY(AQzXY: dTXQZXY);
    function  OpenXQF(AName: String): Boolean;
    function  OpenFocused: Boolean;

    function  getDestDir: String;
    function  getCopyMoveAnswer(AHint, ADir: String): Boolean;
    function  getReplaceAnswer(AFile: String): Integer;

    { Public declarations }
  end;

var
  frmXQSearch: TfrmXQSearch;

implementation

uses XQMain, XQWizard;

{$R *.DFM}

procedure TfrmXQSearch.FormCreate(Sender: TObject);
var
  i, j, ATop, ALeft, ADx, ADy, X, Y: Integer;
  s: String;
begin
  FFileList := TStringList.Create;

  Self.Left := 0;  Self.Top := 0;
  Self.Height := 454;
  Self.Width := 732;
  imgXQBoard.Canvas.CopyRect(Rect(0,0,imgXQBoard.Width,imgXQBoard.Height),
     frmXQWizard.imgXQBoard.Canvas,
     Rect(0,0,imgXQBoard.Width,imgXQBoard.Height));
  lblTitle.Caption    := '';
  lblTimeAddr.Caption := '';

  // 复制棋子的图象
  for i:=1 to 32 do
  begin
    imgQizi[i] := TImage.Create(Self);
    imgQizi[i].Parent := grbXqfInfo;
    imgQizi[i].Width  := frmXQWizard.imgQizi[i].Width;
    imgQizi[i].Height := frmXQWizard.imgQizi[i].Height;
    imgQizi[i].Canvas.CopyRect(
        Rect(0,0,imgQizi[i].Width,imgQizi[i].Height),
        frmXQWizard.imgQizi[i].Canvas,
        Rect(0,0,imgQizi[i].Width,imgQizi[i].Height));
    imgQizi[i].Visible := False;
    imgQizi[i].OnDragOver := imgXQBoardDragOver;
    imgQizi[i].OnStartDrag:= QiziStartDrag;
    imgQizi[i].OnEndDrag  := QiziEndDrag;
    imgQizi[i].DragMode   := dmAutomatic;
    imgQizi[i].Cursor     := crHandPoint;
    imgQizi[i].DragCursor := crHandPoint;
    imgQizi[i].Transparent:= True;
    imgQizi[i].Tag        := i;
  end;
  imgQzMove.BringToFront;

  // 设置棋盘上的兵站
  for i:=0 to 8 do for j:=0 to 9 do
  begin
    with QiziXYRect[i, j] do
    begin
      Left   := imgXQBoard.Left +   9 + i*22;
      Top    := imgXQBoard.Top  + 236 - j*22;
      Right  := Left + 18;
      Bottom := Top  + 18;
    end;
  end;

  // 设置死子的位置
  ALeft := imgXQBoard.Left + 2;
  ATop  := imgXQBoard.Top  + imgXQBoard.Height - 24;
  ADx   := 24;
  ADy   := 22;

  // 红死子位置
  X := ALeft + ADx;  Y := ATop + ADy;
  pntQizi[ 1].x := X;   pntQizi[ 1].y := Y;
  pntQizi[ 9].x := X;   pntQizi[ 9].y := Y;
  X := X + ADx;
  pntQizi[ 2].x := X;   pntQizi[ 2].y := Y;
  pntQizi[ 8].x := X;   pntQizi[ 8].y := Y;
  X := X + ADx;
  pntQizi[ 3].x := X;   pntQizi[ 3].y := Y;
  pntQizi[ 7].x := X;   pntQizi[ 7].y := Y;
  X := X + ADx;
  pntQizi[ 4].x := X;   pntQizi[ 4].y := Y;
  pntQizi[ 6].x := X;   pntQizi[ 6].y := Y;
  X := X + ADx;
  pntQizi[ 5].x := X;   pntQizi[ 5].y := Y;
  X := X + ADx;
  pntQizi[10].x := X;   pntQizi[10].y := Y;
  pntQizi[11].x := X;   pntQizi[11].y := Y;
  X := X + ADx;
  pntQizi[12].x := X;   pntQizi[12].y := Y;
  pntQizi[13].x := X;   pntQizi[13].y := Y;
  pntQizi[14].x := X;   pntQizi[14].y := Y;
  pntQizi[15].x := X;   pntQizi[15].y := Y;
  pntQizi[16].x := X;   pntQizi[16].y := Y;

  // 黑死子位置
  X := ALeft + ADx;  Y := Y + ADy;
  pntQizi[17].x := X;   pntQizi[17].y := Y;
  pntQizi[25].x := X;   pntQizi[25].y := Y;
  X := X + ADx;
  pntQizi[18].x := X;   pntQizi[18].y := Y;
  pntQizi[24].x := X;   pntQizi[24].y := Y;
  X := X + ADx;
  pntQizi[19].x := X;   pntQizi[19].y := Y;
  pntQizi[23].x := X;   pntQizi[23].y := Y;
  X := X + ADx;
  pntQizi[20].x := X;   pntQizi[20].y := Y;
  pntQizi[22].x := X;   pntQizi[22].y := Y;
  X := X + ADx;
  pntQizi[21].x := X;   pntQizi[21].y := Y;
  X := X + ADx;
  pntQizi[26].x := X;   pntQizi[26].y := Y;
  pntQizi[27].x := X;   pntQizi[27].y := Y;
  X := X + ADx;
  pntQizi[28].x := X;   pntQizi[28].y := Y;
  pntQizi[29].x := X;   pntQizi[29].y := Y;
  pntQizi[30].x := X;   pntQizi[30].y := Y;
  pntQizi[31].x := X;   pntQizi[31].y := Y;
  pntQizi[32].x := X;   pntQizi[32].y := Y;

  for i:=1 to 32 do FCurQzXY[i] := $FF;
  dRefreshQiziXY(FCurQzXY);

  FSearchEnabled := False;
  try
    s := ReadRegStr('RecentFileList', 'XqfBrowserDrive', 'C');
    dcbDriver.Drive := s[1];
  except
    dcbDriver.Drive := 'C';
  end;

  try
    s := ReadRegStr('RecentFileList', 'XqfBrowserDir', '\');
    dlbDirTree.Directory := s;
  except
    dlbDirTree.Directory := '\';
  end;

  edtDir.Text := ReadRegStr('RecentFileList', 'XqfFinderDir', 'C:\XqfFiles');
  FSearchEnabled := True;
end;

procedure TfrmXQSearch.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Screen.Cursor := crHourglass;
  lvwResult.Items.Clear;
  Screen.Cursor := crDefault;

  FFileList.Free;

  Action := caFree;
  if (frmMain.MDIChildCount<=1) then frmMain.pnlXQStudioLogo.Visible:=True;
  frmMain.isCreateSearchOk := False;
  frmXQSearch := nil;
  WriteRegStr('RecentFileList', 'XqfBrowserDrive', dcbDriver.Drive);
  WriteRegStr('RecentFileList', 'XqfBrowserDir', dlbDirTree.Directory);
  WriteRegStr('RecentFileList', 'XqfFinderDir', edtDir.Text);
end;

procedure TfrmXQSearch.FormActivate(Sender: TObject);
begin
  frmMain.pnlXQStudioLogo.Visible := False;
end;

procedure TfrmXQSearch.imgXQBoardClick(Sender: TObject);
{var
  slTxt: TStringList;}
begin
{  slTxt := TStringList.Create;
  slTxt.Text := ClipBoard.AsText;
  try
  if not (frmXQWizard.isStringListToQiziXYOK(slTxt, QiziXY)) then Exit;

  frmXQWizard.QiziXYtoImage(QiziXY, imgXQBoard);
  finally
    slTxt.Free;
  end;}
end;

procedure TfrmXQSearch.btnBrowseClick(Sender: TObject);
var
  DirStr: string;
begin
  DirStr := '';
  if SelectDirectory('请选择棋谱文件(*.XQF)所在的目录', '', DirStr) then
  begin
    edtDir.Text := DirStr;
  end;
end;

procedure TFrmXQSearch.ReSearch;
var
  AItem: TListItem;
  i    : Integer;
  s    : String;
begin
  for i:=0 to (FFileList.Count-1) do
  begin
    Inc(FFileNum);
    lblFileCount.Caption := IntToStr(FFileNum);
    lblFileCount.Refresh;

    s := FFileList.Strings[i];

    // 检查文件名的条件
    if (edtFileName.Text <> '') then
    begin
      if (Pos(edtFileName.Text, s) < 1) then continue;
    end;

    // 检查文件内容条件
    if not IsXqfMatched(s) then continue;

    AItem := lvwResult.Items.Add;
    AItem.Caption     := ChangeFileExt(ExtractFileName(s), '');
    AItem.SubItems.Add(ExtractFileDir(s));
    AItem.ImageIndex := 6;
  end;
end;

procedure TFrmXQSearch.AddFileNames(ADir: String);
var
  sr: TSearchRec;
  AItem: TListItem;
begin
  if FindFirst(ADir+'\*.*', faAnyFile, sr) <> 0 then Exit;
  repeat
    if (sr.Attr = faDirectory) and ((sr.Name<>'.') and (sr.Name<>'..')) then
    begin
      if chkSubDir.Checked then AddFileNames(ADir+'\'+sr.Name);
    end
    else
    begin
      Inc(FFileNum);
      lblFileCount.Caption := IntToStr(FFileNum);
      lblFileCount.Refresh;

      // 必须是XQF文件
      if(UpperCase(ExtractFileExt(sr.Name))<>'.XQF') then continue;

      // 检查文件名的条件
      if (edtFileName.Text <> '') then
      begin
        if (Pos(edtFileName.Text, sr.Name) < 1) then continue;
      end;

      // 检查文件内容条件
      if not IsXqfMatched(ADir + '\' + sr.Name) then continue;

      AItem := lvwResult.Items.Add;

⌨️ 快捷键说明

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