suipublic.pas

Delphi界面控件修饰

        TempBmp.TransparentColor := TransColor;
        TempBmp.Transparent := true;
        ACanvas.StretchDraw(DR, TempBmp);
    end;
    TempBmp.Free();

    // center-center
    SR := Rect(Source.Width div 2, Source.Height div 2, Source.Width - (Source.Width div 2) + 1, Source.Height - (Source.Height div 2));
    DR := Rect(LR1.Right, LR1.Bottom, LR3.Left, LR4.Top - 1);
    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
        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();

    // center-bottom
    SR := Rect(Source.Width div 2, Source.Height - (Source.Height div 2), Source.Width - (Source.Width div 2) + 1, Source.Height);
    DR := Rect(LR1.Right - 1, LR2.Top - 1, LR4.Left, LR4.Bottom);
    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.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);
        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);
var
    ImageList : TImageList;
    TransColor : TColor;
    R : TRect;
    TempBuf : TBitmap;
begin
    TransColor := Source.Canvas.Pixels[0, 0];
    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.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[i, j];

    SrcBuf.Height := Buf.Height;
    SrcBuf.Width := Buf.Width;
    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_IsWin95 : Boolean = false;

function LocalIsWin95() : Boolean;
var
    OS : TOSVersionInfo;
begin
    ZeroMemory(@OS,SizeOf(OS));
    OS.dwOSVersionInfoSize := SizeOf(OS);
    GetVersionEx(OS);
    result := (
        (OS.dwMajorVersion >= 4) and
        (OS.dwMinorVersion = 0) and
        (lo(OS.dwBuildNumber) > 1000) and
        (OS.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS)
    );
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;

function IsWin95() : Boolean;
begin
    Result := l_IsWin95;
end;

initialization
    l_IsWin95 := LocalIsWin95();

end.