⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 rm_dsgform.pas

📁 这是一个功能强大
💻 PAS
📖 第 1 页 / 共 5 页
字号:
end;

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

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

begin
  if not t.Selected then Exit;
  with t do
  begin
    Canvas.Pen.Width := 5;
    Canvas.Pen.Mode := pmXor;
    Canvas.Pen.Color := clWhite;
    px := spLeft_Designer + spWidth_Designer div 2;
    py := spTop_Designer + spHeight_Designer div 2;
    _DrawPoint(spLeft_Designer, spTop_Designer);
    _DrawPoint(spLeft_Designer + spWidth_Designer, spTop_Designer);
    _DrawPoint(spLeft_Designer, spTop_Designer + spHeight_Designer);
    _DrawPoint(spLeft_Designer + spWidth_Designer, spTop_Designer + spHeight_Designer);
    Canvas.Pen.Color := clWhite;
    if FDesignerForm.SelNum = 1 then
    begin
      _DrawPoint(px, spTop_Designer);
      _DrawPoint(px, spTop_Designer + spHeight_Designer);
      _DrawPoint(spLeft_Designer, py);
      _DrawPoint(spLeft_Designer + spWidth_Designer, py);
    end;
    Canvas.Pen.Mode := pmCopy;
  end;
end;

procedure TRMWorkSpace.DrawShape(t: TRMView);
begin
  if t.Selected then
  begin
    with t do
    begin
      if FPageEditor.FShapeMode = smFrame then
        DrawFocusRect(Rect(spLeft_Designer, spTop_Designer, spLeft_Designer + spWidth_Designer + 1, spTop_Designer + spHeight_Designer + 1))
      else
      begin
        with Canvas do
        begin
          Pen.Width := 1;
          Pen.Mode := pmNot;
          Brush.Style := bsSolid;
          Rectangle(spLeft_Designer, spTop_Designer, spLeft_Designer + spWidth_Designer + 1, spTop_Designer + spHeight_Designer + 1);
          Pen.Mode := pmCopy;
        end;
      end;
    end;
  end;
end;

procedure TRMWorkSpace.DrawObject(t: TRMView);
var
  lBmp: TBitmap;
begin
  t.Draw(Canvas);
  if THackView(t).HaveEventProp then
    Canvas.Draw(t.spLeft_Designer + 1, t.spTop_Designer + 1, FBmp_Event);

  if (t is TRMCustomMemoView) and (TRMCustomMemoView(t).Highlight.Condition <> '') then
    Canvas.Draw(t.spLeft_Designer + 1 + 8, t.spTop_Designer + 1, FBmp_HighLight);

  if RM_Class.RMShowDropDownField and (FCurrentView = t) then
  begin
    lBmp := TBitmap.Create;
    try
      lBmp.LoadFromResourceName(hInstance, 'RM_DropDownField');
      Canvas.Draw(FCurrentView.spRight_Designer - 16, FCurrentView.spTop_Designer + 1, lBmp);
    finally
      lBmp.Free;
    end;
  end;
end;

procedure TRMWorkSpace.DrawRect(aView: TRMView);
  var
    i: Integer;
    t: TRMView;
    lObjects: TList;
  begin
    //DrawObject(aView);
    lObjects := THackPage(FDesignerForm.Page).Objects;
    for i := 0 to lObjects.Count - 1 do
    begin
      t := lObjects[i];
      if (t = aView) or
        ((t.spRight_Designer <= aView.spRight_Designer) and (t.spRight_Designer >= aView.spLeft_Designer)) or
        ((t.spLeft_Designer >= aView.spLeft_Designer) and (t.spLeft_Designer <= aView.spRight_Designer)) or
        ((t.spBottom_Designer >= aView.spTop_Designer) and (t.spBottom_Designer <= aView.spBottom_Designer)) or
        ((t.spTop_Designer >= aView.spTop_Designer) and (t.spTop_Designer <= aView.spBottom_Designer)) then
        DrawObject(t);
    end;
  end;

procedure TRMWorkSpace.Draw(N: Integer; aClipRgn: HRGN);
var
  i: Integer;
  t: TRMView;
  R, R1: HRGN;
  lObjects: TList;
  lHavePic: Boolean;

  procedure _DrawBackground;
  var
    i, j: Integer;
    lDefaultColor: TColor;
  begin
    lDefaultColor := clBlack;
    with Canvas do
    begin
      Brush.Bitmap := nil;
      if FDesignerForm.ShowGrid and (FDesignerForm.GridSize <> 18) then
      begin
        with FPageEditor.FGridBitmap.Canvas do
        begin
          if FDesignerForm.Page is TRMDialogPage then
            Brush.Color := TRMDialogPage(FDesignerForm.Page).Color
          else
            Brush.Color := FDesignerForm.WorkSpaceColor;
          FillRect(Rect(0, 0, 8, 8));
          Pixels[0, 0] := lDefaultColor;
          if FDesignerForm.GridSize = 4 then
          begin
            Pixels[4, 0] := lDefaultColor;
            Pixels[0, 4] := lDefaultColor;
            Pixels[4, 4] := lDefaultColor;
          end;
        end;
        Brush.Bitmap := FPageEditor.FGridBitmap;
      end
      else
      begin
        if FDesignerForm.Page is TRMDialogPage then
          Brush.Color := TRMDialogPage(FDesignerForm.Page).Color
        else
          Brush.Color := FDesignerForm.WorkSpaceColor;
        Brush.Style := bsSolid;
      end;

      FillRgn(Handle, R, Brush.Handle);
      if FDesignerForm.ShowGrid and (FDesignerForm.GridSize = 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, lDefaultColor);
            Inc(j, FDesignerForm.GridSize);
          end;
          Inc(i, FDesignerForm.GridSize);
        end;
      end;
    end;
  end;

  procedure _DrawbkGroundPic; // 背景图片
  var
    liRect: TRect;
    lPicWidth, lPicHeight: Integer;
  begin
    if lHavePic then
    begin
      with THackReportPage(FDesignerForm.Page).FbkPicture do
      begin
        lPicWidth := Round(TRMReportPage(FDesignerForm.Page).bkPictureWidth * FDesignerForm.Factor / 100);
        lPicHeight := Round(TRMReportPage(FDesignerForm.Page).bkPictureHeight * FDesignerForm.Factor / 100);
        liRect := Rect(0, 0, lPicWidth, lPicHeight);
        OffsetRect(liRect, -Round(TRMReportPage(FDesignerForm.Page).spMarginLeft * FDesignerForm.Factor / 100),
          -Round(TRMReportPage(FDesignerForm.Page).spMarginTop * FDesignerForm.Factor / 100));
        OffsetRect(liRect, Round(TRMReportPage(FDesignerForm.Page).spBackGroundLeft * FDesignerForm.Factor / 100),
          Round(TRMReportPage(FDesignerForm.Page).spBackGroundTop * FDesignerForm.Factor / 100));
        RMPrintGraphic(Canvas, liRect, Graphic, False, True, False);
      end;
    end;
  end;

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

  procedure _DrawMargins;
  var
    i, j, lColumnWidth: Integer;
  begin
    with Canvas do
    begin
      Brush.Style := bsClear;
      Pen.Width := 1;
      Pen.Color := clGray;
      Pen.Style := psSolid;
      Pen.Mode := pmCopy;
      if FDesignerForm.Page is TRMReportPage then
      begin
        Rectangle(0, 0, Width, Height);
        with TRMReportPage(FDesignerForm.Page) do
        begin
          if ColumnCount > 1 then
          begin
            lColumnWidth := (Width - ((ColumnCount - 1) * spColumnGap)) div ColumnCount;
            Pen.Style := psDot;
            j := 0;
            for i := 1 to ColumnCount do
            begin
              Rectangle(j, 0, j + lColumnWidth + 1, Height);
              j := j + lColumnWidth + spCOlumnGap;
            end;
            Pen.Style := psSolid;
          end;
        end;
      end;
    end;
  end;

begin
  FCurrentView := nil;
  if (FDesignerForm.Page = nil) or FDisableDraw then Exit;

  FDesignerForm.Report.DocMode := rmdmDesigning;
  lObjects := THackPage(FDesignerForm.Page).Objects;
  if aClipRgn = 0 then
  begin
    with Canvas.ClipRect do
      aClipRgn := CreateRectRgn(Left, Top, Right, Bottom);
  end;

  lHavePic := (FDesignerForm.Page is TRMReportPage) and (THackReportPage(FDesignerForm.Page).FbkPicture <> nil) and
    (THackReportPage(FDesignerForm.Page).FbkPicture.Graphic <> nil);
  SetTextCharacterExtra(Canvas.Handle, 0);
  R := CreateRectRgn(0, 0, Width, Height);
  for i := lObjects.Count - 1 downto 0 do
  begin
    t := lObjects[i];
    if lHavePic and t.IsBand then Continue;

    if THackView(t).IsChildView then
    begin
      Continue;
    end;

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

    SetTextCharacterExtra(Canvas.Handle, 0);
    R1 := t.GetClipRgn(rmrtNormal);
    CombineRgn(R, R, R1, RGN_DIFF);
    DeleteObject(R1);
    SelectClipRgn(Canvas.Handle, R);
  end;

  CombineRgn(R, R, aClipRgn, RGN_AND);
  _DrawBackground;
  _DrawbkGroundPic;

  if lHavePic then
  begin
    for i := lObjects.Count - 1 downto 0 do
    begin
      t := lObjects[i];
      //      if not t.IsBand then
      DrawObject(t);
    end;
  end;

  DeleteObject(R);
  DeleteObject(aClipRgn);
  SelectClipRgn(Canvas.Handle, 0);
  _DrawMargins;
  if not FMouseButtonDown then
  begin
    DrawPage(dmSelection);
  end;
end;

procedure TRMWorkSpace.DrawPage(aDrawMode: TRMDesignerDrawMode);
var
  i: Integer;
  t: TRMView;
begin
  if FDesignerForm.Report.DocMode <> rmdmDesigning then Exit;
  for i := 0 to FDesignerForm.PageObjects.Count - 1 do
  begin
    t := FDesignerForm.PageObjects[i];
    case aDrawMode of
      dmAll: t.Draw(Canvas);
      dmSelection: DrawSelection(t);
      dmShape: DrawShape(t);
    end;
  end;
end;

procedure TRMWorkSpace.RedrawPage;
begin
  Draw(10000, 0);
end;

procedure TRMWorkSpace.DoDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var
  kx, ky: Integer;
begin
  Accept := (Source = FDesignerForm.FieldForm.lstFields) and
    (FDesignerForm.DesignerRestrictions * [rmdrDontCreateObj] = []) and
    (FDesignerForm.Page is TRMReportPage);
  if not Accept then Exit;

  if not FDragFlag then
  begin
    FDragFlag := True;
    FPageEditor.GetDefaultSize(kx, ky);
    RM_OldRect := Rect(x - 4, y - 4, x + kx - 4, y + ky - 4);
  end
  else
    DrawFocusRect(RM_OldRect);

  RoundCoord(x, y);
  OffsetRect(RM_OldRect, x - RM_OldRect.Left - 4, y - RM_OldRect.Top - 4);
  DrawFocusRect(RM_OldRect);
end;

procedure TRMWorkSpace.DoDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  t: TRMView;
begin
  FDragFlag := False;
  DrawPage(dmSelection);
  FDesignerForm.UnSelectAll;
  FPageEditor.ToolbarComponent.FSelectedObjIndex := rmgtMemo;
  FPageEditor.ToolbarComponent.FBtnMemoView.Down := True;
  Cursor := crCross;
  OnMouseUpEvent(nil, mbLeft, [], 0, 0);
  t := FDesignerForm.PageObjects[FDesignerForm.TopSelected];
  t.Memo.Text := '[' + FDesignerForm.FieldForm.DBField + ']';
  if t is TRMCustomMemoView then
    TRMCustomMemoView(t).DBFieldOnly := True;

  DrawSelection(t);
  t.Draw(Canvas);
  DrawSelection(t);
end;

procedure TRMWorkSpace.CopyToClipboard;
var
  hMem: THandle;
  pMem: pointer;
  lStream: TMemoryStream;

  procedure _SelectionToMemStream(aStream: TMemoryStream);
  var
    i, liNum: Integer;
    t: TRMView;
  begin
    aStream.Clear;
    RMWriteInt32(aStream, 0);
    liNum := 0;
    for i := 0 to FDesignerForm.Page.PageObjects.Count - 1 do
    begin
      t := FDesignerForm.Page.PageObjects[i];
      if t.Selected then
      begin
        RMWriteByte(aStream, t.ObjectType);
        RMWriteString(aStream, t.ClassName);
        THackView(t).StreamMode := rmsmDesigning;
        t.SaveToStream(aStream);
        Inc(liNum);
      end;
    end;

    aStream.Position := 0;
    RMWriteInt32(aStream, liNum);
    aStream.Seek(0, soFromEnd);
  end;

begin
  lStream := TMemoryStream.Create;
  try
    _SelectionToMemStream(lStream);
    ClipBoard.Open;
    try
      lStream.Position := 0;
      hMem := GlobalAlloc(GMEM_MOVEABLE + GMEM_SHARE + GMEM_ZEROINIT, lStream.Size);
      if hMem <> 0 then
      begin
        pMem := GlobalLock(hMem);
        if pMem <> nil then
        begin
          CopyMemory(pMem, lStream.Memory, lStream.Size);
          GlobalUnLock(hMem);
          ClipBoard.SetAsHandle(CF_REPORTMACHINE, hMem);
        end;
      

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -