jvprvwdoc.pas

East make Tray Icon in delphi

procedure TJvCustomPreviewControl.Change;
begin
  //  TopRow := 0; // DONE: make this unnecessary...
  UpdateSizes;
  UpdateScale;
  // call again since some values might have changed (like scale):
  UpdateSizes;
  CalcScrollRange;
  if Assigned(FOnChange) then
    FOnChange(Self);
  Refresh;
end;

procedure TJvCustomPreviewControl.BeginUpdate;
begin
  Inc(FUpdateCount);
end;

procedure TJvCustomPreviewControl.EndUpdate;
begin
  Dec(FUpdateCount);
  if FUpdateCount = 0 then
    Change;
  if FUpdateCount < 0 then
    FUpdateCount := 0;
end;

function TJvCustomPreviewControl.GetLesserScale(AHeight, AWidth: Cardinal): Cardinal;
var
  DC: HDC;
begin
  // determine scale factor for both sides, choose lesser
  // this is the opposite of setting FPageWidth/FPageHeight
  DC := GetDC(HWND_DESKTOP);
  try
    if AWidth > 0 then
      AWidth := MulDiv(AWidth, 100, MulDiv(DeviceInfo.PhysicalWidth,
        GetDeviceCaps(DC, LOGPIXELSX), DeviceInfo.LogPixelsX));
    if AHeight > 0 then
      AHeight := MulDiv(AHeight, 100, MulDiv(DeviceInfo.PhysicalHeight,
        GetDeviceCaps(DC, LOGPIXELSY), DeviceInfo.LogPixelsY));
    if (AHeight > 0) and (AWidth > 0) then
      Result := Min(AWidth, AHeight)
    else
    if AHeight > 0 then
      Result := AHeight
    else
      Result := AWidth;
  finally
    ReleaseDC(HWND_DESKTOP, DC);
  end;
end;

function TJvCustomPreviewControl.IsUpdating: Boolean;
begin
  Result := FUpdateCount <> 0;
end;

procedure TJvCustomPreviewControl.SetTopRow(Value: Integer);
var
  ARow, Tmp: Integer;
  //  SI: TScrollInfo;
begin
  ARow := Max(Min(Value, TotalRows - 1), 0);
  Tmp := (FPageHeight + Integer(Options.VertSpacing)) * ARow;
  ScrollBy(0, -FScrollPos.Y + Tmp);
  FScrollPos.Y := Tmp;
  SetScrollPos(Handle, SB_VERT, FScrollPos.Y, True);
  Refresh;
end;

procedure TJvCustomPreviewControl.UpdateSizes;
var
  DC: HDC;
