bsutils.pas

delphi 皮肤控件

    end;
  end;
end;


procedure CreateVSkinImage;
var
  Y, YCnt, h, YO: Integer;
  R1: TRect;
  Buffer: TBitMap;
begin
  B.Width := RectWidth(R);
  B.Height := AH;
  with B.Canvas do
  begin
    if TpO <> 0 then
       CopyRect(Rect(0, 0, B.Width, TpO), SB.Canvas,
                Rect(R.Left, R.Top, R.Right, R.Top + TpO));
    if BO <> 0 then
       CopyRect(Rect(0, B.Height - BO, B.Width, B.Height),
                SB.Canvas,
                Rect(R.Left, R.Bottom - BO, R.Right, R.Bottom));
    Inc(R.Top, TpO);
    Dec(R.Bottom, BO);
    h := RectHeight(R);
    if H <> 0
    then
      YCnt := (B.Height - TpO - BO) div h
    else
      YCnt := 0;
    if AStretch
    then
      begin
        Buffer := TBitMap.Create;
        Buffer.Width := RectWidth(R);
        Buffer.Height := RectHeight(R);
        Buffer.Canvas.CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height),
         SB.Canvas, R);
        R1 := Rect(0, TpO, B.Width, B.Height - BO);
        B.Canvas.StretchDraw(R1, Buffer);
        Buffer.Free;
      end
    else
    for Y := 0 to YCnt do
    begin
      if TpO + Y * h + h > B.Height - BO
      then YO := TpO + Y * h + h - (B.Height - BO)
      else YO := 0;
      B.Canvas.CopyRect(
        Rect(0, TpO + Y * h, B.Width, TpO + Y * h + h - YO),
        SB.Canvas,
        Rect(R.Left, R.Top, R.Right, R.Bottom - YO));
    end;
  end;
end;

procedure CreateSkinImageBS;
var
  w, h, rw, rh: Integer;
  X, Y, XCnt, YCnt: Integer;
  XO, YO: Integer;
  Rct, SRct: TRect;
  Buffer, Buffer2: TBitMap;
  SaveIndex: 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
    if not TS
    then
      begin
        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;
      end
    else
      begin
        Buffer := TBitMap.Create;
        Buffer.Width := RTPt.X - LTPt.X;
        Buffer.Height := CLRect.Top;
        Rct := Rect(R.Left + LTPt.X, R.Top, R.Left + RTPt.X, R.Top + CLRect.Top);
        Buffer.Canvas.CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height),
          SB.Canvas, Rct);
        SRct := Rect(NewLTPt.X, 0, NewRTPt.X, NewCLRect.Top);
        StretchDraw(SRct, Buffer);
        Buffer.Free;
      end;
    // bottom
    if not BS
    then
      begin
        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;             
      end
    else
      begin
        Buffer := TBitMap.Create;
        Buffer.Width := RBPt.X - LBPt.X;
        Buffer.Height := RectHeight(R) - CLRect.Bottom;
        Rct := Rect(R.Left + LBPt.X, R.Top + ClRect.Bottom,
                    R.Left + RBPt.X, R.Bottom);
        Buffer.Canvas.CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height),
          SB.Canvas, Rct);
        SRct := Rect(NewLBPt.X, NewCLRect.Bottom, NewRBPt.X, B.Height);
        StretchDraw(SRct, Buffer);
        Buffer.Free;
      end;
    // left
    w := NewClRect.Left;
    h := LBPt.Y - LTPt.Y;
    if not LS
    then
      begin
        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;
      end
    else
      begin
        Buffer := TBitMap.Create;
        Buffer.Width := ClRect.Left;
        Buffer.Height := LBPt.Y - LTPt.Y;
        Rct := Rect(R.Left, R.Top + LTPt.Y,
                    R.Left + CLRect.Left, R.Top + LBPt.Y);
        Buffer.Canvas.CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height),
          SB.Canvas, Rct);
        SRct := Rect(0, NewLTPt.Y, NewCLRect.Left, NewLBPt.Y);
        StretchDraw(SRct, Buffer);
        Buffer.Free;
      end;
    // right
    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 and AStretchEffect
    then
      begin
        Buffer := TBitMap.Create;
        Buffer.Width := RectWidth(ClRect);
        Buffer.Height := RectHeight(ClRect);
        Buffer.Canvas.CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height),
        SB.Canvas, Rect(R.Left + ClRect.Left, R.Top + ClRect.Top,
          R.Left + ClRect.Right, R.Top + ClRect.Bottom));

        if (RectWidth(NewClRect) > 0) and (RectHeight(NewClRect) > 0) then  
        case AStretchType of
         bsstFull:
           StretchDraw(NewClRect, Buffer);
         bsstHorz:
           begin
             SaveIndex := SaveDC(B.Canvas.Handle);
             IntersectClipRect(B.Canvas.Handle,
               NewCLRect.Left, NewCLRect.Top, NewCLRect.Right, NewClRect.Bottom);
             //
             Buffer2 := TBitMap.Create;
             Buffer2.Width := Buffer.Width;
             Buffer2.Height := RectHeight(NewClRect);
             Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), Buffer);
             XCnt := RectWidth(NewClRect) div Buffer2.Width;
             for X := 0 to XCnt do
               B.Canvas.Draw(NewClRect.Left + X * Buffer2.Width, NewClRect.Top, Buffer2);
             Buffer2.Free;
             //
             RestoreDC(B.Canvas.Handle, SaveIndex);
           end;
         bsstVert:
           begin
             SaveIndex := SaveDC(B.Canvas.Handle);
             IntersectClipRect(B.Canvas.Handle,
               NewCLRect.Left, NewCLRect.Top, NewCLRect.Right, NewClRect.Bottom);
             //
             Buffer2 := TBitMap.Create;
             Buffer2.Width := RectWidth(NewClRect);
             Buffer2.Height := Buffer.Height;
             Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), Buffer);
             YCnt := RectHeight(NewClRect) div Buffer2.Height;
             for Y := 0 to YCnt do
               B.Canvas.Draw(NewClRect.Left, NewClRect.Top + Y * Buffer2.Height, Buffer2);
             Buffer2.Free;
             //
             RestoreDC(B.Canvas.Handle, SaveIndex);
           end;
        end;

        Buffer.Free;
      end
    else
    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 CreateSkinBG;
