xqmain.pas

象棋演播室1.6的dephi源码 作者 董世伟

  FileList2.Caption := '&2. ' + ChangeFileExt(ExtractFileName(FFileList[2]), '');
  FileList2.Hint    := FFileList[2];

  FileList3.Caption := '&3. ' + ChangeFileExt(ExtractFileName(FFileList[3]), '');
  FileList3.Hint    := FFileList[3];

  FileList4.Caption := '&4. ' + ChangeFileExt(ExtractFileName(FFileList[4]), '');
  FileList4.Hint    := FFileList[4];

  FileList5.Caption := '&5. ' + ChangeFileExt(ExtractFileName(FFileList[5]), '');
  FileList5.Hint    := FFileList[5];

  FileList6.Caption := '&6. ' + ChangeFileExt(ExtractFileName(FFileList[6]), '');
  FileList6.Hint    := FFileList[6];

  FileList7.Caption := '&7. ' + ChangeFileExt(ExtractFileName(FFileList[7]), '');
  FileList7.Hint    := FFileList[7];

  FileList8.Caption := '&8. ' + ChangeFileExt(ExtractFileName(FFileList[8]), '');
  FileList8.Hint    := FFileList[8];

  FileList9.Caption := '&9. ' + ChangeFileExt(ExtractFileName(FFileList[9]), '');
  FileList9.Hint    := FFileList[9];
end;

procedure TfrmMain.dSaveFileList;
begin
  WriteRegStr('RecentFileList', 'XqfListItem1', FileList1.Hint);
  WriteRegStr('RecentFileList', 'XqfListItem2', FileList2.Hint);
  WriteRegStr('RecentFileList', 'XqfListItem3', FileList3.Hint);
  WriteRegStr('RecentFileList', 'XqfListItem4', FileList4.Hint);
  WriteRegStr('RecentFileList', 'XqfListItem5', FileList5.Hint);
  WriteRegStr('RecentFileList', 'XqfListItem6', FileList6.Hint);
  WriteRegStr('RecentFileList', 'XqfListItem7', FileList7.Hint);
  WriteRegStr('RecentFileList', 'XqfListItem8', FileList8.Hint);
  WriteRegStr('RecentFileList', 'XqfListItem9', FileList9.Hint);
end;

procedure TfrmMain.dLoadBitmapList;
procedure GetXQBoardXYWH(ATxtFile: string; var X, Y, W, H: Integer);
var
  F: TextFile;
  S: string;
begin
  X := 0;
  Y := 0;
  W := 0;
  H := 0;
  if (not FileExists(ATxtFile)) then Exit;
  AssignFile(F, ATxtFile);
  Reset(F);
  Readln(F, S);
  X := StrToIntDef(Trim(S), 0);
  Readln(F, S);
  Y := StrToIntDef(Trim(S), 0);
  Readln(F, S);
  W := StrToIntDef(Trim(S), 0);
  Readln(F, S);
  H := StrToIntDef(Trim(S), 0);
  CloseFile(F);
end;

var
  i: Integer;
