suipublic.pas

SUIPack是一款为Delphi和C++Builder开发的所见即所得的界面增强VCL组件

    for i := 0 to SrcBuf.Height do
        for j := 0 to SrcBuf.Width do
            Buf.Canvas.Pixels[i, (SrcBuf.Width - j - 1)] :=
                SrcBuf.Canvas.Pixels[j, i];

    SrcBuf.Height := Buf.Height;
    SrcBuf.Width := Buf.Width;
    SrcBuf.Canvas.Draw(0, 0, Buf);

    Buf.Free();
end;

procedure RoundPicture2(SrcBuf : TBitmap);
var
    Buf : TBitmap;
    i, j : Integer;
begin
    Buf := TBitmap.Create();

    Buf.Width := SrcBuf.Width;
    Buf.Height := SrcBuf.Height;

    for i := 0 to SrcBuf.Width do
        for j := 0 to SrcBuf.Height do
            Buf.Canvas.Pixels[SrcBuf.Width - 1 - i, (SrcBuf.Height - j - 1)] :=
                SrcBuf.Canvas.Pixels[i, j];

    SrcBuf.Canvas.Draw(0, 0, Buf);

    Buf.Free();
end;

procedure RoundPicture3(SrcBuf : TBitmap);
var
    Buf : TBitmap;
    i, j : Integer;
begin
    Buf := TBitmap.Create();

    Buf.Width := SrcBuf.Height;
    Buf.Height := SrcBuf.Width;

    for i := 0 to SrcBuf.Height do
        for j := 0 to SrcBuf.Width do
            Buf.Canvas.Pixels[i, j] := SrcBuf.Canvas.Pixels[j, SrcBuf.Height - i - 1];

    SrcBuf.Height := Buf.Height;
    SrcBuf.Width := Buf.Width;
    SrcBuf.Canvas.Draw(0, 0, Buf);

    Buf.Free();
end;

function IsHasProperty(AComponent : TComponent; ApropertyName : String) : Boolean;
var
    PropInfo : PPropInfo;
begin
    PropInfo := GetPropInfo(AComponent.ClassInfo, APropertyName);
    Result := PropInfo <> nil;
end;

procedure SpitBitmap(Source, Dest : TBitmap; Count, Index : Integer);
var
    TempBmp : TBitmap;
begin
    TempBmp := TBitmap.Create();
    try
        TempBmp.Height := Source.Height;
        TempBmp.Width := Source.Width div Count;
        if Count = Index then
            TempBmp.Canvas.CopyRect(Rect(0, 0, TempBmp.Width, TempBmp.Height), Source.Canvas, Rect(Source.Width - TempBmp.Width, 0, Source.Width, TempBmp.Height))
        else
            TempBmp.Canvas.CopyRect(Rect(0, 0, TempBmp.Width, TempBmp.Height), Source.Canvas, Rect(TempBmp.Width * (Index - 1), 0, TempBmp.Width * Index, TempBmp.Height));
        Dest.Height := TempBmp.Height;
        Dest.Width := TempBmp.Width;
        Dest.Canvas.CopyRect(Rect(0, 0, TempBmp.Width, TempBmp.Height), TempBmp.Canvas, Rect(0, 0, TempBmp.Width, TempBmp.Height));
    finally
        TempBmp.Free();
    end;
end;

function FormHasFocus(Form: TCustomForm): boolean;
var
    hActiveChild: THandle;
begin
    Result := False;

    if Application.MainForm = nil then
    begin
        Result := Form.Active;
        Exit;
    end;

    if (
        (Application.MainForm.FormStyle = fsMDIForm) and
        (Form = Application.MainForm)
    ) then
    begin
        Result := true;
        Exit;
    end;
    if not Application.Active then
        Exit;
    if Application.MainForm = nil then
    begin
        Result := Form.Active;
        Exit;
    end;

    if (Form <> nil) and (Form <> Application.MainForm) then
    begin
        if Application.MainForm.FormStyle = fsMDIForm then
        begin
            hActiveChild := THandle(SendMessage(Application.MainForm.ClientHandle, WM_MDIGETACTIVE, 0, 0 ));
            if hActiveChild <> Form.Handle then
            begin
                if not Form.Active then
                    Exit;
            end;
        end
        else
        begin
            if not Form.Active then
                Exit;
        end;
    end;
    Result := True;
end;

var
    l_IsWinXP : Boolean = false;
    l_IsWinVista : Boolean = false;

function LocalIsWinXP() : Boolean;
var
    OS :TOSVersionInfo;
begin
    ZeroMemory(@OS,SizeOf(OS));
    OS.dwOSVersionInfoSize := SizeOf(OS);
    GetVersionEx(OS);
    Result := (
        (OS.dwMajorVersion >= 5) and
        (OS.dwMinorVersion >= 1) and
        (OS.dwPlatformId = VER_PLATFORM_WIN32_NT)
    );
end;

function LocalIsWinVista() : Boolean;
var
    OS : TOSVersionInfo;
begin
    ZeroMemory(@OS,SizeOf(OS));
    OS.dwOSVersionInfoSize := SizeOf(OS);
    GetVersionEx(OS);
    result := (
        (OS.dwMajorVersion = 6) and
        (OS.dwMinorVersion = 0) and
        (OS.dwPlatformId = VER_PLATFORM_WIN32_NT)
    );
end;

procedure ContainerApplyUIStyle(Container : TWinControl; UIStyle : TsuiUIStyle; FileTheme : TsuiFileTheme);
var
    i : Integer;
