{***************************************************************}
{***               FVision Unit Version1.0                   ***}
{***                    蓝蚂蚁工作室                         ***}
{***************************************************************}
{***                   选择件对象单元                        ***}
{***************************************************************}
{$O+,F+,X+,I-}
Unit FGpf;
Interface
Uses
  Dos,FXmsDrv,Graph,FGraph,FMouse,FTool,
  FEvent,FView,FMenu,FPhoto,FPicture;

Type
  GpfHeader=record
   Sign:Array[0..31] of Char;
   PicType:Word;
   Number:Integer;
   Width:Word;
   Height:Word;
   BlockSize:Word;
  end;

  PGpf=^TGpf;
  TGpf=object(TView)
   FileName:PathStr;
   PicType:Word;
   XmsHandle:Word;
   Width,Height,BSize:Word;
   Number:Integer;
   Constructor Init(Name:PathStr);
   Destructor Done;virtual;
   Procedure NewFile(Name:PathStr);
   Procedure LoadFromFile(Name:PathStr);
   Procedure SaveFile;
   Procedure SaveToFile(Name:PathStr);
   Procedure PaintOne(Num:Integer;X,Y:Integer);
   Procedure Insert(GraF,GraB:Pointer);
   Procedure Delete(Num:Integer);
  end;

  PGpfEdit=^TGpfEdit;
  TGpfEdit=object(TWindow)
   Gpf:PGpf;
   Scroll:PScrollBar;
   Pic:PPicture;
   Status:PStatusLine;
   Num:TPoint;
   Pos:Integer;
   Constructor Init(Name:PathStr);
   Procedure InitMenu;virtual;
   Procedure Paint;virtual;
   Procedure Draw;virtual;
   Procedure LoadFile;
   Procedure SaveAsFile;
   Procedure SetScroll;
   Procedure InsertIco;
   Procedure HandleEvent(var Event:TEvent);virtual;
   Procedure RunPopupMenu(var Event:TEvent;T:TPoint);
  end;


Implementation
Constructor TGpf.Init;
begin
  Inherited Init;
  Option:=opCantSelect;
  FileName:=Name;
  PicType:=$2001;
  Number:=0;
  Width:=32;
  Height:=32;
  BSize:=1028;
  XmsHandle:=MallocXms(500);
  if Name<>'' then LoadFromFile(Name);
end;

Destructor TGpf.Done;
begin
  if XmsHandle<>0 then FreeXms(XmsHandle);
  Inherited Done;
end;

Procedure TGpf.PaintOne;
var
  Gra,Grab:Pointer;
begin
  Full(X,Y,X+Width-1,Y+Height-1,7);
  if (XmsHandle=0)or(Num>Number) then Exit;
  GetMem(Gra,BSize);
  GetMem(Grab,BSize);
  MoveXms(Gra,0,Pointer((Num-1)*BSize*2),XmsHandle,BSize);
  MoveXms(Grab,0,Pointer((Num-1)*BSize*2+BSize),XmsHandle,BSize);
  PutImage(X,Y,Grab^,ANDPUT);
  PutImage(X,Y,Gra^,XORPUT);
  FreeMem(Gra,BSize);
  FreeMem(Grab,BSize);
end;

Procedure TGpf.NewFile;
begin
  if XmsHandle<>0 then
    FreeXms(XmsHandle);
  FileName:=Name;
  PicType:=$2001;
  Number:=0;
  Width:=32;
  Height:=32;
  BSize:=1028;
  XmsHandle:=MallocXms(500);
end;

Procedure TGpf.LoadFromFile;
var
  Fp:File;
  Head:GpfHeader;
  Result:Word;
begin
  Assign(Fp,Name);
  Reset(Fp,1);
  if IOResult<>0 then Exit;
  if XmsHandle<>0 then FreeXms(XmsHandle);
  BlockRead(Fp,Head,SizeOf(GpfHeader),Result);
  PicType:=Head.PicType;
  Width:=Head.Width;
  Height:=Head.Height;
  Number:=Head.Number;
  BSize:=Head.BlockSize;
  Close(Fp);
  XmsHandle:=ReadFileToXms(Name,SizeOf(GpfHeader),500000,rxUserEnd);
  FileName:=Name;
end;

Procedure TGpf.SaveFile;
begin
  if (Number>0)and(FileName<>'') then
    SaveToFile(FileName);
end;

Procedure TGpf.SaveToFile;
var
  Fp:File;
  Head:GpfHeader;
  Result:Word;
begin
  Assign(Fp,Name);
  ReWrite(Fp,1);
  if IOResult<>0 then Exit;
  FileName:=Name;
  Head.PicType:=PicType;
  Head.Width:=Width;
  Head.Height:=Height;
  Head.Number:=Number;
  Head.BlockSize:=BSize;
  BlockWrite(Fp,Head,SizeOf(GpfHeader),Result);
  Close(Fp);
  WriteXmsToFile(XmsHandle,Name,0,Longint(BSize*2)*Longint(Number),wxAppend);
end;

Procedure TGpf.Insert;
var
  Dlt:Longint;
begin
  Dlt:=Longint(BSize*2)*Longint(Number);
  MoveXms(Pointer(Dlt),XmsHandle,GraF,0,BSize);
  MoveXms(Pointer(Dlt+BSize),XmsHandle,GraB,0,BSize);
  Inc(Number);
end;

Procedure TGpf.Delete;
var
  Dlt:Longint;
begin
  if Num>Number then Exit;
  Dlt:=Longint(BSize*2)*Longint(Number);
  MoveXms(Pointer(Dlt-BSize*2),XmsHandle,Pointer(Dlt),XmsHandle,Longint(BSize*2)*Longint(Number-Num));
  Dec(Number);
end;


Constructor TGpfEdit.Init;
var
  R:TRect;
  i,j:Integer;
