aqdockingutils.pas

来自「AutomatedDocking Library 控件源代码修改 适合Delp」· PAS 代码 · 共 2,359 行 · 第 1/5 页

{$ELSE}
  Item.MakeVisible(False);
{$IFEND}
{$ELSE}
  Item.MakeVisible(False);
{$ENDIF}
end;

procedure aqSelectionSort(SortList: PPointerList; L, R: Integer;
  SCompare: TListSortCompare);
var
  I, J: Integer;
  P1, P2: Pointer;
begin
  for I := L to R - 1 do
    for J := R downto I + 1 do
    begin
      P1 := SortList^[I];
      P2 := SortList^[J];
      if SCompare(P1, P2) > 0 then
      begin
        SortList^[I] := P2;
        SortList^[J] := P1;
      end;
    end;
end;

{$IFDEF DEMO}
procedure CheckDemo;
{$IFDEF LINUX}
var
  F: Libc.PIOFile;
  Text: array [0..255] of Char;
  s: string;
{$ENDIF}
begin
  if csDesigning in Application.ComponentState then
    Exit;
{$IFDEF MSWINDOWS}
  if FindWindow('TAppBuilder', nil) = 0 then
  begin
    Windows.MessageBox(0, PChar(SDemoMessage), PChar(SDemoCaption), MB_OK or MB_ICONINFORMATION);
    Halt;
  end
{$ENDIF}
{$IFDEF LINUX}
  F := Libc.popen('ps -e o %c', 'r');
  try
    while Libc.fscanf(F, '%s', @Text) <> Libc.__EOF do
    begin
      s := AnsiLowerCase(StrPas(@Text));
      if (AnsiPos('kylix', s) > 0) or (AnsiPos('delphi', s) > 0) then
        Exit;
    end;
    MessageDlg(SDemoCaption, SDemoMessage, mtInformation, [mbOK], 0);
    Halt;
  finally
    if F <> nil then Libc.pclose(F);
  end;
{$ENDIF}
end;
{$ENDIF}

function aqGetWindowHandle(Window: TControl): THandle;
begin
  if Window <> nil then
{$IFDEF VCL}
    Result := TaqControl(Window).Handle
{$ELSE}
    Result := QWidget_winId(TaqControl(Window).Handle)
{$ENDIF}
  else
    Result := 0;
end;

function aqGetRootParent(Control: TControl): TaqControl;
begin
  if Control = nil then
  begin
    Result := nil;
    Exit;
  end;
  if Control is TaqControl then
    Result := TaqControl(Control)
  else
    Result := Control.Parent;
  while (Result <> nil) and not (Result is TCustomForm) and not (Result is TFrame) do
    Result := Result.Parent;
end;

{$IFDEF MSWINDOWS}
function aqGetRootWindowHandle(Control: TControl): TaqHandle;
var
  Handle: TaqHandle;
begin
  Result := aqNullHandle;
  if Control = nil then
    Exit;
  if not (Control is TaqControl) then
    Control := Control.Parent;

{$IFDEF VCL}
  Handle := TaqControl(Control).Handle;
{$ELSE}
  Handle := QWidget_winId(TaqControl(Window).Handle);
{$ENDIF}
  Result := GetAncestor(Handle, GA_ROOT);
end;
{$ENDIF}


function aqGetRootParentHandle(Control: TControl): TaqHandle;
var
  Ctrl: TaqControl;
begin
  if Control = nil then
    Ctrl := nil
  else if Control is TaqControl then
    Ctrl := TaqControl(Control)
  else
    Ctrl := Control.Parent;
  if Ctrl = nil then
  begin
    Result := aqNullHandle;
    Exit;
  end;
{$IFDEF VCL}
  Result := GetAncestor(Ctrl.Handle, GA_ROOT);
{$ELSE}
  Result := aqNullHandle; // todo
{$ENDIF}
end;

function aqGetParent(Handle: TaqHandle): TaqHandle;
begin
{$IFDEF VCL}
  Result := GetAncestor(Handle, GA_PARENT);
{$ELSE}
  Result := QWidget_parentWidget(Handle);
{$ENDIF}
end;

