⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 acdbctrlgrid.pas

📁 alpha db da sa pouzit na vsetky druhy coho len chcete
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit acDBCtrlGrid;
{$I sDefs.inc}
{.$DEFINE LOGGED}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DBCtrls, DB, dbcgrids, sConst, acntUtils, sGraphUtils, sGlyphUtils, math,
  sCommonData, sDefaults, acSBUtils;

type
  TsDBCtrlGrid = class;

{ TsDBCtrlPanel }

  TsDBCtrlPanel = class(TDBCtrlPanel)
  private
    FDisabledKind: TsDisabledKind;
    DrawIndex : integer;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    function GetDBCtrlGrid: TsDBCtrlGrid;
  protected
    procedure PaintWindow(DC: HDC); override;
    procedure WndProc (var Message: TMessage); override;
    procedure PrepareCache(pR : TPoint);
  public
    FCommonData: TsCommonData;
    constructor CreateLinked2(DBCtrlGrid: TDBCtrlGrid);
    destructor Destroy; override;
    procedure Loaded; override;
    property DBCtrlGrid : TsDBCtrlGrid read GetDBCtrlGrid;
  end;

{ TsDBCtrlGrid }

  TsDBCtrlGrid = class(TDBCtrlGrid)
  private
    FBitmapCount: Integer;
    FPanelBitmap: HBitmap;
    FSaveBitmap: HBitmap;
    FPanelDC: HDC;
    FCommonData: TsCommonData;
    FPanelSkin: TsSkinSection;
    procedure SetDisabledKind(const Value: TsDisabledKind);
    function GetDataLink: TDataLink;
    function GetDisabledKind: TsDisabledKind;
    procedure SetPanelSkin(const Value: TsSkinSection);
  protected
    procedure CreatePanelBitmap;
    procedure DestroyPanelBitmap;
    function GetPanelBounds(Index: Integer): TRect;
    procedure DrawPanel(DC: HDC; Index: Integer);
    procedure DrawPanelBackground(DC: HDC; const R: TRect; Erase, Selected: Boolean);
    procedure PaintWindow(DC: HDC); override;
    procedure WndProc (var Message: TMessage); override;
    procedure PrepareCache;
  public
    ListSW : TacScrollWnd;
    ScrollsUpdating : boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure AfterConstruction; override;
    property DataLink : TDataLink read GetDataLink;
    property Panel;
  published
    property DisabledKind : TsDisabledKind read GetDisabledKind write SetDisabledKind default DefDisabledKind;
    property SkinData : TsCommonData read FCommonData write FCommonData;
    property PanelSkin : TsSkinSection read FPanelSkin write SetPanelSkin;
  end;

implementation

uses sMessages, sMaskData, sStyleSimply, sSkinProps, sVCLUtils,
  sAlphaGraph{$IFDEF LOGGED}, sDebugMsgs{$ENDIF};

type

  TDBCtrlGrid_ = class(TWinControl)
  private
    FDataLink: TDBCtrlGridLink;
    FPanel: TDBCtrlPanel;
  end;

  TDBCtrlPanel_ = class(TWinControl)
  private
    FDBCtrlGrid: TDBCtrlGrid;
  end;

{ TsDBCtrlPanel }

constructor TsDBCtrlPanel.CreateLinked2(DBCtrlGrid: TDBCtrlGrid);
begin
  inherited CreateLinked(DBCtrlGrid);
  DrawIndex := -1;
  ParentColor := False;
  FCommonData := TsCommonData.Create(Self, True);
  FCommonData.COC := COC_TsCustom;
  if FCommonData.SkinSection = '' then FCommonData.SkinSection := TsDBCtrlGrid(DBCtrlGrid).PanelSkin;
  FDisabledKind := DefDisabledKind;
end;

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

function TsDBCtrlPanel.GetDBCtrlGrid: TsDBCtrlGrid;
begin
  Result := TDBCtrlPanel_(Self).FDBCtrlGrid as TsDBCtrlGrid;
end;

procedure TsDBCtrlPanel.Loaded;
begin
  inherited Loaded;
  try
    FCommonData.Loaded;
  except
    Application.HandleException(Self);
  end;
{  if FCommonData.Skinned then begin
    if not FCommonData.CustomColor then Color := FCommonData.SkinManager.gd[FCommonData.SkinIndex].Color;
    if not FCommonData.CustomFont then Font.Color := FCommonData.SkinManager.gd[FCommonData.SkinIndex].FontColor[1];
  end;}
end;

procedure TsDBCtrlPanel.PaintWindow(DC: HDC);
var
  R: TRect;
  Selected: Boolean;
