teutils.pas

这个东西的功能很强大

  Canvas.Pen.Style := psSolid;

  Canvas.Pen.Color := RaisedColor;
  Canvas.MoveTo(Rect.Left, Rect.Bottom - 2);
  Canvas.LineTo(Rect.Left, Rect.Top);
  Canvas.LineTo(Rect.Right - 1, Rect.Top);

  Canvas.Pen.Color := SunkenColor;
  Canvas.MoveTo(Rect.Right - 1, Rect.Top);
  Canvas.LineTo(Rect.Right - 1, Rect.Bottom - 1);
  Canvas.LineTo(Rect.Left - 1, Rect.Bottom - 1);
end;

procedure DrawEdge(Canvas: TCanvas; ALeft, ATop, ARight, ABottom: integer; RaisedColor, SunkenColor: TColor);
begin
  DrawEdge(Canvas, Rect(ALeft, ATop, ARight, ABottom), RaisedColor, SunkenColor);
end;

procedure DrawRect(Canvas: TCanvas; Rect: TRect; Color: TColor);
begin
  Canvas.Brush.Style := bsClear;
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Color := Color;
  with Rect do
    Canvas.Rectangle(Left, Top, Right, Bottom);
end;

procedure DrawRect(Canvas: TCanvas; ALeft, ATop, ARight, ABottom: integer; Color: TColor); overload;
begin
  DrawRect(Canvas, Rect(ALeft, ATop, ARight, ABottom), Color);
end;

procedure DrawFocusRect(Canvas: TCanvas; Rect: TRect; Color: TColor);
begin
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := Color;
  Canvas.DrawFocusRect(Rect);
end;

procedure FillRect(Canvas: TCanvas; Rect: TRect; Color: TColor);
begin
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := Color;
  Canvas.FillRect(Rect);
end;

procedure FillRect(Canvas: TCanvas; ALeft, ATop, ARight, ABottom: integer; Color: TColor); overload;
begin
  FillRect(Canvas, Rect(ALeft, ATop, ARight, ABottom), Color);
end;

procedure FillEllipse(Canvas: TCanvas; Rect: TRect; Color: TColor);
begin
  Canvas.Pen.Style := psClear;
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := Color;
  Canvas.Ellipse(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
end;

procedure FillEllipse(Canvas: TCanvas; ALeft, ATop, ARight, ABottom: integer; Color: TColor);
begin
  FillEllipse(Canvas, Rect(ALeft, ATop, ARight, ABottom), Color);
end;

procedure DrawRoundRect(Canvas: TCanvas; ARect: TRect; Radius: integer; Color: TColor);
begin
  Canvas.Brush.Style := bsClear;
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Color := Color;
  Canvas.RoundRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, Radius, Radius);
end;

procedure FillRoundRect(Canvas: TCanvas; ARect: TRect; Radius: integer; Color: TColor);
begin
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := Color;
  Canvas.Pen.Color := Canvas.Brush.Color;
  Canvas.RoundRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, Radius, Radius);
end;

procedure FillGradientRect(Canvas: TCanvas; ARect: TRect; BeginColor, EndColor: TColor; Vertical: boolean);
var
  RGBFrom: array[0..2] of integer;
  RGBDiff: array[0..2] of integer;
  ColorBand : TRect;
  Colors: integer;
  I: Integer;
  R,G,B: Byte;