begin
  imgXQBoardBmp.Hint := ReadRegStr('Bitmap', 'XQBoard', '');
  imgRed1Bmp.Hint    := ReadRegStr('Bitmap', 'XQRed1',  '');
  imgRed2Bmp.Hint    := ReadRegStr('Bitmap', 'XQRed2',  '');
  imgRed3Bmp.Hint    := ReadRegStr('Bitmap', 'XQRed3',  '');
  imgRed4Bmp.Hint    := ReadRegStr('Bitmap', 'XQRed4',  '');
  imgRed5Bmp.Hint    := ReadRegStr('Bitmap', 'XQRed5',  '');
  imgRed6Bmp.Hint    := ReadRegStr('Bitmap', 'XQRed6',  '');
  imgRed7Bmp.Hint    := ReadRegStr('Bitmap', 'XQRed7',  '');
  imgBlk1Bmp.Hint    := ReadRegStr('Bitmap', 'XQBlk1',  '');
  imgBlk2Bmp.Hint    := ReadRegStr('Bitmap', 'XQBlk2',  '');
  imgBlk3Bmp.Hint    := ReadRegStr('Bitmap', 'XQBlk3',  '');
  imgBlk4Bmp.Hint    := ReadRegStr('Bitmap', 'XQBlk4',  '');
  imgBlk5Bmp.Hint    := ReadRegStr('Bitmap', 'XQBlk5',  '');
  imgBlk6Bmp.Hint    := ReadRegStr('Bitmap', 'XQBlk6',  '');
  imgBlk7Bmp.Hint    := ReadRegStr('Bitmap', 'XQBlk7',  '');
  imgXQQituBmp.Hint  := ReadRegStr('Bitmap', 'XQXYWH',  '');

  if (imgXQBoardBmp.Hint='') then imgXQBoardBmp.Hint:='C:\XQBitmap\XQBoard.BMP';
  if (imgRed1Bmp.Hint   ='') then imgRed1Bmp.Hint   :='C:\XQBitmap\XQRed1.BMP';
  if (imgRed2Bmp.Hint   ='') then imgRed2Bmp.Hint   :='C:\XQBitmap\XQRed2.BMP';
  if (imgRed3Bmp.Hint   ='') then imgRed3Bmp.Hint   :='C:\XQBitmap\XQRed3.BMP';
  if (imgRed4Bmp.Hint   ='') then imgRed4Bmp.Hint   :='C:\XQBitmap\XQRed4.BMP';
  if (imgRed5Bmp.Hint   ='') then imgRed5Bmp.Hint   :='C:\XQBitmap\XQRed5.BMP';
  if (imgRed6Bmp.Hint   ='') then imgRed6Bmp.Hint   :='C:\XQBitmap\XQRed6.BMP';
  if (imgRed7Bmp.Hint   ='') then imgRed7Bmp.Hint   :='C:\XQBitmap\XQRed7.BMP';
  if (imgBlk1Bmp.Hint   ='') then imgBlk1Bmp.Hint   :='C:\XQBitmap\XQBlk1.BMP';
  if (imgBlk2Bmp.Hint   ='') then imgBlk2Bmp.Hint   :='C:\XQBitmap\XQBlk2.BMP';
  if (imgBlk3Bmp.Hint   ='') then imgBlk3Bmp.Hint   :='C:\XQBitmap\XQBlk3.BMP';
  if (imgBlk4Bmp.Hint   ='') then imgBlk4Bmp.Hint   :='C:\XQBitmap\XQBlk4.BMP';
  if (imgBlk5Bmp.Hint   ='') then imgBlk5Bmp.Hint   :='C:\XQBitmap\XQBlk5.BMP';
  if (imgBlk6Bmp.Hint   ='') then imgBlk6Bmp.Hint   :='C:\XQBitmap\XQBlk6.BMP';
  if (imgBlk7Bmp.Hint   ='') then imgBlk7Bmp.Hint   :='C:\XQBitmap\XQBlk7.BMP';
  if (imgXQQituBmp.Hint ='') then imgXQQituBmp.Hint :='C:\XQBitmap\XQXYWH.TXT';

  if (FileExists(imgXQBoardBmp.Hint)) then
  try
    for i:=0 to 14 do
    begin
      FImgXQBitmapList[i].Picture.LoadFromFile(FImgXQBitmapList[i].Hint);
    end;

    imgXQQituBmp.Picture.LoadFromFile(imgXQBoardBmp.Hint);

    GetXQBoardXYWH(imgXQQituBmp.Hint,FXQTopLeftX,FXQTopLeftY,FXQColW,FXQRowH);

    IsBitmapListLoaded := True;
  except
  end;

end;

procedure TfrmMain.dSaveBitmapList;
begin
  WriteRegStr('Bitmap', 'XQBoard', imgXQBoardBmp.Hint);
  WriteRegStr('Bitmap', 'XQRed1' , imgRed1Bmp.Hint);
  WriteRegStr('Bitmap', 'XQRed2' , imgRed2Bmp.Hint);
  WriteRegStr('Bitmap', 'XQRed3' , imgRed3Bmp.Hint);
  WriteRegStr('Bitmap', 'XQRed4' , imgRed4Bmp.Hint);
  WriteRegStr('Bitmap', 'XQRed5' , imgRed5Bmp.Hint);
  WriteRegStr('Bitmap', 'XQRed6' , imgRed6Bmp.Hint);
  WriteRegStr('Bitmap', 'XQRed7' , imgRed7Bmp.Hint);
  WriteRegStr('Bitmap', 'XQBlk1' , imgBlk1Bmp.Hint);
  WriteRegStr('Bitmap', 'XQBlk2' , imgBlk2Bmp.Hint);
  WriteRegStr('Bitmap', 'XQBlk3' , imgBlk3Bmp.Hint);
  WriteRegStr('Bitmap', 'XQBlk4' , imgBlk4Bmp.Hint);
  WriteRegStr('Bitmap', 'XQBlk5' , imgBlk5Bmp.Hint);
  WriteRegStr('Bitmap', 'XQBlk6' , imgBlk6Bmp.Hint);
  WriteRegStr('Bitmap', 'XQBlk7' , imgBlk7Bmp.Hint);
  WriteRegStr('Bitmap', 'XQXYWH' , imgXQQituBmp.Hint);