begin
  // precalc as much as possible to speed up rendering
  DC := GetDC(HWND_DESKTOP);
  try
    FPageWidth := MulDiv(MulDiv(DeviceInfo.PhysicalWidth, GetDeviceCaps(DC, LOGPIXELSX),
      DeviceInfo.LogPixelsX), Options.Scale, 100);
    FPageHeight := MulDiv(MulDiv(DeviceInfo.PhysicalHeight, GetDeviceCaps(DC, LOGPIXELSY),
      DeviceInfo.LogPixelsY), Options.Scale, 100);

    FOffsetLeft := MulDiv(MulDiv(DeviceInfo.OffsetLeft, GetDeviceCaps(DC, LOGPIXELSX),
      DeviceInfo.LogPixelsX), Options.Scale, 100);
    FOffsetTop := MulDiv(MulDiv(DeviceInfo.OffsetTop, GetDeviceCaps(DC, LOGPIXELSY),
      DeviceInfo.LogPixelsY), Options.Scale, 100);
    FOffsetRight := MulDiv(MulDiv(DeviceInfo.OffsetRight, GetDeviceCaps(DC, LOGPIXELSX),
      DeviceInfo.LogPixelsX), Options.Scale, 100);
    FOffsetBottom := MulDiv(MulDiv(DeviceInfo.OffsetBottom, GetDeviceCaps(DC, LOGPIXELSY),
      DeviceInfo.LogPixelsY), Options.Scale, 100);

    FPreviewRect := Rect(0, 0, FPageWidth, FPageHeight);
    FPrintRect := FPreviewRect;
    with FPrintRect do
    begin
      Inc(Left, FOffsetLeft);
      Inc(Top, FOffsetTop);
      Dec(Right, FOffsetRight);
      Dec(Bottom, FOffsetBottom);
    end;

    if (Options.ScaleMode in [smFullPage, smPageWidth]) or
      (FPageWidth >= ClientWidth) or (FPageHeight >= ClientHeight) and
      not (Options.ScaleMode in [smScale, smAutoScale]) then
    begin
      FTotalCols := 1;
      FVisibleRows := 1;
    end
    else
      case Options.ScaleMode of
        smAutoScale:
          begin
            FTotalCols := Max(Min(PageCount, Max((ClientWidth - Integer(Options.HorzSpacing)) div (FPageWidth +
              Integer(Options.HorzSpacing)), 1)), 1);
            FVisibleRows := Min(Max((ClientHeight - Integer(Options.VertSpacing)) div (FPageHeight +
              Integer(Options.VertSpacing)), 1), TotalRows);
            if (VisibleRows > 1) and (VisibleRows * TotalCols > PageCount) then
              FVisibleRows := Min((PageCount div TotalCols) + Ord(PageCount mod TotalCols <> 0), TotalRows);
            if (FPageWidth + Integer(Options.HorzSpacing) * 2 >= ClientWidth) or
              (FPageHeight + Integer(Options.VertSpacing) * 2 >= ClientHeight) then
            begin
              FTotalCols := 1;
              FVisibleRows := 1;
              Options.FScale := GetOptimalScale;
            end;
          end
      else
        begin
          FTotalCols := Max(Min(PageCount, Options.Cols), 1);
          FVisibleRows := Max(Min(PageCount div Integer(Options.Cols) + Ord(PageCount mod Integer(Options.Cols) <> 0),
            Options.Rows), 1);
        end;
      end;

    FTotalRows := Max((PageCount div TotalCols) + Ord(PageCount mod TotalCols <> 0), 1);

    // TODO: this just isn't right...
    FMaxHeight := TotalRows * (FPageHeight + Integer(Options.VertSpacing)) + Integer(Options.VertSpacing);
    //    if (FMaxHeight > ClientHeight) and (TotalRows > 1) then
    //      Dec(FMaxHeight,FPageHeight - Integer(Options.VertSpacing));
    FMaxWidth := TotalCols * (FPageWidth + Integer(Options.HorzSpacing)) + Integer(Options.HorzSpacing);
  finally
    ReleaseDC(HWND_DESKTOP, DC);
  end;
end;

function TJvCustomPreviewControl.GetTopRow: Integer;
begin
  Result := FScrollPos.Y div (FPageHeight + Integer(Options.VertSpacing));
  Inc(Result, Ord(FScrollPos.Y mod (FPageHeight + Integer(Options.VertSpacing)) <> 0));
  Result := Min(Result, TotalRows - 1);
end;

procedure TJvCustomPreviewControl.First;
begin
  TopRow := 0;
end;

procedure TJvCustomPreviewControl.Last;
begin
  TopRow := TotalRows;
end;

procedure TJvCustomPreviewControl.Next;
begin
  TopRow := TopRow + 1;
end;

procedure TJvCustomPreviewControl.Prior;
begin
  TopRow := TopRow - 1;
end;

function TJvCustomPreviewControl.ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
var
  APageRect: TRect;
  ARow, ACol, AOffsetX, AOffsetY: Integer;
begin
  Result := -1;
  // initial top/left offset
  AOffsetX := -FScrollPos.X + Max((ClientWidth - ((FPageWidth + Integer(Options.HorzSpacing)) * TotalCols)) div 2, FOptions.HorzSpacing);
  if IsPageMode then
    AOffsetY := -FScrollPos.Y + Max((ClientHeight - ((FPageHeight + Integer(Options.VertSpacing)) * VisibleRows)) div 2,
      FOptions.VertSpacing)
  else
    AOffsetY := -FScrollPos.Y + Integer(Options.VertSpacing);
  ARow := 0;
  // walk the pages, comparing as we go along
  while True do
  begin
    APageRect := FPreviewRect;
    OffsetRect(APageRect, AOffsetX, AOffsetY + (FPageHeight + Integer(Options.VertSpacing)) * ARow);
    for ACol := 0 to TotalCols - 1 do
    begin
      if PtInRect(APageRect, Pos) then
      begin
        Result := ARow * TotalCols + ACol;
        if Existing and (Result >= PageCount) then
          Result := -1;
        Exit;
      end;
      OffsetRect(APageRect, FPageWidth + Integer(Options.HorzSpacing), 0);
    end;
    Inc(ARow);
    if (APageRect.Left > ClientWidth) or (APageRect.Top > ClientHeight) then
      Exit;
  end;
