Quelle Frame33.pas Sprache: Delphi

unit Frame33;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
interface
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
uses
  //----------------------------------------------------------------------------
  //local
  //----------------------------------------------------------------------------
  GenDefs,OwnUtils,OptionClass,Language,Utilities,Preview,Editor,
  //----------------------------------------------------------------------------
  //global
  //----------------------------------------------------------------------------
  Forms,Controls,ComCtrls,Tabs,Dialogs,Classes,Types,Graphics,ExtCtrls,
  PrintDialogEx,StdCtrls,SysUtils;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
const
  borderfontsize=5;
  Randlinks=150;
  RandOben=150;
  Framelinks=100;
  Frameoben=100;
  //----------------------------------------------------------------------------
  //
  //----------------------------------------------------------------------------
type
  TFrame3= class(TFrame)
    PageControl1:TPageControl;
    StatusBar1:TStatusBar;
    MiniaturTab:TTabSheet;
    DruckvorschauTab:TTabSheet;
    OpenDialog1:TOpenDialog;
    SaveDialog1:TSaveDialog;
    ExecuteTab:TTabSheet;
    Executor:TEde;
    PageNavigator:TTabSet;
    ThumbnailPreview1:TThumbnailPreview;
    PrintPreview1:TPrintPreview;
    constructor Create(Owner:TComponent);override;
    destructor Destroy;override;
    procedure CreateBorders(R:TRect);
    procedure ZoomChange(scale:integer;state:TZoomState);
    procedure PrintButtonClick(Sender:TObject);
    procedure LoadButtonClick(Sender:TObject);
    procedure PageNavigatorChange(Sender:TObject;NewTab:Integer;
      var AllowChange:Boolean);
    procedure PrintPreviewChange(Sender:TObject);
    procedure PrintPreviewBeforePrint(Sender:TObject);
    procedure PrintPreviewPrintProgress(Sender:TObject;PageNum,Progress:Integer;
      var AbortIt:Boolean);
    procedure PrintPreviewAfterPrint(Sender:TObject);
    procedure PrintPreviewBeginDoc(Sender:TObject);
    procedure PrintPreviewEndDoc(Sender:TObject);
    procedure PrintPreviewAnnotation(Sender:TObject;PageNo:Integer;
      Canvas:TCanvas);
    procedure QuerformatClick(Sender:TObject);
    procedure HochformatClick(Sender:TObject);
    procedure PrintPreviewNewPage(Sender:TObject);
    procedure PageNavigatorClick(Sender:TObject);
    procedure DruckenClick(Ty:PrintTypes;Redit:TRichEdit;Img:TImage;
      LoadedFile:JString);
    procedure PDFButtonClick(Sender:TObject);
    procedure Splitter2Moved(Sender:TObject);
    procedure Splitter1Moved(Sender:TObject);
    procedure setPreviewFull();
    procedure PrintTree(var RE:TRichEdit;Tree:TTreeView);
    procedure ZoominClick(Sender: TObject);
    procedure ZoomoutClick(Sender: TObject);
    procedure ZoomNormalClick(Sender: TObject);
  private
    procedure CreateRichTextPage;
    procedure CreateImageOnlyPage;
    procedure CreatePages;
  public
    PrintDialog2:TPrintDialogEx;
    PrintButton:TToolButton;
    Hochformat:TToolButton;
    Querformat:TToolButton;
    RE:TRichEdit;
    IM:TImage;
    PrintType:PrintTypes;
    PrintJobTitle:JString;
    PrintFile:JString;
    firstpreview:Boolean;
  end;
  //----------------------------------------------------------------------------
  //
  //----------------------------------------------------------------------------
implementation
uses
  //----------------------------------------------------------------------------
  //specific
  //----------------------------------------------------------------------------
  Variants,jpeg,Windows,Buttons,Printers;

//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
{$R *.dfm}
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
constructor TFrame3.Create(Owner:TComponent);
begin
  if Printer=nil then begin
    errorn(14,' Kein Drucker installiert');
    Exit;
  end
  else begin
    inherited Create(Owner);
    ThumbnailPreview1.PrintPreview:=PrintPreview1;
  end;
  firstpreview:=true;
  PrintDialog2:=TPrintDialogEx.Create(self);
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
destructor TFrame3.Destroy;
begin
  PrintDialog2.Free;
  ThumbnailPreview1.Free;
  PrintPreview1.Free;
  inherited Free;
end;
//----------------------------------------------------------------------------
//-   display Treeview in Richedit                                             -
//-                                                                -
//----------------------------------------------------------------------------
procedure TFrame3.PrintTree(var RE:TRichEdit;Tree:TTreeView);
  procedure printnode(lvl:Integer;N:TTreenode);
  const indent=' ';
  var
    i:Integer;
    rec:String;
    C:TTreenode;
  begin
    if N<>nil then begin
      rec:='';
      for i:=1 to lvl do
        rec:=rec+indent;
      rec:=rec+N.Text;
      RE.Lines.Add(rec);
      C:=N.getFirstChild;
      while C<>nil do begin
        printnode(lvl+1,C);
        C:=C.getNextSibling;
      end;
    end;
  end;
begin
  RE.Lines.Clear;
  printnode(0,Tree.TopItem);
end;
//----------------------------------------------------------------------------
//-   Function Drucken                                             -
//-                                                                -
//----------------------------------------------------------------------------
procedure TFrame3.DruckenClick(Ty:PrintTypes;Redit:TRichEdit;Img:TImage;
  LoadedFile:JString);
begin
  if Printer<>nil then begin
    if firstpreview then begin
      with PrintPreview1 do begin
        Zoom:=100;
        ZoomState:=zsZoomToWidth;
        Hochformat.Enabled:=Orientation=poLandscape;
        Querformat.Enabled:=Orientation=poPortrait;
        PrintJobTitle:=Application.Title+' '+ExtractFileName(PrintFile);
        DateSeparator:='.';
        if opt.R.Language=english then begin
          ShortDateFormat:='m/d/yyyy';
          DateSeparator:='/';
        end
        else
          ShortDateFormat:='d.m.yyyy';
      end;
      PrintFile:=LoadedFile;
      PrintType:=Ty;
      if Ty=Richtext then
        RE:=Redit
      else if Ty=Imageview then
        IM:=Img;
    end;
    Screen.Cursor:=crHourGlass;
    CreatePages;
    Screen.Cursor:=crDefault;
  end
end;
//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
procedure TFrame3.ZoominClick(Sender: TObject);
begin
   PrintPreview1.Zoom:=(PrintPreview1.Zoom*5) div 4;
end;
//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
procedure TFrame3.ZoomoutClick(Sender: TObject);
begin
   PrintPreview1.Zoom:=(PrintPreview1.Zoom div 5)*4;
end;
//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
procedure TFrame3.ZoomNormalClick(Sender: TObject);
begin
   PrintPreview1.Zoom:=100;
   PrintPreview1.ZoomState:=zsZoomToFit;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.ZoomChange(scale:integer;state:TZoomState);
begin
  PrintPreview1.Zoom:=scale;
  PrintPreview1.ZoomState:=state;
  //CreatePages;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.PDFButtonClick(Sender:TObject);
begin
  if PrintPreview1.CanSaveAsPDF then begin
    SaveDialog1.FileName:=StringReplace(PrintFile,ExtractFileExt(PrintFile),'',
      [rfReplaceAll])+'.pdf';
    SaveDialog1.InitialDir:=ExtractFilePath(opt.R.Infile);
    SaveDialog1.Options:=[ofOverwritePrompt,ofPathMustExist];
    SaveDialog1.Filter:=trans(lang,33,'Akrobatdatei (*.pdf)|*.pdf');
    if SaveDialog1.Execute then
      PrintPreview1.SaveAsPDF(SaveDialog1.FileName)
  end
  else
    errorn(15,'zur Zeit nicht möglich');
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.setPreviewFull();
begin
  PrintPreview1.ZoomState:=zsZoomToFit;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.PrintButtonClick(Sender:TObject);
begin
  if PrintPreview1.State=psReady then begin
    PrintPreview1.SetPrinterOptions;
    PrintPreview1.PrintJobTitle:=PrintJobTitle;
    PrintPreview1.UpdateAnnotation;
    PrintDialog2.MinPage:=1;
    PrintDialog2.FromPage:=1;
    PrintDialog2.ToPage:=PrintPreview1.TotalPages;
    PrintDialog2.MaxPage:=PrintPreview1.TotalPages;
    PrintDialog2.PrintRange:=prAllPages;
    PrintDialog2.Options:=[poPageNums,poSelection];
    PrintDialog2.PrintToFile:=false;
    PrintDialog2.Ctl3D:=true;
    if PrintDialog2.Execute then begin
      if PrintDialog2.PrintRange=prSelection then
        PrintPreview1.PrintPages(PrintPreview1.CurrentPage,
          PrintPreview1.CurrentPage)
      else
        PrintPreview1.PrintPages(PrintDialog2.FromPage,PrintDialog2.ToPage);
    end
  end;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.LoadButtonClick(Sender:TObject);
