rm_desgn.pas

中小企业管理系统------ ERP系统原代码

  OnMouseMove := MMove;
  OnDblClick := DClick;
  OnDragOver := DoDragOver;
  OnDragDrop := DoDragDrop;
end;

procedure TRMDesignerPage.Init;
begin
  FDown := False; FDFlag := False; FRFlag := False;
  Cursor := crDefault; FCT := ctNone;
end;

procedure TRMDesignerPage.SetPage;
var
  Pgw, Pgh, Pgl, Pgt: Integer;
begin
  if (FDesigner = nil) or (FDesigner.Page = nil) then
    Exit;
  Pgw := FDesigner.Page.PrnInfo.Pgw;
  Pgh := FDesigner.Page.PrnInfo.Pgh;
  if FDesigner.FUnlimitedHeight then
    Pgh := Pgh * 3;
//  Pgt := 10;
//  if (Pgw > Parent.ClientWidth - 11) or (FDesigner.FPagePosition = alLeft) then
//    Pgl := 10
//  else if FDesigner.FPagePosition = alClient then
//    Pgl := (Parent.ClientWidth - Pgw) div 2
//  else
//    Pgl := Parent.ClientWidth - Pgw - 11;

  Pgt := 0; //FDesigner.pnlHorizontalRuler.Top + FDesigner.pnlHorizontalRuler.Height;
  Pgl := 0; //FDesigner.pnlVerticalRuler.Left + FDesigner.pnlVerticalRuler.Width;

  if FDesigner.PageType = ptDialog then
  begin
    if FDesigner.FPageForm <> nil then
      FDesigner.FPageForm.OnResize := nil;
    Align := alClient;
    if FDesigner.FPageForm <> nil then
      FDesigner.FPageForm.OnResize := FDesigner.PageFormResize;
  end
  else
  begin
    Align := alNone;
    SetBounds(Pgl, Pgt, Pgw, Pgh);
    TScrollBox(Parent).VertScrollBar.Range := Top + Height + 10;
    TScrollBox(Parent).HorzScrollBar.Range := Left + Width + 10;
  end;

  FDesigner.FHRuler.Scroll(FDesigner.FLastLeft);
  FDesigner.FVRuler.Scroll(FDesigner.FLastTop);
  FDesigner.FLastLeft := 0;
  FDesigner.FLastTop := 0;
  FDesigner.FHRuler.Width := Pgw + Screen.PixelsPerInch;
  FDesigner.FVRuler.Height := Pgh + Screen.PixelsPerInch;
end;

procedure TRMDesignerPage.WMEraseBackground(var Message: TMessage);
begin
end;

procedure TRMDesignerPage.Paint;
begin
  if Left <= 0 then
  begin
    FDesigner.FHRuler.Scroll(FDesigner.FLastLeft - Left);
  end;
  FDesigner.FLastLeft := Left;

  if Top <= 0 then
  begin
    FDesigner.FVRuler.Scroll(FDesigner.FLastTop - Top);
  end;
  FDesigner.FLastTop := Top;

  Draw(10000, 0);
end;

procedure TRMDesignerPage.NormalizeCoord(t: TRMView);
begin
  if t.dx < 0 then
  begin
    t.dx := -t.dx;
    t.x := t.x - t.dx;
  end;
  if t.dy < 0 then
  begin
    t.dy := -t.dy;
    t.y := t.y - t.dy;
  end;
end;

procedure TRMDesignerPage.NormalizeRect(var r: TRect);
var
  i: Integer;
begin
  with r do
  begin
    if Left > Right then
    begin
      i := Left; Left := Right; Right := i;
    end;
    if Top > Bottom then
    begin
      i := Top; Top := Bottom; Bottom := i;
    end;
  end;
end;

procedure TRMDesignerPage.DrawHSplitter(Rect: TRect);
begin
  with Canvas do
  begin
    Pen.Mode := pmXor;
    Pen.Color := clSilver;
    Pen.Width := 1;
    MoveTo(Rect.Left, Rect.Top);
    LineTo(Rect.Right, Rect.Bottom);
    Pen.Mode := pmCopy;
  end;
end;

procedure TRMDesignerPage.DrawRectLine(Rect: TRect);
begin
  with Canvas do
  begin
    Pen.Mode := pmNot;
    Pen.Style := psSolid;
    Pen.Width := Round(LastLineWidth);
    with Rect do
    begin
      if Abs(Right - Left) > Abs(Bottom - Top) then
      begin
        MoveTo(Left, Top);
        LineTo(Right, Top);
      end
      else
      begin
        MoveTo(Left, Top);
        LineTo(Left, Bottom);
      end;
    end;
    Pen.Mode := pmCopy;
  end;
end;