end;

procedure TfrmMain.actToolsTextExecute(Sender: TObject);
begin
  if (ActiveXQTable = nil) then Exit;
  ActiveXQTable.ppmTextXQClick(nil);
end;

procedure TfrmMain.FileListClearClick(Sender: TObject);
var
  i: Integer;
begin
  if (Application.MessageBox(
      PChar('本操作将清除所有的文件打开历史，确实要清除吗?'),
      '清除文件历史',
      MB_OKCANCEL + MB_ICONWARNING + MB_DEFBUTTON1) = IDCANCEL) then
  begin
    Exit;
  end;

  for i:=1 to 9 do FFileList[i] := '';

  dLoadFileList;
end;

procedure TfrmMain.dAddFileListItem(sFileName: String);
var
  i, iIdx  : Integer;
  sFullName: String;
begin
  sFullName := ExpandFileName(sFileName);
  if not FileExists(sFullName) then Exit;

  iIdx := 9;
  for i:=1 to 9 do
  begin
    if (CompareText(FFileList[i] , sFullName)<>0) then continue;
    iIdx := i;
    break;
  end;

  for i:=iIdx downto 2 do
  begin
    FFileList[i] := FFileList[i-1];
  end;

  FFileList[1] := sFullName;
  
  dLoadFileList;
end;

procedure TfrmMain.FileListItemClick(Sender: TObject);
var
  m: TMenuItem;
begin
  if not (Sender is TMenuItem) then Exit;
  m := Sender as TMenuItem;
  if (m.Hint = '') then Exit;
  OpenXQF(m.Hint);
end;

procedure TfrmMain.actHelpHttpQipaileExecute(Sender: TObject);
begin
  ShellExecute(Self.Handle, nil, PChar('http://www.qipaile.net'),
      nil, nil, SW_SHOWNORMAL);
end;

procedure TfrmMain.actHelpHttpXqfExecute(Sender: TObject);
begin
  ShellExecute(Self.Handle, nil, PChar('http://www.qipaile.net/xqf'),
      nil, nil, SW_SHOWNORMAL);
end;

procedure TfrmMain.actEditChangePosExecute(Sender: TObject);
begin
  if (ActiveXQTable = nil) then Exit;
  try
    if (frmXQWizard<>nil) then frmXQWizard.Release;
    frmXQWizard.Free;
    frmXQWizard := nil;
    frmXQWizard := TfrmXQWizard.Create(Application);
    if (frmXQWizard=nil) then Exit;
  except
  end;
  with ActiveXQTable do
  begin
    lbxPlayRec.ItemIndex := 0;
    lbxPlayRecClick(nil);
  end;

  frmXQWizard.QiziXY := ActiveXQTable.XQ.PlayTree.QiziXY;
  frmXQWizard.dRefreshQiziPosition;

  frmXQWizard.dEditPosition;
  if (frmXQWizard.ShowModal <> mrOk) then Exit;
  if (IsQzXYSame(ActiveXQTable.XQ.PlayTree.QiziXY,frmXQWizard.QiziXY, false, false))then Exit;

  if (ActiveXQTable.XQ.PlayStepNo > 0) then
  begin
    if (Application.MessageBox(
        PChar('初始棋图已经被修改，本操作将清除所有的行棋记录，确实要继续吗?'),
        '修改初始棋图',
        MB_OKCANCEL + MB_ICONWARNING + MB_DEFBUTTON1) <> IDOK) then
    begin
      Exit;
    end;
  end;

  ActiveXQTable.actPlayRecLastExecute(nil);
  while (ActiveXQTable.actPlayRecDelete.Enabled) do
  begin
    ActiveXQTable.actPlayRecDeleteExecute(nil);
  end;

  with ActiveXQTable do
  begin
    if (XQ.PlayStepNo<1) then
    begin
      iXQFType := 3;
      XQ.PlayTree.QiziXY := frmXQWizard.QiziXY;
      lbxPlayRecClick(lbxPlayRec);
    end;
  end;
end;

procedure TfrmMain.actEditPasteQipuToFileExecute(Sender: TObject);
begin
  if IsClipBoardTextQipu then
  begin
    FIsOpenFromClipBoard := True;
    OpenXQF('');
    FIsOpenFromClipBoard := False;
  end;
end;

