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

📄 frmdrawreportdesignmainunt.pas

📁 EAComps手工画报表 对写报表编辑器有一定的参考价值
💻 PAS
📖 第 1 页 / 共 3 页
字号:
end;

procedure TfrmDrawReportDesignMain.ActFile_SaveExecute(Sender: TObject);
begin
  if not dlgSave.Execute then
    Exit;
  if FileExists(dlgSave.FileName) then
  begin
    if ea.Dlg.MsgYesNo('文件已存在,要覆盖吗?') = ID_YES then
      ea.Files.DeleteFile(dlgSave.FileName)
    else
      Exit;
  end;
  drReport.SaveToFile(dlgSave.FileName);
  drReport.Store.Clear;
end;

procedure TfrmDrawReportDesignMain.ActFile_CloseFileExecute(
  Sender: TObject);
var
  I, vViewScale: Integer;
begin
  tabPages.Tabs.BeginUpdate;
  tabPages.Tabs.Clear;
  drReport.Pages.Clear;

  drReport.Pages.Add('第 1 页');
  tabPages.Tabs.Add('第 1 页');
  for I := 0 to cboReportSize.Items.Count - 1 do
  begin
    vViewScale := Integer(cboReportSize.Items.Objects[I]);
    if vViewScale = 100 then
    begin
      cboReportSize.ItemIndex := I;
      Break;
    end;
  end;

  tabPages.Tabs.EndUpdate;
  Self.Caption := cSTitleStr;
end;

procedure TfrmDrawReportDesignMain.ActFile_SaveAsExecute(Sender: TObject);
begin
  if not dlgSave.Execute then
    Exit;
  if FileExists(dlgSave.FileName) then
  begin
    if ea.Dlg.MsgYesNo('文件已存在,要覆盖吗?') = ID_YES then
      ea.Files.DeleteFile(dlgSave.FileName)
    else
      Exit;
  end;
  drReport.SaveToFile(dlgSave.FileName);
  Self.Caption := cSTitleStr + '[' + dlgSave.FileName + ']';
end;

function TfrmDrawReportDesignMain.IsNotRepeatPageName(const AName: string;
  AOldPageIndex: Integer): Boolean;
var
  I: Integer;
begin
  for I := 0 to tabPages.Tabs.Count - 1 do
    if (I <> AOldPageIndex) and (SameText(AName, tabPages.Tabs[I])) then
    begin
      Result := False;
      Exit;
    end;
  Result := True;
end;

function TfrmDrawReportDesignMain.GetNewPageName: string;
var
  I: Integer;
begin
  I := 1;
  while tabPages.Tabs.IndexOf('第 ' + IntToStr(I) + ' 页') > -1 do
    Inc(I);
  Result := '第 ' + IntToStr(I) + ' 页';
end;

procedure TfrmDrawReportDesignMain.ActListUpdate(Action: TBasicAction;
  var Handled: Boolean);
begin
  ActEdit_Undo.Enabled := drReport.Store.CanUndo;
  ActEdit_Redo.Enabled := drReport.Store.CanRedo;
end;

procedure TfrmDrawReportDesignMain.ActEdit_UndoExecute(Sender: TObject);
begin
  drReport.Store.Undo;
end;

procedure TfrmDrawReportDesignMain.ActEdit_RedoExecute(Sender: TObject);
begin
  drReport.Store.Redo;
end;

procedure TfrmDrawReportDesignMain.ActFormat_FontSetExecute(
  Sender: TObject);
var
  vPage: TEAPage;
  vGrid: TEAReportDrawGrid;
  vLabel: TEAReportLabel;
  I, N: Integer;
