xqwizard.pas

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

  pnlStep13.Visible   := rbtPlayType0.Checked or rbtPlayType2.Checked;

//  isResultVisible   :=rbtPlayType0.Checked;
//  lblResult.Visible :=isResultVisible;
//  rbtResult0.Visible:=isResultVisible;
//  rbtResult1.Visible:=isResultVisible;
//  rbtResult2.Visible:=isResultVisible;
//  rbtResult3.Visible:=isResultVisible;
end;

procedure TfrmXQWizard.pnlBottomResize(Sender: TObject);
begin
  btnPrior.Left   := btnNext.Left;
  btnPrior.Top    := btnNext.Top;
  btnPrior.Width  := btnNext.Width;
  btnPrior.Height := btnNext.Height;
end;

procedure TfrmXQWizard.btnFinishClick(Sender: TObject);
begin
  with XQFHead do
  begin
    CodeA := 0;
    if rbtPlayType0.Checked then CodeA := 0;
    if rbtPlayType1.Checked then CodeA := 1;
    if rbtPlayType2.Checked then CodeA := 2;
    if rbtPlayType3.Checked then CodeA := 3;

    PlayResult := 0;
    if rbtResult0.Checked then PlayResult := 0;
    if rbtResult1.Checked then PlayResult := 1;
    if rbtResult2.Checked then PlayResult := 2;
    if rbtResult3.Checked then PlayResult := 3;

    TitleA    := edtTitle.Text;
    MatchName := edtMatchName.Text;
    MatchTime := edtMatchTime.Text;
    MatchAddr := edtMatchAddr.Text;
    RedPlayer := edtRedPlayer.Text;
    BlkPlayer := edtBlkPlayer.Text;
    RMKWriter := edtRMKWriter.Text;
    Author    := edtAuthor.Text;
  end;
end;

procedure TfrmXQWizard.dSaveBoardToFile(sFilename: String);
var
  Bitmap      : TBitMap;
  AFormat     : Word;
  AData       : THandle;
  APalette    : HPalette;
  RectS, RectD: TRect;
  i, j, x, y  : dTInt32;
  AGreen, ASilver, AOlive: TColor;
begin
  Bitmap := TBitmap.Create;
  try
    imgXQBoard.Picture.SaveToClipboardFormat(AFormat,AData,APalette);
    ClipBoard.SetAsHandle(AFormat,AData);
    Bitmap.LoadFromClipboardFormat(AFormat,AData,APalette);

    for i:=1 to 32 do
    begin
      if (QiziXY[i]>89) then Continue;
      with imgQizi[i] do
      begin
        RectD := Rect(Left, Top, Left + Width, Top + Height);
        RectS := Rect(0, 0, Width, Height);
      end;
      if (i < 17) then
      begin
        imgQiziRed.Canvas.Pen.Mode := pmCopy;
        imgQiziRed.Canvas.CopyMode := cmSrcCopy;
        imgQiziRed.Canvas.CopyRect(RectS, imgQizi[i].Canvas, RectS);
        with imgQiziRed.Canvas do
        begin
          for x:=0 to RectS.Right do for y := 0 to RectS.Bottom do
          begin
            if (Pixels[x, y] = clRed) then
            begin
              Pixels[x, y] := RGB(255,255,255); continue;
            end;
            if (Pixels[x, y] = clWhite) then
            begin
              Pixels[x, y] := RGB(0, 0, 0); continue;
            end;
          end;
          Pen.Mode := pmMask;
          Ellipse(RectS);
        end;
        Bitmap.Canvas.CopyMode := cmSrcCopy;
        Bitmap.Canvas.CopyRect(RectD, imgQiziRed.Canvas, RectS);
      end
      else
      begin
        Bitmap.Canvas.CopyMode := cmSrcCopy;
        Bitmap.Canvas.CopyRect(RectD, imgQizi[i].Canvas, RectS);
      end;
    end;

    ASilver := Bitmap.Canvas.Pixels[0,   0];
    AGreen  := Bitmap.Canvas.Pixels[15, 80];
    AOlive  := Bitmap.Canvas.Pixels[17, 28];

    for i:=0 to Bitmap.Width do for j:=0 to Bitmap.Height do
    begin
      if (Bitmap.Canvas.Pixels[i, j] = ASilver) then
      begin
        Bitmap.Canvas.Pixels[i, j] := RGB(255,255,255);  continue;
      end;
      if (Bitmap.Canvas.Pixels[i, j] = AGreen) then
      begin
        Bitmap.Canvas.Pixels[i, j] := RGB(0, 0, 0);  continue;
      end;
      if (Bitmap.Canvas.Pixels[i, j] = AOlive) then
      begin
        Bitmap.Canvas.Pixels[i, j] := RGB(0, 0, 0);  continue;
      end;
    end;

    Bitmap.PixelFormat := pf4Bit;
    Bitmap.SaveToClipBoardFormat(AFormat,AData,APalette);
    ClipBoard.SetAsHandle(AFormat,AData);
    if (Trim(sFileName)<>'') then BitMap.SaveToFile(sFileName);

    if Assigned(imgQituImage) then
    begin
      imgQituImage.Canvas.CopyRect(
          Rect(0,0,imgXQBoard.Width, imgXQBoard.Height), Bitmap.Canvas,
          Rect(0,0,imgXQBoard.Width, imgXQBoard.Height));
      imgQituImage := nil;
    end;
  finally
    Bitmap.Free;
  end;
