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

📄 sputils.~pas

📁 DynamicSkinForm Finial 6.85_完全汉化版_for CB_D5-9 特点: 完全source 完全汉化真正奉献! 本汉化只供研究和学习用
💻 ~PAS
📖 第 1 页 / 共 5 页
字号:
  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;
  RMRight.Free;
end;

procedure DrawGlyph;
var
  B: TBitMap;
  gw, gh: Integer;
  GR: TRect;
begin
  if FGlyph.Empty then Exit;
  gw := FGlyph.Width div FNumGlyphs;
  gh := FGlyph.Height;
  B := TBitMap.Create;
  B.Width := gw;
  B.Height := gh;
  GR := Rect(gw * (FGlyphNum - 1), 0, gw * FGlyphNum, gh);
  B.Canvas.CopyRect(Rect(0, 0, gw, gh), FGlyph.Canvas, GR);
  B.Transparent := True;
  Cnvs.Draw(X, Y, B);
  B.Free;
end;

procedure CreateSkinBorderImages;
var
  XCnt, YCnt, i, X, Y, XO, YO, w, h: Integer;
  TB: TBitMap;
  TR, TR1: TRect;
begin
  // top
  w := AW;
  h := NewClRect.Top;
  if (w > 0) and (h > 0) and (RTPt.X - LTPt.X > 0)
  then
    begin
      TopB.Width := w;
      TopB.Height := h;
      w := RTPt.X - LTPt.X;
      XCnt := TopB.Width div w;
      if TS
      then
        begin
          TB := TBitMap.Create;
          TR := Rect(R.Left + LTPt.X, R.Top,
                     R.Left + RTPt.X, R.Top + h);
          TR1 := Rect(NewLTPt.X, 0, NewRTPt.X, h);
          TB.Width := RectWidth(TR);
          TB.Height := RectHeight(TR);
          TB.Canvas.CopyRect(Rect(0, 0, TB.Width, TB.Height),
          SB.Canvas, TR);
          TopB.Canvas.StretchDraw(TR1, TB);
          TB.Free;
        end
      else
        for X := 0 to XCnt do
        begin
          if X * w + w > TopB.Width
          then XO := X * w + w -  TopB.Width else XO := 0;
          with TopB.Canvas do
          begin
            CopyRect(Rect(X * w, 0, X * w + w - XO, h),
                     SB.Canvas,
                     Rect(R.Left + LTPt.X, R.Top,
                     R.Left + RTPt.X - XO, R.Top + h));
          end;
        end;
      with TopB.Canvas do
      begin
        CopyRect(Rect(0, 0, NewLTPt.X, h), SB.Canvas,
                 Rect(R.Left, R.Top, R.Left + LTPt.X, R.Top + h));
        CopyRect(Rect(NewRTPt.X, 0, TopB.Width, h), SB.Canvas,
                 Rect(R.Left + RTPt.X, R.Top, R.Right, R.Top + h));
      end;
    end;

  // bottom
  w := AW;
  h := AH - NewClRect.Bottom;
  if (w > 0) and (h > 0) and (RBPt.X - LBPt.X > 0)
  then
    begin
      BottomB.Width := w;
      BottomB.Height := h;
      w := RBPt.X - LBPt.X;
      XCnt := BottomB.Width div w;
      if BS
      then
        begin
          TB := TBitMap.Create;
          TR := Rect(R.Left + LBPt.X, R.Bottom - h,
                          R.Left + RBPt.X, R.Bottom);
          TR1 := Rect(NewLBPt.X, 0, NewRBPt.X, h);
          TB.Width := RectWidth(TR);
          TB.Height := RectHeight(TR);
          TB.Canvas.CopyRect(Rect(0, 0, TB.Width, TB.Height),
          SB.Canvas, TR);
          BottomB.Canvas.StretchDraw(TR1, TB);
          TB.Free;
        end
      else
      for X := 0 to XCnt do
      begin
        if X * w + w > BottomB.Width
        then XO := X * w + w -  BottomB.Width else XO := 0;
          with BottomB.Canvas do
          begin
            CopyRect(Rect(X * w, 0, X * w + w - XO, h),
                     SB.Canvas,
                     Rect(R.Left + LBPt.X, R.Bottom - h,
                          R.Left + RBPt.X - XO, R.Bottom));
          end;
      end;
      with BottomB.Canvas do
      begin
        CopyRect(Rect(0, 0, NewLBPt.X, h), SB.Canvas,
                 Rect(R.Left, R.Bottom - h, R.Left + LBPt.X, R.Bottom));
        CopyRect(Rect(NewRBPt.X, 0, BottomB.Width, h), SB.Canvas,
                 Rect(R.Left + RBPt.X, R.Bottom - h, R.Right, R.Bottom));
      end;
    end;
  // draw left
  h := AH - BottomB.Height - TopB.Height;
  w := NewClRect.Left;
  if (w > 0) and (h > 0) and (LBPt.Y - LTPt.Y > 0)
  then
    begin
      LeftB.Width := w;
      LeftB.Height := h;
      h := LBPt.Y - LTPt.Y;
      YCnt := LeftB.Height div h;
      if LS
      then
        begin
          TB := TBitMap.Create;
          TR := Rect(R.Left, R.Top + LTPt.Y,
                     R.Left + w, R.Top + LBPt.Y);
          TR1 := Rect(0, LTPt.Y - ClRect.Top, w,
                      LeftB.Height - (ClRect.Bottom - LBPt.Y));
          TB.Width := RectWidth(TR);
          TB.Height := RectHeight(TR);
          TB.Canvas.CopyRect(Rect(0, 0, TB.Width, TB.Height),
          SB.Canvas, TR);
          LeftB.Canvas.StretchDraw(TR1, TB);
          TB.Free;
        end
      else
      for Y := 0 to YCnt do
      begin
        if Y * h + h > LeftB.Height
        then YO := Y * h + h - LeftB.Height else YO := 0;
        with LeftB.Canvas do
          CopyRect(Rect(0, Y * h, w, Y * h + h - YO),
                   SB.Canvas,
                   Rect(R.Left, R.Top + LTPt.Y, R.Left + w, R.Top + LBPt.Y - YO));
      end;
      with LeftB.Canvas do
      begin
        YO := LTPt.Y - ClRect.Top;
        if YO > 0
        then
          CopyRect(Rect(0, 0, w, YO), SB.Canvas,
                   Rect(R.Left, R.Top + ClRect.Top,
                   R.Left + w, R.Top + LTPt.Y));
        YO :=  ClRect.Bottom - LBPt.Y;
        if YO > 0
        then
          CopyRect(Rect(0, LeftB.Height - YO, w, LeftB.Height),
                   SB.Canvas,
                   Rect(R.Left, R.Top + LBPt.Y,
                   R.Left + w, R.Top + ClRect.Bottom));
      end;
    end;
   // draw right
  h := AH - BottomB.Height - TopB.Height;
  w := AW - NewClRect.Right;
  if (w > 0) and (h > 0) and (RBPt.Y - RTPt.Y > 0)
  then
    begin
      RightB.Width := w;
      RightB.Height := h;
      h := RBPt.Y - RTPt.Y;
      YCnt := RightB.Height div h;
      if RS
      then
        begin
          TB := TBitMap.Create;
          TR := Rect(R.Left + ClRect.Right, R.Top + RTPt.Y,
                                R.Right, R.Top + RBPt.Y);
          TR1 := Rect(0, RTPt.Y - ClRect.Top, w,
                      RightB.Height - (ClRect.Bottom - RBPt.Y));
          TB.Width := RectWidth(TR);
          TB.Height := RectHeight(TR);
          TB.Canvas.CopyRect(Rect(0, 0, TB.Width, TB.Height),
          SB.Canvas, TR);
          RightB.Canvas.StretchDraw(TR1, TB);
          TB.Free;
        end
      else
      for Y := 0 to YCnt do
      begin
        if Y * h + h > RightB.Height
        then YO := Y * h + h - RightB.Height else YO := 0;
        with RightB.Canvas do
        CopyRect(Rect(0, Y * h, w, Y * h + h - YO),
                 SB.Canvas,
                 Rect(R.Left + ClRect.Right, R.Top + RTPt.Y,
                      R.Right, R.Top + RBPt.Y - YO));
      end;
      with RightB.Canvas do
      begin
        YO := RTPt.Y - ClRect.Top;
        if YO > 0
        then
          CopyRect(Rect(0, 0, w, YO), SB.Canvas,
                   Rect(R.Left + ClRect.Right, R.Top + ClRect.Top,
                   R.Right, R.Top + RTPt.Y));
                  
        YO :=  ClRect.Bottom - RBPt.Y;
        if YO > 0
        then
          CopyRect(Rect(0, RightB.Height - YO, w, RightB.Height),
                   SB.Canvas,
                   Rect(R.Left + ClRect.Right, R.Top + RBPt.Y,
                        R.Right, R.Top + ClRect.Bottom));
      end;
    end;
