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

📄 sputils.pas

📁 灰鸽子VIP1.2经典源代码
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    h := RBPt.Y - RTPt.Y;
    if not RS
    then
      begin
        YCnt := (NewRBPt.Y - NewRTPt.Y) div h;
        for Y := 0 to YCnt do
        begin
          if NewRTPt.Y + Y * h + h > NewRBPt.Y
          then YO := NewRTPt.Y + Y * h + h - NewRBPt.Y else YO := 0;
          CopyRect(Rect(NewClRect.Right, NewRTPt.Y + Y * h,
                    AW, NewRTPt.Y + Y * h + h - YO),
                   SB.Canvas,
                   Rect(R.Left + ClRect.Right, R.Top + RTPt.Y,
                   R.Right, R.Top + RBPt.Y - YO));
        end;
      end
    else
      begin
        Buffer := TBitMap.Create;
        Buffer.Width := RectWidth(R) - ClRect.Right;
        Buffer.Height := RBPt.Y - RTPt.Y;
        Rct := Rect(R.Left + ClRect.Right, R.Top + RTPt.Y,
                    R.Right, R.Top + RBPt.Y);
        Buffer.Canvas.CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height),
          SB.Canvas, Rct);
        SRct := Rect(NewClRect.Right, NewRTPt.Y, B.Width, NewRBPt.Y);
        StretchDraw(SRct, Buffer);
        Buffer.Free;
      end;

    // Draw corners
    // lefttop

    CopyRect(Rect(0, 0, NewLTPt.X, NewClRect.Top),
             SB.Canvas, Rect(R.Left, R.Top,
                             R.Left + LTPt.X, R.Top + ClRect.Top));

    CopyRect(Rect(0, NewClRect.Top, NewClRect.Left, NewLTPt.Y),
             SB.Canvas, Rect(R.Left, R.Top + ClRect.Top,
                             R.Left + ClRect.left, R.Top + LTPT.Y));

    //topright

    CopyRect(Rect(NewRTPt.X, 0, AW, NewClRect.Top), SB.Canvas,
             Rect(R.Left + RTPt.X, R.Top,  R.Right, R.Top + ClRect.Top));
    CopyRect(Rect(NewClRect.Right, NewClRect.Top, AW, NewRTPt.Y), SB.Canvas,
             Rect(R.Left + ClRect.Right, R.Top + ClRect.Top,
             R.Right, R.Top + RTPt.Y));

    //leftbottom

    CopyRect(Rect(0, NewLBPt.Y, NewClRect.Left, AH), SB.Canvas,
             Rect(R.Left, R.Top + LBPt.Y, R.Left + ClRect.Left, R.Bottom));

    CopyRect(Rect(NewClRect.Left, NewClRect.Bottom, NewLBPt.X, AH), SB.Canvas,
             Rect(R.Left + ClRect.Left, R.Top + ClRect.Bottom, R.Left + LBPt.X, R.Bottom));


    //rightbottom

    CopyRect(Rect(NewRBPt.X, NewClRect.Bottom, AW, AH), SB.Canvas,
             Rect(R.Left + RBPt.X, R.Top + ClRect.Bottom, R.Right, R.Bottom));

    CopyRect(Rect(NewClRect.Right, NewRBPt.Y, AW, NewClRect.Bottom), SB.Canvas,
             Rect(R.Left + ClRect.Right, R.Top + RBPt.Y,
                  R.Right, R.Top + ClRect.Bottom));

    //Draw client
    w := RectWidth(ClRect);
    h := RectHeight(ClRect);
    rw := RectWidth(NewClRect);
    rh := RectHeight(NewClRect);
    if DrawClient
    then
      begin
        // Draw client area
        XCnt := rw div w;
        YCnt := rh div h;
        for X := 0 to XCnt do
        for Y := 0 to YCnt do
        begin
          if X * w + w > rw then XO := X * W + W - rw else XO := 0;
          if Y * h + h > rh then YO := Y * h + h - rh else YO := 0;
          CopyRect(Rect(NewClRect.Left + X * w, NewClRect.Top + Y * h,
             NewClRect.Left + X * w + w - XO,
             NewClRect.Top + Y * h + h - YO),
             SB.Canvas,
             Rect(R.Left + ClRect.Left, R.Top + ClRect.Top,
             R.Left + ClRect.Right - XO,
             R.Top + ClRect.Bottom - YO));
         end;
    end;
  end;
end;
procedure CreateSkinImage;
var
  w, h, rw, rh: Integer;
  X, Y, XCnt, YCnt: Integer;
  XO, YO: Integer;
begin
  B.Width := AW;
  B.Height := AH;
  if (RBPt.X - LTPt.X  = 0) or
     (RBPt.Y - LTPt.Y = 0) or SB.Empty then  Exit;
  with B.Canvas do
  begin
    // Draw lines
    // top
    w := RTPt.X - LTPt.X;
    XCnt := (NewRTPt.X - NewLTPt.X) div (RTPt.X - LTPt.X);
    for X := 0 to XCnt do
    begin
      if NewLTPt.X + X * w + w > NewRTPt.X
      then XO := NewLTPt.X + X * w + w - NewRTPt.X else XO := 0;
      CopyRect(Rect(NewLTPt.X + X * w, 0, NewLTPt.X + X * w + w - XO, NewClRect.Top),
               SB.Canvas, Rect(R.Left + LTPt.X, R.Top,
                 R.Left + RTPt.X - XO, R.Top + ClRect.Top));
    end;
    // bottom
    w := RBPt.X - LBPt.X;
    XCnt := (NewRBPt.X - NewLBPt.X) div (RBPt.X - LBPt.X);
    for X := 0 to XCnt do
    begin
      if NewLBPt.X + X * w + w > NewRBPt.X
      then XO := NewLBPt.X + X * w + w - NewRBPt.X else XO := 0;
      CopyRect(Rect(NewLBPt.X + X * w, NewClRect.Bottom, NewLBPt.X + X * w + w - XO, AH),
               SB.Canvas, Rect(R.Left + LBPt.X, R.Top + ClRect.Bottom,
                 R.Left + RBPt.X - XO, R.Bottom));
    end;
    // left
    w := NewClRect.Left;
    h := LBPt.Y - LTPt.Y;
    YCnt := (NewLBPt.Y - NewLTPt.Y) div h;
    for Y := 0 to YCnt do
    begin
      if NewLTPt.Y + Y * h + h > NewLBPt.Y
      then YO := NewLTPt.Y + Y * h + h - NewLBPt.Y else YO := 0;
      CopyRect(Rect(0, NewLTPt.Y + Y * h, w, NewLTPt.Y + Y * h + h - YO),
               SB.Canvas,
               Rect(R.Left, R.Top + LTPt.Y, R.Left + w, R.Top + LBPt.Y - YO));
    end;
    // right
    h := RBPt.Y - RTPt.Y;
    YCnt := (NewRBPt.Y - NewRTPt.Y) div h;
    for Y := 0 to YCnt do
    begin
      if NewRTPt.Y + Y * h + h > NewRBPt.Y
      then YO := NewRTPt.Y + Y * h + h - NewRBPt.Y else YO := 0;
      CopyRect(Rect(NewClRect.Right, NewRTPt.Y + Y * h,
                    AW, NewRTPt.Y + Y * h + h - YO),
               SB.Canvas,
               Rect(R.Left + ClRect.Right, R.Top + RTPt.Y,
                 R.Right, R.Top + RBPt.Y - YO));
    end;

    // Draw corners
    // lefttop

    CopyRect(Rect(0, 0, NewLTPt.X, NewClRect.Top),
             SB.Canvas, Rect(R.Left, R.Top,
                             R.Left + LTPt.X, R.Top + ClRect.Top));

    CopyRect(Rect(0, NewClRect.Top, NewClRect.Left, NewLTPt.Y),
             SB.Canvas, Rect(R.Left, R.Top + ClRect.Top,
                             R.Left + ClRect.left, R.Top + LTPT.Y));

    //topright

    CopyRect(Rect(NewRTPt.X, 0, AW, NewClRect.Top), SB.Canvas,
             Rect(R.Left + RTPt.X, R.Top,  R.Right, R.Top + ClRect.Top));
    CopyRect(Rect(NewClRect.Right, NewClRect.Top, AW, NewRTPt.Y), SB.Canvas,
             Rect(R.Left + ClRect.Right, R.Top + ClRect.Top,
             R.Right, R.Top + RTPt.Y));

    //leftbottom

    CopyRect(Rect(0, NewLBPt.Y, NewClRect.Left, AH), SB.Canvas,
             Rect(R.Left, R.Top + LBPt.Y, R.Left + ClRect.Left, R.Bottom));

    CopyRect(Rect(NewClRect.Left, NewClRect.Bottom, NewLBPt.X, AH), SB.Canvas,
             Rect(R.Left + ClRect.Left, R.Top + ClRect.Bottom, R.Left + LBPt.X, R.Bottom));


    //rightbottom

    CopyRect(Rect(NewRBPt.X, NewClRect.Bottom, AW, AH), SB.Canvas,
             Rect(R.Left + RBPt.X, R.Top + ClRect.Bottom, R.Right, R.Bottom));

    CopyRect(Rect(NewClRect.Right, NewRBPt.Y, AW, NewClRect.Bottom), SB.Canvas,
             Rect(R.Left + ClRect.Right, R.Top + RBPt.Y,
                  R.Right, R.Top + ClRect.Bottom));

    //Draw client
    w := RectWidth(ClRect);
    h := RectHeight(ClRect);
    rw := RectWidth(NewClRect);
    rh := RectHeight(NewClRect);
    if DrawClient
    then
      begin
        // Draw client area
        XCnt := rw div w;
        YCnt := rh div h;
        for X := 0 to XCnt do
        for Y := 0 to YCnt do
        begin
          if X * w + w > rw then XO := X * W + W - rw else XO := 0;
          if Y * h + h > rh then YO := Y * h + h - rh else YO := 0;
          CopyRect(Rect(NewClRect.Left + X * w, NewClRect.Top + Y * h,
             NewClRect.Left + X * w + w - XO,
             NewClRect.Top + Y * h + h - YO),
             SB.Canvas,
             Rect(R.Left + ClRect.Left, R.Top + ClRect.Top,
             R.Left + ClRect.Right - XO,
             R.Top + ClRect.Bottom - YO));
         end;
    end;
  end;
end;

procedure CreateSkinMask;
var
  i, j, k: Integer;
  LWidth, TWidth, RWidth, BWidth: Integer;
  Ofs: Integer;
  W, H: Integer;
begin
  LWidth := ClRect.Left;
  TWidth := ClRect.Top;
  RWidth := FMask.Width - ClRect.Right;
  BWidth := FMask.Height - ClRect.Bottom;
  //left
  W := LWidth;
  H := RectHeight(NewClRect);
  if (W > 0) and (H > 0) then
  begin
  RMLeft.Width := W;
  RMLeft.Height := H;
  j := LBPt.Y - LTPt.Y;
  with RMLeft.Canvas do
  begin
    if j <> 0
    then
    for i := 0 to RMLeft.Height div j do
    begin
      if i * j + j > RMLeft.Height
      then Ofs := i * j + j - RMLeft.Height else Ofs := 0;
      CopyRect(Rect(0, i * j, LWidth, i * j + j - Ofs),
               FMask.Canvas,
               Rect(0, LTPt.Y, LWidth, LBPt.Y - Ofs));
    end;

    k := LTPt.Y - ClRect.Top;
    if k > 0 then
      CopyRect(Rect(0, 0, LWidth, k),
               FMask.Canvas,
               Rect(0, ClRect.Top, LWidth, LTPt.Y));

    k := ClRect.Bottom - LBPt.Y;
    if k > 0 then
      CopyRect(Rect(0, RMLeft.Height - k, LWidth, RMLeft.Height),
               FMask.Canvas,
               Rect(0, LBPt.Y, LWidth, ClRect.Bottom));
  end;
  end;
  //right
  W := RWidth;
  H := RectHeight(NewClRect);
  if (W > 0) and (H > 0) then
  begin
  RMRight.Width  := W;
  RMRight.Height := H;
  j := RBPt.Y - RTPt.Y;

  with RMRight.Canvas do
  begin
    if j <> 0 then 
    for i := 0 to RMRight.Height div j do
    begin
      if i * j + j > RMRight.Height
      then Ofs := i * j + j - RMRight.Height else Ofs := 0;
      CopyRect(Rect(0, i * j, RWidth, i * j + j - Ofs),
               FMask.Canvas,
               Rect(ClRect.Right, RTPt.Y, FMask.Width, RBPt.Y - Ofs));
    end;           

    k := RTPt.Y - ClRect.Top;
    if k > 0 then
      CopyRect(Rect(0, 0, RWidth, k),
               FMask.Canvas,
               Rect(FMask.Width - RWidth, ClRect.Top, FMask.Width, RTPt.Y));

    k := ClRect.Bottom - RBPt.Y;
    if k > 0 then
      CopyRect(Rect(0, RMRight.Height - k, RWidth, RMRight.Height),
               FMask.Canvas,
               Rect(FMask.Width - RWidth, RBPt.Y, FMask.Width, CLRect.Bottom));
  end;
  end;
  // top
  H := TWidth;
  W := AW;
  if (W > 0) and (H > 0) then
  begin
  j := RTPt.X - LTPt.X;
  RMTop.Height := H;
  RMTop.Width := W;

  with RMTop.Canvas do
  begin
    if j <> 0 then
    for i := 0 to RMTop.Width div j do
    begin
      if NewLTPt.X + i * j + j > NewRTPt.X
      then Ofs := NewLTPt.X + i * j + j - NewRTPt.X else Ofs := 0;
      CopyRect(Rect(NewLTPt.X + i * j, 0, NewLTPt.X + i * j + j - Ofs, TWidth),
               FMask.Canvas,
               Rect(LTPt.X, 0, RTPt.X - Ofs, TWidth));
    end;
    CopyRect(Rect(0, 0, LTPt.X, TWidth), FMask.Canvas,
             Rect(0, 0, LTPt.X, TWidth));
    CopyRect(Rect(NewRTPt.X, 0, RMTop.Width, TWidth), FMask.Canvas,
             Rect(RTPt.X, 0, FMask.Width, TWidth));
  end;
  end;
  // bottom
  W := AW;
  H := BWidth;
  if (W > 0) and (H > 0) then
  begin
  j := RBPt.X - LBPt.X;
  RMBottom.Height := H;
  RMBottom.Width := W;

  with RMBottom.Canvas do
  begin
    if j <> 0 then
    for i := 0 to RMBottom.Width div j do
    begin
      if NewLBPt.X + i * j + j > NewRBPt.X
      then Ofs := NewLBPt.X + i * j + j - NewRBPt.X else Ofs := 0;
      CopyRect(Rect(NewLBPt.X + i * j, 0, NewLBPt.X + i * j + j - Ofs, BWidth),
               FMask.Canvas,
               Rect(LBPt.X, ClRect.Bottom, RBPt.X - Ofs, FMask.Height));
    end;
    CopyRect(Rect(0, 0, LBPt.X, BWidth), FMask.Canvas,
             Rect(0, ClRect.Bottom, LBPt.X, FMask.Height));
    CopyRect(Rect(NewRBPt.X, 0, RMBottom.Width, BWidth), FMask.Canvas,
             Rect(RBPt.X, ClRect.Bottom, FMask.Width, FMask.Height));
  end;
  end;
end;

procedure CreateSkinSimplyRegion(var FRgn: HRgn; FMask: TBitMap);
var
  Size: Integer;
  RgnData: PRgnData;
begin
  Size := CreateRgnFromBmp(FMask, 0, 0, RgnData);
  FRgn := ExtCreateRegion(nil, Size, RgnData^);
  FreeMem(RgnData, Size);
end;

procedure CreateSkinRegion;
var
  RMTop, RMBottom, RMLeft, RMRight: TBitMap;
  Size: Integer;
  RgnData: PRgnData;
  R1, R2, R3, R4: HRGN;
begin
  if (NewLtPt.X > NewRTPt.X) or (NewLtPt.Y > NewLBPt.Y)
  then
    begin
      FRgn := 0;
      Exit;
    end;
  RMTop := TBitMap.Create;
  RMBottom := TBitMap.Create;
  RMLeft := TBitMap.Create;
  RMRight := TBitMap.Create;
  //
  CreateSkinMask(LTPt, RTPt, LBPt, RBPt, ClRect,
               NewLtPt, NewRTPt, NewLBPt, NewRBPt, NewClRect,
               FMask, RMTop, RMLeft, RMRight, RMBottom,
               AW, AH);
  //
  if (RMTop.Width > 0) and (RMTop.Height > 0) 
  then
    begin
      Size := CreateRgnFromBmp(RMTop, 0, 0, RgnData);
      R1 := ExtCreateRegion(nil, Size, RgnData^);
      FreeMem(RgnData, Size);
    end
  else
    R1 := 0;

  if (RMBottom.Width > 0) and (RMBottom.Height > 0)
  then
    begin
      Size := CreateRgnFromBmp(RMBottom, 0, NewClRect.Bottom, RgnData);
      R2 := ExtCreateRegion(nil, Size, RgnData^);
      FreeMem(RgnData, Size);
    end
  else
    R2 := 0;

  if (RMLeft.Width > 0) and (RMleft.Height > 0)
  then
    begin
      Size := CreateRgnFromBmp(RMLeft, 0, NewClRect.Top, RgnData);
      R3 := ExtCreateRegion(nil, Size, RgnData^);
      FreeMem(RgnData, Size);
    end
  else
    R3 := 0;

  if (RMRight.Width > 0) and (RMRight.Height > 0)
  then
    begin
      Size := CreateRgnFromBmp(RMRight, NewClRect.Right, NewClRect.Top, RgnData);
      R4 := ExtCreateRegion(nil, Size, RgnData^);
      FreeMem(RgnData, Size);
    end
  else
    R4 := 0;  

  if not isNullRect(NewClRect)
  then
    FRgn := CreateRectRgn(NewClRect.Left, NewClRect.Top,
                          NewClRect.Right, NewClRect.Bottom)
  else
    FRgn := 0;

  CombineRgn(R1, R1, R2, RGN_OR);
  CombineRgn(R3, R3, R4, RGN_OR);
  CombineRgn(R3, R3, R1, RGN_OR);

  CombineRgn(FRgn, FRgn, R3, RGN_OR);

  DeleteObject(R1);
  DeleteObject(R2);
  DeleteObject(R3);
  DeleteObject(R4);
  //
  RMTop.Free;
  RMBottom.Free;
  RMLeft.Free;

⌨️ 快捷键说明

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