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

📄 suipublic.pas

📁 SUIPack是一款为Delphi和C++Builder开发的所见即所得的界面增强VCL组件
💻 PAS
📖 第 1 页 / 共 3 页
字号:
////////////////////////////////////////////////////////////////////////////////
//
//
//  FileName    :   SUIPublic.pas
//  Creator     :   Shen Min
//  Date        :   2002-05-24
//  Comment     :
//
//  Copyright (c) 2002-2006 Sunisoft
//  http://www.sunisoft.com
//  Email: support@sunisoft.com
//
////////////////////////////////////////////////////////////////////////////////

unit SUIPublic;

interface

{$I SUIPack.inc}

uses Windows, Graphics, Controls, Messages, Classes, Forms, SysUtils,
     TypInfo, Math, Dialogs,
     SUIThemes, SUIMgr;

const
    SUI_ENTER = #13 + #10;
    SUI_2ENTER = SUI_ENTER + SUI_ENTER;


    procedure DoTrans(Canvas : TCanvas; Control : TWinControl);
    procedure TileDraw(const Canvas : TCanvas; const Picture : TPicture; const Rect : TRect);
    procedure SetWinControlTransparent(Control : TWinControl);
    procedure SpitBitmap(Source, Dest : TBitmap; Count, Index : Integer);
    procedure SpitDraw(Source : TBitmap; ACanvas : TCanvas; ARect : TRect; ATransparent : Boolean);
    procedure SpitDrawHorizontal(Source : TBitmap; ACanvas : TCanvas; ARect : TRect; ATransparent : Boolean; BGColor : TColor; SampleTopPt : Boolean = true);
    procedure SpitDrawHorizontal2(Source : TBitmap; ACanvas : TCanvas; ARect : TRect; ATransparent : Boolean; ATransColor : TColor);
    procedure DrawHorizontalGradient(const ACanvas : TCanvas; const ARect : TRect; const BeginColor, EndColor : TColor);
    procedure DrawVerticalGradient(const ACanvas : TCanvas; const ARect : TRect; const BeginColor, EndColor : TColor);

    procedure GetCaptionFont(const Font : TFont);
    function FormatStringWithWidth(Canvas: TCanvas; const szPath: string; nWidth: Integer): string;        

    procedure DrawControlBorder(WinControl : TWinControl; BorderColor, Color : TColor; DrawColor : Boolean = true);
    procedure RoundPicture(SrcBuf : TBitmap);
    procedure RoundPicture2(SrcBuf : TBitmap);
    procedure RoundPicture3(SrcBuf : TBitmap);

    procedure SetBitmapWindow(HandleOfWnd : HWND; const Bitmap : TBitmap; TransColor : TColor);

    function InRect(Point : TPoint; Rect : TRect) : Boolean; overload;
    function InRect(X, Y : Integer; Rect : TRect) : Boolean; overload;

    procedure PlaceControl(const Control : TControl; const Position : TPoint); overload;
    procedure PlaceControl(const Control : TControl; const Rect : TRect); overload;

    function GetWorkAreaRect() : TRect;
    function IsWinXP() : Boolean;
    function IsWinVista() : Boolean;

    function IsHasProperty(AComponent : TComponent; ApropertyName : String) : Boolean;
    function FormHasFocus(Form: TCustomForm): boolean;
    function PCharToStr(pstr : PChar) : String;

    procedure ContainerApplyUIStyle(Container : TWinControl; UIStyle : TsuiUIStyle; FileTheme : TsuiFileTheme);

    function SUIGetScrollBarInfo(Handle : THandle; idObject : Integer; var ScrollInfo : tagScrollBarInfo) : Boolean; stdcall;
    function SUIGetComboBoxInfo(hwndCombo: HWND; var pcbi: TComboBoxInfo): Boolean; stdcall;
    function SUIAnimateWindow(hWnd: HWND; dwTime: DWORD; dwFlags: DWORD): Boolean; stdcall;

    procedure ScanColor(const Bmp : TBitmap; SrcColor, TgtColor : TColor);
    procedure ResizeImage(SrcBmp : TBitmap; tgtCanvas: TCanvas; tgtRect: TRect);

    function GetLocaleButtonCaption(Button: TMsgDlgBtn): string;

