spanel.pas

Alpha Controls 界面控件包

unit sPanel;
{$I sDefs.inc}
{.$DEFINE LOGGED}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, sCommonData, sConst
  {$IFDEF TNTUNICODE} , TntExtCtrls {$ENDIF};

type
{$IFDEF TNTUNICODE}
  TsPanel = class(TTntPanel)
{$ELSE}
  TsPanel = class(TPanel)
{$ENDIF}
{$IFNDEF NOTFORHELP}
  private
    FCommonData: TsCommonData;
    FOnPaint: TPaintEvent;
    FOnMouseLeave: TNotifyEvent;
    FOnMouseEnter: TNotifyEvent;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure AfterConstruction; override;
    procedure Loaded; override;
    procedure Paint; override;
    procedure OurPaint(DC : HDC = 0; SendUpdated : boolean = True); virtual;
    procedure PrepareCache;
    procedure WndProc (var Message: TMessage); override;
    procedure WriteText(R : TRect);
    procedure PaintWindow(DC: HDC); override;
  published
{$ENDIF} // NOTFORHELP
    property SkinData : TsCommonData read FCommonData write FCommonData;
    property OnPaint : TPaintEvent read FOnPaint write FOnPaint;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  end;

  TsDragBar = class(TsPanel)
{$IFNDEF NOTFORHELP}
  private
    FDraggedControl : TControl;
    procedure WMActivateApp(var Message: TWMActivateApp); message WM_ACTIVATEAPP;
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    procedure ReadState(Reader: TReader); override;
    constructor Create (AOwner: TComponent); override;
  published
    property Alignment;
    property Align default alTop;
    property Color default clActiveCaption;
{$ENDIF} // NOTFORHELP
    property DraggedControl : TControl read FDraggedControl write FDraggedControl;
  end;

{$IFNDEF NOTFORHELP}
  TsContainer = class(TsPanel)
  end;

  TsGrip = class(TsPanel)
  public
    Transparent : boolean;
    LinkedControl : TWinControl;
    constructor Create (AOwner: TComponent); override;
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  end;

  TsColInfo = record
    Index : integer;
    Color : TColor;
    R : TRect;
    Selected : boolean;
  end;

  TsColorsPanel = class(TsPanel)
  private
    FColors: TStrings;
    FItemIndex: integer;
    FItemWidth: integer;
    FItemHeight: integer;
    FItemMargin: integer;
    FColCount: integer;
    FRowCount: integer;
    FOnChange: TNotifyEvent;
    procedure SetColors(const Value: TStrings);
    procedure SetItemIndex(const Value: integer);
    procedure SetItemHeight(const Value: integer);
    procedure SetItemWidth(const Value: integer);
    procedure SetItemMargin(const Value: integer);
    procedure SetColCount(const Value: integer);
    procedure SetRowCount(const Value: integer);
  public
    OldSelected : integer;
    ColorsArray : array of TsColInfo;
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    procedure GenerateColors;
    procedure AfterConstruction; override;
    procedure Loaded; override;
    procedure OurPaint(DC : HDC = 0; SendUpdated : boolean = True); override;
    procedure PaintColors(DC: hdc);
    function Count : integer;
    function GetItemByCoord(p : TPoint) : integer;
    procedure WndProc (var Message: TMessage); override;
    procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    function ColorValue : TColor;
  published
    property ColCount : integer read FColCount write SetColCount default 5;
    property Colors : TStrings read FColors write SetColors;
    property ItemIndex : integer read FItemIndex write SetItemIndex default -1;
    property ItemHeight : integer read FItemHeight write SetItemHeight default 21;
    property ItemWidth : integer read FItemWidth write SetItemWidth default 21;
    property ItemMargin : integer read FItemMargin write SetItemMargin default 6;
    property Height default 60;
    property RowCount : integer read FRowCount write SetRowCount default 2;
    property Width default 140;
    property OnChange : TNotifyEvent read FOnChange write FOnChange;
  end;

  TsStdColorsPanel = class(TsColorsPanel)
  end;