function aqIsWindowHigher(Wnd1, Wnd2: TaqHandle): Integer;
{$IFDEF VCL}
var
  CommonAncestor, HigherParent: TaqHandle;
{$ENDIF}
begin
{$IFDEF VCL}
  Result := -1;
  if (Wnd1 = Wnd2) or ((Wnd1 = aqNullHandle) and (Wnd2 = GetDeskTopWindow)) or
    ((Wnd2 = aqNullHandle) and (Wnd1 = GetDeskTopWindow)) then
  begin
    Result := 0;
    Exit;
  end;

  CommonAncestor := Wnd1;
  while not IsChild(CommonAncestor, Wnd2) and (CommonAncestor <> Wnd2) and
    (CommonAncestor <> aqNullHandle) do
    CommonAncestor := aqGetParent(CommonAncestor);

  HigherParent := GetTopWindow(CommonAncestor);
  repeat
    if (HigherParent = Wnd1) or IsChild(HigherParent, Wnd1) then
    begin
      Result := 1;
      Break;
    end
    else if (HigherParent = Wnd2) or IsChild(HigherParent, Wnd2) then
      Break
    else
      HigherParent := GetNextWindow(HigherParent, GW_HWNDNEXT);
  until HigherParent = aqNullHandle;

  if HigherParent = aqNullHandle then
    Result := 0;
{$ELSE}
  Result := 0; // todo: GetTopWindow and GetNextWindow
{$ENDIF}
end;

{$IFDEF VCL}
function DoEnumChildWindows(Window: HWND; Param: Pointer): LongBool; stdcall;
begin
  TList(Param).Add(Pointer(Window));
  Result:= True;
end;
{$ENDIF}

procedure aqEnumChildWindows(Parent: TaqHandle; Children: TList);
begin
{$IFDEF VCL}
  Windows.EnumChildWindows(Parent, @DoEnumChildWindows, Integer(Children));
{$ELSE}
  // todo
{$ENDIF}
end;

procedure aqLockWindowRedraw(Handle: TaqHandle);
begin
{$IFDEF VCL}
  if IsWindow(Handle) then
    SendMessage(Handle, WM_SETREDRAW, Integer(False), 0);
{$ELSE}
  // todo
{$ENDIF}
end;

procedure aqUnlockWindowRedraw(Handle: TaqHandle);
begin
{$IFDEF VCL}
  if IsWindow(Handle) then
    SendMessage(Handle, WM_SETREDRAW, Integer(True), 0);
{$ELSE}
{$ENDIF}
end;

function aqMouseTrack(const P1, P2: TPoint): Integer;
begin
  Result := Round(Sqrt(Sqr(P1.X - P2.X) + Sqr(P1.Y - P2.Y)));
end;

function aqButtonToShiftState(Button: TMouseButton): TShiftState;
const
  ShiftStates: array [TMouseButton] of TShiftState =
    // mbLeft, mbRight, mbMiddle
    ([ssleft], [ssRight], [ssMiddle]);
begin
  Result := ShiftStates[Button];
end;

function aqIsRgnEmpty(Region: TaqHandle): Boolean;
var
  Rect: TRect;
begin
  Result := (Region = aqNullhandle) or
    (GetRgnBox(Region, Rect) = aqRegionEmpty) or IsRectEmpty(Rect);
end;

procedure aqTransformRegion(var Region: TaqHandle; const Transformation: TXForm);
var
  Count: Cardinal;
  RgnData: PRgnData;
  NewRegion: THandle;
begin
  if Region = aqNullHandle then
    Exit;
  Count := GetRegionData(Region, 0, nil);
  if Count = 0 then
    Exit;
  NewRegion := aqNullHandle;
  GetMem(RgnData, Count);
  if GetRegionData(Region, Count, RgnData) = Count then
  begin
    NewRegion := ExtCreateRegion(@Transformation, Count, RgnData^);
    if NewRegion <> aqNullHandle then
    begin
      DeleteObject(Region);
      Region := NewRegion;
    end;
  end;
  FreeMem(RgnData);
  if NewRegion = aqNullHandle then
    RaiseLastOSError;
end;

function aqDuplicateRegion(Region: TaqHandle): TaqHandle;
begin
  Result := CreateRectRgn(0, 0, 0, 0);
  CombineRgn(Result, Region, 0, RGN_COPY);
end;

function aqEqualRgn(Region1, Region2: TaqHandle): Boolean;
begin
  if (Region1 = Region2) and (Region1 = aqNullHandle) then
    Result := True
  else
    Result := EqualRgn(Region1, Region2);
end;

function aqGetRegionComplexity(Region: TaqHandle): TaqRegionComplexity;
begin
  Result := OffsetRgn(Region, 0, 0);
end;

function aqPointToStr(Value: TPoint): string;
begin
  Result := IntToStr(Value.X) + ';' + IntToStr(Value.Y);
end;

function aqRectToStr(Value: TRect): string;
begin
  Result := IntToStr(Value.Left) + ';' + IntToStr(Value.Top) + ';' +
    IntToStr(Value.Right) + ';'  + IntToStr(Value.Bottom);
end;

function aqVarToIntDef(Value: OleVariant; DefValue: Integer): Integer;
begin
  if VarIsOrdinal(Value) then
    Result := Value
  else if VarIsStr(Value) then
    Result := StrToIntDef(Value, DefValue)
  else
    Result := DefValue;
end;

