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

📄 sgraphutils.pas

📁 Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。
💻 PAS
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
  PaintItemBGFast(SkinIndex, BGIndex, BGHotIndex, SkinSection, ci, State, R, pP, ItemBmp, SkinManager);
  inc(ci.X, pP.X);
  inc(ci.Y, pP.Y);
  if TsSkinManager(SkinManager).IsValidImgIndex(MaskIndex) then DrawSkinRect(ItemBmp, R, Filling, ci, TsSkinManager(SkinManager).ma[MaskIndex], State, True, TsSkinManager(SkinManager));
  dec(ci.X, pP.X);
  dec(ci.Y, pP.Y);
end;

procedure PaintSmallItem(SkinIndex : integer; const SkinSection : string; ci : TCacheInfo; Filling : boolean; State : integer; R : TRect; pP : TPoint; ItemBmp : TBitmap; SkinManager : TObject = nil); overload;
var
  i : integer;
begin
  if SkinManager = nil then SkinManager := DefaultManager;
  if not Assigned(SkinManager) or not TsSkinManager(SkinManager).IsValidSkinIndex(SkinIndex) or (R.Bottom > ItemBmp.Height) or (R.Right > ItemBmp.Width) or (R.Left < 0) or (R.Top < 0) then Exit;
  PaintItemBG(SkinIndex, SkinSection, ci, State, R, pP, ItemBmp, SkinManager);
  i := TsSkinManager(SkinManager).GetMaskIndex(SkinIndex, SkinSection, s_BordersMask);
  inc(ci.X, pP.X);
  inc(ci.Y, pP.Y);
  if TsSkinManager(SkinManager).IsValidImgIndex(i) then DrawSmallSkinRect(ItemBmp, R, Filling, ci, TsSkinManager(SkinManager).ma[i], State);
end;

procedure PaintItem(SkinData : TsCommonData; ci : TCacheInfo; Filling : boolean; State : integer; R : TRect; pP : TPoint; ItemBmp : TBitmap; UpdateCorners : boolean; OffsetX : integer = 0; OffsetY : integer = 0); overload;
var
  i : integer;
begin
  if (ItemBmp = nil) or not Assigned(SkinData.SkinManager) or not SkinData.SkinManager.IsValidSkinIndex(SkinData.SkinIndex) or (R.Bottom > ItemBmp.Height) or
                                                   (R.Right > ItemBmp.Width) or (R.Left < 0) or (R.Top < 0) then Exit;
  ParentCenterColor := clFuchsia;
  if not CI.Ready then begin
    if (SkinData.FOwnerControl <> nil) and (SkinData.FOwnerControl.Parent <> nil) then begin
      CtrlParentColor := ColorToRGB(TsHackedControl(SkinData.FOwnerControl.Parent).Color);
      ParentCenterColor := ColorToRGB(TsHackedControl(SkinData.FOwnerControl.Parent).Color);
    end// else if (SkinData.FOwnerControl is TCustomFrame) then Alert(SkinData.FOwnerControl.Name);
  end;
  if CI.Ready and not SkinData.RepaintIfMoved and (ParentCenterColor = clFuchsia{ParentCenterColor may be already defined}) then begin
    InitParentColor(SkinData.FOwnerControl.Parent);
  end;
//  if not Filling or (ma[SkinData.BorderIndex].MaskType = 1) then // !!!! may be optimized
  PaintItemBG(SkinData, ci, State, R, pP, ItemBmp, OffsetX, OffsetY);
  inc(ci.X, pP.X);
  inc(ci.Y, pP.Y);
  if Assigned(SkinData.SkinManager) and SkinData.SkinManager.IsValidImgIndex(SkinData.BorderIndex) and not ((State = 0) and (SkinData.SkinManager.ma[SkinData.BorderIndex].DrawMode and BDM_ACTIVEONLY = BDM_ACTIVEONLY)) // May be optimized
    then DrawSkinRect(ItemBmp, R, Filling, ci, SkinData.SkinManager.ma[SkinData.BorderIndex], State, UpdateCorners);
  CtrlParentColor := clFuchsia;
  ParentCenterColor := clFuchsia;

  i := SkinData.SkinManager.GetMaskIndex(SkinData.SkinIndex, SkinData.SkinSection, s_ImgTopLeft);
  if i > -1 then DrawSkinGlyph(ItemBmp, Point(R.Left, R.Top), State, 1, SkinData.SkinManager.ma[i]);
  i := SkinData.SkinManager.GetMaskIndex(SkinData.SkinIndex, SkinData.SkinSection, s_ImgTopRight);
  if i > -1
    then DrawSkinGlyph(ItemBmp, Point(R.Right - WidthOf(SkinData.SkinManager.ma[i].R) div SkinData.SkinManager.ma[i].ImageCount, R.Top), State, 1, SkinData.SkinManager.ma[i]);
  i := SkinData.SkinManager.GetMaskIndex(SkinData.SkinIndex, SkinData.SkinSection, s_ImgBottomLeft);
  if i > -1 then DrawSkinGlyph(ItemBmp, Point(0, R.Bottom - HeightOf(SkinData.SkinManager.ma[i].R) div (1 + SkinData.SkinManager.ma[i].MaskType)), State, 1, SkinData.SkinManager.ma[i]);
  i := SkinData.SkinManager.GetMaskIndex(SkinData.SkinIndex, SkinData.SkinSection, s_ImgBottomRight);
  if i > -1 then DrawSkinGlyph(ItemBmp, Point(R.Right - WidthOf(SkinData.SkinManager.ma[i].R) div SkinData.SkinManager.ma[i].ImageCount, R.Bottom - HeightOf(SkinData.SkinManager.ma[i].R) div (1 + SkinData.SkinManager.ma[i].MaskType)), State, 1, SkinData.SkinManager.ma[i]);
end;

procedure DrawGlyphEx(Glyph, DstBmp : TBitmap; R : TRect; NumGlyphs : integer; Enabled, Grayed : boolean; DisabledGlyphKind : TsDisabledGlyphKind; State, Blend : integer);
var
  Bmp, TmpGlyph : TBitmap;
  MaskColor: TsColor;
  w, GlyphIndex : integer;
begin
  TmpGlyph := TBitmap.Create;
  TmpGlyph.Assign(Glyph);
  TmpGlyph.PixelFormat := pf24bit;
  case NumGlyphs of
    1 : begin
      Bmp := TBitmap.Create;
      Bmp.Assign(TmpGlyph);
      Bmp.PixelFormat := pf24bit;
      Bmp.TransparentColor := Bmp.Canvas.Pixels[0, Bmp.Height - 1];

      try
      if not Enabled then begin
        if dgGrayed in DisabledGlyphKind then begin
          GrayScale(Bmp);
        end;
        if dgBlended in DisabledGlyphKind then begin
          MaskColor := TsColor(Bmp.Canvas.Pixels[0, Bmp.Height - 1]);
          BlendTransRectangle(DstBmp, R.Left, R.Top, Bmp, Rect(0, 0, WidthOf(R), HeightOf(R)), 0.5, MaskColor);
        end
        else begin
          MaskColor := TsColor(Bmp.Canvas.Pixels[0, Bmp.Height - 1]);
          CopyTransBitmaps(DstBmp, Bmp, R.Left, R.Top, MaskColor);
        end;
      end
      else begin
        if (State = 0) and Grayed then GrayScale(Bmp);
        MaskColor := TsColor(Bmp.Canvas.Pixels[0, Bmp.Height - 1]);

        if (State = 0) and (Blend > 0) then begin
          BlendTransRectangle(DstBmp, R.Left, R.Top, Bmp, Rect(0, 0, WidthOf(R), HeightOf(R)), Blend / 100, MaskColor);
        end
        else begin
          CopyTransBitmaps(DstBmp, Bmp, R.Left, R.Top, MaskColor);
        end;
      end;
      finally
        FreeAndNil(Bmp);
      end;
    end
    else begin
      if not Enabled then GlyphIndex := min(NumGlyphs, 2) - 1 else begin
        case State of
          0, 1 : GlyphIndex := 0;//State
          else {2} GlyphIndex := min(NumGlyphs, 4) - 1;
        end;
      end;
      w := TmpGlyph.Width div NumGlyphs;
      if Enabled then begin
        CopyTransRect(DstBmp, TmpGlyph, R.Left, R.Top, Rect(w * GlyphIndex, 0, (GlyphIndex + 1) * w - 1, TmpGlyph.Height - 1), TmpGlyph.Canvas.Pixels[GlyphIndex * w, TmpGlyph.Height - 1], EmptyCI, true);
      end
      else begin
        if (State = 0) and (Blend > 0) then begin
          MaskColor := TsColor(TmpGlyph.Canvas.Pixels[0, TmpGlyph.Height - 1]);
          BlendTransRectangle(DstBmp, R.Left, R.Top, TmpGlyph, Rect(w * GlyphIndex, 0, (GlyphIndex + 1) * w - 1, TmpGlyph.Height - 1), Blend / 100, MaskColor);
        end
        else begin
          CopyTransRect(DstBmp, TmpGlyph, R.Left, R.Top, Rect(w * GlyphIndex, 0, (GlyphIndex + 1) * w - 1, TmpGlyph.Height - 1), TmpGlyph.Canvas.Pixels[0, TmpGlyph.Height - 1], EmptyCI, True);
        end;
      end;
    end;
  end;
  FreeAndNil(TmpGlyph);
end;
{$ENDIF}

procedure FillDC(DC: HDC; aRect: TRect; Color: TColor);
var
  OldBrush, NewBrush : hBrush;
  SavedDC : hWnd;
begin
  SavedDC := SaveDC(DC);
  NewBrush := CreateSolidBrush(cardinal(ColorToRGB(Color)));
  OldBrush := SelectObject(dc, NewBrush);
  try
    FillRect(DC, aRect, NewBrush);
  finally
    SelectObject(dc, OldBrush);
    DeleteObject(NewBrush);
    RestoreDC(DC, SavedDC);
  end;
end;

procedure BitBltBorder(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; BorderWidth : integer);
begin
  BitBlt(DestDC, X, Y, BorderWidth, Height, SrcDC, XSrc, YSrc, SRCCOPY);
  BitBlt(DestDC, X + BorderWidth, Y, Width, BorderWidth, SrcDC, XSrc + BorderWidth, YSrc, SRCCOPY);
  BitBlt(DestDC, Width - BorderWidth, Y + BorderWidth, Width, Height, SrcDC, XSrc + Width - BorderWidth, YSrc + BorderWidth, SRCCOPY);
  BitBlt(DestDC, X + BorderWidth, Height - BorderWidth, Width - BorderWidth, Height, SrcDC, XSrc + BorderWidth, YSrc + Height - BorderWidth, SRCCOPY);
end;

procedure GrayScale(Bmp: TBitmap);
var
  p : PByteArray;
  Gray, x, y, w, h : integer;
begin
  h := Bmp.Height - 1;
  w := Bmp.Width - 1;
  for y := 0 to h do begin
    p := Bmp.scanline[y];
    for x := 0 to w do begin
      Gray := (p[x * 3] + p[x * 3 + 1] + p[x * 3 + 2]) div 3;
      p[x * 3 + 0] := Gray; p[x * 3 + 1] := Gray; p[x * 3 + 2] := Gray
    end
  end;
end;

procedure GrayScaleTrans(Bmp: TBitmap; const TransColor : TsColor);
var
  S1 : PRGBArray;
  Gray, x, y, w, h : integer;
begin
  h := Bmp.Height - 1;
  w := Bmp.Width - 1;
  for Y := 0 to h do begin
    S1 := Bmp.ScanLine[Y];
    for X := 0 to w do begin
      if (S1[X].B <> TransColor.B) or (S1[X].G <> TransColor.G) or (S1[X].R <> TransColor.R) then begin
        Gray := (S1[X].R + S1[X].G + S1[X].B) div 3;
        S1[X].R := Gray; S1[X].G := Gray; S1[X].B := Gray
      end;
    end
  end;
end;

procedure PaintCheck(Canvas: TCanvas; r: TRect; Enabled: boolean; Color: TColor);
var
  h, w: integer;
  aRect: TRect;
  procedure Paint(const r: TRect);
  begin
    aRect := r;
    InflateRect(aRect, - WidthOf(r) div 8, - WidthOf(r) div 8);
    inc(aRect.Left, 1);
    inc(aRect.Top, 1);
    h := HeightOf(aRect);
    w := h div 4;
    Canvas.Polygon([
                    Point(aRect.Left,            aRect.Bottom - h div 3 - 2),
                    Point(aRect.Left + h div 3,  aRect.Bottom - 2),
                    Point(aRect.Right - 2,       aRect.Top + h div 3),
                    Point(aRect.Right - 2,       aRect.Top + h div 3 - w),
                    Point(aRect.Left + h div 3,  aRect.Bottom - 2 - w),
                    Point(aRect.Left + w,        aRect.Bottom - h div 3 - 2)
                                    ])
  end;
