I downloaded lazarus again after a long time, and I noticed that much was inproved.. it…
Hi,
Where is gtkmsgqueue.pp? Can you delete the *~ files in the base directory before creating the patch?
Ok Sorry, GtkMsgQueue as attachment.
Jer
{*************************************************************************** GtkMsgQueue - Messagequeue for Gtk interface
-------------------
Initial Revision : Thu Aug 16, 2003
***************************************************************************/
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.LCL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* * ***************************************************************************** }
{$mode objfpc}
unit gtkmsgqueue;
interface
uses lazqueue,lcltype,lmessages,gtkglobals,dynhasharray,gtkproc;
type
TFinalPaintMessageFlag=(FPMF_None,FPMF_Internal,FPMF_All);
TGtkMessageQueueItem=class(TLinkListitem)
private
fMsg : PMsg;
public
property Msg : PMsg read fMsg write fMsg;
function IsPaintMessage : boolean;
procedure DestroyMessage(ParFinalInternalOnly : TFinalPaintMEssageFlag);
constructor Create;
end;
TGtkMessageQueue=class(TLinkList)
private
FPaintMessages: TDynHashArray; // Hash for paint messages
protected
function CreateItem : TLinkListItem;override;
function CalculateHash(ParWnd : Hwnd):integer;
function HashPaintMessage(p: pointer): integer;
public
constructor Create;
destructor destroy;override;
function FirstMessageItem : TGtkMessageQueueItem;
function LastMessageItem : TGtkMessageQueueItem;
function FirstMessage : PMsg;
function LastMessage : PMsg;
procedure AddMessage(ParMsg : PMsg);
procedure RemoveMessage(ParItem : TGtkMessageQueueItem;ParFinalOnlyInternal : TFinalPaintMessageFlag);
function FindPaintMessage(HandleWnd: HWnd): TGtkMessageQueueItem;
function HasPaintMessages:boolean;
function HasNonPaintMessages:boolean;
function NumberOfPaintMessages:integer;
procedure PopFirstMessage(var ParMsg : TMsg);
end;
implementation{---(TGtkMessageQueueItem)----------------------}
function TGtkMessageQueueItem.IsPaintMessage : boolean;
begin
Result := false;
if fMsg nil then begin
Result := (Msg^.Message = LM_Paint) or (Msg^.Message = LM_GtkPaint);
end;
end;
constructor TGtkMessageQueueItem.Create;
begin
inherited Create;
fMsg := nil;
end;
procedure TGtkMessageQueueItem.DestroyMessage(ParFinalInternalOnly : TFinalPaintMEssageFlag);
begin
if (ParFinalInternalOnly = FPMF_All) or ((ParFinalInternalOnly = FPMF_Internal) and (fMsg^.message = LM_GtkPaint)) then FinalizePaintTagMsg(fMsg);
dispose(fMsg);
fMsg := nil;
end;{---(TGtkMessageQueue )---------------------------}
constructor TGtkMessageQueue.Create;
begin
inherited Create;
FPaintMessages := TDynHashArray.Create(-1);
FPaintMessages.OwnerHashFunction := @HashPaintMessage;
end;
destructor TGtkMessageQueue.destroy;
begin
inherited Destroy;
fPaintMessages.destroy;
end;{------------------------------------------------------------------------------ Function: FindPaintMessage
Params: a window handle
Returns: nil or a Paint Message to the widget
Searches in FPaintMessages for a LM_PAINT message with HandleWnd.
------------------------------------------------------------------------------}
function TGtkMessageQueue.FindPaintMessage(HandleWnd: HWnd): TGtkMessageQueueItem;
var h: integer;
HashItem: PDynHashArrayItem;
begin
h:= CalculateHash(HandleWnd);
HashItem:=FPaintMessages.GetHashItem(h);
if HashItemnil then begin
Result:=TGtkMessageQueueItem(HashItem^.Item);
if Result.Msg^.hWnd=HandleWnd then
exit;
HashItem:=HashItem^.Next;
while (HashItemnil) and (HashItem^.IsOverflow) do begin
Result:=TGtkMessageQueueItem(HashItem^.Item);
if Result.Msg^.hWnd=HandleWnd then
exit;
HashItem:=HashItem^.Next;
end;
end;
Result:=nil;
end;
function TGtkMessageQueue.HashPaintMessage(p: pointer): integer;
begin
result := CalculateHash(TGtkMessageQueueItem(p).Msg^.Hwnd);
end;
function TGtkMessageQueue.CalculateHash(ParWnd : Hwnd):integer;
var
h:integer;
begin
h :=ParWnd;
if h<0 then h:=-h;
Result:=((h mod 5364329)+(h mod 17)) mod FPaintMessages.Capacity;
end;
function TGtkMessageQueue.CreateItem : TLinkListItem;
begin
result := TGtkMessageQueueItem.Create;
result.ResetItem;
end;
procedure TGtkMessageQueue.AddMessage(ParMsg : PMsg);
var
vLItem : TGtkMessageQueueItem;
begin
vlItem := TGtkMessageQueueItem(GetNewItem);
vlItem.fMsg := ParMsg;
AddAsLast(vlItem);
if vlItem.IsPaintMessage then fPaintMessages.Add(vlitem);
end;
function TGtkMessageQueue.FirstMessageItem : TGtkMessageQueueItem;
begin
Result :=TGtkMessageQueueItem(First);
end;
function TGtkMessageQueue.FirstMessage : PMsg;
begin
Result := nil;
if FirstMessageItem nil then Result := FirstMessageItem.fMsg;
end;
function TGtkMessageQueue.LastMessageItem : TGtkMessageQueueItem;
begin
result:= TGtkMessageQueueItem(Last);
end;
function TGtkMessageQueue.LastMessage : PMsg;
begin
Result := nil;
if LastMessageItem nil then result := LastMessageItem.fMsg;
end;
// Remove from queue and destroy message
// ParItem : Queue Item for removel
// ParFinalOnlyInterl : finalyze message only for LM_GtkPaint
procedure TGtkMessageQueue.RemoveMessage(ParItem : TGtkMessageQueueItem;ParFinalOnlyInternal : TFinalPaintMessageFlag);
begin
if (ParItem.IsPaintMessage) then begin
fPaintMessages.Remove(ParItem);
ParItem.DestroyMessage(ParFinalOnlyInternal);
end;
Delete(ParItem);
end;
function TGtkMessageQueue.HasPaintMessages:boolean;
begin
result := fPaintMessages.Count > 0;
end;
function TGtkMessageQueue.NumberOfPaintMessages:integer;
begin
result := fPaintMessages.Count;
end;
function TGtkMessageQueue.HasNonPaintMessages:boolean;
begin
result := fPaintMessages.Count count;
end;
procedure TGtkMessageQueue.PopFirstMessage(var ParMsg : TMsg);
var
vlItem : TGtkMessageQueueItem;
begin
vlItem := FirstMessageItem;
ParMsg := vlItem.Msg^;
RemoveMessage(vlItem,FPMF_none);
end;
end.