svclutils.pas

Alpha Controls.v5.46b Source

          ReleaseDC(0, tDC);
          MemDC := CreateCompatibleDC(0); OldBitmap := SelectObject(MemDC, MemBitmap);
          MemDCExists := True;
          for j := 0 to Count - 1 do // Copy parent BG
            if ControlIsReady(OwnerControl.Controls[J]) then begin
              if not (csOpaque in OwnerControl.Controls[J].ControlStyle) // and (OwnerControl.Controls[J].Align = alNone)// if transparent
                then BitBlt(MemDC, OwnerControl.Controls[J].Left, OwnerControl.Controls[J].Top, OwnerControl.Controls[J].Width, OwnerControl.Controls[J].Height, GlobalCacheInfo.Bmp.Canvas.Handle, OwnerControl.Controls[J].Left + GlobalCacheInfo.X, OwnerControl.Controls[J].Top + GlobalCacheInfo.Y, SRCCOPY)
                else FillDC(MemDC, OwnerControl.Controls[J].BoundsRect, TsHackedControl(OwnerControl.Controls[J]).Color);
            end;
        end;

        SaveIndex := SaveDC(MemDC);

        if not RectVisible(DC, OwnerControl.Controls[I].BoundsRect) then begin
          SendAMessage(OwnerControl.Controls[I], AC_SETHALFVISIBLE);
        end;

        MoveWindowOrg(MemDC, OwnerControl.Controls[I].Left, OwnerControl.Controls[I].top);
        IntersectClipRect(MemDC, 0, 0, OwnerControl.Controls[I].Width, OwnerControl.Controls[I].Height);

        if csPaintCopy in OwnerControl.ControlState then begin
          OwnerControl.Controls[I].ControlState := OwnerControl.Controls[I].ControlState + [csPaintCopy];
        end;
        OwnerControl.Controls[I].Perform(WM_PAINT, longint(MemDC), 0);
        if csPaintCopy in OwnerControl.ControlState then begin
          OwnerControl.Controls[I].ControlState := OwnerControl.Controls[I].ControlState - [csPaintCopy];
        end;

        MoveWindowOrg(MemDC, - OwnerControl.Controls[I].Left, - OwnerControl.Controls[I].Top);

        RestoreDC(MemDC, SaveIndex);
      end;
      Inc(i);
    end;
    if MemDCExists then begin
      J := 0;
      while J < Count do begin // Copy graphic controls
        if ControlIsReady(OwnerControl.Controls[J]) then begin
          if GetPixel(MemDC, OwnerControl.Controls[J].Left + Offset.X, OwnerControl.Controls[J].Top + Offset.Y) <> DWord(clFuchsia) then
            BitBlt(DC, OwnerControl.Controls[J].Left + Offset.X, OwnerControl.Controls[J].Top + Offset.Y, OwnerControl.Controls[J].Width, OwnerControl.Controls[J].Height,
                   MemDC, OwnerControl.Controls[J].Left, OwnerControl.Controls[J].Top, SRCCOPY);
        end;
        inc(J);
      end;
    end;
    GlobalCacheInfo.Ready := False;
  finally if MemDCExists then begin
    SelectObject(MemDC, OldBitmap);
    DeleteDC(MemDC);
    DeleteObject(MemBitmap);
  end; end;
end;

function SendAMessage(Handle : hwnd; Cmd : Integer; LParam : longword = 0) : longint; overload;
begin
  Result := SendMessage(Handle, SM_ALPHACMD, MakeWParam(0, Cmd), LParam);
end;

function SendAMessage(Control : TControl; Cmd : Integer; LParam : longword = 0) : longint; overload;
begin
  Result := 0;
  if (Control is TWinControl) then begin
    if not (csDestroying in Control.ComponentState) and TWinControl(Control).HandleAllocated
      then Result := SendMessage(TWinControl(Control).Handle, SM_ALPHACMD, MakeWParam(0, Cmd), LParam)
  end
  else Result := Control.Perform(SM_ALPHACMD, MakeWParam(0, Cmd), LParam)
end;

procedure SetBoolMsg(Handle : hwnd; Cmd : Cardinal; Value : boolean);
var
  m : TMessage;
begin
  m.Msg := SM_ALPHACMD;
  m.WParam := MakeWParam(Word(Value), Cmd);
  m.Result := 0;
  SendMessage(Handle, m.Msg, m.wParam, m.lParam);
end;

function GetBoolMsg(Control : TWinControl; Cmd : Cardinal) : boolean;
var
  M : TMessage;
begin
  m.Msg := SM_ALPHACMD;
  M.WParam := MakeWParam(0, Cmd);
  M.LParam := 0;
  M.Result := 0;
  Control.WindowProc(M);
  Result := (M.LParam = 1);
  if not Result and Control.HandleAllocated then Result := SendMessage(Control.Handle, M.Msg, M.WParam, M.LParam) = 1;
end;

function GetBoolMsg(CtrlHandle : hwnd; Cmd : Cardinal) : boolean; overload;
var
  LParam : cardinal;
begin
  LParam := 0;
  if SendMessage(CtrlHandle, SM_ALPHACMD, MakeWParam(0, Cmd), LParam) = 1 then Result := True else Result := LParam = 1;
end;

procedure RepaintShadows(Control : TWinControl; BGBmp : graphics.TBitmap);
begin
end;

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

function ControlIsReady(Control : TControl) : boolean;
begin
  Result := False;
  if (Control = nil) or ((Control is TWinControl) and not TWinControl(Control).HandleAllocated) then Exit;

  Result := not (csCreating in Control.ControlState) and
              not (csReadingState in Control.ControlState) and
                not (csLoading in Control.ComponentState) and not (csDestroying in Control.ComponentState) and
                  (Control.Parent <> nil);
end;

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

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

procedure SetPanelFocus(Panel : TWinControl);
var
  List : TList;
  i : integer;
begin
  List := TList.Create;
  Panel.GetTabOrderList(List);
  if List.Count > 0 then 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;
  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 TComboBox) and (TComboBox(Panel.Controls[i]).Text='') then begin exit; end;
  end;
  Result:=True;
end;

{$IFDEF USEDB}
procedure ComboBoxFilling(ComboBox:TComboBox; DataSet:TDataSet; const 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
  i := 0;
  while i <= Owner.ControlCount - 1 do begin
    if ControlIsReady(Owner.Controls[i]) then begin
      if not (Owner.Controls[i] is TGraphicControl) then Owner.Controls[i].Invalidate;
    end;
    inc(i);
  end;
end;

procedure AlphaBroadCast(Control : TWinControl; var Message);
var
  i : integer;
begin
  i := 0;
  while i < Control.ControlCount do begin
    if (i >= Control.ControlCount) or (csDestroying in Control.Controls[i].ComponentState) then Exit;
    if (Control.Controls[i] is TWincontrol) then begin
      if not TWinControl(Control).HandleAllocated then begin
        Control.Controls[i].Perform(TMessage(Message).Msg, TMessage(Message).Wparam, TMessage(Message).LParam);
      end
      else if GetBoolMsg(TWinControl(Control.Controls[i]), AC_CTRLHANDLED) then begin
        SendMessage(TWinControl(Control.Controls[i]).Handle, TMessage(Message).Msg, TMessage(Message).WParam, TMessage(Message).LParam)
      end
      else begin
{$IFDEF DEVEX}
        if Control.Controls[i] is TcxGrid then begin
          TcxGrid(Control.Controls[i]).Invalidate(True);
        end
        else
{$ENDIF}
        AlphaBroadCast(TWinControl(Control.Controls[i]), Message);
      end;
    end
    else Control.Controls[i].Perform(TMessage(Message).Msg, TMessage(Message).Wparam, TMessage(Message).LParam);
    inc(i);
  end;
end;

procedure SendToProvider(Form : TCustomform; var Message);
var
  i : integer;
begin
  i := 0;
  while i < Form.ComponentCount do begin
    if i >= Form.ComponentCount then Exit;
    if (Form.Components[i] is TsSkinProvider) and not (csDestroying in Form.Components[i].ComponentState) then begin
      TsSkinProvider(Form.Components[i]).DsgnWndProc(TMessage(Message));
      exit
    end;
    inc(i);
  end;
end;

function GetCtrlRange(Ctl : TWinControl; nBar : integer) : integer;
var
  i, iMin, iMax : integer;
begin
  iMax := 0;
  iMin := 0;
  case nBar of
    SB_VERT : begin
      iMin := Ctl.Height;
      for i := 0 to Ctl.ControlCount - 1 do begin
        iMin := Min(iMin, Ctl.Controls[i].Top);
        iMax := Max(iMax, Ctl.Controls[i].Top + Ctl.Controls[i].Height);
      end;
    end;
    SB_HORZ : begin
      iMin := Ctl.Width;
      for i := 0 to Ctl.ControlCount - 1 do begin
        iMin := Min(iMin, Ctl.Controls[i].Left);
        iMax := Max(iMax, Ctl.Controls[i].Left + Ctl.Controls[i].Width);
      end;
    end;
  end;
  if iMin < iMax then Result := iMax - iMin else Result := 0
end;

function ACClientRect(Handle : hwnd): TRect;
var
  R: TRect;
begin
  Windows.GetClientRect(Handle, Result);
  GetWindowRect(Handle, R);
  MapWindowPoints(0, Handle, R, 2);
  OffsetRect(Result, -R.Left, -R.Top);
end;

{ TOutputWindow }

constructor TOutputWindow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Caption := 'acOutputWindow';
  Visible := False;
  Color   := clPurple;
end;

procedure TOutputWindow.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do begin
    if (Parent = nil) and (ParentWindow = 0) then begin
      Style := WS_POPUP;
      if(Owner is TWinControl) and ((DWord(GetWindowLong(TWinControl(Owner).Handle, GWL_EXSTYLE)) and WS_EX_TOPMOST) <> 0)
        then ExStyle := ExStyle or WS_EX_TOPMOST;
      WndParent := Application.Handle;
    end;
  end;
end;

procedure TOutputWindow.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  Message.Result := 1;
end;

function GetAlignShift(Ctrl : TWinControl; Align : TAlign; GraphCtrlsToo : boolean = False) : integer;
var
  i : integer;
begin
  Result := 0;
  for i := 0 to Ctrl.ControlCount - 1 do if Ctrl.Controls[i].Visible and (Ctrl.Controls[i].Align = Align) and (GraphCtrlsToo or not (Ctrl.Controls[i] is TGraphicControl)) then begin
    case Align of
      alLeft, alRight : inc(Result, Ctrl.Controls[i].Width);
      alTop, alBottom : inc(Result, Ctrl.Controls[i].Height);
    end;
  end;
end;

initialization
  uxthemeLib := LoadLibrary('UXTHEME');
  try
    if uxthemeLib <> 0
      then Ac_SetWindowTheme := GetProcAddress(uxthemeLib, 'SetWindowTheme')
      else @Ac_SetWindowTheme := nil
  finally
  end;

finalization
  FreeLibrary(uxthemeLib);

end.