meihuayishu.pas

梅花易数排课软件

unit MeiHuaYiShu;//梅花易数

interface
uses IniFiles,SysUtils;
type
  TSanCai=(scTian,scRen,scDi);//三才--天,人,地
  TSanYaoWei = 1..3;
  TLiuYaoWei = 1..6;
  //阴阳爻
  TYinYangYao=(YinYao,YangYao);
  //八卦(即八经卦)
//  TSanYao=array[scTian..scDi] of Boolean;
  TBaGuaValue = 0..7;
  TYiGuaValue = 0..63;
  TBaGuaOrder=(bgNull,bgQian,bgDui,bgLi,bgZhen,bgXun,bgKan,bgGen,bgKun);//乾兑离震巽坎艮坤
  TBaGua=class
  private
    function GetOrder:TBaGuaOrder;
    function GetYao(YaoWei:TSanCai):Boolean;
    function GetCaption:string;
    procedure SetYao(YaoWei:TSanCai;YaoValue:Boolean);
  protected
    vValue:TBaGuaValue;//实值
    vCaption:string;
  public
    constructor Create(BGOrder:TBaGuaOrder);overload;//按卦序创建
    constructor Create(bgValue:TBaGuaValue);overload;//值
    constructor Create(Tian,Ren,Di:Boolean);overload;//三爻
    destructor Destroy;override;
    property Order:TBaGuaOrder read GetOrder;//卦序
    property Caption:string read GetCaption;
    property Yao[YaoWei:TSanCai]:Boolean read GetYao write SetYao;
    property Value:TBaGuaValue read vValue write vValue;
  end;
  //易卦，即六十四卦
  TYiGua=class
  private
    vValue:TYiGuaValue;
    vSG:TBaGua;
    vXG:TBaGua;
    procedure SetValue(theVal:TYiGuaValue);
    procedure SetShangGua(vGua:TBaGua);
    procedure SetXiaGua(vGua:TBaGua);
  public
    constructor Create;
    destructor Destroy;override;
    property Value:TYiGuaValue read vValue write SetValue;
    property ShangGua:TBaGua read vSG write SetShangGua;
    property XiaGua:TBaGua read vXG write SetXiaGua;
  end;

  TArchiveData=class
  private
    ini:TIniFile;  
  public
    DateTime:TDateTime;
    Num1:Integer;
    Num2:Integer;
    Num3:Integer;
    Zhan:string[255];
    Duan:string[255];
    Yan:string[255];
    Jie:string[255];
    function LoadFromFile(theFile:string):Boolean;
    function SaveToFile(theFile:string):Boolean;
    constructor Create;
  end;

var
  QianGua,DuiGua,LiGua,ZhenGua,XunGua,KanGua,GenGua,KunGua:TBaGua;//八卦
  function HuGuaValue(BenGua:TYiGua):TYiGuaValue;//求互卦值
  function BianGuaValue(BenGua:TYiGua;YaoDong:TLiuYaoWei):TYiGuaValue;//求变卦值

implementation

{ TBaGua }//八经卦

constructor TBaGua.Create(BGOrder:TBaGuaOrder);
begin

  vValue:=8-Integer(BGOrder);

end;

constructor TBaGua.Create(Tian, Ren, Di: Boolean);
begin
  vValue:=0;
  if Tian then Inc(vValue,4);
  if Ren then Inc(vValue,2);
  if Di then Inc(vValue,1);
end;

constructor TBaGua.Create(bgValue: TBaGuaValue);
begin
  vValue:=bgValue;
end;

destructor TBaGua.Destroy;
begin

  inherited;
end;

function TBaGua.GetOrder: TBaGuaOrder;
begin
  Result:=TBaGuaOrder(8-vValue);
end;

function TBaGua.GetYao(YaoWei: TSanCai): Boolean;
begin
  case YaoWei of
    scTian:Result:=((vValue and 4)=4);
    scRen:Result:=((vValue and 2)=2);
    scDi:Result:=((vValue and 1)=1);
  end;
end;

procedure TBaGua.SetYao(YaoWei: TSanCai; YaoValue: Boolean);
begin
  case YaoWei of
    scTian:vValue:=vValue or 4;
    scRen:vValue:=vValue or 2;
    scDi:vValue:=vValue or 1;
  end;
end;

function TBaGua.GetCaption: string;
begin
  case vValue of
    7:Result:='乾';
    6:Result:='兑';
    5:Result:='离';
    4:Result:='震';
    3:Result:='巽';
    2:Result:='坎';
    1:Result:='艮';
    0:Result:='坤';
  end;
end;

{ TYiGua }

constructor TYiGua.Create;
begin
  vSG:=TBaGua.Create(BGQian);
  vXG:=TBaGua.Create(BGQian);
end;

destructor TYiGua.Destroy;
begin
  vSG.Free;
  vXG.Free;
  inherited;
