dcoutbar.pas

XP风格的outbar.rar.有DELPHI,C++BULIDER的例子及源码

        dcsbs_CaptionHelp: uState := DFCS_CAPTIONHELP ;
        dcsbs_CaptionMAX: uState := DFCS_CAPTIONMAX ;
        dcsbs_CaptionMIN: uState := DFCS_CAPTIONMIN ;
        dcsbs_CaptionRestore: uState := DFCS_CAPTIONRESTORE ;
      End ;
    End ;
  End ;
  If State Then
    uState := uState OR DFCS_PUSHED ;
  If NOT Enabled Then
    uState := uState OR DFCS_INACTIVE ;
  DrawFrameControl (Canvas.Handle, GetClientRect, uType, uState) ;
End ;

{-----------------------------------------------------------}

Procedure TCustomDCScrollButton.CMVisibleChanged(Var Message:TMessage);
Begin
  Inherited;
  FTimer.Enabled:=False;
  If HandleAllocated Then
    If GetCapture=Handle Then
      ReleaseCapture;
End;

{-----------------------------------------------------------}

Procedure TCustomDCScrollButton.DoOnSelect;
Begin
  If FDownFlag And Assigned(FOnSelect) Then
    FOnSelect(Self);
End;

{-----------------------------------------------------------}

Procedure TCustomDCScrollButton.MouseDown(Button:TMouseButton;Shift:TShiftState;X,Y:Integer);
Begin
  Inherited;
  If Button=mbLeft Then
  Begin
    DrawButton(True);
    FDownFlag:=True;
    SetCapture(Handle);
    FTimer.Interval:=FFrequency;
    FTimer.Enabled:=True;
    DoOnSelect;
  End;
End;

{-----------------------------------------------------------}

Procedure TCustomDCScrollButton.MouseMove (Shift : TShiftState ; X, Y : Integer) ;
Var Point : TPoint ;
Begin
  Inherited ;
  Point.X := X ;
  Point.Y := Y ;
  If MouseCapture Then
    If PtInRect (GetClientRect, Point) <> FDownFlag Then
    Begin
      FDownFlag := NOT FDownFlag ;
      DrawButton (FDownFlag) ;
    End ;
End ;

{-----------------------------------------------------------}

Procedure TCustomDCScrollButton.MouseUp (Button : TMouseButton ; Shift : TShiftState ; X, Y: Integer) ;
Begin
  Inherited;
  FTimer.Enabled:=False;
  FDownFlag:=False;
  DrawButton(False);
  ReleaseCapture;
End ;

{-----------------------------------------------------------}

Procedure TCustomDCScrollButton.OnTimer(Sender:TObject);
Var
  Point:TPoint;
Begin
  GetCursorPos(Point);
  Point:=ScreenToClient(Point);
  If PtInRect(GetClientRect,Point) Then
    If Assigned(FOnSelect) Then
        FOnSelect(Self);
End ;

{-----------------------------------------------------------}

Procedure TCustomDCScrollButton.Paint ;
Begin
  DrawButton (FALSE) ;
End ;

{*********************************************************}

Constructor TCustomDCListViewEx.Create(AOwner:TComponent);
Begin
  Inherited;
  FBackground:=TBitmap.Create;
  FBackground.OnChange:=OnBkChange;
  {$IFNDEF D4}
  FCanvas:={$IFDEF D3}TControlCanvas{$ELSE}TDCControlCanvas{$ENDIF}.Create;
  {$IFDEF D3}TControlCanvas{$ELSE}TDCControlCanvas{$ENDIF}(FCanvas).Control:=Self;
  {$ENDIF}
  FGradientBeginColor:=clBlue;
End;

{---------------------------------------------------------}

Destructor TCustomDCListViewEx.Destroy;
Begin
  {$IFNDEF D4}
  FCanvas.Free;
  {$ENDIF}
  FBackground.Free;
  Inherited;
End;

{---------------------------------------------------------}

{$IFNDEF D3}
Procedure TCustomDCListViewEx.DestroyWnd;
Begin
  FreeDeviceContexts;
  Inherited;
End;
{$ENDIF}

{---------------------------------------------------------}

Procedure TCustomDCListViewEx.DrawBackGround(ARect:TRect);
Var
  hRgn:THandle;
  LeftPos,TopPos:Integer;
  RightPos,BottomPos:Integer;
  I,J:Integer;
Begin
  Inc(ARect.Right,1);
  Inc(ARect.Bottom,1);
  If (((FBackground.Width=0) Or (FBackground.Height=0)) And
     (Not (FBackgroundMode In [bkmGradientHorz,bkmGradientVert]))) Or
     (FBackgroundMode=bkmNone) Then
  Begin
    Canvas.Brush.Color:=Color;
    Canvas.FillRect(ARect);
    Exit;
  End;
  hRgn:=CreateRectRgnIndirect(ARect);
  SelectClipRgn(Canvas.Handle,hRgn);
  Try
    Case FBackgroundMode Of
      bkmGradientHorz:
        FillGradient(Canvas.Handle,ClientWidth,ClientHeight,FGradientBeginColor,FGradientEndColor,False);
      bkmGradientVert:
        FillGradient(Canvas.Handle,ClientWidth,ClientHeight,FGradientBeginColor,FGradientEndColor,True);
      bkmCenter:
        Begin
          Canvas.Brush.Color:=Color;
          Canvas.FillRect(ARect);
          Canvas.Draw((ClientWidth-FBackground.Width) Div 2,
                      (ClientHeight-FBackground.Height) Div 2,
                      FBackground);
        End;
      bkmStretch:
        Canvas.StretchDraw(Rect(0,0,ClientWidth,ClientHeight),FBackground);
      bkmTile:
        Begin
          LeftPos:=ARect.Left Div FBackground.Width;
          TopPos:=ARect.Top Div FBackground.Height;
          RightPos:=(ARect.Right+FBackground.Width-1) Div FBackground.Width;
          BottomPos:=(ARect.Bottom+FBackground.Height-1) Div FBackground.Height;
          For I:=LeftPos To RightPos Do
            For J:=TopPos To BottomPos Do
              Canvas.Draw(I*FBackground.Width,J*FBackground.Height,FBackGround);
        End;
    End;
  Finally
    SelectClipRgn(Canvas.Handle,0);
    DeleteObject(hRgn);
  End;
End;

{---------------------------------------------------------}
{$IFNDEF D3}
Procedure TCustomDCListViewEx.WndProc(Var Message:TMessage);
Begin
  Try
    Inherited;
  Finally
    FreeDeviceContexts;
  End;
End;
{$ENDIF}

{---------------------------------------------------------}

Procedure TCustomDCListViewEx.LastPaint;
Begin
End;

{---------------------------------------------------------}

Procedure TCustomDCListViewEx.OnBkChange(Sender:TObject);
Begin
  UpdateBackground;
End;

{---------------------------------------------------------}

Procedure TCustomDCListViewEx.SetBackground(Value:TBitmap);
Begin
  FBackground.Assign(Value);
End;

{---------------------------------------------------------}

Procedure TCustomDCListViewEx.SetBackgroundMode(Value:TBackgroundMode);
Begin
  If FBackgroundMode=Value Then
    Exit;
  FBackgroundMode:=Value;
  UpdateBackground;
End;

{---------------------------------------------------------}

Procedure TCustomDCListViewEx.SetGradientBeginColor(Value:TColor);
Begin
  If FGradientBeginColor=Value Then
    Exit;
  FGradientBeginColor:=Value;
  If FBackgroundMode In [bkmGradientHorz,bkmGradientVert] Then
    UpdateBackground;
End;

{---------------------------------------------------------}

Procedure TCustomDCListViewEx.SetGradientEndColor(Value:TColor);
Begin
  If FGradientEndColor=Value Then
    Exit;
  FGradientEndColor:=Value;
  If FBackgroundMode In [bkmGradientHorz,bkmGradientVert] Then
    UpdateBackground;
End;

{---------------------------------------------------------}

Procedure TCustomDCListViewEx.UpdateBackground;
Begin
  Invalidate;
End;

{---------------------------------------------------------}

Procedure TCustomDCListViewEx.WMPaint(Var Message:TMessage);
Var
  Rect:TRect;
  ScreenDC:THandle;
  MemDC:THandle;
  hBitMap:THandle;
  PrevObject:THandle;
Begin

  Rect:=Canvas.ClipRect;
  If Rect.Bottom>ClientHeight Then
    Rect.Bottom:=ClientHeight;
  ValidateRect(Handle,@Rect);
  {$IFNDEF D3}
  TDCControlCanvas(Canvas).Lock;
  {$ELSE}
  Canvas.Lock;
  {$ENDIF}
  Try
    If Message.wParam=0 Then
    Begin
      ScreenDC:=GetDC(0);
      {$IFDEF FASTPAINT}
      hBitmap:=CreateCompatibleBitmap(ScreenDC,Rect.Right-Rect.Left,Rect.Bottom-Rect.Top);
      {$ELSE}
      hBitmap:=CreateCompatibleBitmap(ScreenDC,Width,Height);
      {$ENDIF}
      MemDC:=CreateCompatibleDC(ScreenDC);
      ReleaseDC(0,ScreenDC);
      PrevObject:=SelectObject(MemDC,hBitmap);
      {$IFDEF FASTPAINT}
      SetViewportOrgEx(MemDC,-Rect.Left,-Rect.Top,Nil);
      {$ENDIF}

      Canvas.Handle:=MemDC;
      Canvas.Handle;
      DrawBackground(ClientRect);

      Message.WParam := MemDC;
      WMPaint(Message);
      Message.WPAram := 0;

      //Inherited;

      LastPaint;
      Canvas.Handle:=0;
      BitBlt(Canvas.Handle,Rect.Left,Rect.Top,Rect.Right-Rect.Left,Rect.Bottom-Rect.Top,
             MemDC,Rect.Left,Rect.Top,SRCCOPY);

      SelectObject(MemDC,PrevObject);
      DeleteObject(hBitmap);
      DeleteDC(MemDC);
    End
    Else
    Begin
      Canvas.Handle:=Message.wParam;
      //Message.wParam:=0;
      DrawBackground(ClientRect);
      Inherited;
      LastPaint;
      Canvas.Handle:=0;
    End;
  Finally
    {$IFNDEF D3}
    TDCControlCanvas(Canvas).UnLock;
    {$ELSE}
    Canvas.UnLock;
    {$ENDIF}
  End;
End;

{*********************************************************}

Destructor TDCVertListItem.Destroy;
Begin
  With TDCVertListView(ListView) Do
    If FDragItem=Self Then
      FDragItem:=Nil;
  Inherited;    
End;

{-----------------------------------------------------------}

Procedure TDCVertListItem.DoClick;
Begin
  If Assigned(FOnClick) Then
    FOnClick(ListView);
End;

{-----------------------------------------------------------}

Procedure TDCVertListItem.SetHotTrackIndex(Value:Integer);
Begin
  If FHotTrackIndex=Value Then
    Exit;
  FHotTrackIndex:=Value;
  With TDCVertListView(ListView) Do
    InvalidateItem(Self);
End;

{-----------------------------------------------------------}

Procedure TDCVertListItem.SetSelectedIndex(Value:Integer);
Begin
  If FSelectedIndex=Value Then
    Exit;
  FSelectedIndex:=Value;
  With TDCVertListView(ListView) Do
    InvalidateItem(Self);
End;

{*********************************************************}

Constructor TDCVertListView.Create(AOwner:TComponent);
Begin
  Inherited;
  FDownButton:=CreateScrollButton(dcsbs_ScrollDown);
  FUpButton:=CreateScrollButton(dcsbs_ScrollUp);
  FDragNewPlace:=-1;
  HideSelection:=False;
  FScrollTimer:=TTimer.Create(Self);
  FScrollTimer.Enabled:=Fa