procedure TRMDesignerPage.DrawFocusRect(Rect: TRect);
begin
  with Canvas do
  begin
    Pen.Mode := pmXor;
    Pen.Color := clSilver;
    Pen.Width := 1;
    Pen.Style := psSolid;
    Brush.Style := bsClear;
    if (Rect.Right = Rect.Left + 1) or (Rect.Bottom = Rect.Top + 1) then
    begin
      if Rect.Right = Rect.Left + 1 then
        Dec(Rect.Right, 1)
      else
        Dec(Rect.Bottom, 1);
      MoveTo(Rect.Left, Rect.Top);
      LineTo(Rect.Right, Rect.Bottom);
    end
    else
      Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
    Pen.Mode := pmCopy;
    Brush.Style := bsSolid;
  end;
end;

procedure TRMDesignerPage.DrawSelection(t: TRMView);
var
  px, py: Word;

  procedure DrawPoint(x, y: Word);
  begin
    Canvas.MoveTo(x, y);
    Canvas.LineTo(x, y);
  end;

begin
  if t.Selected then
  begin
    with t, Canvas do
    begin
      Pen.Width := 5;
      Pen.Mode := pmXor;
      Pen.Color := clWhite;
      px := x + dx div 2;
      py := y + dy div 2;
      DrawPoint(x, y);
      if (dx <> 0) and (dy <> 0) then
      begin
        DrawPoint(x + dx, y);
        DrawPoint(x, y + dy);
      end;
      if Objects.IndexOf(t) = FRightBottom then
        Pen.Color := clTeal;
      DrawPoint(x + dx, y + dy);
      Pen.Color := clWhite;
      if (SelNum = 1) and (dx <> 0) and (dy <> 0) then
      begin
        DrawPoint(px, y); DrawPoint(px, y + dy);
        DrawPoint(x, py); DrawPoint(x + dx, py);
      end;
      Pen.Mode := pmCopy;
    end;
  end;
end;

procedure TRMDesignerPage.DrawShape(t: TRMView);
begin
  with t do
  begin
    if Selected then
      DrawFocusRect(Rect(x, y, x + dx + 1, y + dy + 1))
  end;
end;

type
  THackPage = class(TRMPage)
  end;

procedure TRMDesignerPage.Draw(N: Integer; ClipRgn: HRGN);
var
  i: Integer;
  t: TRMView;
  R, R1: HRGN;
  Objects: TList;
  c: TColor;
  bmp, Bmp1: TBitmap;
  liHavePic: Boolean;

  procedure DrawBackground;
  var
    i, j: Integer;
  begin
    with Canvas do
    begin
      c := clBlack;
      if FDesigner.ShowGrid and (FDesigner.GridSizeX <> 18) then
      begin
        with FDesigner.FGridBitmap.Canvas do
        begin
          if FDesigner.PageType = ptDialog then
            Brush.Color := FDesigner.Page.Color
          else
            Brush.Color := clWhite;
          FillRect(Rect(0, 0, 8, 8));
          Pixels[0, 0] := c;
          if FDesigner.GridSizeX = 4 then
          begin
            Pixels[4, 0] := c;
            Pixels[0, 4] := c;
            Pixels[4, 4] := c;
          end;
        end;
        Brush.Bitmap := FDesigner.FGridBitmap;
      end
      else
      begin
        if FDesigner.PageType = ptDialog then
          Brush.Color := FDesigner.Page.Color
        else
          Brush.Color := clWhite;
        Brush.Style := bsSolid;
      end;

      FillRgn(Handle, R, Brush.Handle);
      if FDesigner.ShowGrid and (FDesigner.GridSizeX = 18) then
      begin
        i := 0;
        while i < Width do
        begin
          j := 0;
          while j < Height do
          begin
            if RectVisible(Handle, Rect(i, j, i + 1, j + 1)) then
              SetPixel(Handle, i, j, c);
            Inc(j, FDesigner.GridSizeY);
          end;
          Inc(i, FDesigner.GridSizeX);
        end;
      end;
    end;
  end;

  procedure DrawbkGroundPic;
  var
    R: TRect;
    lPicWidth, lPicHeight: Integer;
  begin
    if liHavePic then
    begin
      with FDesigner.Page, THackPage(FDesigner.Page).FbkPicture do
      begin
        lPicWidth := bkPictureWidth;
        lPicHeight := bkPictureHeight;

        R := Rect(0, 0, lPicWidth, lPicHeight);
        OffsetRect(R, bkPictureLeft, bkPictureTop);
        RMPrintGraphic(Canvas, R, Graphic, False);
      end;
    end;
  end;

  procedure DrawMargins;
  var
    i, j: integer;
  begin
    with Canvas do
    begin
      Brush.Style := bsClear;
      Pen.Width := 1;
      Pen.Color := clGray;
      Pen.Style := psSolid;
      Pen.Mode := pmCopy;
      if FDesigner.PageType = ptReport then
      begin
        with FDesigner.Page do
        begin
          Rectangle(LeftMargin, TopMargin, RightMargin, BottomMargin);
          if ColCount > 1 then
          begin
            ColWidth := (RightMargin - LeftMargin - ((ColCount - 1) * ColGap)) div ColCount;
            Pen.Style := psDot;
            j := LeftMargin;
            for i := 1 to ColCount do
            begin
              Rectangle(j, -1, j + ColWidth + 1, PrnInfo.Pgh + 1);
              Inc(j, ColWidth + ColGap);
            end;
            Pen.Style := psSolid;
          end;
        end;
      end;
    end;
  end;

  function IsVisible(t: TRMView): Boolean;
  var
    R: HRGN;
  begin
    R := t.GetClipRgn(rtNormal);
    Result := CombineRgn(R, R, ClipRgn, RGN_AND) <> NULLREGION;
    DeleteObject(R);
  end;

  procedure DrawObject(t: TRMView; aCanvas: TCanvas);
  begin
    t.Draw(aCanvas);
    if (t.Script.Count > 0) or (t.Script_AfterPrint.Count > 0) then
      aCanvas.Draw(t.x + 1, t.y + 1, Bmp);
    if (t is TRMMemoView) and (TRMMemoView(t).HighlightStr <> '') then
      aCanvas.Draw(t.x + 1, t.y + 10, Bmp1);
  end;

