tabfrm.pas

文件包含程序源原文件

procedure TTabForm.InitCtrlList(Target: TWinControl; Index,
  UpdateIndex: Integer; Prior, Next: TWinControl);
begin

     FCtrlList[FCtrlListCount]^.Target := Target;
     FCtrlList[FCtrlListCount]^.UpdateIndex := UpdateIndex;
     FCtrlList[FCtrlListCount]^.Prior := Prior;
     FCtrlList[FCtrlListCount]^.Next  := Next;
     FCtrlList[FCtrlListCount]^.Index := Index; //--
     Inc(FCtrlListCount);

end;

procedure TTabForm.PostCtrlList;
var
  i: Integer;
begin

     for i:=1 to FCtrlListCount-1 do
         FCtrlList[i]^.Prior := FCtrlList[i-1]^.Target;

     for i:=0 to FCtrlListCount-2 do
         FCtrlList[i]^.Next := FCtrlList[i+1]^.Target;

     for i:=FCtrlListCount to 99 do
         Dispose( FCtrlList[i] );

     FCtrlList[FCtrlListCount] := nil;

end;

function TTabForm.GetCtrlListTarget(Sender: TWinControl): PCONTROL_LIST;
var
  n: Integer;
begin

     FEntryCtrl:=nil;

     n:=0;
     while FCtrlList[n]<>nil do
     begin
          try
          if FCtrlList[n]^.Target=Sender then
          begin
               Result:=FCtrlList[n];
               FEntryCtrl:=FCtrlList[n];
               Exit;
          end
          except
                ;
          end;
          Inc(n);
     end;

     Result:=nil;
end;

procedure TTabForm.ResetCtrllistAddress;
var
  i: Integer;
begin

     for i:=0 to FCtrlListCount-1 do
         if FCtrlList[i]<>nil then
            FCtrlList[i]^.Address:=nil;
end;


function TTabForm.ReturnFocus: Boolean;
var
  n:Integer;
begin

     n:=0;

     Result:=True;
     while FCtrlList[n]<>nil do
     begin
          if FCtrlList[n]^.Focused then
          begin
               try
               FCtrlList[n]^.Target.SetFocus;
               except
               Result:=False;
               end;
               Exit;
          end;
          Inc(n);
     end;
     Result:=False;

end;

procedure TTabForm.ReturnValueFromTag(CtrlList: PCONTROL_LIST);
begin

     if CtrlList^.Target is TEx2NumEdit then begin
        CopyMemory(@((CtrlList^.Target as TEx2NumEdit).Value), Pointer(CtrlList^.Target.Tag), Sizeof(Extended));
        (CtrlList^.Target as TEx2NumEdit).Value := (CtrlList^.Target as TEx2NumEdit).Value;
     end
     else
     if CtrlList^.Target is TCustomEdit then
        (CtrlList^.Target as TCustomEdit).Text := StrPas(PChar(CtrlList^.Target.Tag))
     else
     if CtrlList^.Target is TCustomCombobox then
        (CtrlList^.Target as TCustomCombobox).Itemindex := (CtrlList^.Target as TCustomCombobox).Tag;

end;

procedure TTabForm.SetUndoBuffer(Sender: TObject);
var
  Control: TWinControl;
  Index,i: Integer;
  TmpP: Pointer;
  Recid: LongInt;
begin

     try
     Control:=Sender as TWinControl;
     except
     Exit;
     end;

     if Selected=nil then
        Exit;

     Index:=-1;
     for i:=0 to cMAX_UNDO -1 do
         if FUndoBuffer[i]=nil then
         begin
              Index:=i;
              break;
         end;


     if index<>0 then
     begin

          CopyMemory(@Recid, Selected, Sizeof(LongInt));
          if (Recid=FUndoBuffer[0]^.Recid) and  (Control=FundoBuffer[0]^.Control) then
          begin

               if (Sender is TEx2NumEdit) then
               begin
                    if (FUndoBuffer[0]^.Value = Extended(Pointer(Control.Tag)^)) then
                       Exit;
               end
               else
               if (Sender is TCustomEdit) and (FUndoBuffer[0]^.Value = StrPas(PChar(Control.Tag))) then
                  Exit
               else
               if (Sender is TCustomCombobox) and (FUndoBuffer[0]^.Value = Control.Tag) then
                  Exit;
          end;

     end;


     if Index<0 then
     begin
          TmpP:= FUndoBuffer[cMAX_UNDO-1];
          for i:=cMAX_UNDO-1 downto 1 do
              FUndoBuffer[i]:=FUndoBuffer[i-1];
          FUndoBuffer[0]:=TmpP;
     end
     else
     begin
          for i:=Index downto 1 do
              FUndoBuffer[i]:=FUndoBuffer[i-1];
          New(FUndoBuffer[0]);
     end;


     if Sender is TEx2NumEdit  then
        FUndoBuffer[0]^.Value := Extended( Pointer( Control.Tag )^ )
     else
     if Sender is TCustomEdit then
        FUndoBuffer[0]^.Value := StrPas( PChar( Control.Tag ))
     else
     if Sender is TCustomCombobox then
        FUndoBuffer[0]^.Value := Control.Tag;

     CopyMemory(@FUndoBuffer[0]^.RecId, Selected, Sizeof(LongInt));
     FUndoBuffer[0]^.Control := Control;

end;

function TTabForm.DoUndo: Boolean;
var
  i: Integer;
  Control: TWinControl;
  CtrlList: PCONTROL_LIST;
  Recid: LongInt;
begin

     Result:=False;

     if FUndoBuffer[0]=nil then
        Exit;

     RecId:=-1;

     if Selected<>nil then
        CopyMemory(@Recid, Selected, Sizeof(LongInt));


     //--
     if Recid<>FUndoBuffer[0]^.Recid then
     begin

          for i:=0 to TabControl.Tabs.Count-1 do
          begin

               if TabControl.Tabs.Objects[i]<>nil then
               begin
                    CopyMemory(@Recid, TabControl.Tabs.Objects[i], Sizeof(LongInt));
                    if Recid=FUndoBuffer[0]^.Recid then
                    begin
                         Selected := TabControl.Tabs.Objects[i];
                         break;
                    end;

               end;

          end;

     end;

     if Recid<>FUndoBuffer[0]^.Recid then
        Exit;

     FOnUndo:=True;

     if FUndoBuffer[0]^.Control is TEx2NumEdit then
        (FUndoBuffer[0]^.Control as TEx2NumEdit).Value := FUndoBuffer[0]^.Value
     else
     if FUndoBuffer[0]^.Control is TCustomEdit then
        (FUndoBuffer[0]^.Control as TCustomEdit).Text := FUndoBuffer[0]^.Value
     else
     if FUndoBuffer[0]^.Control is TCustomCombobox then
        (FUndoBuffer[0]^.Control as TCustomCombobox).ItemIndex := FUndoBuffer[0]^.Value;

     Control := FUndoBuffer[0]^.Control;

     Dispose(FUndoBuffer[0]);

     for i:=0 to cMAX_UNDO-2 do
         FUndoBuffer[i]:=FUndoBuffer[i+1];
     FUndoBuffer[cMAX_UNDO-1]:=nil;

     CtrlList := GetCtrlListTarget(Control);

     if CtrlList<>nil then
     begin

          try
          CtrlList^.Target.SetFocus;
          except
          ;
          end;

          Application.ProcessMessages;
          SetCtrlListFocus(CtrlList);


     end;

     FOnUndo:=False;

     if FUndoBuffer[0]<>nil then
        Result:=True;
end;

function TTabForm.SetUpdateList(Recid: Integer; Target: Pointer; Index,
  Level: Integer; Parent: Pointer): PUPDATE_LIST;
var
  lcP: PUPDATE_LIST;
begin

     Result:=nil;

     if Target=nil then
        Exit;

     if SearchUpdateList(Target)=True then
        Exit;


     New(lcP);
     lcP^.REC_ID:=Recid;
     lcP^.TARGET:=Target;
     lcP^.INDEX :=Index;
     lcP^.PARENT:=Parent;
     lcP^.LEVEL :=Level;
     FUpdateList.Add(lcP);

     Result:=lcP;

end;

procedure TTabForm.DeleteUpdateList(RecId, Index: Integer);
var
  i: Integer;
  lcP: PUPDATE_LIST;
begin

     i:=0;
     while i<FUpdateList.Count do
     begin

          lcP:=FUpdateList.Items[i];
          if lcP=nil then
             FUpdateList.Delete(i)
          else
          if (lcP^.REC_ID=Recid) and (lcP^.INDEX=Index) then
             FUpdateList.Delete(i)
          else
              Inc(i);
     end;

end;


function TTabForm.DateReturn(CtrlList: PCONTROL_LIST;
  Msg: Boolean): Boolean;
var
  TmpText: string;
begin

     Result:=False;

     TmpText := (CtrlList^.Target as TCustomEdit).Text;

     if (AnsiCompareText(TmpText, '  /  /  ')<>0) and (AnsiCompareText(TmpText, '__/__/__')<>0) then

        try
        StrToDate(TmpText);
        except
        begin
             if (Msg) and (MessageDlg('Date Error',mtError,[mbOk,mbIgnore],0)<>mrOk) then
                Result:=True;

             //--
             (CtrlList^.Target as TCustomEdit).Text := StrPas(PChar(CtrlList^.Target.Tag));
             Exit;

        end;
        end;

     TDateTime(CtrlList^.Address^) := StrToDate00to2000(TmpText);

     Result:=True;

end;

function TTabForm.GetUpdateListList: TList;
var
  List: TList;
  lcP: PUPDATE_LIST;
  i: Integer;
begin

  UpdateListListDisposeClear;

  List := TList.Create;
  List.Clear;

  for i:=0 to FUpdateList.Count-1 do
  begin
    lcP := FUpdateList[i];
    List := SearchUpdateListList(lcP);
    List.Add(lcP);
  end;

  Result := FUpdateListList;
end;

function TTabForm.InsertSQL(TableName: string; NewRecId: Integer; List: TList): string;
var
  ErrorCode, i: Integer;
  Sqls1, Sqls2, Value: string;
  lcP: PUPDATE_LIST;
begin

     Sqls1 :='Insert Into ' + TableName + ' (REC_ID';
     Sqls2 :=' Values('+IntToStr(NewRecid);

     for i:=0 to List.Count-1 do
     begin

          lcP := List[i];

          MakeUpdateValue(lcP, False, ErrorCode);

          if ErrorCode<>0 then
             Continue;

          Sqls1 := Sqls1 + ',' + GetFieldName(TableName, lcP^.Index);

          Value := MakeUpdateValue(lcP, False, ErrorCode);

          Sqls2 := Sqls2 + ',' + Value;

     end;

     Sqls1:=Sqls1+')';
     Sqls2:=Sqls2+')';

     Result := Sqls1 + Sqls2;
end;

function TTabForm.UpdateSQL(TableName: string; List: TList): string;
var
  Recid: LongInt;
  cons, Sqls1, Sqls2:String;
  i, ErrorCode: Integer;
  lcP: PUPDATE_LIST;
begin

     lcP := List[0];
     Recid:=lcP^.REC_ID;

     Sqls1 :='Update ' + TableName + ' Set';
     Sqls2 :=' Where REC_ID='+IntToStr(Recid);

     cons :=' ';
     for i:=0 to List.Count-1 do
     begin

          lcP := List[i];

          MakeUpdateValue(lcP, False, ErrorCode);

          if ErrorCode<>0 then
             Continue;

          Sqls1 := Sqls1 + cons + GetFieldName(TableName, lcP^.Index) + '=' +
                   MakeUpdateValue(lcP, False, ErrorCode);
          cons :=',';

     end;

     Result := Sqls1+Sqls2;
end;

function TTabForm.TabTrap(ShiftState: TShiftState): Boolean;
begin
     Result:=False;
end;

procedure TTabForm.CopyValueToTag(Sender: TObject; CtrlList: PCONTROL_LIST);
begin
     if Sender is TEx2NumEdit then
        CopyMemory(Pointer((Sender as TWinControl).Tag), @((Sender as TEx2NumEdit).Value), Sizeof(Extended))
     else
     if Sender is TCustomEdit then
        StrPCopy(PChar((Sender as TWinControl).Tag), (Sender as TCustomEdit).Text)
     else
     if Sender is TCustomCombobox then
        (Sender as TCustomCombobox).Tag := (Sender as TCustomCombobox).Itemindex;
end;

procedure TTabForm.FreeUpdateList(Item: Pointer);
var
  i: Integer;
  lcUdP: PUPDATE_LIST;
begin
  for i := FUpdateList.Count - 1 downto 0 do begin
    lcUdP := FUpdateList.Items[i];
    if (lcUdP <> nil) and (lcUdP^.PARENT = Item) then begin
      FUpdateList.Delete(i);
      Dispose(lcUdP);
    end;
  end;
end;

procedure TTabForm.SetCtrlListAddress(CtrlList: PCONTROL_LIST);
begin
     CtrlList^.Address := nil;

     if Selected = nil then
        Exit;

     CtrlList^.Address := Pointer( Longint(Selected) + CtrlList^.UpdateIndex);
end;

//--
procedure TTabForm.AddTab(Item: Pointer);
begin
  TabControl.Tabs.AddObject('', TObject(Item));
  TabControl.TabIndex := TabControl.Tabs.Count - 1;
  SetTabCaption(Selected);
  TabControlChange(Self);
end;

//--
procedure TTabForm.InsertTab(Item: Pointer; Index: Integer);
begin
  TabControl.Tabs.InsertObject(Index, '', TObject(Item));
  TabControl.TabIndex := Index;
  SetTabCaption(Selected);
  TabControlChange(Self);
end;

//--
procedure TTabForm.DeleteTab(Item: Pointer; DisposeFlag: Boolean);
var
  i, TabIndex: Integer;
begin
  TabIndex := -1;

  for i:=0 to TabControl.Tabs.Count - 1 do
    if TabControl.Tabs.Objects[i] = Item then begin

      if DisposeFlag then
        Dispose(Pointer(TabControl.Tabs.Objects[i]));

      TabControl.Tabs.Delete(i);
      TabIndex := i;
      Break;
    end;

  if TabIndex <= TabControl.Tabs.Count - 1 then begin
    TabControl.TabIndex := TabIndex;
    TabControlChange(Self);
  end
  else
  if TabControl.Tabs.Count > 0 then begin
    TabControl.TabIndex := TabIndex - 1;
    TabControlChange(Self);
  end
  else
    TabControl.TabIndex := -1;


end;

//--
procedure TTabForm.SetTabCaption(Item: Pointer);
begin
  TabControl.Tabs[TabControl.TabIndex] := GetTabCaption(Item);
end;

//--
procedure TTabForm.SelectTabIndex(Index: Integer);
begin
  if (Index < 0) or (Index >= TabControl.Tabs.Count) then
    Exit;

  TabControl.TabIndex := Index;
  TabControlChange(Self);
end;

//--
function TTabForm.GetSelected: Pointer;
begin
  if TabControl.TabIndex <> -1 then
    Result := TabControl.Tabs.Objects[TabControl.TabIndex]
  else
    Result := nil;
end;

procedure TTabForm.SetSelected(Item: Pointer);
var
  Index: Integer;
begin
  if Item <> nil then begin
    Index := TabControl.Tabs.IndexOfObject(Item);
    if Index <> -1 then
      TabControl.TabIndex := Index
    else
      TabControl.TabIndex := -1;
  end
  else
    TabControl.TabIndex := -1;

  TabControlChange(Self);
end;

procedure TTabForm.TabControlChanging(Sender: TObject; var AllowChange: Boolean);
begin
  try
    ClientPanel.SetFocus;     // ControlExit
  except
    ;
  end;

  SetTabCaption(Selected);
  SetKomoku(Selected);
end;

procedure TTabForm.TabControlChange(Sender: TObject);
begin
  if FOnTabChange then
    Exit;

  if (TabControl.TabIndex=-1) or (TabControl.TabIndex > TabControl.Tabs.Count-1) then
    Exit;

  FOnTabChange := True;
  try

    try
      ClientPanel.SetFocus;   // ControlExit--
    except
      ;
    end;

    SetTabCaption(Selected);
    SetKomoku(Selected);

    ResetCtrllistAddress;
    SetCtrlFocusFromIndex(0);

  finally
    FOnTabChange := False;
  end;

end;

end.