suiimagepanel.pas

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

procedure TsuiCustomPanel.SetCaptionPosX(const Value: Integer);
begin
    m_CaptionPosX := Value;

    RePaint();
end;

procedure TsuiCustomPanel.SetCaptionPosY(const Value: Integer);
begin
    m_CaptionPosY := Value;

    RePaint();
end;

procedure TsuiCustomPanel.SetDrawStyle(const Value: TsuiDrawStyle);
begin
    m_DrawStyle := Value;

    ClearPanel();
    Repaint();
end;

procedure TsuiCustomPanel.SetPicture(const Value: TPicture);
begin
    m_Picture.Assign(Value);

    ClearPanel();
    Repaint();
end;

procedure TsuiCustomPanel.SetTransparent(const Value: Boolean);
begin
    m_Transparent := Value;

    if m_Picture.Graphic <> nil then
        ApplyTransparent();
    Repaint();
end;

procedure TsuiCustomPanel.WMERASEBKGND(var Msg: TMessage);
begin
    if m_EraseBackground then
        inherited;
end;

{ TsuiPanel }

procedure TsuiPanel.AlignControls(AControl: TControl; var Rect: TRect);
begin
    Rect.Left := Rect.Left + 3;
    Rect.Right := Rect.Right - 3;
    Rect.Bottom := Rect.Bottom - 3;
    Rect.Top := m_TitleBitmap.Height + 3;
    inherited AlignControls(AControl, Rect);
end;

constructor TsuiPanel.Create(AOwner: TComponent);
begin
    inherited;

    m_TitleBitmap := TBitmap.Create();
    m_ShowButton := true;
    m_InButton := false;
    m_Poped := true;
    m_Moving := false;
    Width := 100;
    Height := 100;
    m_FromTheme := false;
    m_EraseBackground := false;

    UIStyle := GetSUIFormStyle(AOwner);    
end;

destructor TsuiPanel.Destroy;
begin
    m_TitleBitmap.Free();
    
    inherited;
end;

function TsuiPanel.GetPushed: Boolean;
begin
    Result := not m_Poped;
end;

procedure TsuiPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
    inherited;
    if (m_ShowButton) and (Y <= m_TitleBitmap.Height) then
        PaintButton();
end;

procedure TsuiPanel.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
    inherited;

    if Button <> mbLeft then
        Exit;

    if m_InButton then
    begin
        if m_Poped then
            Push()
        else
            Pop();
    end;
    Repaint();
end;

procedure TsuiPanel.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
    inherited;
    if (
        (Operation = opRemove) and
        (AComponent = m_FileTheme)
    )then
    begin
        m_FileTheme := nil;
        ContainerApplyUIStyle(self, SUI_THEME_DEFAULT, nil);
        SetUIStyle(SUI_THEME_DEFAULT);        
    end;
end;

procedure TsuiPanel.Paint;
var
    Buf : TBitmap;
    R : TRect;
    Btn : TBitmap;
    MousePoint : TPoint;
    Index : Integer;    
begin
    Buf := TBitmap.Create();
    Buf.Width := inherited Width;
    Buf.Height := Height;

    Buf.Canvas.Brush.Color := Color;
    Buf.Canvas.Pen.Color := m_BorderColor;
    Buf.Canvas.Rectangle(ClientRect);

    R := Rect(1, 0, inherited Width - 1, m_TitleBitmap.Height);
    Buf.Canvas.StretchDraw(R, m_TitleBitmap);

    Buf.Canvas.Brush.Style := bsClear;
    Buf.Canvas.Font.Assign(Font);
    Buf.Canvas.Font.Color := m_CaptionFontColor;

    if (BidiMode = bdRightToLeft) and SysLocale.MiddleEast then
    begin
        Dec(R.Right, 10);
        if m_ShowButton and (Align <> alClient) and (Align <> alLeft) and (Align <> alRight) then
            Dec(R.Right, 10);
        DrawText(Buf.Canvas.Handle, PChar(Caption), -1, R, DT_VCENTER or DT_SINGLELINE or DT_RIGHT);
        R.Right := inherited Width - 1;
    end
    else
    begin
        R.Left := 10;
        DrawText(Buf.Canvas.Handle, PChar(Caption), -1, R, DT_VCENTER or DT_SINGLELINE or DT_LEFT);
    end;

    if m_ShowButton and (Align <> alClient) and (Align <> alLeft) and (Align <> alRight) then
    begin
        Btn := TBitmap.Create();
        Btn.LoadFromResourceName(hInstance, 'PANEL_BUTTON');
        R.Left := R.Right - Btn.Width div 4 - 4;
        R.Top := (R.Bottom - Btn.Height) div 2;
        R.Bottom := R.Top + Btn.Height;
        R.Right := R.Left + Btn.Width div 4;
        GetCursorPos(MousePoint);
        MousePoint := ScreenToClient(MousePoint);
        if InRect(MousePoint, R) then
        begin
            if m_Poped then
                Index := 2
            else
                Index := 4;
            m_InButton := true;
        end
        else
        begin
            if m_Poped then
                Index := 1
            else
                Index := 3;
            m_InButton := false;
        end;
        SpitBitmap(Btn, Btn, 4, Index);
        Buf.Canvas.Draw(Width - Btn.Width - 4, (R.Bottom - Btn.Height) div 2 + 2, Btn);
        Btn.Free();
    end;

    BitBlt(Canvas.Handle, 0, 0, Width, Height, Buf.Canvas.Handle, 0, 0, SRCCOPY);

    Buf.Free();
end;

procedure TsuiPanel.PaintButton;
var
    Btn : TBitmap;
    R : TRect;
    MousePoint : TPoint;
    Index : Integer;
begin
    R := Rect(1, 0, inherited Width - 1, m_TitleBitmap.Height);
    if m_ShowButton and (Align <> alClient) and (Align <> alLeft) and (Align <> alRight) then
    begin
        Btn := TBitmap.Create();
        Btn.LoadFromResourceName(hInstance, 'PANEL_BUTTON');
        R.Left := R.Right - Btn.Width div 4 - 4;
        R.Top := (R.Bottom - Btn.Height) div 2;
        R.Bottom := R.Top + Btn.Height;
        R.Right := R.Left + Btn.Width div 4;
        GetCursorPos(MousePoint);
        MousePoint := ScreenToClient(MousePoint);
        if InRect(MousePoint, R) then
        begin
            if m_Poped then
                Index := 2
            else
                Index := 4;
            m_InButton := true;
        end
        else
        begin
            if m_Poped then
                Index := 1
            else
                Index := 3;
            m_InButton := false;
        end;
        SpitBitmap(Btn, Btn, 4, Index);
        Canvas.Draw(Width - Btn.Width - 4, (R.Bottom - Btn.Height) div 2 + 2, Btn);
        Btn.Free();
    end;
end;

procedure TsuiPanel.Pop;
begin
    m_Moving := true;
    while inherited Height + 15 < m_Height do
    begin
        inherited Height := inherited Height + 15;
        Refresh();
        Application.ProcessMessages();
    end;
    inherited Height := m_Height;
    Refresh();
    m_Moving := false;
    m_Poped := true;
    Repaint();
    if Assigned (m_OnPop) then
        m_OnPop(self);        
end;

procedure TsuiPanel.Push;
var
    InnerHeight : Integer;
begin
    if (Align = alClient) or (Align = alLeft) or (Align = alRight) then
        raise Exception.Create('Can''t push when Align is alClient, alLeft or alRight.');
    InnerHeight := m_TitleBitmap.Height;
    if InnerHeight = 0 then
        InnerHeight := 20;
    m_Moving := true;
    while inherited Height - 15 > InnerHeight do
    begin
        inherited Height := inherited Height - 15;
        Refresh();
        Application.ProcessMessages();
    end;
    inherited Height := InnerHeight;
    Refresh();
    m_Moving := false;
    m_Poped := false;
    Repaint();
    if Assigned(m_OnPush) then
        m_OnPush(self);
end;

procedure TsuiPanel.Resize;
begin
    inherited;

    if (not m_Moving) and m_Poped then
    begin
        m_Height := inherited Height;
    end;
end;

procedure TsuiPanel.SetBorderColor(const Value: TColor);
begin
    m_BorderColor := Value;
    Repaint();
end;

procedure TsuiPanel.SetCaptionFontColor(const Value: TColor);
begin
    m_CaptionFontColor := Value;
    Repaint();
end;

procedure TsuiPanel.SetFileTheme(const Value: TsuiFileTheme);
begin
    m_FileTheme := Value;
    m_FromTheme := true;
    SetUIStyle(m_UIStyle);
    m_FromTheme := false;
end;

procedure TsuiPanel.SetHeight2(const Value: Integer);
begin
    m_Height := Value;

    if (csDesigning in ComponentState) or m_Poped then
        inherited Height := m_Height;
end;

procedure TsuiPanel.SetShowButton(const Value: Boolean);
begin
    m_ShowButton := Value;
    Repaint();
end;

procedure TsuiPanel.SetUIStyle(const Value: TsuiUIStyle);
var
    OutUIStyle : TsuiUIStyle;
    Tmp : TBitmap;
begin
    m_UIStyle := Value;

    if m_FromTheme and (m_UIStyle <> FromThemeFile) then
        Exit; 

    Color := clWhite;
    if UsingFileTheme(m_FileTheme, m_UIStyle, OutUIStyle) then
    begin
        Tmp := m_FileTheme.GetBitmap(SKIN2_SIDECHANNELTITLE);
        if Tmp <> nil then
            m_TitleBitmap.Assign(Tmp)
        else
            GetInsideThemeBitmap(SUI_THEME_DEFAULT, SUI_THEME_SIDECHENNEL_BAR_IMAGE, m_TitleBitmap);        
        m_BorderColor := m_FileTheme.GetColor(SKIN2_CONTROLBORDERCOLOR);
        m_CaptionFontColor := m_FileTheme.GetColor(SKIN2_CONTROLFONTCOLOR);
    end
    else
    begin
        GetInsideThemeBitmap(OutUIStyle, SUI_THEME_SIDECHENNEL_BAR_IMAGE, m_TitleBitmap);
        m_BorderColor := GetInsideThemeColor(OutUIStyle, SUI_THEME_CONTROL_BORDER_COLOR);
{$IFDEF RES_MACOS}
        if OutUIStyle = MacOS then
            m_CaptionFontColor := clBlack
        else
{$ENDIF}        
            m_CaptionFontColor := GetInsideThemeColor(OutUIStyle, SUI_THEME_MENU_SELECTED_FONT_COLOR);
    end;

    Height := Height - 1;
    Height := Height + 1;
    Repaint();
end;

procedure TsuiPanel.WMERASEBKGND(var Msg: TMessage);
begin
    if m_EraseBackground then
        inherited;
end;

end.