svclutils.pas

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

unit sVclUtils;
{$I sDefs.inc}

interface

uses
  Classes, Controls, SysUtils, StdCtrls,
  Dialogs, Graphics, Forms, Messages, windows, extctrls,
  comctrls, sConst, Menus, inifiles, registry, sUtils,
{$IFNDEF ALITE}
  sEdit, sMemo, sCustomComboBox, sToolEdit, sCurrEdit, sDateUtils,
  sCustomComboEdit, sRadioButton, sMonthCalendar, 
{$ENDIF}
  sButtonControl,
  {$IFDEF USEDB}db, dbgrids, dbCtrls, {$ENDIF}
  sCheckBox, sCheckedControl, {sCustomButton,}
  sGraphUtils, buttons, sStyleUtil;

const
  AlignToInt: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);

procedure RepaintShadows(Control : TWinControl; BGBmp : graphics.TBitmap);
procedure PaintPassiveControls(WinControl : TWinControl);
procedure RepaintsGraphicControls(WinControl : TWinControl);
function ControlIsReady(Control : TControl) : boolean;
procedure CopyFromParent(sStyle: TsPaintStyle; aRect: TRect);
//procedure PaintStyleBG(sStyle: TsPassiveBGStyle; Bmp: Graphics.TBitmap; fRect: TRect);
function GetOwnerForm(Component: TComponent) : TCustomForm;
procedure SetPanelFocus(Panel : TWinControl);
procedure ClearPanel(Panel : TWinControl);
procedure SetControlsEnabled(Parent:TWinControl; Value: boolean);
function CheckPanelFilled(Panel:TCustomPanel):boolean;
procedure Delay(MSecs: Integer);
{$IFDEF USEDB}
procedure ComboBoxFilling(ComboBox:TComboBox; DataSet:TDataSet; CodeField, NameField:string; CountSymb:integer; FromDOSToWIN: boolean);
procedure FillsComboBox(sC : TCustomComboBox; CharsInCode: smallint; sD: TDataSet);
{$ENDIF}
function GetStringFlags(Control: TControl; al: TAlignment): longint;
procedure RepaintsControls(Owner: TWinControl; BGChanged : boolean);
procedure SetControlChanged(Control : TControl; BGChanged : boolean);

implementation

uses
{$IFNDEF ALITE}
    sStatusBar, sPageControl, sSpinEdit, sGroupBox, sGauge,
    sScrollBar, sScrollBox, sComboBoxes,
{$ENDIF}
  sCustomLabel, sPanel, sStyleSimply, sMessages, sMaskData;

procedure RepaintShadows(Control : TWinControl; BGBmp : graphics.TBitmap);
var
  sc : TsGenStyle;
  i : integer;
begin
  for i := 0 to Control.ControlCount - 1 do begin
    sc := GetsStyle(Control.Controls[i]);
    if (csDestroying in Control.Controls[i].ComponentState) then break;
    if Assigned(sc) and (sc.SkinIndex > -1) and gd[sc.SkinIndex].ShadowEnabled and Control.Controls[i].Visible then begin
      sc.PaintShadow(BGBmp.Canvas, 0, 0);
    end
    else
    if Assigned(sc) and (sc.COC > 0) and sc.Effects.Shadow.Enabled and Control.Controls[i].Visible then begin
      sc.PaintShadow(BGBmp.Canvas, 0, 0);
    end;
  end;
end;

procedure PaintPassiveControls(WinControl : TWinControl);
var
  i : integer;
begin
  for i := 0 to WinControl.ControlCount - 1 do begin
    if (WinControl.Controls[i] is TsLabel) then begin
      if ControlIsReady(WinControl.Controls[i]) then WinControl.Controls[i].Repaint;
    end;
  end;
end;

procedure RepaintsGraphicControls(WinControl : TWinControl);
var
  i : integer;
begin
  for i := 0 to WinControl.ControlCount - 1 do begin
    if (WinControl.Controls[i] is TGraphicControl) then begin
      if ControlIsReady(WinControl.Controls[i]) then WinControl.Controls[i].Repaint;
    end;
  end;
end;

function ControlIsReady(Control : TControl) : boolean;
begin
  Result := (Control <> nil) and not (csCreating in Control.ControlState) and
              not (csLoading in Control.ComponentState) and
                  not (csDestroying in Control.ComponentState) {and Control.Visible} and (Control.Parent <> nil);
end;

procedure CopyFromParent(sStyle: TsPaintStyle; aRect: TRect);
var
  pRect: TRect;
  ci : TCacheInfo;
begin
  pRect := aRect;
  ci := sStyle.GetParentCache;
  OffsetRect(pRect, sStyle.FOwner.Left + ci.X, sStyle.FOwner.Top + ci.Y);
  if sStyle is TsActiveBGStyle then begin
    if sStyle.SkinIndex > -1 then
      FadeRect(ci.Bmp.Canvas,
           pRect,
           sStyle.FCacheBmp.Canvas.Handle,
           Point(aRect.Left, aRect.Top),
           gd[sStyle.SkinIndex].HotPaintingTransparency,
           gd[sStyle.SkinIndex].HotPaintingColor, 0, ssRectangle)
    else
      FadeRect(ci.Bmp.Canvas,
           pRect,
           sStyle.FCacheBmp.Canvas.Handle,
           Point(aRect.Left, aRect.Top),
           TsActiveBGStyle(sStyle).HotStyle.HotPainting.Transparency,
           TsActiveBGStyle(sStyle).HotStyle.HotPainting.Color, 0, ssRectangle)
  end
  else begin
    if sStyle.SkinIndex > -1 then
      FadeRect(ci.Bmp.Canvas,
           pRect,
           sStyle.FCacheBmp.Canvas.Handle,
           Point(aRect.Left, aRect.Top),
           gd[sStyle.SkinIndex].PaintingTransparency,
           gd[sStyle.SkinIndex].PaintingColor, 0, ssRectangle)
    else
      FadeRect(ci.Bmp.Canvas,
           pRect,
           sStyle.FCacheBmp.Canvas.Handle,
           Point(aRect.Left, aRect.Top),
           sStyle.Painting.Transparency,
           ColorToRGB(sStyle.Painting.Color), 0, ssRectangle);
  end;
end;

function GetOwnerForm(Component: TComponent) : TCustomForm;
var
  c: TComponent;
begin
  Result := nil;
  c := Component;
  while Assigned(c) and not (c is TCustomForm) do begin
    c := c.Owner;
  end;
  if (c is TCustomForm) then begin
    Result := TCustomForm(c);
  end;
end;

procedure SetPanelFocus(Panel : TWinControl);
var
  List : TList;
  i : integer;
begin
  List := TList.Create;
  Panel.GetTabOrderList(List);
  if List.Count>0 then begin
    for i:=0 to List.Count-1 do begin
      if TWinControl(List[i]).Enabled and TWinControl(List[i]).TabStop then begin
        TWinControl(List[i]).SetFocus;
        Break;
      end;
    end;
  end;
  List.Free;
end;

procedure SetControlsEnabled(Parent:TWinControl; Value: boolean);
var
   i:integer;
begin
  for i:=0 to Parent.ControlCount-1 do begin
    if not (Parent.Controls[i] is TCustomPanel) then Parent.Controls[i].Enabled := Value;
  end;
end;

function CheckPanelFilled(Panel:TCustomPanel):boolean;
var
   i:integer;
begin
  Result:=False;
  for i:=0 to Panel.ControlCount-1 do begin
    if (Panel.Controls[i] is TEdit) and (TEdit(Panel.Controls[i]).Text='') then begin exit; end;
//    if (Panel.Controls[i] is TDateEdit) and (TDateEdit(Panel.Controls[i]).Text='  .  .    ') then begin exit; end;
//    if (Panel.Controls[i] is TComboEdit) and (TComboEdit(Panel.Controls[i]).Text='') then begin exit; end;
    if (Panel.Controls[i] is TComboBox) and (TComboBox(Panel.Controls[i]).Text='') then begin exit; end;
  end;
  Result:=True;
end;

procedure ClearPanel(Panel:TWinControl);
var
  List : TList;
  i : integer;
//  Mes : TMessage;
begin
//  Mes.Msg := WM_CLEAR;
//  BroadcastS(Panel, Mes);

  List := TList.Create;
  Panel.GetTabOrderList(List);
  if List.Count > 0 then begin
    for i := 0 to List.Count - 1 do begin
      if True{TWinControl(List[i]).Enabled and TWinControl(List[i]).TabStop} then begin

//        if TWinControl(List[i]) is TsCustomDateEdit then begin
//          TsCustomDateEdit(TWinControl(List[i])).Date := Date;
//          Application.ProcessMessages;
//          TsDateEdit(TWinControl(List[i])).Text := '  .  .    ';
//        end else
      {$IFNDEF ALITE}
        if TWinControl(List[i]) is TsCustomNumEdit then begin
          TsCustomNumEdit(TWinControl(List[i])).Value := 0;
        end else
        if TWinControl(List[i]) is TsCustomComboEdit then begin
          TsCustomComboEdit(TWinControl(List[i])).Text := '';
        end else
        if TWinControl(List[i]) is TsCustomComboBox then begin
          TsCustomComboBox(TWinControl(List[i])).Active := True;
          TCustomComboBox(TWinControl(List[i])).ItemIndex := -1;
        end else 
      {$ENDIF}
        if TWinControl(List[i]) is TCustomEdit then begin
          TCustomEdit(TWinControl(List[i])).Text := '';
        end else
        if TWinControl(List[i]) is TsCheckedControl then begin
          TsCheckedControl(TWinControl(List[i])).Checked := False;
        end else
        if TWinControl(List[i]) is TCheckBox then begin
          TCheckBox(TWinControl(List[i])).Checked := False;
        end;
      end;
    end;
  end;
  List.Free;

end;

procedure Delay(MSecs: Integer);
var
  FirstTickCount : dword;//LongInt;
begin
  FirstTickCount := GetTickCount;
  repeat
    Application.ProcessMessages; {allowing access to other controls, etc.}
  until ((GetTickCount - FirstTickCount) >= dword(MSecs));
end;

{$IFDEF USEDB}
procedure ComboBoxFilling(ComboBox:TComboBox; DataSet:TDataSet; CodeField, NameField:string; CountSymb:integer; FromDOSToWIN: boolean);
begin
   with DataSet do begin
      DisableControls;
      open;
      first;
      while not eof do begin
        if CodeField<>'' then begin
         if FieldByName(CodeField).AsInteger < CountSymb then begin
          if FromDOSToWIN
            then ComboBox.Items.Add('0' + FieldByName(CodeField).AsString + ' - ' + OEMToAnsiStr(FieldByName(NameField).AsString))
            else ComboBox.Items.Add('0' + FieldByName(CodeField).AsString + ' - ' + FieldByName(NameField).AsString);
         end
         else begin
          if FromDOSToWIN
            then ComboBox.Items.Add(FieldByName(CodeField).AsString + ' - ' + OEMToAnsiStr(FieldByName(NameField).AsString))
            else ComboBox.Items.Add(FieldByName(CodeField).AsString + ' - ' + FieldByName(NameField).AsString);
         end;
        end
        else begin
          if FromDOSToWIN
            then ComboBox.Items.Add(OEMToAnsiStr(FieldByName(NameField).AsString))
            else ComboBox.Items.Add(FieldByName(NameField).AsString);
        end;
        next;
      end;
      EnableControls;
   end;
end;

procedure FillsComboBox(sC : TCustomComboBox; CharsInCode: smallint; sD: TDataSet);
begin
  if not sD.Active then sD.Open;
  sC.Items.Clear;
  while not sD.Eof do begin
    if (CharsInCode = 0) then begin
      sC.Items.Add(sD.Fields[0].asString);
    end
    else begin
      sC.Items.Add(AddChar('0', sD.Fields[0].asString, CharsInCode) +
                   ' - ' + sD.Fields[1].asString);
    end;
    sD.Next;
  end;
  sD.Close;
  sC.ItemIndex := 0;
end;
{$ENDIF}

function GetStringFlags(Control: TControl; al: TAlignment): longint;
begin
  Result := Control.DrawTextBiDiModeFlags(DT_EXPANDTABS or DT_VCENTER or AlignToInt[al]);
end;

procedure RepaintsControls(Owner: TWinControl; BGChanged : boolean);
var
  i: Integer;
begin
  with Owner do for i := 0 to ControlCount - 1 do begin
    if ControlIsReady(Controls[i]) then begin
{$IFNDEF ALITE}
      if Controls[i] is TsCustomLabel then begin
        Controls[i].Repaint;
      end
      else
      if Controls[i] is TsScrollBox then begin
        TsScrollBox(Controls[i]).CommonData.BGChanged := BGChanged;
        TsScrollBox(Controls[i]).Repaint;
      end else
      if Controls[i] is TsCommonComboBox then begin
        TsCommonComboBox(Controls[i]).CommonData.BGChanged := BGChanged;
        TsCommonComboBox(Controls[i]).Repaint;
      end else
{$ENDIF}
      if (GetStyleInfo(Controls[i]) > 0) then begin
        case GetsStyle(Controls[i]).COC of
          COC_TsSpinEdit : begin
//            TsSpinEdit(Controls[i]).Invalidate;
          end;
          COC_TsEdit..COC_TsMemo, COC_TsCurrencyEdit, COC_TsListBox : begin
//            TWinControl(Controls[i]).Repaint;
          end;
          COC_TsCustomComboBox..COC_TsBDEComboBox : begin
//            TsCustomComboBox(Controls[i]).Repaint; // It is work correct?
//            TsCustomComboBox(Controls[i]).sStyle.RedrawBorder; // It is work correct?
          end;
          COC_TsCustomComboEdit..COC_TsDateEdit: begin
//            TWinControl(Controls[i]).Repaint;
          end;
          COC_TsCheckedControl..COC_TsRadioButton : begin
            if BGChanged then begin
              SetControlChanged(Controls[i], True);
              TsCheckedControl(Controls[i]).PaintControl;
            end;
          end;
          COC_TsPanel..COC_TsTabSheet, COC_TsCustomPanel: begin
            SetControlChanged(Controls[i], BGChanged);
            TsCustomPanel(Controls[i]).Repaint;
          end;
        {$IFNDEF ALITE}
          COC_TsGroupBox: begin
            SetControlChanged(Controls[i], BGChanged);
//            SendMessage(TsGroupBox(Controls[i]).Handle, CM_INVALIDATE, 0, 0);
            TsGroupBox(Controls[i]).Repaint;
          end;
          COC_TsPageControl: begin
            if BGChanged then begin
              SetControlChanged(Controls[i], BGChanged);
            end;
            TsPageControl(Controls[i]).Repaint;
          end;
          COC_TsScrollBar: begin
            if TsScrollBar(Controls[i]).LinkedControl = nil then begin
              if BGChanged then begin
                SetControlChanged(Controls[i], BGChanged);
              end;
              TsScrollBar(Controls[i]).Repaint;
            end;
          end;
        {$ENDIF}
          COC_TsButtonControl..COC_TsColorSelect : begin
//            if (TsButtonControl(Controls[i]).sStyle.Painting.Transparency > 0) then begin
              if BGChanged then begin
                SetControlChanged(Controls[i], True);
              end;
              TsButtonControl(Controls[i]).Repaint;
//            end;
          end;
          COC_TsGauge, COC_TsTrackBar : begin
            if BGChanged then begin
              SetControlChanged(Controls[i], BGChanged);
              TControl(Controls[i]).Invalidate;//Repaint
            end;
          end;
        {$IFNDEF ALITE}
          COC_TsStatusBar : begin
            if (TsStatusBar(Controls[i]).sStyle.Painting.Transparency > 0) then begin
              if BGChanged then begin
                SetControlChanged(Controls[i], BGChanged);
                TsStatusBar(Controls[i]).Repaint;
              end;
            end;
          end;
        {$ENDIF}  
        end;
      end;
    end;
  end;
  {$IFNDEF ALITE}
    if Owner is TsMonthCalendar then TsMonthCalendar(Owner).FGrid.Invalidate;
  {$ENDIF}
end;

procedure SetControlChanged(Control : TControl; BGChanged : boolean);
var
  M : TSMsetBoolean;
begin
  M.Value := BGChanged;
  M.GroupIndex := 0;
  M.Msg := SM_SETBGCHANGED;
  Control.Perform(M.Msg, TMessage(M).WParam, TMessage(M).LParam);
end;

end.