⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 pfibdsgnviewsqls.pas

📁 FIBPlus is a component suite intended for work with InterBase. It is direct, fast and flexible Inter
💻 PAS
📖 第 1 页 / 共 3 页
字号:
        Result := True;
        Break;
      end
      else
      if Components[k] is TFrame then
      begin
        Result:=IsValidFrame(TFrame(Components[k]));
        if Result then
          Break
      end;
   end;
end;

begin
 ClearForms;
 with Screen do
 for i:=Pred(CustomFormCount) downto 0 do
 begin

  if not (csDesigning in CustomForms[i].ComponentState) then
   Continue;
  with CustomForms[i] do
   begin
    UnName:=GetUnitName(CustomForms[i]);
    Found :=false;
    if UnitInProject(UnName) then
    for j:=0 to Pred(ComponentCount) do
{$IFNDEF D6+}
     if Pos('TDataModule',Components[j].ClassName)=1 then
     begin
       Found :=True; Break;
     end
     else
{$ENDIF}
     if (Components[j] is TFIBQuery) or
      (Components[j] is TFIBCustomDataSet)
{$IFDEF SQL_NAVIGATOR_SUPPORT_BDE}
     or (Components[j] is TQuery)
     or (Components[j] is TUpdateSQL)
{$ENDIF}
     then
     begin
       RegisterModule(CustomForms[i],UnName);
       Found :=True;
       Break;
     end
{$IFDEF D5+}
     else
     if Components[j] is TFrame then
     begin
      if IsValidFrame(TFrame(Components[j])) then
      begin
        RegisterModule(Components[j],UnName);
        Found :=True;
      end;
(*      tmpCmp:=Components[j];
      with tmpCmp do
      for k:=0 to Pred(ComponentCount) do
      if (Components[k] is TFIBQuery) or
        (Components[k] is TFIBCustomDataSet)
{$IFDEF SQL_NAVIGATOR_SUPPORT_BDE}
     or (Components[k] is TQuery)
     or (Components[k] is TUpdateSQL)
{$ENDIF}

      then
      begin
        RegisterModule(tmpCmp,UnName);
        Found :=True;
        Break;
      end *)
     end
{$IFDEF D6+}
     else
      if (ClassName='TDataModuleForm')  then
      begin
       tmpCmp:=Components[1];
       if (Components[j] is TDataModule) then
       with Components[j] do
        for k:=0 to Pred(ComponentCount) do
        if (Components[k] is TFIBQuery) or
        (Components[k] is TFIBCustomDataSet)
{$IFDEF SQL_NAVIGATOR_SUPPORT_BDE}
        or (Components[k] is TQuery)
        or (Components[k] is TUpdateSQL)
{$ENDIF}
        then
        begin
          RegisterModule(tmpCmp,UnName);
          Found :=True;
          Break;
        end
      end;
{$ENDIF}

{$ENDIF}
;
     if not Found then
     begin
      if FListOfOpenedForms.Find(UnName,k) then
      begin
       CloseUnFile(UnName);
       FListOfOpenedForms.Delete(k)
      end;
     end;
   end
 end;
 with Screen do
 for i:=Pred(DataModuleCount)  downto 0 do
 begin
  if not (csDesigning in DataModules[i].ComponentState) then Continue;
  UnName:=GetUnitName(DataModules[i]);
  Found :=false;
  if UnitInProject(UnName) then
  with DataModules[i] do
  for j:=0 to Pred(ComponentCount) do
   if (Components[j] is TFIBQuery) or
    (Components[j] is TFIBCustomDataSet)
{$IFDEF SQL_NAVIGATOR_SUPPORT_BDE}
     or (Components[j] is TQuery)
     or (Components[j] is TUpdateSQL)
{$ENDIF}

   then
   begin
     RegisterModule(DataModules[i],UnName);
     Found :=True;
     Break;
   end;// end if for


  if not Found then
  if FListOfOpenedForms.Find(UnName,k) then
  begin
     CloseUnFile(UnName);
     FListOfOpenedForms.Delete(k)
  end;
 end;

end;


procedure TfrmSaveSQLs.RegisterModule(Module: TComponent; const UnName:string);
var i:integer;
    ts:TStringList;

procedure DoRegister(Owner:TComponent);
var k:integer;
begin
  with Owner do
  for k:=0 to Pred(ComponentCount) do
   if (Components[k] is TFIBQuery) or
    (Components[k] is TFIBCustomDataSet)
{$IFDEF SQL_NAVIGATOR_SUPPORT_BDE}
     or (Components[k] is TQuery)
     or (Components[k] is TUpdateSQL)
{$ENDIF}

   then
   begin
    ts.AddObject(Components[k].Name+'  '+
    '('+Components[k].ClassName+')',
     TFIBSQLOwner.Create(Components[k])
    )
   end
   else
   if Components[k] is TFrame then
   begin
    DoRegister(TFrame(Components[k]));
   end;
end;

