dviewer.pas

来自「KSDev.BlockEngine.v3.03.rar 界面控件」· PAS 代码 · 共 1,449 行 · 第 1/3 页

  if not HandleAllocated then Exit;
  
  RecreateWnd;
  case FViewKind of
    vkPage:
      begin
        ViewX := PageX;
        ViewY := PageY;
      end;
    vkBlank:
      begin
        ViewX := 0;
        ViewY := 0;
      end;
  end;
  UpdateScrollBars;
  Invalidate;
end;

procedure TBlockViewer.UpdateScrollBars;
var
  ScrollInfo: TScrollInfo;
begin
  ScrollInfo.cbSize := SizeOf(ScrollInfo);
  ScrollInfo.fMask := SIF_ALL;

  { Horizontal }
  if FHScrollbar then
  begin
    if (Document <> nil) and (WorkWidth > ViewWidth) then
    begin
      ScrollInfo.nMin := 0;
      ScrollInfo.nMax := Round(WorkWidth * 100);
      ScrollInfo.nPage := Round(ViewWidth * 100);
      ScrollInfo.nPos := Round(ViewX * 100);
      SetScrollInfo(Handle, SB_HORZ, ScrollInfo, True);
    end
    else
    begin
      ShowScrollBar(Handle, SB_HORZ, false);
    end
  end
  else
    ShowScrollBar(Handle, SB_HORZ, false);

  { Vertical }
  if FVScrollbar then
  begin
    if (Document <> nil) and (WorkHeight > ViewHeight) then
    begin
      ScrollInfo.nMin := 0;
      ScrollInfo.nMax := Round(WorkHeight * 100);
      ScrollInfo.nPage := Round(ViewHeight * 100);
      ScrollInfo.nPos := Round(ViewY * 100);
      SetScrollInfo(Handle, SB_VERT, ScrollInfo, True);
    end
    else
    begin
      ShowScrollBar(Handle, SB_VERT, false);
    end;
  end
  else
    ShowScrollBar(Handle, SB_VERT, false);
end;

procedure TBlockViewer.Scroll(Dx, Dy: integer);
begin
  if Document = nil then Exit;
  if Graphics = nil then Exit;

  if Dx <> 0 then
  begin
    if Dx = MaxScroll then
      ViewX := WorkWidth - ViewWidth
    else
      if Dx = -MaxScroll then
        ViewX := 0
      else
        if Dx = -PageScroll then
          ViewX := ViewX - ViewWidth
        else
          if Dx = PageScroll then
            ViewX := ViewX + ViewWidth
          else
            ViewX := ViewX + Dx;

    if ViewX > WorkWidth - ViewWidth then
      ViewX := WorkWidth - ViewWidth;
    if ViewX < 0 then ViewX := 0;

    SetGraphics;
    UpdateScrollBars;
    Invalidate;
  end;

  if Dy <> 0 then
  begin
    if Dy = MaxScroll then
      ViewY := WorkHeight - ViewHeight
    else
      if Dy = -MaxScroll then
        ViewY := 0
      else
        if Dy = -PageScroll then
          ViewY := ViewY - ViewHeight
        else
          if Dy = PageScroll then
            ViewY := ViewY + ViewHeight
          else
            ViewY := ViewY + Dy;

    if ViewY > WorkHeight - ViewHeight then
      ViewY := WorkHeight - ViewHeight;
    if ViewY < 0 then ViewY := 0;

    SetGraphics;
    UpdateScrollBars;
    Invalidate;
  end;
end;

procedure TBlockViewer.ScrollTo(X, Y: integer);
begin
  if Document = nil then Exit;
  if Graphics = nil then Exit;

  if X <> 0 then
  begin
    ViewX := X / 100;

    if ViewX > WorkWidth - ViewWidth then
      ViewX := WorkWidth - ViewWidth;
    if ViewX < 0 then ViewX := 0;

    SetGraphics;
    UpdateScrollBars;
    Invalidate;
  end;

  if Y <> 0 then
  begin
    ViewY := Y / 100;

    if ViewY > WorkHeight - ViewHeight then
      ViewY := WorkHeight - ViewHeight;
    if ViewY < 0 then ViewY := 0;

    SetGraphics;
    UpdateScrollBars;
    Invalidate;
  end;
end;

procedure TBlockViewer.WMHScroll(var Message: TWMHScroll);
var
  ScrollInfo: TScrollInfo;
