jvprvwdoc.pas

East make Tray Icon in delphi

  end;
end;

procedure TJvCustomPreviewControl.Clear;
var
  I: Integer;
begin
  for I := 0 to FPages.Count - 1 do
    TMetafile(FPages[I]).Free;
  FPages.Count := 0;
  if not (csDestroying in ComponentState) then
    Change;
end;

procedure TJvCustomPreviewControl.CMCtl3DChanged(var Msg: TMessage);
begin
  if NewStyleControls and (FBorderStyle = bsSingle) then
    RecreateWnd;
  inherited;
end;

procedure TJvCustomPreviewControl.CreateParams(var Params: TCreateParams);
const
  BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or BorderStyles[FBorderStyle];
    if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
    begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
  end;
end;

procedure TJvCustomPreviewControl.Delete(Index: Integer);
begin
  TMetafile(FPages[Index]).Free;
  FPages.Delete(Index);
  Change;
end;

function TJvCustomPreviewControl.DoAddPage(AMetaFile: TMetafile; PageIndex: Integer): Boolean;
var
  ACanvas: TMetaFileCanvas;
  APageRect, APrintRect: TRect;
  I: Integer;
begin
  Result := False;
  ACanvas := TMetaFileCanvas.Create(AMetaFile, DeviceInfo.ReferenceHandle);
  SetMapMode(ACanvas.Handle, MM_ANISOTROPIC);
  with DeviceInfo do
  begin
    SetWindowOrgEx(ACanvas.Handle, 0, 0, nil);
    SetWindowExtEx(ACanvas.Handle, PhysicalWidth, PhysicalHeight, nil);
    SetViewportExtEx(ACanvas.Handle, PhysicalWidth, PhysicalHeight, nil);
  end;
  // NB! Font.Size is changed when PPI is changed, so store and reset
  I := ACanvas.Font.Size;
  ACanvas.Font.PixelsPerInch := DeviceInfo.LogPixelsY;
  ACanvas.Font.Size := I;

  if Assigned(FOnAddPage) then
    with DeviceInfo do
    begin
      APageRect := Rect(0, 0, PhysicalWidth, PhysicalHeight);
      APrintRect := APageRect;
      Dec(APageRect.Left, OffsetLeft);
      Dec(APageRect.Top, OffsetTop);
      Inc(APageRect.Right, OffsetRight);
      Inc(APageRect.Bottom, OffsetBottom);
      FOnAddPage(Self, PageIndex, ACanvas, APageRect, APrintRect, Result);
    end;
  // spool canvas to metafile
  ACanvas.Free;
end;

procedure TJvCustomPreviewControl.DoDrawPreviewPage(PageIndex: Integer;
  Canvas: TCanvas; PageRect, PrintRect: TRect);
begin
  if Assigned(FOnDrawPreviewPage) then
    FOnDrawPreviewPage(Self, PageIndex, Canvas, PageRect, PrintRect);
end;

procedure TJvCustomPreviewControl.DoOptionsChange(Sender: TObject);
begin
  Change;
  if Assigned(FOnOptionsChange) then
    FOnOptionsChange(Self);
end;

procedure TJvCustomPreviewControl.DoScaleModeChange(Sender: TObject);
begin
  Change;
  if Assigned(FOnScaleModeChange) then
    FOnScaleModeChange(Self);
end;

procedure TJvCustomPreviewControl.DoDeviceInfoChange(Sender: TObject);
begin
  Change;
  if Assigned(FOnDeviceInfoChange) then
    FOnDeviceInfoChange(Self);
end;

procedure TJvCustomPreviewControl.DrawPages(ACanvas: TCanvas; Offset: TPoint);
var
  I, J, K, M, AOffsetX, AOffsetY, APageIndex: Integer;
  APageRect, APrintRect: TRect;
  //  SI: TScrollInfo;
  Tmp: Boolean;

  function CanDrawPage(APageIndex: Integer; APageRect: TRect): Boolean;
  begin
    Result := (APageIndex < PageCount) or (PageCount = 0);
    if not Result then
      Exit;
    Result := not IsPageMode;
    if not Result then
      Result := RectInRect(APageRect, ClientRect)
    else
      Result := PartialInRect(APageRect, ClientRect);
  end;

begin
  APageRect := FPreviewRect;
  APrintRect := FPrintRect;

  // initial top/left offset
  AOffsetX := -Offset.X + Max((ClientWidth - ((FPageWidth + Integer(Options.HorzSpacing)) * TotalCols)) div 2,
    FOptions.HorzSpacing);
  if IsPageMode then
    AOffsetY := -Offset.Y + Max((ClientHeight - ((FPageHeight + Integer(Options.VertSpacing)) * VisibleRows)) div 2,
      FOptions.VertSpacing)
  else
    AOffsetY := -Offset.Y + Integer(Options.VertSpacing);
  K := 0;
  with ACanvas do
  begin
    Brush.Color := Color;
    FillRect(ClipRect);
    Pen.Color := clBlack;
    Pen.Style := psDot;
    { (rom) disabled
    // $IFDEF DEBUG
    Polyline([
      Point(AOffsetX, AOffsetY),
        Point(AOffsetX, AOffsetY + FMaxHeight),
        Point(AOffsetX + FMaxWidth, AOffsetY + FMaxHeight),
        Point(AOffsetX + FMaxWidth, AOffsetY),
        Point(AOffsetX, AOffsetY)
        ]);
    // $ENDIF DEBUG
    }
    Pen.Style := psSolid;
    APageIndex := K * TotalCols;
    M := Max(0, PageCount - 1);
//    if not IsPageMode and (K > 0) then
//      Dec(K);
    for I := K to M do
    begin
      APrintRect := FPrintRect;
      APageRect := FPreviewRect;
      OffsetRect(APrintRect, AOffsetX, AOffsetY + (FPageHeight + Integer(Options.VertSpacing)) * I);
      OffsetRect(APageRect, AOffsetX, AOffsetY + (FPageHeight + Integer(Options.VertSpacing)) * I);
      for J := 0 to TotalCols - 1 do
      begin
        // avoid drawing partial pages when previewrect < clientrect
        Tmp := CanDrawPage(APageIndex, APageRect);
        if Tmp then
        begin
          DrawShadow(ACanvas, APageRect);
          // draw background
          Brush.Color := Options.Color;
          FillRect(APageRect);
          // draw preview content
          if APageIndex < PageCount then
            DrawPreview(APageIndex, APageRect, APrintRect);
          // draw frame
          Brush.Style := bsClear;
          Pen.Color := clWindowText;
          Rectangle(APageRect);
          if (APageIndex = FSelectedPage) and Selection.Visible then
          begin
            Pen.Color := Selection.Color;
            Pen.Width := Selection.Width;
            Rectangle(APageRect);
            Pen.Color := clWindowText;
            Pen.Width := 1;
          end;
          // draw margins
          if Options.DrawMargins and not EqualRect(APageRect, APrintRect) then
          begin
            Pen.Style := psDot;
            Rectangle(APrintRect);
            Pen.Style := psSolid;
          end;
          Brush.Style := bsSolid;
          if PageCount = 0 then
            Exit; // we've drawn one empty page, so let's skip the rest
        end;
        OffsetRect(APrintRect, FPageWidth + Integer(Options.HorzSpacing), 0);
        OffsetRect(APageRect, FPageWidth + Integer(Options.HorzSpacing), 0);
        Inc(APageIndex);
      end;
    end;
  end;
end;

procedure TJvCustomPreviewControl.DrawPreview(PageIndex: Integer;
  APageRect, APrintRect: TRect);
begin
  FBuffer.Canvas.StretchDraw(APrintRect, Pages[PageIndex]);
  DoDrawPreviewPage(PageIndex, FBuffer.Canvas, APageRect, APrintRect);
end;

function TJvCustomPreviewControl.GetPage(Index: Integer): TMetafile;
begin
  Result := TMetafile(FPages[Index]);
end;

function TJvCustomPreviewControl.GetPageCount: Integer;
begin
  Result := FPages.Count;
end;

procedure TJvCustomPreviewControl.Paint;
begin
  if IsUpdating then
    Exit;
  FBuffer.Width := ClientWidth;
  FBuffer.Height := ClientHeight;
  //  Canvas.Brush.Color := Color;
  //  Canvas.FillRect(ClientRect);
  DrawPages(FBuffer.Canvas, Point(FScrollPos.X, FScrollPos.Y));
  BitBlt(Canvas.Handle, 0, 0, FBuffer.Width, FBuffer.Height, FBuffer.Canvas.Handle,
    0, 0, SRCCOPY);