begin
  if (FDesigner.Page = nil) or FDisableDraw then
    Exit;
  Bmp := TBitmap.Create;
  Bmp.LoadFromResourceName(hInstance, 'RM_SCRIPT');
  Bmp1 := TBitmap.Create;
  Bmp1.LoadFromResourceName(hInstance, 'RM_HIGHLIGHT');
  RM_Class.DocMode := dmDesigning;
  Objects := FDesigner.Page.Objects;
  if ClipRgn = 0 then
  begin
    with Canvas.ClipRect do
      ClipRgn := CreateRectRgn(Left, Top, Right, Bottom);
  end;

  liHavePic := (FDesigner.PageType = ptReport) and (THackPage(FDesigner.Page).FbkPicture <> nil) and (THackPage(FDesigner.Page).FbkPicture.Graphic <> nil);
  SetTextCharacterExtra(Canvas.Handle, 0);
  R := CreateRectRgn(0, 0, Width, Height);
  for i := Objects.Count - 1 downto 0 do
  begin
    t := Objects[i];
    if liHavePic and (t is TRMBandView) then
      Continue;
    if FDesigner.FirstInstance and (t.PChildView or THackView(t).FFlag1) then
    begin
      THackView(t).FFlag1 := False;
      Continue;
    end;

    if i <= N then
    begin
      if t.Selected then
        DrawObject(t, Canvas)
      else if IsVisible(t) then
      begin
        R1 := CreateRectRgn(0, 0, 1, 1);
        CombineRgn(R1, ClipRgn, R, RGN_AND);
        SelectClipRgn(Canvas.Handle, R1);
        DeleteObject(R1);
        DrawObject(t, Canvas);
      end;
    end;

    SetTextCharacterExtra(Canvas.Handle, 0);
    R1 := t.GetClipRgn(rtNormal);
    CombineRgn(R, R, R1, RGN_DIFF);
    DeleteObject(R1);
    SelectClipRgn(Canvas.Handle, R);
  end;
  CombineRgn(R, R, ClipRgn, RGN_AND);
  DrawBackground;
  DrawbkGroundPic;

  //WHF Add
  if liHavePic then
  begin
    for i := Objects.Count - 1 downto 0 do
    begin
      t := Objects[i];
      if not (t is TRMBandView) then
        Continue;
//    	if i <= N then
      DrawObject(t, Canvas)
    end;
  end;

  DeleteObject(R);
  DeleteObject(ClipRgn);
  SelectClipRgn(Canvas.Handle, 0);
  DrawMargins;
  if not FDown then
    DrawPage(dmSelection);
  Bmp.Free;
  Bmp1.Free;
end;

procedure TRMDesignerPage.DrawPage(DrawMode: TRMDesignerDrawMode);
var
  i: Integer;
  t: TRMView;
begin
  if RM_Class.DocMode <> dmDesigning then
    Exit;
  for i := 0 to Objects.Count - 1 do
  begin
    t := Objects[i];
    case DrawMode of
      dmAll: t.Draw(Canvas);
      dmSelection: DrawSelection(t);
      dmShape: DrawShape(t);
    end;
  end;
end;

function TRMDesignerPage.FindNearestEdge(var x, y: Integer): Boolean;
var
  i: Integer;
  t: TRMView;