end;

procedure DrawRCloseImage(C: TCanvas; R: TRect; Color: TColor);
var
  X, Y: Integer;
begin
  X := R.Left + RectWidth(R) div 2 - 5;
  Y := R.Top + RectHeight(R) div 2 - 5;
  DrawCloseImage(C, X, Y, Color);
end;


procedure DrawCloseImage(C: TCanvas; X, Y: Integer; Color: TColor);
begin
  with C do
  begin
    Pen.Color := Color;
    MoveTo(X + 1, Y + 1); LineTo(X + 9, Y + 9);
    MoveTo(X + 9, Y + 1); LineTo(X + 1, Y + 9);
    MoveTo(X + 2, Y + 1); LineTo(X + 10, Y + 9);
    MoveTo(X + 8, Y + 1); LineTo(X, Y + 9);
  end;
end;

procedure DrawSysMenuImage(C: TCanvas; X, Y: Integer; Color: TColor);
begin
  with C do
  begin                
    Pen.Color := Color;
    Brush.Style := bsClear;
    Rectangle(X + 1, Y + 3, X + 9, Y + 6);
  end;
end;

procedure DrawMinimizeImage(C: TCanvas; X, Y: Integer; Color: TColor);
begin
  with C do
  begin
    Pen.Color := Color;
    MoveTo(X + 1, Y + 8); LineTo(X + 9, Y + 8);
    MoveTo(X + 1, Y + 9); LineTo(X + 9, Y + 9);
  end;
end;

procedure DrawMaximizeImage(C: TCanvas; X, Y: Integer; Color: TColor);
begin
  with C do
  begin
    Brush.Style := bsClear;
    Pen.Color := Color;
    Rectangle(X, Y, X + 11, Y + 10);
    Rectangle(X, Y, X + 11, Y + 2);
  end;
end;

procedure DrawRestoreImage(C: TCanvas; X, Y: Integer; Color: TColor);
begin
  with C do
  begin
    Brush.Style := bsClear;
    Pen.Color := Color;
    Rectangle(X + 2, Y, X + 10, Y + 6);
    Rectangle(X + 2, Y, X + 10, Y + 2);
    Rectangle(X, Y + 4, X + 7, Y + 10);
    Rectangle(X, Y + 4, X + 7, Y + 6);
  end;
end;

procedure DrawRestoreRollUpImage(C: TCanvas; X, Y: Integer; Color: TColor);
begin
  with C do
  begin
    Pen.Color := Color;
    MoveTo(X + 5, Y + 6); LineTo(X + 5, Y + 6);
    MoveTo(X + 4, Y + 5); LineTo(X + 6, Y + 5);
    MoveTo(X + 3, Y + 4); LineTo(X + 7, Y + 4);
    MoveTo(X + 2, Y + 3); LineTo(X + 8, Y + 3);
    MoveTo(X + 1, Y + 2); LineTo(X + 9, Y + 2);
  end;
end;


proc

⌨️ 快捷键说明

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