dxclass.pas

原版翎风(LF)引擎(M2)源码(Delphi)

  ExStyle := GetWindowLong(Application.Handle, GWL_EXSTYLE);
  ExStyle := ExStyle or WS_EX_TOOLWINDOW;
  SetWindowLong(Application.Handle, GWL_EXSTYLE, ExStyle);
end;

destructor TDXForm.Destroy;
var
  ExStyle: Integer;
begin
  Dec(SetAppExStyleCount);
  if SetAppExStyleCount=0 then
  begin
    ExStyle := GetWindowLong(Application.Handle, GWL_EXSTYLE);
    ExStyle := ExStyle and (not WS_EX_TOOLWINDOW);
    SetWindowLong(Application.Handle, GWL_EXSTYLE, ExStyle);
  end;
  inherited Destroy;
end;

procedure TDXForm.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW;
end;

procedure TDXForm.RestoreWindow;
begin
  if FStoreWindow then
  begin
    SetWindowPlacement(Handle, @FWindowPlacement);
    FStoreWindow := False;
  end;
end;

procedure TDXForm.StoreWindow;
begin
  FWindowPlacement.Length := SizeOf(FWindowPlacement);
  FStoreWindow := GetWindowPlacement(Handle, @FWindowPlacement);
end;

procedure TDXForm.WMSYSCommand(var Msg: TWMSYSCommand);
begin
  if Msg.CmdType = SC_MINIMIZE then
  begin
    DefaultHandler(Msg);
    WindowState := wsMinimized;
  end else
    inherited;
end;

{  TCustomDXTimer  }

constructor TCustomDXTimer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FActiveOnly := True;
  FEnabled := True;
  Interval := 1000;
  Application.HookMainWindow(AppProc);
end;

destructor TCustomDXTimer.Destroy;
begin
  Finalize;
  Application.UnHookMainWindow(AppProc);
  inherited Destroy;
end;

procedure TCustomDXTimer.AppIdle(Sender: TObject; var Done: Boolean);
var
  t, t2: DWORD;
  LagCount, i: Integer;
begin
  Done := False;

  t := TimeGetTime;
  t2 := t-FOldTime;
  if t2>=FInterval then
  begin
    FOldTime := t;

    LagCount := t2 div FInterval2;
    if LagCount<1 then LagCount := 1;

    Inc(FNowFrameRate);

    i := Max(t-FOldTime2, 1);
    if i>=1000 then
    begin
      FFrameRate := Round(FNowFrameRate*1000/i);
      FNowFrameRate := 0;
      FOldTime2 := t;
    end;

    DoTimer(LagCount);
  end;
end;

function TCustomDXTimer.AppProc(var Message: TMessage): Boolean;
begin
  Result := False;
  case Message.Msg of
    CM_ACTIVATE:
        begin
          DoActivate;
          if FInitialized and FActiveOnly then Resume;
        end;
    CM_DEACTIVATE:
        begin
          DoDeactivate;
          if FInitialized and FActiveOnly then Suspend;
        end;
  end;
end;

procedure TCustomDXTimer.DoActivate;
begin
  if Assigned(FOnActivate) then FOnActivate(Self);
end;

procedure TCustomDXTimer.DoDeactivate;
begin
  if Assigned(FOnDeactivate) then FOnDeactivate(Self);
end;

procedure TCustomDXTimer.DoTimer(LagCount: Integer);
begin
  if Assigned(FOnTimer) then FOnTimer(Self, LagCount);
end;

procedure TCustomDXTimer.Finalize;
begin
  if FInitialized then
  begin
    Suspend;
    FInitialized := False;
  end;
end;

procedure TCustomDXTimer.Initialize;
begin
  Finalize;

  if ActiveOnly then
  begin
    if Application.Active then
      Resume;
  end else
    Resume;
  FInitialized := True;
end;

procedure TCustomDXTimer.Loaded;
begin
  inherited Loaded;
  if (not (csDesigning in ComponentState)) and FEnabled then
    Initialize;
end;

procedure TCustomDXTimer.Resume;
begin
  FOldTime := TimeGetTime;
  FOldTime2 := TimeGetTime;
  Application.OnIdle := AppIdle;
end;

