sputils.pas

一套及时通讯的原码

  hDC:=CreateCompatibleDC(0);
  SelectObject(hDC,Handle);
end;

// Region convert
function CreateRgnFromBmp(B: TBitmap; XO, YO: Integer; var RgnData: PRgnData): integer;
const
  max = 10000;
var
  j, i, i1: integer;
  C: TFBColor;
  FB: TFBitmap;
  Rts: array [0..max] of TRect;
  Count: integer;
begin
  Result := 0;
  If B.Empty Then Exit;
  Count := 0;
  FB := TFBitmap.Create(B.Handle);
  for j := 0 to FB.Height - 1 do
  begin
    i := 0;
    while i < FB.Width do
    begin
      C := FB.Pixels[j, i];
      If C.R + C.G + C.B = 0 Then
      begin
        i1 := i;
        C := FB.Pixels[j, i1];
        while C.R + C.G + C.B = 0 do
        begin
          Inc(i1);
          If i1 > FB.Width - 1 Then Break else C := FB.Pixels[j, i1];
        end;
        Rts[Count] := Rect(i + XO, j + YO, i1 + XO, j + 1 + YO);
        Inc(Count);
        i := i1;
        Continue;
      end;
      Inc(i);
    end;
  end;
  FB.Free;
  // Make Region data
  Result := Count*SizeOf(TRect);
  GetMem(Rgndata, SizeOf(TRgnDataHeader)+Result);
  FillChar(Rgndata^, SizeOf(TRgnDataHeader)+Result, 0);
  RgnData^.rdh.dwSize := SizeOf(TRgnDataHeader);
  RgnData^.rdh.iType := RDH_RECTANGLES;
  RgnData^.rdh.nCount := Count;
  RgnData^.rdh.nRgnSize := 0;
  RgnData^.rdh.rcBound := Rect(0 + XO, 0 + YO, B.Width + XO, B.Height + YO);
  // Update New Region
  Move(Rts, RgnData^.Buffer, Result);
  Result := SizeOf(TRgnDataHeader)+Count*SizeOf(TRect);
end;

procedure WriteStringToStream(Str: String; S: TStream);
var
  L: Integer;
begin
  L := Length(Str);
  S.Write(L, SizeOf(Integer));
  S.Write(Pointer(Str)^, L);
end;


procedure ReadStringFromStream(var Str: String; S: TStream);
var
  L: Integer;
begin
  L := 0;
  S.Read(L, SizeOf(Integer));
  SetLength(Str, L);
  S.Read(Pointer(Str)^, L);
end;

procedure CreateHSkinImage2;
var
  X, XCnt, w, XO: Integer;
begin
  B.Width := AW;
  B.Height := RectHeight(R);
  with B.Canvas do
  begin
    if LO <> 0 then
       CopyRect(Rect(0, 0, LO, B.Height), SB.Canvas,
                Rect(R.Left, R.Top, R.Left + LO, R.Bottom));
    Inc(R.Left, LO);
    Dec(R.Right, RO);
    w := RectWidth(R);
    if w = 0 then w := 1;
    XCnt := (B.Width - LO) div w;
    for X := 0 to XCnt do
    begin
      if LO + X * w + w > B.Width
      then XO := LO + X * w + w - B.Width
      else XO := 0;
      B.Canvas.CopyRect(Rect(LO + X * w, 0, LO + X * w + w - XO,
                        B.Height),
                        SB.Canvas,
                        Rect(R.Left, R.Top, R.Right - XO, R.Bottom));
    end;
  end;
end;

procedure CreateHSkinImage;
var
  X, XCnt, w, XO: Integer;
begin
  B.Width := AW;
  B.Height := RectHeight(R);
  with B.Canvas do
  begin
    if LO <> 0 then
       CopyRect(Rect(0, 0, LO, B.Height), SB.Canvas,
                Rect(R.Left, R.Top, R.Left + LO, R.Bottom));
    if RO <> 0 then
       CopyRect(Rect(B.Width - RO, 0, B.Width, B.Height),
                SB.Canvas,
                Rect(R.Right - RO, R.Top, R.Right, R.Bottom));
    Inc(R.Left, LO);
    Dec(R.Right, RO);
    w := RectWidth(R);
    XCnt := (B.Width - LO - RO) div w;
    for X := 0 to XCnt do
    begin
      if LO + X * w + w > B.Width - RO
      then XO := LO + X * w + w - (B.Width - RO)
      else XO := 0;
      B.Canvas.CopyRect(Rect(LO + X * w, 0, LO + X * w + w - XO,
                        B.Height),
                        SB.Canvas,
                        Rect(R.Left, R.Top, R.Right - XO, R.Bottom));
    end;
  end;  
end;

procedure CreateVSkinImage;
var
  Y, YCnt, h, YO: Integer;
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);
    YCnt := (B.Height - TpO - BO) div h;
    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 CreateSkinImage2;
var
  w, h, rw, rh: Integer;
  X, Y, XCnt, YCnt: Integer;
  XO, YO: Integer;
  NCLRect: TRect;
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 := RBPt.X - LTPt.X;
    XCnt := (AW - NewLTPt.X) div (RBPt.X - LTPt.X);
    for X := 0 to XCnt do
    begin
      if NewLTPt.X + X * w + w > AW
      then XO := NewLTPt.X + X * w + w - AW 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 := (AW - NewLBPt.X) div (RBPt.X - LBPt.X);
    for X := 0 to XCnt do
    begin
      if NewLBPt.X + X * w + w > AW
      then XO := NewLBPt.X + X * w + w - AW 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;

    // 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));

    //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));

    //Draw client
    NCLRect := NewClRect;
    NCLRect.Right := AW;
    w := RectWidth(ClRect);
    h := RectHeight(ClRect);
    rw := RectWidth(NCLRect);
    rh := RectHeight(NCLRect);
    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(NCLRect.Left + X * w, NCLRect.Top + Y * h,
             NCLRect.Left + X * w + w - XO,
             NCLRect.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),