childwin.pas

RxRich很有用的文字图像显示控件,这是它的Demo

      StopWait;
    end;
  end;
  if VQBLoaded then begin
    ExecBuilder(Query1);
    SQLMemo.Lines := Query1.SQL;
    SQLMemo.Modified := True;
    UpdateSQLHistory;
  end
  else DatabaseError(SVqbNotLoaded);
{$ELSE}
  NotImplemented;
{$ENDIF}
end;

procedure TMDIChild.QueryAborting(DataSet: TDataSet; var AbortQuery: Boolean);
begin
  if (DataSet = Query1) and EnableQueryAbort then begin
    CancelItem.Enabled := not FAbortQuery;
    AbortQuery := FAbortQuery;
  end;
end;

procedure TMDIChild.DBQryProgress(Sender: TObject; var Abort: Boolean);
begin
  if FQueryRunning and EnableQueryAbort then begin
    CancelItem.Enabled := not FAbortQuery;
    Abort := FAbortQuery;
  end;
end;

procedure TMDIChild.CancelQueryClick(Sender: TObject); { for 32-bit only }
begin
  if FQueryRunning then begin
    FAbortQuery := True;
    QueryAnimation.Hint := Format(SQueryAborting, [DatabaseName]);
  end;
  CancelItem.Enabled := False;
end;

procedure TMDIChild.RunSQLClick(Sender: TObject);
begin
  if FQueryRunning then Exit;
  Query1.Close;
  if Query1.SQL.Text <> SQLMemo.Lines.Text + #13#10 then begin
    Query1.SQL.Text := SQLMemo.Lines.Text + #13#10;
  end;
  if SQLMemo.Lines.Count = 0 then Exit;
  Query1.RequestLive := LiveQueries;
  {Query1.Params.Clear;} {!!!???}
  Query1.Macros.Clear;
  Query1.Unprepare;
  UpdateSQLHistory;
  ExecSQL;
end;

procedure TMDIChild.UpdateSQLHistory;
begin
  if (SQLMemo.Modified) and (SQLMemo.Lines.Count > 0) then begin
    while FSQLHistory.Count >= SQLHistoryCapacity do
      if FSQLHistory.Count > 0 then FSQLHistory.Delete(0);
    if (SQLHistoryCapacity > 0) then begin
      FSQLHistoryIndex := FSQLHistory.AddObject('',
        TStringList.Create);
      TStrings(FSQLHistory.Objects[FSQLHistoryIndex]).Assign(SQLMemo.Lines);
      SQLMemo.Modified := False;
    end;
  end;
  EnableSQLHistoryItems;
end;

procedure TMDIChild.EnableSQLHistoryItems;
begin
  PriorSQL.Enabled := ((FSQLHistoryIndex > 0) or (FSQLHistoryIndex = -1)) and
    (FSQLHistory.Count > 0);
  PriorSQLItem.Enabled := PriorSQL.Enabled;
  NextSQL.Enabled := (FSQLHistoryIndex <> -1);
  NextSQLItem.Enabled := NextSQL.Enabled;
end;

procedure TMDIChild.FieldListCalcFields(DataSet: TDataset);
var
  F: TField;
begin
  FieldList1TypeName.AsString := FieldTypeName(FieldList1TYPE.AsInteger);
  FieldList1SubTypeName.AsString := FieldSubtypeName(FieldList1SUBTYPE.AsInteger);
  F := Table1.FindField(FieldList1NAME.AsString);
  if F <> nil then FieldList1Required.AsBoolean := (F.Tag = 2) or F.Required;
end;

procedure TMDIChild.TablesGridDrawDataCell(Sender: TObject;
  const Rect: TRect; Field: TField; State: TGridDrawState);
var
  I: Integer;
begin
  if Field.FieldName = 'Pict' then begin
    if TableListVIEW.AsBoolean then I := 1 else I := 0;
    if TableListDELETED.AsBoolean then I := 4;
    DbImages.DrawCenter(TablesGrid.Canvas, Rect, I);
  end;
end;

procedure TMDIChild.OpenTableClick(Sender: TObject);
begin
  SetToCurrentTable;
end;

procedure TMDIChild.TablesGridKeyPress(Sender: TObject; var Key: Char);
begin
  if (Key = Char(VK_RETURN)) then SetToCurrentTable;
end;

procedure TMDIChild.GridDblClick(Sender: TObject);
var
  F: TField;
begin
  if GetActiveDataSource.State in [dsBrowse, dsEdit, dsInsert] then begin
    F := (Sender as TrxDBGrid).SelectedField;
    if F = nil then Exit;
    if (F.DataType in [ftMemo]) then
      StrListEdit(GetActiveDataSource.DataSet, F.FieldName)
    else if (F.DataType in [ftGraphic]) then
      PictureEdit(GetActiveDataSource.DataSet, F.FieldName)
    else if (F.DataType in ftBlobTypes) then
      BlobView(GetActiveDataSource.DataSet, F.FieldName);
    (Sender as TrxDBGrid).Update;
  end;
end;

procedure TMDIChild.AfterPost(DataSet: TDataset);
begin
  try
    DataSet.Refresh;
  except
  end;
end;

procedure TMDIChild.CloseItemClick(Sender: TObject);
begin
  Close;
end;

procedure TMDIChild.FilterItemClick(Sender: TObject);
var
  TabMask: string;
  P: TPoint;
begin
  TabMask := TableList.FileMask;
  P.X := TablesGrid.Left + 25;
  P.Y := TablesGrid.Top + 25;
  P := ClientToScreen(P);
  if ShowFilterDialog(TabMask, P.X, P.Y) then
    TableList.FileMask := TabMask;
end;

procedure TMDIChild.PopupSQLMenuClick(Sender: TObject);
begin
  case TMenuItem(Sender).Tag of
    1: if SQLMemo.Perform(EM_CANUNDO, 0, 0) <> 0 then
         SQLMemo.Perform(EM_UNDO, 0, 0);
    2: SQLMemo.CutToClipboard;
    3: SQLMemo.CopyToClipboard;
    4: SQLMemo.PasteFromClipboard;
    5: SQLMemo.SelectAll;
    6: if SaveDialog1.Execute then begin
         SaveDialog1.InitialDir := ExtractFilePath(SaveDialog1.FileName);
         SQLMemo.Lines.SaveToFile(SaveDialog1.FileName);
       end;
    7: if OpenDialog1.Execute then begin
         OpenDialog1.InitialDir := ExtractFilePath(OpenDialog1.FileName);
         SQLMemo.Lines.LoadFromFile(OpenDialog1.FileName);
         SQLMemo.Modified := True;
         UpdateSQLHistory;
       end;
    8: RunSQLClick(Sender);
    9: NavigateSQLClick(PriorSQL);
   10: NavigateSQLClick(NextSQL);
   11: RunQueryBuilder;
   12: if not FQueryRunning and (SQLMemo.Lines.Count > 0) then begin
         { parameters }
         if Query1.SQL.Text <> SQLMemo.Lines.Text + #13#10 then begin
           Query1.Close;
           Query1.SQL.Text := SQLMemo.Lines.Text + #13#10;
         end;
         EditQueryParams(Query1, Query1.Params, 0);
       end;
  end;
end;

procedure TMDIChild.PopupSQLMenuPopup(Sender: TObject);
var
  EnableCopy: Boolean;
begin
  EnableCopy := SQLMemo.SelLength <> 0;
  Undo1.Enabled := (SQLMemo.Perform(EM_CANUNDO, 0, 0) <> 0);
  Cut1.Enabled := EnableCopy;
  Copy1.Enabled := EnableCopy;
  Paste1.Enabled := Clipboard.HasFormat(CF_TEXT);
  SelectAll1.Enabled := SQLMemo.Lines.Count > 0;
  Saveas1.Enabled := SQLMemo.Lines.Count > 0;
  Runquery1.Enabled := (SQLMemo.Lines.Count > 0) and not FQueryRunning;
  QueryParamItem.Enabled := Runquery1.Enabled;
  EnableSQLHistoryItems;
end;

procedure TMDIChild.SQLMemoChange(Sender: TObject);
begin
  RunSQL.Enabled := (SQLMemo.Lines.Count > 0) and not FQueryRunning;
  Runquery1.Enabled := (SQLMemo.Lines.Count > 0) and not FQueryRunning;
  QueryParamItem.Enabled := (SQLMemo.Lines.Count > 0) and not FQueryRunning;
end;

procedure TMDIChild.SetTrace(Value: Boolean);
begin
  DBQueryProgress.TraceFlags := SQLTraceFlags;
  DBQueryProgress.Trace := Value;
end;

procedure TMDIChild.CloseDatabase;
var
  TempDatabase: TDatabase;
begin
  CloseCurrent;
  Query1.Close;
  TableList.Close;
  TempDatabase := Session.FindDatabase(DatabaseName);
  if TempDatabase <> nil then
    TempDatabase.Session.CloseDatabase(TempDatabase);
end;

procedure TMDIChild.FormCreate(Sender: TObject);
begin
  FSQLHistoryIndex := -1;
  FSQLHistory := TObjectStrings.Create;
  FDeletedList := TStringList.Create;
  TStringList(FDeletedList).Sorted := True;
  Notebook1.PageIndex := 0;
  FTryOpenTable := False;
  FQueryRunning := False;
  EnableSQLHistoryItems;
  QueryAnimation.Parent := DBExplorerMainForm.StatusLine;
{$IFNDEF RX_D4}
  Query1.OnServerYield := QueryAborting;
{$ENDIF}
end;

procedure TMDIChild.FormDestroy(Sender: TObject);
begin
  CloseDatabase;
  FSQLHistory.Free;
  FSQLHistory := nil;
  FDeletedList.Free;
  FDeletedList := nil;
end;

procedure TMDIChild.AfterOpen(DataSet: TDataset);
var
  I: Integer;
begin
  UpdateFieldFormats(DataSet);
  for I := 0 to DataSet.FieldCount - 1 do
    if DataSet.Fields[I].Required then begin
      DataSet.Fields[I].Required := False;
      DataSet.Fields[I].Tag := 2;
    end;
end;

procedure TMDIChild.NavigateSQLClick(Sender: TObject);
var
  NewSQL: Boolean;
begin
  if (FSQLHistory = nil) or (FSQLHistory.Count = 0) then Exit;
  NewSQL := False;
  if Sender = PriorSQL then begin
    if FSQLHistoryIndex > 0 then Dec(FSQLHistoryIndex)
    else if FSQLHistoryIndex = -1 then begin
      UpdateSQLHistory;
      FSQLHistoryIndex := FSQLHistory.Count - 1;
    end;
  end
  else if Sender = NextSQL then begin
    if FSQLHistoryIndex = -1 then UpdateSQLHistory;
    if FSQLHistoryIndex < FSQLHistory.Count - 1 then
      Inc(FSQLHistoryIndex)
    else begin
      NewSQL := True;
    end;
  end;
  if NewSQL then begin
    FSQLHistoryIndex := -1;
    SQLMemo.Clear;
    SQLMemo.Modified := False;
  end
  else begin
    SQLMemo.Lines.Assign(TStrings(FSQLHistory.Objects[FSQLHistoryIndex]));
    SQLMemo.Modified := False;
  end;
  EnableSQLHistoryItems;
end;

procedure TMDIChild.FormStorageRestorePlacement(Sender: TObject);
begin
  RestoreFields(FieldList1, FormStorage.IniFile, False);
  RestoreFields(IndexList1, FormStorage.IniFile, False);
  RestoreFields(RefIntList, FormStorage.IniFile, False);
end;

procedure TMDIChild.FormStorageSavePlacement(Sender: TObject);
begin
  SaveFields(FieldList1, FormStorage.IniFile);
  SaveFields(IndexList1, FormStorage.IniFile);
  SaveFields(RefIntList, FormStorage.IniFile);
end;

procedure TMDIChild.DataSource2StateChange(Sender: TObject);
var
  CanEdit: Boolean;
begin
  CanEdit := (DataSource2.DataSet <> nil) and DataSource2.DataSet.CanModify;
  with rxDBGrid2 do begin
    ReadOnly := not CanEdit;
  end;
end;

procedure TMDIChild.DataSource3StateChange(Sender: TObject);
begin
  with rxDBGrid3 do
    ReadOnly := not ((DataSource3.DataSet <> nil) and
      DataSource3.DataSet.CanModify);
end;

procedure TMDIChild.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
{$IFDEF USE_QR2}
var
  F: TForm;
{$ENDIF}
begin
  if FQueryRunning then MessageDlg(SQueryRunning, mtWarning, [mbOk], 0);
  CanClose := not FQueryRunning;
  if CanClose then begin
    TDBExplorerMainForm(Application.MainForm).ClosedDatabases.Add(DatabaseName, 0);
    if TransOperEnabled(tsTables, teCommit) then begin
      case MessageDlg(Format(SCommitConfirm, [SMainSession]), mtWarning,
        mbYesNoCancel, 0) of
        mrYes: Commit(tsTables);
        mrNo: Rollback(tsTables);
        mrCancel: CanClose := False;
      end;
    end;
    if CanClose and TransOperEnabled(tsQuery, teCommit) then begin
      case MessageDlg(Format(SCommitConfirm, [SQuerySession]), mtWarning,
        mbYesNoCancel, 0) of
        mrYes: Commit(tsQuery);
        mrNo: Rollback(tsQuery);
        mrCancel: CanClose := False;
      end;
    end;
{$IFDEF USE_QR2}
    if CanClose then begin
      F := FindPreview(Self);
      if F <> nil then begin
        MessageDlg(SClosePreview, mtWarning, [mbOk], 0);
        CanClose := False;
        F.BringToFront;
        {F.Close;}
      end;
    end;
{$ENDIF}
  end;
