mainform.pas.txt

对矩阵这种数据结构进行变换

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Buttons, MatClass, ComCtrls, Menus, About, WinSkinData;

type
  TFmRel = class(TForm)
    ScllBox: TScrollBox;
    ImgMat: TImage;
    Panel1: TPanel;
    sbtnNewMat: TSpeedButton;
    MainMenu1: TMainMenu;
    mmiFile: TMenuItem;
    mmiExit: TMenuItem;
    mniInduc: TMenuItem;
    SkinData1: TSkinData;
    Img01: TImage;
    StatusBar: TStatusBar;
    PopupMenu1: TPopupMenu;
    mniViewProp: TMenuItem;
    N1: TMenuItem;
    mniComple: TMenuItem;
    mniInverse: TMenuItem;
    N4: TMenuItem;
    mniRClsr: TMenuItem;
    mniSClsr: TMenuItem;
    mniTClsr: TMenuItem;
    procedure sbtnNewMatClick(Sender: TObject);
    procedure ImgMatMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ImgMatMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure mmiExitClick(Sender: TObject);
    procedure mniInducClick(Sender: TObject);
    procedure mniInverseClick(Sender: TObject);
    procedure mniCompleClick(Sender: TObject);
    procedure mniViewPropClick(Sender: TObject);
    procedure mniRClsrClick(Sender: TObject);
    procedure mniSClsrClick(Sender: TObject);
    procedure mniTClsrClick(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure ShowMatrix(var Mat: TRelMatrix);
  end;

const
  GridWidth = 24;
var
  FmRel: TFmRel;
  MatR: TRelMatrix;
  pActiveMat: ^TRelMatrix;
  PosX, PosY: integer;

implementation

{$R *.dfm}
//Create new matrix
procedure TFmRel.sbtnNewMatClick(Sender: TObject);
var
  flag: boolean;
  str: string;
  i, Row, Col: integer;
begin
  //Input Row
  repeat
    flag:=true;
    str:=InputBox('设置矩阵','请输入行数(1-128)', str );

    //Check if integer
    if length(str)<>0 then
    begin
      for i:=1 to length(str) do
      begin
        flag:= (str[i] in ['0'..'9']);
        if not flag then break;
      end;
      //Check range
      if flag then flag:= (StrToInt(str)>=1) and (StrToInt(str)<=128);
    end
    else
      exit;
  until flag;
  Row:=StrToInt(str);

  //Input Column
  repeat
    flag:=true;
    str:=InputBox('设置矩阵','请输入列数(1-128)', str );

    //Check if integer
    if length(str)<>0 then
    begin
      for i:=1 to length(str) do
      begin
        flag:= (str[i] in ['0'..'9']);
        if not flag then break;
      end;
      //Check range
      if flag then flag:= (StrToInt(str)>=1) and (StrToInt(str)<=128);
    end
    else
      exit;
  until flag;
  Col:=StrToInt(str);

  //Create a matrix
  if not Assigned(MatR) then
  begin
    MatR:=TRelMatrix.Create(Row, Col);
    pActiveMat:= @MatR;
  end
  else
  begin
    MatR.Destroy;
    MatR:=TRelMatrix.Create(Row, Col);
    pActiveMat:= @MatR;
  end;

  ShowMatrix(MatR);
end;
//显示矩阵
procedure TFmRel.ShowMatrix(var Mat: TRelMatrix);
var
  i, j: integer;
begin
  if not Assigned(Mat) then exit;

  StatusBar.Panels[0].Text:= Format('A relation R represented by %d * %d Matrix',[Mat.Row, Mat.Col]);
  StatusBar.Panels[1].Text:= '';
  StatusBar.Panels[2].Text:= '';

  pActiveMat:=@Mat;
  ImgMat.Width:=24*Mat.Col;
  ImgMat.Height:=24*Mat.Row;

  for i:= 0 to Mat.Row-1 do
    for j:= 0 to Mat.Col-1 do
    begin
      case Mat.Matrix[i, j] of
      0:
        begin
          ImgMat.Canvas.CopyRect(Rect(j*GridWidth, i*GridWidth,
            (j+1)*GridWidth, (i+1)*24),
            Img01.Canvas, Rect(0,0,24,24));
        end;
      1:
        begin
          ImgMat.Canvas.CopyRect(Rect(j*GridWidth, i*GridWidth,
            (j+1)*GridWidth, (i+1)*24),
            Img01.Canvas, Rect(24,0,48,24));
        end;
      end;
    end;
end;

procedure TFmRel.ImgMatMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  tPosX, tPosY: integer;
begin
  if pActiveMat=nil then exit;
  tPosX:=X div GridWidth;
  tPosY:=Y div GridWidth;
  
  if (tPosY<0) or (tPosY>pActiveMat^.Row-1)
    or (tPosX<0) or (tPosX>pActiveMat^.Col-1) then exit;

  if (tPosX<>PosX) or (tPosY<>PosY) then
  begin
      if (PosY>=0) and (PosY<=pActiveMat^.Row-1)
      and (PosX>=0) and (PosX<=pActiveMat^.Col-1) then
      begin
          case pActiveMat^.Matrix[PosY, PosX] of
          0:
            begin
              ImgMat.Canvas.CopyRect(Rect(PosX*GridWidth, PosY*GridWidth,
                (PosX+1)*GridWidth, (PosY+1)*24),
                Img01.Canvas, Rect(0,0,24,24));
            end;
          1:
            begin
              ImgMat.Canvas.CopyRect(Rect(PosX*GridWidth, PosY*GridWidth,
                (PosX+1)*GridWidth, (PosY+1)*24),
                Img01.Canvas, Rect(24,0,48,24));
            end;
          end;
      end;

      case pActiveMat^.Matrix[tPosY, tPosX] of
      0:
        begin
          ImgMat.Canvas.CopyRect(Rect(tPosX*GridWidth, tPosY*GridWidth,
            (tPosX+1)*GridWidth, (tPosY+1)*24),
            Img01.Canvas, Rect(0,24,24,48));
        end;
      1:
        begin
          ImgMat.Canvas.CopyRect(Rect(tPosX*GridWidth, tPosY*GridWidth,
            (tPosX+1)*GridWidth, (tPosY+1)*24),
            Img01.Canvas, Rect(24,24,48,48));
        end;
      end;

      PosX:=tPosX;
      PosY:=tPosY;
  end;

  StatusBar.Panels[1].Text:= Format(' Row: %d  Col: %d',[tPosY+1, tPosX+1]);

  case pActiveMat^.Matrix[tPosY, tPosX] of
  1:
    StatusBar.Panels[2].Text:= Format(' [%d] R [%d]',[tPosY+1, tPosX+1]);
  0:                                         
    StatusBar.Panels[2].Text:= Format(' [%d] not R [%d]',[tPosY+1, tPosX+1]);
  end;
end;

procedure TFmRel.ImgMatMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  tPosX, tPosY: integer;
begin
  if pActiveMat=nil then exit;
  if Button=mbLeft then
  begin
      tPosX:=X div GridWidth;
      tPosY:=Y div GridWidth;
      (pActiveMat^).Matrix[tPosY, tPosX]:=1-(pActiveMat^).Matrix[tPosY, tPosX];

      case pActiveMat^.Matrix[tPosY, tPosX] of
      0:
        begin
          ImgMat.Canvas.CopyRect(Rect(tPosX*GridWidth, tPosY*GridWidth,
            (tPosX+1)*GridWidth, (tPosY+1)*24),
            Img01.Canvas, Rect(0,24,24,48));
        end;
      1:
        begin
          ImgMat.Canvas.CopyRect(Rect(tPosX*GridWidth, tPosY*GridWidth,
            (tPosX+1)*GridWidth, (tPosY+1)*24),
            Img01.Canvas, Rect(24,24,48,48));
        end;
      end;
  end;
end;

procedure TFmRel.FormCreate(Sender: TObject);
begin
  ImgMat.Width:=24*128;
  ImgMat.Height:=24*128;
  ImgMat.Canvas.FillRect(ImgMat.ClientRect);
end;

//退出
procedure TFmRel.mmiExitClick(Sender: TObject);
begin
  Application.Terminate;
end;

//说明
procedure TFmRel.mniInducClick(Sender: TObject);
begin
  AboutForm.Show;
end;

//逆关系
procedure TFmRel.mniInverseClick(Sender: TObject);
begin                    
  if not Assigned(MatR) then exit;
  
  MatR:= MatR.Invertion;
  pActiveMat:= @MatR;

  ShowMatrix(MatR);
end;

//互补关系
procedure TFmRel.mniCompleClick(Sender: TObject);
begin
  if not Assigned(MatR) then exit;

  MatR:= MatR.Complement;
  pActiveMat:= @MatR;

  ShowMatrix(MatR);
end;
//查看属性
procedure TFmRel.mniViewPropClick(Sender: TObject); 
const
  RelProp: array[0..9] of string=
    ('自反','反自反','对称','非对称',
     '反对称','传递','等价', '相容', '偏序','拟序');
var
  MsgText: string;

  function BoolToStat(data: boolean): string;
  begin
    if data then result:='Yes'
    else result:='No'
  end;

begin
      MsgText:=MsgText + RelProp[0]+': ';
      MsgText:=MsgText + BoolToStat(pActiveMat^.IsReflexive)+#10;
      MsgText:=MsgText + RelProp[1]+': ';
      MsgText:=MsgText + BoolToStat(pActiveMat^.IsIrreflexive)+#10;
      MsgText:=MsgText + RelProp[2]+': ';
      MsgText:=MsgText + BoolToStat(pActiveMat^.IsSymmetric)+#10;
      MsgText:=MsgText + RelProp[3]+': ';
      MsgText:=MsgText + BoolToStat(pActiveMat^.IsAsymmetric)+#10;
      MsgText:=MsgText + RelProp[4]+': ';
      MsgText:=MsgText + BoolToStat(pActiveMat^.IsAntisymmetric)+#10;
      MsgText:=MsgText + RelProp[5]+': ';
      MsgText:=MsgText + BoolToStat(pActiveMat^.IsTransitive)+#10;
      MsgText:=MsgText + RelProp[6]+': ';
      MsgText:=MsgText + BoolToStat(pActiveMat^.IsEquivalence)+#10; 
      MsgText:=MsgText + RelProp[7]+': ';
      MsgText:=MsgText + BoolToStat(pActiveMat^.IsCompatibility)+#10;
      MsgText:=MsgText + RelProp[8]+': ';
      MsgText:=MsgText + BoolToStat(pActiveMat^.IsPartialOrder)+#10;  
      MsgText:=MsgText + RelProp[9]+': ';
      MsgText:=MsgText + BoolToStat(pActiveMat^.IsQuasiOrder)+#10;

      Application.MessageBox(PChar(MsgText),
                             PChar('关系属性                  '), MB_OK);
end;

//自反闭包
procedure TFmRel.mniRClsrClick(Sender: TObject);
begin
  MatR:=MatR.ReflexiveClosure;
  pActiveMat:=@MatR;
  ShowMatrix(pActiveMat^);
end;
//对称闭包
procedure TFmRel.mniSClsrClick(Sender: TObject);
begin
  MatR:=MatR.SymmetricClosure;
  pActiveMat:=@MatR;
  ShowMatrix(pActiveMat^);
end;
//传递闭包
procedure TFmRel.mniTClsrClick(Sender: TObject);
begin
  MatR:=MatR.TransitiveClosure;
  pActiveMat:=@MatR;
  ShowMatrix(pActiveMat^);
end;

procedure TFmRel.PopupMenu1Popup(Sender: TObject);
begin
  if pActiveMat=nil then exit;
  TPopupMenu(Sender).Items[0].Enabled:=(pActiveMat^.Row=pActiveMat^.Col);
  TPopupMenu(Sender).Items[5].Enabled:=(pActiveMat^.Row=pActiveMat^.Col);
  TPopupMenu(Sender).Items[6].Enabled:=(pActiveMat^.Row=pActiveMat^.Col);
  TPopupMenu(Sender).Items[7].Enabled:=(pActiveMat^.Row=pActiveMat^.Col);
end;

end.