end;

procedure TJvCustomPreviewControl.SetScrollBars(const Value: TScrollStyle);
begin
  if FScrollBars <> Value then
  begin
    FScrollBars := Value;
    Change;
  end;
end;

procedure TJvCustomPreviewControl.SetHideScrollBars(const Value: Boolean);
begin
  if FHideScrollBars <> Value then
  begin
    FHideScrollBars := Value;
    Change;
  end;
end;

function TJvCustomPreviewControl.DoMouseWheel(Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint): Boolean;
var
  Msg: TWMScroll;
  SI: TScrollInfo;
begin
  Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
  if not Result then
  begin
    FillChar(SI, SizeOf(TScrollInfo), 0);
    SI.cbSize := SizeOf(TScrollInfo);
    SI.fMask := SIF_ALL;
    GetScrollInfo(Handle, SB_VERT, SI);
    if SI.nMax = 0 then
      Exit;
    Msg.Msg := WM_VSCROLL;
    if WheelDelta > 0 then
      Msg.ScrollCode := SB_PAGEUP
    else
      Msg.ScrollCode := SB_PAGEDOWN;
    Msg.Pos := FScrollPos.Y;
    Msg.Result := 0;
    WMVScroll(Msg);
    Refresh;
    TDeactiveHintThread.Create(500, HintWindow);
    HintWindow := nil;
    Result := True;
  end;
end;

procedure TJvCustomPreviewControl.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  I: Integer;
begin
  inherited MouseDown(Button, Shift, X, Y);
  if CanFocus then
    SetFocus;
  I := ItemAtPos(Point(X, Y), True);
  if I >= 0 then
    SelectedPage := I;
end;

function TJvCustomPreviewControl.IsPageMode: Boolean;
begin
  Result := (Options.ScaleMode in [smFullPage, smAutoScale, smColsRows]) or
    ((Options.ScaleMode = smScale) and (FPageHeight + Integer(Options.VertSpacing) * 2 <= ClientHeight));
end;

procedure TJvCustomPreviewControl.UpdateScale;
begin
  case Options.ScaleMode of
    smFullPage:
      begin
        Options.FCols := 1;
        Options.FRows := 1;
        FTotalRows := PageCount - 1;
        Options.FScale := GetOptimalScale;
      end;
    smPageWidth:
      begin
        Options.FCols := 1;
        Options.FRows := 1;
        FTotalRows := PageCount - 1;
        Options.FScale := GetLesserScale(0, ClientWidth - Integer(Options.HorzSpacing) * 2 -
          GetSystemMetrics(SM_CYHSCROLL));
      end;
    smScale:
      begin
        FTotalCols := Min(Options.Cols, TotalCols);
        FVisibleRows := Min(Options.Rows, VisibleRows);
        //      Options.FScale := GetOptimalScale;
      end;
    smAutoScale:
      begin
        Options.FCols := TotalCols;
        Options.FRows := VisibleRows;
        FTotalRows := Max((PageCount div TotalCols) + Ord(PageCount mod TotalCols <> 0), 1);
      end;
    smColsRows:
      Options.FScale := GetOptimalScale;
  end;
end;

procedure TJvCustomPreviewControl.DoScrollHint(NewPos: Integer);
var
  S: string;
  HW: THintWindow;
  Pt: TPoint;
  R: TRect;
begin
  // stolen from SynEdit, thanks guys!
  if Assigned(FOnScrollHint) then
  begin
    S := '';
    FOnScrollHint(Self, NewPos, S);
    if S <> '' then
    begin
      HW := GetHintWindow;
      if not HW.Visible then
      begin
        HW.Color := Application.HintColor;
        HW.Visible := True;
      end;
      R := Rect(0, 0, HW.Canvas.TextWidth(S) + 6,
        HW.Canvas.TextHeight(S) + 4);
      GetCursorPos(Pt);
      Pt := ScreenToClient(Pt);
      Pt.X := ClientWidth - HW.Canvas.TextWidth(S) - 12;
      Pt := ClientToScreen(Pt);
      OffsetRect(R, Pt.X, Pt.Y - 4);
      HW.ActivateHint(R, S);
      HW.Invalidate;
      HW.Update;
    end;
  end;