{$ENDIF} // NOTFORHELP

implementation

uses sMessages, sGraphUtils, sVCLUtils, sMaskData, sStyleSimply, sSkinManager,
  acUtils{$IFDEF LOGGED}, sDebugMsgs{$ENDIF}, sAlphaGraph;

{ TsPanel }

procedure TsPanel.AfterConstruction;
begin
  inherited;
  FCommonData.Loaded;
end;

constructor TsPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csOpaque]; //v4.44
  FCommonData := TsCommonData.Create(Self, True);
  FCommonData.COC := COC_TsPanel;
end;

destructor TsPanel.Destroy;
begin
  if Assigned(FCommonData) then FreeAndNil(FCommonData);
  inherited Destroy;
end;

procedure TsPanel.Loaded;
begin
  inherited;
  FCommonData.Loaded;
end;

procedure TsPanel.OurPaint;
var
  b : boolean;
  NewDC : HDC;
  R : TRect;
begin
  if (csDestroying in ComponentState) or
       (csCreating in Parent.ControlState) or
         not Assigned(FCommonData) or not FCommonData.Skinned then Exit;

  FCommonData.Updating := FCommonData.Updating;
  if not FCommonData.Updating then begin
    // If transparent and form resizing processed
    b := FCommonData.HalfVisible or FCommonData.BGChanged;// or GetBoolMsg(Parent.Handle, AC_GETHALFVISIBLE);

    if DC <> 0 then NewDC := DC else NewDC := Canvas.Handle; // v4.43
    if SkinData.RepaintIfMoved then begin
      GetClipBox(NewDC, R);
      FCommonData.HalfVisible := (WidthOf(R) <> Width) or (HeightOf(R) <> Height)
    end
    else FCommonData.HalfVisible := False;

    if b and not FCommonData.UrgentPainting then PrepareCache;
//    UpdateCorners(FCommonData, 0);
    CopyWinControlCache(Self, FCommonData, Rect(0, 0, 0, 0), Rect(0, 0, Width, Height), NewDC, True);

    sVCLUtils.PaintControls(NewDC, Self, b and SkinData.RepaintIfMoved, Point(0, 0)); // Painting of the skinned TGraphControls !!!!!!!
    if SendUpdated then SetParentUpdated(Self);
  end;
end;

procedure TsPanel.Paint;
begin
  if SkinData.Skinned or not Assigned(FOnPaint)  then inherited else begin
    if not (csLoading in ComponentState) or not Visible then FOnPaint(Self, Canvas);
  end;
end;

procedure TsPanel.PaintWindow(DC: HDC);
begin
  inherited;
  OurPaint(DC);
end;

procedure TsPanel.PrepareCache;
var
  CI : TCacheInfo;
  w : integer;
  R : TRect;
begin
  FCommonData.InitCacheBmp;
  CI := GetParentCache(FCommonData);
  PaintItem(FCommonData, CI, Self is TsdragBar, 0, Rect(0, 0, width, Height), Point(Left, Top), FCommonData.FCacheBMP, False);
  R := ClientRect;
  w := BorderWidth + integer(BevelInner <> bvNone) * BevelWidth + integer(BevelOuter <> bvNone) * BevelWidth;
  InflateRect(R, -w, -w);
  WriteText(R);
  if Assigned(FOnPaint) then FOnPaint(Self, FCommonData.FCacheBmp.Canvas); // KJS
  FCommonData.BGChanged := False;
end;

procedure TsPanel.WndProc(var Message: TMessage);
var
  SaveIndex: Integer;
  DC: HDC;
  PS: TPaintStruct;