begin
  if RectWidth(ARect) <= 0 then Exit;
  if RectHeight(ARect) <= 0 then Exit;

  Colors := 255;
  if not Vertical and (Colors > RectWidth(ARect)) then
    Colors := RectWidth(ARect);
  if Vertical and (Colors > RectHeight(ARect)) then
    Colors := RectHeight(ARect);

  BeginColor := ColorToRGB(BeginColor);
  EndColor := ColorToRGB(EndColor);

  { extract from RGB values }
  RGBFrom[0] := TteColorRecBor(BeginColor).R * $FF;
  RGBFrom[1] := TteColorRecBor(BeginColor).G * $FF;
  RGBFrom[2] := TteColorRecBor(BeginColor).B * $FF;
  { calculate difference of from and to RGB values }
  RGBDiff[0] := TteColorRecBor(EndColor).R * $FF - RGBFrom[0];
  RGBDiff[1] := TteColorRecBor(EndColor).G * $FF - RGBFrom[1];
  RGBDiff[2] := TteColorRecBor(EndColor).B * $FF - RGBFrom[2];

  Canvas.Brush.Style := bsSolid;

  ColorBand := ARect;
  for I := 0 to Colors do
  begin
    { calculate color band's top and bottom coordinates }
    if not Vertical then
    begin
      ColorBand.Left := MulDiv(I, RectWidth(ARect), Colors);
      ColorBand.Right := MulDiv(Succ(I), RectWidth(ARect), Colors);

      ColorBand.Left := ColorBand.Left + ARect.Left;
      ColorBand.Right := ColorBand.Right + ARect.Left;
    end else
    begin
      ColorBand.Top := MulDiv (I, RectHeight(ARect), Colors);
      ColorBand.Bottom := MulDiv (Succ(I), RectHeight(ARect), Colors);

      ColorBand.Top := ColorBand.Top + ARect.Top;
      ColorBand.Bottom := ColorBand.Bottom + ARect.Top;
    end;

    { calculate color band color }
    R := Round((RGBFrom[0] + ((I * RGBDiff[0]) /  Colors)) / $FF);
    G := Round((RGBFrom[1] + ((I * RGBDiff[1]) /  Colors)) / $FF);
    B := Round((RGBFrom[2] + ((I * RGBDiff[2]) /  Colors)) / $FF);

    if (i = 0) or (i = Colors) then
      IntersectRect(ColorBand, ARect, ColorBand);

    Canvas.Brush.Color := RGB(R, G, B);
    Canvas.FillRect(ColorBand);
  end;
end;

procedure FillRadialGradientRect(Canvas: TCanvas; Rect: TRect; BeginColor,
  EndColor: TColor; Pos: TPoint);
var
  RGBFrom: array[0..3] of integer;
  RGBDiff: array[0..4] of integer;
  Colors: integer;

  ColorBand: TRect;
  Len: integer;
  I: Integer;
  R,G,B: Byte;
  ClipRgn: HRgn;
begin
  if RectWidth(Rect) <= 0 then Exit;
  if RectHeight(Rect) <= 0 then Exit;

  Colors := 50;

  { extract from RGB values }
  RGBFrom[0] := TteColorRecBor(BeginColor).R * $FF;
  RGBFrom[1] := TteColorRecBor(BeginColor).G * $FF;
  RGBFrom[2] := TteColorRecBor(BeginColor).B * $FF;
  RGBFrom[3] := TteColorRecBor(BeginColor).A * $FF;
  { calculate difference of from and to RGB values }
  RGBDiff[0] := TteColorRecBor(EndColor).R * $FF - RGBFrom[0];
  RGBDiff[1] := TteColorRecBor(EndColor).G * $FF - RGBFrom[1];
  RGBDiff[2] := TteColorRecBor(EndColor).B * $FF - RGBFrom[2];
  RGBDiff[3] := TteColorRecBor(EndColor).A * $FF - RGBFrom[3];

  { set clip region }
  ClipRgn := CreateRectRgn(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
  SelectClipRgn(Canvas.Handle, ClipRgn);

  try
    { calc length }
    if RectWidth(Rect) > RectHeight(Rect) then
      Len := RectWidth(Rect)
    else
      Len := RectHeight(Rect);

    for I := Colors downto 0 do
    begin
      { calculate color band color }
      R := Round((RGBFrom[0] + ((I * RGBDiff[0]) /  Colors)) / $FF);
      G := Round((RGBFrom[1] + ((I * RGBDiff[1]) /  Colors)) / $FF);
      B := Round((RGBFrom[2] + ((I * RGBDiff[2]) /  Colors)) / $FF);

      ColorBand.TopLeft := Rect.TopLeft;
      ColorBand.Right := ColorBand.Left + MulDiv(Succ(I), Len, Colors) * 2;
      ColorBand.Bottom := ColorBand.Top + MulDiv(Succ(I), Len, Colors) * 2;

      OffsetRect(ColorBand, -RectWidth(ColorBand) div 2, -RectHeight(ColorBand) div 2);

      OffsetRect(ColorBand, Round((Pos.X / 100) * RectWidth(Rect)),
        Round((Pos.X / 100) * RectHeight(Rect)));

      { paint ellipse  }
      FillEllipse(Canvas, ColorBand, RGB(R, G, B));
    end;
  finally
    SelectClipRgn(Canvas.Handle, 0);
    DeleteObject(ClipRgn);
  end;
end;

procedure FillHalftoneRect(Canvas: TCanvas; ARect: TRect; Color, HalfColor: TColor);
var
  i, j: integer;
  HalfBrush: TBrush;
  HalfBitmap: TBitmap;
begin
  if ARect.Left < 0 then ARect.Left := 0;
  if ARect.Top < 0 then ARect.Top := 0;
  if RectWidth(ARect) <= 0 then Exit;
  if RectHeight(ARect) <= 0 then Exit;

  HalfBrush := TBrush.Create;
  HalfBitmap := TBitmap.Create;
  HalfBitmap.Width := 8;
  HalfBitmap.Height := 8;

  { Create halftone bitmap }
  HalfBitmap.Canvas.Brush.Style := bsSolid;
  HalfBitmap.Canvas.Brush.Color := Color;
  HalfBitmap.Canvas.FillRect(Rect(0, 0, 8, 8));

  for i := 0 to HalfBitmap.Width - 1 do
    for j := 0 to HalfBitmap.Height - 1 do
    begin
      if Odd(i) and Odd(j) then
        HalfBitmap.Canvas.Pixels[i, j] := HalfColor;
      if not Odd(i) and not Odd(j) then
        HalfBitmap.Canvas.Pixels[i, j] := HalfColor;
    end;

  HalfBrush.Bitmap := HalfBitmap;

  Canvas.Brush := HalfBrush;
  Canvas.FillRect(ARect);

  HalfBitmap.Free;
  HalfBrush.Free;
end;

procedure DrawPolygon(Canvas: TCanvas; Points: array of TPoint; Color: TColor);
begin
  { Draw Polygon }
  Canvas.Brush.Style := bsClear;
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Color := Color;
  Canvas.Polygon(Points);
end;

procedure FillPolygon(Canvas: TCanvas; Points: array of TPoint; Color: TColor);
begin
  { Fill Polygon }
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := Color;
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Color := Color;
  Canvas.Polygon(Points);
end;

procedure FillHalftonePolygon(Canvas: TCanvas; Points: array of TPoint; Color, HalfColor: TColor);
var
  i, j: integer;
  HalfBrush: TBrush;
  HalfBitmap: TBitmap;
begin
  { Fill Polygon }
  HalfBrush := TBrush.Create;
  HalfBitmap := TBitmap.Create;
  HalfBitmap.Width := 8;
  HalfBitmap.Height := 8;

  { Create halftone bitmap }
  HalfBitmap.Canvas.Brush.Style := bsSolid;
  HalfBitmap.Canvas.Brush.Color := Color;
  HalfBitmap.Canvas.FillRect(Rect(0, 0, 8, 8));

  for i := 0 to HalfBitmap.Width - 1 do
    for j := 0 to HalfBitmap.Height - 1 do
    begin
      if Odd(i) and Odd(j) then
        HalfBitmap.Canvas.Pixels[i, j] := HalfColor;
      if not Odd(i) and not Odd(j) then
        HalfBitmap.Canvas.Pixels[i, j] := HalfColor;
    end;

  HalfBrush.Bitmap := HalfBitmap;

  Canvas.Brush := HalfBrush;
  Canvas.Pen.Style := psClear;
  Canvas.Polygon(Points);

  HalfBitmap.Free;
  HalfBrush.Free;
end;

procedure DrawIcon(Canvas: TCanvas; ARect: TRect; AIcon: TIcon);
var
  R: TRect;
begin
  if AIcon = nil then Exit;

  R := Rect(0, 0, 16, 16);
  RectCenter(R, ARect);

  DrawIconEx(Canvas.Handle, R.Left, R.Top, AIcon.Handle, 0, 0, 0, 0, DI_NORMAL);
end;

procedure DrawIcon(DC: HDC; ARect: TRect; AIcon: TIcon);
var
  R: TRect;
begin
  if AIcon = nil then Exit;

  R := Rect(0, 0, 16, 16);
  RectCenter(R, ARect);

  DrawIconEx(DC, R.Left, R.Top, AIcon.Handle, 0, 0, 0, 0, DI_NORMAL);
end;

procedure DrawGlyphShadow(Canvas: TCanvas; X, Y: integer; Glyph: TteBitmap; Color: TColor);
var
  Shadow: TteBitmap;
  i: integer;
  P: PteColor;
begin
  Shadow := TteBitmap.Create;
  try
    Shadow.Assign(Glyph);
    Shadow.AlphaBlend := true;
    Shadow.CheckingTransparent;

    for i := 0 to Shadow.Width * Shadow.Height - 1 do
    begin
      P := @Shadow.Bits[i];
      if P^ shr 24 > 0 then
        P^ := teColor(Color, 100);
    end;

    Shadow.Draw(Canvas, X, Y);
  finally
    Shadow.Free;
  end;
end;

{ Stream routines ============================================================}

function ReadString(S: TStream): string;
var
  L: Integer;
begin
  L := 0;
  S.Read(L, SizeOf(L));
  SetLength(Result, L);
  S.Read(Pointer(Result)^, L);
end;

procedure WriteString(S: TStream; Value: string);
var
  L: Integer;
begin
  L := Length(Value);
  S.Write(L, SizeOf(L));
  S.Write(Pointer(Value)^, L);
end;

{ Region routines =============================================================}

var
  Rts: array [0..5000] of TRect;

function CreateRegionDataFromBitmap(Bitmap: TteBitmap; var RgnData: PRgnData;
  Left, Top: integer): HRgn;
var
  j, i, i1: integer;
  TrColor: TteColor;
  C: PteColor;
  Count: integer;
begin
  Result := 0;

  TrColor := teTransparent;

  if Bitmap.Empty then Exit;
  if Bitmap.Width * Bitmap.Height = 0 then Exit;

  Count := 0;
  for j := 0 to Bitmap.Height-1 do
  begin
    i := -1;
    while i < Bitmap.Width do
    begin
      repeat
        Inc(i);
        C := Bitmap.PixelPtr[i, j];
        if i >= Bitmap.Width then Break;
      until not ((C^ and not AlphaMask) = TrColor);

      if i >= Bitmap.Width then Break;

      i1 := i;
      repeat
        Inc(i1);
        If (i1 >= Bitmap.Width) Then Break;
        C := Bitmap.PixelPtr[i1, j];
      until ((C^ and not AlphaMask) = TrColor);

      if i <> i1 then
      begin
        Rts[Count] := Rect(Left + i, Top + j, Left + i1, Top + j + 1);
        Inc(Count);
      end;
      i := i1;
    end;
  end;
  { Make Region data }
  Result := Count * SizeOf(TRect);
  GetMem(Rgndata, SizeOf(TRgnDataHeader) + Result);
  RgnData^.rdh.dwSize := SizeOf(TRgnDataHeader);
  RgnData^.rdh.iType := RDH_RECTANGLES;
  RgnData^.rdh.nCount := Count;
  RgnData^.rdh.nRgnSize := 0;
  RgnData^.rdh.rcBound := Rect(0, 0, Bitmap.Width, Bitmap.Height);
  { Update New Region }
  Move(Rts, RgnData^.Buffer, Result);
  Result := SizeOf(TRgnDataHeader) + Count * SizeOf(TRect);
end;

function CreateRegionFromBitmap(Bitmap: TteBitmap; Left, Top: integer): HRgn;
var
  RgnData: PRgnData;
  Size: integer;
begin
  RgnData := nil;
  Size := CreateRegionDataFromBitmap(Bitmap, RgnData, Left, Top);
  Result := ExtCreateRegion(nil, Size, RgnData^);
  if RgnData <> nil then FreeMem(RgnData, Size);
end;

{ System Routines }

function GetKeyBoardDelayInterval: integer;
var
  A: DWORD;
begin
  SystemParametersInfo(SPI_GETKEYBOARDDELAY, 0, @A, 0);
  Result := (A + 1) * 200;
end;

function GetKeyBoardSpeedInterval: integer;
var
  A: DWORD;
begin
  SystemParametersInfo(SPI_GETKEYBOARDSPEED, 0, @A, 0);
  Result := Round(1000 / ((A + 1) * 2.3));
end;

{ System Routines }

var
  MMX_ACTIVE: Boolean;

function CPUID_Available: Boolean;
asm
        MOV       EDX,False
        PUSHFD
        POP       EAX
        MOV       ECX,EAX
        XOR       EAX,$00200000
        PUSH      EAX
        POPFD
        PUSHFD
        POP       EAX
        XOR       ECX,EAX
        JZ        @1
        MOV       EDX,True
@1:     PUSH      EAX
        POPFD
        MOV       EAX,EDX
end;

function CPU_Signature: Integer;
asm
        PUSH    EBX
        MOV     EAX,1
        DW      $A20F   // CPUID
        POP     EBX
end;

function CPU_Features: Integer;
asm
        PUSH    EBX
        MOV     EAX,1
        DW      $A20F   // CPUID
        POP     EBX
        MOV     EAX,EDX
end;

function HasMMX: Boolean;
begin
  Result := False;
  if not CPUID_Available then Exit;              // no CPUID available
  if CPU_Signature shr 8 and $0F < 5 then Exit;  // not a Pentium class
  if CPU_Features and $800000 = 0 then Exit;     // no MMX
  Result := True;
end;
 
procedure EMMS;
begin
  if MMX_ACTIVE then
  asm
    db $0F,$77               /// EMMS
  end;
end;




initialization
  Sig := Sig;

  MMX_ACTIVE := HasMMX;

finalization
end.