frmdocunit.pas

delphi 运行期间窗体设计

  begin
    LObjects := TList.Create;
    try
      LMDDesigner1.SelectedComponents.GetComponents(LObjects);
      frmProps.PropInsp.Objects.SetObjects(LObjects);
      frmProps.LMDObjectComboBox1.SelectedObjects.SetObjects(LObjects);
    finally
      LObjects.Free;
    end;
  end;
end;

procedure TfrmDoc.LMDDesigner1ChangeSelection(Sender: TObject);
begin
  AdjustChangeSelection;
end;

procedure TfrmDoc.LMDDesigner1Change(Sender: TObject);
begin
  if frmProps.Doc = Self then frmProps.PropInsp.UpdateContent;
  Modify;
end;

{ TNotifyQuickRep }

procedure TNotifyQuickRep.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if Assigned(OnNotification) then OnNotification(Self, AComponent, Operation);
end;

procedure TfrmDoc.ReportNotification(Sender: TObject;
  AnObject: TPersistent; Operation: TOperation);
begin
  if Operation = opInsert then
  begin
    if AnObject is TQRDBText then
      TQRDBText(AnObject).DataSet := FDataSet;
    frmProps.UpdateComboBoxObjects;
  end;
  if Operation = opRemove then
    frmProps.RemoveNotify(AnObject);
end;

procedure TfrmDoc.LMDDesigner1DblClick(Sender: TObject);
var
  LS: string;
  LControl: TComponent;
begin
  if LMDDesigner1.SelectedComponents.Count = 1 then
  begin
    LControl := LMDDesigner1.SelectedComponents.DefaultComponent;
    if LControl is TQRDBText then
    begin
      if dlgFields.Execute(DataSet, LS) then
      begin
        TQRDBText(LControl).DataField := LS;
        frmProps.PropInsp.UpdateContent;
        Modify;
      end;
    end else if LControl is TQRMemo then
    begin
      if dlgLinesEditor.Execute(TQRMemo(LControl).Lines, DataSet) then
      begin
        TQRMemo(LControl).Refresh;
        frmProps.PropInsp.UpdateContent;
        Modify;
      end;
    end else if LControl is TQRExprMemo then
    begin
      if dlgLinesEditor.Execute(TQRExprMemo(LControl).Lines, DataSet) then
      begin
        TQRExprMemo(LControl).Refresh;
        frmProps.PropInsp.UpdateContent;
        Modify;
      end;
    end else if LControl is TQRExpr then
    begin
      LS := TQRExpr(LControl).Expression;
      if dlgLinesEditor.Execute(LS, DataSet) then
      begin
        TQRExpr(LControl).Expression := LS;
        frmProps.PropInsp.UpdateContent;
        Modify;
      end;
    end;
  end;
end;

procedure TfrmDoc.LMDDesigner1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  LC: TComponent;
begin
  if (LMDDesigner1.SelectedComponents.Count = 1) and (Key = VK_DELETE) then
  begin
    LC := LMDDesigner1.SelectedComponents.DefaultComponent;
    if LC.ClassType = TQRLabel then
    begin
      if TQRLabel(LC).Caption <> '' then
      begin
        TQRLabel(LC).Caption := '';
        Key := 0;
        frmProps.PropInsp.UpdateContent;
        Modify;
      end;
    end else if LC.ClassType = TQRExpr then
    begin
      if TQRExpr(LC).Expression <> '' then
      begin
        TQRExpr(LC).Expression := '';
        Key := 0;
        frmProps.PropInsp.UpdateContent;
        Modify;
      end;
    end else if LC.ClassType = TQRDBText then
    begin
      if TQRDBText(LC).DataField <> '' then
      begin
        TQRDBText(LC).DataField := '';
        Key := 0;
        frmProps.PropInsp.UpdateContent;
        Modify;  
      end;
    end
  end;
end;

constructor TfrmDoc.CreateDocument(AOwner: TComponent; AFileName: string);
begin
  Create(AOwner);
  LoadFromFile(AFileNAme);
  FFileName := AFileNAme;
  Caption := ExtractFileName(AFileName);
  Dec(DocNum);
end;

procedure TfrmDoc.Save;
begin
  SaveToFile(FFileName);
  FModified := False;
end;

procedure TfrmDoc.SaveAs(AFileName: string);
begin
  SaveToFile(AFileName);
  FFileName := AFileName;
  Caption := ExtractFileName(AFileName);
  FModified := False;
end;