begin
  vPage := drReport.SelectedPage;
  if (vPage = nil) or (vPage.SelectedCount = 0) then
    Exit;

  if vPage.SelectedObjects[0] is TEAReportDrawGrid then
  begin
    vGrid := TEAReportDrawGrid(vPage.SelectedObjects[0]);
    if vGrid.SelectedCount = 0 then
      dlgFont.Font := vGrid.Font
    else
      dlgFont.Font := vGrid.SelectedCells[0].Font;
  end
  else if vPage.SelectedObjects[0] is TEAReportLabel then
  begin
    vLabel := TEAReportLabel(vPage.SelectedObjects[0]);
    dlgFont.Font := vLabel.Font;
  end;

  if not dlgFont.Execute then
    Exit;

  for I := 0 to vPage.SelectedCount - 1 do
  begin
    if vPage.SelectedObjects[I] is TEAReportDrawGrid then
    begin
      vGrid := TEAReportDrawGrid(vPage.SelectedObjects[I]);
      if vGrid.SelectedCount = 0 then
        vGrid.Font := dlgFont.Font
      else begin
         for N := 0 to vGrid.SelectedCount - 1 do
           vGrid.SelectedCells[N].Font := dlgFont.Font;
      end;
    end
    else if vPage.SelectedObjects[I] is TEAReportLabel then
    begin
      vLabel := TEAReportLabel(vPage.SelectedObjects[I]);
      vLabel.Font := dlgFont.Font;
    end;
  end;
end;

procedure TfrmDrawReportDesignMain.ActEdit_DeleteExecute(Sender: TObject);
var
  vPage: TEAPage;
  I: Integer;
begin
  vPage := drReport.SelectedPage;
  if (vPage = nil) or (vPage.SelectedCount = 0) then
    Exit;
  for I := vPage.SelectedCount - 1 downto 0 do
    vPage.Remove(vPage.SelectedObjects[I]);
end;

procedure TfrmDrawReportDesignMain.ActEdit_CutExecute(Sender: TObject);
begin
  drReport.CutToClipboard;
end;

procedure TfrmDrawReportDesignMain.ActEdit_CopyExecute(Sender: TObject);
begin
  drReport.CopyToClipboard;
end;

procedure TfrmDrawReportDesignMain.ActEdit_PasteExecute(Sender: TObject);
begin
  drReport.PasteFromClipboard(True);
end;

procedure TfrmDrawReportDesignMain.ActEdit_ClearExecute(Sender: TObject);
var
  vPage: TEAPage;
  I: Integer;
  vGrid: TEAReportDrawGrid;
  vLabel: TEAReportLabel;
begin
  vPage := drReport.SelectedPage;
  if (vPage = nil) or (vPage.SelectedCount = 0) then
    Exit;
  for I := vPage.SelectedCount - 1 downto 0 do
  begin
    if vPage.SelectedObjects[I] is TEAReportDrawGrid then
    begin
      vGrid := TEAReportDrawGrid(vPage.SelectedObjects[I]);
      if vGrid.SelectedCount = 0 then
        vGrid.ClearAllCellData
      else
        vGrid.ClearSelectedCellData;
    end
    else if vPage.SelectedObjects[0] is TEAReportLabel then
    begin
      vLabel := TEAReportLabel(vPage.SelectedObjects[0]);
      vLabel.InnerText := '';
    end;
  end;
end;

procedure TfrmDrawReportDesignMain.ActGrid_DeleteGridExecute(
  Sender: TObject);
var
  vPage: TEAPage;
  I: Integer;
begin
  vPage := drReport.SelectedPage;
  if (vPage = nil) or (vPage.SelectedCount = 0) then
    Exit;
  for I := vPage.SelectedCount - 1 downto 0 do
    if vPage.SelectedObjects[I] is TEAReportDrawGrid then
      vPage.Remove(vPage.SelectedObjects[I]);
end;

procedure TfrmDrawReportDesignMain.ActEdit_BringToFrontExecute(
  Sender: TObject);
var
  vPage: TEAPage;
begin
  vPage := drReport.SelectedPage;
  if (vPage = nil) or (vPage.SelectedCount = 0) then
    Exit;
  vPage.BringToFront(vPage.SelectedObjects[0]);
end;

procedure TfrmDrawReportDesignMain.ActFormat_AlignExecute(Sender: TObject);
begin
//
end;

procedure TfrmDrawReportDesignMain.ActFormat_BackColorExecute(
  Sender: TObject);
var
  vPage: TEAPage;
  vGrid: TEAReportDrawGrid;
  vLabel: TEAReportLabel;
  I, N: Integer;