begin
  if OpenDialog1.Execute then begin
    Screen.Cursor:=crHourGlass;
    Caption:=Application.Title+' - lade aus Datei...';
    try
      PrintPreview1.LoadFromFile(OpenDialog1.FileName);
    finally
      Caption:=Application.Title;
      Screen.Cursor:=crDefault;
    end;
  end;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.PageNavigatorChange(Sender:TObject;NewTab:Integer;
  var AllowChange:Boolean);
begin
  PrintPreview1.CurrentPage:=NewTab+1;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.PrintPreviewChange(Sender:TObject);
begin
  while PageNavigator.Tabs.Count<PrintPreview1.TotalPages do
    PageNavigator.Tabs.Add(IntToStr(PageNavigator.Tabs.Count+1));
  while PageNavigator.Tabs.Count>PrintPreview1.TotalPages do
    PageNavigator.Tabs.Delete(PageNavigator.Tabs.Count-1);
  PageNavigator.TabIndex:=PrintPreview1.CurrentPage-1;
  if PrintPreview1.State=psCreating then
    //To be able to see and navigate pages, which are prepared so far
    Application.ProcessMessages
  else begin
    PrintButton.Enabled:=PrintPreview1.PrinterInstalled;
  end;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.PrintPreviewBeginDoc(Sender:TObject);
begin
  Caption:=Application.Title+' - erzeuge Seiten...';
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.PrintPreviewEndDoc(Sender:TObject);
begin
  Caption:=Application.Title;
  PrintButton.Enabled:=PrintPreview1.PrinterInstalled;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.PrintPreviewBeforePrint(Sender:TObject);
begin
  Screen.Cursor:=crHourGlass;
  Caption:=Application.Title+trans(lang,34,' - bereite Druck vor...');
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.PrintPreviewAfterPrint(Sender:TObject);
begin
  Caption:=Application.Title;
  Screen.Cursor:=crDefault;
  PrintButton.Enabled:=PrintPreview1.PrinterInstalled;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.PrintPreviewPrintProgress(Sender:TObject;
  PageNum,Progress:Integer;var AbortIt:Boolean);
begin
  Caption:=Format(trans(lang,35,'%s - Druck Seite %d von %d (%%%d fertig)...'),
    [Application.Title,PageNum,PrintPreview1.TotalPages,Progress]);
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.PrintPreviewAnnotation(Sender:TObject;PageNo:Integer;
  Canvas:TCanvas);
begin
  with PrintPreview1.PrinterPageBounds do begin
    Canvas.Pen.Width:=0;
    Canvas.Pen.Style:=psDot;
    Canvas.Pen.Color:=clLtGray;
    Canvas.MoveTo(Left,0);
    Canvas.LineTo(Left,PrintPreview1.PaperHeight);
    Canvas.MoveTo(Right,0);
    Canvas.LineTo(Right,PrintPreview1.PaperHeight);
    Canvas.MoveTo(0,Top);
    Canvas.LineTo(PrintPreview1.PaperWidth,Top);
    Canvas.MoveTo(0,Bottom);
    Canvas.LineTo(PrintPreview1.PaperWidth,Bottom);
  end;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.CreateBorders(R:TRect);
var
  partial:JString;
begin
  with PrintPreview1 do begin
    //The following line ensures one pixel pen width in any mapping mode.
    Canvas.Pen.Width:=0;
    Canvas.Brush.Style:=bsCLear;
    Canvas.Rectangle(R.Left,R.Top,R.Right,R.Bottom-borderfontsize);
    //We write also the page number under the frame.
    Canvas.Font.size:=borderfontsize;
    SetTextAlign(Canvas.Handle,TA_LEFT or TA_TOP);
    Canvas.TextOut(R.Left,R.Bottom-borderfontsize,DateToStr(date));
    SetTextAlign(Canvas.Handle,TA_CENTER or TA_TOP);
    Canvas.TextOut((R.Right-R.Left)div 2+R.Left,R.Bottom-borderfontsize,'');
    SetTextAlign(Canvas.Handle,TA_RIGHT or TA_TOP);
    Canvas.TextOut(R.Right,R.Bottom-borderfontsize,
      Format(trans(lang,36,'Seite %d'),[TotalPages+1]));
    SetTextAlign(Canvas.Handle,TA_LEFT or TA_TOP);
    Canvas.TextOut(R.Left,R.Top+Canvas.Font.Height-8,
      Application.Title+' '+Version_IDE);
    SetTextAlign(Canvas.Handle,TA_RIGHT or TA_TOP);
    partial:='';
    if Previewselected then
      partial:=trans(lang,233,'Auszug aus ');
    Canvas.TextOut(R.Right,R.Top+Canvas.Font.Height-8,
      partial+ExtractFileName(PrintFile));
  end
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.PrintPreviewNewPage(Sender:TObject);
var
  R:TRect;