begin
 ts:=TStringList.Create;
 ts.Sorted:=True;
 ts.Duplicates:=dupIgnore;
 DoRegister(Module);
 i:= lstForms.Items.AddObject(Module.Name+'  '+
   '('+Module.ClassName+')',ts);
 if i>=Length(FUnits) then
  SetLength(FUnits,i+1);
 FUnits[i]:=UnName;
end;

function TfrmSaveSQLs.GetCurrentSQLOwner:TFIBSQLOwner;
begin
 Result:=nil;
 if (lstQueries.ItemIndex=-1) or (lstQueries.Items.Count<=0) then
  Exit;
 if lstForms.Items.Count>0 then
  Result:=TFIBSQLOwner(
         TStrings(lstForms.Items.Objects[lstForms.ItemIndex]).
          Objects[lstQueries.ItemIndex]
         );

end;

function GetFormDesigner(cmp:TComponent):
{$IFNDEF D6+}
TFormDesigner;
{$ELSE}
 IDesignerHook;
{$ENDIF}
var     DsgnForm   :TForm;
begin

  if cmp is TForm then
    DsgnForm:=TForm(cmp)
  else
  if cmp.Owner is TForm then
    DsgnForm:=TForm(cmp.Owner)
  else
   if cmp.Owner.Owner is TForm then
    DsgnForm:=TForm(cmp.Owner.Owner)
   else
   if cmp.Owner.Owner.Owner is TForm then
    DsgnForm:=TForm(cmp.Owner.Owner.Owner)
   else
    raise Exception.Create('Can''t... Sorry');
  {$IFNDEF D6+}
    Result:=TFormDesigner(DsgnForm.Designer)
  {$ELSE}
    Result:=DsgnForm.Designer
  {$ENDIF}

end;

var InEnter:boolean;

procedure TfrmSaveSQLs.FillQueryList;
var i:integer;
begin
 if InEnter then begin
  InEnter:=false;
  Exit;
 end;

 lstQueries.Clear;
 if lstForms.ItemIndex>-1 then
  lstQueries.Items.AddStrings(
   TStrings(lstForms.Items.Objects[lstForms.ItemIndex])
  );
 for i:=0 to Pred(lstQueries.Items.Count) do
 begin
  lstQueries.Checked[i]:=
  TFIBSQLOwner(
   TStrings(lstForms.Items.Objects[lstForms.ItemIndex]).
   Objects[i]
  ).vChecked;
 end;
end;


procedure TfrmSaveSQLs.lstFormsEnter(Sender: TObject);
begin
 FillQueryList;
 lstQueries.ItemIndex:=0;
 lstQueriesEnter(lstForms);
end;

procedure TfrmSaveSQLs.lstQueriesClickCheck(Sender: TObject);
begin
 SetQueryCheck(lstQueries.ItemIndex);
 if lstQueries.Checked[lstQueries.ItemIndex] then
  lstForms.Checked[lstForms.ItemIndex]:=True
 else
 if not ExistCheckedItems(lstQueries) then
  lstForms.Checked[lstForms.ItemIndex]:=false
end;


procedure TfrmSaveSQLs.ClearForms;
var
 i,j:integer;
begin
 with lstForms.Items do
 for i:=0 to Pred(Count) do
 begin
  for j:=0 to Pred(TStrings(Objects[i]).Count) do
   TStrings(Objects[i]).Objects[j].Free;
  Objects[i].Free;
 end;
 lstForms.Items.Clear;
 lstQueries.Items.Clear;
 ClearSQLs;
 SetLength(FUnits,0);
end;

procedure TfrmSaveSQLs.ClearSQLs;
begin
 memSQL.Lines.Clear;
 memInsertSQL.Lines.Clear;
 memUpdateSQL.Lines.Clear;
 memDeleteSQL.Lines.Clear;
 memRefreshSQL.Lines.Clear;
end;

procedure TfrmSaveSQLs.FormClose(Sender: TObject;
  var Action: TCloseAction);
var
  FIBSQLOwner:TFIBSQLOwner;
begin
 {$IFNDEF USE_SYN_EDIT}
  if ActiveControl is TMemo then
 {$ELSE}
   if ActiveControl is TSynMemo then
 {$ENDIF}
    MemoExit(ActiveControl);

 FIBSQLOwner:=GetCurrentSQLOwner;
 if FIBSQLOwner<>nil then
 begin
  CurrentComponent:=FIBSQLOwner.vFIBSQLOwner;
  FakeCmp.FreeNotification(CurrentComponent);
 end;
 ClearSearch;
 ClearForms;
end;

procedure TfrmSaveSQLs.lstFormsClickCheck(Sender: TObject);
begin
  SetModuleCheck(lstForms.ItemIndex);
  lstFormsEnter(lstForms)
end;



procedure TfrmSaveSQLs.lstQueriesEnter(Sender: TObject);
var FIBSQLOwner:TFIBSQLOwner;
begin
{
if InEnter then begin
 InEnter:=false;
 Exit;
end;
}
FIBSQLOwner:=GetCurrentSQLOwner;
if FIBSQLOwner=nil then
 Exit;