procedure TfrmMain.dHandleOpenXqfMsg(var Msg: TMessage);
var
  s: string;
  a: ATOM;
  sFilename: string;
begin
  a := ATOM(Msg.lParam);
  SetLength(s, 256);
  GlobalGetAtomName(a, PChar(s), 255);
  try
    GlobalDeleteAtom(a);
  except
  end;
  sFilename := ExpandFileName(s);

  if FileExists(sFilename) then OpenXQF(sFilename);
end;


procedure TfrmMain.actEditMergeXqfExecute(Sender: TObject);
begin
  if (ActiveXQTable = nil) then Exit;
  ActiveXQTable.ppmMergeXqfClick(ActiveXQTable.ppmMergeXqf);
end;

procedure TfrmMain.FileImportItemClick(Sender: TObject);
var
  ABool: Boolean;
begin
  lblTextLine0.Caption := StringReplace(lblTextLine0.Caption, '播放', '转换', [rfReplaceAll]);
  lblTextLine1.Caption := StringReplace(lblTextLine1.Caption, '播放', '转换', [rfReplaceAll]);
  lblTextLine2.Caption := StringReplace(lblTextLine2.Caption, '播放', '转换', [rfReplaceAll]);
  lblTextLine3.Caption := StringReplace(lblTextLine3.Caption, '播放', '转换', [rfReplaceAll]);
  lbxPlayList.Height   := 173;

  pnlPlayList.Visible := True;
  pnlPlayList.Tag     := 1;


  ABool := (pnlPlayList.Tag = 0);
  gbxAutoPlaySetup.Visible := ABool;
  btnAutoPlay.Visible      := ABool;
  btnStopAutoPlay.Visible  := ABool;
  btnImport.Visible        := not ABool;
  btnStopImport.Visible    := not ABool;

  btnAddFile.Enabled       := True;
  btnDelFile.Enabled       := False;
  btnClearPlayList.Enabled := False;

  lbxPlayList.Items.Clear;
end;

procedure TfrmMain.btnImportClick(Sender: TObject);
begin
  isSetAutoImport := False;
  if (lbxPlayList.Items.Count < 1) then Exit;
  if (lbxPlayList.ItemIndex < 0) then lbxPlayList.ItemIndex := 0;
  sImportFileName := UpperCase(lbxPlayList.Items[lbxPlayList.ItemIndex]);
  if (pos('> OK', sImportFileName) > 0) then
  begin
    sImportFileName := '';
    Exit;
  end;
  isSetAutoImport := True;
  btnImport.Enabled := False;
  btnStopImport.Enabled := True;
  OpenXQF('');
end;

procedure TfrmMain.btnStopImportClick(Sender: TObject);
begin
  isSetAutoImport := False;
  sImportFileName := '';
  btnImport.Enabled := True;
  btnStopImport.Enabled := False;
end;

procedure TfrmMain.QiziXYtoBitmap(qzXY: dTXQZXY; img: TImage);
var
  RectS, RectD: TRect;
  i           : dTInt32;
  X, Y        : Integer;
begin
  if (not IsBitmapListLoaded) then Exit;

  try
    imgXQQituBmp.Canvas.CopyRect(       // 重新复制棋图
          Bounds(0, 0, imgXQQituBmp.Width, imgXQQituBmp.Height),
          imgXQBoardBmp.Canvas,
          Bounds(0, 0, imgXQQituBmp.Width, imgXQQituBmp.Height));

    for i:=1 to 32 do
    begin
      if (qzXY[i]=$FF) then Continue;

      X := (qzXY[i] div 10)       * FXQColW + FXQTopLeftX;
      Y := (9 - (qzXY[i] mod 10)) * FXQRowH + FXQTopLeftY;

      RectD := Bounds(X, Y, FImgXQQiziBmp[i].Width, FImgXQQiziBmp[i].Height);
      RectS := Bounds(0, 0, FImgXQQiziBmp[i].Width, FImgXQQiziBmp[i].Height);

      imgXQQituBmp.Canvas.CopyRect(RectD, FImgXQQiziBmp[i].Canvas, RectS);
    end;

    img.Picture := imgXQQituBmp.Picture;
  except
  end;
end;

procedure TfrmMain.actToolsBmpToClipExecute(Sender: TObject);
begin
  if (ActiveXQTable = nil) then Exit;
  ActiveXQTable.ppmBitmapCopyClick(nil);
end;

procedure TfrmMain.actToolsBmpToFileExecute(Sender: TObject);
begin
  if (ActiveXQTable = nil) then Exit;
  ActiveXQTable.ppmBitmapSaveAsBmpClick(nil);
end;

end.