begin
  with PrintPreview1 do begin
    //The following line ensures one pixel pen width in any mapping mode.
    Canvas.Pen.Width:=0;
    Canvas.Brush.Style:=bsCLear;
    //We are going to draw a rectangular frame on the page with 1cm distance
    //from edges of the paper.
    R:=PageBounds;
    with ConvertXY(Framelinks,Frameoben,mmLoMetric,Units) do
      InflateRect(R,-X,-Y);
    //Canvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
    //We write also the page number under the frame.
    Canvas.Font.size:=borderfontsize;
    //SetTextAlign(Canvas.Handle, TA_RIGHT or TA_TOP);
    //Canvas.TextOut(R.Right, R.Bottom, Format('Page %d', [TotalPages+1]));
    SetTextAlign(Canvas.Handle,TA_LEFT or TA_TOP);
    CreateBorders(R);
  end;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.CreateRichTextPage;
var
  R:TRect;
begin
  with PrintPreview1 do begin
    //Don't forget that we have already drawn a frame for the page with 1cm
    //margin. We have to exclude it from the paper size. Besides that, we
    //want to include 1cm margin for the text also.
    R:=PageBounds;
    with ConvertXY(Randlinks,RandOben,mmLoMetric,Units) do
      InflateRect(R,-X,-Y);
    PaintRichText(R,RE,0,nil);
  end;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.CreateImageOnlyPage;
var
  R:TRect;
begin
  with PrintPreview1 do begin
    //Don't forget that we have already drawn a frame for the page with 1cm
    //margin. We have to exclude it from the paper size. Besides that, we
    //want to include 5mm margin for the image also.
    R:=PageBounds;
    with ConvertXY(Randlinks,RandOben,mmLoMetric,Units) do
      InflateRect(R,-X,-Y);
    PaintGraphicEx(R,IM.Picture.Graphic,true,false,true);
  end;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.CreatePages;
begin
  Screen.Cursor:=crHourGlass;
  visible:=false;
  with PrintPreview1 do begin
    Hochformat.Enabled:=Orientation=poLandscape;
    Querformat.Enabled:=Orientation=poPortrait;
    Units:=TUnits(1);
    BeginDoc;
    try
      case PrintType of
        Richtext:
          CreateRichTextPage;
        Imageview:
          CreateImageOnlyPage
      end
    finally
      EndDoc;
    end;
  end;
  visible:=true;
  Screen.Cursor:=crDefault; { Revient toujours à normal }
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.HochformatClick(Sender:TObject);
begin
  Screen.Cursor:=crHourGlass;
  PrintPreview1.Orientation:=poPortrait;
  CreatePages();
  //PrintPreview1.UpdateAnnotation;
  Hochformat.Enabled:=false;
  Querformat.Enabled:=true;
  Screen.Cursor:=crDefault;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.QuerformatClick(Sender:TObject);
begin
  Screen.Cursor:=crHourGlass;
  PrintPreview1.Orientation:=poLandscape;
  CreatePages();
  //PrintPreview1.UpdateAnnotation;
  Hochformat.Enabled:=true;
  Querformat.Enabled:=false;
  Screen.Cursor:=crDefault;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.Splitter2Moved(Sender:TObject);
begin
  ThumbnailPreview1.Update;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.Splitter1Moved(Sender:TObject);
begin
  ThumbnailPreview1.Update;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
procedure TFrame3.PageNavigatorClick(Sender:TObject);
begin
  PrintPreview1.CurrentPage:=PageNavigator.TabIndex+1;
end;
{ ------------------------------------------------------------------ }
{ -                                                                - }
{ -   Ende dieser Quelle                                           - }
{ -                                                                - }
{ ------------------------------------------------------------------ }
end.

quality88%

¤ Dauer der Verarbeitung: 0.19 Sekunden (vorverarbeitet) ¤

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.