begin
  if not ControlIsReady(Self) or not FCommonData.Skinned then inherited else begin
    if DrawIndex = -1
      then R := DBCtrlGrid.GetPanelBounds(DBCtrlGrid.PanelIndex)
      else R := DBCtrlGrid.GetPanelBounds(DrawIndex);

    PrepareCache(Point(R.Left,R.Top));
    UpdateCorners(FCommonData, 0);

    with DBCtrlGrid do begin
      if DataLink.Active then begin
        Selected := (DataLink.ActiveRecord = PanelIndex);

        FCommonData.FCacheBmp.Canvas.Font := Font;
        FCommonData.FCacheBmp.Canvas.Brush.Style := bsSolid;
        FCommonData.FCacheBmp.Canvas.Brush.Color := Color;
        PaintPanel(DataLink.ActiveRecord);
      end
    end;
    SetParentUpdated(Self);
    BitBlt(DC, 0, 0, Width, Height, FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
    if DBCtrlGrid.ShowFocus and DBCtrlGrid.Focused and Selected then DrawFocusRect(DC, Rect(2, 2, Width - 2, Height - 2));
  end;
end;

procedure TsDBCtrlPanel.PrepareCache(pR : TPoint);
begin
  try
    DBCtrlGrid.PrepareCache;
    FCommonData.InitCacheBmp;
    PaintItem(FCommonData, GetParentCache(FCommonData), False, 0, Rect(0, 0, Width, Height), pR, FCommonData.FCacheBmp, False);
    FCommonData.BGChanged := False;
  except
  end;
end;

procedure TsDBCtrlPanel.WMPaint(var Message: TWMPaint);
var
  DC: HDC;
  PS: TPaintStruct;
  i : integer;
begin
  if not ControlIsReady(Self) or not FCommonData.Skinned then inherited else begin
    if Message.DC = 0 then begin
      for i := 0 to ControlCount - 1 do Controls[i].ControlState := Controls[i].ControlState + [csPaintCopy];
      DBCtrlGrid.CreatePanelBitmap;
      try
        Message.DC := DBCtrlGrid.FPanelDC;
        PaintHandler(Message);
        Message.DC := 0;
        DC := BeginPaint(Handle, PS);
        BitBlt(DC, 0, 0, Width, Height, DBCtrlGrid.FPanelDC, 0, 0, SRCCOPY);
        EndPaint(Handle, PS);
      finally
        DBCtrlGrid.DestroyPanelBitmap;
      end;
      for i := 0 to ControlCount - 1 do Controls[i].ControlState := Controls[i].ControlState - [csPaintCopy];
    end
    else PaintHandler(Message);
  end;
end;

procedure TsDBCtrlPanel.WndProc(var Message: TMessage);
begin
  if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
    AC_CTRLHANDLED : begin Message.Result := 1; Exit end; // AlphaSkins supported
    AC_REMOVESKIN : if LongWord(Message.LParam) = LongWord(FCommonData.SkinManager) then begin
      CommonWndProc(Message, FCommonData);
      AlphaBroadCast(Self,Message);
      Exit;
    end;
    AC_SETNEWSKIN : if (LongWord(Message.LParam) = LongWord(FCommonData.SkinManager)) then begin
      CommonWndProc(Message, FCommonData);
      AlphaBroadCast(Self,Message);
      exit;
    end;
    AC_REFRESH : if (LongWord(Message.LParam) = LongWord(FCommonData.SkinManager)) then begin
      CommonWndProc(Message, FCommonData);
      AlphaBroadCast(Self,Message);
      if FCommonData.Skinned then Perform(WM_NCPAINT, 0, 0);
      Exit;
    end;
    AC_ENDPARENTUPDATE : if FCommonData.Updating then begin
      FCommonData.Updating := False;
      Perform(WM_NCPAINT, 0, 0);
    end
  end;
  if not ControlIsReady(Self) or not FCommonData.Skinned then inherited else begin
    case Message.Msg of
      WM_PRINT : if not ControlIsReady(Self) or not FCommonData.Skinned then inherited else begin
        Perform(WM_PAINT, Message.WParam, Message.LParam);
        Perform(WM_NCPAINT, Message.WParam, Message.LParam);
        Exit;
      end;
    end;
    CommonWndProc(Message, FCommonData);
    inherited;
  end;
end;

{ TsDBCtrlGrid }

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

  FCommonData := TsCommonData.Create(Self, True);
  FCommonData.COC := COC_TsCustom;
  if FCommonData.SkinSection = '' then FCommonData.SkinSection := s_CheckBox;
  if FPanelSkin = '' then FPanelSkin := s_GroupBox;

  FreeAndNil(TDBCtrlGrid_(Self).FPanel);
  TDBCtrlGrid_(Self).FPanel := TsDBCtrlPanel.CreateLinked2(Self);
  AdjustSize;
end;

procedure TsDBCtrlGrid.Loaded;
begin
  inherited Loaded;
  try
    FCommonData.Loaded;
    TsDBCtrlPanel(Panel).Loaded;
  except
    Application.HandleException(Self);
  end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -