sputils.pas

灰鸽子VIP1.2经典源代码

  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;


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

procedure DrawMTImage(C: TCanvas; X, Y: Integer; Color: TColor);
begin
  with C do
  begin
    Pen.Color := Color;
    Brush.Color := Color;
    Rectangle(X + 2, Y + 2, X + 7, Y + 7);
  end;
end;

function ExtractDay(ADate: TDateTime): Word;
var
  M, Y: Word;
begin
  DecodeDate(ADate, Y, M, Result);
end;

function ExtractMonth(ADate: TDateTime): Word;
var
  D, Y: Word;
begin
  DecodeDate(ADate, Y, Result, D);
end;

function ExtractYear(ADate: TDateTime): Word;
var
  D, M: Word;
begin
  DecodeDate(ADate, Result, M, D);
end;

function IsLeapYear(AYear: Integer): Boolean;
begin
  Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
end;

function DaysPerMonth(AYear, AMonth: Integer): Integer;
const
  DaysInMonth: array[1..12] of Integer =
    (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
  Result := DaysInMonth[AMonth];
  if (AMonth = 2) and IsLeapYear(AYear) then Inc(Result); { leap-year Feb is special }
end;

type

  PMonitorInfo = ^TMonitorInfo;
  TMonitorInfo = record
    cbSize: DWORD;
    rcMonitor: TRect;
    rcWork: TRect;
    dwFlags: DWORD;
  end;

const
  MONITOR_DEFAULTTONEAREST = $2;
  SM_CMONITORS = 80;

var
  MonitorFromWindowFunc: function(hWnd: HWND; dwFlags: DWORD): THandle; stdcall;
  GetMonitorInfoFunc: function(hMonitor: THandle; lpMonitorInfo: PMonitorInfo): BOOL; stdcall;

function CheckMultiMonitors: Boolean;
var
  MonitorCount: Integer;
begin
  MonitorCount := GetSystemMetrics(SM_CMONITORS);
  Result := (MonitorCount > 1) and Assigned(GetMonitorInfoFunc);
end;

function GetPrimaryMonitorWorkArea(const WorkArea: Boolean): TRect;
begin
  if WorkArea
  then
    SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0)
  else
    Result := Rect(0, 0, Screen.Width, Screen.Height);
end;

function GetMonitorWorkArea(const W: HWND; const WorkArea: Boolean): TRect;
var
  MonitorInfo: TMonitorInfo;
  MH: THandle;
begin
  if CheckMultiMonitors
  then
    begin
      MH := MonitorFromWindowFunc(W, MONITOR_DEFAULTTONEAREST);
      MonitorInfo.cbSize := SizeOf(MonitorInfo);
      if GetMonitorInfoFunc(MH, @MonitorInfo)
      then
        begin
          if not WorkArea
          then
            Result := MonitorInfo.rcMonitor
          else
            Result := MonitorInfo.rcWork;
        end;
    end
  else
    Result := GetPrimaryMonitorWorkArea(WorkArea);
end;

var
  User32H: THandle;

initialization

  User32H := GetModuleHandle(user32);

  if User32H > 0 then
  begin
    MonitorFromWindowFunc := GetProcAddress(User32H, 'MonitorFromWindow');
    GetMonitorInfoFunc := GetProcAddress(User32H, 'GetMonitorInfoA');
  end;

finalization

  if User32H > 0 then FreeLibrary(User32H);
  MonitorFromWindowFunc := nil;
  GetMonitorInfoFunc := nil;
  
end.