qreditor.~pas

delphi7报表打印控件源码 可以设计报表

  AControl : TControl;
begin
  for I := 0 to SelectionList.Count - 1 do
  begin
    AControl := SelectionList[0];
    SelectionList.Remove(AControl);
    if Assigned(FOnUnselectControl) then
      FOnUnselectControl(AControl);
  end;
end;

procedure TCustomEditor.StartResize(Position : TGrabPosition; APoint : TPoint);
begin
  if State = esAdd then Exit;
  case Position of
    gpNW, gpN, gpNE : begin
                        SizeUp := true;
                        SizeDown := false;
                      end;
    gpSW, gpS, gpSE : begin
                        SizeUp := false;
                        SizeDown := true;
                      end;
  else
    SizeUp := false;
    SizeDown := false;
  end;
  case Position of
    gpNW, gpW, gpSW : begin
                        SizeLeft := true;
                        SizeRight := false;
                      end;
    gpNE, gpE, gpSE : begin
                  SizeLeft := false;
                  SizeRight := true;
                end;
  else
    SizeLeft := false;
    SizeRight := false;
  end;
  Origin := APoint;
  FState := esResize;
  SelectionList.State := fsFrame;
end;

procedure TCustomEditor.ResizeTo(APoint : TPoint);
var
  ChangeLeft,
  ChangeTop,
  ChangeBottom,
  ChangeRight : integer;
begin
  if SizeLeft then ChangeLeft := Origin.X - APoint.X else ChangeLeft := 0;
  if SizeRight then ChangeRight := APoint.X - Origin.X else ChangeRight := 0;
  if SizeUp then ChangeTop := Origin.Y - APoint.Y else ChangeTop := 0;
  if SizeDown then ChangeBottom := APoint.Y - Origin.Y else ChangeBottom := 0;
  SelectionList.Size(ChangeLeft, ChangeTop, ChangeRight, ChangeBottom);
  Origin := APoint;
end;

procedure TCustomEditor.EndResize(APoint : TPoint);
begin
  ResizeTo(APoint);
  if SelectionList.Count = 1 then SelectionList.State := fsNormal
  else SelectionList.State := fsDim;
  FState := esNormal;
  Modified := SelectionList.UpdateControls or Modified;
end;

procedure TCustomEditor.StartMove(APoint : TPoint);
begin
  if State = esAdd then Exit;
  SelectionList.State := fsFrame;
  FState := esMove;
  Origin := APoint;
end;

procedure TCustomEditor.MoveTo(APoint : TPoint);
begin
  SelectionList.Move(Origin.X - APoint.X, Origin.Y - APoint.Y);
  Origin := APoint;
end;

procedure TCustomEditor.EndMove(APoint : TPoint);
begin
  MoveTo(APoint);
  if SelectionList.Count = 1 then SelectionList.State := fsNormal
  else SelectionList.State := fsDim;
  FState := esNormal;
  Modified := SelectionList.UpdateControls or Modified;
end;

procedure TCustomEditor.MouseDownHandler(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : integer);
var
  AControl : TControl;
begin
  AControl := TControl(Sender);
  if Sender is TGrabHandle then with TGrabHandle(Sender) do
  begin
    if Cursor <> crDefault then
      StartResize(FPosition, Self.ScreenToClient(ClientToScreen(Point(X, Y))))
    else
      StartMove(Self.ScreenToClient(ClientToScreen(Point(X, Y))));
  end
  else
    if SelectionList.IsSelected(AControl) then
    begin
      if (SelectionList.Count > 1) and (ssShift in Shift) then Unselect(AControl)
      else StartMove(Self.ScreenToClient(AControl.ClientToScreen(Point(X, Y))));
    end else
    begin
      if ssShift in Shift then Select(AControl, true)
      else Select(AControl, false);
      StartMove(Self.ScreenToClient(AControl.ClientToScreen(Point(X, Y))));
    end;
  if Button = mbRight then DoPopup(X, Y)
  else if State = esAdd then DoAdd(X, Y);
  MouseIsDown := true;
end;

procedure TCustomEditor.MouseMoveHandler(Sender : TObject; Shift : TShiftState; X, Y : integer);
begin
  if MouseIsDown then
  case FState of
    esMove : MoveTo(ScreenToClient(TControl(Sender).ClientToScreen(Point(X, Y))));
    esResize : ResizeTo(ScreenToClient(TControl(Sender).ClientToScreen(Point(X, Y))));
  end;
end;

procedure TCustomEditor.MouseUpHandler(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : integer);
begin
  MouseIsDown := false;
  case FState of
    esMove : EndMove(ScreenToClient(TControl(Sender).ClientToScreen(Point(X, Y))));
    esResize : EndResize(ScreenToClient(TControl(Sender).ClientToScreen(Point(X, Y))));
  end;
  FState := esNormal;
end;

procedure TCustomEditor.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  UnselectAll;
  if State = esAdd then
    DoAdd(X, Y)
end;

procedure TCustomEditor.DeleteSelected;
var
  I : integer;
begin
  for I := 0 to SelectionList.Count - 1 do
    SelectionList.Items[I].Free;
  SelectionList.Clear;
end;

procedure TCustomEditor.CopySelected;
begin
  if SelectionList.Count > 0 then
    SelectionList.Copy(Clipboard);
  FClipboardAvailable := (Clipboard <> nil) and (Clipboard.Size > 0);
  if assigned(FOnClipboardStateChange) then FOnClipboardStateChange(Self);
end;

procedure TCustomEditor.CutSelected;
begin
  CopySelected;
  DeleteSelected;
end;

procedure TCustomEditor.Paste;
var
  NewComponent : TComponent;
  AParent : TWinControl;
begin
  if (SelectionList.Count = 1) and (SelectionList[0] is TWinControl) then
    AParent := TWinControl(SelectionList[0])
  else AParent := MainControl;
  SelectionList.Clear;
  if (Clipboard <> nil) and (Clipboard.Size > 0) then
  begin
    Clipboard.Position := 0;
    repeat
      NewComponent := Clipboard.ReadComponent(nil);
      Add(NewComponent, AParent);
    until Clipboard.Position >= Clipboard.Size - 1;
    SetEvents(Self);
    Modified := true;
  end;
end;

procedure TCustomEditor.ClearAll;
begin
  UnselectAll;
  while ControlCount > 0 do
    Controls[0].Free;
end;

procedure TCustomEditor.SaveToStream(Stream : TStream);
var
  I : integer;
  TempList : TList;
begin
  UnSelectAll;
  TempList := TList.Create;
  for I := 0 to ComponentCount - 1 do
    if Components[I] <> MainControl then TempList.Add(Components[I]);
  for I := 0 to TempList.Count - 1 do
  begin
    RemoveComponent(TempList[I]);
    MainControl.InsertComponent(TempList[I]);
  end;
  if MainControl <> nil then
    Stream.WriteComponent(MainControl);
  TempList.Free;
end;

procedure TCustomEditor.Save(Filename : string);
var
  Stream : TFileStream;
begin
  Stream := TFileStream.Create(Filename, fmCreate);
  try
    SaveToStream(Stream)
  finally
    Stream.Free;
  end;
end;

procedure TCustomEditor.LoadFromStream(Stream : TStream);
begin
  ClearAll;
  Stream.Position := 0;
  repeat
    Add(Stream.ReadComponent(nil), Self);
  until Stream.Position >= Stream.Size - 1;
  SetEvents(Self);
  if ControlCount > 0 then
    MainControl := TWinControl(Controls[0]);
  Modified := true;
end;

procedure TCustomEditor.Load(Filename : string);
resourcestring
  sLoadError = 'error';
var
  Stream : TFileStream;
  aForm : TForm;
  I : integer;
  AComponent : TComponent;
begin
  MainControl := nil;
  try
    Stream := TFileStream.Create(Filename, fmOpenRead + fmShareDenyNone);
    try
      LoadFromStream(Stream)
    finally
      Stream.Free;
    end;
  except
    try
      aForm := TForm.Create(Application);
      ReadComponentResFile(Filename, aForm);
      I := 0;
      while I < aForm.ComponentCount do
      begin
        if (aForm.Components[I] is TQuickRep) then
          MainControl := TQuickRep(aForm.Components[0]);
        inc(i);
      end;
      if MainControl <> nil then
      begin
        while AForm.ComponentCount > 0 do
        begin
          AComponent := AForm.Components[0];
          AForm.RemoveComponent(AComponent);
          if AComponent <> MainControl then
            MainControl.InsertComponent(AComponent);
        end;
        Add(MainControl, self);
        SetEvents(Self);
        aForm.Free;
      end;
    except
      ShowMessage(sLoadError);
    end;
  end;
end;

function AskFilename(var AFilename : string) : boolean;
resourcestring
  sAskFileNameFilter = 'QuickReport file|*.qr';
begin
  with TSaveDialog.Create(Application) do
  try
    Filter := sAskFileNameFilter;
    DefaultExt := 'qr';
    Filename := AFilename;
    if Execute then
    begin
      AFilename := Filename;
      Result := true;
    end else
      Result := false;
  finally
    Free;
  end
end;

procedure TQReportEditor.SetFilename(Value : string);
begin
  FFilename := Value;
  Caption := 'QuickReport - ' + Filename; { do not localize }
end;

procedure TQReportEditor.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_DELETE : Editor.DeleteSelected;
    ord('C') : if ssCtrl in Shift then Copy;
    ord('X') : if ssCtrl in Shift then Cut;
    ord('V') : if ssCtrl in Shift then Paste;
  end;
