sstatusbar.pas

AlphaControls是一个Delphi标准控件的集合

begin
  if ARTLAlignment then ChangeBiDiModeAlignment(AAlignment);
  case AAlignment of
    taCenter: Insert(#9, Str, 1);
    taRightJustify: Insert(#9#9, Str, 1);
  end;
  sStyle.Invalidate;
end;

procedure TsStatusBar.UpdateSimpleText;
const
  RTLReading: array[Boolean] of Longint = (0, SBT_RTLREADING);
begin
  DoRightToLeftAlignment(FSimpleText, taLeftJustify, UseRightToLeftAlignment);
  if HandleAllocated then SendMessage(Handle, SB_SETTEXT,
                                      255 or RTLREADING[UseRightToLeftReading],
                                      Integer(PChar(FSimpleText)));
  sStyle.Invalidate;
end;

procedure TsStatusBar.SetSimpleText(const Value: string);
begin
  if FSimpleText <> Value then begin
    FSimpleText := Value;
    UpdateSimpleText;
  end;
end;

procedure TsStatusBar.CMBiDiModeChanged(var Message: TMessage);
var
  Loop: Integer;
begin
  inherited;
  if HandleAllocated then begin
    if not SimplePanel then begin
      for Loop := 0 to Panels.Count - 1 do begin
        if Panels[Loop].ParentBiDiMode then Panels[Loop].ParentBiDiModeChanged;
      end;
      UpdatePanels(True, True);
    end
    else begin
      UpdateSimpleText;
    end;
  end;
end;

procedure TsStatusBar.FlipChildren(AllLevels: Boolean);
var
  Loop, FirstWidth, LastWidth: Integer;
  APanels: TsStatusPanels;
begin
  if HandleAllocated and (not SimplePanel) and (Panels.Count > 0) then begin
    { Get the true width of the last panel }
    LastWidth := ClientWidth;
    FirstWidth := Panels[0].Width;
    for Loop := 0 to Panels.Count - 2 do Dec(LastWidth, Panels[Loop].Width);
    { Flip 'em }
    APanels := TsStatusPanels.Create(Self);
    try
      for Loop := 0 to Panels.Count - 1 do with APanels.Add do
        Assign(Self.Panels[Loop]);
      for Loop := 0 to Panels.Count - 1 do
        Panels[Loop].Assign(APanels[Panels.Count - Loop - 1]);
    finally
      APanels.Free;
    end;
    { Set the width of the last panel }
    if Panels.Count > 1 then begin
      Panels[Panels.Count-1].Width := FirstWidth;
      Panels[0].Width := LastWidth;
    end;
    UpdatePanels(True, True);
  end;
end;

procedure TsStatusBar.SetSizeGrip(Value: Boolean);
begin
  if FSizeGrip <> Value then begin
    FSizeGrip := Value;
    RecreateWnd;
    sStyle.Invalidate;
  end;
end;

procedure TsStatusBar.SyncToSystemFont;
begin
  if FUseSystemFont then begin
    Font := Screen.HintFont;
    sStyle.Invalidate;
  end;
end;

procedure TsStatusBar.UpdatePanel(Index: Integer; Repaint: Boolean);
var
  Flags: Integer;
  S: string;
  PanelRect: TRect;
begin
  if HandleAllocated then with Panels[Index] do begin
    if not Repaint then begin
      FUpdateNeeded := True;
      SendMessage(Handle, SB_GETRECT, Index, Integer(@PanelRect));
      InvalidateRect(Handle, @PanelRect, True);
      Exit;
    end
    else begin
      if not FUpdateNeeded then Exit;
    end;
    FUpdateNeeded := False;
    Flags := 0;
    case Bevel of
      pbNone: Flags := SBT_NOBORDERS;
      pbRaised: Flags := SBT_POPOUT;
    end;
    if UseRightToLeftReading then Flags := Flags or SBT_RTLREADING;
    if Style = psOwnerDraw then Flags := Flags or SBT_OWNERDRAW;
    S := Text;
    if UseRightToLeftAlignment then begin
      DoRightToLeftAlignment(S, Alignment, UseRightToLeftAlignment)
    end
    else begin
      case Alignment of
        taCenter: Insert(#9, S, 1);
        taRightJustify: Insert(#9#9, S, 1);
      end;
    end;
    SendMessage(Handle, SB_SETTEXT, Index or Flags, Integer(PChar(S)));
    sStyle.Invalidate;
  end;
end;

procedure TsStatusBar.UpdatePanels(UpdateRects, UpdateText: Boolean);
const
  MaxPanelCount = 128;
var
  I, Count, PanelPos: Integer;
  PanelEdges: array[0..MaxPanelCount - 1] of Integer;
begin
  if HandleAllocated then begin
    Count := Panels.Count;
    if UpdateRects then begin
      if Count > MaxPanelCount then Count := MaxPanelCount;
      if Count = 0 then begin
        PanelEdges[0] := -1;
        SendMessage(Handle, SB_SETPARTS, 1, Integer(@PanelEdges));
        SendMessage(Handle, SB_SETTEXT, 0, Integer(PChar('')));
      end
      else begin
        PanelPos := 0;
        for I := 0 to Count - 2 do begin
          Inc(PanelPos, Panels[I].Width);
          PanelEdges[I] := PanelPos;
        end;
        PanelEdges[Count - 1] := -1;
        SendMessage(Handle, SB_SETPARTS, Count, Integer(@PanelEdges));
      end;
    end;
    for I := 0 to Count - 1 do UpdatePanel(I, UpdateText);
  end;
end;

procedure TsStatusBar.CMWinIniChange(var Message: TMessage);
begin
  inherited;
  if (Message.WParam = 0) or (Message.WParam = SPI_SETNONCLIENTMETRICS) then SyncToSystemFont;
end;

procedure TsStatusBar.WMGetTextLength(var Message: TWMGetTextLength);
begin
  Message.Result := Length(FSimpleText);
end;

procedure TsStatusBar.WMSize(var Message: TWMSize);
begin
  { Eat WM_SIZE message to prevent control from doing alignment }
  if not (csLoading in ComponentState) then Resize;
end;

function TsStatusBar.IsFontStored: Boolean;
begin
  Result := not FUseSystemFont and not ParentFont and not DesktopFont;
end;

procedure TsStatusBar.SetUseSystemFont(const Value: Boolean);
begin
  if FUseSystemFont <> Value then begin
    FUseSystemFont := Value;
    if Value then begin
      if ParentFont then ParentFont := False;
      SyncToSystemFont;
    end;
  end;
end;

procedure TsStatusBar.CMParentFontChanged(var Message: TMessage);
begin
  inherited;
  if FUseSystemFont and ParentFont then FUseSystemFont := False;
  sStyle.Invalidate;
end;

function TsStatusBar.ExecuteAction(Action: TBasicAction): Boolean;
begin
  if AutoHint and (Action is THintAction) and not DoHint then begin
    if SimplePanel or (Panels.Count = 0) then begin
      SimpleText := THintAction(Action).Hint;
      UpdateSimpleText;
//      sStyle.Invalidate;
    end
    else begin
      Panels[0].Text := THintAction(Action).Hint
    end;
    Result := True;
  end
  else Result := inherited ExecuteAction(Action);
end;

procedure TsStatusBar.CMSysFontChanged(var Message: TMessage);
begin
  inherited;
  SyncToSystemFont;
  sStyle.Invalidate;
end;

procedure TsStatusBar.ChangeScale(M, D: Integer);
begin
   // status bar size based on system font size
  if UseSystemFont then ScalingFlags := [sfTop];
  inherited;
end;

procedure TsStatusBar.PaintBody;
begin
  sStyle.PaintBG(sStyle.FCacheBMP);
  if IsValidImgIndex(sStyle.BorderIndex) then begin
//    if sStyle.RegionChanged then begin
      sStyle.FRegion := 0;
      sStyle.FRegion := CreateRectRgn(0,
                              0,
                              Width,
                              Height);
//    end;
    PaintRasterBorder(sStyle.FCacheBmp, ma[sStyle.BorderIndex].Bmp, 0, sStyle.FRegion, ma[sStyle.BorderIndex].TransparentColor, True);
//    if sStyle.RegionChanged then begin
      SetWindowRgn(Handle, sStyle.FRegion, True);
      sStyle.RegionChanged := False;
//    end;
  end
  else begin
    DrawPanelBorders(sStyle.FCacheBmp.Canvas);
  end;
  PaintPanels;
  if SizeGrip then begin
    PaintGrip(Point(Width - 1 - Margin, Height - 2 - Margin));
  end;
end;

procedure TsStatusBar.PaintGrip(p: TPoint);
var
  i : integer;
begin
  i := GetMaskIndex(sStyle.SkinIndex, sStyle.SkinSection, StatusBarGrip);
  if IsValidImgIndex(i) then begin
    PaintRasterGlyph(sStyle.FCacheBmp, ma[i].Bmp,
            point(Width - ma[i].Bmp.Width div 3 - 1, Height - ma[i].Bmp.Height div 2 - 1), 0, ma[i].TransparentColor);
  end
  else begin
    sStyle.FCacheBmp.Canvas.Pen.Style := psSolid;
    sStyle.FCacheBmp.Canvas.Pen.Color := ColorToRGB(clBlack);
    sStyle.FCacheBmp.Canvas.Brush.Style := bsSolid;
    for i := 1 to 4 do begin
      sStyle.FCacheBmp.Canvas.Polyline([
                              OffsetPoint(p, - 4 * i + 2, 0),
                              OffsetPoint(p, 0, - 4 * i +2)
                                       ]);
    end;

    sStyle.FCacheBmp.Canvas.Pen.Color := ColorToRGB(clWhite);
    for i := 1 to 4 do begin
      sStyle.FCacheBmp.Canvas.Polyline([
                              OffsetPoint(p, - 4 * i, 0),
                              OffsetPoint(p, 0, - 4 * i)
                                       ]);
    end;
  end;
end;

procedure TsStatusBar.WndProc(var Message: TMessage);
begin
  if Assigned(FsStyle) then FsStyle.WndProc(Message);
  if Message.Result <> 1 then
    inherited;
end;

procedure TsStatusBar.PaintPanels;
var
  i: integer;
//  aRect : TRect;
begin
  if SimplePanel then begin
    InternalDrawPanel(nil, SimpleText, Rect(0, 1, Width - 1, Height - 1));
  end
  else begin
    for i := 0 to Panels.Count - 1 do begin
      DrawPanel(Panels[i], Rect(PanelOffset(i),
                0,
                iffi(i<>Panels.Count - 1, PanelOffset(i) + Panels[i].Width + 1, Width),
                Height)
               );
    end;
  end;
end;

function TsStatusBar.PanelOffset(k: integer): integer;
var
  i: integer;
begin
  Result := 0;
  for i := 0 to Panels.Count - 1 do begin
    if i = k then break;
    inc(Result, Panels[i].Width + 1);
  end;
end;

procedure TsStatusBar.InternalDrawPanel(Panel: TsStatusPanel; Text: string; Rect: TRect);
var
  aRect: TRect;
  index, w: integer;
  Color1, Color2: TColor;
  s : string;
begin
  aRect := Rect;
  InflateRect(aRect, -1, -1);

  index := GetMaskIndex(sStyle.SkinIndex, sStyle.SkinSection, StatusPanelBordersMask);
  if IsValidImgIndex(index) then begin
    if not SimplePanel then 
    // Draw panel except last
      if (Panel.Index <> Panels.Count - 1) then
        DrawMaskRect(sStyle.FCacheBmp, ma[index].Bmp,
                 0, Rect, ma[index].TransparentColor, True, EmptyCI);
  end
  else begin
    Color1 := clBlack;
    Color2 := clWhite;
    w := 1;

    if Assigned(Panel) then begin
      case Panel.Bevel of
        pbNone: begin
          w := 0;
        end;
        pbRaised: begin
          Color1 := clWhite;
          Color2 := clBlack;
        end;
      end;
    end;
    Color1 := ColorToRGB(Color1);
    Color2 := ColorToRGB(Color2);

    if Assigned(Panel) {and (Panel.Index <> Panels.Count - 1)} then begin
      DrawRectangleOnDC(sStyle.FCacheBmp.Canvas.Handle, aRect,
                      Color1,
                      Color2,
                      w)
    end;
  end;
  dec(aRect.Bottom, 1);
  inc(aRect.Left, 2);
  if Assigned(Panel) then begin
    s := CutText(sStyle.FCacheBmp.Canvas, Panel.Text, WidthOf(aRect));
    sGraphUtils.WriteText(sStyle.FCacheBmp.Canvas,
                   PChar(s), True,
                   aRect, GetStringFlags(Self, Panel.Alignment));
  end
  else begin
    s := CutText(sStyle.FCacheBmp.Canvas, Text, WidthOf(aRect));
    sGraphUtils.WriteText(sStyle.FCacheBmp.Canvas,
                   PChar(s), True,
                   aRect, GetStringFlags(Self, taLeftJustify));
  end;
end;

procedure TsStatusBar.WriteText(R: TRect; sStyle: TsPaintStyle);
begin
end;

procedure TsStatusBar.Paint;
var
  aRect : TRect;
  b : boolean;
begin
  if not (csDestroying in ComponentState) and not (csLoading in ComponentState) then begin
    if sStyle.BGChanged then begin
      aRect := ClientRect;
      sStyle.InitCacheBmp;

      UpdatePanels(False, True);

      PaintBody;
      if Assigned(FOnPaint) then FOnPaint(Self, sStyle.FCacheBmp.Canvas);
    end;
    sStyle.CopyFromCache(Canvas.Handle, 0, 0, Width, Height);
    b := sStyle.BGChanged;
    RepaintsControls(Self, b);
  end;
end;

end.