var
    g_SUIPackConverting : Boolean = false;

implementation

procedure ResizeImage(SrcBmp : TBitmap; tgtCanvas: TCanvas; tgtRect: TRect);
begin
    SetStretchBltMode(tgtCanvas.Handle, HALFTONE);
    StretchBlt(tgtCanvas.Handle, tgtRect.Left, tgtRect.Top, tgtRect.Right - tgtRect.Left, tgtRect.Bottom - tgtRect.Top, SrcBmp.Canvas.Handle, 0, 0, SrcBmp.Width, SrcBmp.Height, SRCCOPY);
end;

procedure ScanColor(const Bmp : TBitmap; SrcColor, TgtColor : TColor);
var
    i, j : Integer;
begin
    Bmp.PixelFormat := pf24Bit;
    for i := 0 to Bmp.Width - 1 do
    begin
        for j := 0 to Bmp.Height - 1 do
        begin
            if Bmp.Canvas.Pixels[i, j] = SrcColor then
                Bmp.Canvas.Pixels[i, j] := TgtColor;
        end;
    end;
end;

procedure DoTrans(Canvas : TCanvas; Control : TWinControl);
var
    DC : HDC;
    SaveIndex : HDC;
    Position: TPoint;
begin
    if Control.Parent <> nil then
    begin
{$R-}
        DC := Canvas.Handle;
        SaveIndex := SaveDC(DC);
        GetViewportOrgEx(DC, Position);
        SetViewportOrgEx(DC, Position.X - Control.Left, Position.Y - Control.Top, nil);
        IntersectClipRect(DC, 0, 0, Control.Parent.ClientWidth, Control.Parent.ClientHeight);
        Control.Parent.Perform(WM_ERASEBKGND, DC, 0);
        Control.Parent.Perform(WM_PAINT, DC, 0);
        RestoreDC(DC, SaveIndex);
{$R+}
    end;
end;

procedure TileDraw(const Canvas : TCanvas; const Picture : TPicture; const Rect : TRect);
var
    i, j : Integer;
begin
    i := 0;
    While i < (Rect.Right - Rect.Left) + Picture.Width do
    begin
        j := 0;
        While j < (Rect.Bottom - Rect.Top) + Picture.Height do
        begin
            Canvas.Draw(i, j, Picture.Graphic);
            Inc(j, Picture.Height);
        end;
        Inc(i, Picture.Width);
    end;
end;

procedure SetWinControlTransparent(Control : TWinControl);
var
    WinStyle : DWORD;
begin
    Control.ControlStyle := Control.ControlStyle - [csOpaque];

    WinStyle := GetWindowLong(Control.Handle, GWL_EXSTYLE );
    WinStyle := WinStyle or WS_EX_TRANSPARENT;
    SetWindowLong(Control.Handle, GWL_EXSTYLE, WinStyle);
end;

function InRect(Point : TPoint; Rect : TRect) : Boolean;
begin
    Result := InRect(Point.X, Point.Y, Rect);
end;

function InRect(X, Y : Integer; Rect : TRect) : Boolean;
begin
    Result := false;

    if (
        (X >= Rect.Left) and
        (X <= Rect.Right) and
        (Y >= Rect.Top) and
        (Y <= Rect.Bottom)
    )then
        Result := True
end;

function GetWorkAreaRect() : TRect;
begin
{$IFDEF SUIPACK_D6UP}
    if (Application = nil) or (Application.MainForm = nil) then
{$ENDIF}
        SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0)
{$IFDEF SUIPACK_D6UP}
    else
        Result := Screen.MonitorFromWindow(Application.MainForm.Handle).WorkAreaRect;
{$ENDIF}
end;

procedure PlaceControl(const Control : TControl; const Position : TPoint);
begin
    Control.Left := Position.X;
    Control.Top := Position.Y;
end;