function aqVarToBoolDef(Value: OleVariant; DefValue: Boolean): Boolean;
begin
  if VarType(Value) = varBoolean then
    Result := Value
  else if VarIsStr(Value) then
  begin
    Result := CompareText(Value, 'true') = 0;
    if not Result then
    begin
      Result := CompareText(Value, 'false') <> 0;
      if Result then
        Result := DefValue;
    end
  end
  else
    Result := DefValue;
end;

function aqVarToByteDef(Value: OleVariant; DefValue: Byte): Byte;
var
  I: Integer;
begin
  if VarIsOrdinal(Value) and (Integer(Value) in [Low(Byte)..High(Byte)]) then
    Result := Value
  else if VarIsStr(Value) then
  begin
    I := StrToIntDef(Value, DefValue);
    Result := IfThen(I in [Low(Byte)..High(Byte)], I, DefValue);
  end
  else
    Result := DefValue;
end;

function aqVarToPointDef(Value: OleVariant; const DefValue: TPoint): TPoint;
var
  S: string;
  I: Integer;
begin
  S := VarToStr(Value);
  if S <> '' then
  begin
    I := Pos(';', S);
    if I > 0 then
    begin
      Result.X := StrToIntDef(Copy(S, 1, I - 1), DefValue.X);
      Result.Y := StrToIntDef(Copy(S, I + 1, Length(S)), DefValue.Y);
      Exit;
    end;
  end;
  Result := DefValue;
end;

function aqVarToRectDef(Value: OleVariant; const DefValue: TRect): TRect;
type
  TRectArray = array [0..3] of Integer;
var
  S: string;
  i, StartPos, EndPos: Integer;
begin
  S := VarToStr(Value);
  if S <> '' then
  begin
    StartPos := 1;
    for i := 0 to 3 do
    begin
      EndPos := PosEx(';', S, StartPos);
      if EndPos = 0 then
        EndPos := Length(S) + 1;
      TRectArray(Result)[i] := StrToIntDef(Copy(S, StartPos, EndPos - StartPos),
        TRectArray(DefValue)[i]);
      if (EndPos > StartPos) and (EndPos <= Length(S)) then
        StartPos := EndPos + 1;
    end;
    Exit;
  end;
  Result := DefValue;
end;

{$IFNDEF DELPHI7}
function PosEx(const SubStr, S: string; Offset: Cardinal = 1): Integer;
var
  I,X: Integer;
  Len, LenSubStr: Integer;
begin
  if Offset = 1 then
    Result := Pos(SubStr, S)
  else
  begin
    I := Offset;
    LenSubStr := Length(SubStr);
    Len := Length(S) - LenSubStr + 1;
    while I <= Len do
    begin
      if S[I] = SubStr[1] then
      begin
        X := 1;
        while (X < LenSubStr) and (S[I + X] = SubStr[X + 1]) do
          Inc(X);
        if (X = LenSubStr) then
        begin
          Result := I;
          exit;
        end;
      end;
      Inc(I);
    end;
    Result := 0;
  end;
end;
{$ENDIF}

function GetPopupOwnerWindows(Handle: HWND; Info: LParam): BOOL; stdcall;
var
  LOwner: HWND;
  Pid: DWORD;
begin
  Result := True;
//  outputdebugstring(pchar(inttostr(Handle)));
  LOwner := GetWindow(Handle, GW_OWNER);
  if (LOwner <> 0) and (LOwner <> Application.Handle) then
    GetWindowThreadProcessId(LOwner, Pid)
  else
    Pid := 0;
  if (Pid = GetCurrentProcessId) and (AppHack.FPopupOwners.IndexOf(TObject(LOwner)) < 0) then
    AppHack.FPopupOwners.Add(TObject(LOwner));
end;

{ TaqBucketList }

function TaqBucketList.AddItem(ABucket: Integer; AItem,
  AData: Pointer): Pointer;
begin
  Result := inherited AddItem(ABucket, AItem, AData);
  Inc(FCount);
end;

function TaqBucketList.DeleteItem(ABucket, AIndex: Integer): Pointer;
begin
  // Fix for Delphi 6, 7 : range check error and reading invalid memory address.
  with Buckets[ABucket] do
  begin
    Result := Items[AIndex].Data;

    if Count = 1 then
      SetLength(Items, 0)
    else
      if AIndex < Count - 1 then
        System.Move(Items[AIndex + 1], Items[AIndex],
          (Count - AIndex - 1) * SizeOf(TBucketItem));
    Dec(Count);
  end;
  Dec(FCount);
end;

function TaqBucketList.Iterator: TaqCustomBucketListIterator;
begin
  Result := TaqBucketListIterator.Create(Self);
end;

{ TaqClassObjectList }

function TaqClassObjectList.Add(AItem: TClass; AData: TObject): TObject;
begin
  Result := TObject(inherited Add(AItem, AData));
end;