begin
  inherited ;
  case Message.ScrollCode of
    SB_TOP: Scroll(MaxScroll, 0);
    SB_BOTTOM: Scroll(-MaxScroll, 0);
    SB_LINEDOWN: Scroll(1, 0);
    SB_LINEUP: Scroll(-1, 0);
    SB_PAGEDOWN: Scroll(PageScroll, 0);
    SB_PAGEUP: Scroll(-PageScroll, 0);
    SB_THUMBPOSITION, SB_THUMBTRACK:
      begin
        ScrollInfo.cbSize := SizeOf(ScrollInfo);
        ScrollInfo.fMask := SIF_ALL;
        GetScrollInfo(Handle, SB_HORZ, ScrollInfo);
        ScrollTo(ScrollInfo.nTrackPos, 0);
      end;
  end;
  UpdateScrollBars;
end;

procedure TBlockViewer.WMVScroll(var Message: TWMVScroll);
var
  ScrollInfo: TScrollInfo;
begin
  inherited ;
  case Message.ScrollCode of
    SB_TOP: Scroll(0, MaxScroll);
    SB_BOTTOM: Scroll(0, -MaxScroll);
    SB_LINEDOWN: Scroll(0, 1);
    SB_LINEUP: Scroll(0, -1);
    SB_PAGEDOWN: Scroll(0, PageScroll);
    SB_PAGEUP: Scroll(0, -PageScroll);
    SB_THUMBPOSITION, SB_THUMBTRACK:
      begin
        ScrollInfo.cbSize := SizeOf(ScrollInfo);
        ScrollInfo.fMask := SIF_ALL;
        GetScrollInfo(Handle, SB_VERT, ScrollInfo);
        ScrollTo(0, ScrollInfo.nTrackPos);
      end;
  end;
  UpdateScrollBars;
end;

procedure TBlockViewer.Resize;
begin
  Scene.Width := Width + 30;
  Scene.Height := Height + 30;
  inherited;
  SetGraphics;
  UpdateScrollBars;
end;

procedure TBlockViewer.WMMouseWheel(var Msg: TWMMouseWheel);
const
  MOUSE_WHEEL_DELTA = 120;
var
  Dy, sl: integer;
begin
  inherited ;

  SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, @sl, SPIF_SENDCHANGE);
  if sl = 0 then sl := 1;
  Dy := Msg.WheelDelta div (MOUSE_WHEEL_DELTA div sl);

  if Dy > 0 then Dy := 1;
  if Dy < 0 then Dy := -1;
  Scroll(0, -Dy)
end;

procedure TBlockViewer.SetDocumentCopy(ADoc: BlockDocument);
var
  S: TMemoryStream;
begin
  S := TMemoryStream.Create;
  try
    ADoc.SaveToStream(S);
    S.Position := 0;
    LoadFromStream(S);
  finally
    S.Free;
  end;
end;

procedure TBlockViewer.SetBlockDocument(const Value: BlockDocument);
begin
  { Clear on old BlockDocument }
  if Document <> nil then
  begin
    Document.BlockRoot.OnRepaint := nil;
    FBlockDocument.Free;
  end;

  { Set new value }
  FBlockDocument := Value;
  if Document <> nil then
  begin
    Document.UnitType := FUnitType;
    if FGridVSize = 0 then
      FGridVSize := ConvertValue(Inch, DefaultGridSize, Document.UnitType)
    else
      FGridVSize := ConvertValue(UnitType, FGridVSize, Document.UnitType);
    if FGridHSize = 0 then
      FGridHSize := ConvertValue(Inch, DefaultGridSize, Document.UnitType)
    else
      FGridHSize := ConvertValue(UnitType, FGridHSize, Document.UnitType);

    { Set events }
    Document.BlockRoot.DesignState := Document.BlockRoot.DesignState - [dsDesignMode];
    Document.BlockRoot.OnRepaint := DoRepaintEvent;
    Document.BlockRoot.OnRepaintRect := DoRepaintRectEvent;
    Document.BlockRoot.OnGetGraphics := DoGetGraphics;
  end;
  SetGraphics;
  GridStep := FGridHSize;
  UpdateAll;
end;

procedure TBlockViewer.SetGridKind(const Value: TGridKind);
begin
  if FGridKind <> Value then
  begin
    FGridKind := Value;
    Invalidate;
  end;
end;

procedure TBlockViewer.SetGridHSize(const Value: Float);
begin
  if FGridHSize <> Value then
  begin
    FGridHSize := Value;
    Invalidate;
  end;
end;

procedure TBlockViewer.SetGridVSize(const Value: Float);
begin
  if FGridVSize <> Value then
  begin
    FGridVSize := Value;
    Invalidate;
  end;
end;

procedure TBlockViewer.SetScale(const Value: single);
begin
  if FScale <> Value then
  begin
    FScale := Value;
    UpdateAll;
  end;