end;

procedure TJvCustomPreviewControl.SetBorderStyle(const Value: TBorderStyle);
begin
  if FBorderStyle <> Value then
  begin
    FBorderStyle := Value;
    RecreateWnd;
  end;
end;

procedure TJvCustomPreviewControl.SetSelectedPage(const Value: Integer);
begin
  if FSelectedPage <> Value then
  begin
    FSelectedPage := Value;
    Invalidate;
  end;
end;

procedure TJvCustomPreviewControl.SetDeviceInfo(const Value: TJvDeviceInfo);
begin
  FDeviceInfo.Assign(Value);
end;

procedure TJvCustomPreviewControl.SetOptions(const Value: TJvPreviewPageOptions);
begin
  FOptions.Assign(Value);
end;

function TJvCustomPreviewControl.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean;
begin
  //  inherited DoEraseBackground(Canvas, Param);
  Result := True;
end;

procedure TJvCustomPreviewControl.BoundsChanged;
var
  TmpRow: Integer;
begin
  inherited BoundsChanged;
  TmpRow := TopRow; // workaround...
  Change;
  if IsPageMode then
    TopRow := TmpRow; // workaround...
end;

procedure TJvCustomPreviewControl.WMHScroll(var Msg: TWMHScroll);
var
  SI: TScrollInfo;
  NewPos, Increment: Integer;
begin
  if IsPageMode then
    Exit;
  Increment := FPageWidth div 3;
  FillChar(SI, SizeOf(TScrollInfo), 0);
  SI.cbSize := SizeOf(TScrollInfo);
  SI.fMask := SIF_ALL;
  GetScrollInfo(Handle, SB_HORZ, SI);
  case Msg.ScrollCode of
    SB_TOP:
      NewPos := 0;
    SB_BOTTOM:
      NewPos := FMaxWidth;
    SB_LINEDOWN, SB_PAGEDOWN:
      NewPos := FScrollPos.X + Increment;
    SB_LINEUP, SB_PAGEUP:
      NewPos := FScrollPos.X - Increment;
    SB_THUMBPOSITION, SB_THUMBTRACK:
      begin
        NewPos := SI.nTrackPos;
        if NewPos = FScrollPos.X then
          Exit;
      end;
    SB_ENDSCROLL:
      Exit;
  end;
  NewPos := EnsureRange(NewPos, SI.nMin, SI.nMax);
  if Assigned(FOnHorzScroll) then
    FOnHorzScroll(Self, TScrollCode(Msg.ScrollCode), NewPos);
  NewPos := EnsureRange(NewPos, SI.nMin, SI.nMax);
  ScrollBy(-FScrollPos.X + NewPos, 0);
  FScrollPos.X := NewPos;
  SI.nPos := NewPos;
  SetScrollInfo(Handle, SB_HORZ, SI, True);
  if Assigned(FOnAfterScroll) then
    FOnAfterScroll(Self);
  Refresh;
end;

procedure TJvCustomPreviewControl.WMVScroll(var Msg: TWMVScroll);
var
  SI: TScrollInfo;
  NewPos, Increment: Integer;
begin
  Increment := FPageHeight + Integer(Options.VertSpacing);
  if not IsPageMode then
    Increment := Increment div 3;
  if Increment < 1 then
    Increment := 1;

  FillChar(SI, SizeOf(TScrollInfo), 0);
  SI.cbSize := SizeOf(TScrollInfo);
  SI.fMask := SIF_ALL;
  GetScrollInfo(Handle, SB_VERT, SI);
  case Msg.ScrollCode of
    SB_TOP:
      NewPos := 0;
    SB_BOTTOM:
      NewPos := FMaxHeight;
    SB_LINEDOWN, SB_PAGEDOWN:
      NewPos := FScrollPos.Y + Increment;
    SB_LINEUP, SB_PAGEUP:
      NewPos := FScrollPos.Y - Increment;
    SB_THUMBPOSITION, SB_THUMBTRACK:
      begin
        NewPos := SI.nTrackPos;
        if IsPageMode then
          NewPos := NewPos - SI.nTrackPos mod Increment;
        if NewPos = FScrollPos.Y then
          Exit;
      end;
    SB_ENDSCROLL:
      begin
        TDeactiveHintThread.Create(500, HintWindow);
        HintWindow := nil;
        Exit;
      end;
  end;
  NewPos := EnsureRange(NewPos, SI.nMin, SI.nMax);
  if Assigned(FOnVertScroll) then
    FOnVertScroll(Self, TScrollCode(Msg.ScrollCode), NewPos);
  NewPos := EnsureRange(NewPos, SI.nMin, SI.nMax);
  ScrollBy(0, -FScrollPos.Y + NewPos);
  FScrollPos.Y := NewPos;
  SI.nPos := NewPos;
  SetScrollInfo(Handle, SB_VERT, SI, True);
  DoScrollHint(NewPos);
  if Assigned(FOnAfterScroll) then
    FOnAfterScroll(Self);
  Refresh;