begin
  Canvas.Brush.Style := bsSolid;
  Canvas.Pen.Style := psSolid;
  if Enabled then begin
    Canvas.pen.color := Color;
    Canvas.brush.color := Color;
  end
  else begin
    Canvas.brush.color := cl3DLight;
    Canvas.pen.color := cl3DLight;

    OffsetRect(r, 1, 1);
    Paint(r);
    OffsetRect(r, -1, -1);

    Canvas.brush.color := clBtnShadow;
    Canvas.pen.color := clBtnShadow;
  end;
  Paint(r);
end;

function CutText(Canvas: TCanvas; const Text: string; MaxLength : integer): string;
begin
  if MaxLength < 1 then Result := '' else Result := Text;
  if (Canvas.TextWidth(Result) > MaxLength) and (Result <> '') then begin
    while (Result <> '') and (Canvas.TextWidth(Result + '...') > MaxLength) do Delete(Result, Length(Result), 1);
    if Result <> '' then Result := Result + '...';
  end;
end;

procedure WriteText(Canvas: TCanvas; Text: PChar; Enabled: boolean; var aRect : TRect; Flags: Cardinal);
var
  R, Rd: TRect;
  x, y : integer;
  ts: TSize;
begin
  R := aRect;

  if Flags or DT_WORDBREAK <> Flags then begin // If no multiline

    GetTextExtentPoint32(Canvas.Handle, Text, Length(Text), ts);
    R.Right := R.Left + ts.cx;
    R.Bottom := R.Top + ts.cy;

    if Flags or DT_CENTER = Flags then begin
      y := (HeightOf(R) - HeightOf(aRect)) div 2;
      x := (WidthOf(R) - WidthOf(aRect)) div 2;
      InflateRect(aRect, x, y);
    end
    else if Flags or DT_RIGHT = Flags then begin
      y := (HeightOf(R) - HeightOf(aRect)) div 2;
      dec(aRect.Top, y);
      inc(aRect.Bottom, y);
      inc(aRect.Left, WidthOf(aRect) - WidthOf(R));
    end
    else if Flags or DT_LEFT = Flags then begin
      y := (HeightOf(R) - HeightOf(aRect)) div 2;
      dec(aRect.Top, y);
      inc(aRect.Bottom, y);
      inc(aRect.Right, WidthOf(R) - WidthOf(aRect));
    end;


    R := aRect;// := R;
    InflateRect(aRect, 1, 1);
  end;

  Canvas.Brush.Style := bsClear;
  if Text <> ''then
  if Enabled then begin
    DrawText(Canvas.Handle, Text, Length(Text), R, Flags);
  end
  else begin
    Rd := Rect(R.Left + 1, R.Top + 1, R.Right + 1, R.Bottom + 1);
    Canvas.Font.Color := ColorToRGB(clBtnHighlight);
    DrawText(Canvas.Handle, Text, Length(Text), Rd, Flags);

    Canvas.Font.Color := ColorToRGB(clBtnShadow);
    DrawText(Canvas.Handle, Text, Length(Text), R, Flags);
  end;
end;

procedure WriteTextOnDC(DC: hdc; Text: PChar; Enabled: boolean; var aRect : TRect; Flags: Cardinal);
var
  R, Rd: TRect;
  x, y : integer;
  ts: TSize;
begin
  R := aRect;
  SetBkMode(DC, TRANSPARENT);

  if Flags or DT_WORDBREAK <> Flags then begin // If no multiline

    GetTextExtentPoint32(DC, Text, Length(Text), ts);
    R.Right := R.Left + ts.cx;
    R.Bottom := R.Top + ts.cy;

    if Flags or DT_CENTER = Flags then begin
      y := (HeightOf(R) - HeightOf(aRect)) div 2;
      x := (WidthOf(R) - WidthOf(aRect)) div 2;
      InflateRect(aRect, x, y);
    end
    else if Flags or DT_RIGHT = Flags then begin
      y := (HeightOf(R) - HeightOf(aRect)) div 2;
      dec(aRect.Top, y);
12345

⌨️ 快捷键说明

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