end;

procedure TfrmXQWizard.ppmCopyClick(Sender: TObject);
begin
  dSaveBoardToFile('');
end;

procedure TfrmXQWizard.ppmSaveAsBmpClick(Sender: TObject);
var
  sFileName : String;
begin
  if dlgSaveDialog.Execute then
  begin
    sFileName := dlgSaveDialog.FileName;
    if (Pos('.', sFileName)=0) then sFileName := sFileName + '.bmp';
    if FileExists(sFileName) then
    begin
      if (Application.MessageBox('文件已经存在，要替换吗?', '保存文件',
          MB_OKCANCEL + MB_DEFBUTTON1) = IDCANCEL) then Exit;
    end;
    dSaveBoardToFile(sFileName);
  end;
end;


procedure TfrmXQWizard.FormShow(Sender: TObject);
begin
  if FIsEditPosition then
     pgcSetup.ActivePage := tstStep2
  else
     pgcSetup.ActivePage := tstStep1;
end;

procedure TfrmXQWizard.dRefreshQiziPosition;
var
  i,xy, x, y: dTInt32;

begin
  // 全部的棋子不在盘上
  for i:=1 to 32 do
  begin
    if (QiziXY[i] = $FF) then Continue;
    xy := QiziXY[i];
    x  := xy div 10;
    y  := xy mod 10;

    imgQizi[i].Left := QiziXYRect[x, y].Left;
    imgQizi[i].Top  := QiziXYRect[x, y].Top;
  end;
end;

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

function TfrmXQWizard.isStringListToQiziXYOK(sl:TStringList; var qzXY:dTXQZXY): dTBoolean;
var
  i, j, k, x0, y0, iIdxBase : dTInt32;
  iIdxPos                   : array [1..5] of dTInt32;
  xy                        : dTXQZXY;
  s                         : String;
  sPiece                    : String[2];
begin
  Result := False;
  if sl.Count < 19 then Exit;

  // 寻找棋盘的左上角，x0为列数从1开始，y0为行数从0开始
  x0 := 0;  y0 := 0;
  for i:=0 to (sl.Count - 1) do
  begin
    x0 := pos('│　│　│　│＼│／│　│　│　│', sl.Strings[i]);
    if x0 > 0 then
    begin
      y0 := i - 1;
      if y0 < 0 then Exit;
      if ((y0 + 18) > sl.Count) then Exit;
      break;
    end;
  end;

  for i:=1 to 32 do xy[i] := $FF;

  for i:=0 to 9 do                      // 棋盘共有10行
  begin
    s := sl.Strings[y0 + ((9-i)*2)] + '   ';    // 取得文本列
    if ((Length(s) - x0 -1) < 34) then Exit;
    for j:=0 to 8 do                    // 棋盘共有9列
    begin
      if (j > 0) then k := -1 else k := 2;

      if (not (s[x0 + j*4 + k] in ['[', ']', '(', ')'])) then Continue;

      if ((s[x0 + j*4 + k] = '[') or (s[x0 + j*4 + k] = ']')) then
        iIdxBase := 16                  // 黑方
      else
        iIdxBase := 00;                 // 红方

      for k:=1 to 5 do iIdxPos[k] := 0;

      sPiece := '  ';
      sPiece[1] := s[x0 + j*4 + 0];
      sPiece[2] := s[x0 + j*4 + 1];

      if (sPiece = '车') then
      begin
        iIdxPos[1] := iIdxBase + 01;
        iIdxPos[2] := iIdxBase + 09;
      end;
      if (sPiece = '马') then
      begin
        iIdxPos[1] := iIdxBase + 02;
        iIdxPos[2] := iIdxBase + 08;
      end;
      if (sPiece = '相') or (sPiece = '象') then
      begin
        iIdxPos[1] := iIdxBase + 03;
        iIdxPos[2] := iIdxBase + 07;
      end;
      if (sPiece = '士') or (sPiece = '仕') then
      begin
        iIdxPos[1] := iIdxBase + 04;
        iIdxPos[2] := iIdxBase + 06;
      end;
      if (sPiece = '帅') or (sPiece = '将') then
      begin
        iIdxPos[1] := iIdxBase + 05;
      end;
      if (sPiece = '炮') then
      begin
        iIdxPos[1] := iIdxBase + 10;
        iIdxPos[2] := iIdxBase + 11;
      end;
      if (sPiece = '兵') or (sPiece = '卒') then
      begin
        iIdxPos[1] := iIdxBase + 12;
        iIdxPos[2] := iIdxBase + 13;
        iIdxPos[3] := iIdxBase + 14;
        iIdxPos[4] := iIdxBase + 15;
        iIdxPos[5] := iIdxBase + 16;
      end;

      for k:=1 to 5 do
      begin
        if iIdxPos[k] = 0 then Exit;
        if (xy[iIdxPos[k]]<>$FF) then Continue;

        if isQiziCanAtXY(iIdxPos[k], j, i) then
        begin
          xy[iIdxPos[k]] := j*10 + i;
        end;
        break;
      end;
    end;
  end;

  qzXY := xy;
  Result := True;
end;

// 根据目前的棋子位置刷新棋图
procedure TfrmXQWizard.ppmPastePositionClick(Sender: TObject);
var
  slTxt: TStringList;
begin
  slTxt := TStringList.Create;
try
  slTxt.Text := ClipBoard.AsText;

  IsPasteQituOk := True;
  if not (isStringListToQiziXYOK(slTxt, QiziXY)) then
  begin
    Application.MessageBox(
      '剪贴板中的文本不是有效的棋子位置图。'#13#10#13#10+
      '有效的位置图是由本' +
      '软件自动生成的文本大棋图(小棋图不可以)。'#13#10#13#10 +
      '请确认将正确的棋图文本选中并放入剪贴板。',
      '系统信息',
      MB_OK + MB_ICONWARNING + MB_DEFBUTTON1);
      IsPasteQituOk := False;
  end;
finally
  Self.dRefreshQiziPosition;
  slTxt.Free;
end;
end;

procedure TfrmXQWizard.QiziXYtoImage(qzXY: dTXQZXY; img: TImage);
var
  Bitmap      : TBitMap;
  AFormat     : Word;
  AData       : THandle;
  APalette    : HPalette;
  RectS, RectD: TRect;
  i           : dTInt32;
begin
  QiziXY := qzXY;
  dRefreshQiziPosition;

  Bitmap := TBitmap.Create;
  try
    imgXQBoard.Picture.SaveToClipboardFormat(AFormat,AData,APalette);
    ClipBoard.SetAsHandle(AFormat,AData);
    Bitmap.LoadFromClipboardFormat(AFormat,AData,APalette);

    for i:=1 to 32 do
    begin
      if (QiziXY[i]=$FF) then Continue;
      with imgQizi[i] do
      begin
        RectD := Rect(Left, Top, Left + Width, Top + Height);
        RectS := Rect(0, 0, Width, Height);
      end;
      Bitmap.Canvas.CopyRect(RectD, imgQizi[i].Canvas, RectS);
    end;

    Bitmap.SaveToClipBoardFormat(AFormat,AData,APalette);
    ClipBoard.SetAsHandle(AFormat,AData);
    Bitmap.PixelFormat := pf4Bit;
    img.Picture.LoadFromClipboardFormat(AFormat,AData,APalette);
  finally
    Bitmap.Free;
  end;
end;

procedure TfrmXQWizard.FormDestroy(Sender: TObject);
var
  i: Integer;
begin
  for i:=1 to 32 do begin imgQizi[i].Free; imgQizi[i] := nil; end;
end;

procedure TfrmXQWizard.ppm32QiziClick(Sender: TObject);
begin
  QiziXY := dCXqzXY;
  dRefreshQiziPosition;
end;

procedure TfrmXQWizard.ppm1MaClick(Sender: TObject);
begin
  QiziXY    := dCXqzXY;
  QiziXY[2] := $FF;
  dRefreshQiziPosition;
end;

procedure TfrmXQWizard.ppm2MClick(Sender: TObject);
begin
  QiziXY    := dCXqzXY;
  QiziXY[8] := $FF;
  dRefreshQiziPosition;
end;

procedure TfrmXQWizard.dEditPosition;
begin
  FIsEditPosition     := True;
  tstStep1.TabVisible := False;
  tstStep2.TabVisible := True;
  btnPrior.Visible    := False;
  btnNext.Visible     := False;
  btnFinish.Enabled   := True;
  Self.Caption        := ' 修改或调整当前文件初始局面的子力位置';
end;

end.