procedure TfrmDoc.LoadFromFile(AFileName: string);
var
  LS: TFileStream;
  LI: Longint;
  LB: Byte;
  LDataSet: TBDEDataSet;
begin
  LS := TFileStream.Create(AFileName, fmOpenRead);
  try
    LS.Read(LI, SizeOf(Longint));
    if LI <> Longint(Signature) then
      raise Exception.Create('File "' + ExtractFileName(AFileName) +
        '" is not a report file');

    LS.Read(LB, SizeOf(Byte));
    case LB of
      1:
        begin
          LDataSet := TQuery.Create(Self);
          try
            TQuery(LDataSet).DatabaseName := LoadStringFromStream(LS);
            UnpackStrings(LoadStringFromStream(LS), TQuery(LDataSet).SQL);
            LDataSet.Open;
          except
            LDataSet.Free;
            raise;
          end;
          DataSet := LDataSet;
        end;
      2:
        begin
          LDataSet := TTable.Create(Self);
          try
            TTable(LDataSet).DatabaseName := LoadStringFromStream(LS);
            TTable(LDataSet).TableName := LoadStringFromStream(LS);
            LDataSet.Open;
          except
            LDataSet.Free;
            raise;
          end;
          DataSet := LDataSet;
        end;
    end;
    LS.ReadComponent(FReport);
    FReport.Left := 0;
    FReport.Top := 0;
  finally
    LS.Free;
  end;
end;

procedure TfrmDoc.SaveToFile(AFileName: string);
var
  LS: TFileStream;
  LI: Longint;
  LB: Byte;
begin
  LS := TFileStream.Create(AFileName, fmCreate);
  try
    LI := Longint(Signature);
    LS.Write(LI, SizeOf(Longint));
    if FDataSet <> nil then
    begin
      if FDataSet is TQuery then LB := 1
        else if FDataSet is TTable then LB := 2;
    end else LB := 0;
    LS.Write(LB, SizeOf(Byte));
    case LB of
      1:
        begin
          SaveStringToStream(TQuery(DataSet).DatabaseName, LS);
          SaveStringToStream(PackStrings(TQuery(DataSet).SQL), LS);
        end;
      2:
        begin
          SaveStringToStream(TTable(DataSet).DatabaseName, LS);
          SaveStringToStream(TTable(DataSet).TableName, LS);
        end;
    end;
    LS.WriteComponent(FReport);
  finally
    LS.Free;
  end;
end;

constructor TfrmDoc.Create(AOwner: TComponent);
begin
  inherited;
  FReport := TNotifyQuickRep.Create(nil);
  FReport.Name := 'Report';
  FReport.OnNotification := ReportNotification;
  FReport.PrintIfEmpty := True;
  LMDDesigner1.DesignControl := FReport;
  LMDDesigner1.Active := True;

  Caption := 'Document' + IntToStr(DocNum);
  Inc(DocNum);
end;

procedure TfrmDoc.Modify;
begin
  FModified := True;
end;

procedure TfrmDoc.LMDDesigner1ComponentInserted(Sender: TObject);
begin
  frmMain.ComponentInserted;
end;

procedure TfrmDoc.LMDDesigner1ComponentInserting(Sender: TObject;
  var AComponentClass: TComponentClass);
begin
  frmMain.ComponentInserting(AComponentClass);
end;

procedure TfrmDoc.LMDDesigner1ComponentHint(Sender: TObject;
  AComponent: TComponent; var AHint: String);
var
  LI: Integer;
begin
  if AComponent is TQRMemo then
  begin
    AHint := AHint + #13 + 'Lines:';
    for LI := 0 to TQRMemo(AComponent).Lines.Count - 1 do
      AHint := AHint + #13 + '  ' + TQRMemo(AComponent).Lines[LI];
  end else if AComponent is TQRExprMemo then
  begin
    AHint := AHint + #13 + 'Lines:';
    for LI := 0 to TQRExprMemo(AComponent).Lines.Count - 1 do
      AHint := AHint + #13 + '  ' + TQRExprMemo(AComponent).Lines[LI];
  end else if AComponent is TQRLabel then
  begin
    AHint := AHint + #13 + 'Caption: ' + TQRLabel(AComponent).Caption;
  end else if AComponent is TQRDBText then
  begin
    AHint := AHint + #13 + 'Data field: ' + TQRDBText(AComponent).DataField;
  end else if AComponent is TQRExpr then
  begin
    AHint := AHint + #13 + 'Expression: ' + TQRExpr(AComponent).Expression;
  end;
end;

end.