suipublic.pas

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

            ImageList.AddMasked(TempBmp, TransColor)
        else
            ImageList.Add(TempBmp, nil);
        ImageList.Draw(ACanvas, ARect.Right - TempBmp.Width, ARect.Bottom - TempBmp.Height, 0);
        ImageList.Free();
        LR4 := Rect(ARect.Right - TempBmp.Width, ARect.Bottom - TempBmp.Height, ARect.Right, ARect.Bottom);
    end;
    TempBmp.Free();

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

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

    // 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; BGColor : TColor; 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);

    if ARect.Right - ARect.Left < ImageList.Width then
    begin
        TempBuf := TBitmap.Create();
        TempBuf.Width := ARect.Right - ARect.Left;
        ImageList.Draw(TempBuf.Canvas, 0, 0, 0);
        ACanvas.Draw(ARect.Left, ARect.Top, TempBuf);
        TempBuf.Free();
    end
    else
    begin
        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();
        TempBuf.Height := Source.Height;
        TempBuf.Width := ImageList.Width;
        TempBuf.Canvas.Brush.Color := BGColor;
        TempBuf.Canvas.FillRect(Rect(0, 0, TempBuf.Width, TempBuf.Height));
        ImageList.GetBitmap(1, TempBuf);
        ACanvas.StretchDraw(R, TempBuf);
        TempBuf.Free();
    end;

    ImageList.Free();    
end;

procedure SpitDrawHorizontal2(Source : TBitmap; ACanvas : TCanvas; ARect : TRect; ATransparent : Boolean; ATransColor : TColor);
var
    ImageList : TImageList;
    R : TRect;
    TempBuf : TBitmap;
begin
    ImageList := TImageList.Create(nil);
    ImageList.Height := Source.Height;
    ImageList.Width := Source.Width div 3;
    if ATransparent then
        ImageList.AddMasked(Source, ATransColor)
    else
        ImageList.Add(Source, nil);

    TempBuf := TBitmap.Create();
    if ImageList.Width > ARect.Right - ARect.Left then
    begin
        ImageList.GetBitmap(0, TempBuf);
        TempBuf.Width := ARect.Right - ARect.Left;
        ACanvas.Draw(ARect.Left, ARect.Top, TempBuf);
    end
    else
    begin
        ImageList.Draw(ACanvas, ARect.Left, ARect.Top, 0);
        ImageList.Draw(ACanvas, ARect.Right - ImageList.Width, ARect.Top, 2);
        ImageList.GetBitmap(1, TempBuf);
        R := Rect(ARect.Left + ImageList.Width, ARect.Top, ARect.Right - ImageList.Width, ARect.Top + Source.Height);
        ACanvas.StretchDraw(R, TempBuf);
    end;
    TempBuf.Free();

    ImageList.Free();
end;

type
    TColorRec = packed record
    case Integer of
    0: (Value: Longint);
    1: (Red, Green, Blue: Byte);
    2: (R, G, B, Flag: Byte);
    {$IFDEF MSWINDOWS}
    3: (Index: Word); // GetSysColor, PaletteIndex
    {$ENDIF MSWINDOWS}
     end;

function RGBToColor(r, g, b : Byte) : TColor;
begin
    TColorRec(Result).Red := r;
    TColorRec(Result).Green := g;
    TColorRec(Result).Blue := b;
    TColorRec(Result).Flag := 0;
end;

procedure ColorToRGB(Color : TColor; out r, g, b : Byte);
var
    Temp: TColorRec;
begin
    Temp.Value := Graphics.ColorToRGB(Color);
    r := Temp.R;
    g := Temp.G;
    b := Temp.B;
end;

procedure DrawHorizontalGradient(const ACanvas : TCanvas; const ARect : TRect; const BeginColor, EndColor : TColor);
var
    i : Integer;
    cr, cg, cb : byte;
    begin_r, begin_g, begin_b : byte;
    end_r, end_g, end_b : byte;
begin
    if ARect.Bottom = ARect.Top then
        Exit;
    ColorToRGB(BeginColor, begin_r, begin_g, begin_b);
    ColorToRGB(EndColor, end_r, end_g, end_b);

    ACanvas.Pen.Color := BeginColor;
    ACanvas.MoveTo(ARect.Left, ARect.Top);
    ACanvas.LineTo(ARect.Right, ARect.Top);
    for i := ARect.Top + 1 to ARect.Bottom - 2 do
    begin
        cr := begin_r + Trunc((end_r - begin_r) / (ARect.Bottom - ARect.Top) * (i - ARect.Top - 1));
        cg := begin_g + Trunc((end_g - begin_g) / (ARect.Bottom - ARect.Top) * (i - ARect.Top - 1));
        cb := begin_b + Trunc((end_b - begin_b) / (ARect.Bottom - ARect.Top) * (i - ARect.Top - 1));
        ACanvas.Pen.Color := RGBToColor(cr, cg, cb);
        ACanvas.MoveTo(ARect.Left, i);
        ACanvas.LineTo(ARect.Right, i);
    end;

    ACanvas.Pen.Color := EndColor;
    ACanvas.MoveTo(ARect.Left, ARect.Bottom - 1);
    ACanvas.LineTo(ARect.Right, ARect.Bottom - 1);
end;

procedure DrawVerticalGradient(const ACanvas : TCanvas; const ARect : TRect; const BeginColor, EndColor : TColor);
var
    i : Integer;
    cr, cg, cb : byte;
    begin_r, begin_g, begin_b : byte;
    end_r, end_g, end_b : byte;
begin
    if ARect.Right = ARect.Left then
        Exit;
    ColorToRGB(BeginColor, begin_r, begin_g, begin_b);
    ColorToRGB(EndColor, end_r, end_g, end_b);

    ACanvas.Pen.Color := BeginColor;
    ACanvas.MoveTo(ARect.Left, ARect.Top);
    ACanvas.LineTo(ARect.Left, ARect.Bottom);
    for i := ARect.Left + 1 to ARect.Right - 2 do
    begin
        cr := begin_r + Trunc((end_r - begin_r) / (ARect.Right - ARect.Left) * (i - ARect.Left));
        cg := begin_g + Trunc((end_g - begin_g) / (ARect.Right - ARect.Left) * (i - ARect.Left));
        cb := begin_b + Trunc((end_b - begin_b) / (ARect.Right - ARect.Left) * (i - ARect.Left));
        ACanvas.Pen.Color := RGBToColor(cr, cg, cb);
        ACanvas.MoveTo(i, ARect.Top);
        ACanvas.LineTo(i, ARect.Bottom);
    end;

    ACanvas.Pen.Color := EndColor;
    ACanvas.MoveTo(ARect.Right - 1, ARect.Top);
    ACanvas.LineTo(ARect.Right - 1, ARect.Bottom);
end;

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

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