procedure TCustomDXTimer.SetActiveOnly(Value: Boolean);
begin
  if FActiveOnly<>Value then
  begin
    FActiveOnly := Value;

    if Application.Active and FActiveOnly then
      if FInitialized and FActiveOnly then Suspend;
  end;
end;

procedure TCustomDXTimer.SetEnabled(Value: Boolean);
begin
  if FEnabled<>Value then
  begin
    FEnabled := Value;
    if ComponentState*[csReading, csLoading]=[] then
      if FEnabled then Initialize else Finalize;
  end;
end;

procedure TCustomDXTimer.SetInterval(Value: Cardinal);
begin
  if FInterval<>Value then
  begin
    FInterval := Max(Value, 0);
    FInterval2 := Max(Value, 1);
  end;
end;

procedure TCustomDXTimer.Suspend;
begin
  Application.OnIdle := nil;
end;

{  TControlSubClass  }

constructor TControlSubClass.Create(Control: TControl;
  WindowProc: TControlSubClassProc);
begin
  inherited Create;
  FControl := Control;
  FDefWindowProc := FControl.WindowProc;
  FControl.WindowProc := WndProc;
  FWindowProc := WindowProc;
end;

destructor TControlSubClass.Destroy;
begin
  FControl.WindowProc := FDefWindowProc;
  inherited Destroy;
end;

procedure TControlSubClass.WndProc(var Message: TMessage);
begin
  FWindowProc(Message, FDefWindowProc);
end;

{  THashCollectionItem  }

function MakeHashCode(const Str: string): Integer;
var
  s: string;
begin
  s := AnsiLowerCase(Str);
  Result := Length(s)*16;
  if Length(s)>=2 then
    Result := Result + (Ord(s[1]) + Ord(s[Length(s)-1]));
  Result := Result and 255;
end;
               
constructor THashCollectionItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FIndex := inherited Index;
  AddHash;
end;

destructor THashCollectionItem.Destroy;
var
  i: Integer;
begin
  for i:=FIndex+1 to Collection.Count-1 do
    Dec(THashCollectionItem(Collection.Items[i]).FIndex);
  DeleteHash;
  inherited Destroy;
end;

procedure THashCollectionItem.Assign(Source: TPersistent);
begin
  if Source is THashCollectionItem then
  begin
    Name := THashCollectionItem(Source).Name;
  end else
    inherited Assign(Source);
end;

procedure THashCollectionItem.AddHash;
var
  Item: THashCollectionItem;
begin
  FHashCode := MakeHashCode(FName);

  Item := THashCollection(Collection).FHash[FHashCode];
  if Item<>nil then
  begin
    Item.FLeft := Self;
    Self.FRight := Item;
  end;

  THashCollection(Collection).FHash[FHashCode] := Self;
end;

procedure THashCollectionItem.DeleteHash;
begin
  if FLeft<>nil then
  begin
    FLeft.FRight := FRight;
    if FRight<>nil then
      FRight.FLeft := FLeft;
  end else
  begin
    if FHashCode<>-1 then
    begin
      THashCollection(Collection).FHash[FHashCode] := FRight;
      if FRight<>nil then
        FRight.FLeft := nil;
    end;
  end;
  FLeft := nil;
  FRight := nil;
end;

function THashCollectionItem.GetDisplayName: string;
begin
  Result := Name;
  if Result='' then Result := inherited GetDisplayName;
end;

procedure THashCollectionItem.SetIndex(Value: Integer);
begin
  if FIndex<>Value then
  begin
    FIndex := Value;
    inherited SetIndex(Value);
  end;
end;

procedure THashCollectionItem.SetName(const Value: string);
begin
  if FName<>Value then
  begin
    FName := Value;
    DeleteHash;
    AddHash;
  end;
end;

{  THashCollection  }

function THashCollection.IndexOf(const Name: string): Integer;
var
  Item: THashCollectionItem;
begin
  Item := FHash[MakeHashCode(Name)];
  while Item<>nil do
  begin
    if AnsiCompareText(Item.Name, Name)=0 then
    begin
      Result := Item.FIndex;
      Exit;
    end;
    Item := Item.FRight;
  end;
  Result := -1;
end;

initialization
  InitCosinTable;
finalization
  FreeLibList;
end.