end;

procedure TQReportEditor.NewReport;
var
  AReport : TCustomQuickRep;
begin
  Editor.ClearAll;
  AReport := ExecuteQRWizard;
  if AReport <> nil then
  begin
    Editor.MainControl := AReport;
    Editor.Add(AReport, Editor);
    AReport.Top := 0;
    AReport.Left := 0;
    ScrollArea.VertScrollBar.Range := AReport.Height;
    ScrollArea.HorzScrollBar.Range := AReport.Width;
  end;
  Editor.Editing := true;
  EnableAndDisable;
end;

procedure TQReportEditor.OpenMIClick(Sender: TObject);
begin
  Editor.AddClass(TQRExpr);
end;

function TQReportEditor.PrintableEditor : TQRPrintableEditor;
begin
  Result := TQRPrintable(Editor.SelectionList[0]).EditorClass.Create(TQRPrintable(Editor.SelectionList[0]));
end;

procedure TQReportEditor.EditorSelectControl(Sender: TObject);

  procedure StyleBtns(Value : boolean);
  begin
    BoldBtn.Enabled := Value;
    ItalicBtn.Enabled := Value;
    UnderLnBtn.Enabled := Value;
    LeftAlBtn.Enabled := Value;
    CenterAlBtn.Enabled := Value;
    RightAlBtn.Enabled := Value;
  end;

begin
  EnableAndDisable;
  if FontNameCB.Items.Count = 0 then
    FontNameCB.Items := GetFonts;
  FontNameCB.Sorted := True;
  if FontSizeCB.Items.Count = 0 then
    PopulateFontSizeCombo(FontSizeCB);
  if (Editor.SelectionList.Count = 1) and (Editor.SelectionList[0] is TQRPrintable) then
    with PrintableEditor do
    try
      ControlValue.Text := Value;
      FontSizeCB.Text := IntToStr(Font.Size);
      FontNameCB.ItemIndex := FontNameCB.Items.IndexOf(Font.Name);
      BoldBtn.Down := fsBold in Font.Style;
      ItalicBtn.Down := fsItalic in Font.Style;
      UnderLnBtn.Down := fsUnderline in Font.Style;
{$ifndef QRSTANDARD}
      case Alignment of
        taLeftJustify : LeftAlBtn.Down := true;
        taCenter : CenterAlBtn.Down := true;
        taRightJustify : RightAlBtn.Down := true;
      end;
{$endif}
      StyleBtns(True);
    finally
      Free;
    end
  else
  begin
    ControlValue.Text := '';
    StyleBtns(False);
  end;
end;

procedure TQReportEditor.EditorClipboardStateChange(Sender: TObject);
begin
  EnableAndDisable;
end;

procedure TQReportEditor.Paste;
begin
  Editor.Paste;
end;

procedure TQReportEditor.Cut;
begin
  Editor.CutSelected;
end;

procedure TQReportEditor.Copy;
begin
  Editor.CopySelected ;
end;

procedure TQReportEditor.OpenReport;
resourcestring
  sOpenReportFilter = 'QuickReport file|*.qr';
var
  I : integer;
  ADS : TDatasource;
begin
  ADS := nil;
  with TOpenDialog.Create(Self) do
  try
    Filter := sOpenReportFilter;
    DefaultExt := 'qr';
    if Execute then
    begin
      Editor.Load(Filename);
      Self.Filename := Filename;
      if Editor.MainControl is TQuickRep then
      begin
        for I := 0 to Editor.MainControl.ComponentCount - 1 do
          if Editor.MainControl.Components[I] is TDataSource then
            ADS := TDataSource(Editor.MainControl.Components[I]);
        for I := 0 to Editor.MainControl.ControlCount - 1 do
          if Editor.MainControl.Controls[I] is TQRSubDetail then
            TTable(TQRSubDetail(Editor.MainControl.Controls[I]).DataSet).MasterSource := ADS;
      end;
    end;
  finally
    Free;
  end;
end;

procedure TQReportEditor.ControlTBResize(Sender: TObject);
begin
  ControlValue.Width := ControlTB.Width - ControlValue.Left - ControlTB.ButtonWidth;
end;

procedure TQReportEditor.ControlValueEnter(Sender: TObject);
begin
  ControlOKBtn.Enabled := true;
  ControlCancelBtn.Enabled := true;
  AttributeTB.Enabled := false;
  FileTB.Enabled := false;
end;

procedure TQReportEditor.ControlValueExit(Sender: TObject);
begin
  ControlOKBtn.Enabled := false;
  ControlCancelBtn.Enabled := false;
  AttributeTB.Enabled := true;
  FileTB.Enabled := true;
end;

procedure TQReportEditor.SaveReport;
begin
  if (Filename <> '') or AskFilename(FFilename) then
  begin
    Editor.Save(Filename);