pspreview.pas

GREATIS Print Suite Pro for Delphi (3-7,2005,2006,2007) and C++ Builder (3-6) Set of components for

                      dirVertical,
                      PhysicalPageWidth));
              end;
              with FScrollBox do
              begin
                with HorzScrollBar do
                begin
                  Range:=FPage.Width+16;
                  with FPage do
                    if Range<FScrollBox.ClientWidth then
                      Left:=(FScrollBox.ClientWidth-Width) div 2
                    else Left:=8;
                end;
                with VertScrollBar do
                begin
                  Range:=FPage.Height+16;
                  with FPage do
                    if Range<FSCrollBox.ClientHeight then
                      Top:=(FScrollBox.ClientHeight-Height) div 2
                    else Top:=8;
                end;
              end;
            end;
          end;
          if FViewMode<>vmCustom then
            with PrintJob.ActiveInstance(FPageIndex) do
              FViewScale:=
                Round(
                  100*
                  ClientWidth*
                  DPIX/
                  ConvertUnits(PageWidth,PageUnits,unPixels,dirHorizontal,PhysicalPageWidth)/
                  Screen.PixelsPerInch);
        end;
      finally
        with FPage,FMetafile do
        begin
          with PrintJob.ActiveInstance(PageIndex) do
          begin
            ResetToDefaultPage;
            Width:=GetSheetRect.Right;
            Height:=GetSheetRect.Bottom;
          end;
          TheCanvas:=TMetafileCanvas.Create(FMetafile,Printer.Handle);
          try
            TheCanvas.FillRect(Rect(0,0,Width,Height));
            PrintJob.Draw(TheCanvas,PageIndex,dtMetaPreview);
          finally
            TheCanvas.Free;
          end;
        end;
        FPage.Invalidate;
        Show;
      end;
    end;
    with FControls do
      for i:=0 to Pred(Count) do
      try
        TControl(FControls[i]).Update;
      except
      end;
    if Assigned(FOnUpdate) then FOnUpdate(Self);
  end
  else FPage.Hide;
end;

procedure TCustomPreview.Repaint;
begin
  inherited;
  FPage.Repaint;
end;

procedure TCustomPreview.AddControlNotification(Control: TControl);
begin
  with FControls do
    if IndexOf(Control)=-1 then Add(Control);
end;

procedure TCustomPreview.DeleteControlNotification(Control: TControl);
begin
  with FControls do
    if IndexOf(Control)<>-1 then Delete(IndexOf(Control));
end;

procedure TCustomPreview.ZoomIn;
var
  i: Integer;
begin
  ViewMode:=vmCustom;
  for i:=Low(ScaleArray) to High(ScaleArray) do
    if ScaleArray[i]>ViewScale then
    begin
      ViewScale:=ScaleArray[i];
      Break;
    end;
end;

procedure TCustomPreview.ZoomOut;
var
  i: Integer;
begin
  ViewMode:=vmCustom;
  for i:=High(ScaleArray) downto Low(ScaleArray) do
    if ScaleArray[i]<ViewScale then
    begin
      ViewScale:=ScaleArray[i];
      Break;
    end;
end;

function TCustomPreview.DPIX: Integer;
begin
  if Assigned(FPrintJob) then
    Result:=
      FPrintJob.ActiveInstance(FPageIndex).PhysicalPageWidth*
      GetDeviceCaps(Printer.Handle,LOGPIXELSX) div
      FPage.ClientWidth
  else Result:=Screen.PixelsPerInch;
end;

function TCustomPreview.DPIY: Integer;
begin
  if Assigned(FPrintJob) then
    Result:=
      FPrintJob.ActiveInstance(FPageIndex).PhysicalPageHeight*
      GetDeviceCaps(Printer.Handle,LOGPIXELSY) div
      FPage.ClientHeight
  else Result:=Screen.PixelsPerInch;
end;

procedure TCustomPreview.GetBitmap(BMP: TBitmap);
begin
  with FPage do
  begin
    BMP.Width:=Width;
    BMP.Height:=Height;
    PaintTo(BMP.Canvas.Handle,0,0);
  end;
end;

