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

📄 acdbctrlgrid.pas

📁 alpha db da sa pouzit na vsetky druhy coho len chcete
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{  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;}
  RefreshScrolls(FCommonData, ListSW);
end;

destructor TsDBCtrlGrid.Destroy;
begin
  if ListSW <> nil then FreeAndNil(ListSW);
  if Assigned(FCommonData) then FreeAndNil(FCommonData);
  inherited;
end;

procedure TsDBCtrlGrid.DrawPanel(DC: HDC; Index: Integer);
var
  SaveActive: Integer;
  R: TRect;
begin
  R := GetPanelBounds(Index);
  if Index < PanelCount then begin
    SaveActive := DataLink.ActiveRecord;
    DataLink.ActiveRecord := Index;
    TsDBCtrlPanel(Panel).DrawIndex := Index;
    if Index <> PanelIndex then
    Panel.PaintTo(FPanelDC, 0, 0);
    DataLink.ActiveRecord := SaveActive;
  end
  else begin
    DrawPanelBackground(FPanelDC, Panel.ClientRect, True, False);
  end;
  BitBlt(DC, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top, FPanelDC, 0, 0, SRCCOPY);
end;

procedure TsDBCtrlGrid.DrawPanelBackground(DC: HDC; const R: TRect; Erase, Selected: Boolean);
begin
  TsDBCtrlPanel(Panel).PrepareCache(Point(R.Left, R.Top));
  PaintItem(TsDBCtrlPanel(Panel).FCommonData, GetParentCache(TsDBCtrlPanel(Panel).FCommonData), False, 0, Panel.ClientRect,
                   Point(R.Left, R.Top), TsDBCtrlPanel(Panel).FCommonData.FCacheBmp, False
                 );
{  if ShowFocus and Focused and Selected then begin
    sGraphUtils.FocusRect(TsDBCtrlPanel(Panel).FCommonData.FCacheBmp.Canvas, Panel.ClientRect);
  end;}
  BitBlt(DC, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top, TsDBCtrlPanel(Panel).FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
end;

function TsDBCtrlGrid.GetPanelBounds(Index: Integer): TRect;
var
  Col, Row: Integer;
begin
  if Orientation = goVertical then begin
    Col := Index mod ColCount;
    Row := Index div ColCount;
  end
  else begin
    Col := Index div RowCount;
    Row := Index mod RowCount;
  end;
  Result.Left := PanelWidth * Col;
  Result.Top := PanelHeight * Row;
  Result.Right := Result.Left + PanelWidth;
  Result.Bottom := Result.Top + PanelHeight;
end;

procedure TsDBCtrlGrid.PaintWindow(DC: HDC);
var
  I: Integer;
  Brush: HBrush;
//  bActive : boolean;
begin
  if not ControlIsReady(Panel) or not (Panel is TsDBCtrlPanel and TsDBCtrlPanel(Panel).FCommonData.Skinned) then inherited else begin
    if csDesigning in ComponentState then begin
      Panel.Update;
      Brush := CreateHatchBrush(HS_BDIAGONAL, ColorToRGB(clBtnShadow));
      SetBkColor(DC, ColorToRGB(Color));
      FillRect(DC, ClientRect, Brush);
      DeleteObject(Brush);
//      bActive := DataLink.Active and
      for I := 1 to ColCount * RowCount - 1 do DrawPanelBackground(DC, GetPanelBounds(I), False, DataLink.Active and (I = DataLink.ActiveRecord));
    end
    else begin
      CreatePanelBitmap;
      try
        for I := 0 to ColCount * RowCount - 1 do
          if (PanelCount <> 0) and (I = PanelIndex) then begin
            TsDBCtrlPanel(Panel).DrawIndex := -1;
            RedrawWindow(Panel.Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN);
          end
          else begin
            DrawPanel(DC, I);
          end;
      finally
        TsDBCtrlPanel(Panel).DrawIndex := -1;
        DestroyPanelBitmap;
      end;
    end;
    { When width or height are not evenly divisible by panel size, fill the gaps }
    if HandleAllocated then begin
      if (Height <> Panel.Height * RowCount) then BitBlt(DC, 0, Panel.Height * RowCount, Width, Height, FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
      if (Width <> Panel.Width * ColCount) then BitBlt(DC, Panel.Width * ColCount, 0, Width, Height, FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
    end;
  end;
end;

procedure TsDBCtrlGrid.SetDisabledKind(const Value: TsDisabledKind);
begin
  with TsDBCtrlPanel(Panel) do
  if FDisabledKind <> Value then begin
    FDisabledKind := Value;
    FCommonData.Invalidate;
  end;
end;


function TsDBCtrlGrid.GetDisabledKind: TsDisabledKind;
begin
  with TsDBCtrlPanel(Panel) do
    result := FDisabledKind;
end;

{function TsDBCtrlGrid.GetSkinData: TsCommonData;
begin
  with TsDBCtrlPanel(Panel) do result := FCommonData;
end;}

procedure TsDBCtrlGrid.PrepareCache;
var
  CI : TCacheInfo;
begin
  try
    FCommonData.InitCacheBmp;
    CI := GetParentCache(FCommonData);
    PaintItem(FCommonData,
                 CI,
                 False, 0,
                 Rect(0, 0, Width, Height),
                 Point(Left, Top),
                 FCommonData.FCacheBmp, False
               );
    FCommonData.BGChanged := False;
  except
  end;
end;

procedure TsDBCtrlGrid.WndProc(var Message: TMessage);
begin
{$IFDEF LOGGED}
  AddToLog(Message);
{$ENDIF}
  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
      if ListSW <> nil then begin
        FreeAndNil(ListSW);
      end;
      CommonWndProc(Message, FCommonData);
      AlphaBroadCast(Self,Message);
      RecreateWnd;
      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);
      RefreshScrolls(FCommonData, ListSW);
      AlphaBroadCast(Self,Message);
      RedrawWindow(Handle, nil, 0, RDW_FRAME + RDW_INVALIDATE + RDW_UPDATENOW + RDW_ALLCHILDREN);
      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 : begin
        Perform(WM_PAINT, Message.WParam, Message.LParam);
        Ac_NCPaint(ListSW, Handle, Message.wParam, Message.lParam, -1, hdc(Message.WParam));
        Exit;
      end;
    end;
    CommonWndProc(Message, FCommonData);
    inherited;
    case Message.Msg of
      CM_VISIBLECHANGED, CM_ENABLEDCHANGED, WM_SETFONT : begin
        FCommonData.Invalidate;
      end;
      WM_SIZE, WM_MOVE : UpdateScrolls(ListSW, True);
      WM_PASTE, WM_CUT, WM_CLEAR, WM_UNDO, WM_SETTEXT : UpdateScrolls(ListSW, True);
      WM_HSCROLL, WM_VSCROLL : begin
        UpdateScrolls(ListSW, True);
      end;
      CM_CHANGED, CN_KEYDOWN, CN_KEYUP, CM_INVALIDATE : UpdateScrolls(ListSW, True);
      WM_PARENTNOTIFY: if (Message.WParam and $FFFF = WM_CREATE) or (Message.WParam and $FFFF = WM_DESTROY) then begin
        UpdateScrolls(ListSW, True);
      end;
      WM_MOUSEWHEEL, CM_CONTROLLISTCHANGE, CM_CONTROLCHANGE : if not SkinData.Updating then begin
        UpdateScrolls(ListSW, True);
      end;
    end;
  end;   
end;            

function TsDBCtrlGrid.GetDataLink: TDataLink;
begin
  Result := TDBCtrlGrid_(Self).FDataLink;
end;

procedure TsDBCtrlGrid.CreatePanelBitmap;
var
  DC: HDC;
begin
  if FBitmapCount = 0 then
  begin
    DC := GetDC(0);
    FPanelBitmap := CreateCompatibleBitmap(DC, Panel.Width, Panel.Height);
    ReleaseDC(0, DC);
    FPanelDC := CreateCompatibleDC(0);
    FSaveBitmap := SelectObject(FPanelDC, FPanelBitmap);
  end;
  Inc(FBitmapCount);
end;

procedure TsDBCtrlGrid.DestroyPanelBitmap;
begin
  Dec(FBitmapCount);
  if FBitmapCount = 0 then
  begin
    SelectObject(FPanelDC, FSaveBitmap);
    DeleteDC(FPanelDC);
    DeleteObject(FPanelBitmap);
  end;
end;

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

procedure TsDBCtrlGrid.SetPanelSkin(const Value: TsSkinSection);
begin
  if FPanelSkin <> Value then begin
    FPanelSkin := Value;
    TsDBCtrlPanel(TDBCtrlGrid_(Self).FPanel).FCommonData.SkinSection := Value;
    FCommonData.BGChanged := True;
    RedrawWindow(Handle, nil, 0, RDW_FRAME + RDW_INVALIDATE + RDW_UPDATENOW + RDW_ALLCHILDREN);
  end;
end;

end.

⌨️ 快捷键说明

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