mainform_.pas

梅花易数排课软件

    X:=CalcExpre(LE2.Text);
    if X<0 then
    begin
      ShowMessage('数值太大！有必要吗？');
      LE2.SetFocus;
      goto Done;
    end;
    if (LE3.Text<>'') then//用数
      Y:=CalcExpre(LE3.Text)
    else//用时辰
      Y:=cbx.ItemIndex;
    if Y<0 then
    begin
      ShowMessage('数值太大！有必要吗？');
      LE3.SetFocus;
      goto Done;
    end;
    goto Change;
  end;

  if (LE2.Text='') then//数+时
  begin
    X:=S+cbx.ItemIndex;
    Y:=X;
//    goto Change;
  end;

Change:
    if S>8 then S:=S mod 8;
    if S=0 then S:=8;
    if X>8 then X:=X mod 8;
    if X=0 then X:=8;
    if Y>6 then Y:=Y mod 6;
    if Y=0 then Y:=6;

    GNum1:=S; GNum2:=X; GNum3:=Y;

    G[1].Value:=(8-X)*8+(8-S);
    G[2].Value:=HuGuaValue(G[1]);
    G[3].Value:=HuGuaValue(G[2]);
    G[4].Value:=BianGuaValue(G[1],Y);
    G[5].Value:=HuGuaValue(G[4]);

    NilImage;
    DrawValue(Image1,G[1].ShangGua.Value);
    DrawValue(Image2,G[1].XiaGua.Value);
    DrawValue(Image3,G[2].ShangGua.Value);
    DrawValue(Image4,G[2].XiaGua.Value);
    DrawValue(Image5,G[3].ShangGua.Value);
    DrawValue(Image6,G[3].XiaGua.Value);
    DrawValue(Image7,G[4].ShangGua.Value);
    DrawValue(Image8,G[4].XiaGua.Value);
    DrawValue(Image9,G[5].ShangGua.Value);
    DrawValue(Image10,G[5].XiaGua.Value);

    vb:=IntToStr(G[1].Value)+'begin';
    if G[1].Value<10 then vb:='0'+vb;
    begin
      for I:=0 to (YiJing.Lines.Count-1) do
      begin
        if LeftStr(YiJing.Lines[I],7)=vb then//找到卦经了
        begin
          Ln:=I+1;
          Memo.Clear;
          while RightStr(LeftStr(YiJing.Lines[Ln],7),5)<>'begin' do//逐行复制
          begin
            Memo.Lines.Add(YiJing.Lines[Ln]);
            Inc(Ln);
          end;
          Memo.SelStart:=0;
          Memo.SelLength:=0;
          Break;
        end;
      end;
    end;
Done:
  Refreshing:=False;
//  RefreshBtn.Enabled:=True;

end;

procedure TMainForm.ActExitExecute(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.FileExit1Hint(var HintStr: String;
  var CanShow: Boolean);
begin
  Close;
end;

procedure TMainForm.ClearActExecute(Sender: TObject);
begin
  if NeedToSave then
  begin
    if MessageDlg('当前数据未存档，是否现在保存？', mtConfirmation, [mbYes, mbNo], 0)=mrYes then
      FileSaveAs1.Execute;
  end;
  LE1.Text:='';
  LE2.Text:='';
  LE3.Text:='';
  cbx.ItemIndex:=0;
  Memo.Clear;
  Memo1.Clear;
  Memo2.Clear;
  Memo3.Clear;
  Memo4.Clear;
  NilImage;
  LE1.SetFocus;
  DateTimeNow;
  FileSaveAs1.Enabled:=False;
  NeedToSave:=False;
  ArchiveName:='';
end;

procedure TMainForm.RefreshActExecute(Sender: TObject);
var
  S,X,Y:Integer;//上、下、爻
  I,Ln:Integer;
  vb:string;
  label Change,Done;
begin
//确定用户使用哪种方式起卦
//计算1至3个输入表达式
//得到本卦和爻动
//互卦，互互，变卦、变互
//按卦画像，刷新IMAGE
  if Refreshing then Exit;
  Refreshing:=True;
  if NeedToSave then
  begin
    if MessageDlg('当前数据未存档，是否现在保存？', mtConfirmation, [mbYes, mbNo], 0)=mrYes then
    begin
      FileSaveAs1.Execute;
      NeedToSave:=False;
    end;
  end;

  ArchiveName:='';
//  RefreshBtn.Enabled:=False;

  if LE1.Text='' then
  begin
    ShowMessage('缺上卦');
    LE1.SetFocus;
    goto Done;
  end;

  if (LE2.Text='') and ((LE3.Text='') and (cbx.ItemIndex=0)) then
  begin
    ShowMessage('缺下卦或爻动');
    LE2.SetFocus;
    Exit;
  end;

  if (LE2.Text='') and (cbx.ItemIndex=0) then
  begin
    ShowMessage('这是什么起卦方法？真新鲜');
    LE3.SetFocus;
    goto Done;
  end;

  if (LE3.Text<>'') and (cbx.ItemIndex>0) then
  begin
    ShowMessage('请确定用数还是用时辰作为爻动，不用的项请留空');
    LE3.SetFocus;
    goto Done;
  end;

  S:=CalcExpre(LE1.Text);//上卦原始数据
  if S<0 then
  begin
    ShowMessage('数值太大！有必要吗？');
    LE1.SetFocus;
    goto Done;
  end;

  if (LE2.Text<>'') and (LE3.Text='') and (cbx.ItemIndex=0) then//只有上、下卦
  begin
    X:=CalcExpre(LE2.Text);
    if X<0 then
    begin
      ShowMessage('数值太大！有必要吗？');
      LE2.SetFocus;
      goto Done;
    end;
    Y:=(S+X);
    goto Change;
  end;

  if (LE2.Text<>'') and ((LE3.Text<>'') or (cbx.ItemIndex>0)) then//三部分都有
  begin
    X:=CalcExpre(LE2.Text);
    if X<0 then
    begin
      ShowMessage('数值太大！有必要吗？');
      LE2.SetFocus;
      goto Done;
    end;
    if (LE3.Text<>'') then//用数
      Y:=CalcExpre(LE3.Text)
    else//用时辰
      Y:=cbx.ItemIndex;
    if Y<0 then
    begin
      ShowMessage('数值太大！有必要吗？');
      LE3.SetFocus;
      goto Done;
    end;
    goto Change;
  end;

  if (LE2.Text='') then//数+时
  begin
    X:=S+cbx.ItemIndex;
    Y:=X;
//    goto Change;
  end;

Change:
    if S>8 then S:=S mod 8;
    if S=0 then S:=8;
    if X>8 then X:=X mod 8;
    if X=0 then X:=8;
    if Y>6 then Y:=Y mod 6;
    if Y=0 then Y:=6;

    GNum1:=S; GNum2:=X; GNum3:=Y;

    G[1].Value:=(8-X)*8+(8-S);
    G[2].Value:=HuGuaValue(G[1]);
    G[3].Value:=HuGuaValue(G[2]);
    G[4].Value:=BianGuaValue(G[1],Y);
    G[5].Value:=HuGuaValue(G[4]);

    NilImage;
    DrawValue(Image1,G[1].ShangGua.Value);
    DrawValue(Image2,G[1].XiaGua.Value);
    DrawValue(Image3,G[2].ShangGua.Value);
    DrawValue(Image4,G[2].XiaGua.Value);
    DrawValue(Image5,G[3].ShangGua.Value);
    DrawValue(Image6,G[3].XiaGua.Value);
    DrawValue(Image7,G[4].ShangGua.Value);
    DrawValue(Image8,G[4].XiaGua.Value);
    DrawValue(Image9,G[5].ShangGua.Value);
    DrawValue(Image10,G[5].XiaGua.Value);

    FileSaveAs1.Enabled:=True;
    
    vb:=IntToStr(G[1].Value)+'begin';
    if G[1].Value<10 then vb:='0'+vb;
    begin
      for I:=0 to (YiJing.Lines.Count-1) do
      begin
        if LeftStr(YiJing.Lines[I],7)=vb then//找到卦经了
        begin
          Ln:=I+1;
          Memo.Clear;
          while RightStr(LeftStr(YiJing.Lines[Ln],7),5)<>'begin' do//逐行复制
          begin
            Memo.Lines.Add(YiJing.Lines[Ln]);
            Inc(Ln);
          end;
          Memo.SelStart:=0;
          Memo.SelLength:=0;
          Break;
        end;
      end;
    end;
  NeedToSave:=True;
Done:
  Refreshing:=False;

end;

procedure TMainForm.WindowClose1Execute(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.btnNowClick(Sender: TObject);
begin
  DateTimeNow;
end;

procedure TMainForm.HelpActExecute(Sender: TObject);
begin
  InfoForm.ShowModal;
  ToolButton4.Down:=False;
end;

procedure TMainForm.ToolButton4Click(Sender: TObject);
begin
  HelpActExecute(nil);
  ToolButton4.Down:=False;
end;

procedure TMainForm.FileSaveAs1Accept(Sender: TObject);
begin
  MArchive.DateTime:=TimePicker.DateTime;
  MArchive.Num1:=GNum1;
  MArchive.Num2:=GNum2;
  MArchive.Num3:=GNum3;
  MArchive.Zhan:=Memo1.Lines.CommaText;
  MArchive.Duan:=Memo2.Lines.CommaText;
  MArchive.Yan:=Memo3.Lines.CommaText;
  MArchive.Jie:=Memo4.Lines.CommaText;
  if MArchive.SaveToFile(FileSaveAs1.Dialog.FileName) then
  begin
    NeedToSave:=False;
    ArchiveName:=FileSaveAs1.Dialog.FileName;
  end
  else
    MessageDlg('无法保存文件，如果目标文件已存在，请确定没在其它程序打开它。否则，有可能磁盘出错！', mtWarning, [mbOK], 0);
end;

procedure TMainForm.DatePickerChange(Sender: TObject);
begin
  TimePicker.Date:=DatePicker.Date;
end;

procedure TMainForm.FileOpen1Accept(Sender: TObject);
begin
  if MArchive.LoadFromFile(FileOpen1.Dialog.FileName) then
  begin
    DatePicker.DateTime:=MArchive.DateTime;
    TimePicker.DateTime:=MArchive.DateTime;
    Memo1.Lines.CommaText:=MArchive.Zhan;
    Memo2.Lines.CommaText:=MArchive.Duan;
    Memo3.Lines.CommaText:=MArchive.Yan;
    Memo4.Lines.CommaText:=MArchive.Jie;
    LE1.Text:=IntToStr(MArchive.Num1);
    LE2.Text:=IntToStr(MArchive.Num2);
    LE3.Text:=IntToStr(MArchive.Num3);
    ArchiveName:=FileOpen1.Dialog.FileName;
    NeedToSave:=False;
    RefreshAct.Execute;
  end
  else
  begin
    OpenErrForm.edtFilename.Text:=FileOpen1.Dialog.FileName;
    OpenErrForm.ShowModal;
  end;
end;

procedure TMainForm.FileSaveAs1BeforeExecute(Sender: TObject);
begin
  if ArchiveName<>'' then FileSaveAs1.Dialog.FileName:=ArchiveName else
    FileSaveAs1.Dialog.FileName:=DateToStr(DatePicker.Date)+' 占：'+Memo1.Lines[0];
end;

procedure TMainForm.FileOpen1BeforeExecute(Sender: TObject);
begin
  if NeedToSave then
  begin
    if MessageDlg('当前数据未存档，是现在保存？', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
      if ArchiveName<>'' then MArchive.SaveToFile(ArchiveName) else FileSaveAs1.Execute;
  end;

end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if NeedToSave then
  begin
    if MessageDlg('当前数据未存档，是否现在保存？', mtConfirmation, [mbYes, mbNo], 0)=mrYes then
      FileSaveAs1.Execute;
  end;
end;

procedure TMainForm.OptionActExecute(Sender: TObject);
begin
  OptionForm.ShowModal;
end;

procedure TMainForm.LE2KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key=VK_RETURN then LE3.SetFocus;
end;

procedure TMainForm.LE3KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key=VK_RETURN then CBX.SetFocus;
end;

procedure TMainForm.LE1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key=VK_RETURN then LE2.SetFocus;
end;

procedure TMainForm.cbxKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key=VK_RETURN then RefreshAct.Execute;
end;

initialization
  for I:=1 to 5 do G[I]:=TYiGua.Create;

finalization
  for I:=1 to 5 do G[I].Free;

end.