procedure TCustomPreview.GetContentBitmap(BMP: TBitmap);
begin
  with FPage.FMetafile do
  begin
    BMP.Width:=Width;
    BMP.Height:=Height;
    BMP.Canvas.Draw(0,0,FPage.FMetafile);
  end;
end;

procedure TCustomPreview.CopyToClipboard;
var
  BMP: TBitmap;
  ClipFormat: Word;
  Data: THandle;
  Palette: HPALETTE;
begin
  BMP:=TBitmap.Create;
  try
    GetBitmap(BMP);
    BMP.SaveToClipboardFormat(ClipFormat,Data,Palette);
    Clipboard.SetAsHandle(ClipFormat,Data);
  finally
    BMP.Free;
  end;
end;

procedure TCustomPreview.SaveToFile(const FileName: string);
var
  BMP: TBitmap;
begin
  BMP:=TBitmap.Create;
  try
    GetBitmap(BMP);
    BMP.SaveToFile(FileName);
  finally
    BMP.Free;
  end;
end;

procedure TCustomPreview.WndProc(var Msg: TMessage);
begin
  inherited;
  case Msg.Msg of
    WM_SIZE: Update;
  end;
end;

procedure TCustomPreview.CMChildKey(var Msg: TCMChildKey);

  function KeyPressed(VK: Word): Boolean;
  begin
    Result:=GetKeyState(VK) and $80 <> 0;
  end;

begin
  with FScrollBox,Msg do
  begin
    with VertScrollBar do
      case CharCode of
        VK_UP:
        begin
          Position:=Position-Increment;
          Result:=1;
        end;
        VK_DOWN:
        begin
          Position:=Position+Increment;
          Result:=1;
        end;
        VK_PRIOR:
        begin
          if KeyPressed(VK_CONTROL) then Position:=0
          else
            if Position<=0 then PageIndex:=PageIndex-1
            else Position:=Position-ClientHeight+Increment;
          Result:=1;
        end;
        VK_NEXT:
        begin
          if KeyPressed(VK_CONTROL) then Position:=Range
          else
            if Position>=Range-ClientHeight then PageIndex:=PageIndex+1
            else Position:=Position+ClientHeight-Increment;
          Result:=1;
        end;
      end;
    with HorzScrollBar do
      case CharCode of
        VK_LEFT:
        begin
          if KeyPressed(VK_CONTROL) then Position:=Position-ClientWidth+Increment
          else Position:=Position-Increment;
          Result:=1;
        end;
        VK_RIGHT:
        begin
          if KeyPressed(VK_CONTROL) then Position:=Position+ClientWidth-Increment
          else Position:=Position+Increment;
          Result:=1;
        end;
        VK_HOME:
        begin
          if KeyPressed(VK_CONTROL) then
          begin
            Position:=0;
            VertScrollBar.Position:=0;
          end
          else Position:=0;
          Result:=1;
        end;
        VK_END:
        begin
          if KeyPressed(VK_CONTROL) then
          begin
            Position:=Range;
            VertScrollBar.Position:=VertScrollBar.Range;
          end
          else Position:=Range;
          Result:=1;
        end;
      end;
  end;
end;

{$IFNDEF VERSION3}
procedure TCustomPreview.CMMouseWheel(var Msg: TCMMouseWheel);
begin
  inherited;
  with FScrollBox.VertScrollBar do
    Position:=Position-(ViewScale*Msg.WheelDelta div 480);
end;
{$ENDIF}

procedure TCustomPreview.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation=opRemove) and Assigned(FPrintJob) and (AComponent=FPrintJob) then
    PrintJob:=nil;
end;

procedure TCustomPreview.SetPrintJob(const Value: TCustomPrintJob);
begin
  if Value<>FPrintJob then
  begin
    if Assigned(FPrintJob) then FPrintJob.DeleteControlNotification(Self);
    FPrintJob:=Value;
    if Assigned(FPrintJob) then FPrintJob.AddControlNotification(Self);
    PageIndex:=1;
    FPage.Visible:=Assigned(FPrintJob);
    Update;
  end;
end;

function TCustomPreview.GetBorderStyle: TBorderStyle;
begin
  Result:=FScrollBox.BorderStyle;
end;

procedure TCustomPreview.SetBorderStyle(const Value: TBorderStyle);
begin
  FScrollBox.BorderStyle:=Value;