end;

procedure TBlockViewer.SetShowGrid(const Value: boolean);
begin
  if FShowGrid <> Value then
  begin
    FShowGrid := Value;
    Invalidate;
  end;
end;

procedure TBlockViewer.SetShowRulers(const Value: boolean);
begin
  if FShowRulers <> Value then
  begin
    FShowRulers := Value;
    UpdateAll;
  end;
end;

procedure TBlockViewer.SetUnitType(const Value: UnitType);
begin
  if FUnitType <> Value then
  begin
    if not (csLoading in ComponentState) then
    begin
      FGridVSize := ConvertValue(FUnitType, FGridVSize, Value);
      FGridHSize := ConvertValue(FUnitType, FGridHSize, Value);
    end;

    if Document <> nil then
    begin
      Document.UnitType := Value;
      ViewX := ConvertValue(FUnitType, ViewX, Value);
      ViewY := ConvertValue(FUnitType, ViewY, Value);
      SetGraphics;
    end;
    FUnitType := Value;
    UpdateAll;
  end;
end;

procedure TBlockViewer.SetSmooth(const Value: boolean);
begin
  if FSmooth <> Value then
  begin
    FSmooth := Value;
    Invalidate;
  end;
end;

procedure TBlockViewer.SetViewKind(const Value: TViewKind);
begin
  if FViewKind <> Value then
  begin
    FViewKind := Value;
    UpdateAll;
  end;
end;

procedure TBlockViewer.LoadFromFile(AFileName: string);
var
  B: BlockDocument;
begin
  FreeAndNil(FBlockDocument);

  B := BlockDocument.Create(nil);
  B.LoadFromBinFile(AFileName);
  Document := B;
end;

procedure TBlockViewer.LoadFromStream(AStream: TStream);
var
  B: BlockDocument;
begin
  FreeAndNil(FBlockDocument);
  B := BlockDocument.Create(nil);
  B.LoadFromStream(AStream);
  Document := B;
end;

procedure TBlockViewer.LoadFromTextFile(AFileName: string);
var
  B: BlockDocument;
begin
  FDisableUpdate := true;
  try
    FreeAndNil(FBlockDocument);
    B := BlockDocument.Create(nil);
    B.LoadFromTextFile(AFileName);
    Document := B;
  finally
    FDisableUpdate := false;
  end;
end;

procedure TBlockViewer.SaveToFile(AFileName: string);
begin
  if Document <> nil then
    Document.SaveToBinFile(AFileName);
end;

procedure TBlockViewer.SaveToStream(AStream: TStream);
begin
  if Document <> nil then
    Document.SaveToStream(AStream);
end;

procedure TBlockViewer.SaveToTextFile(AFileName: string);
begin
  if Document <> nil then
    Document.SaveToTextFile(AFileName);
end;

function TBlockViewer.FindBlockByName(AName: WideString): Block;
begin
  Result := Document.BlockRoot.BlockByName(AName);
end;

function TBlockViewer.GetOrientation: PaperOrientation;
begin
  Result := Document.Paper.Orientation;
end;

function TBlockViewer.GetPaperKind: PaperKind;
begin
  Result := Document.Paper.Kind;
end;

procedure TBlockViewer.SetOrientation(const Value: PaperOrientation);
begin
  Document.Paper.Orientation := Value;
end;

procedure TBlockViewer.SetPaperKind(const Value: PaperKind);
var
  SaveUnit: ddoc.UnitType;
begin
  SaveUnit := Document.UnitType;
  Document.UnitType := Inch;
  Document.Paper.Kind := Value;
  Document.UnitType := SaveUnit;
end;

procedure TBlockViewer.SetBackgroundBlock(const Value: Block);
begin
  FBlockDocument.BlockRoot.BackBlock := Value;
  FBlockDocument.BlockRoot.DesignState := FBlockDocument.BlockRoot.DesignState - [dsFocused, dsSelected];
  Invalidate;
end;

function TBlockViewer.GetBackgroundBlock: Block;
begin
  Result := FBlockDocument.BlockRoot.BackBlock;
end;

procedure TBlockViewer.SetHScrollBar(const Value: boolean);
begin
  FHScrollbar := Value;
  if not (csLoading in ComponentState) then
    ShowScrollBar(Handle, SB_HORZ, Value);
end;

procedure TBlockViewer.SetVScrollBar(const Value: boolean);
begin
  FVScrollbar := Value;
  if not (csLoading in ComponentState) then
    ShowScrollBar(Handle, SB_VERT, Value);
end;

initialization
  {$IFDEF BlockTrial}
  ShowVersion2;
  {$ENDIF}
end.