end;

procedure TJvCustomPreviewControl.DrawShadow(ACanvas: TCanvas; APageRect: TRect);
var
  TmpRect: TRect;
  TmpColor: TColor;
begin
  TmpColor := ACanvas.Brush.Color;
  try
    ACanvas.Brush.Color := Options.Shadow.Color;
    if Options.Shadow.Offset <> 0 then
    begin
      // draw full background shadow if necessary
      if (Abs(Options.Shadow.Offset) >= (APageRect.Left - APageRect.Right)) or
        (Abs(Options.Shadow.Offset) >= (APageRect.Bottom - APageRect.Top)) then
      begin
        TmpRect := APageRect;
        OffsetRect(TmpRect, Options.Shadow.Offset, Options.Shadow.Offset);
        ACanvas.FillRect(TmpRect);
      end
        // draw two smaller rects (does this *really* reduce flicker?)
      else
      if Options.Shadow.Offset < 0 then
      begin
        // left side
        TmpRect := APageRect;
        TmpRect.Right := TmpRect.Left - Options.Shadow.Offset;
        OffsetRect(TmpRect, Options.Shadow.Offset, Options.Shadow.Offset);
        ACanvas.FillRect(TmpRect);
        // top side
        TmpRect := APageRect;
        TmpRect.Bottom := TmpRect.Top - Options.Shadow.Offset;
        OffsetRect(TmpRect, Options.Shadow.Offset, Options.Shadow.Offset);
        ACanvas.FillRect(TmpRect);
      end
      else
      begin
        // right side
        TmpRect := APageRect;
        TmpRect.Left := TmpRect.Right - Options.Shadow.Offset;
        OffsetRect(TmpRect, Options.Shadow.Offset, Options.Shadow.Offset);
        ACanvas.FillRect(TmpRect);
        // bottom side
        TmpRect := APageRect;
        TmpRect.Top := TmpRect.Bottom - Options.Shadow.Offset;
        OffsetRect(TmpRect, Options.Shadow.Offset, Options.Shadow.Offset);
        ACanvas.FillRect(TmpRect);
      end;
    end;
  finally
    ACanvas.Brush.Color := TmpColor;
  end;
end;

//=== { TDeactiveHintThread } ================================================

constructor TDeactiveHintThread.Create(Delay: Integer; HintWindow: THintWindow);
begin
  inherited Create(True);
  FreeOnTerminate := True;
  FHintWindow := HintWindow;
  FDelay := Delay;
  if FDelay = 0 then
    FDelay := Application.HintHidePause;
  Resume;
end;

procedure TDeactiveHintThread.Execute;
begin
  Sleep(FDelay);
  if FHintWindow <> nil then
  begin
    FHintWindow.Visible := False;
    FHintWindow.ActivateHint(Rect(0, 0, 0, 0), '');
    FHintWindow := nil;
  end;
  Terminate;
end;

procedure TJvCustomPreviewControl.SetSelection(const Value: TJvPreviewSelection);
begin
  FSelection.Assign(Value);
end;

//=== { TJvPreviewSelection } ================================================

constructor TJvPreviewSelection.Create;
begin
  inherited Create;
  FColor := clNavy;
  FWidth := 4;
  FVisible := True;
end;

procedure TJvPreviewSelection.Assign(Source: TPersistent);
begin
  if Source is TJvPreviewSelection then
  begin
    if Source = Self then
      Exit;
    FColor := TJvPreviewSelection(Source).Color;
    FWidth := TJvPreviewSelection(Source).Width;
    FVisible := TJvPreviewSelection(Source).Visible;
    Change;
  end
  else
    inherited Assign(Source);
end;

procedure TJvPreviewSelection.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TJvPreviewSelection.SetColor(const Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    Change;
  end;
end;

procedure TJvPreviewSelection.SetWidth(const Value: Integer);
begin
  if FWidth <> Value then
  begin
    FWidth := Value;
    Change;
  end;
end;

procedure TJvPreviewSelection.SetVisible(const Value: Boolean);
begin
  if FVisible <> Value then
  begin
    FVisible := Value;
    Change;
  end;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.