end;

function TCustomPreview.GetCtl3D: Boolean;
begin
  Result:=FScrollBox.Ctl3D;
end;

procedure TCustomPreview.SetCtl3D(const Value: Boolean);
begin
  FScrollBox.Ctl3D:=Value;
end;

function TCustomPreview.GetParentCtl3D: Boolean;
begin
  Result:=FScrollBox.Ctl3D;
end;

procedure TCustomPreview.SetParentCtl3D(const Value: Boolean);
begin
  FScrollBox.Ctl3D:=Value;
end;

procedure TCustomPreview.SetColor(const Value: TColor);
begin
  if Value<>FColor then
  begin
    FColor:=Value;
    FScrollBox.Color:=FColor;
    FPage.Color:=FColor;
  end;
end;

procedure TCustomPreview.SetShadowColor(const Value: TColor);
begin
  if Value<>FShadowColor then
  begin
    FShadowColor:=Value;
    FPage.Invalidate;
  end;
end;

procedure TCustomPreview.SetShadowSize(const Value: Integer);
var
  I: Integer;
begin
  I:=Value;
  if I<0 then I:=0;
  if I>100 then I:=100;
  if I<>FShadowSize then
  begin
    FShadowSize:=I;
    Update;
  end;
end;

procedure TCustomPreview.SetViewMode(const Value: TViewMode);
begin
  {$IFNDEF PSTRIAL}
  if Value<>FViewMode then
  begin
    FViewMode:=Value;
    ViewScale:=FViewScale;
    Update;
  end;
  {$ENDIF}
end;

procedure TCustomPreview.SetViewScale(const Value: Integer);
{$IFNDEF PSTRIAL}
var
  iValue: Integer;
{$ENDIF}
begin
  {$IFNDEF PSTRIAL}
  if ViewMode=vmCustom then
  begin
    iValue:=Value;
    if iValue<ScaleArray[Low(ScaleArray)] then iValue:=ScaleArray[Low(ScaleArray)];
    if iValue>ScaleArray[High(ScaleArray)] then iValue:=ScaleArray[High(ScaleArray)];
    if iValue<>FViewScale then
    begin
      FViewScale:=iValue;
      Update;
    end;
  end;
  {$ENDIF}
end;

procedure TCustomPreview.SetPageIndex(const Value: Integer);
var
  iValue: Integer;
begin
  iValue:=Value;
  if not Assigned(PrintJob) then iValue:=1
  else
  begin
    if iValue<1 then iValue:=1;
    if iValue>PrintJob.PageCount then iValue:=PrintJob.PageCount;
  end;
  if iValue<>FPageIndex then
  begin
    FPageIndex:=iValue;
    with FScrollBox do
    begin
      with HorzScrollBar do Position:=0;
      with VertScrollBar do Position:=0;
    end;
    Update;
  end;
  if Assigned(FOnPageChanged) then FOnPageChanged(Self);
end;

procedure TCustomPreview.SetScrollTracking(const Value: Boolean);
begin
  if Value<>FScrollTracking then
  begin
    FScrollTracking:=Value;
    FScrollBox.HorzScrollBar.Tracking:=ScrollTracking;
    FScrollBox.VertScrollBar.Tracking:=ScrollTracking;
  end;
end;

function TCustomPreview.GetCursor: TCursor;
begin
  if Assigned(FPage) then Result:=FPage.Cursor
  else Result:=crDefault;
end;

procedure TCustomPreview.SetCursor(const Value: TCursor);
begin
  if Assigned(FPage) then FPage.Cursor:=Value;
end;

function TCustomPreview.GetScaleText: string;
begin
  case FViewMode of
    vmCustom: Result:=IntToStr(ViewScale)+'%';
    vmPageWidth: Result:=Format(strPageWidth,[ViewScale]);
    vmWholePage: Result:=Format(strWholePage,[ViewScale]);
  end;
end;

function TCustomPreview.GetPageText: string;
begin
  if Assigned(PrintJob) then
    Result:=Format(strPageIndex,[PageIndex,PrintJob.PageCount]);
end;

procedure Register;
begin
  RegisterComponents('Print Suite', [TPreview]);
end;

end.