begin
  vPage := drReport.SelectedPage;
  if (vPage = nil) or (vPage.SelectedCount = 0) then
    Exit;

  if vPage.SelectedObjects[0] is TEAReportDrawGrid then
  begin
    vGrid := TEAReportDrawGrid(vPage.SelectedObjects[0]);
    if vGrid.SelectedCount = 0 then
      dlgColor.Color := vGrid.Color
    else
      dlgColor.Color := vGrid.SelectedCells[0].Color;
  end
  else if vPage.SelectedObjects[0] is TEAReportLabel then
  begin
    vLabel := TEAReportLabel(vPage.SelectedObjects[0]);
    dlgColor.Color := vLabel.Color;
  end;

  if not dlgColor.Execute then
    Exit;

  for I := 0 to vPage.SelectedCount - 1 do
  begin
    if vPage.SelectedObjects[I] is TEAReportDrawGrid then
    begin
      vGrid := TEAReportDrawGrid(vPage.SelectedObjects[I]);
      if vGrid.SelectedCount = 0 then
        vGrid.Color := dlgColor.Color
      else begin
         for N := 0 to vGrid.SelectedCount - 1 do
           vGrid.SelectedCells[N].Color := dlgColor.Color;
      end;
    end
    else if vPage.SelectedObjects[I] is TEAReportLabel then
    begin
      vLabel := TEAReportLabel(vPage.SelectedObjects[I]);
      vLabel.Color := dlgColor.Color;
    end;
  end;
end;

procedure TfrmDrawReportDesignMain.SetupTextAlign(AHorz: TEAHorzPos;
  AVert: TEAVertPos);
var
  vPage: TEAPage;
  vGrid: TEAReportDrawGrid;
  vLabel: TEAReportLabel;
  I, N: Integer;
begin
  vPage := drReport.SelectedPage;
  if (vPage = nil) or (vPage.SelectedCount = 0) then
    Exit;

  for I := 0 to vPage.SelectedCount - 1 do
  begin
    if vPage.SelectedObjects[I] is TEAReportDrawGrid then
    begin
      vGrid := TEAReportDrawGrid(vPage.SelectedObjects[I]);
      if vGrid.SelectedCount > 0 then
      begin
         for N := 0 to vGrid.SelectedCount - 1 do
         begin
           vGrid.SelectedCells[N].HorzPos := AHorz;
           vGrid.SelectedCells[N].VertPos := AVert;
         end;
      end;
    end
    else if vPage.SelectedObjects[I] is TEAReportLabel then
    begin
      vLabel := TEAReportLabel(vPage.SelectedObjects[I]);
      vLabel.HorzPos := AHorz;
      vLabel.VertPos := AVert;
    end;
  end;
end;

procedure TfrmDrawReportDesignMain.ActFormat_AlignTLExecute(
  Sender: TObject);
begin
  SetupTextAlign(ehpLeft, evpTop);
end;

procedure TfrmDrawReportDesignMain.ActFormat_AlignTCExecute(
  Sender: TObject);
begin
  SetupTextAlign(ehpCenter, evpTop);
end;

procedure TfrmDrawReportDesignMain.ActFormat_AlignTRExecute(
  Sender: TObject);
begin
  SetupTextAlign(ehpRight, evpTop);
end;

procedure TfrmDrawReportDesignMain.ActFormat_AlignCLExecute(
  Sender: TObject);
begin
  SetupTextAlign(ehpLeft, evpCenter);
end;

procedure TfrmDrawReportDesignMain.ActFormat_AlignCCExecute(
  Sender: TObject);
begin
  SetupTextAlign(ehpCenter, evpCenter);
end;

procedure TfrmDrawReportDesignMain.ActFormat_AlignCRExecute(
  Sender: TObject);
begin
  SetupTextAlign(ehpRight, evpCenter);
end;

procedure TfrmDrawReportDesignMain.ActFormat_AlignBLExecute(
  Sender: TObject);
begin
  SetupTextAlign(ehpLeft, evpBottom);
end;

procedure TfrmDrawReportDesignMain.ActFormat_AlignBCExecute(
  Sender: TObject);
begin
  SetupTextAlign(ehpCenter, evpBottom);
end;

procedure TfrmDrawReportDesignMain.ActFormat_AlignBRExecute(
  Sender: TObject);
begin
  SetupTextAlign(ehpRight, evpBottom);
end;

procedure TfrmDrawReportDesignMain.drReportMouseWheel(Sender: TObject;
  Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint);
begin

  with scrollReport.VertScrollBar do
  begin
    if WheelDelta > 0 then
      Position := Position - 16
    else
      Position := Position + 16;
  end;
end;

procedure TfrmDrawReportDesignMain.drReportButtonClick(Sender,
  ASelectedObj: TObject; AObjType: TEASelectedObjectType);
begin
  if AObjType = esotDrawGridCell then
    if TEAReportDrawGridCell(ASelectedObj).CellType = egctButton then
      ShowMessage('click me is ok!!!');
end;

procedure TfrmDrawReportDesignMain.ActInsert_ImageExecute(Sender: TObject);
var
  vPage: TEAPage;
begin
  vPage := drReport.SelectedPage;
  if vPage = nil then
    Exit;
  ActInsert_Image.Checked := True;
  drReport.ReportPenState := erpsImage;
end;

procedure TfrmDrawReportDesignMain.ActFormat_ImageExecute(Sender: TObject);
var
  vPage: TEAPage;
  I: Integer;
  B: Boolean;
  vImg: TEAReportImage;
  vPic: TPicture;
  vJpg: TJPEGImage;
begin
  vPage := drReport.SelectedPage;
  if vPage = nil then
    Exit;

  B := False;
  for I := 0 to vPage.SelectedCount - 1 do
    if vPage.SelectedObjects[I] is TEAReportImage then
    begin
      B := True;
      Break;
    end;

  if not B then
    Exit;

  if dlgOpenPicture.Execute then
  begin
    vPic := TPicture.Create;
    vJpg := TJPEGImage.Create;
    try
      vPic.LoadFromFile(dlgOpenPicture.FileName);
      for I := 0 to vPage.SelectedCount - 1 do
        if vPage.SelectedObjects[I] is TEAReportImage then
        begin
          vImg := TEAReportImage(vPage.SelectedObjects[I]);
          ea.Graphics.PictureToJpeg(vPic, vJpg);
          vImg.Picture := vJpg;
        end;
    finally
      vPic.Free;
      vJpg.Free;
    end;
  end;      
end;

procedure TfrmDrawReportDesignMain.ActFormat_AlignImageExecute(
  Sender: TObject);
begin
//
end;

procedure TfrmDrawReportDesignMain.ActFormat_AlignImageNoneExecute(
  Sender: TObject);
begin
  SetupImageAlign(eiaNone);
end;

procedure TfrmDrawReportDesignMain.ActFormat_AlignImageClientExecute(
  Sender: TObject);
begin
  SetupImageAlign(eiaClient);
end;

procedure TfrmDrawReportDesignMain.ActFormat_AlignImageAutoExecute(
  Sender: TObject);
begin
  SetupImageAlign(eiaAuto);
end;

procedure TfrmDrawReportDesignMain.SetupImageAlign(
  AImageAlign: TEAImageAlign);
var
  vPage: TEAPage;
  I: Integer;
  vImg: TEAReportImage;
begin
  vPage := drReport.SelectedPage;
  if vPage = nil then
    Exit;

  for I := 0 to vPage.SelectedCount - 1 do
    if vPage.SelectedObjects[I] is TEAReportImage then
    begin
      vImg := TEAReportImage(vPage.SelectedObjects[I]);
      vImg.ImageAlign := AImageAlign;
    end;
end;

procedure TfrmDrawReportDesignMain.ActInsert_LineExecute(Sender: TObject);
var
  vPage: TEAPage;
begin
  vPage := drReport.SelectedPage;
  if vPage = nil then
    Exit;
  ActInsert_Line.Checked := True;
  drReport.ReportPenState := erpsLine;
  //TEAReportLine.CreateLineComp(vPage, 20, 20, 100, 20);
end;

end.

⌨️ 快捷键说明

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