begin
  Gpf:=New(PGpf,Init(Name));
  Num.X:=5;Num.Y:=6;
  AssignRect(R,0,0,(Gpf^.Width+4)*Num.X+140,(Gpf^.Height+4)*Num.Y+77);
  Inherited Init(R,'Gpf Editer',True);
  for i:=0 to Num.X-1 do
  for j:=0 to Num.Y-1 do
  begin
    AssignRect(R,10+i*(Gpf^.Width+4),50+j*(Gpf^.Height+4),
      10+i*(Gpf^.Width+4)+Gpf^.Width+2,50+j*(Gpf^.Height+4)+Gpf^.Height+2);
    Insert(New(PShape,Init(gcBroad+gcHideMouse,R,0,0,7,0,'')));
  end;
  AssignRect(R,13+(Gpf^.Width+4)*Num.X,50,15,(Gpf^.Height+4)*Num.Y-4);
  Scroll:=New(PScrollBar,Init(sbVer,R,0));
  Insert(Scroll);
  Insert(Gpf);
  Pic:=New(PPicture,Init(35+(Gpf^.Width+4)*Num.X,50,0,phStandDac));
  AssignRect(R,32,0,32*3,31);
  Pic^.SetViewRec(R);
  Insert(Pic);
  AssignRect(R,Broad.A.X+5,Broad.B.Y-25,Broad.B.X-5,Broad.B.Y-3);
  Status:=New(PStatusLine,Init(R,0,#0));
  Insert(Status);
  Pos:=0;
  Next;
  Center;
end;

Procedure TGpfEdit.InitMenu;
var
  T:TRect;
begin
  Inherited InitMenu;
  AssignRect(T,5,27,Broad.b.x-5,44);
  Insert(New(PMainMenu,Init(T,False,
   NewSubMenu('文件~F~',kbAltF,New(PMenu,Init(
     NewMenuItem('新建',kbNoKey,cmNew,nil,
     NewMenuItem('打开',kbNoKey,cmOpen,nil,
     NewMenuItem('保存',kbNoKey,cmSave,nil,
     NewMenuItem('另存为',kbNoKey,cmSaveAs,nil,
     NewMenuItem('',0,0,nil,
     NewMenuItem('退出  ~Alt+F3~',kbAltF3,cmCloseWin,nil,nil)))))))),
   NewSubMenu('编辑~E~',kbAltE,New(PMenu,Init(
     NewMenuItem('插入   ~Ins~',kbIns,cmInsert,nil,
     NewMenuItem('删除   ~Del~',kbDel,cmDelete,nil,nil)))),
   NewSubMenu('帮助~H~',kbAltH,New(PMenu,Init(
     NewMenuItem('关于',kbNoKey,cmAbout,nil,nil))),nil))))));
end;

Procedure TGpfEdit.Paint;
begin
  Inherited Paint;
  Draw;
end;

Procedure TGpfEdit.Draw;
var
  i,j:Integer;
begin
  HideMouse;
  for i:=0 to Num.X-1 do
  for j:=0 to Num.Y-1 do
  Gpf^.PaintOne(Pos+j*Num.X+i+1,
       Origin.X+10+i*(Gpf^.Width+4)+1,Origin.Y+50+j*(Gpf^.Height+4)+1);
  ShowMouse;
end;

Procedure TGpfEdit.LoadFile;
var
  FName:PathStr;
begin
  if OpenFile(FName,'打开文件','*.GPF') then
  if Exist_Fi(FName) then
  begin
    Gpf^.LoadFromFile(FName);
    Draw;
    Status^.Modify(FName+#0);
  end;
end;

Procedure TGpfEdit.SaveAsFile;
var
  FName:PathStr;
begin
  if OpenFile(FName,'保存文件','*.GPF') then
  if not Exist_Fi(FName) then
  begin
    Gpf^.SaveToFile(FName);
    Status^.Modify(FName+#0);
  end;
end;

Procedure TGpfEdit.SetScroll;
begin
  Draw;
  if Gpf^.Number-Num.X*Num.Y>0 then
    Scroll^.NewPos(Pos/(Gpf^.Number-Num.X*Num.Y))
  else
    Scroll^.NewPos(0);
end;

Procedure TGpfEdit.InsertIco;
var
  R:TRect;
  FName:PathStr;
  GraF,GraB:Pointer;
  Si:Word;
begin
  if OpenFile(FName,'打开文件','*.ICO') then
  if Exist_Fi(FName) then
  begin
    ChangePath(FName);
    Pic^.LoadFromFile(FName);
    AssignRect(R,32,0,32*3,31);
    Pic^.SetViewRec(R);
    Pic^.Paint;
    AssignRect(R,Origin.X+35+(Gpf^.Width+4)*Num.X,Origin.Y+50,
                 Origin.X+35+(Gpf^.Width+4)*Num.X+31,Origin.Y+50+31);
    GraF:=SaveImage(R.A.X,R.A.Y,R.B.X,R.B.Y,Si);
    Inc(R.A.X,32);Inc(R.B.X,32);
    GraB:=SaveImage(R.A.X,R.A.Y,R.B.X,R.B.Y,Si);
    Gpf^.Insert(GraF,GraB);
    FreeMem(GraF,Si);
    FreeMem(GraB,Si);
    SetScroll;
  end;
end;

Procedure TGpfEdit.HandleEvent;
Label Start;
begin
 Start:
  Inherited HandleEvent(Event);
  case Event.What of
  evMouseDown:if IsIn(Event.Where,Broad) and
                 (Event.Buttons=mbRightButton) then
              begin
                RunPopupMenu(Event,Event.Where);
                goto Start;
              end;
  evCommand:case Event.Command of
            cmUp:if Pos>0 then
                 begin
                   Dec(Pos,Num.X);
                   SetScroll;
                 end;
            cmDown:if Pos+Num.Y*Num.X<Gpf^.Number then
                 begin
                   Inc(Pos,Num.X);
                   SetScroll;
                 end;
            cmNew:begin
                    Gpf^.NewFile('NONAME.GPF');
                    SetScroll;
                    Status^.Modify('NONAME.GPF'#0);
                  end;
            cmOpen:LoadFile;
            cmSave:Gpf^.SaveFile;
            cmSaveAs:SaveAsFile;
            cmInsert:InsertIco;
            cmDelete:begin Gpf^.Delete(Gpf^.Number);SetScroll; end;
            else Exit;
            end;
  else Exit;
  end;
  ClearEvent(Event);
end;

Procedure TGpfEdit.RunPopupMenu;
var
  PopMenu:PMenu;
begin
  PopMenu:=New(PMenu,Init(
    NewMenuItem('插入 ~Ins~',kbIns,cmInsert,nil,
    NewMenuItem('删除 ~Del~',kbDel,cmDelete,nil,nil))));
  PopMenu^.Owner:=@Self;
  PopMenu^.MoveTo(T.X,T.Y);
  PopMenu^.Run(Event);
  Dispose(PopMenu);
end;

end.