procedure PlaceControl(const Control : TControl; const Rect : TRect);
begin
    Control.Left := Rect.Left;
    Control.Top := Rect.Top;
    Control.Width := Rect.Right - Rect.Left;
    Control.Height := Rect.Bottom - Rect.Top;
end;

procedure SpitDraw(Source : TBitmap; ACanvas:TCanvas; ARect:TRect; ATransparent : Boolean);
var
    ImageList : TImageList;
    SR, DR, LR1, LR2, LR3, LR4 : TRect;
    TempBmp : TBitmap;
    TransColor : TColor;
    DW, DH : Integer;
    TempInt : Integer;
begin
    TransColor := clFuchsia;//Source.Canvas.Pixels[0, 0];
    DW := ARect.Right - ARect.Left;
    DH := ARect.Bottom - ARect.Top;

    // left-top
    SR := Rect(0, 0, Source.Width div 2, Source.Height div 2);
    DR := Rect(0, 0, DW div 2, DH div 2);
    TempBmp := TBitmap.Create();
    TempInt := Min(SR.Right - SR.Left, DR.Right - DR.Left);
    if TempInt < 0 then
        TempInt := 0;
    TempBmp.Width := TempInt;
    TempInt := Min(SR.Bottom - SR.Top, DR.Bottom - DR.Top);
    if TempInt < 0 then
        TempInt := 0;
    TempBmp.Height := TempInt;

    if (TempBmp.Height <> 0) and (TempBmp.Width <> 0) then
    begin
        if TempBmp.Width < (SR.Right - SR.Left) then
            SR.Right := SR.Right - (SR.Right - SR.Left) + TempBmp.Width;

        if TempBmp.Height < (SR.Bottom - SR.Top) then
            SR.Bottom := SR.Bottom - (SR.Bottom - SR.Top) + TempBmp.Height;

        TempBmp.Canvas.CopyRect(Rect(0, 0, TempBmp.Width, TempBmp.Height), Source.Canvas, SR);
        ImageList := TImageList.CreateSize(TempBmp.Width, TempBmp.Height);
        if ATransparent then
            ImageList.AddMasked(TempBmp, TransColor)
        else
            ImageList.Add(TempBmp, nil);
        ImageList.Draw(ACanvas, 0, 0, 0);
        ImageList.Free();
        LR1 := Rect(0, 0, TempBmp.Width, TempBmp.Height);
    end;
    TempBmp.Free();

    // left-bottom
    SR := Rect(0, Source.Height - (Source.Height div 2) + 1, Source.Width div 2, Source.Height);
    DR := Rect(0, DH - (DH div 2) + 1, DW div 2, DH);
    TempBmp := TBitmap.Create();
    TempInt := Min(SR.Right - SR.Left, DR.Right - DR.Left);
    if TempInt < 0 then
        TempInt := 0;
    TempBmp.Width := TempInt;
    TempInt := Min(SR.Bottom - SR.Top, DR.Bottom - DR.Top);
    if TempInt < 0 then
        TempInt := 0;
    TempBmp.Height := TempInt;

    if (TempBmp.Height <> 0) and (TempBmp.Width <> 0) then
    begin
        if TempBmp.Height < (SR.Bottom - SR.Top) then
            SR.Top := SR.Top + (SR.Bottom - SR.Top) - TempBmp.Height;

        if TempBmp.Width < (SR.Right - SR.Left) then
            SR.Right := SR.Right - (SR.Right - SR.Left) + TempBmp.Width;

        TempBmp.Canvas.CopyRect(Rect(0, 0, TempBmp.Width, TempBmp.Height), Source.Canvas, SR);
        ImageList := TImageList.CreateSize(TempBmp.Width, TempBmp.Height);
        if ATransparent then
            ImageList.AddMasked(TempBmp, TransColor)
        else
            ImageList.Add(TempBmp, nil);
        ImageList.Draw(ACanvas, 0, ARect.Bottom - TempBmp.Height, 0);
        ImageList.Free();
        LR2 := Rect(0, ARect.Bottom - TempBmp.Height, TempBmp.Width, ARect.Bottom);
    end;
    TempBmp.Free();

    // left-center
    SR := Rect(0, Source.Height div 2, Source.Width div 2, Source.Height - (Source.Height div 2));
    DR := Rect(0, LR1.Bottom, LR1.Right, LR2.Top);

    TempBmp := TBitmap.Create();
    TempBmp.Width := DR.Right - DR.Left;
    TempBmp.Height := DR.Bottom - DR.Top;

    if (TempBmp.Height <> 0) and (TempBmp.Width <> 0) then
    begin
        if TempBmp.Width < (SR.Right - SR.Left) then
            SR.Right := SR.Right - (SR.Right - SR.Left) + TempBmp.Width;

        TempBmp.Canvas.CopyRect(Rect(0, 0, TempBmp.Width, TempBmp.Height), Source.Canvas, SR);
        TempBmp.TransparentColor := TransColor;
        TempBmp.Transparent := true;
        ACanvas.StretchDraw(DR, TempBmp);
    end;
    TempBmp.Free();

    // right-top
    SR := Rect(Source.Width - (Source.Width div 2) + 1, 0, Source.Width, Source.Height div 2);
    DR := Rect(DW - (DW div 2) + 1, 0, DW, DH div 2);
    TempBmp := TBitmap.Create();
    TempInt := Min(SR.Right - SR.Left, DR.Right - DR.Left);
    if TempInt < 0 then
        TempInt := 0;
    TempBmp.Width := TempInt;
    TempInt := Min(SR.Bottom - SR.Top, DR.Bottom - DR.Top);
    if TempInt < 0 then
        TempInt := 0;
    TempBmp.Height := TempInt;

    if (TempBmp.Height <> 0) and (TempBmp.Width <> 0) then
    begin
        if TempBmp.Width < (SR.Right - SR.Left) then
            SR.Left := SR.Left + (SR.Right - SR.Left) - TempBmp.Width;

        if TempBmp.Height < (SR.Bottom - SR.Top) then
            SR.Bottom := SR.Bottom - (SR.Bottom - SR.Top) + TempBmp.Height;

        TempBmp.Canvas.CopyRect(Rect(0, 0, TempBmp.Width, TempBmp.Height), Source.Canvas, SR);
        ImageList := TImageList.CreateSize(TempBmp.Width, TempBmp.Height);
        if ATransparent then
            ImageList.AddMasked(TempBmp, TransColor)
        else
            ImageList.Add(TempBmp, nil);
        ImageList.Draw(ACanvas, ARect.Right - TempBmp.Width, 0, 0);
        ImageList.Free();
        LR3 := Rect(ARect.Right - TempBmp.Width, 0, ARect.Right, TempBmp.Height)
    end;
    TempBmp.Free();

    // right-bottom
    SR := Rect(Source.Width - (Source.Width div 2) + 1, Source.Height - (Source.Height div 2) + 1, Source.Width, Source.Height);
    DR := Rect(DW - (DW div 2) + 1, DH - (DH div 2) + 1, DW, DH);
    TempBmp := TBitmap.Create();
    TempInt := Min(SR.Right - SR.Left, DR.Right - DR.Left);
    if TempInt < 0 then
        TempInt := 0;
    TempBmp.Width := TempInt;
    TempInt := Min(SR.Bottom - SR.Top, DR.Bottom - DR.Top);
    if TempInt < 0 then
        TempInt := 0;
    TempBmp.Height := TempInt;

    if (TempBmp.Height <> 0) and (TempBmp.Width <> 0) then
    begin
        if TempBmp.Width < (SR.Right - SR.Left) then
            SR.Left := SR.Left + (SR.Right - SR.Left) - TempBmp.Width;

        if TempBmp.Height < (SR.Bottom - SR.Top) then
            SR.Top := SR.Top + (SR.Bottom - SR.Top) - TempBmp.Height;

        TempBmp.Canvas.CopyRect(Rect(0, 0, TempBmp.Width, TempBmp.Height), Source.Canvas, SR);
        ImageList := TImageList.CreateSize(TempBmp.Width, TempBmp.Height);
        if ATransparent then

⌨️ 快捷键说明

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