begin
    with Container do
    begin
        for i := 0 to ControlCount - 1 do
        begin
            if (
                (IsHasProperty(Controls[i], 'FileTheme')) and
                (IsHasProperty(Controls[i], 'UIStyle'))
            ) then
            begin
                SetObjectProp(Controls[i], 'FileTheme', FileTheme);
                SetOrdProp(Controls[i], 'UIStyle', Ord(UIStyle));
            end;
//            if Controls[i] is TWinControl then
//               ContainerApplyUIStyle(Controls[i] as TWinControl, UiStyle, FileTheme);
        end;
    end; // with
end;

type
    TsuiFunc1 = function (Handle : THandle; idObject : Integer; var ScrollInfo : tagScrollBarInfo) : Boolean; stdcall;
    TsuiFunc2 = function (hwndCombo: HWND; var pcbi: TComboBoxInfo): Boolean; stdcall;
    TsuiFunc3 = function (hWnd: HWND; dwTime: DWORD; dwFlags: DWORD): Boolean; stdcall;
    
var
    l_Func1 : TsuiFunc1 = nil;
    l_Func2 : TsuiFunc2 = nil;
    l_Func3 : TsuiFunc3 = nil;
    l_Win95 : Boolean = false;
    l_Win95_2 : Boolean = false;
    l_DllUser32 : THandle = 0;

function SUIGetScrollBarInfo(Handle : THandle; idObject : Integer; var ScrollInfo : tagScrollBarInfo) : Boolean; stdcall;
begin
    Result := false;
    if l_Win95 then
        Exit;
    if (not l_Win95) and not Assigned(l_Func1) then
    begin
        if l_DllUser32 = 0 then
            l_DllUser32 := LoadLibrary('User32.dll');
        l_Func1 := GetProcAddress(l_DllUser32, 'GetScrollBarInfo');
        if not Assigned(l_Func1) then
        begin
            l_Win95 := true;
            Exit;
        end;
    end;
    if Assigned(l_Func1) then
        Result := l_Func1(Handle, idObject, ScrollInfo);
end;

function SUIGetComboBoxInfo(hwndCombo: HWND; var pcbi: TComboBoxInfo): Boolean; stdcall;
begin
    Result := false;
    if l_Win95 then
        Exit;    
    if (not l_Win95) and not Assigned(l_Func2) then
    begin
        if l_DllUser32 = 0 then
            l_DllUser32 := LoadLibrary('User32.dll');
        l_Func2 := GetProcAddress(l_DllUser32, 'GetComboBoxInfo');
        if not Assigned(l_Func2) then
        begin
            l_Win95 := true;       
            Exit;
        end;
    end;
    if Assigned(l_Func2) then
        Result := l_Func2(hwndCombo, pcbi);
end;

function SUIAnimateWindow(hWnd: HWND; dwTime: DWORD; dwFlags: DWORD): Boolean; stdcall;
begin
    Result := false;
    if l_Win95_2 then
        Exit;
    if (not l_Win95_2) and not Assigned(l_Func3) then
    begin
        if l_DllUser32 = 0 then
            l_DllUser32 := LoadLibrary('User32.dll');
        l_Func3 := GetProcAddress(l_DllUser32, 'AnimateWindow');
        if not Assigned(l_Func3) then
        begin
            l_Win95_2 := true;          
            Exit;
        end;
    end;
    if Assigned(l_Func3) then
        Result := l_Func3(hWnd, dwTime, dwFlags);
end;

function GetLocaleButtonCaption(Button: TMsgDlgBtn): string;
var
    pStr: PChar;
    uID: Integer;
begin
    Result := '';
    uID := 0;
    case Button of
    mbYes: uID := 805;
    mbNo: uID := 806;
    mbOK: uID := 800;
    mbCancel: uID := 801;
    mbAbort: uID := 802;
    mbRetry: uID := 803;
    mbIgnore: uID := 804;
    mbHelp: uID := 808;
    mbAll: Result := 'All';
    mbNoToAll: Result := 'No to All';
    mbYesToAll: Result := 'Yes to All';
    end;

    if uID > 0 then
    begin
        if l_DllUser32 = 0 then
            l_DllUser32 := LoadLibrary('User32.dll');
        if l_DllUser32 <> 0 then
        begin
            GetMem(pStr, 64);
            if LoadString(l_DllUser32, uID, pStr, 64) > 0 then
                Result := StrPas(pStr);
            FreeMem(pStr);
        end;
    end;
end;

procedure GetCaptionFont(const Font : TFont);
var
    FNonCLientMetrics : TNonCLientMetrics;
begin
    FNonCLientMetrics.cbSize := Sizeof(TNonCLientMetrics);
    if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @FNonCLientMetrics, 0) then
    begin
        Font.Handle := CreateFontIndirect(FNonCLientMetrics.lfCaptionFont);
    end;
end;

function FormatStringWithWidth(Canvas: TCanvas; const szPath: string; nWidth: Integer): string;
var
    nNewWidth: Integer;
    nLeftPos : Integer;
begin
    Result := szPath;
    nNewWidth := Canvas.TextWidth(Result);
    if (nNewWidth <= nWidth) then
        exit;
    nLeftPos := 1;

    while (nLeftPos < Length(szPath)) do
    begin
        Result := Copy(szPath, 1, nLeftPos) + '...';

        nNewWidth := Canvas.TextWidth(Result);
        if (nNewWidth >= nWidth) then
            exit;

        inc(nLeftPos);
    end;

    Result := szPath;
end;

function IsWinXP() : Boolean;
begin
    Result := l_IsWinXP;
end;

function IsWinVista() : Boolean;
begin
    Result := l_IsWinVista;
end;

initialization
    l_IsWinXP := LocalIsWinXP();
    l_IsWinVista := LocalIsWinVista();

finalization
    if l_DllUser32 <> 0 then
        FreeLibrary(l_DllUser32);

end.