begin
{$IFDEF LOGGED}
  AddToLog(Message);
{$ENDIF}
  if Message.Msg = SM_ALPHACMD
    then case Message.WParamHi of
    AC_CTRLHANDLED : begin Message.LParam := 1; Exit end; // AlphaSkins supported
    AC_GETAPPLICATION : begin Message.Result := longint(Application); Exit end;
    AC_REMOVESKIN : begin
      if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
        CommonWndProc(Message, FCommonData);
        Invalidate;
      end;
      AlphaBroadCast(Self, Message);
      exit
    end;
    AC_SETNEWSKIN : begin
      AlphaBroadCast(Self, Message);
      if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
        CommonWndProc(Message, FCommonData);
      end;
      exit
    end;
    AC_REFRESH : begin
      if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
        CommonWndProc(Message, FCommonData);
        AlphaBroadCast(Self, Message);
        Repaint;
      end
      else AlphaBroadCast(Self, Message);
      exit
    end;
  end;
  if not ControlIsReady(Self) or not FCommonData.Skinned then begin
    case Message.Msg of
      WM_PRINT : if Assigned(OnPaint) then begin
        OnPaint(Self, Canvas);
        if TWMPaint(Message).DC <> 0
          then BitBlt(TWMPaint(Message).DC, 0, 0, Width, Height, Canvas.Handle, 0, 0, SRCCOPY);
      end;
      WM_ERASEBKGND : begin
        if not Assigned(FOnPaint) then inherited;
      end
      else inherited;
    end;
  end
  else begin
    if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
      AC_ENDPARENTUPDATE : if {IsNT or (not IsNT and }(FCommonData.Updating) {v4.83 for win9x} then {????} begin
        FCommonData.Updating := False;
        RedrawWindow(Handle, nil, 0, RDW_ALLCHILDREN or RDW_INVALIDATE or RDW_ERASE or RDW_FRAME or RDW_UPDATENOW);
        Exit;
      end else Exit;
      AC_PREPARING : begin
        Message.LParam := integer(FCommonData.BGChanged or FCommonData.Updating);
      end;
      AC_URGENTPAINT : begin // v4.08
        CommonWndProc(Message, FCommonData);
        if FCommonData.UrgentPainting then PrepareCache;
      end
      else CommonMessage(Message, FCommonData);
    end
    else begin
      case Message.Msg of
        WM_PRINT : begin
          FCommonData.Updating := False;
          if ControlIsReady(Self) then begin
            DC := TWMPaint(Message).DC;
            if SkinData.BGChanged then begin
              PrepareCache;
              if Assigned(OnPaint) then OnPaint(Self, FCommonData.FCacheBmp.Canvas);
            end;
            UpdateCorners(FCommonData, 0);
            OurPaint(DC, False);
          end;
          Exit;
        end;
        WM_PAINT : begin
          if (not Visible and not (csDesigning in ComponentState)) then begin inherited; exit end;
          ControlState := ControlState + [csCustomPaint];
          BeginPaint(Handle, PS); // v4.31
          if TWMPAINT(Message).DC = 0 then DC := GetDC(Handle) else DC := TWMPAINT(Message).DC;
          try
            SaveIndex := SaveDC(DC);
            Canvas.Lock;
            try
              Canvas.Handle := DC;
              try
                TControlCanvas(Canvas).UpdateTextFlags;
                OurPaint(DC);
              finally
                Canvas.Handle := 0;
              end;
            finally
              Canvas.Unlock;
            end;
            RestoreDC(DC, SaveIndex);
          finally
            if TWMPaint(Message).DC = 0 then ReleaseDC(Handle, DC);
            EndPaint(Handle, PS);
          end;
          ControlState := ControlState - [csCustomPaint];
          Exit;
        end;
        CM_TEXTCHANGED : begin
          if Parent <> nil then FCommonData.Invalidate;
          Exit;
        end;
        WM_ERASEBKGND : Exit;
        CM_VISIBLECHANGED : begin
          FCommonData.BGChanged := True;
          FCommonData.Updating := False;
          inherited;
          Exit;
        end;
        WM_KILLFOCUS, WM_SETFOCUS: begin inherited; exit end; // v4.12
      end;
      CommonWndProc(Message, FCommonData);
      inherited;
      case Message.Msg of
        CM_ENABLEDCHANGED : FCommonData.Invalidate;