var
  w, h, rw, rh: Integer;
  X, Y, XCnt, YCnt: Integer;
  XO, YO: Integer;
  Buffer, Buffer2: TBitMap;
begin
  B.Width := AW;
  B.Height := AH;
  if RectWidth(NewClRect) = 0 then Exit;
  if RectHeight(NewClRect) = 0 then Exit;
  with B.Canvas do
  begin
    w := RectWidth(ClRect);
    h := RectHeight(ClRect);
    rw := RectWidth(NewClRect);
    rh := RectHeight(NewClRect);
    XCnt := rw div w;
    YCnt := rh div h;
    if AStretch
    then
      begin
        Buffer := TBitMap.Create;
        Buffer.Width := RectWidth(ClRect);
        Buffer.Height := RectHeight(ClRect);
        Buffer.Canvas.CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height),
         SB.Canvas, Rect(R.Left + ClRect.Left, R.Top + ClRect.Top,
                         R.Left + ClRect.Right, R.Top + ClRect.Bottom));
        if (RectWidth(NewClRect) > 0) and (RectHeight(NewClRect) > 0) then                  
        case AStretchType of
         bsstHorz:
           begin
             Buffer2 := TBitMap.Create;
             Buffer2.Width := Buffer.Width;
             Buffer2.Height := RectHeight(NewClRect);
             Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), Buffer);
             XCnt := RectWidth(NewClRect) div Buffer2.Width;
             for X := 0 to XCnt do
               B.Canvas.Draw(NewClRect.Left + X * Buffer2.Width, NewClRect.Top, Buffer2);
             Buffer2.Free;
           end;
         bsstVert:
           begin
             Buffer2 := TBitMap.Create;
             Buffer2.Width := RectWidth(NewClRect);
             Buffer2.Height := Buffer.Height;
             Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), Buffer);
             YCnt := RectHeight(NewClRect) div Buffer2.Height;
             for Y := 0 to YCnt do
               B.Canvas.Draw(NewClRect.Left, NewClRect.Top + Y * Buffer2.Height, Buffer2);
             Buffer2.Free;
           end;
         bsstFull:
           begin
             B.Canvas.StretchDraw(NewClRect, Buffer);
           end;
        end;
        //
        Buffer.Free;
      end
    else
    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(X * w, Y * h, X * w + w - XO, 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;

procedure CreateSkinImage;
var
  w, h, rw, rh: Integer;
  X, Y, XCnt, YCnt: Integer;
  XO, YO: Integer;
  R1, R2, R3: TRect;
  Buffer, Buffer2: TBitMap;
  SaveIndex: 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
    if not ATopStretch
    then
      begin
        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;
    end
    else
    begin
      R1 := Rect(NewLTPt.X, 0, NewRTPt.X, NewClRect.Top);
      R2 := Rect(R.Left + LTPt.X, R.Top, R.Left + RTPt.X, R.Top + ClRect.Top);
      Buffer := TBitMap.Create;
      Buffer.Width := RectWidth(R2);
      Buffer.Height := RectHeight(R2);
      R3 := Rect(0, 0, Buffer.Width, Buffer.Height);
      Buffer.Canvas.CopyRect(R3, SB.Canvas, R2);
      StretchDraw(R1, Buffer);
      Buffer.Free;
    end;
    // bottom
    if not ABottomStretch
    then
      begin
        w := RBPt.X - LBPt.X;