end;

procedure TMDIChild.CloseTableItemClick(Sender: TObject);
begin
  CloseCurrent;
end;

procedure TMDIChild.DBQueryProgressTrace(Sender: TObject; Flag: TTraceFlag;
  const Msg: string);
begin
  BufAddLine(Msg);
end;

procedure TMDIChild.GridCheckButton(Sender: TObject; ACol: Longint;
  Field: TField; var Enabled: Boolean);
begin
  Enabled := (TRxDBGrid(Sender).DataSource.DataSet is TTable) and
    (Field <> nil) and not (Field is TBlobField) and
    (TTable(TRxDBGrid(Sender).DataSource.DataSet).IndexDefs.Count > 0);
end;

procedure TMDIChild.GridTitleBtnClick(Sender: TObject; ACol: Longint;
  Field: TField);
begin
  if TRxDBGrid(Sender).DataSource.DataSet is TTable then
  try
    TTable(TRxDBGrid(Sender).DataSource.DataSet).IndexFieldNames :=
      Field.FieldName;
  except
    TTable(TRxDBGrid(Sender).DataSource.DataSet).IndexFieldNames := '';
  end;
end;

procedure TMDIChild.GridGetBtnParams(Sender: TObject; Field: TField;
  AFont: TFont; var Background: TColor; var SortMarker: TSortMarker;
  IsDown: Boolean);
begin
  if (TRxDBGrid(Sender).DataSource.DataSet is TTable) and (Field <> nil) and
    (Field.IsIndexField) then
  begin
    SortMarker := smDown;
  end;
end;

procedure TMDIChild.ShowDeletedItemClick(Sender: TObject);
var
  Tab: TTable;
begin
  Tab := CurrentTable;
  if (Tab <> nil) and Tab.Active then
    DataSetShowDeleted(Tab, not FShowDeleted);
  FShowDeleted := not FShowDeleted;
end;

procedure TMDIChild.PopupTablesMenuPopup(Sender: TObject);
var
  IsCurrent: Boolean;
begin
  CloseTableItem.Enabled := Table1.Active;
  OpenTableItem.Enabled := not Table1.Active;
  IsCurrent := TableList.Active and Table1.Active and
    (TableListTABNAME.AsString = Table1.TableName);
  ShowDeletedItem.Enabled := IsCurrent;
  ShowDeletedItem.Checked := ShowDeletedItem.Enabled and FShowDeleted;
end;

procedure TMDIChild.TabAfterClose(DataSet: TDataSet);
begin
  FShowDeleted := False;
  with Table1 do begin
    IndexFieldNames := '';
    IndexName := '';
    IndexFiles.Clear;
    FieldDefs.Clear;
  end;
end;

procedure TMDIChild.GridGetCellParams(Sender: TObject; Field: TField;
  AFont: TFont; var Background: TColor; Highlight: Boolean);
begin
  if FShowDeleted and not Highlight and CurrentRecordDeleted(Table1) then
    AFont.Color := clGrayText;
end;

procedure TMDIChild.TableChange(Sender: TObject; Field: TField);
begin
  FCurDeleted := FShowDeleted and CurrentRecordDeleted(Table1);
  TDBExplorerMainForm(Application.MainForm).DBNavigator.ConfirmDelete :=
    not FCurDeleted;
  if FCurDeleted then
    rxDBGrid2.Options := rxDBGrid2.Options - [dgConfirmDelete]
  else
    rxDBGrid2.Options := rxDBGrid2.Options + [dgConfirmDelete];
end;

procedure TMDIChild.FormActivate(Sender: TObject);
begin
  TableChange(Sender, nil);
end;

procedure TMDIChild.TabBeforeDelete(DataSet: TDataSet);
begin
  if FShowDeleted and not (dgConfirmDelete in rxDBGrid2.Options) and
    CurrentRecordDeleted(Table1) then
  begin
    if MessageDlg(SUndeleteConfirm, mtConfirmation, [mbYes, mbNo], 0) = mrYes then
    begin
      Table1.GetCurrentRecord(nil);
      Check(DbiUndeleteRecord(Table1.Handle));
      Table1.Refresh;
    end;
    SysUtils.Abort;
  end;
end;

procedure TMDIChild.BeforeClose(DataSet: TDataSet);
{$IFDEF USE_QR2}
var
  F: TForm;
{$ENDIF USE_QR2}
begin
{$IFDEF USE_QR2}
  F := FindPreview(Self);
  if F <> nil then F.Close;
{$ENDIF}
end;

end.