with FIBSQLOwner do
begin
 TabSQL.TabVisible:=True;
 TabInsertSQL.TabVisible:=vFIBSQLOwner is TFIBCustomDataSet;
 TabDeleteSQL.TabVisible:=vFIBSQLOwner is TFIBCustomDataSet;
 TabUpdateSQL.TabVisible:=vFIBSQLOwner is TFIBCustomDataSet;
 TabRefreshSQL.TabVisible:=vFIBSQLOwner is TFIBCustomDataSet;
// TabSheet5.TabVisible:=vFIBSQLOwner is TFIBCustomDataSet;
 if vFIBSQLOwner is TFIBQuery then
 begin
  TabSQL.Caption:='SQL';
  MemSQL.Text:=TFIBQuery(vFIBSQLOwner).SQL.Text;
 end
 else
 if vFIBSQLOwner is TFIBCustomDataSet then
 begin
  TabSQL.Caption:='SelectSQL';
  MemSQL.Text:=TFIBDataSet(vFIBSQLOwner).SelectSQL.Text;
  MemInsertSQL.Text :=TFIBDataSet(vFIBSQLOwner).InsertSQL.Text;
  MemUpdateSQL.Text :=TFIBDataSet(vFIBSQLOwner).UpdateSQL.Text;
  MemDeleteSQL.Text :=TFIBDataSet(vFIBSQLOwner).DeleteSQL.Text;
  MemRefreshSQL.Text:=TFIBDataSet(vFIBSQLOwner).RefreshSQL.Text;

    memSQL       .Modified:=false;
    memInsertSQL .Modified:=false;
    memUpdateSQL .Modified:=false;
    memDeleteSQL .Modified:=false;
    memRefreshSQL.Modified:=false;

 end
{$IFDEF SQL_NAVIGATOR_SUPPORT_BDE}
 else
  if vFIBSQLOwner is TQuery then
  begin
   TabSQL.Caption:='SQL';
   MemSQL.Text:=TQuery(vFIBSQLOwner).SQL.Text;

   memSQL       .Modified:=false;

  end
  else
  if vFIBSQLOwner is TUpdateSQL then
  begin
   TabSQL.Caption:='SQL';
//   MemSQL.Clear;
   TabSQL.TabVisible:=false;
   TabInsertSQL.TabVisible:=True;
   TabDeleteSQL.TabVisible:=True;
   TabUpdateSQL.TabVisible:=True;


   MemInsertSQL.Text :=TUpdateSQL(vFIBSQLOwner).InsertSQL.Text;
   MemUpdateSQL.Text :=TUpdateSQL(vFIBSQLOwner).ModifySQL.Text;
   MemDeleteSQL.Text :=TUpdateSQL(vFIBSQLOwner).DeleteSQL.Text;

   memInsertSQL .Modified:=false;
   memUpdateSQL .Modified:=false;
   memDeleteSQL .Modified:=false;
   memRefreshSQL.Modified:=false;
  end

{$ENDIF}

end;
if (OI<>nil)  and OI.Enabled and OI.Visible
then
begin
 InEnter:=lstQueries=ActiveControl;
 GotocurrentComponent1Click(nil);
 TWinControl(Sender).SetFocus
end;

end;

procedure TfrmSaveSQLs.SelectAll1Click(Sender: TObject);
var i:integer;
begin
 with TCheckListBox(PopupMenu1.PopupComponent) do begin
  for i:=0 to Pred(Items.Count) do begin
   Checked[i]:=Sender=SelectAll1;
   if PopupMenu1.PopupComponent=lstQueries then
    SetQueryCheck(i)
   else
    SetModuleCheck(i)
  end;
  if PopupMenu1.PopupComponent=lstQueries then
   lstForms.Checked[lstForms.ItemIndex]:=Sender=SelectAll1
  else
   lstFormsEnter(lstForms)
 end;
end;

procedure TfrmSaveSQLs.SetQueryCheck(Index: integer);
begin
 TFIBSQLOwner(
  TStrings(lstForms.Items.Objects[lstForms.ItemIndex]).
   Objects[Index]).vChecked:=
    lstQueries.Checked[Index];
end;

procedure TfrmSaveSQLs.SetModuleCheck(Index: integer);
var i:integer;
   ch:boolean;
begin
  with lstForms do
  begin
   ch:= Checked[Index];
   with TStrings(Items.Objects[Index])
   do
    for i:= 0 to Pred(Count) do
      TFIBSQLOwner(Objects[i]).vChecked:=ch;
  end;
end;

procedure TfrmSaveSQLs.ScanSelObjects(Operation:TOperationOnSQLText);
var F:TextFile;
    i,j:integer;
    ErrMsg:TStrings;
    AnalyzeResult:TStrings;
//    im:TIModuleInterface;
begin
 if Operation in [oSaveSQL,oAnalyzeSQL] then
 begin
  if SaveDialog1.Execute then
  begin
   AssignFile(F,SaveDialog1.FileName);
   Rewrite(F);
   Writeln(F,'Project  - "'+ GetActiveProjectName+'"');
  end
  else
   Exit;
 end;

   Screen.Cursor:=crHourGlass;
   AnalyzeResult:=TStringList.Create;
   try

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -