suipublic.pas

suipack ver5控件 suipack ver5控件 suipack ver5控件 suipack ver5控件 suipack ver5控件

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

        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();
end;

procedure DrawControlBorder(WinControl : TWinControl; BorderColor, Color : TColor; DrawColor : Boolean = true);
var
    DC : HDC;
    Brush : HBRUSH;
    R: TRect;
begin
    DC := GetWindowDC(WinControl.Handle);

    GetWindowRect(WinControl.Handle, R);
    OffsetRect(R, -R.Left, -R.Top);

    Brush := CreateSolidBrush(ColorToRGB(BorderColor));
    FrameRect(DC, R, Brush);
    DeleteObject(Brush);

    if DrawColor then
    begin
        Brush := CreateSolidBrush(ColorToRGB(Color));
        R := Rect(R.Left + 1, R.Top + 1, R.Right - 1, R.Bottom - 1);
        FrameRect(DC, R, Brush);
        DeleteObject(Brush);
    end;

    ReleaseDC(WinControl.Handle, DC);
end;

{$WARNINGS OFF}
function PCharToStr(pstr : PChar) : String;
begin
    if StrLen(pstr) = 0 then
        Result := ''
    else
    begin
        Result := pstr;
        SetLength(Result, StrLen(pstr));
    end;
end;
{$WARNINGS ON}

procedure SetBitmapWindow(HandleOfWnd : HWND; const Bitmap : TBitmap; TransColor : TColor);
var
    i, j : Integer;
    Left, Right : Integer;
    PreWhite : Boolean;
    TempRgn : HRgn;
    Rgn : HRgn;
begin
    Rgn := CreateRectRgn(0, 0, 0, 0);

    for i := 0 to Bitmap.Height - 1 do
    begin
        Left := 0;
        Right := 0;
        PreWhite := true;

        for j := 0 to Bitmap.Width - 1 do
        begin
            if (
                (Bitmap.Canvas.Pixels[j, i] = TransColor) or
                (j = Bitmap.Width - 1)
            ) then
            begin
                if (not PreWhite) then
                begin
                    TempRgn := CreateRectRgn(Left, i, Right + 1, i + 1);
                    CombineRgn(Rgn, Rgn, TempRgn, RGN_OR);
                    DeleteObject(TempRgn);
                end;
                PreWhite := true;
            end
            else
            begin
                if PreWhite then
                begin
                    Left := j;
                    Right := j;
                end
                else
                    Inc(Right);
                PreWhite := false;
            end;
        end;
    end;

    SetWindowRgn(HandleOfWnd, Rgn, true);
    DeleteObject(Rgn);
end;

procedure SpitDrawHorizontal(Source : TBitmap; ACanvas : TCanvas; ARect : TRect; ATransparent : Boolean; SampleTopPt : Boolean);
var
    ImageList : TImageList;
    TransColor : TColor;
    R : TRect;
    TempBuf : TBitmap;
begin
    if SampleTopPt then
        TransColor := Source.Canvas.Pixels[0, 0]
    else
        TransColor := Source.Canvas.Pixels[0, Source.Height - 1];
    ImageList := TImageList.Create(nil);
    ImageList.Height := Source.Height;
    ImageList.Width := Source.Width div 3;
    if ATransparent then
        ImageList.AddMasked(Source, TransColor)
    else
        ImageList.AddMasked(Source, clFuchsia);

    ImageList.Draw(ACanvas, ARect.Left, ARect.Top, 0);
    ImageList.Draw(ACanvas, ARect.Right - ImageList.Width, ARect.Top, 2);
    R := Rect(ARect.Left + ImageList.Width, ARect.Top, ARect.Right - ImageList.Width, ARect.Bottom);
    TempBuf := TBitmap.Create();
    ImageList.GetBitmap(1, TempBuf);
    ACanvas.StretchDraw(R, TempBuf);
    TempBuf.Free();

    ImageList.Free();
end;

procedure RoundPicture(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, (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;
        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;

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;

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 IsWinXP() : Boolean;
begin
    Result := l_IsWinXP;
end;

initialization
    l_IsWinXP := LocalIsWinXP();

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

end.