end;

procedure TJvCustomPreviewControl.GetDlgCode(var Code: TDlgCodes);
begin
  Code := [dcWantAllKeys];
end;

procedure TJvCustomPreviewControl.PrintRange(const APrinter: IJvPrinter;
  StartPage, EndPage, Copies: Integer; Collate: Boolean);
var
  I, J: Integer;
begin
  if (APrinter = nil) or APrinter.GetPrinting then
    Exit;
  if StartPage < 0 then
    StartPage := PageCount - 1;
  if StartPage >= PageCount then
    StartPage := PageCount - 1;
  if EndPage < 0 then
    EndPage := PageCount - 1;
  if EndPage >= PageCount then
    EndPage := PageCount - 1;
  if Copies < 1 then
    Copies := 1;
  if (StartPage < 0) or (EndPage < 0) then
    Exit;
  if Collate then // Range * Copies
  begin
    if StartPage > EndPage then
    begin
      // print backwards
      for I := 0 to Copies - 1 do
        for J := StartPage downto EndPage do
        begin
          if APrinter.GetAborted then
          begin
            if APrinter.GetPrinting then
              APrinter.EndDoc;
            Exit;
          end;
          if (J = StartPage) and (I = 0) then
            APrinter.BeginDoc
          else
            APrinter.NewPage;
          APrinter.GetCanvas.Draw(0, 0, Pages[J]);
        end;
    end
    else
    begin
      for I := 0 to Copies - 1 do
        for J := StartPage to EndPage do
        begin
          if APrinter.GetAborted then
          begin
            if APrinter.GetPrinting then
              APrinter.EndDoc;
            Exit;
          end;
          if (J = StartPage) and (I = 0) then
            APrinter.BeginDoc
          else
            APrinter.NewPage;
          APrinter.GetCanvas.Draw(0, 0, Pages[J]);
        end;
    end;
  end
  else // Page * Copies
  begin
    if StartPage > EndPage then
    begin
      // print backwards
      for J := StartPage downto EndPage do
        for I := 0 to Copies - 1 do
        begin
          if APrinter.GetAborted then
          begin
            if APrinter.GetPrinting then
              APrinter.EndDoc;
            Exit;
          end;
          if (J = StartPage) and (I = 0) then
            APrinter.BeginDoc
          else
            APrinter.NewPage;
          APrinter.GetCanvas.Draw(0, 0, Pages[J]);
        end;
    end
    else
    begin
      for J := StartPage to EndPage do
        for I := 0 to Copies - 1 do
        begin
          if APrinter.GetAborted then
          begin
            if APrinter.GetPrinting then
              APrinter.EndDoc;
            Exit;
          end;
          if (J = StartPage) and (I = 0) then
            APrinter.BeginDoc
          else
            APrinter.NewPage;
          APrinter.GetCanvas.Draw(0, 0, Pages[J]);
        end;
    end;
  end;
  if APrinter.GetPrinting then
    APrinter.EndDoc;
end;

function TJvCustomPreviewControl.GetOptimalScale: Cardinal;
var
  Val1, Val2: Integer;
begin
  Val1 := (ClientHeight - Integer(Options.VertSpacing)) div VisibleRows - Integer(Options.VertSpacing) * 2;
  Val2 := (ClientWidth - Integer(Options.HorzSpacing)) div TotalCols - Integer(Options.HorzSpacing) * 2;
  Result := GetLesserScale(Val1, Val2);
end;