end;

procedure TYiGua.SetShangGua(vGua: TBaGua);
begin
  vSG.Value:=vGua.Value;
  vValue:=((vXG.Value shl 3) and 56) or vSG.Value;
end;

procedure TYiGua.SetValue(theVal: TYiGuaValue);
begin
  vValue:=theVal;
  vXG.Value:=(vValue shr 3) and 7;
  vSG.Value:=vValue and 7;
end;

procedure TYiGua.SetXiaGua(vGua: TBaGua);
begin
  vXG.Value:=vGua.Value;
  vValue:=((vXG.Value shl 3) and 56) or vSG.Value;
end;

function HuGuaValue(BenGua:TYiGua):TYiGuaValue;//求互卦值
begin
  Result:=((BenGua.Value shl 1) and 56) or ((BenGua.Value shr 1) and 7);
end;

function BianGuaValue(BenGua:TYiGua;YaoDong:TLiuYaoWei):TYiGuaValue;//求变卦值
begin
  Result:=BenGua.Value xor (1 shl (6-YaoDong));
end;

{ TArchiveData }

constructor TArchiveData.Create;
begin
  Num1:=-1;
  Num2:=-1;
  Num3:=-1;
  Zhan:='';
  Duan:='';
  Yan:='';
  Jie:='';
end;

function TArchiveData.LoadFromFile(theFile: string): Boolean;
label Gone;
begin
  Result:=False;
  if not(FileExists(theFile)) then Exit;
  try
    ini:=TIniFile.Create(theFile);
    if ini.ReadString('Header','App','')<>'MHYS' then goto Gone;
    if ini.ReadInteger('Header','Ver',0)<>1 then goto Gone;
    DateTime:=ini.ReadDateTime('Body','DateTime',Now);
    Num1:=ini.ReadInteger('Body','Num1',1);
    Num2:=ini.ReadInteger('Body','Num2',1);
    Num3:=ini.ReadInteger('Body','Num3',1);
    Zhan:=ini.ReadString('Body','Zhan','');
    Duan:=ini.ReadString('Body','Duan','');
    Yan:=ini.ReadString('Body','Yan','');
    Jie:=ini.ReadString('Body','Jie','');
    Result:=True;
Gone:
  finally
    ini.Free;
  end;
end;

function TArchiveData.SaveToFile(theFile: string): Boolean;
//label Gone;
begin
  Result:=False;
  if (Num1<1) or (Num2<1) or (Num3<1) then Exit;
  try
    ini:=TIniFile.Create(theFile);
    ini.WriteString('Header','App','MHYS');
    ini.WriteInteger('Header','Ver',1);
    ini.WriteDateTime('Body','DateTime',DateTime);
    ini.WriteInteger('Body','Num1',Num1);
    ini.WriteInteger('Body','Num2',Num3);
    ini.WriteInteger('Body','Num3',Num3);
    ini.WriteString('Body','Zhan',Zhan);
    ini.WriteString('Body','Duan',Duan);
    ini.WriteString('Body','Yan',Yan);
    ini.WriteString('Body','Jie',Jie);
    Result:=True;
  finally
    ini.Free;
  end;
end;

initialization

  QianGua:=TBaGua.Create(bgQian);
  DuiGua:=TBaGua.Create(bgDui);
  LiGua:=TBaGua.Create(bgLi);
  ZhenGua:=TBaGua.Create(bgZhen);
  XunGua:=TBaGua.Create(bgXun);
  KanGua:=TBaGua.Create(bgKan);
  GenGua:=TBaGua.Create(bgGen);
  KunGua:=TBaGua.Create(bgKun);

finalization

  QianGua.Free;
  DuiGua.Free;
  LiGua.Free;
  ZhenGua.Free;
  XunGua.Free;
  KanGua.Free;
  GenGua.Free;
  KunGua.Free;

{
procedure TMainForm.ActRefreshExecute(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;
//  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;

    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.ActClearExecute(Sender: TObject);
begin
  LE1.Text:='';
  LE2.Text:='';
  LE3.Text:='';
  cbx.ItemIndex:=0;
  Memo.Clear;
  NilImage;
  LE1.SetFocus;
end;

procedure TMainForm.LE1Change(Sender: TObject);
var
  ns,s:string;
  I:Integer;
begin
  //只允许 + , 0 .. 9 等12种字符
  if Checking then Exit;
  Checking:=True;
  ns:='';
  for I:=1 to Length(TLabeledEdit(Sender).Text) do
  begin
    s:=MidStr(TLabeledEdit(Sender).Text,I,1);
    if (s='+') or (s=',') or ((s>='0') and (s<='9') ) then ns:=ns+s;
  end;
  TLabeledEdit(Sender).Text:=ns;
  TLabeledEdit(Sender).SelStart:=Length(ns);
  Checking:=False;

end;
}

end.