diff options
Diffstat (limited to 'apps/X11/VCL')
30 files changed, 0 insertions, 8273 deletions
diff --git a/apps/X11/VCL/Makefile b/apps/X11/VCL/Makefile deleted file mode 100644 index 81f7721..0000000 --- a/apps/X11/VCL/Makefile +++ /dev/null @@ -1,4 +0,0 @@ -root := ../../.. - -all: - make -C ${root} diff --git a/apps/X11/VCL/TComponent.cpp b/apps/X11/VCL/TComponent.cpp deleted file mode 100644 index c01f110..0000000 --- a/apps/X11/VCL/TComponent.cpp +++ /dev/null @@ -1,8 +0,0 @@ -#include <TComponent.h> - -TComponent::TComponent(TComponent *AOwner) { -} - - -TComponent::~TComponent() { -} diff --git a/apps/X11/VCL/TComponent.h b/apps/X11/VCL/TComponent.h deleted file mode 100644 index 6981980..0000000 --- a/apps/X11/VCL/TComponent.h +++ /dev/null @@ -1,134 +0,0 @@ -#ifndef TCOMPONENT_H -#define TCOMPONENT_H - -#include <TPersistent.h> -#include <string> - -enum TOperation {opInsert, opRemove}; - -/* - TComponentState = set of (csLoading, csReading, csWriting, csDestroying, - csDesigning, csAncestor, csUpdating, csFixups); - TComponentStyle = set of (csInheritable, csCheckPropAvail); - TGetChildProc = procedure (Child: TComponent) of object; -*/ - -typedef string TComponentName; - -/* - IVCLComObject = interface - ['{E07892A0-F52F-11CF-BD2F-0020AF0E5B81}'] - function GetTypeInfoCount(out Count: Integer): HResult; stdcall; - function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall; - function GetIDsOfNames(const IID: TGUID; Names: Pointer; - NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall; - function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; - Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall; - function SafeCallException(ExceptObject: TObject; - ExceptAddr: Pointer): HResult; - procedure FreeOnRelease; - end; - - IDesignerNotify = interface - ['{B971E807-E3A6-11D1-AAB1-00C04FB16FBC}'] - procedure Modified; - procedure Notification(AnObject: TPersistent; Operation: TOperation); - end; - - TBasicAction = class; - -*/ -class TComponent : public TPersistent { -private: -/* - FOwner: TComponent; - FName: TComponentName; - FTag: Longint; - FComponents: TList; - FFreeNotifies: TList; - FDesignInfo: Longint; - FVCLComObject: Pointer; - FComponentState: TComponentState; - function GetComObject: IUnknown; - function GetComponent(AIndex: Integer): TComponent; - function GetComponentCount: Integer; - function GetComponentIndex: Integer; - procedure Insert(AComponent: TComponent); - procedure ReadLeft(Reader: TReader); - procedure ReadTop(Reader: TReader); - procedure Remove(AComponent: TComponent); - procedure SetComponentIndex(Value: Integer); - procedure SetReference(Enable: Boolean); - procedure WriteLeft(Writer: TWriter); - procedure WriteTop(Writer: TWriter); - protected - FComponentStyle: TComponentStyle; - procedure ChangeName(const NewName: TComponentName); - procedure DefineProperties(Filer: TFiler); override; - procedure GetChildren(Proc: TGetChildProc; Root: TComponent); dynamic; - function GetChildOwner: TComponent; dynamic; - function GetChildParent: TComponent; dynamic; - function GetOwner: TPersistent; override; - procedure Loaded; virtual; - procedure Notification(AComponent: TComponent; - Operation: TOperation); virtual; - procedure ReadState(Reader: TReader); virtual; - procedure SetAncestor(Value: Boolean); - procedure SetDesigning(Value: Boolean); - procedure SetName(const NewName: TComponentName); virtual; - procedure SetChildOrder(Child: TComponent; Order: Integer); dynamic; - procedure SetParentComponent(Value: TComponent); dynamic; - procedure Updating; dynamic; - procedure Updated; dynamic; - class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); virtual; - procedure ValidateRename(AComponent: TComponent; - const CurName, NewName: string); virtual; - procedure ValidateContainer(AComponent: TComponent); dynamic; - procedure ValidateInsert(AComponent: TComponent); dynamic; - procedure WriteState(Writer: TWriter); virtual; - { IUnknown } - function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall; - function _AddRef: Integer; stdcall; - function _Release: Integer; stdcall; - { IDispatch } - function GetTypeInfoCount(out Count: Integer): HResult; stdcall; - function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall; - function GetIDsOfNames(const IID: TGUID; Names: Pointer; - NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall; - function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; - Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall; -*/ -public: - TComponent(TComponent *AOwner); - ~TComponent(); -/* - procedure DestroyComponents; - procedure Destroying; - function ExecuteAction(Action: TBasicAction): Boolean; dynamic; - function FindComponent(const AName: string): TComponent; - procedure FreeNotification(AComponent: TComponent); - procedure FreeOnRelease; - function GetParentComponent: TComponent; dynamic; - function GetNamePath: string; override; - function HasParent: Boolean; dynamic; - procedure InsertComponent(AComponent: TComponent); - procedure RemoveComponent(AComponent: TComponent); - function SafeCallException(ExceptObject: TObject; - ExceptAddr: Pointer): HResult; override; - function UpdateAction(Action: TBasicAction): Boolean; dynamic; - property ComObject: IUnknown read GetComObject; - property Components[Index: Integer]: TComponent read GetComponent; - property ComponentCount: Integer read GetComponentCount; - property ComponentIndex: Integer read GetComponentIndex write SetComponentIndex; - property ComponentState: TComponentState read FComponentState; - property ComponentStyle: TComponentStyle read FComponentStyle; - property DesignInfo: Longint read FDesignInfo write FDesignInfo; - property Owner: TComponent read FOwner; - property VCLComObject: Pointer read FVCLComObject write FVCLComObject; - published - property Name: TComponentName read FName write SetName stored False; - property Tag: Longint read FTag write FTag default 0; -*/ -}; - -#endif diff --git a/apps/X11/VCL/TControl.cpp b/apps/X11/VCL/TControl.cpp deleted file mode 100644 index 3a0ac4d..0000000 --- a/apps/X11/VCL/TControl.cpp +++ /dev/null @@ -1,1874 +0,0 @@ -#include <TControl.h> - -TControl::TControl(TComponent *AOwner) : TComponent(AOwner) { -} - -TControl::~TControl() { -} - - -/* -procedure TControl.Repaint; -var - DC: HDC; -begin - if (Visible or (csDesigning in ComponentState) and - not (csNoDesignVisible in ControlStyle)) and (Parent <> nil) and - Parent.HandleAllocated then - if csOpaque in ControlStyle then - begin - DC := GetDC(Parent.Handle); - try - IntersectClipRect(DC, Left, Top, Left + Width, Top + Height); - Parent.PaintControls(DC, Self); - finally - ReleaseDC(Parent.Handle, DC); - end; - end else - begin - Invalidate; - Update; - end; -end; -*/ -void TControl::Repaint() { -} - - -/* -{ TControl } - -constructor TControl.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FWindowProc := WndProc; - FControlStyle := [csCaptureMouse, csClickEvents, csSetCaption, csDoubleClicks]; - FFont := TFont.Create; - FFont.OnChange := FontChanged; - FAnchors := [akLeft, akTop]; - FConstraints := TSizeConstraints.Create(Self); - FConstraints.OnChange := DoConstraintsChange; - FColor := clWindow; - FVisible := True; - FEnabled := True; - FParentFont := True; - FParentColor := True; - FParentShowHint := True; - FParentBiDiMode := True; - FIsControl := False; - FDragCursor := crDrag; - FFloatingDockSiteClass := TCustomDockForm; -end; - -destructor TControl.Destroy; -begin - Application.ControlDestroyed(Self); - SetParent(nil); - if (FHostDockSite <> nil) and not (csDestroying in FHostDockSite.ComponentState) then - begin - FHostDockSite.Perform(CM_UNDOCKCLIENT, 0, Integer(Self)); - Dock(NullDockSite, BoundsRect); - FHostDockSite := nil; - end; - FActionLink.Free; - FActionLink := nil; - FConstraints.Free; - FFont.Free; - StrDispose(FText); - inherited Destroy; -end; - -function TControl.GetDragImages: TDragImageList; -begin - Result := nil; -end; - -function TControl.GetEnabled: Boolean; -begin - Result := FEnabled; -end; - -function TControl.GetPalette: HPALETTE; -begin - Result := 0; -end; - -function TControl.HasParent: Boolean; -begin - Result := FParent <> nil; -end; - -function TControl.GetParentComponent: TComponent; -begin - Result := Parent; -end; - -procedure TControl.SetParentComponent(Value: TComponent); -begin - if Value is TWinControl then SetParent(TWinControl(Value)); -end; - -function TControl.PaletteChanged(Foreground: Boolean): Boolean; -var - OldPalette, Palette: HPALETTE; - WindowHandle: HWnd; - DC: HDC; -begin - Result := False; - if not Visible then Exit; - Palette := GetPalette; - if Palette <> 0 then - begin - DC := GetDeviceContext(WindowHandle); - OldPalette := SelectPalette(DC, Palette, not Foreground); - if RealizePalette(DC) <> 0 then Invalidate; - SelectPalette(DC, OldPalette, True); - ReleaseDC(WindowHandle, DC); - Result := True; - end; -end; - -function TControl.GetAction: TBasicAction; -begin - if ActionLink <> nil then - Result := ActionLink.Action else - Result := nil; -end; - -procedure TControl.SetAction(Value: TBasicAction); -begin - if Value = nil then - begin - ActionLink.Free; - ActionLink := nil; - Exclude(FControlStyle, csActionClient); - end - else - begin - Include(FControlStyle, csActionClient); - if ActionLink = nil then - ActionLink := GetActionLinkClass.Create(Self); - ActionLink.Action := Value; - ActionLink.OnChange := DoActionChange; - ActionChange(Value, csLoading in Value.ComponentState); - Value.FreeNotification(Self); - end; -end; - -function TControl.IsAnchorsStored: Boolean; -begin - Result := Anchors <> AnchorAlign[Align]; -end; - -procedure TControl.SetDragMode(Value: TDragMode); -begin - FDragMode := Value; -end; - -procedure TControl.RequestAlign; -begin - if Parent <> nil then Parent.AlignControl(Self); -end; - -procedure TControl.Resize; -begin - if Assigned(FOnResize) then FOnResize(Self); -end; - -procedure TControl.ReadState(Reader: TReader); -begin - Include(FControlState, csReadingState); - if Reader.Parent is TWinControl then Parent := TWinControl(Reader.Parent); - inherited ReadState(Reader); - Exclude(FControlState, csReadingState); - if Parent <> nil then - begin - Perform(CM_PARENTCOLORCHANGED, 0, 0); - Perform(CM_PARENTFONTCHANGED, 0, 0); - Perform(CM_PARENTSHOWHINTCHANGED, 0, 0); - Perform(CM_SYSFONTCHANGED, 0, 0); - Perform(CM_PARENTBIDIMODECHANGED, 0, 0); - end; -end; - -procedure TControl.Notification(AComponent: TComponent; - Operation: TOperation); -begin - inherited Notification(AComponent, Operation); - if Operation = opRemove then - if AComponent = PopupMenu then PopupMenu := nil - else if AComponent = Action then Action := nil; -end; - -procedure TControl.SetAlign(Value: TAlign); -var - OldAlign: TAlign; -begin - if FAlign <> Value then - begin - OldAlign := FAlign; - FAlign := Value; - Anchors := AnchorAlign[Value]; - if not (csLoading in ComponentState) and (not (csDesigning in ComponentState) or - (Parent <> nil)) then - if ((OldAlign in [alTop, alBottom]) = (Value in [alRight, alLeft])) and - not (OldAlign in [alNone, alClient]) and not (Value in [alNone, alClient]) then - SetBounds(Left, Top, Height, Width) - else - AdjustSize; - end; - RequestAlign; -end; - -procedure TControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); -begin - if CheckNewSize(AWidth, AHeight) and - ((ALeft <> FLeft) or (ATop <> FTop) or - (AWidth <> FWidth) or (AHeight <> FHeight)) then - begin - InvalidateControl(Visible, False); - UpdateLastResize(AWidth, AHeight); - FLeft := ALeft; - FTop := ATop; - FWidth := AWidth; - FHeight := AHeight; - Invalidate; - Perform(WM_WINDOWPOSCHANGED, 0, 0); - RequestAlign; - if not (csLoading in ComponentState) then Resize; - end; -end; - -procedure TControl.SetLeft(Value: Integer); -begin - SetBounds(Value, FTop, FWidth, FHeight); - Include(FScalingFlags, sfLeft); -end; - -procedure TControl.SetTop(Value: Integer); -begin - SetBounds(FLeft, Value, FWidth, FHeight); - Include(FScalingFlags, sfTop); -end; - -procedure TControl.SetWidth(Value: Integer); -begin - SetBounds(FLeft, FTop, Value, FHeight); - Include(FScalingFlags, sfWidth); -end; - -procedure TControl.SetHeight(Value: Integer); -begin - SetBounds(FLeft, FTop, FWidth, Value); - Include(FScalingFlags, sfHeight); -end; - -procedure TControl.Dock(NewDockSite: TWinControl; ARect: TRect); -var - PrevDockSite: TWinControl; -begin - if HostDockSite <> NewDockSite then - begin - if (FHostDockSite <> nil) and (FHostDockSite.FDockClients <> nil) then - FHostDockSite.FDockClients.Remove(Self); - if (NewDockSite <> nil) and (NewDockSite <> NullDockSite) and - (NewDockSite.FDockClients <> nil) then - NewDockSite.FDockClients.Add(Self); - end; - Include(FControlState, csDocking); - try - if NewDockSite <> NullDockSite then - DoDock(NewDockSite, ARect); - if FHostDockSite <> NewDockSite then - begin - PrevDockSite := FHostDockSite; - if NewDockSite <> NullDockSite then - begin - FHostDockSite := NewDockSite; - if NewDockSite <> nil then NewDockSite.DoAddDockClient(Self, ARect); - end - else - FHostDockSite := nil; - if PrevDockSite <> nil then PrevDockSite.DoRemoveDockClient(Self); - end; - finally - Exclude(FControlState, csDocking); - end; -end; - -procedure TControl.DoDock(NewDockSite: TWinControl; var ARect: TRect); -begin - { Erase TControls before UpdateboundsRect modifies position } - if not (Self is TWinControl) then InvalidateControl(Visible, False); - if Parent <> NewDockSite then - UpdateBoundsRect(ARect) else - BoundsRect := ARect; - if (NewDockSite = nil) or (NewDockSite = NullDockSite) then Parent := nil; -end; - -procedure TControl.SetHostDockSite(Value: TWinControl); -begin - Dock(Value, BoundsRect); -end; - -function TControl.GetBoundsRect: TRect; -begin - Result.Left := Left; - Result.Top := Top; - Result.Right := Left + Width; - Result.Bottom := Top + Height; -end; - -procedure TControl.SetBoundsRect(const Rect: TRect); -begin - with Rect do SetBounds(Left, Top, Right - Left, Bottom - Top); -end; - -function TControl.GetClientRect: TRect; -begin - Result.Left := 0; - Result.Top := 0; - Result.Right := Width; - Result.Bottom := Height; -end; - -function TControl.GetClientWidth: Integer; -begin - Result := ClientRect.Right; -end; - -procedure TControl.SetClientWidth(Value: Integer); -begin - SetClientSize(Point(Value, ClientHeight)); -end; - -function TControl.GetClientHeight: Integer; -begin - Result := ClientRect.Bottom; -end; - -procedure TControl.SetClientHeight(Value: Integer); -begin - SetClientSize(Point(ClientWidth, Value)); -end; - -function TControl.GetClientOrigin: TPoint; -begin - if Parent = nil then - raise EInvalidOperation.CreateFmt(SParentRequired, [Name]); - Result := Parent.ClientOrigin; - Inc(Result.X, FLeft); - Inc(Result.Y, FTop); -end; - -function TControl.ClientToScreen(const Point: TPoint): TPoint; -var - Origin: TPoint; -begin - Origin := ClientOrigin; - Result.X := Point.X + Origin.X; - Result.Y := Point.Y + Origin.Y; -end; - -function TControl.ScreenToClient(const Point: TPoint): TPoint; -var - Origin: TPoint; -begin - Origin := ClientOrigin; - Result.X := Point.X - Origin.X; - Result.Y := Point.Y - Origin.Y; -end; - -procedure TControl.SendCancelMode(Sender: TControl); -var - Control: TControl; -begin - Control := Self; - while Control <> nil do - begin - if Control is TCustomForm then - TCustomForm(Control).SendCancelMode(Sender); - Control := Control.Parent; - end; -end; - -procedure TControl.SendDockNotification(Msg: Cardinal; WParam, LParam: Integer); -var - NotifyRec: TDockNotifyRec; -begin - if (FHostDockSite <> nil) and (DragObject = nil) and - (ComponentState * [csLoading, csDestroying] = []) then - begin - with NotifyRec do - begin - ClientMsg := Msg; - MsgWParam := WParam; - MsgLParam := LParam; - end; - FHostDockSite.Perform(CM_DOCKNOTIFICATION, Integer(Self), Integer(@NotifyRec)); - end; -end; - -procedure TControl.Changed; -begin - Perform(CM_CHANGED, 0, Longint(Self)); -end; - -procedure TControl.ChangeScale(M, D: Integer); -var - X, Y, W, H: Integer; - Flags: TScalingFlags; -begin - if M <> D then - begin - if csLoading in ComponentState then - Flags := ScalingFlags else - Flags := [sfLeft, sfTop, sfWidth, sfHeight, sfFont]; - if sfLeft in Flags then - X := MulDiv(FLeft, M, D) else - X := FLeft; - if sfTop in Flags then - Y := MulDiv(FTop, M, D) else - Y := FTop; - if (sfWidth in Flags) and not (csFixedWidth in ControlStyle) then - if sfLeft in Flags then - W := MulDiv(FLeft + FWidth, M, D) - X else - W := MulDiv(FWidth, M, D) - else W := FWidth; - if (sfHeight in Flags) and not (csFixedHeight in ControlStyle) then - if sfHeight in Flags then - H := MulDiv(FTop + FHeight, M, D) - Y else - H := MulDiv(FTop, M, D ) - else H := FHeight; - SetBounds(X, Y, W, H); - if not ParentFont and (sfFont in Flags) then - Font.Size := MulDiv(Font.Size, M, D); - end; - FScalingFlags := []; -end; - -procedure TControl.SetAutoSize(Value: Boolean); -begin - if FAutoSize <> Value then - begin - FAutoSize := Value; - if Value then AdjustSize; - end; -end; - -procedure TControl.SetName(const Value: TComponentName); -var - ChangeText: Boolean; -begin - ChangeText := (csSetCaption in ControlStyle) and (Name = Text) and - ((Owner = nil) or not (Owner is TControl) or - not (csLoading in TControl(Owner).ComponentState)); - inherited SetName(Value); - if ChangeText then Text := Value; -end; - -procedure TControl.SetClientSize(Value: TPoint); -var - Client: TRect; -begin - Client := GetClientRect; - SetBounds(FLeft, FTop, Width - Client.Right + Value.X, Height - - Client.Bottom + Value.Y); -end; - -procedure TControl.SetParent(AParent: TWinControl); -begin - if FParent <> AParent then - begin - if Parent = Self then - raise EInvalidOperation.Create(SControlParentSetToSelf); - if FParent <> nil then FParent.RemoveControl(Self); - if AParent <> nil then AParent.InsertControl(Self); - end; -end; - -procedure TControl.SetVisible(Value: Boolean); -begin - if FVisible <> Value then - begin - VisibleChanging; - FVisible := Value; - Perform(CM_VISIBLECHANGED, Ord(Value), 0); - RequestAlign; - end; -end; - -procedure TControl.SetEnabled(Value: Boolean); -begin - if FEnabled <> Value then - begin - FEnabled := Value; - Perform(CM_ENABLEDCHANGED, 0, 0); - end; -end; - -function TControl.GetTextLen: Integer; -begin - Result := Perform(WM_GETTEXTLENGTH, 0, 0); -end; - -function TControl.GetTextBuf(Buffer: PChar; BufSize: Integer): Integer; -begin - Result := Perform(WM_GETTEXT, BufSize, Longint(Buffer)); -end; - -function TControl.GetUndockHeight: Integer; -begin - if FUndockHeight > 0 then Result := FUndockHeight - else Result := Height; -end; - -function TControl.GetUndockWidth: Integer; -begin - if FUndockWidth > 0 then Result := FUndockWidth - else Result := Width; -end; - -function TControl.GetTBDockHeight: Integer; -begin - if FTBDockHeight > 0 then Result := FTBDockHeight - else Result := UndockHeight; -end; - -function TControl.GetLRDockWidth: Integer; -begin - if FLRDockWidth > 0 then Result := FLRDockWidth - else Result := UndockWidth; -end; - -procedure TControl.SetPopupMenu(Value: TPopupMenu); -begin - FPopupMenu := Value; - if Value <> nil then - begin - Value.ParentBiDiModeChanged(Self); - Value.FreeNotification(Self); - end; -end; - -procedure TControl.SetTextBuf(Buffer: PChar); -begin - Perform(WM_SETTEXT, 0, Longint(Buffer)); - Perform(CM_TEXTCHANGED, 0, 0); -end; - -function TControl.GetText: TCaption; -var - Len: Integer; -begin - Len := GetTextLen; - SetString(Result, PChar(nil), Len); - if Len <> 0 then GetTextBuf(Pointer(Result), Len + 1); -end; - -procedure TControl.SetText(const Value: TCaption); -begin - if GetText <> Value then SetTextBuf(PChar(Value)); -end; - -procedure TControl.SetBiDiMode(Value: TBiDiMode); -begin - if FBiDiMode <> Value then - begin - FBiDiMode := Value; - FParentBiDiMode := False; - Perform(CM_BIDIMODECHANGED, 0, 0); - end; -end; - -procedure TControl.FontChanged(Sender: TObject); -begin - FParentFont := False; - FDesktopFont := False; - if Font.Height <> FFontHeight then - begin - Include(FScalingFlags, sfFont); - FFontHeight := Font.Height; - end; - Perform(CM_FONTCHANGED, 0, 0); -end; - -procedure TControl.SetFont(Value: TFont); -begin - FFont.Assign(Value); -end; - -function TControl.IsFontStored: Boolean; -begin - Result := not ParentFont and not DesktopFont; -end; - -function TControl.IsShowHintStored: Boolean; -begin - Result := not ParentShowHint; -end; - -function TControl.IsBiDiModeStored: Boolean; -begin - Result := not ParentBiDiMode; -end; - -procedure TControl.SetParentFont(Value: Boolean); -begin - if FParentFont <> Value then - begin - FParentFont := Value; - if FParent <> nil then Perform(CM_PARENTFONTCHANGED, 0, 0); - end; -end; - -procedure TControl.SetDesktopFont(Value: Boolean); -begin - if FDesktopFont <> Value then - begin - FDesktopFont := Value; - Perform(CM_SYSFONTCHANGED, 0, 0); - end; -end; - -procedure TControl.SetShowHint(Value: Boolean); -begin - if FShowHint <> Value then - begin - FShowHint := Value; - FParentShowHint := False; - Perform(CM_SHOWHINTCHANGED, 0, 0); - end; -end; - -procedure TControl.SetParentShowHint(Value: Boolean); -begin - if FParentShowHint <> Value then - begin - FParentShowHint := Value; - if FParent <> nil then Perform(CM_PARENTSHOWHINTCHANGED, 0, 0); - end; -end; - -procedure TControl.SetColor(Value: TColor); -begin - if FColor <> Value then - begin - FColor := Value; - FParentColor := False; - Perform(CM_COLORCHANGED, 0, 0); - end; -end; - -function TControl.IsColorStored: Boolean; -begin - Result := not ParentColor; -end; - -procedure TControl.SetParentColor(Value: Boolean); -begin - if FParentColor <> Value then - begin - FParentColor := Value; - if FParent <> nil then Perform(CM_PARENTCOLORCHANGED, 0, 0); - end; -end; - -procedure TControl.SetParentBiDiMode(Value: Boolean); -begin - if FParentBiDiMode <> Value then - begin - FParentBiDiMode := Value; - if FParent <> nil then Perform(CM_PARENTBIDIMODECHANGED, 0, 0); - end; -end; - -procedure TControl.SetCursor(Value: TCursor); -begin - if FCursor <> Value then - begin - FCursor := Value; - Perform(CM_CURSORCHANGED, 0, 0); - end; -end; - -function TControl.GetMouseCapture: Boolean; -begin - Result := GetCaptureControl = Self; -end; - -procedure TControl.SetMouseCapture(Value: Boolean); -begin - if MouseCapture <> Value then - if Value then SetCaptureControl(Self) else SetCaptureControl(nil); -end; - -procedure TControl.BringToFront; -begin - SetZOrder(True); -end; - -procedure TControl.SendToBack; -begin - SetZOrder(False); -end; - -procedure TControl.SetZOrderPosition(Position: Integer); -var - I, Count: Integer; - ParentForm: TCustomForm; -begin - if FParent <> nil then - begin - I := FParent.FControls.IndexOf(Self); - if I >= 0 then - begin - Count := FParent.FControls.Count; - if Position < 0 then Position := 0; - if Position >= Count then Position := Count - 1; - if Position <> I then - begin - FParent.FControls.Delete(I); - FParent.FControls.Insert(Position, Self); - InvalidateControl(Visible, True); - ParentForm := ValidParentForm(Self); - if csPalette in ParentForm.ControlState then - TControl(ParentForm).PaletteChanged(True); - end; - end; - end; -end; - -procedure TControl.SetZOrder(TopMost: Boolean); -begin - if FParent <> nil then - if TopMost then - SetZOrderPosition(FParent.FControls.Count - 1) else - SetZOrderPosition(0); -end; - -function TControl.GetDeviceContext(var WindowHandle: HWnd): HDC; -begin - if Parent = nil then - raise EInvalidOperation.CreateFmt(SParentRequired, [Name]); - Result := Parent.GetDeviceContext(WindowHandle); - SetViewportOrgEx(Result, Left, Top, nil); - IntersectClipRect(Result, 0, 0, Width, Height); -end; - -procedure TControl.InvalidateControl(IsVisible, IsOpaque: Boolean); -var - Rect: TRect; - - function BackgroundClipped: Boolean; - var - R: TRect; - List: TList; - I: Integer; - C: TControl; - begin - Result := True; - List := FParent.FControls; - I := List.IndexOf(Self); - while I > 0 do - begin - Dec(I); - C := List[I]; - with C do - if C.Visible and (csOpaque in ControlStyle) then - begin - IntersectRect(R, Rect, BoundsRect); - if EqualRect(R, Rect) then Exit; - end; - end; - Result := False; - end; - -begin - if (IsVisible or (csDesigning in ComponentState) and - not (csNoDesignVisible in ControlStyle)) and (Parent <> nil) and - Parent.HandleAllocated then - begin - Rect := BoundsRect; - InvalidateRect(Parent.Handle, @Rect, not (IsOpaque or - (csOpaque in Parent.ControlStyle) or BackgroundClipped)); - end; -end; - -procedure TControl.Invalidate; -begin - InvalidateControl(Visible, csOpaque in ControlStyle); -end; - -procedure TControl.Hide; -begin - Visible := False; -end; - -procedure TControl.Show; -begin - if Parent <> nil then Parent.ShowControl(Self); - if not (csDesigning in ComponentState) or - (csNoDesignVisible in ControlStyle) then Visible := True; -end; - -procedure TControl.Update; -begin - if Parent <> nil then Parent.Update; -end; - -procedure TControl.Refresh; -begin - Repaint; -end; - -function TControl.GetControlsAlignment: TAlignment; -begin - Result := taLeftJustify; -end; - -function TControl.IsRightToLeft: Boolean; -begin - Result := SysLocale.MiddleEast and (BiDiMode <> bdLeftToRight); -end; - -function TControl.UseRightToLeftReading: Boolean; -begin - Result := SysLocale.MiddleEast and (BiDiMode <> bdLeftToRight); -end; - -function TControl.UseRightToLeftAlignment: Boolean; -begin - Result := SysLocale.MiddleEast and (BiDiMode = bdRightToLeft); -end; - -function TControl.UseRightToLeftScrollBar: Boolean; -begin - Result := SysLocale.MiddleEast and - (BiDiMode in [bdRightToLeft, bdRightToLeftNoAlign]); -end; - -procedure TControl.BeginAutoDrag; -begin - BeginDrag(Mouse.DragImmediate, Mouse.DragThreshold); -end; - -procedure TControl.BeginDrag(Immediate: Boolean; Threshold: Integer); -var - P: TPoint; -begin - if (Self is TCustomForm) and (FDragKind <> dkDock) then - raise EInvalidOperation.Create(SCannotDragForm); - CalcDockSizes; - if (DragControl = nil) or (DragControl = Pointer($FFFFFFFF)) then - begin - DragControl := nil; - if csLButtonDown in ControlState then - begin - GetCursorPos(P); - P := ScreenToClient(P); - Perform(WM_LBUTTONUP, 0, Longint(PointToSmallPoint(P))); - end; - { Use default value when Threshold < 0 } - if Threshold < 0 then - Threshold := Mouse.DragThreshold; - // prevent calling EndDrag within BeginDrag - if DragControl <> Pointer($FFFFFFFF) then - DragInitControl(Self, Immediate, Threshold); - end; -end; - -procedure TControl.EndDrag(Drop: Boolean); -begin - if Dragging then DragDone(Drop) - // prevent calling EndDrag within BeginDrag - else if DragControl = nil then DragControl := Pointer($FFFFFFFF); -end; - -procedure TControl.DragCanceled; -begin -end; - -function TControl.Dragging: Boolean; -begin - Result := DragControl = Self; -end; - -procedure TControl.DragOver(Source: TObject; X, Y: Integer; - State: TDragState; var Accept: Boolean); -begin - Accept := False; - if Assigned(FOnDragOver) then - begin - Accept := True; - FOnDragOver(Self, Source, X, Y, State, Accept); - end; -end; - -procedure TControl.DragDrop(Source: TObject; X, Y: Integer); -begin - if Assigned(FOnDragDrop) then FOnDragDrop(Self, Source, X, Y); -end; - -procedure TControl.DoStartDrag(var DragObject: TDragObject); -begin - if Assigned(FOnStartDrag) then FOnStartDrag(Self, DragObject); -end; - -procedure TControl.DoEndDrag(Target: TObject; X, Y: Integer); -begin - if Assigned(FOnEndDrag) then FOnEndDrag(Self, Target, X, Y); -end; - -procedure TControl.PositionDockRect(DragDockObject: TDragDockObject); -var - NewWidth, NewHeight: Integer; - TempX, TempY: Double; -begin - with DragDockObject do - begin - if (DragTarget = nil) or (not TWinControl(DragTarget).UseDockManager) then - begin - NewWidth := Control.UndockWidth; - NewHeight := Control.UndockHeight; - // Drag position for dock rect is scaled relative to control's click point. - TempX := DragPos.X - ((NewWidth) * FMouseDeltaX); - TempY := DragPos.Y - ((NewHeight) * FMouseDeltaY); - with FDockRect do - begin - Left := Round(TempX); - Top := Round(TempY); - Right := Left + NewWidth; - Bottom := Top + NewHeight; - end; - { Allow DragDockObject final say on this new dock rect } - AdjustDockRect(FDockRect); - end - else begin - GetWindowRect(TWinControl(DragTarget).Handle, FDockRect); - if TWinControl(DragTarget).UseDockManager and - (TWinControl(DragTarget).DockManager <> nil) then - TWinControl(DragTarget).DockManager.PositionDockRect(Control, - DropOnControl, DropAlign, FDockRect); - end; - end; -end; - -procedure TControl.DockTrackNoTarget(Source: TDragDockObject; X, Y: Integer); -begin - PositionDockRect(Source); -end; - -procedure TControl.DoEndDock(Target: TObject; X, Y: Integer); -begin - if Assigned(FOnEndDock) then FOnEndDock(Self, Target, X, Y); -end; - -procedure TControl.DoStartDock(var DragObject: TDragObject); -begin - if Assigned(FOnStartDock) then FOnStartDock(Self, TDragDockObject(DragObject)); -end; - -procedure TControl.DefaultDockImage(DragDockObject: TDragDockObject; - Erase: Boolean); -var - DesktopWindow: HWND; - DC: HDC; - OldBrush: HBrush; - DrawRect: TRect; - PenSize: Integer; -begin - with DragDockObject do - begin - PenSize := FrameWidth; - if Erase then DrawRect := FEraseDockRect - else DrawRect := FDockRect; - end; - DesktopWindow := GetDesktopWindow; - DC := GetDCEx(DesktopWindow, 0, DCX_CACHE or DCX_LOCKWINDOWUPDATE); - try - OldBrush := SelectObject(DC, DragDockObject.Brush.Handle); - with DrawRect do - begin - PatBlt(DC, Left + PenSize, Top, Right - Left - PenSize, PenSize, PATINVERT); - PatBlt(DC, Right - PenSize, Top + PenSize, PenSize, Bottom - Top - PenSize, PATINVERT); - PatBlt(DC, Left, Bottom - PenSize, Right - Left - PenSize, PenSize, PATINVERT); - PatBlt(DC, Left, Top, PenSize, Bottom - Top - PenSize, PATINVERT); - end; - SelectObject(DC, OldBrush); - finally - ReleaseDC(DesktopWindow, DC); - end; -end; - -procedure TControl.DrawDragDockImage(DragDockObject: TDragDockObject); -begin - DefaultDockImage(DragDockObject, False); -end; - -procedure TControl.EraseDragDockImage(DragDockObject: TDragDockObject); -begin - DefaultDockImage(DragDockObject, True); -end; - -procedure TControl.DoDragMsg(var DragMsg: TCMDrag); -var - S: TObject; - Accepts, IsDockOp: Boolean; -begin - with DragMsg, DragRec^ do - begin - S := Source; - IsDockOp := S is TDragDockObject; - if DragFreeObject and not IsDockOp then - S := (S as TDragControlObject).Control; - with ScreenToClient(Pos) do - case DragMessage of - dmDragEnter, dmDragLeave, dmDragMove: - begin - Accepts := True; - if IsDockOp then - begin - TWinControl(Target).DockOver(TDragDockObject(S), X, Y, - TDragState(DragMessage), Accepts) - end - else - DragOver(S, X, Y, TDragState(DragMessage), Accepts); - Result := Ord(Accepts); - end; - dmDragDrop: - begin - if IsDockOp then TWinControl(Target).DockDrop(TDragDockObject(S), X, Y) - else DragDrop(S, X, Y); - end; - end; - end; -end; - -function TControl.ManualDock(NewDockSite: TWinControl; DropControl: TControl; - ControlSide: TAlign): Boolean; -var - R: TRect; - DockObject: TDragDockObject; - HostDockSiteHandle: THandle; -begin - if (NewDockSite = nil) or (NewDockSite = NullDockSite) then - begin - if (HostDockSite <> nil) and HostDockSite.UseDockManager and - (HostDockSite.DockManager <> nil) then - begin - HostDockSite.DockManager.GetControlBounds(Self, R); - MapWindowPoints(HostDockSite.Handle, 0, R.TopLeft, 2); - end - else begin - R.TopLeft := Point(Left, Top); - if Parent <> nil then R.TopLeft := Parent.ClientToScreen(R.TopLeft); - end; - R := Bounds(R.Left, R.Top, UndockWidth, UndockHeight); - Result := ManualFloat(R); - end - else - begin - CalcDockSizes; - Result := (HostDockSite = nil) or HostDockSite.DoUndock(NewDockSite, Self); - if Result then - begin - DockObject := TDragDockObject.Create(Self); - try - if HostDockSite <> nil then - HostDockSiteHandle := HostDockSite.Handle else - HostDockSiteHandle := 0; - R := BoundsRect; - if HostDockSiteHandle <> 0 then - MapWindowPoints(HostDockSiteHandle, 0, R, 2); - with DockObject do - begin - FDragTarget := NewDockSite; - FDropAlign := ControlSide; - FDropOnControl := DropControl; - DockRect := R; - end; - MapWindowPoints(0, NewDockSite.Handle, R.TopLeft, 1); - NewDockSite.DockDrop(DockObject, R.Left, R.Top); - finally - DockObject.Free; - end; - end; - end; -end; - -function TControl.ManualFloat(ScreenPos: TRect): Boolean; -var - FloatHost: TWinControl; -begin - Result := (HostDockSite = nil) or HostDockSite.DoUndock(nil, Self); - if Result then - begin - FloatHost := CreateFloatingDockSite(ScreenPos); - if FloatHost <> nil then - Dock(FloatHost, Rect(0, 0, FloatHost.ClientWidth, FloatHost.ClientHeight)) - else - Dock(FloatHost, ScreenPos); - end; -end; - -function TControl.ReplaceDockedControl(Control: TControl; - NewDockSite: TWinControl; DropControl: TControl; ControlSide: TAlign): Boolean; -var - OldDockSite: TWinControl; -begin - Result := False; - if (Control.HostDockSite = nil) or ((Control.HostDockSite.UseDockManager) and - (Control.HostDockSite.DockManager <> nil)) then - begin - OldDockSite := Control.HostDockSite; - if OldDockSite <> nil then - OldDockSite.DockManager.SetReplacingControl(Control); - try - ManualDock(OldDockSite, nil, alTop); - finally - if OldDockSite <> nil then - OldDockSite.DockManager.SetReplacingControl(nil); - end; - if Control.ManualDock(NewDockSite, DropControl, ControlSide) then - Result := True; - end; -end; - -procedure TControl.DoConstraintsChange(Sender: TObject); -begin - AdjustSize; -end; - -function TControl.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; -begin - Result := True; -end; - -function TControl.CanResize(var NewWidth, NewHeight: Integer): Boolean; -begin - Result := True; - if Assigned(FOnCanResize) then FOnCanResize(Self, NewWidth, NewHeight, Result); -end; - -function TControl.DoCanAutoSize(var NewWidth, NewHeight: Integer): Boolean; -var - W, H: Integer; -begin - if Align <> alClient then - begin - W := NewWidth; - H := NewHeight; - Result := CanAutoSize(W, H); - if Align in [alNone, alLeft, alRight] then - NewWidth := W; - if Align in [alNone, alTop, alBottom] then - NewHeight := H; - end - else Result := True; -end; - -function TControl.DoCanResize(var NewWidth, NewHeight: Integer): Boolean; -begin - Result := CanResize(NewWidth, NewHeight); - if Result then DoConstrainedResize(NewWidth, NewHeight); -end; - -procedure TControl.ConstrainedResize(var MinWidth, MinHeight, MaxWidth, - MaxHeight: Integer); -begin - if Assigned(FOnConstrainedResize) then FOnConstrainedResize(Self, MinWidth, - MinHeight, MaxWidth, MaxHeight); -end; - -procedure TControl.DoConstrainedResize(var NewWidth, NewHeight: Integer); -var - MinWidth, MinHeight, MaxWidth, MaxHeight: Integer; -begin - if Constraints.MinWidth > 0 then - MinWidth := Constraints.MinWidth - else - MinWidth := 0; - if Constraints.MinHeight > 0 then - MinHeight := Constraints.MinHeight - else - MinHeight := 0; - if Constraints.MaxWidth > 0 then - MaxWidth := Constraints.MaxWidth - else - MaxWidth := 0; - if Constraints.MaxHeight > 0 then - MaxHeight := Constraints.MaxHeight - else - MaxHeight := 0; - { Allow override of constraints } - ConstrainedResize(MinWidth, MinHeight, MaxWidth, MaxHeight); - if (MaxWidth > 0) and (NewWidth > MaxWidth) then - NewWidth := MaxWidth - else if (MinWidth > 0) and (NewWidth < MinWidth) then - NewWidth := MinWidth; - if (MaxHeight > 0) and (NewHeight > MaxHeight) then - NewHeight := MaxHeight - else if (MinHeight > 0) and (NewHeight < MinHeight) then - NewHeight := MinHeight; -end; - -function TControl.Perform(Msg: Cardinal; WParam, LParam: Longint): Longint; -var - Message: TMessage; -begin - Message.Msg := Msg; - Message.WParam := WParam; - Message.LParam := LParam; - Message.Result := 0; - if Self <> nil then WindowProc(Message); - Result := Message.Result; -end; - -procedure TControl.CalcDockSizes; -begin - if Floating then - begin - UndockHeight := Height; - UndockWidth := Width; - end - else if HostDockSite <> nil then - begin - if (DockOrientation = doVertical) or - (HostDockSite.Align in [alTop, alBottom]) then - TBDockHeight := Height - else if (DockOrientation = doHorizontal) or - (HostDockSite.Align in [alLeft, alRight]) then - LRDockWidth := Width; - end; -end; - -procedure TControl.UpdateBoundsRect(const R: TRect); -begin - UpdateLastResize(R.Right - R.Left, R.Bottom - R.Top); - FLeft := R.Left; - FTop := R.Top; - FWidth := R.Right - R.Left; - FHeight := R.Bottom - R.Top; -end; - -procedure TControl.VisibleChanging; -begin -end; - -procedure TControl.WndProc(var Message: TMessage); -var - Form: TCustomForm; -begin - if (csDesigning in ComponentState) then - begin - Form := GetParentForm(Self); - if (Form <> nil) and (Form.Designer <> nil) and - Form.Designer.IsDesignMsg(Self, Message) then Exit; - end - else if (Message.Msg >= WM_KEYFIRST) and (Message.Msg <= WM_KEYLAST) then - begin - Form := GetParentForm(Self); - if (Form <> nil) and Form.WantChildKey(Self, Message) then Exit; - end - else if (Message.Msg >= WM_MOUSEFIRST) and (Message.Msg <= WM_MOUSELAST) then - begin - if not (csDoubleClicks in ControlStyle) then - case Message.Msg of - WM_LBUTTONDBLCLK, WM_RBUTTONDBLCLK, WM_MBUTTONDBLCLK: - Dec(Message.Msg, WM_LBUTTONDBLCLK - WM_LBUTTONDOWN); - end; - case Message.Msg of - WM_MOUSEMOVE: Application.HintMouseMessage(Self, Message); - WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: - begin - if FDragMode = dmAutomatic then - begin - BeginAutoDrag; - Exit; - end; - Include(FControlState, csLButtonDown); - end; - WM_LBUTTONUP: - Exclude(FControlState, csLButtonDown); - end; - end - else if Message.Msg = CM_VISIBLECHANGED then - with Message do - SendDockNotification(Msg, WParam, LParam); - Dispatch(Message); -end; - -procedure TControl.DefaultHandler(var Message); -var - P: PChar; -begin - with TMessage(Message) do - case Msg of - WM_GETTEXT: - begin - if FText <> nil then P := FText else P := ''; - Result := StrLen(StrLCopy(PChar(LParam), P, WParam - 1)); - end; - WM_GETTEXTLENGTH: - if FText = nil then Result := 0 else Result := StrLen(FText); - WM_SETTEXT: - begin - P := StrNew(PChar(LParam)); - StrDispose(FText); - FText := P; - SendDockNotification(Msg, WParam, LParam); - end; - end; -end; - -procedure TControl.ReadIsControl(Reader: TReader); -begin - FIsControl := Reader.ReadBoolean; -end; - -procedure TControl.WriteIsControl(Writer: TWriter); -begin - Writer.WriteBoolean(FIsControl); -end; - -procedure TControl.DefineProperties(Filer: TFiler); - - function DoWrite: Boolean; - begin - if Filer.Ancestor <> nil then - Result := TControl(Filer.Ancestor).IsControl <> IsControl else - Result := IsControl; - end; - -begin - { The call to inherited DefinedProperties is omitted since the Left and - Top special properties are redefined with real properties } - Filer.DefineProperty('IsControl', ReadIsControl, WriteIsControl, DoWrite); -end; - -procedure TControl.Click; -begin - { Call OnClick if assigned and not equal to associated action's OnExecute. - If associated action's OnExecute assigned then call it, otherwise, call - OnClick. } - if Assigned(FOnClick) and (Action <> nil) and (@FOnClick <> @Action.OnExecute) then - FOnClick(Self) - else if not (csDesigning in ComponentState) and (ActionLink <> nil) then - ActionLink.Execute - else if Assigned(FOnClick) then - FOnClick(Self); -end; - -procedure TControl.DblClick; -begin - if Assigned(FOnDblClick) then FOnDblClick(Self); -end; - -procedure TControl.MouseDown(Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); -begin - if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, X, Y); -end; - -procedure TControl.DoMouseDown(var Message: TWMMouse; Button: TMouseButton; - Shift: TShiftState); -begin - if not (csNoStdEvents in ControlStyle) then - with Message do - MouseDown(Button, KeysToShiftState(Keys) + Shift, XPos, YPos); -end; - -procedure TControl.WMLButtonDown(var Message: TWMLButtonDown); -begin - SendCancelMode(Self); - inherited; - if csCaptureMouse in ControlStyle then MouseCapture := True; - if csClickEvents in ControlStyle then Include(FControlState, csClicked); - DoMouseDown(Message, mbLeft, []); -end; - -procedure TControl.WMNCLButtonDown(var Message: TWMNCLButtonDown); -begin - SendCancelMode(Self); - inherited; -end; - -procedure TControl.WMLButtonDblClk(var Message: TWMLButtonDblClk); -begin - SendCancelMode(Self); - inherited; - if csCaptureMouse in ControlStyle then MouseCapture := True; - if csClickEvents in ControlStyle then DblClick; - DoMouseDown(Message, mbLeft, [ssDouble]); -end; - -function TControl.GetPopupMenu: TPopupMenu; -begin - Result := FPopupMenu; -end; - -procedure TControl.CheckMenuPopup(const Pos: TSmallPoint); -var - Control: TControl; - PopupMenu: TPopupMenu; -begin - if csDesigning in ComponentState then Exit; - Control := Self; - while Control <> nil do - begin - PopupMenu := Control.GetPopupMenu; - if (PopupMenu <> nil) then - begin - if not PopupMenu.AutoPopup then Exit; - SendCancelMode(nil); - PopupMenu.PopupComponent := Control; - with ClientToScreen(SmallPointToPoint(Pos)) do - PopupMenu.Popup(X, Y); - Exit; - end; - Control := Control.Parent; - end; -end; - -function TControl.CheckNewSize(var NewWidth, NewHeight: Integer): Boolean; -var - W, H, W2, H2: Integer; -begin - Result := False; - W := NewWidth; - H := NewHeight; - if DoCanResize(W, H) then - begin - W2 := W; - H2 := H; - Result := not AutoSize or (DoCanAutoSize(W2, H2) and (W2 = W) and (H2 = H)) or - DoCanResize(W2, H2); - if Result then - begin - NewWidth := W2; - NewHeight := H2; - end; - end; -end; - -procedure TControl.WMRButtonDown(var Message: TWMRButtonDown); -begin - inherited; - DoMouseDown(Message, mbRight, []); -end; - -procedure TControl.WMRButtonDblClk(var Message: TWMRButtonDblClk); -begin - inherited; - DoMouseDown(Message, mbRight, [ssDouble]); -end; - -procedure TControl.WMMButtonDown(var Message: TWMMButtonDown); -begin - inherited; - DoMouseDown(Message, mbMiddle, []); -end; - -procedure TControl.WMMButtonDblClk(var Message: TWMMButtonDblClk); -begin - inherited; - DoMouseDown(Message, mbMiddle, [ssDouble]); -end; - -procedure TControl.MouseMove(Shift: TShiftState; X, Y: Integer); -begin - if Assigned(FOnMouseMove) then FOnMouseMove(Self, Shift, X, Y); -end; - -procedure TControl.WMMouseMove(var Message: TWMMouseMove); -begin - inherited; - if not (csNoStdEvents in ControlStyle) then - with Message do MouseMove(KeysToShiftState(Keys), XPos, YPos); -end; - -procedure TControl.MouseUp(Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); -begin - if Assigned(FOnMouseUp) then FOnMouseUp(Self, Button, Shift, X, Y); -end; - -procedure TControl.DoMouseUp(var Message: TWMMouse; Button: TMouseButton); -begin - if not (csNoStdEvents in ControlStyle) then - with Message do MouseUp(Button, KeysToShiftState(Keys), XPos, YPos); -end; - -procedure TControl.WMLButtonUp(var Message: TWMLButtonUp); -begin - inherited; - if csCaptureMouse in ControlStyle then MouseCapture := False; - if csClicked in ControlState then - begin - Exclude(FControlState, csClicked); - if PtInRect(ClientRect, SmallPointToPoint(Message.Pos)) then Click; - end; - DoMouseUp(Message, mbLeft); -end; - -procedure TControl.WMRButtonUp(var Message: TWMRButtonUp); -begin - inherited; - DoMouseUp(Message, mbRight); - if Message.Result = 0 then CheckMenuPopup(Message.Pos); -end; - -procedure TControl.WMMButtonUp(var Message: TWMMButtonUp); -begin - inherited; - DoMouseUp(Message, mbMiddle); -end; - -procedure TControl.WMCancelMode(var Message: TWMCancelMode); -begin - inherited; - if MouseCapture then - begin - MouseCapture := False; - if csLButtonDown in ControlState then Perform(WM_LBUTTONUP, 0, - Integer($FFFFFFFF)); - end - else - Exclude(FControlState, csLButtonDown); -end; - -procedure TControl.WMWindowPosChanged(var Message: TWMWindowPosChanged); -begin - inherited; - { Update min/max width/height to actual extents control will allow } - if ComponentState * [csReading, csLoading] = [] then - begin - with Constraints do - begin - if (MaxWidth > 0) and (Width > MaxWidth) then - FMaxWidth := Width - else if (MinWidth > 0) and (Width < MinWidth) then - FMinWidth := Width; - if (MaxHeight > 0) and (Height > MaxHeight) then - FMaxHeight := Height - else if (MinHeight > 0) and (Height < MinHeight) then - FMinHeight := Height; - end; - if Message.WindowPos <> nil then - with Message.WindowPos^ do - if (FHostDockSite <> nil) and not (csDocking in ControlState) and - (Flags and SWP_NOSIZE = 0) and (cx <> 0) and (cy <> 0) then - CalcDockSizes; - end; -end; - -procedure TControl.CMVisibleChanged(var Message: TMessage); -begin - if not (csDesigning in ComponentState) or - (csNoDesignVisible in ControlStyle) then - InvalidateControl(True, FVisible and (csOpaque in ControlStyle)); -end; - -procedure TControl.CMEnabledChanged(var Message: TMessage); -begin - Invalidate; -end; - -procedure TControl.CMFontChanged(var Message: TMessage); -begin - Invalidate; -end; - -procedure TControl.CMColorChanged(var Message: TMessage); -begin - Invalidate; -end; - -procedure TControl.CMParentColorChanged(var Message: TMessage); -begin - if FParentColor then - begin - if Message.wParam <> 0 then - SetColor(TColor(Message.lParam)) else - SetColor(FParent.FColor); - FParentColor := True; - end; -end; - -procedure TControl.CMParentBiDiModeChanged(var Message: TMessage); -begin - if FParentBiDiMode then - begin - if FParent <> nil then BiDiMode := FParent.BiDiMode; - FParentBiDiMode := True; - end; -end; - -procedure TControl.CMBiDiModeChanged(var Message: TMessage); -begin - if (SysLocale.MiddleEast) and (Message.wParam = 0) then Invalidate; -end; - -procedure TControl.CMParentShowHintChanged(var Message: TMessage); -begin - if FParentShowHint then - begin - SetShowHint(FParent.FShowHint); - FParentShowHint := True; - end; -end; - -procedure TControl.CMParentFontChanged(var Message: TMessage); -begin - if FParentFont then - begin - if Message.wParam <> 0 then - SetFont(TFont(Message.lParam)) else - SetFont(FParent.FFont); - FParentFont := True; - end; -end; - -procedure TControl.CMSysFontChanged(var Message: TMessage); -begin - if FDesktopFont then - begin - SetFont(Screen.IconFont); - FDesktopFont := True; - end; -end; - -procedure TControl.CMHitTest(var Message: TCMHitTest); -begin - Message.Result := 1; -end; - -procedure TControl.CMMouseEnter(var Message: TMessage); -begin - if FParent <> nil then - FParent.Perform(CM_MOUSEENTER, 0, Longint(Self)); -end; - -procedure TControl.CMMouseLeave(var Message: TMessage); -begin - if FParent <> nil then - FParent.Perform(CM_MOUSELEAVE, 0, Longint(Self)); -end; - -procedure TControl.CMDesignHitTest(var Message: TCMDesignHitTest); -begin - Message.Result := 0; -end; - -function TControl.CreateFloatingDockSite(Bounds: TRect): TWinControl; -begin - Result := nil; - if (FloatingDockSiteClass <> nil) and - (FloatingDockSiteClass <> TWinControlClass(ClassType)) then - begin - Result := FloatingDockSiteClass.Create(Application); - with Bounds do - begin - Result.Top := Top; - Result.Left := Left; - Result.ClientWidth := Right - Left; - Result.ClientHeight := Bottom - Top; - end; - end; -end; - -procedure TControl.CMFloat(var Message: TCMFloat); -var - FloatHost: TWinControl; - - procedure UpdateFloatingDockSitePos; - var - P: TPoint; - begin - P := Parent.ClientToScreen(Point(Left, Top)); - with Message.DockSource.DockRect do - Parent.BoundsRect := Bounds(Left + Parent.Left - P.X, - Top + Parent.Top - P.Y, - Right - Left + Parent.Width - Width, - Bottom - Top + Parent.Height - Height); - end; - -begin - if Floating and (Parent <> nil) then - UpdateFloatingDockSitePos - else - begin - FloatHost := CreateFloatingDockSite(Message.DockSource.DockRect); - if FloatHost <> nil then - begin - Message.DockSource.DragTarget := FloatHost; - Message.DockSource.DragHandle := FloatHost.Handle; - end; - end; -end; - -procedure TControl.ActionChange(Sender: TObject; CheckDefaults: Boolean); -begin - if Sender is TCustomAction then - with TCustomAction(Sender) do - begin - if not CheckDefaults or (Self.Caption = '') then - Self.Caption := Caption; - if not CheckDefaults or (Self.Enabled = True) then - Self.Enabled := Enabled; - if not CheckDefaults or (Self.Hint = '') then - Self.Hint := Hint; - if not CheckDefaults or (Self.Visible = True) then - Self.Visible := Visible; - if not CheckDefaults or not Assigned(Self.OnClick) then - Self.OnClick := OnExecute; - end; -end; - -procedure TControl.DoActionChange(Sender: TObject); -begin - if Sender = Action then ActionChange(Sender, False); -end; - -function TControl.GetActionLinkClass: TControlActionLinkClass; -begin - Result := TControlActionLink; -end; - -function TControl.IsCaptionStored: Boolean; -begin - Result := (ActionLink = nil) or not ActionLink.IsCaptionLinked; -end; - -function TControl.IsEnabledStored: Boolean; -begin - Result := (ActionLink = nil) or not ActionLink.IsEnabledLinked; -end; - -function TControl.IsHintStored: Boolean; -begin - Result := (ActionLink = nil) or not ActionLink.IsHintLinked; -end; - -function TControl.IsVisibleStored: Boolean; -begin - Result := (ActionLink = nil) or not ActionLink.IsVisibleLinked; -end; - -function TControl.IsOnClickStored: Boolean; -begin - Result := (ActionLink = nil) or not ActionLink.IsOnExecuteLinked; -end; - -procedure TControl.Loaded; -begin - inherited Loaded; - if Action <> nil then ActionChange(Action, True); -end; - -procedure TControl.AssignTo(Dest: TPersistent); -begin - if Dest is TCustomAction then - with TCustomAction(Dest) do - begin - Enabled := Self.Enabled; - Hint := Self.Hint; - Caption := Self.Caption; - Visible := Self.Visible; - OnExecute := Self.OnClick; - end - else inherited AssignTo(Dest); -end; - -function TControl.GetDockEdge(MousePos: TPoint): TAlign; - - function MinVar(const Data: array of Double): Integer; - var - I: Integer; - begin - Result := 0; - for I := Low(Data) + 1 to High(Data) do - if Data[I] < Data[Result] then Result := I; - end; - -var - T, L, B, R: Integer; -begin - Result := alNone; - R := Width; - B := Height; - // if Point is outside control, then we can determine side quickly - if MousePos.X <= 0 then Result := alLeft - else if MousePos.X >= R then Result := alRight - else if MousePos.Y <= 0 then Result := alTop - else if MousePos.Y >= B then Result := alBottom - else begin - // if MousePos is inside the control, then we need to figure out which side - // MousePos is closest to. - T := MousePos.Y; - B := B - MousePos.Y; - L := MousePos.X; - R := R - MousePos.X; - case MinVar([L, R, T, B]) of - 0: Result := alLeft; - 1: Result := alRight; - 2: Result := alTop; - 3: Result := alBottom; - end; - end; -end; - -function TControl.GetFloating: Boolean; -begin - Result := (HostDockSite <> nil) and (HostDockSite is FloatingDockSiteClass); -end; - -function TControl.GetFloatingDockSiteClass: TWinControlClass; -begin - Result := FFloatingDockSiteClass; -end; - -procedure TControl.AdjustSize; -begin - if not (csLoading in ComponentState) then SetBounds(Left, Top, Width, Height); -end; - -function TControl.DrawTextBiDiModeFlags(Flags: Longint): Longint; -begin - Result := Flags; - { do not change center alignment } - if UseRightToLeftAlignment then - if Result and DT_RIGHT = DT_RIGHT then - Result := Result and not DT_RIGHT { removing DT_RIGHT, makes it DT_LEFT } - else if not (Result and DT_CENTER = DT_CENTER) then - Result := Result or DT_RIGHT; - Result := Result or DrawTextBiDiModeFlagsReadingOnly; -end; - -function TControl.DrawTextBiDiModeFlagsReadingOnly: Longint; -begin - if UseRightToLeftReading then - Result := DT_RTLREADING - else - Result := 0; -end; - -procedure TControl.InitiateAction; -begin - if ActionLink <> nil then ActionLink.Update; -end; - -procedure TControl.CMHintShow(var Message: TMessage); -begin - if (ActionLink <> nil) and - not ActionLink.DoShowHint(TCMHintShow(Message).HintInfo^.HintStr) then - Message.Result := 1; -end; - -procedure TControl.UpdateLastResize(NewWidth, NewHeight: Integer); -begin - FLastWidth := NewWidth; - FLastHeight := NewHeight; -end; -*/ diff --git a/apps/X11/VCL/TControl.h b/apps/X11/VCL/TControl.h deleted file mode 100644 index 0969339..0000000 --- a/apps/X11/VCL/TControl.h +++ /dev/null @@ -1,331 +0,0 @@ -#ifndef TCONTROL_H -#define TCONTROL_H - -#include <TComponent.h> - -class TControl : public TComponent { -private: -/* - FParent: TWinControl; - FWindowProc: TWndMethod; - FLeft: Integer; - FTop: Integer; - FWidth: Integer; - FHeight: Integer; - FControlStyle: TControlStyle; - FControlState: TControlState; - FDesktopFont: Boolean; - FVisible: Boolean; - FEnabled: Boolean; - FParentFont: Boolean; - FParentColor: Boolean; - FAlign: TAlign; - FAutoSize: Boolean; - FDragMode: TDragMode; - FIsControl: Boolean; - FBiDiMode: TBiDiMode; - FParentBiDiMode: Boolean; - FText: PChar; - FFont: TFont; - FActionLink: TControlActionLink; - FAnchors: TAnchors; - FColor: TColor; - FConstraints: TSizeConstraints; - FCursor: TCursor; - FDragCursor: TCursor; - FPopupMenu: TPopupMenu; - FHint: string; - FFontHeight: Integer; - FLastHeight: Integer; - FLastWidth: Integer; - FScalingFlags: TScalingFlags; - FShowHint: Boolean; - FParentShowHint: Boolean; - FDragKind: TDragKind; - FDockOrientation: TDockOrientation; - FHostDockSite: TWinControl; - FUndockWidth: Integer; - FUndockHeight: Integer; - FLRDockWidth: Integer; - FTBDockHeight: Integer; - FFloatingDockSiteClass: TWinControlClass; - FOnCanResize: TCanResizeEvent; - FOnConstrainedResize: TConstrainedResizeEvent; - FOnMouseDown: TMouseEvent; - FOnMouseMove: TMouseMoveEvent; - FOnMouseUp: TMouseEvent; - FOnDragDrop: TDragDropEvent; - FOnDragOver: TDragOverEvent; - FOnResize: TNotifyEvent; - FOnStartDock: TStartDockEvent; - FOnEndDock: TEndDragEvent; - FOnStartDrag: TStartDragEvent; - FOnEndDrag: TEndDragEvent; - FOnClick: TNotifyEvent; - FOnDblClick: TNotifyEvent; - procedure CalcDockSizes; - procedure CheckMenuPopup(const Pos: TSmallPoint); - function CheckNewSize(var NewWidth, NewHeight: Integer): Boolean; - function CreateFloatingDockSite(Bounds: TRect): TWinControl; - procedure DoActionChange(Sender: TObject); - function DoCanAutoSize(var NewWidth, NewHeight: Integer): Boolean; - function DoCanResize(var NewWidth, NewHeight: Integer): Boolean; - procedure DoConstraintsChange(Sender: TObject); - procedure DoConstrainedResize(var NewWidth, NewHeight: Integer); - procedure DoDragMsg(var DragMsg: TCMDrag); - procedure DoMouseDown(var Message: TWMMouse; Button: TMouseButton; - Shift: TShiftState); - procedure DoMouseUp(var Message: TWMMouse; Button: TMouseButton); - procedure FontChanged(Sender: TObject); - function GetAction: TBasicAction; - function GetBoundsRect: TRect; - function GetClientHeight: Integer; - function GetClientWidth: Integer; - function GetLRDockWidth: Integer; - function GetMouseCapture: Boolean; - function GetText: TCaption; - function GetTBDockHeight: Integer; - function GetUndockWidth: Integer; - function GetUndockHeight: Integer; - procedure InvalidateControl(IsVisible, IsOpaque: Boolean); - function IsAnchorsStored: Boolean; - function IsBiDiModeStored: Boolean; - function IsCaptionStored: Boolean; - function IsColorStored: Boolean; - function IsEnabledStored: Boolean; - function IsFontStored: Boolean; - function IsHintStored: Boolean; - function IsOnClickStored: Boolean; - function IsShowHintStored: Boolean; - function IsVisibleStored: Boolean; - procedure ReadIsControl(Reader: TReader); - procedure SetAction(Value: TBasicAction); - procedure SetAlign(Value: TAlign); - procedure SetAutoSize(Value: Boolean); - procedure SetBoundsRect(const Rect: TRect); - procedure SetClientHeight(Value: Integer); - procedure SetClientSize(Value: TPoint); - procedure SetClientWidth(Value: Integer); - procedure SetColor(Value: TColor); - procedure SetCursor(Value: TCursor); - procedure SetDesktopFont(Value: Boolean); - procedure SetFont(Value: TFont); - procedure SetHeight(Value: Integer); - procedure SetHostDockSite(Value: TWinControl); - procedure SetLeft(Value: Integer); - procedure SetMouseCapture(Value: Boolean); - procedure SetParentColor(Value: Boolean); - procedure SetParentFont(Value: Boolean); - procedure SetShowHint(Value: Boolean); - procedure SetParentShowHint(Value: Boolean); - procedure SetPopupMenu(Value: TPopupMenu); - procedure SetText(const Value: TCaption); - procedure SetTop(Value: Integer); - procedure SetVisible(Value: Boolean); - procedure SetWidth(Value: Integer); - procedure SetZOrderPosition(Position: Integer); - procedure UpdateLastResize(NewWidth, NewHeight: Integer); virtual; - procedure WriteIsControl(Writer: TWriter); - procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; - procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN; - procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN; - procedure WMMButtonDown(var Message: TWMMButtonDown); message WM_MBUTTONDOWN; - procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK; - procedure WMRButtonDblClk(var Message: TWMRButtonDblClk); message WM_RBUTTONDBLCLK; - procedure WMMButtonDblClk(var Message: TWMMButtonDblClk); message WM_MBUTTONDBLCLK; - procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE; - procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP; - procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP; - procedure WMMButtonUp(var Message: TWMMButtonUp); message WM_MBUTTONUP; - procedure WMCancelMode(var Message: TWMCancelMode); message WM_CANCELMODE; - procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED; - procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED; - procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; - procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; - procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED; - procedure CMParentFontChanged(var Message: TMessage); message CM_PARENTFONTCHANGED; - procedure CMSysFontChanged(var Message: TMessage); message CM_SYSFONTCHANGED; - procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED; - procedure CMParentShowHintChanged(var Message: TMessage); message CM_PARENTSHOWHINTCHANGED; - procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW; - procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST; - procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; - procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; - procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST; - procedure CMFloat(var Message: TCMFloat); message CM_FLOAT; - procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED; - procedure CMParentBiDiModeChanged(var Message: TMessage); message CM_PARENTBIDIMODECHANGED; - protected - procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); dynamic; - procedure AdjustSize; dynamic; - procedure AssignTo(Dest: TPersistent); override; - procedure BeginAutoDrag; dynamic; - function CanResize(var NewWidth, NewHeight: Integer): Boolean; virtual; - function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; virtual; - procedure Changed; - procedure ChangeScale(M, D: Integer); dynamic; - procedure Click; dynamic; - procedure ConstrainedResize(var MinWidth, MinHeight, MaxWidth, MaxHeight: Integer); virtual; - procedure DblClick; dynamic; - procedure DefaultDockImage(DragDockObject: TDragDockObject; Erase: Boolean); dynamic; - procedure DefineProperties(Filer: TFiler); override; - procedure DockTrackNoTarget(Source: TDragDockObject; X, Y: Integer); dynamic; - procedure DoEndDock(Target: TObject; X, Y: Integer); dynamic; - procedure DoDock(NewDockSite: TWinControl; var ARect: TRect); dynamic; - procedure DoStartDock(var DragObject: TDragObject); dynamic; - procedure DragCanceled; dynamic; - procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; - var Accept: Boolean); dynamic; - procedure DoEndDrag(Target: TObject; X, Y: Integer); dynamic; - procedure DoStartDrag(var DragObject: TDragObject); dynamic; - procedure DrawDragDockImage(DragDockObject: TDragDockObject); dynamic; - procedure EraseDragDockImage(DragDockObject: TDragDockObject); dynamic; - function GetActionLinkClass: TControlActionLinkClass; dynamic; - function GetClientOrigin: TPoint; virtual; - function GetClientRect: TRect; virtual; - function GetDeviceContext(var WindowHandle: HWnd): HDC; virtual; - function GetDockEdge(MousePos: TPoint): TAlign; dynamic; - function GetDragImages: TDragImageList; virtual; - function GetEnabled: Boolean; virtual; - function GetFloating: Boolean; virtual; - function GetFloatingDockSiteClass: TWinControlClass; virtual; - function GetPalette: HPALETTE; dynamic; - function GetPopupMenu: TPopupMenu; dynamic; - procedure Loaded; override; - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); dynamic; - procedure MouseMove(Shift: TShiftState; X, Y: Integer); dynamic; - procedure MouseUp(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); dynamic; - procedure Notification(AComponent: TComponent; - Operation: TOperation); override; - procedure PositionDockRect(DragDockObject: TDragDockObject); dynamic; - function PaletteChanged(Foreground: Boolean): Boolean; dynamic; - procedure ReadState(Reader: TReader); override; - procedure RequestAlign; dynamic; - procedure Resize; dynamic; - procedure SendCancelMode(Sender: TControl); - procedure SendDockNotification(Msg: Cardinal; WParam, LParam: Integer); - procedure SetDragMode(Value: TDragMode); virtual; - procedure SetEnabled(Value: Boolean); virtual; - procedure SetName(const Value: TComponentName); override; - procedure SetParent(AParent: TWinControl); virtual; - procedure SetParentComponent(Value: TComponent); override; - procedure SetParentBiDiMode(Value: Boolean); virtual; - procedure SetBiDiMode(Value: TBiDiMode); virtual; - procedure SetZOrder(TopMost: Boolean); dynamic; - procedure UpdateBoundsRect(const R: TRect); - procedure VisibleChanging; dynamic; - procedure WndProc(var Message: TMessage); virtual; - property ActionLink: TControlActionLink read FActionLink write FActionLink; - property AutoSize: Boolean read FAutoSize write SetAutoSize default False; - property Caption: TCaption read GetText write SetText stored IsCaptionStored; - property Color: TColor read FColor write SetColor stored IsColorStored default clWindow; - property DesktopFont: Boolean read FDesktopFont write SetDesktopFont default False; - property DragKind: TDragKind read FDragKind write FDragKind default dkDrag; - property DragCursor: TCursor read FDragCursor write FDragCursor default crDrag; - property DragMode: TDragMode read FDragMode write SetDragMode default dmManual; - property Font: TFont read FFont write SetFont stored IsFontStored; - property IsControl: Boolean read FIsControl write FIsControl; - property MouseCapture: Boolean read GetMouseCapture write SetMouseCapture; - property ParentBiDiMode: Boolean read FParentBiDiMode write SetParentBiDiMode default True; - property ParentColor: Boolean read FParentColor write SetParentColor default True; - property ParentFont: Boolean read FParentFont write SetParentFont default True; - property ParentShowHint: Boolean read FParentShowHint write SetParentShowHint default True; - property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu; - property ScalingFlags: TScalingFlags read FScalingFlags write FScalingFlags; - property Text: TCaption read GetText write SetText; - property WindowText: PChar read FText write FText; - property OnCanResize: TCanResizeEvent read FOnCanResize write FOnCanResize; - property OnConstrainedResize: TConstrainedResizeEvent read FOnConstrainedResize write FOnConstrainedResize; - property OnClick: TNotifyEvent read FOnClick write FOnClick stored IsOnClickStored; - property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick; - property OnDragDrop: TDragDropEvent read FOnDragDrop write FOnDragDrop; - property OnDragOver: TDragOverEvent read FOnDragOver write FOnDragOver; - property OnEndDock: TEndDragEvent read FOnEndDock write FOnEndDock; - property OnEndDrag: TEndDragEvent read FOnEndDrag write FOnEndDrag; - property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown; - property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove; - property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp; - property OnResize: TNotifyEvent read FOnResize write FOnResize; - property OnStartDock: TStartDockEvent read FOnStartDock write FOnStartDock; - property OnStartDrag: TStartDragEvent read FOnStartDrag write FOnStartDrag; -*/ -public: - TControl(TComponent *AOwner); - ~TControl(); - -// procedure Repaint; virtual; - void Repaint(); -/* - procedure BeginDrag(Immediate: Boolean; Threshold: Integer = -1); - procedure BringToFront; - function ClientToScreen(const Point: TPoint): TPoint; - procedure Dock(NewDockSite: TWinControl; ARect: TRect); dynamic; - procedure DefaultHandler(var Message); override; - function Dragging: Boolean; - procedure DragDrop(Source: TObject; X, Y: Integer); dynamic; - function DrawTextBiDiModeFlags(Flags: Longint): Longint; - function DrawTextBiDiModeFlagsReadingOnly: Longint; - property Enabled: Boolean read GetEnabled write SetEnabled stored IsEnabledStored default True; - procedure EndDrag(Drop: Boolean); - function GetControlsAlignment: TAlignment; dynamic; - function GetParentComponent: TComponent; override; - function GetTextBuf(Buffer: PChar; BufSize: Integer): Integer; - function GetTextLen: Integer; - function HasParent: Boolean; override; - procedure Hide; - procedure InitiateAction; virtual; - procedure Invalidate; virtual; - function IsRightToLeft: Boolean; - function ManualDock(NewDockSite: TWinControl; DropControl: TControl = nil; - ControlSide: TAlign = alNone): Boolean; - function ManualFloat(ScreenPos: TRect): Boolean; - function Perform(Msg: Cardinal; WParam, LParam: Longint): Longint; - procedure Refresh; - function ReplaceDockedControl(Control: TControl; NewDockSite: TWinControl; - DropControl: TControl; ControlSide: TAlign): Boolean; - function ScreenToClient(const Point: TPoint): TPoint; - procedure SendToBack; - procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); virtual; - procedure SetTextBuf(Buffer: PChar); - procedure Show; - procedure Update; virtual; - function UseRightToLeftAlignment: Boolean; dynamic; - function UseRightToLeftReading: Boolean; - function UseRightToLeftScrollBar: Boolean; - property Action: TBasicAction read GetAction write SetAction; - property Align: TAlign read FAlign write SetAlign default alNone; - property Anchors: TAnchors read FAnchors write FAnchors stored IsAnchorsStored default [akLeft, akTop]; - property BiDiMode: TBiDiMode read FBiDiMode write SetBiDiMode stored IsBiDiModeStored; - property BoundsRect: TRect read GetBoundsRect write SetBoundsRect; - property ClientHeight: Integer read GetClientHeight write SetClientHeight stored False; - property ClientOrigin: TPoint read GetClientOrigin; - property ClientRect: TRect read GetClientRect; - property ClientWidth: Integer read GetClientWidth write SetClientWidth stored False; - property Constraints: TSizeConstraints read FConstraints write FConstraints; - property ControlState: TControlState read FControlState write FControlState; - property ControlStyle: TControlStyle read FControlStyle write FControlStyle; - property DockOrientation: TDockOrientation read FDockOrientation write FDockOrientation; - property Floating: Boolean read GetFloating; - property FloatingDockSiteClass: TWinControlClass read GetFloatingDockSiteClass write FFloatingDockSiteClass; - property HostDockSite: TWinControl read FHostDockSite write SetHostDockSite; - property LRDockWidth: Integer read GetLRDockWidth write FLRDockWidth; - property Parent: TWinControl read FParent write SetParent; - property ShowHint: Boolean read FShowHint write SetShowHint stored IsShowHintStored; - property TBDockHeight: Integer read GetTBDockHeight write FTBDockHeight; - property UndockHeight: Integer read GetUndockHeight write FUndockHeight; - property UndockWidth: Integer read GetUndockWidth write FUndockWidth; - property Visible: Boolean read FVisible write SetVisible stored IsVisibleStored default True; - property WindowProc: TWndMethod read FWindowProc write FWindowProc; - published - property Left: Integer read FLeft write SetLeft; - property Top: Integer read FTop write SetTop; - property Width: Integer read FWidth write SetWidth; - property Height: Integer read FHeight write SetHeight; - property Cursor: TCursor read FCursor write SetCursor default crDefault; - property Hint: string read FHint write FHint stored IsHintStored; -*/ -}; - -#endif diff --git a/apps/X11/VCL/TCustomImageList.cpp b/apps/X11/VCL/TCustomImageList.cpp deleted file mode 100644 index 6a63a24..0000000 --- a/apps/X11/VCL/TCustomImageList.cpp +++ /dev/null @@ -1,1142 +0,0 @@ - -#include <TCustomImageList.h> - -TCustomImageList::TCustomImageList(TComponent *AOwner) : - TComponent(AOwner) { -} - -TCustomImageList::TCustomImageList(int AWidth, int AHeight) : - TComponent(0) { -} - -TCustomImageList::~TCustomImageList() { -} - -/* -function TCustomImageList.Add(Image, Mask: TBitmap): Integer; -var - ImageDDB, MaskDDB: TBitmap; -begin - ImageDDB := TBitmap.Create; - try - MaskDDB := TBitmap.Create; - try - HandleNeeded; - Result := ImageList_Add(FHandle, GetImageHandle(Image, ImageDDB), - GetImageHandle(Mask, MaskDDB)); - finally - MaskDDB.Free; - end; - finally - ImageDDB.Free; - end; - Change; -end; -*/ - -int TCustomImageList::Add(gchar **xpm_data, GtkWidget *canvas) { - - /* GtkWidget is the storage type for widgets */ - GtkWidget *pixmapwid; - GdkPixmap *pixmap; - GdkBitmap *mask; - GdkWindow *window = 0; - GtkStyle *style; - - while ((!window) && (canvas->parent)) { - window = gtk_widget_get_parent_window(GTK_WIDGET(canvas)); - canvas = canvas->parent; - } - style = gtk_widget_get_style( GTK_WIDGET(canvas) ); - pixmap = gdk_pixmap_create_from_xpm_d( window, &mask, - &style->bg[GTK_STATE_NORMAL], - (gchar **)xpm_data); - - pixmapwid = gtk_pixmap_new( pixmap, mask ); - images.push_back(GTK_PIXMAP(pixmapwid)); - return images.size(); -} - - -/* -procedure TCustomImageList.GetBitmap(Index: Integer; Image: TBitmap); -begin - if (Image <> nil) and HandleAllocated then - with Image do - begin - Height := FHeight; - Width := FWidth; - Draw(Canvas, 0, 0, Index); - end; -end; -*/ -GtkPixmap *TCustomImageList::GetPixmap(int index) { - if ((unsigned int)index < images.size()) - return images[index]; - else return 0; -} - - -/* -{ TCustomImageList } - -function GetRGBColor(Value: TColor): DWORD; -begin - Result := ColorToRGB(Value); - case Result of - clNone: Result := CLR_NONE; - clDefault: Result := CLR_DEFAULT; - end; -end; - -function GetColor(Value: DWORD): TColor; -begin - case Value of - CLR_NONE: Result := clNone; - CLR_DEFAULT: Result := clDefault; - else - Result := TColor(Value); - end; -end; - -constructor TCustomImageList.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FWidth := 16; - FHeight := 16; - Initialize; -end; - -constructor TCustomImageList.CreateSize(AWidth, AHeight: Integer); -begin - inherited Create(nil); - FWidth := AWidth; - FHeight := AHeight; - Initialize; -end; - -destructor TCustomImageList.Destroy; -begin - while FClients.Count > 0 do - UnRegisterChanges(TChangeLink(FClients.Last)); - FBitmap.Free; - FreeHandle; - FClients.Free; - FClients := nil; - if FMonoBitmap <> nil then FMonoBitmap.Free; - inherited Destroy; -end; - -procedure TCustomImageList.Initialize; -const - MaxSize = 32768; -begin - FClients := TList.Create; - if (Height < 1) or (Height > MaxSize) or (Width < 1) then - raise EInvalidOperation.Create(SInvalidImageSize); - AllocBy := 4; - Masked := True; - DrawingStyle := dsNormal; - ImageType := itImage; - FBkColor := clNone; - FBlendColor := clNone; - FBitmap := TBitmap.Create; - InitBitmap; -end; - -function TCustomImageList.HandleAllocated: Boolean; -begin - Result := FHandle <> 0; -end; - -procedure TCustomImageList.HandleNeeded; -begin - if FHandle = 0 then CreateImageList; -end; - -procedure TCustomImageList.InitBitmap; -var - ScreenDC: HDC; -begin - ScreenDC := GetDC(0); - try - with FBitmap do - begin - Handle := CreateCompatibleBitmap(ScreenDC, Self.Width, Self.Height); - Canvas.Brush.Color := clBlack; - Canvas.FillRect(Rect(0, 0, Width, Height)); - end; - finally - ReleaseDC(0, ScreenDC); - end; - if FMonoBitmap <> nil then - begin - FMonoBitmap.Free; - FMonoBitmap := nil; - end; -end; - -procedure TCustomImageList.SetNewDimensions(Value: HImageList); -var - AHeight, AWidth: Integer; -begin - AWidth := Width; - AHeight := Height; - ImageList_GetIconSize(Value, AWidth, AHeight); - FWidth := AWidth; - FHeight := AHeight; - InitBitmap; -end; - -procedure TCustomImageList.SetWidth(Value: Integer); -begin - if Value <> Width then - begin - FWidth := Value; - if HandleAllocated then ImageList_SetIconSize(FHandle, Width, Height); - Clear; - InitBitmap; - Change; - end; -end; - -procedure TCustomImageList.SetHeight(Value: Integer); -begin - if Value <> Height then - begin - FHeight := Value; - if HandleAllocated then ImageList_SetIconSize(FHandle, Width, Height); - Clear; - InitBitmap; - Change; - end; -end; - -procedure TCustomImageList.SetHandle(Value: HImageList); -begin - FreeHandle; - if Value <> 0 then - begin - SetNewDimensions(Value); - FHandle := Value; - Change; - end; -end; - -function TCustomImageList.GetBitmapHandle(Bitmap: HBITMAP): HBITMAP; -begin - if Bitmap <> 0 then - Result := Bitmap else - Result := FBitmap.Handle; -end; - -function TCustomImageList.GetHandle: HImageList; -begin - HandleNeeded; - Result := FHandle; -end; - -function TCustomImageList.GetImageHandle(Image, ImageDDB: TBitmap): HBITMAP; -begin - CheckImage(Image); - if Image <> nil then - if Image.HandleType = bmDDB then - Result := Image.Handle - else - begin - ImageDDB.Assign(Image); - ImageDDB.HandleType := bmDDB; - Result := ImageDDB.Handle; - end - else Result := FBitmap.Handle; -end; - -procedure TCustomImageList.FreeHandle; -begin - if HandleAllocated and not ShareImages then - ImageList_Destroy(Handle); - FHandle := 0; - Change; -end; - -procedure TCustomImageList.CreateImageList; -const - Mask: array[Boolean] of Longint = (0, ILC_MASK); -begin - FHandle := ImageList_Create(Width, Height, ILC_COLOR or Mask[Masked], - AllocBy, AllocBy); - if FHandle = 0 then raise EInvalidOperation.Create(SInvalidImageList); - if FBkColor <> clNone then BkColor := FBkColor; -end; - -function TCustomImageList.GetImageBitmap: HBITMAP; -var - Info: TImageInfo; -begin - if (Count > 0) and ImageList_GetImageInfo(Handle, 0, Info) then - begin - Result := Info.hbmImage; - DeleteObject(Info.hbmMask); - end - else Result := 0; -end; - -function TCustomImageList.GetMaskBitmap: HBITMAP; -var - Info: TImageInfo; -begin - if (Count > 0) and ImageList_GetImageInfo(Handle, 0, Info) then - begin - Result := Info.hbmMask; - DeleteObject(Info.hbmImage); - end - else Result := 0; -end; - -function TCustomImageList.AddMasked(Image: TBitmap; MaskColor: TColor): Integer; -var - ImageDDB: TBitmap; -begin - ImageDDB := TBitmap.Create; - try - if Masked and (MaskColor <> -1) then - begin - with TBitmap.Create do - try - Assign(Image); - TransparentColor := MaskColor; - Self.HandleNeeded; - Result := ImageList_Add(Self.FHandle, GetImageHandle(Image, ImageDDB), - GetBitmapHandle(MaskHandle)); - finally - Free; - end; - end - else Result := ImageList_Add(Handle, GetImageHandle(Image, ImageDDB), 0); - finally - ImageDDB.Free; - end; - Change; -end; - -function TCustomImageList.AddIcon(Image: TIcon): Integer; -begin - if Image = nil then - Result := Add(nil, nil) - else - begin - CheckImage(Image); - Result := ImageList_AddIcon(Handle, Image.Handle); - end; - Change; -end; - -procedure TCustomImageList.GetIcon(Index: Integer; Image: TIcon); -const - DrawingStyles: array[TDrawingStyle] of Longint = (ILD_FOCUS, - ILD_SELECTED, ILD_NORMAL, ILD_TRANSPARENT); - Images: array[TImageType] of Longint = (0, ILD_MASK); -begin - if (Image <> nil) and HandleAllocated then - Image.Handle := ImageList_GetIcon(Handle, Index, - DrawingStyles[DrawingStyle] or Images[ImageType]); -end; - -function TCustomImageList.GetCount: Integer; -begin - if HandleAllocated then Result := ImageList_GetImageCount(Handle) - else Result := 0; -end; - -procedure TCustomImageList.Replace(Index: Integer; Image, Mask: TBitmap); -var - ImageDDB, MaskDDB: TBitmap; -begin - ImageDDB := TBitmap.Create; - try - MaskDDB := TBitmap.Create; - try - if HandleAllocated and not ImageList_Replace(Handle, Index, - GetImageHandle(Image, ImageDDB), GetImageHandle(Mask, MaskDDB)) then - raise EInvalidOperation.Create(SReplaceImage); - finally - MaskDDB.Free; - end; - finally - ImageDDB.Free; - end; - Change; -end; - -procedure TCustomImageList.ReplaceMasked(Index: Integer; NewImage: TBitmap; MaskColor: TColor); -var - TempIndex: Integer; - Image, Mask: TBitmap; -begin - if HandleAllocated then - begin - CheckImage(NewImage); - TempIndex := AddMasked(NewImage, MaskColor); - if TempIndex <> -1 then - try - Image := TBitmap.Create; - try - with Image do - begin - Height := FHeight; - Width := FWidth; - end; - Mask := TBitmap.Create; - try - with Mask do - begin - Monochrome := True; - Height := FHeight; - Width := FWidth; - end; - ImageList_Draw(Handle, TempIndex, Image.Canvas.Handle, 0, 0, ILD_NORMAL); - ImageList_Draw(Handle, TempIndex, Mask.Canvas.Handle, 0, 0, ILD_MASK); - if not ImageList_Replace(Handle, Index, Image.Handle, Mask.Handle) then - raise EInvalidOperation.Create(SReplaceImage); - finally - Mask.Free; - end; - finally - Image.Free; - end; - finally - Delete(TempIndex); - end - else raise EInvalidOperation.Create(SReplaceImage); - end; - Change; -end; - -procedure TCustomImageList.ReplaceIcon(Index: Integer; Image: TIcon); -begin - if HandleAllocated then - if Image = nil then Replace(Index, nil, nil) - else begin - CheckImage(Image); - if ImageList_ReplaceIcon(Handle, Index, Image.Handle) = -1 then - raise EInvalidOperation.Create(SReplaceImage); - end; - Change; -end; - -procedure TCustomImageList.Delete(Index: Integer); -begin - if Index >= Count then raise EInvalidOperation.Create(SImageIndexError); - if HandleAllocated then ImageList_Remove(Handle, Index); - Change; -end; - -procedure TCustomImageList.Clear; -begin - Delete(-1); -end; - -procedure TCustomImageList.SetBkColor(Value: TColor); -begin - if HandleAllocated then ImageList_SetBkColor(FHandle, GetRGBColor(Value)) - else FBkColor := Value; - Change; -end; - -function TCustomImageList.GetBkColor: TColor; -begin - if HandleAllocated then Result := GetColor(ImageList_GetBkColor(Handle)) - else Result := FBkColor; -end; - -procedure TCustomImageList.DoDraw(Index: Integer; Canvas: TCanvas; X, Y: Integer; - Style: Cardinal; Enabled: Boolean); -const - ROP_DSPDxax = $00E20746; -var - R: TRect; - DestDC, SrcDC: HDC; -begin - if HandleAllocated then - begin - if Enabled then - ImageList_DrawEx(Handle, Index, Canvas.Handle, X, Y, 0, 0, - GetRGBColor(BkColor), GetRGBColor(BlendColor), Style) - else - begin - if FMonoBitmap = nil then - begin - FMonoBitmap := TBitmap.Create; - with FMonoBitmap do - begin - Monochrome := True; - Width := Self.Width; - Height := Self.Height; - end; - end; - { Store masked version of image temporarily in FBitmap } - FMonoBitmap.Canvas.Brush.Color := clWhite; - FMonoBitmap.Canvas.FillRect(Rect(0, 0, Self.Width, Self.Height)); - ImageList_DrawEx(Handle, Index, FMonoBitmap.Canvas.Handle, 0,0,0,0, - CLR_DEFAULT, 0, ILD_NORMAL); - R := Rect(X, Y, X+Width, Y+Height); - SrcDC := FMonoBitmap.Canvas.Handle; - { Convert Black to clBtnHighlight } - Canvas.Brush.Color := clBtnHighlight; - DestDC := Canvas.Handle; - Windows.SetTextColor(DestDC, clWhite); - Windows.SetBkColor(DestDC, clBlack); - BitBlt(DestDC, X+1, Y+1, Width, Height, SrcDC, 0, 0, ROP_DSPDxax); - { Convert Black to clBtnShadow } - Canvas.Brush.Color := clBtnShadow; - DestDC := Canvas.Handle; - Windows.SetTextColor(DestDC, clWhite); - Windows.SetBkColor(DestDC, clBlack); - BitBlt(DestDC, X, Y, Width, Height, SrcDC, 0, 0, ROP_DSPDxax); - end; - end; -end; - -procedure TCustomImageList.Draw(Canvas: TCanvas; X, Y, Index: Integer; - Enabled: Boolean); -const - DrawingStyles: array[TDrawingStyle] of Longint = (ILD_FOCUS, ILD_SELECTED, - ILD_NORMAL, ILD_TRANSPARENT); - Images: array[TImageType] of Longint = (0, ILD_MASK); -begin - if HandleAllocated then - DoDraw(Index, Canvas, X, Y, DrawingStyles[DrawingStyle] or - Images[ImageType], Enabled); -end; - -procedure TCustomImageList.DrawOverlay(Canvas: TCanvas; X, Y: Integer; - ImageIndex: Integer; Overlay: TOverlay; Enabled: Boolean); -const - Images: array[TImageType] of Longint = (0, ILD_MASK); -var - Index: Integer; -begin - if HandleAllocated then - begin - Index := IndexToOverlayMask(Overlay + 1); - DoDraw(ImageIndex, Canvas, X, Y, Images[ImageType] or ILD_OVERLAYMASK and - Index, Enabled); - end; -end; - -function TCustomImageList.Overlay(ImageIndex: Integer; Overlay: TOverlay): Boolean; -begin - if HandleAllocated then - Result := ImageList_SetOverlayImage(Handle, ImageIndex, Overlay + 1) - else Result := False; -end; - -procedure TCustomImageList.CopyImages(Value: HImageList); -var - I: Integer; - Image, Mask: TBitmap; - ARect: TRect; -begin - ARect := Rect(0, 0, Width, Height); - BeginUpdate; - try - Image := TBitmap.Create; - try - with Image do - begin - Height := FHeight; - Width := FWidth; - end; - Mask := TBitmap.Create; - try - with Mask do - begin - Monochrome := True; - Height := FHeight; - Width := FWidth; - end; - for I := 0 to ImageList_GetImageCount(Value) - 1 do - begin - with Image.Canvas do - begin - FillRect(ARect); - ImageList_Draw(Value, I, Handle, 0, 0, ILD_NORMAL); - end; - with Mask.Canvas do - begin - FillRect(ARect); - ImageList_Draw(Value, I, Handle, 0, 0, ILD_MASK); - end; - Add(Image, Mask); - end; - finally - Mask.Free; - end; - finally - Image.Free; - end; - finally - EndUpdate; - end; -end; - -procedure TCustomImageList.GetImages(Index: Integer; Image, Mask: TBitmap); -var - R: TRect; -begin - R := Rect(0, 0, Width, Height); - with Image.Canvas do - begin - Brush.Color := clWhite; - FillRect(R); - ImageList_Draw(Self.Handle, Index, Handle, 0, 0, ILD_NORMAL); - end; - with Mask.Canvas do - begin - Brush.Color := clWhite; - FillRect(R); - ImageList_Draw(Self.Handle, Index, Handle, 0, 0, ILD_MASK); - end; -end; - -procedure TCustomImageList.InsertImage(Index: Integer; Image, Mask: TBitmap; - MaskColor: TColor); -var - I: Integer; - OldImage, OldMask: TBitmap; - TempList: TCustomImageList; -begin - BeginUpdate; - try - OldImage := TBitmap.Create; - try - with OldImage do - begin - Height := FHeight; - Width := FWidth; - end; - OldMask := TBitmap.Create; - try - with OldMask do - begin - Monochrome := True; - Height := FHeight; - Width := FWidth; - end; - TempList := TCustomImageList.CreateSize(5, 5); - try - TempList.Assign(Self); - Clear; - if Index > TempList.Count then - raise EInvalidOperation.Create(SImageIndexError); - for I := 0 to Index - 1 do - begin - TempList.GetImages(I, OldImage, OldMask); - Add(OldImage, OldMask); - end; - if MaskColor <> -1 then - AddMasked(Image, MaskColor) else - Add(Image, Mask); - for I := Index to TempList.Count - 1 do - begin - TempList.GetImages(I, OldImage, OldMask); - Add(OldImage, OldMask); - end; - finally - TempList.Free; - end; - finally - OldMask.Free; - end; - finally - OldImage.Free; - end; - finally - EndUpdate; - end; -end; - -procedure TCustomImageList.Insert(Index: Integer; Image, Mask: TBitmap); -begin - InsertImage(Index, Image, Mask, -1); -end; - -procedure TCustomImageList.InsertMasked(Index: Integer; Image: TBitmap; - MaskColor: TColor); -begin - InsertImage(Index, Image, nil, MaskColor); -end; - -procedure TCustomImageList.InsertIcon(Index: Integer; Image: TIcon); -var - I: Integer; - TempList: TCustomImageList; - Icon: TIcon; -begin - Icon := TIcon.Create; - TempList := TCustomImageList.CreateSize(5, 5); - TempList.Assign(Self); - Clear; - if Index > TempList.Count then raise EInvalidOperation.Create(SImageIndexError); - BeginUpdate; - try - for I := 0 to Index - 1 do - begin - TempList.GetIcon(I, Icon); - AddIcon(Icon); - end; - AddIcon(Image); - for I := Index to TempList.Count - 1 do - begin - TempList.GetIcon(I, Icon); - AddIcon(Icon); - end; - finally - TempList.Free; - EndUpdate; - end; -end; - -procedure TCustomImageList.Move(CurIndex, NewIndex: Integer); -var - Image, Mask: TBitmap; -begin - if CurIndex <> NewIndex then - begin - Image := TBitmap.Create; - try - with Image do - begin - Height := FHeight; - Width := FWidth; - end; - Mask := TBitmap.Create; - try - with Mask do - begin - Height := FHeight; - Width := FWidth; - end; - GetImages(CurIndex, Image, Mask); - Delete(CurIndex); - Insert(NewIndex, Image, Mask); - finally - Mask.Free; - end; - finally - Image.Free; - end; - end; -end; - -procedure TCustomImageList.AddImages(Value: TCustomImageList); -begin - if Value <> nil then CopyImages(Value.Handle); -end; - -procedure TCustomImageList.Assign(Source: TPersistent); -var - ImageList: TCustomImageList; -begin - if Source = nil then FreeHandle - else if Source is TCustomImageList then - begin - Clear; - ImageList := TCustomImageList(Source); - Masked := ImageList.Masked; - ImageType := ImageList.ImageType; - DrawingStyle := ImageList.DrawingStyle; - ShareImages := ImageList.ShareImages; - SetNewDimensions(ImageList.Handle); - if not HandleAllocated then HandleNeeded - else ImageList_SetIconSize(Handle, Width, Height); - BkColor := GetColor(ImageList_GetBkColor(ImageList.Handle)); - BlendColor := ImageList.BlendColor; - AddImages(ImageList); - end - else inherited Assign(Source); -end; - -procedure TCustomImageList.AssignTo(Dest: TPersistent); -var - ImageList: TCustomImageList; -begin - if Dest is TCustomImageList then - begin - ImageList := TCustomImageList(Dest); - ImageList.Masked := Masked; - ImageList.ImageType := ImageType; - ImageList.DrawingStyle := DrawingStyle; - ImageList.ShareImages := ShareImages; - ImageList.BlendColor := BlendColor; - with ImageList do - begin - Clear; - SetNewDimensions(Self.Handle); - if not HandleAllocated then HandleNeeded - else ImageList_SetIconSize(Handle, Width, Height); - BkColor := GetColor(ImageList_GetBkColor(Self.Handle)); - AddImages(Self); - end; - end - else inherited AssignTo(Dest); -end; - -procedure TCustomImageList.CheckImage(Image: TGraphic); -begin - if Image = nil then Exit; - with Image do - if (Height < FHeight) or (Width < FWidth) then - raise EInvalidOperation.Create(SInvalidImageSize); -end; - -procedure TCustomImageList.SetDrawingStyle(Value: TDrawingStyle); -begin - if Value <> DrawingStyle then - begin - FDrawingStyle := Value; - Change; - end; -end; - -function TCustomImageList.GetHotSpot: TPoint; -begin - Result := Point(0, 0); -end; - -function TCustomImageList.GetInstRes(Instance: THandle; ResType: TResType; - Name: string; Width: Integer; LoadFlags: TLoadResources; MaskColor: TColor): - Boolean; -const - ResMap: array [TResType] of Integer = (IMAGE_BITMAP, IMAGE_CURSOR, IMAGE_ICON); -var - hImage: HImageList; - Flags: Integer; -begin - Flags := 0; - if lrDefaultColor in LoadFlags then Flags := Flags or LR_DEFAULTCOLOR; - if lrDefaultSize in LoadFlags then Flags := Flags or LR_DEFAULTSIZE; - if lrFromFile in LoadFlags then Flags := Flags or LR_LOADFROMFILE; - if lrMap3DColors in LoadFlags then Flags := Flags or LR_LOADMAP3DCOLORS; - if lrTransparent in LoadFlags then Flags := Flags or LR_LOADTRANSPARENT; - if lrMonoChrome in LoadFlags then Flags := Flags or LR_MONOCHROME; - hImage := ImageList_LoadImage(Instance, PChar(Name), Width, AllocBy, - MaskColor, ResMap[ResType], Flags); - if hImage <> 0 then - begin - CopyImages(hImage); - ImageList_Destroy(hImage); - Result := True; - end - else Result := False; -end; - -function TCustomImageList.GetResource(ResType: TResType; Name: string; - Width: Integer; LoadFlags: TLoadResources; MaskColor: TColor): Boolean; -begin - Result := GetInstRes(MainInstance, ResType, Name, Width, LoadFlags, MaskColor); -end; - -function TCustomImageList.ResInstLoad(Instance: THandle; ResType: TResType; - Name: string; MaskColor: TColor): Boolean; -begin - Result := GetInstRes(Instance, ResType, Name, Width, [], MaskColor); -end; - -function TCustomImageList.ResourceLoad(ResType: TResType; Name: string; - MaskColor: TColor): Boolean; -var - LibModule: PLibModule; -begin - Result := False; - if HInstance = MainInstance then - Result := GetInstRes(MainInstance, ResType, Name, Width, [], MaskColor) - else - begin - LibModule := LibModuleList; - while LibModule <> nil do - with LibModule^ do - begin - Result := GetInstRes(ResInstance, ResType, Name, Width, [], MaskColor); - if not Result and (Instance <> ResInstance) then - Result := GetInstRes(Instance, ResType, Name, Width, [], MaskColor); - if Result then Exit; - LibModule := LibModule.Next; - end; - end; -end; - -function TCustomImageList.FileLoad(ResType: TResType; Name: string; - MaskColor: TColor): Boolean; -begin - Result := GetResource(ResType, Name, Width, [lrFromFile], MaskColor); -end; - -procedure TCustomImageList.Change; -var - I: Integer; -begin - FChanged := True; - if FUpdateCount > 0 then Exit; - if FClients <> nil then - for I := 0 to FClients.Count - 1 do - TChangeLink(FClients[I]).Change; - if Assigned(FOnChange) then FOnChange(Self); -end; - -procedure TCustomImageList.UnRegisterChanges(Value: TChangeLink); -var - I: Integer; -begin - if FClients <> nil then - for I := 0 to FClients.Count - 1 do - if FClients[I] = Value then - begin - Value.Sender := nil; - FClients.Delete(I); - Break; - end; -end; - -procedure TCustomImageList.RegisterChanges(Value: TChangeLink); -begin - Value.Sender := Self; - if FClients <> nil then FClients.Add(Value); -end; - -function TCustomImageList.Equal(IL: TCustomImageList): Boolean; - - function StreamsEqual(S1, S2: TMemoryStream): Boolean; - begin - Result := (S1.Size = S2.Size) and CompareMem(S1.Memory, S2.Memory, S1.Size); - end; - -var - MyImage, OtherImage: TMemoryStream; -begin - if (IL = nil) or (Count <> IL.Count) then - begin - Result := False; - Exit; - end; - if (Count = 0) and (IL.Count = 0) then - begin - Result := True; - Exit; - end; - MyImage := TMemoryStream.Create; - try - WriteData(MyImage); - OtherImage := TMemoryStream.Create; - try - IL.WriteData(OtherImage); - Result := StreamsEqual(MyImage, OtherImage); - finally - OtherImage.Free; - end; - finally - MyImage.Free; - end; -end; - -procedure TCustomImageList.DefineProperties(Filer: TFiler); - - function DoWrite: Boolean; - begin - if Filer.Ancestor <> nil then - Result := not (Filer.Ancestor is TCustomImageList) or - not Equal(TCustomImageList(Filer.Ancestor)) - else - Result := Count > 0; - end; - -begin - inherited DefineProperties(Filer); - Filer.DefineBinaryProperty('Bitmap', ReadData, WriteData, DoWrite); -end; - -procedure TCustomImageList.ReadD2Stream(Stream: TStream); -var - FullImage, Image, FullMask, Mask: TBitmap; - I, J, Size, Pos, Count: Integer; - SrcRect: TRect; -begin - Stream.ReadBuffer(Size, SizeOf(Size)); - Stream.ReadBuffer(Count, SizeOf(Count)); - FullImage := TBitmap.Create; - try - Pos := Stream.Position; - FullImage.LoadFromStream(Stream); - Stream.Position := Pos + Size; - FullMask := TBitmap.Create; - try - FullMask.LoadFromStream(Stream); - Image := TBitmap.Create; - Image.Width := Width; - Image.Height := Height; - Mask := TBitmap.Create; - Mask.Monochrome := True; - Mask.Width := Width; - Mask.Height := Height; - SrcRect := Rect(0, 0, Width, Height); - BeginUpdate; - try - for J := 0 to (FullImage.Height div Height) - 1 do - begin - if Count = 0 then Break; - for I := 0 to (FullImage.Width div Width) - 1 do - begin - if Count = 0 then Break; - Image.Canvas.CopyRect(SrcRect, FullImage.Canvas, - Bounds(I * Width, J * Height, Width, Height)); - Mask.Canvas.CopyRect(SrcRect, FullMask.Canvas, - Bounds(I * Width, J * Height, Width, Height)); - Add(Image, Mask); - Dec(Count); - end; - end; - finally - Image.Free; - Mask.Free; - EndUpdate; - end; - finally - FullMask.Free; - end; - finally - FullImage.Free; - end; -end; - -procedure TCustomImageList.ReadD3Stream(Stream: TStream); -var - SA: TStreamAdapter; -begin - SA := TStreamAdapter.Create(Stream); - try - Handle := ImageList_Read(SA); - if Handle = 0 then - raise EReadError.Create(SImageReadFail); - finally - SA.Free; - end; -end; - -procedure TCustomImageList.ReadData(Stream: TStream); -var - CheckInt1, CheckInt2: Integer; - CheckByte1, CheckByte2: Byte; - StreamPos: Integer; -begin - FreeHandle; - StreamPos := Stream.Position; // check stream signature to - Stream.Read(CheckInt1, SizeOf(CheckInt1)); // determine a Delphi 2 or Delphi - Stream.Read(CheckInt2, SizeOf(CheckInt2)); // 3 imagelist stream. Delphi 2 - CheckByte1 := Lo(LoWord(CheckInt1)); // streams can be read, but only - CheckByte2 := Hi(LoWord(CheckInt1)); // Delphi 3 streams will be written - Stream.Position := StreamPos; - if (CheckInt1 <> CheckInt2) and (CheckByte1 = $49) and (CheckByte2 = $4C) then - ReadD3Stream(Stream) - else - ReadD2Stream(Stream); -end; - -procedure TCustomImageList.WriteData(Stream: TStream); -var - SA: TStreamAdapter; -begin - SA := TStreamAdapter.Create(Stream); - try - if not ImageList_Write(Handle, SA) then - raise EWriteError.Create(SImageWriteFail); - finally - SA.Free; - end; -end; -(* -var - I: Integer; - DIB1, DIB2: TBitmap; - DC: HDC; - S: TMemoryStream; - - procedure WriteDIB(BM: HBitmap); - { The ImageList leaves its bitmap handle selected into a DC somewhere, - so we can't select it into our own DC to copy from it. The only safe - operation is GetDIB (GetDIBits), which extracts the pixel bits without - selecting the BM into a DC. This code builds our own bitmap from - those bits, then crops it to the minimum size before writing it out.} - var - BitsSize: DWORD; - Header, Bits: PChar; - DIBBits: Pointer; - R: TRect; - HeaderSize: DWORD; - GlyphsPerRow, Rows: Integer; - begin - if BM = 0 then Exit; - GetDIBSizes(BM, HeaderSize, BitsSize); - GetMem(Header, HeaderSize + BitsSize); - try - Bits := Header + HeaderSize; - GetDIB(BM, 0, Header^, Bits^); - DIB1.Handle := CreateDIBSection(DC, PBitmapInfo(Header)^, DIB_RGB_COLORS, DIBBits, 0, 0); - System.Move(Bits^, DIBBits^, BitsSize); - with PBitmapInfo(Header)^.bmiHeader do - begin - GlyphsPerRow := biWidth div Width; - if GlyphsPerRow = 0 then Inc(GlyphsPerRow); - if GlyphsPerRow > Count then GlyphsPerRow := Count; - biWidth := GlyphsPerRow * Width; - Rows := Count div GlyphsPerRow; - if Count > Rows * GlyphsPerRow then Inc(Rows); - biHeight := Rows * Height; - R := Rect(0, 0, biWidth, biHeight); - end; - DIB2.Handle := CreateDIBSection(DC, PBitmapInfo(Header)^, DIB_RGB_COLORS, DIBBits, 0, 0); - DIB2.Canvas.CopyRect(R, DIB1.Canvas, R); - DIB2.SaveToStream(S); - finally - FreeMem(Header); - end; - end; - -begin - DIB1 := nil; - DIB2 := nil; - DC := 0; - S := TMemoryStream.Create; - try - DIB1 := TBitmap.Create; - DIB2 := TBitmap.Create; - DC := GetDC(0); - WriteDIB(GetImageBitmap); - I := S.Size; - WriteDIB(GetMaskBitmap); - Stream.WriteBuffer(I, sizeof(I)); - I := Count; - Stream.WriteBuffer(I, sizeof(I)); - Stream.WriteBuffer(S.Memory^, S.Size); - finally - ReleaseDC(0, DC); - DIB1.Free; - DIB2.Free; - S.Free; - end; -end; -*) -procedure TCustomImageList.BeginUpdate; -begin - Inc(FUpdateCount); -end; - -procedure TCustomImageList.EndUpdate; -begin - if FUpdateCount > 0 then Dec(FUpdateCount); - if FChanged then - begin - FChanged := False; - Change; - end; -end; -*/ diff --git a/apps/X11/VCL/TCustomImageList.h b/apps/X11/VCL/TCustomImageList.h deleted file mode 100644 index b9b7cab..0000000 --- a/apps/X11/VCL/TCustomImageList.h +++ /dev/null @@ -1,136 +0,0 @@ - -#ifndef TCUSTOMIMAGELIST_H -#define TCUSTOMIMAGELIST_H - -#include <TComponent.h> -#include <vector> -#include <gtk/gtkpixmap.h> - -class TCustomImageList : public TComponent { -/* - - TDrawingStyle = (dsFocus, dsSelected, dsNormal, dsTransparent); - TImageType = (itImage, itMask); - TResType = (rtBitmap, rtCursor, rtIcon); - TOverlay = 0..3; - TLoadResource = (lrDefaultColor, lrDefaultSize, lrFromFile, - lrMap3DColors, lrTransparent, lrMonoChrome); - TLoadResources = set of TLoadResource; - - TCustomImageList = class(TComponent) -*/ -private: - vector <GtkPixmap *> images; -/* - FHeight: Integer; - FWidth: Integer; - FAllocBy: Integer; - FHandle: HImageList; - FDrawingStyle: TDrawingStyle; - FMasked: Boolean; - FShareImages: Boolean; - FImageType: TImageType; - FBkColor: TColor; - FBlendColor: TColor; - FClients: TList; - FBitmap: TBitmap; - FMonoBitmap: TBitmap; - FChanged: Boolean; - FUpdateCount: Integer; - FOnChange: TNotifyEvent; - procedure AssignTo(Dest: TPersistent); override; - procedure BeginUpdate; - procedure EndUpdate; - procedure InitBitmap; - procedure CheckImage(Image: TGraphic); - procedure CopyImages(Value: HImageList); - procedure CreateImageList; - function Equal(IL: TCustomImageList): Boolean; - procedure FreeHandle; - function GetCount: Integer; - function GetBitmapHandle(Bitmap: HBITMAP): HBITMAP; - function GetBkColor: TColor; - function GetHandle: HImageList; - function GetImageHandle(Image, ImageDDB: TBitmap): HBITMAP; - procedure InsertImage(Index: Integer; Image, Mask: TBitmap; MaskColor: TColor); - procedure ReadData(Stream: TStream); - procedure SetBkColor(Value: TColor); - procedure SetDrawingStyle(Value: TDrawingStyle); - procedure SetHandle(Value: HImageList); - procedure SetHeight(Value: Integer); - procedure SetNewDimensions(Value: HImageList); - procedure SetWidth(Value: Integer); - procedure WriteData(Stream: TStream); - procedure ReadD2Stream(Stream: TStream); - procedure ReadD3Stream(Stream: TStream); - protected - procedure Change; dynamic; - procedure DefineProperties(Filer: TFiler); override; - procedure DoDraw(Index: Integer; Canvas: TCanvas; X, Y: Integer; - Style: Cardinal; Enabled: Boolean); virtual; - procedure GetImages(Index: Integer; Image, Mask: TBitmap); - procedure HandleNeeded; - procedure Initialize; virtual; -*/ -public: - TCustomImageList(TComponent *AOwner); - TCustomImageList(int AWidth, int AHeight); - virtual ~TCustomImageList(); -// int Add(TBitmap *Image, TBitmap *Mask); - int Add(gchar **xpm_data, GtkWidget *canvas); -// procedure GetBitmap(Index: Integer; Image: TBitmap); -// void GetBitmap(int Index, TBitmap *); - GtkPixmap *GetPixmap(int Index); -/* - procedure Assign(Source: TPersistent); override; - function AddIcon(Image: TIcon): Integer; - procedure AddImages(Value: TCustomImageList); - function AddMasked(Image: TBitmap; MaskColor: TColor): Integer; - procedure Clear; - procedure Delete(Index: Integer); - procedure Draw(Canvas: TCanvas; X, Y, Index: Integer; Enabled: Boolean=True); - procedure DrawOverlay(Canvas: TCanvas; X, Y: Integer; - ImageIndex: Integer; Overlay: TOverlay; Enabled: Boolean=True); - function FileLoad(ResType: TResType; Name: string; - MaskColor: TColor): Boolean; - function GetHotSpot: TPoint; virtual; - procedure GetIcon(Index: Integer; Image: TIcon); - function GetImageBitmap: HBITMAP; - function GetMaskBitmap: HBITMAP; - function GetResource(ResType: TResType; Name: string; - Width: Integer; LoadFlags: TLoadResources; MaskColor: TColor): Boolean; - function GetInstRes(Instance: THandle; ResType: TResType; Name: string; - Width: Integer; LoadFlags: TLoadResources; MaskColor: TColor): Boolean; - function HandleAllocated: Boolean; - procedure Insert(Index: Integer; Image, Mask: TBitmap); - procedure InsertIcon(Index: Integer; Image: TIcon); - procedure InsertMasked(Index: Integer; Image: TBitmap; MaskColor: TColor); - procedure Move(CurIndex, NewIndex: Integer); - function Overlay(ImageIndex: Integer; Overlay: TOverlay): Boolean; - procedure RegisterChanges(Value: TChangeLink); - function ResourceLoad(ResType: TResType; Name: string; - MaskColor: TColor): Boolean; - function ResInstLoad(Instance: THandle; ResType: TResType; Name: string; - MaskColor: TColor): Boolean; - procedure Replace(Index: Integer; Image, Mask: TBitmap); - procedure ReplaceIcon(Index: Integer; Image: TIcon); - procedure ReplaceMasked(Index: Integer; NewImage: TBitmap; MaskColor: TColor); - procedure UnRegisterChanges(Value: TChangeLink); - property Count: Integer read GetCount; - property Handle: HImageList read GetHandle write SetHandle; - public - property AllocBy: Integer read FAllocBy write FAllocBy default 4; - property BlendColor: TColor read FBlendColor write FBlendColor default clNone; - property BkColor: TColor read GetBkColor write SetBkColor default clNone; - property DrawingStyle: TDrawingStyle read FDrawingStyle write SetDrawingStyle default dsNormal; - property Height: Integer read FHeight write SetHeight default 16; - property ImageType: TImageType read FImageType write FImageType default itImage; - property Masked: Boolean read FMasked write FMasked default True; - property ShareImages: Boolean read FShareImages write FShareImages default False; - property Width: Integer read FWidth write SetWidth default 16; - property OnChange: TNotifyEvent read FOnChange write FOnChange; - end; -*/ -}; - -#endif diff --git a/apps/X11/VCL/TCustomTabControl.cpp b/apps/X11/VCL/TCustomTabControl.cpp deleted file mode 100644 index 40f9c3e..0000000 --- a/apps/X11/VCL/TCustomTabControl.cpp +++ /dev/null @@ -1,7 +0,0 @@ -#include <TCustomTabControl.h> - -TCustomTabControl::TCustomTabControl(TComponent *AOwner) : TWinControl(AOwner) { -} - -TCustomTabControl::~TCustomTabControl() { -} diff --git a/apps/X11/VCL/TCustomTabControl.h b/apps/X11/VCL/TCustomTabControl.h deleted file mode 100644 index 0b1e2b7..0000000 --- a/apps/X11/VCL/TCustomTabControl.h +++ /dev/null @@ -1,103 +0,0 @@ -#ifndef TCUSTOMTABCONTROL_H -#define TCUSTOMTABCONTROL_H - -#include <TWinControl.h> - -class TCustomTabControl : public TWinControl { - -private: -/* - FCanvas: TCanvas; - FHotTrack: Boolean; - FImageChangeLink: TChangeLink; - FImages: TCustomImageList; - FMultiLine: Boolean; - FMultiSelect: Boolean; - FOwnerDraw: Boolean; - FRaggedRight: Boolean; - FSaveTabIndex: Integer; - FSaveTabs: TStringList; - FScrollOpposite: Boolean; - FStyle: TTabStyle; - FTabPosition: TTabPosition; - FTabs: TStrings; - FTabSize: TSmallPoint; - FUpdating: Boolean; - FOnChange: TNotifyEvent; - FOnChanging: TTabChangingEvent; - FOnDrawTab: TDrawTabEvent; - FOnGetImageIndex: TTabGetImageEvent; - function GetDisplayRect: TRect; - function GetTabIndex: Integer; - procedure ImageListChange(Sender: TObject); - function InternalSetMultiLine(Value: Boolean): Boolean; - procedure SetHotTrack(Value: Boolean); - procedure SetImages(Value: TCustomImageList); - procedure SetMultiLine(Value: Boolean); - procedure SetMultiSelect(Value: Boolean); - procedure SetOwnerDraw(Value: Boolean); - procedure SetRaggedRight(Value: Boolean); - procedure SetScrollOpposite(Value: Boolean); - procedure SetStyle(Value: TTabStyle); - procedure SetTabHeight(Value: Smallint); - procedure SetTabIndex(Value: Integer); - procedure SetTabPosition(Value: TTabPosition); - procedure SetTabs(Value: TStrings); - procedure SetTabWidth(Value: Smallint); - procedure TabsChanged; - procedure UpdateTabSize; - procedure CMFontChanged(var Message); message CM_FONTCHANGED; - procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE; - procedure CMTabStopChanged(var Message: TMessage); message CM_TABSTOPCHANGED; - procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY; - procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR; - procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM; - procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY; - procedure WMNotifyFormat(var Message: TMessage); message WM_NOTIFYFORMAT; - procedure WMSize(var Message: TMessage); message WM_SIZE; - protected - procedure AdjustClientRect(var Rect: TRect); override; - function CanChange: Boolean; dynamic; - function CanShowTab(TabIndex: Integer): Boolean; virtual; - procedure Change; dynamic; - procedure CreateParams(var Params: TCreateParams); override; - procedure CreateWnd; override; - procedure DestroyWnd; override; - procedure DrawTab(TabIndex: Integer; const Rect: TRect; Active: Boolean); virtual; - function GetImageIndex(TabIndex: Integer): Integer; virtual; - procedure Loaded; override; - procedure UpdateTabImages; - property DisplayRect: TRect read GetDisplayRect; - property HotTrack: Boolean read FHotTrack write SetHotTrack default False; - property Images: TCustomImageList read FImages write SetImages; - property MultiLine: Boolean read FMultiLine write SetMultiLine default False; - property MultiSelect: Boolean read FMultiSelect write SetMultiSelect default False; - procedure Notification(AComponent: TComponent; Operation: TOperation); override; - property OwnerDraw: Boolean read FOwnerDraw write SetOwnerDraw default False; - property RaggedRight: Boolean read FRaggedRight write SetRaggedRight default False; - property ScrollOpposite: Boolean read FScrollOpposite - write SetScrollOpposite default False; - property Style: TTabStyle read FStyle write SetStyle default tsTabs; - property TabHeight: Smallint read FTabSize.Y write SetTabHeight default 0; - property TabIndex: Integer read GetTabIndex write SetTabIndex default -1; - property TabPosition: TTabPosition read FTabPosition write SetTabPosition - default tpTop; - property Tabs: TStrings read FTabs write SetTabs; - property TabWidth: Smallint read FTabSize.X write SetTabWidth default 0; - property OnChange: TNotifyEvent read FOnChange write FOnChange; - property OnChanging: TTabChangingEvent read FOnChanging write FOnChanging; - property OnDrawTab: TDrawTabEvent read FOnDrawTab write FOnDrawTab; - property OnGetImageIndex: TTabGetImageEvent read FOnGetImageIndex write FOnGetImageIndex; -*/ -public: - TCustomTabControl(TComponent *AOwner); - ~TCustomTabControl(); -/* - property Canvas: TCanvas read FCanvas; - property TabStop default True; - end; -*/ -}; - -#endif - diff --git a/apps/X11/VCL/TCustomTreeView.cpp b/apps/X11/VCL/TCustomTreeView.cpp deleted file mode 100644 index 18e4c29..0000000 --- a/apps/X11/VCL/TCustomTreeView.cpp +++ /dev/null @@ -1,1169 +0,0 @@ -#include <TCustomTreeView.h> -#include <TTreeNodes.h> - -TCustomTreeView::TCustomTreeView(TComponent *AOwner) : - TWinControl(AOwner), - Items(this, &TCustomTreeView::getItems, &TCustomTreeView::SetTreeNodes), - Images(this, &TCustomTreeView::getImages, &TCustomTreeView::SetImages), - StateImages(this, &TCustomTreeView::getStateImages, &TCustomTreeView::SetStateImages), - Selected(this, &TCustomTreeView::GetSelection, &TCustomTreeView::SetSelection) { - init(AOwner); -} - - -TCustomTreeView::TCustomTreeView(GtkWidget *parent) : - TWinControl(parent), - Items(this, &TCustomTreeView::getItems, &TCustomTreeView::SetTreeNodes), - Images(this, &TCustomTreeView::getImages, &TCustomTreeView::SetImages), - StateImages(this, &TCustomTreeView::getStateImages, &TCustomTreeView::SetStateImages), - Selected(this, &TCustomTreeView::GetSelection, &TCustomTreeView::SetSelection) { - nativeControl = gtk_tree_new(); -/* - gtk_widget_ref (nativeControl); - gtk_object_set_data_full (GTK_OBJECT (InstallMgrApp), "LocalTree", LocalTree, - (GtkDestroyNotify) gtk_widget_unref); -*/ - gtk_widget_show (nativeControl); - gtk_container_add (GTK_CONTAINER (parent), nativeControl); - init(0); -} - -TCustomTreeView::~TCustomTreeView() { -} - -void TCustomTreeView::init(TComponent *AOwner) { -/* - ControlStyle := ControlStyle - [csCaptureMouse] + [csDisplayDragImage, csReflector]; - Width := 121; - Height := 97; - TabStop := True; - ParentColor := False; - FCanvas := TControlCanvas.Create; - TControlCanvas(FCanvas).Control := Self; -*/ -// FTreeNodes := TTreeNodes.Create(Self); - FTreeNodes = new TTreeNodes(this); -/* - FBorderStyle := bsSingle; - FShowButtons := True; - FShowRoot := True; - FShowLines := True; - FHideSelection := True; - FDragImage := TDragImageList.CreateSize(32, 32); - FSaveIndent := -1; - FChangeTimer := TTimer.Create(Self); - FChangeTimer.Enabled := False; - FChangeTimer.Interval := 0; - FChangeTimer.OnTimer := OnChangeTimer; - FToolTips := True; - FEditInstance := MakeObjectInstance(EditWndProc); - FImageChangeLink := TChangeLink.Create; - FImageChangeLink.OnChange := ImageListChange; - FStateChangeLink := TChangeLink.Create; - FStateChangeLink.OnChange := ImageListChange; -*/ -} - - -/* -procedure TCustomTreeView.SetTreeNodes(Value: TTreeNodes); -begin - Items.Assign(Value); -end; -*/ - -void TCustomTreeView::SetTreeNodes(TTreeNodes* Value) { -// Items->Assign(Value); -} - -/* -procedure TCustomTreeView.GetSelectedIndex(Node: TTreeNode); -begin - if Assigned(FOnGetSelectedIndex) then FOnGetSelectedIndex(Self, Node); -end; - -TTreeNode *TCustomTreeView::GetSelected() { -} - -*/ - -/* -function TCustomTreeView.GetSelection: TTreeNode; -begin - if HandleAllocated then - begin - if FRightClickSelect and Assigned(FRClickNode) then - Result := FRClickNode - else - Result := Items.GetNode(TreeView_GetSelection(Handle)); - end - else Result := nil; -end; - -procedure TCustomTreeView.SetSelection(Value: TTreeNode); -begin - if Value <> nil then Value.Selected := True - else TreeView_SelectItem(Handle, nil); -end; -*/ - -TTreeNode *TCustomTreeView::GetSelection() { - GList *selected_nodes = GTK_TREE_SELECTION (nativeControl); - selected_nodes = g_list_first(selected_nodes); - return (selected_nodes) ? Items->GetNode(GTK_TREE_ITEM(selected_nodes->data)) : 0; -} - -void TCustomTreeView::SetSelection(TTreeNode *node) { -} - - -/* -procedure TCustomTreeView.SetImages(Value: TCustomImageList); -begin - if Images <> nil then - Images.UnRegisterChanges(FImageChangeLink); - FImages := Value; - if Images <> nil then - begin - Images.RegisterChanges(FImageChangeLink); - Images.FreeNotification(Self); - SetImageList(Images.Handle, TVSIL_NORMAL) - end - else SetImageList(0, TVSIL_NORMAL); -end; - -procedure TCustomTreeView.SetStateImages(Value: TCustomImageList); -begin - if StateImages <> nil then - StateImages.UnRegisterChanges(FStateChangeLink); - FStateImages := Value; - if StateImages <> nil then - begin - StateImages.RegisterChanges(FStateChangeLink); - StateImages.FreeNotification(Self); - SetImageList(StateImages.Handle, TVSIL_STATE) - end - else SetImageList(0, TVSIL_STATE); -end; -*/ - -void TCustomTreeView::SetImages(TCustomImageList *images) { - FImages = images; -} - -void TCustomTreeView::SetStateImages(TCustomImageList *images) { - FStateImages = images; -} - - -/* -{ TCustomTreeView } -destructor TCustomTreeView.Destroy; -begin - Items.Free; - FChangeTimer.Free; - FSaveItems.Free; - FDragImage.Free; - FMemStream.Free; - FreeObjectInstance(FEditInstance); - FImageChangeLink.Free; - FStateChangeLink.Free; - FCanvas.Free; - inherited Destroy; -end; - -procedure TCustomTreeView.CreateParams(var Params: TCreateParams); -const - BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER); - LineStyles: array[Boolean] of DWORD = (0, TVS_HASLINES); - RootStyles: array[Boolean] of DWORD = (0, TVS_LINESATROOT); - ButtonStyles: array[Boolean] of DWORD = (0, TVS_HASBUTTONS); - EditStyles: array[Boolean] of DWORD = (TVS_EDITLABELS, 0); - HideSelections: array[Boolean] of DWORD = (TVS_SHOWSELALWAYS, 0); - DragStyles: array[TDragMode] of DWORD = (TVS_DISABLEDRAGDROP, 0); - RTLStyles: array[Boolean] of DWORD = (0, TVS_RTLREADING); - ToolTipStyles: array[Boolean] of DWORD = (TVS_NOTOOLTIPS, 0); - AutoExpandStyles: array[Boolean] of DWORD = (0, TVS_SINGLEEXPAND); - HotTrackStyles: array[Boolean] of DWORD = (0, TVS_TRACKSELECT); - RowSelectStyles: array[Boolean] of DWORD = (0, TVS_FULLROWSELECT); -begin - InitCommonControl(ICC_TREEVIEW_CLASSES); - inherited CreateParams(Params); - CreateSubClass(Params, WC_TREEVIEW); - with Params do - begin - Style := Style or LineStyles[FShowLines] or BorderStyles[FBorderStyle] or - RootStyles[FShowRoot] or ButtonStyles[FShowButtons] or - EditStyles[FReadOnly] or HideSelections[FHideSelection] or - DragStyles[DragMode] or RTLStyles[UseRightToLeftReading] or - ToolTipStyles[FToolTips] or AutoExpandStyles[FAutoExpand] or - HotTrackStyles[FHotTrack] or RowSelectStyles[FRowSelect]; - if Ctl3D and NewStyleControls and (FBorderStyle = bsSingle) then - begin - Style := Style and not WS_BORDER; - ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE; - end; - WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW); - end; -end; - -procedure TCustomTreeView.CreateWnd; -begin - FStateChanging := False; - inherited CreateWnd; - TreeView_SetBkColor(Handle, ColorToRGB(Color)); - TreeView_SetTextColor(Handle, ColorToRGB(Font.Color)); - if FMemStream <> nil then - begin - Items.ReadData(FMemStream); - FMemStream.Destroy; - FMemStream := nil; - SetTopItem(Items.GetNodeFromIndex(FSaveTopIndex)); - FSaveTopIndex := 0; - SetSelection(Items.GetNodeFromIndex(FSaveIndex)); - FSaveIndex := 0; - end; - if FSaveIndent <> -1 then Indent := FSaveIndent; - if (Images <> nil) and Images.HandleAllocated then - SetImageList(Images.Handle, TVSIL_NORMAL); - if (StateImages <> nil) and StateImages.HandleAllocated then - SetImageList(StateImages.Handle, TVSIL_STATE); -end; - -procedure TCustomTreeView.DestroyWnd; -var - Node: TTreeNode; -begin - FStateChanging := True; - if Items.Count > 0 then - begin - FMemStream := TMemoryStream.Create; - Items.WriteData(FMemStream); - FMemStream.Position := 0; - Node := GetTopItem; - if Node <> nil then FSaveTopIndex := Node.AbsoluteIndex; - Node := Selected; - if Node <> nil then FSaveIndex := Node.AbsoluteIndex; - end; - FSaveIndent := Indent; - inherited DestroyWnd; -end; - -procedure TCustomTreeView.EditWndProc(var Message: TMessage); -begin - try - with Message do - begin - case Msg of - WM_KEYDOWN, - WM_SYSKEYDOWN: if DoKeyDown(TWMKey(Message)) then Exit; - WM_CHAR: if DoKeyPress(TWMKey(Message)) then Exit; - WM_KEYUP, - WM_SYSKEYUP: if DoKeyUp(TWMKey(Message)) then Exit; - CN_KEYDOWN, - CN_CHAR, CN_SYSKEYDOWN, - CN_SYSCHAR: - begin - WndProc(Message); - Exit; - end; - end; - Result := CallWindowProc(FDefEditProc, FEditHandle, Msg, WParam, LParam); - end; - except - Application.HandleException(Self); - end; -end; - -procedure TCustomTreeView.CMColorChanged(var Message: TMessage); -begin - inherited; - RecreateWnd; -end; - -procedure TCustomTreeView.CMCtl3DChanged(var Message: TMessage); -begin - inherited; - if FBorderStyle = bsSingle then RecreateWnd; -end; - -procedure TCustomTreeView.CMFontChanged(var Message: TMessage); -begin - inherited; - TreeView_SetTextColor(Handle, ColorToRGB(Font.Color)); -end; - -procedure TCustomTreeView.CMSysColorChange(var Message: TMessage); -begin - inherited; - if not (csLoading in ComponentState) then - begin - Message.Msg := WM_SYSCOLORCHANGE; - DefaultHandler(Message); - end; -end; - -function TCustomTreeView.AlphaSort: Boolean; -var - Node: TTreeNode; -begin - if HandleAllocated then - begin - Result := CustomSort(nil, 0); - Node := FTreeNodes.GetFirstNode; - while Node <> nil do - begin - if Node.HasChildren then Node.AlphaSort; - Node := Node.GetNext; - end; - end - else - Result := False; -end; - -function TCustomTreeView.CustomSort(SortProc: TTVCompare; Data: Longint): Boolean; -var - SortCB: TTVSortCB; - Node: TTreeNode; -begin - Result := False; - if HandleAllocated then - begin - with SortCB do - begin - if not Assigned(SortProc) then lpfnCompare := @DefaultTreeViewSort - else lpfnCompare := SortProc; - hParent := TVI_ROOT; - lParam := Data; - Result := TreeView_SortChildrenCB(Handle, SortCB, 0); - end; - Node := FTreeNodes.GetFirstNode; - while Node <> nil do - begin - if Node.HasChildren then Node.CustomSort(SortProc, Data); - Node := Node.GetNext; - end; - Items.ClearCache; - end; -end; - -procedure TCustomTreeView.SetAutoExpand(Value: Boolean); -begin - if FAutoExpand <> Value then - begin - FAutoExpand := Value; - SetComCtlStyle(Self, TVS_SINGLEEXPAND, Value); - end; -end; - -procedure TCustomTreeView.SetHotTrack(Value: Boolean); -begin - if FHotTrack <> Value then - begin - FHotTrack := Value; - SetComCtlStyle(Self, TVS_TRACKSELECT, Value); - end; -end; - -procedure TCustomTreeView.SetRowSelect(Value: Boolean); -begin - if FRowSelect <> Value then - begin - FRowSelect := Value; - SetComCtlStyle(Self, TVS_FULLROWSELECT, Value); - end; -end; - -procedure TCustomTreeView.SetToolTips(Value: Boolean); -begin - if FToolTips <> Value then - begin - FToolTips := Value; - SetComCtlStyle(Self, TVS_NOTOOLTIPS, not Value); - end; -end; - -procedure TCustomTreeView.SetSortType(Value: TSortType); -begin - if SortType <> Value then - begin - FSortType := Value; - if ((SortType in [stData, stBoth]) and Assigned(OnCompare)) or - (SortType in [stText, stBoth]) then - AlphaSort; - end; -end; - -procedure TCustomTreeView.SetBorderStyle(Value: TBorderStyle); -begin - if BorderStyle <> Value then - begin - FBorderStyle := Value; - RecreateWnd; - end; -end; - -procedure TCustomTreeView.SetDragMode(Value: TDragMode); -begin - if Value <> DragMode then - SetComCtlStyle(Self, TVS_DISABLEDRAGDROP, Value = dmManual); - inherited; -end; - -procedure TCustomTreeView.SetButtonStyle(Value: Boolean); -begin - if ShowButtons <> Value then - begin - FShowButtons := Value; - SetComCtlStyle(Self, TVS_HASBUTTONS, Value); - end; -end; - -procedure TCustomTreeView.SetLineStyle(Value: Boolean); -begin - if ShowLines <> Value then - begin - FShowLines := Value; - SetComCtlStyle(Self, TVS_HASLINES, Value); - end; -end; - -procedure TCustomTreeView.SetRootStyle(Value: Boolean); -begin - if ShowRoot <> Value then - begin - FShowRoot := Value; - SetComCtlStyle(Self, TVS_LINESATROOT, Value); - end; -end; - -procedure TCustomTreeView.SetReadOnly(Value: Boolean); -begin - if ReadOnly <> Value then - begin - FReadOnly := Value; - SetComCtlStyle(Self, TVS_EDITLABELS, not Value); - end; -end; - -procedure TCustomTreeView.SetHideSelection(Value: Boolean); -begin - if HideSelection <> Value then - begin - FHideSelection := Value; - SetComCtlStyle(Self, TVS_SHOWSELALWAYS, not Value); - Invalidate; - end; -end; - -function TCustomTreeView.GetNodeAt(X, Y: Integer): TTreeNode; -var - HitTest: TTVHitTestInfo; -begin - with HitTest do - begin - pt.X := X; - pt.Y := Y; - if TreeView_HitTest(Handle, HitTest) <> nil then - Result := Items.GetNode(HitTest.hItem) - else Result := nil; - end; -end; - -function TCustomTreeView.GetHitTestInfoAt(X, Y: Integer): THitTests; -var - HitTest: TTVHitTestInfo; -begin - Result := []; - with HitTest do - begin - pt.X := X; - pt.Y := Y; - TreeView_HitTest(Handle, HitTest); - if (flags and TVHT_ABOVE) <> 0 then Include(Result, htAbove); - if (flags and TVHT_BELOW) <> 0 then Include(Result, htBelow); - if (flags and TVHT_NOWHERE) <> 0 then Include(Result, htNowhere); - if (flags and TVHT_ONITEM) = TVHT_ONITEM then - Include(Result, htOnItem) - else - begin - if (flags and TVHT_ONITEM) <> 0 then Include(Result, htOnItem); - if (flags and TVHT_ONITEMICON) <> 0 then Include(Result, htOnIcon); - if (flags and TVHT_ONITEMLABEL) <> 0 then Include(Result, htOnLabel); - if (flags and TVHT_ONITEMSTATEICON) <> 0 then Include(Result, htOnStateIcon); - end; - if (flags and TVHT_ONITEMBUTTON) <> 0 then Include(Result, htOnButton); - if (flags and TVHT_ONITEMINDENT) <> 0 then Include(Result, htOnIndent); - if (flags and TVHT_ONITEMRIGHT) <> 0 then Include(Result, htOnRight); - if (flags and TVHT_TOLEFT) <> 0 then Include(Result, htToLeft); - if (flags and TVHT_TORIGHT) <> 0 then Include(Result, htToRight); - end; -end; - -procedure TCustomTreeView.SetIndent(Value: Integer); -begin - if Value <> Indent then TreeView_SetIndent(Handle, Value); -end; - -function TCustomTreeView.GetIndent: Integer; -begin - Result := TreeView_GetIndent(Handle) -end; - -procedure TCustomTreeView.FullExpand; -var - Node: TTreeNode; -begin - Node := Items.GetFirstNode; - while Node <> nil do - begin - Node.Expand(True); - Node := Node.GetNextSibling; - end; -end; - -procedure TCustomTreeView.FullCollapse; -var - Node: TTreeNode; -begin - Node := Items.GetFirstNode; - while Node <> nil do - begin - Node.Collapse(True); - Node := Node.GetNextSibling; - end; -end; - -procedure TCustomTreeView.Loaded; -begin - inherited Loaded; - if csDesigning in ComponentState then FullExpand; -end; - -function TCustomTreeView.GetTopItem: TTreeNode; -begin - if HandleAllocated then - Result := Items.GetNode(TreeView_GetFirstVisible(Handle)) - else Result := nil; -end; - -procedure TCustomTreeView.SetTopItem(Value: TTreeNode); -begin - if HandleAllocated and (Value <> nil) then - TreeView_SelectSetFirstVisible(Handle, Value.ItemId); -end; - -procedure TCustomTreeView.OnChangeTimer(Sender: TObject); -begin - FChangeTimer.Enabled := False; - Change(TTreeNode(FChangeTimer.Tag)); -end; - -procedure TCustomTreeView.SetChangeDelay(Value: Integer); -begin - FChangeTimer.Interval := Value; -end; - -function TCustomTreeView.GetChangeDelay: Integer; -begin - Result := FChangeTimer.Interval; -end; - -function TCustomTreeView.GetDropTarget: TTreeNode; -begin - if HandleAllocated then - begin - Result := Items.GetNode(TreeView_GetDropHilite(Handle)); - if Result = nil then Result := FLastDropTarget; - end - else Result := nil; -end; - -procedure TCustomTreeView.SetDropTarget(Value: TTreeNode); -begin - if HandleAllocated then - if Value <> nil then Value.DropTarget := True - else TreeView_SelectDropTarget(Handle, nil); -end; - -function TCustomTreeView.GetNodeFromItem(const Item: TTVItem): TTreeNode; -begin - with Item do - if (state and TVIF_PARAM) <> 0 then Result := Pointer(lParam) - else Result := Items.GetNode(hItem); -end; - -function TCustomTreeView.IsEditing: Boolean; -var - ControlHand: HWnd; -begin - ControlHand := TreeView_GetEditControl(Handle); - Result := (ControlHand <> 0) and IsWindowVisible(ControlHand); -end; - -procedure TCustomTreeView.CNNotify(var Message: TWMNotify); -var - Node: TTreeNode; - MousePos: TPoint; - R: TRect; - DefaultDraw: Boolean; - TmpItem: TTVItem; -begin - with Message do - case NMHdr^.code of - NM_CUSTOMDRAW: - with PNMCustomDraw(NMHdr)^ do - begin - Result := CDRF_DODEFAULT; - if dwDrawStage = CDDS_PREPAINT then - begin - if IsCustomDrawn(dtControl, cdPrePaint) then - begin - FCanvas.Handle := hdc; - FCanvas.Font := Font; - FCanvas.Brush := Brush; - R := ClientRect; - DefaultDraw := CustomDraw(R, cdPrePaint); - FCanvas.Handle := 0; - if not DefaultDraw then - begin - Result := CDRF_SKIPDEFAULT; - Exit; - end; - end; - if IsCustomDrawn(dtControl, cdPostPaint) then - Result := CDRF_NOTIFYPOSTPAINT; - if IsCustomDrawn(dtItem, cdPrePaint) then - Result := Result or CDRF_NOTIFYITEMDRAW else - Result := Result or CDRF_DODEFAULT; - end - else if dwDrawStage = CDDS_ITEMPREPAINT then - begin - FillChar(TmpItem, SizeOf(TmpItem), 0); - TmpItem.hItem := HTREEITEM(dwItemSpec); - Node := GetNodeFromItem(TmpItem); - if Node <> nil then - begin - FCanvas.Handle := hdc; - FCanvas.Font := Font; - FCanvas.Brush := Brush; - { Unlike the list view, the tree view doesn't override the text - foreground and background colors of selected items. } - if uItemState and CDIS_SELECTED <> 0 then - begin - FCanvas.Font.Color := clHighlightText; - FCanvas.Brush.Color := clHighlight; - end; - FCanvas.Font.OnChange := CanvasChanged; - FCanvas.Brush.OnChange := CanvasChanged; - DefaultDraw := CustomDrawItem(Node, - TCustomDrawState(Word(uItemState)), cdPrePaint); - if not DefaultDraw then - Result := Result or CDRF_SKIPDEFAULT - else if FCanvasChanged then - begin - FCanvasChanged := False; - FCanvas.Font.OnChange := nil; - FCanvas.Brush.OnChange := nil; - with PNMTVCustomDraw(NMHdr)^ do - begin - clrText := ColorToRGB(FCanvas.Font.Color); - clrTextBk := ColorToRGB(FCanvas.Brush.Color); - SelectObject(hdc, FCanvas.Font.Handle); - Result := Result or CDRF_NEWFONT; - end; - end; - FCanvas.Handle := 0; - if IsCustomDrawn(dtItem, cdPostPaint) then - Result := Result or CDRF_NOTIFYPOSTPAINT; - end; - end; - end; - TVN_BEGINDRAG: - begin - FDragged := True; - with PNMTreeView(NMHdr)^ do - FDragNode := GetNodeFromItem(ItemNew); - end; - TVN_BEGINLABELEDIT: - begin - with PTVDispInfo(NMHdr)^ do - if Dragging or not CanEdit(GetNodeFromItem(item)) then - Result := 1; - if Result = 0 then - begin - FEditHandle := TreeView_GetEditControl(Handle); - FDefEditProc := Pointer(GetWindowLong(FEditHandle, GWL_WNDPROC)); - SetWindowLong(FEditHandle, GWL_WNDPROC, LongInt(FEditInstance)); - end; - end; - TVN_ENDLABELEDIT: Edit(PTVDispInfo(NMHdr)^.item); - TVN_ITEMEXPANDING: - if not FManualNotify then - begin - with PNMTreeView(NMHdr)^ do - begin - Node := GetNodeFromItem(ItemNew); - if (action = TVE_EXPAND) and not CanExpand(Node) then - Result := 1 - else if (action = TVE_COLLAPSE) and - not CanCollapse(Node) then Result := 1; - end; - end; - TVN_ITEMEXPANDED: - if not FManualNotify then - begin - with PNMTreeView(NMHdr)^ do - begin - Node := GetNodeFromItem(itemNew); - if (action = TVE_EXPAND) then Expand(Node) - else if (action = TVE_COLLAPSE) then Collapse(Node); - end; - end; - TVN_SELCHANGINGA, TVN_SELCHANGINGW: - if not CanChange(GetNodeFromItem(PNMTreeView(NMHdr)^.itemNew)) then - Result := 1; - TVN_SELCHANGEDA, TVN_SELCHANGEDW: - with PNMTreeView(NMHdr)^ do - if FChangeTimer.Interval > 0 then - with FChangeTimer do - begin - Enabled := False; - Tag := Integer(GetNodeFromItem(itemNew)); - Enabled := True; - end - else - Change(GetNodeFromItem(itemNew)); - TVN_DELETEITEM: - begin - Node := GetNodeFromItem(PNMTreeView(NMHdr)^.itemOld); - if Node <> nil then - begin - Node.FItemId := nil; - FChangeTimer.Enabled := False; - if FStateChanging then Node.Delete - else Items.Delete(Node); - end; - end; - TVN_SETDISPINFO: - with PTVDispInfo(NMHdr)^ do - begin - Node := GetNodeFromItem(item); - if (Node <> nil) and ((item.mask and TVIF_TEXT) <> 0) then - Node.Text := item.pszText; - end; - TVN_GETDISPINFO: - with PTVDispInfo(NMHdr)^ do - begin - Node := GetNodeFromItem(item); - if Node <> nil then - begin - if (item.mask and TVIF_TEXT) <> 0 then - StrLCopy(item.pszText, PChar(Node.Text), item.cchTextMax); - if (item.mask and TVIF_IMAGE) <> 0 then - begin - GetImageIndex(Node); - item.iImage := Node.ImageIndex; - end; - if (item.mask and TVIF_SELECTEDIMAGE) <> 0 then - begin - GetSelectedIndex(Node); - item.iSelectedImage := Node.SelectedIndex; - end; - end; - end; - NM_RCLICK: - begin - if RightClickSelect then - begin - GetCursorPos(MousePos); - with PointToSmallPoint(ScreenToClient(MousePos)) do - begin - FRClickNode := GetNodeAt(X, Y); - Perform(WM_RBUTTONUP, 0, MakeLong(X, Y)); - end; - end - else FRClickNode := Pointer(1); - end; - end; -end; - -function TCustomTreeView.GetDragImages: TDragImageList; -begin - if FDragImage.Count > 0 then - Result := FDragImage else - Result := nil; -end; - -procedure TCustomTreeView.WndProc(var Message: TMessage); -begin - if not (csDesigning in ComponentState) and ((Message.Msg = WM_LBUTTONDOWN) or - (Message.Msg = WM_LBUTTONDBLCLK)) and not Dragging and - (DragMode = dmAutomatic) and (DragKind = dkDrag) then - begin - if not IsControlMouseMsg(TWMMouse(Message)) then - begin - ControlState := ControlState + [csLButtonDown]; - Dispatch(Message); - end; - end - else inherited WndProc(Message); -end; - -procedure TCustomTreeView.DoStartDrag(var DragObject: TDragObject); -var - ImageHandle: HImageList; - DragNode: TTreeNode; - P: TPoint; -begin - inherited DoStartDrag(DragObject); - DragNode := FDragNode; - FLastDropTarget := nil; - FDragNode := nil; - if DragNode = nil then - begin - GetCursorPos(P); - with ScreenToClient(P) do DragNode := GetNodeAt(X, Y); - end; - if DragNode <> nil then - begin - ImageHandle := TreeView_CreateDragImage(Handle, DragNode.ItemId); - if ImageHandle <> 0 then - with FDragImage do - begin - Handle := ImageHandle; - SetDragImage(0, 2, 2); - end; - end; -end; - -procedure TCustomTreeView.DoEndDrag(Target: TObject; X, Y: Integer); -begin - inherited DoEndDrag(Target, X, Y); - FLastDropTarget := nil; -end; - -procedure TCustomTreeView.CMDrag(var Message: TCMDrag); -begin - inherited; - with Message, DragRec^ do - case DragMessage of - dmDragMove: - with ScreenToClient(Pos) do - DoDragOver(Source, X, Y, Message.Result <> 0); - dmDragLeave: - begin - TDragObject(Source).HideDragImage; - FLastDropTarget := DropTarget; - DropTarget := nil; - TDragObject(Source).ShowDragImage; - end; - dmDragDrop: FLastDropTarget := nil; - end; -end; - -procedure TCustomTreeView.DoDragOver(Source: TDragObject; X, Y: Integer; CanDrop: Boolean); -var - Node: TTreeNode; -begin - Node := GetNodeAt(X, Y); - if (Node <> nil) and - ((Node <> DropTarget) or (Node = FLastDropTarget)) then - begin - FLastDropTarget := nil; - TDragObject(Source).HideDragImage; - Node.DropTarget := True; - TDragObject(Source).ShowDragImage; - end; -end; - -procedure TCustomTreeView.GetImageIndex(Node: TTreeNode); -begin - if Assigned(FOnGetImageIndex) then FOnGetImageIndex(Self, Node); -end; - -function TCustomTreeView.CanChange(Node: TTreeNode): Boolean; -begin - Result := True; - if Assigned(FOnChanging) then FOnChanging(Self, Node, Result); -end; - -procedure TCustomTreeView.Change(Node: TTreeNode); -begin - if Assigned(FOnChange) then FOnChange(Self, Node); -end; - -procedure TCustomTreeView.Delete(Node: TTreeNode); -begin - if Assigned(FOnDeletion) then FOnDeletion(Self, Node); -end; - -procedure TCustomTreeView.Expand(Node: TTreeNode); -begin - if Assigned(FOnExpanded) then FOnExpanded(Self, Node); -end; - -function TCustomTreeView.CanExpand(Node: TTreeNode): Boolean; -begin - Result := True; - if Assigned(FOnExpanding) then FOnExpanding(Self, Node, Result); -end; - -procedure TCustomTreeView.Collapse(Node: TTreeNode); -begin - if Assigned(FOnCollapsed) then FOnCollapsed(Self, Node); -end; - -function TCustomTreeView.CanCollapse(Node: TTreeNode): Boolean; -begin - Result := True; - if Assigned(FOnCollapsing) then FOnCollapsing(Self, Node, Result); -end; - -function TCustomTreeView.CanEdit(Node: TTreeNode): Boolean; -begin - Result := True; - if Assigned(FOnEditing) then FOnEditing(Self, Node, Result); -end; - -procedure TCustomTreeView.Edit(const Item: TTVItem); -var - S: string; - Node: TTreeNode; -begin - with Item do - if pszText <> nil then - begin - S := pszText; - Node := GetNodeFromItem(Item); - if Assigned(FOnEdited) then FOnEdited(Self, Node, S); - if Node <> nil then Node.Text := S; - end; -end; - -function TCustomTreeView.CreateNode: TTreeNode; -begin - Result := TTreeNode.Create(Items); -end; - -procedure TCustomTreeView.SetImageList(Value: HImageList; Flags: Integer); -begin - if HandleAllocated then TreeView_SetImageList(Handle, Value, Flags); -end; - -procedure TCustomTreeView.ImageListChange(Sender: TObject); -var - ImageHandle: HImageList; -begin - if HandleAllocated then - begin - if TCustomImageList(Sender).HandleAllocated then - ImageHandle := TCustomImageList(Sender).Handle - else - ImageHandle := 0; - if Sender = Images then - SetImageList(ImageHandle, TVSIL_NORMAL) - else if Sender = StateImages then - SetImageList(ImageHandle, TVSIL_STATE); - end; -end; - -procedure TCustomTreeView.Notification(AComponent: TComponent; - Operation: TOperation); -begin - inherited Notification(AComponent, Operation); - if Operation = opRemove then - begin - if AComponent = Images then Images := nil; - if AComponent = StateImages then StateImages := nil; - end; -end; - -procedure TCustomTreeView.LoadFromFile(const FileName: string); -var - Stream: TStream; -begin - Stream := TFileStream.Create(FileName, fmOpenRead); - try - LoadFromStream(Stream); - finally - Stream.Free; - end; -end; - -procedure TCustomTreeView.LoadFromStream(Stream: TStream); -begin - with TTreeStrings.Create(Items) do - try - LoadTreeFromStream(Stream); - finally - Free; - end; -end; - -procedure TCustomTreeView.SaveToFile(const FileName: string); -var - Stream: TStream; -begin - Stream := TFileStream.Create(FileName, fmCreate); - try - SaveToStream(Stream); - finally - Stream.Free; - end; -end; - -procedure TCustomTreeView.SaveToStream(Stream: TStream); -begin - with TTreeStrings.Create(Items) do - try - SaveTreeToStream(Stream); - finally - Free; - end; -end; - -procedure TCustomTreeView.WMRButtonDown(var Message: TWMRButtonDown); -var - MousePos: TPoint; -begin - FRClickNode := nil; - try - if not RightClickSelect then - begin - inherited; - if FRClickNode <> nil then - begin - GetCursorPos(MousePos); - with PointToSmallPoint(ScreenToClient(MousePos)) do - Perform(WM_RBUTTONUP, 0, MakeLong(X, Y)); - end; - end - else DefaultHandler(Message); - finally - FRClickNode := nil; - - end; -end; - -procedure TCustomTreeView.WMRButtonUp(var Message: TWMRButtonUp); - - procedure DoMouseDown(var Message: TWMMouse; Button: TMouseButton; - Shift: TShiftState); - begin - if not (csNoStdEvents in ControlStyle) then - with Message do - MouseDown(Button, KeysToShiftState(Keys) + Shift, XPos, YPos); - end; - -begin - if RightClickSelect then DoMouseDown(Message, mbRight, []); - inherited; -end; - -procedure TCustomTreeView.WMLButtonDown(var Message: TWMLButtonDown); -var - Node: TTreeNode; - MousePos: TPoint; -begin - FDragged := False; - FDragNode := nil; - try - inherited; - if (DragMode = dmAutomatic) and (DragKind = dkDrag) then - begin - SetFocus; - if not FDragged then - begin - GetCursorPos(MousePos); - with PointToSmallPoint(ScreenToClient(MousePos)) do - Perform(WM_LBUTTONUP, 0, MakeLong(X, Y)); - end - else begin - Node := GetNodeAt(Message.XPos, Message.YPos); - if Node <> nil then - begin - Node.Focused := True; - Node.Selected := True; - BeginDrag(False); - end; - end; - end; - finally - FDragNode := nil; - end; -end; - -procedure TCustomTreeView.WMNotify(var Message: TWMNotify); -var - Node: TTreeNode; - MaxTextLen: Integer; - Pt: TPoint; -begin - with Message do - if NMHdr^.code = TTN_NEEDTEXTW then - begin - // Work around NT COMCTL32 problem with tool tips >= 80 characters - GetCursorPos(Pt); - Pt := ScreenToClient(Pt); - Node := GetNodeAt(Pt.X, Pt.Y); - if (Node = nil) or (Node.Text = '') or - (PToolTipTextW(NMHdr)^.uFlags and TTF_IDISHWND = 0) then Exit; - if (GetComCtlVersion >= ComCtlVersionIE4) and (Length(Node.Text) < 80) then - begin - inherited; - Exit; - end; - FWideText := Node.Text; - MaxTextLen := SizeOf(PToolTipTextW(NMHdr)^.szText) div SizeOf(WideChar); - if Length(FWideText) >= MaxTextLen then - SetLength(FWideText, MaxTextLen - 1); - PToolTipTextW(NMHdr)^.lpszText := PWideChar(FWideText); - FillChar(PToolTipTextW(NMHdr)^.szText, MaxTextLen, 0); - Move(Pointer(FWideText)^, PToolTipTextW(NMHdr)^.szText, Length(FWideText) * SizeOf(WideChar)); - PToolTipTextW(NMHdr)^.hInst := 0; - SetWindowPos(NMHdr^.hwndFrom, HWND_TOP, 0, 0, 0, 0, SWP_NOACTIVATE or - SWP_NOSIZE or SWP_NOMOVE or SWP_NOOWNERZORDER); - Result := 1; - end - else inherited; -end; - -{ CustomDraw support } - -procedure TCustomTreeView.CanvasChanged; -begin - FCanvasChanged := True; -end; - -function TCustomTreeView.IsCustomDrawn(Target: TCustomDrawTarget; - Stage: TCustomDrawStage): Boolean; -begin - { Tree view doesn't support erase notifications } - if Stage = cdPrePaint then - begin - if Target = dtItem then - Result := Assigned(FOnCustomDrawItem) - else if Target = dtControl then - Result := Assigned(FOnCustomDraw) - else - Result := False; - end - else - Result := False; -end; - -function TCustomTreeView.CustomDraw(const ARect: TRect; Stage: TCustomDrawStage): Boolean; -begin - Result := True; - if Assigned(FOnCustomDraw) then FOnCustomDraw(Self, ARect, Result); -end; - -function TCustomTreeView.CustomDrawItem(Node: TTreeNode; State: TCustomDrawState; - Stage: TCustomDrawStage): Boolean; -begin - Result := True; - if Assigned(FOnCustomDrawItem) then FOnCustomDrawItem(Self, Node, State, Result); -end; - -*/ diff --git a/apps/X11/VCL/TCustomTreeView.h b/apps/X11/VCL/TCustomTreeView.h deleted file mode 100644 index 0b3c91d..0000000 --- a/apps/X11/VCL/TCustomTreeView.h +++ /dev/null @@ -1,238 +0,0 @@ -#ifndef TCUSTOMTREEVIEW_H -#define TCUSTOMTREEVIEW_H - -#include <TWinControl.h> -#include <TTreeNode.h> -#include <TCustomImageList.h> -#include <gtk/gtktree.h> -#include <gtk/gtktreeitem.h> - - enum THitTest {htAbove, htBelow, htNowhere, htOnItem, htOnButton, htOnIcon, - htOnIndent, htOnLabel, htOnRight, htOnStateIcon, htToLeft, htToRight}; -// THitTests = set of THitTest; - enum TSortType {stNone, stData, stText, stBoth}; - -/* - ETreeViewError = class(Exception); - TTVChangingEvent = procedure(Sender: TObject; Node: TTreeNode; - var AllowChange: Boolean) of object; - TTVChangedEvent = procedure(Sender: TObject; Node: TTreeNode) of object; - TTVEditingEvent = procedure(Sender: TObject; Node: TTreeNode; - var AllowEdit: Boolean) of object; - TTVEditedEvent = procedure(Sender: TObject; Node: TTreeNode; var S: string) of object; - TTVExpandingEvent = procedure(Sender: TObject; Node: TTreeNode; - var AllowExpansion: Boolean) of object; - TTVCollapsingEvent = procedure(Sender: TObject; Node: TTreeNode; - var AllowCollapse: Boolean) of object; - TTVExpandedEvent = procedure(Sender: TObject; Node: TTreeNode) of object; - TTVCompareEvent = procedure(Sender: TObject; Node1, Node2: TTreeNode; - Data: Integer; var Compare: Integer) of object; - TTVCustomDrawEvent = procedure(Sender: TCustomTreeView; const ARect: TRect; - var DefaultDraw: Boolean) of object; - TTVCustomDrawItemEvent = procedure(Sender: TCustomTreeView; Node: TTreeNode; - State: TCustomDrawState; var DefaultDraw: Boolean) of object; -*/ - -class TTreeNodes; - -class TCustomTreeView : public TWinControl { -friend TTreeNodes; -friend TTreeNode; -protected: - void init(TComponent *AOwner); - -// procedure SetTreeNodes(Value: TTreeNodes); - void SetTreeNodes(TTreeNodes* Value); -// FImages: TCustomImageList; - TCustomImageList *FImages; -// FStateImages: TCustomImageList; - TCustomImageList *FStateImages; -// procedure SetImages(Value: TCustomImageList); - void SetImages(TCustomImageList *val); - TCustomImageList * getImages() { return FImages; } -// procedure SetStateImages(Value: TCustomImageList); - void SetStateImages(TCustomImageList *val); - TCustomImageList * getStateImages() { return FStateImages; } -/* - FAutoExpand: Boolean; - FBorderStyle: TBorderStyle; - FCanvas: TCanvas; - FCanvasChanged: Boolean; - FDefEditProc: Pointer; - FDragged: Boolean; - FDragImage: TDragImageList; - FDragNode: TTreeNode; - FEditHandle: HWND; - FEditInstance: Pointer; - FHideSelection: Boolean; - FHotTrack: Boolean; - FImageChangeLink: TChangeLink; - FLastDropTarget: TTreeNode; - FManualNotify: Boolean; - FMemStream: TMemoryStream; - FRClickNode: TTreeNode; - FRightClickSelect: Boolean; - FReadOnly: Boolean; - FRowSelect: Boolean; - FSaveIndex: Integer; - FSaveIndent: Integer; - FSaveItems: TStringList; - FSaveTopIndex: Integer; - FShowButtons: Boolean; - FShowLines: Boolean; - FShowRoot: Boolean; - FSortType: TSortType; - FStateChanging: Boolean; - FStateChangeLink: TChangeLink; - FToolTips: Boolean; - FWideText: WideString; - FOnEditing: TTVEditingEvent; - FOnEdited: TTVEditedEvent; - FOnExpanded: TTVExpandedEvent; - FOnExpanding: TTVExpandingEvent; - FOnCollapsed: TTVExpandedEvent; - FOnCollapsing: TTVCollapsingEvent; - FOnChanging: TTVChangingEvent; - FOnChange: TTVChangedEvent; - FOnCompare: TTVCompareEvent; - FOnDeletion: TTVExpandedEvent; - FOnCustomDraw: TTVCustomDrawEvent; - FOnCustomDrawItem: TTVCustomDrawItemEvent; - FOnGetImageIndex: TTVExpandedEvent; - FOnGetSelectedIndex: TTVExpandedEvent; - procedure CanvasChanged(Sender: TObject); - procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED; - procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED; - procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; - procedure CMDrag(var Message: TCMDrag); message CM_DRAG; - procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY; - procedure EditWndProc(var Message: TMessage); - procedure DoDragOver(Source: TDragObject; X, Y: Integer; CanDrop: Boolean); - function GetChangeDelay: Integer; - function GetDropTarget: TTreeNode; - function GetIndent: Integer; - function GetNodeFromItem(const Item: TTVItem): TTreeNode; - function GetTopItem: TTreeNode; - procedure ImageListChange(Sender: TObject); - procedure SetAutoExpand(Value: Boolean); - procedure SetBorderStyle(Value: TBorderStyle); - procedure SetButtonStyle(Value: Boolean); - procedure SetChangeDelay(Value: Integer); - procedure SetDropTarget(Value: TTreeNode); - procedure SetHideSelection(Value: Boolean); - procedure SetHotTrack(Value: Boolean); - procedure SetImageList(Value: HImageList; Flags: Integer); - procedure SetIndent(Value: Integer); - procedure SetLineStyle(Value: Boolean); - procedure SetReadOnly(Value: Boolean); - procedure SetRootStyle(Value: Boolean); - procedure SetRowSelect(Value: Boolean); - procedure SetSortType(Value: TSortType); - procedure SetToolTips(Value: Boolean); - procedure SetTopItem(Value: TTreeNode); - procedure OnChangeTimer(Sender: TObject); - procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; - procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN; - procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP; - procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY; - procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE; -*/ - protected: -// property Items: TTreeNodes read FTreeNodes write SetTreeNodes; - TTreeNodes *FTreeNodes; - property <TCustomTreeView, TTreeNodes*> Items; - TTreeNodes *getItems() { return FTreeNodes; } - -// property Images: TCustomImageList read FImages write SetImages; - property <TCustomTreeView, TCustomImageList *> Images; -// property StateImages: TCustomImageList read FStateImages write SetStateImages; - property <TCustomTreeView, TCustomImageList *> StateImages; - -// property Selected: TTreeNode read GetSelection write SetSelection; -// function GetSelection: TTreeNode; -// procedure SetSelection(Value: TTreeNode); - TTreeNode *GetSelection(); - void SetSelection(TTreeNode *); - -/* - FChangeTimer: TTimer; - function CanEdit(Node: TTreeNode): Boolean; dynamic; - function CanChange(Node: TTreeNode): Boolean; dynamic; - function CanCollapse(Node: TTreeNode): Boolean; dynamic; - function CanExpand(Node: TTreeNode): Boolean; dynamic; - procedure Change(Node: TTreeNode); dynamic; - procedure Collapse(Node: TTreeNode); dynamic; - function CreateNode: TTreeNode; virtual; - procedure CreateParams(var Params: TCreateParams); override; - procedure CreateWnd; override; - function CustomDraw(const ARect: TRect; Stage: TCustomDrawStage): Boolean; virtual; - function CustomDrawItem(Node: TTreeNode; State: TCustomDrawState; - Stage: TCustomDrawStage): Boolean; virtual; - procedure Delete(Node: TTreeNode); dynamic; - procedure DestroyWnd; override; - procedure DoEndDrag(Target: TObject; X, Y: Integer); override; - procedure DoStartDrag(var DragObject: TDragObject); override; - procedure Edit(const Item: TTVItem); dynamic; - procedure Expand(Node: TTreeNode); dynamic; - function GetDragImages: TDragImageList; override; - procedure GetImageIndex(Node: TTreeNode); virtual; - procedure GetSelectedIndex(Node: TTreeNode); virtual; - function IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean; - procedure Loaded; override; - procedure Notification(AComponent: TComponent; - Operation: TOperation); override; - procedure SetDragMode(Value: TDragMode); override; - procedure WndProc(var Message: TMessage); override; - property AutoExpand: Boolean read FAutoExpand write SetAutoExpand default False; - property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle; - property ChangeDelay: Integer read GetChangeDelay write SetChangeDelay default 0; - property HideSelection: Boolean read FHideSelection write SetHideSelection default True; - property HotTrack: Boolean read FHotTrack write SetHotTrack default False; - property Indent: Integer read GetIndent write SetIndent; - property ReadOnly: Boolean read FReadOnly write SetReadOnly default False; - property RightClickSelect: Boolean read FRightClickSelect write FRightClickSelect default False; - property RowSelect: Boolean read FRowSelect write SetRowSelect default False; - property ShowButtons: Boolean read FShowButtons write SetButtonStyle default True; - property ShowLines: Boolean read FShowLines write SetLineStyle default True; - property ShowRoot: Boolean read FShowRoot write SetRootStyle default True; - property SortType: TSortType read FSortType write SetSortType default stNone; - property ToolTips: Boolean read FToolTips write SetToolTips default True; - property OnCustomDraw: TTVCustomDrawEvent read FOnCustomDraw write FOnCustomDraw; - property OnCustomDrawItem: TTVCustomDrawItemEvent read FOnCustomDrawItem write FOnCustomDrawItem; - property OnEditing: TTVEditingEvent read FOnEditing write FOnEditing; - property OnEdited: TTVEditedEvent read FOnEdited write FOnEdited; - property OnExpanding: TTVExpandingEvent read FOnExpanding write FOnExpanding; - property OnExpanded: TTVExpandedEvent read FOnExpanded write FOnExpanded; - property OnCollapsing: TTVCollapsingEvent read FOnCollapsing write FOnCollapsing; - property OnCollapsed: TTVExpandedEvent read FOnCollapsed write FOnCollapsed; - property OnChanging: TTVChangingEvent read FOnChanging write FOnChanging; - property OnChange: TTVChangedEvent read FOnChange write FOnChange; - property OnCompare: TTVCompareEvent read FOnCompare write FOnCompare; - property OnDeletion: TTVExpandedEvent read FOnDeletion write FOnDeletion; - property OnGetImageIndex: TTVExpandedEvent read FOnGetImageIndex write FOnGetImageIndex; - property OnGetSelectedIndex: TTVExpandedEvent read FOnGetSelectedIndex write FOnGetSelectedIndex; -*/ -public: - TCustomTreeView(TComponent *AOwner); - TCustomTreeView(GtkWidget *parent); - property <TCustomTreeView, TTreeNode *> Selected; - virtual ~TCustomTreeView(); -/* - function AlphaSort: Boolean; - function CustomSort(SortProc: TTVCompare; Data: Longint): Boolean; - procedure FullCollapse; - procedure FullExpand; - function GetHitTestInfoAt(X, Y: Integer): THitTests; - function GetNodeAt(X, Y: Integer): TTreeNode; - function IsEditing: Boolean; - procedure LoadFromFile(const FileName: string); - procedure LoadFromStream(Stream: TStream); - procedure SaveToFile(const FileName: string); - procedure SaveToStream(Stream: TStream); - property Canvas: TCanvas read FCanvas; - property DropTarget: TTreeNode read GetDropTarget write SetDropTarget; - property TopItem: TTreeNode read GetTopItem write SetTopItem; -*/ -}; - -#endif diff --git a/apps/X11/VCL/TDragImageList.cpp b/apps/X11/VCL/TDragImageList.cpp deleted file mode 100644 index 4f51c7c..0000000 --- a/apps/X11/VCL/TDragImageList.cpp +++ /dev/null @@ -1,144 +0,0 @@ -#include <TDragImageList.h> - -TDragImageList::TDragImageList() :TCustomImageList(0) { - -} - -/* -{ TDragImageList } - -function ClientToWindow(Handle: HWND; X, Y: Integer): TPoint; -var - Rect: TRect; - Point: TPoint; -begin - Point.X := X; - Point.Y := Y; - ClientToScreen(Handle, Point); - GetWindowRect(Handle, Rect); - Result.X := Point.X - Rect.Left; - Result.Y := Point.Y - Rect.Top; -end; - -procedure TDragImageList.Initialize; -begin - inherited Initialize; - DragCursor := crNone; -end; - -procedure TDragImageList.CombineDragCursor; -var - TempList: HImageList; - Point: TPoint; -begin - if DragCursor <> crNone then - begin - TempList := ImageList_Create(GetSystemMetrics(SM_CXCURSOR), - GetSystemMetrics(SM_CYCURSOR), ILC_MASK, 1, 1); - try - ImageList_AddIcon(TempList, Screen.Cursors[DragCursor]); - ImageList_AddIcon(TempList, Screen.Cursors[DragCursor]); - ImageList_SetDragCursorImage(TempList, 0, 0, 0); - ImageList_GetDragImage(nil, @Point); - ImageList_SetDragCursorImage(TempList, 1, Point.X, Point.Y); - finally - ImageList_Destroy(TempList); - end; - end; -end; - -function TDragImageList.SetDragImage(Index, HotSpotX, HotSpotY: Integer): Boolean; -begin - if HandleAllocated then - begin - FDragIndex := Index; - FDragHotspot.x := HotSpotX; - FDragHotspot.y := HotSpotY; - ImageList_BeginDrag(Handle, Index, HotSpotX, HotSpotY); - Result := True; - FDragging := Result; - end - else Result := False; -end; - -procedure TDragImageList.SetDragCursor(Value: TCursor); -begin - if Value <> DragCursor then - begin - FDragCursor := Value; - if Dragging then CombineDragCursor; - end; -end; - -function TDragImageList.GetHotSpot: TPoint; -begin - Result := inherited GetHotSpot; - if HandleAllocated and Dragging then - ImageList_GetDragImage(nil, @Result); -end; - -function TDragImageList.BeginDrag(Window: HWND; X, Y: Integer): Boolean; -begin - Result := False; - if HandleAllocated then - begin - if not Dragging then SetDragImage(FDragIndex, FDragHotspot.x, FDragHotspot.y); - CombineDragCursor; - Result := DragLock(Window, X, Y); - if Result then ShowCursor(False); - end; -end; - -function TDragImageList.DragLock(Window: HWND; XPos, YPos: Integer): Boolean; -begin - Result := False; - if HandleAllocated and (Window <> FDragHandle) then - begin - DragUnlock; - FDragHandle := Window; - with ClientToWindow(FDragHandle, XPos, YPos) do - Result := ImageList_DragEnter(FDragHandle, X, Y); - end; -end; - -procedure TDragImageList.DragUnlock; -begin - if HandleAllocated and (FDragHandle <> 0) then - begin - ImageList_DragLeave(FDragHandle); - FDragHandle := 0; - end; -end; - -function TDragImageList.DragMove(X, Y: Integer): Boolean; -begin - if HandleAllocated then - with ClientToWindow(FDragHandle, X, Y) do - Result := ImageList_DragMove(X, Y) - else - Result := False; -end; - -procedure TDragImageList.ShowDragImage; -begin - if HandleAllocated then ImageList_DragShowNoLock(True); -end; - -procedure TDragImageList.HideDragImage; -begin - if HandleAllocated then ImageList_DragShowNoLock(False); -end; - -function TDragImageList.EndDrag: Boolean; -begin - if HandleAllocated and Dragging then - begin - DragUnlock; - Result := ImageList_EndDrag; - FDragging := False; - DragCursor := crNone; - ShowCursor(True); - end - else Result := False; -end; -*/ diff --git a/apps/X11/VCL/TDragImageList.h b/apps/X11/VCL/TDragImageList.h deleted file mode 100644 index 4cb9dab..0000000 --- a/apps/X11/VCL/TDragImageList.h +++ /dev/null @@ -1,40 +0,0 @@ -#ifndef TDRAGIMAGELIST -#define TDRAGIMAGELIST - -#include <TCustomImageList.h> - -class TDragImageList : public TCustomImageList { - - TDragImageList(); - -/* -{ TDragImageList } - - TDragImageList = class(TCustomImageList) - private - FDragCursor: TCursor; - FDragging: Boolean; - FDragHandle: HWND; - FDragHotspot: TPoint; - FDragIndex: Integer; - procedure CombineDragCursor; - procedure SetDragCursor(Value: TCursor); - protected - procedure Initialize; override; - public - function BeginDrag(Window: HWND; X, Y: Integer): Boolean; - function DragLock(Window: HWND; XPos, YPos: Integer): Boolean; - function DragMove(X, Y: Integer): Boolean; - procedure DragUnlock; - function EndDrag: Boolean; - function GetHotSpot: TPoint; override; - procedure HideDragImage; - function SetDragImage(Index, HotSpotX, HotSpotY: Integer): Boolean; - procedure ShowDragImage; - property DragCursor: TCursor read FDragCursor write SetDragCursor; - property Dragging: Boolean read FDragging; - end; -*/ -}; - -#endif diff --git a/apps/X11/VCL/TImageList.cpp b/apps/X11/VCL/TImageList.cpp deleted file mode 100644 index e9f1259..0000000 --- a/apps/X11/VCL/TImageList.cpp +++ /dev/null @@ -1,2 +0,0 @@ -#include <TImageList.h> - diff --git a/apps/X11/VCL/TImageList.h b/apps/X11/VCL/TImageList.h deleted file mode 100644 index ebabbe1..0000000 --- a/apps/X11/VCL/TImageList.h +++ /dev/null @@ -1,28 +0,0 @@ -#ifndef TIMAGELIST_H -#define TIMAGELIST_H - -#include <TDragImageList.h> - -class TImageList : public TDragImageList { -public: - -/* -{ TImageList } - - TImageList = class(TDragImageList) - published - property BlendColor; - property BkColor; - property AllocBy; - property DrawingStyle; - property Height; - property ImageType; - property Masked; - property OnChange; - property ShareImages; - property Width; - end; -*/ -}; - -#endif diff --git a/apps/X11/VCL/TObject.cpp b/apps/X11/VCL/TObject.cpp deleted file mode 100644 index e1ea4c5..0000000 --- a/apps/X11/VCL/TObject.cpp +++ /dev/null @@ -1,7 +0,0 @@ -#include <TObject.h> - -TObject::TObject() { -} - -TObject::~TObject() { -} diff --git a/apps/X11/VCL/TObject.h b/apps/X11/VCL/TObject.h deleted file mode 100644 index 874f071..0000000 --- a/apps/X11/VCL/TObject.h +++ /dev/null @@ -1,38 +0,0 @@ -#ifndef TOBJECT_H -#define TOBJECT_H - -#include <property> - -class TObject { -public: - TObject(); - virtual ~TObject(); -/* - procedure Free; - class function InitInstance(Instance: Pointer): TObject; - procedure CleanupInstance; - function ClassType: TClass; - class function ClassName: ShortString; - class function ClassNameIs(const Name: string): Boolean; - class function ClassParent: TClass; - class function ClassInfo: Pointer; - class function InstanceSize: Longint; - class function InheritsFrom(AClass: TClass): Boolean; - class function MethodAddress(const Name: ShortString): Pointer; - class function MethodName(Address: Pointer): ShortString; - function FieldAddress(const Name: ShortString): Pointer; - function GetInterface(const IID: TGUID; out Obj): Boolean; - class function GetInterfaceEntry(const IID: TGUID): PInterfaceEntry; - class function GetInterfaceTable: PInterfaceTable; - function SafeCallException(ExceptObject: TObject; - ExceptAddr: Pointer): HResult; virtual; - procedure AfterConstruction; virtual; - procedure BeforeDestruction; virtual; - procedure Dispatch(var Message); virtual; - procedure DefaultHandler(var Message); virtual; - class function NewInstance: TObject; virtual; - procedure FreeInstance; virtual; -*/ -}; - -#endif diff --git a/apps/X11/VCL/TPageControl.cpp b/apps/X11/VCL/TPageControl.cpp deleted file mode 100644 index af0112c..0000000 --- a/apps/X11/VCL/TPageControl.cpp +++ /dev/null @@ -1,408 +0,0 @@ -#include <TPageControl.h> - -TPageControl::TPageControl(TComponent *AOwner) : TCustomTabControl(AOwner) { -} - -TPageControl::~TPageControl() { -} - -/* -{ TPageControl } - -constructor TPageControl.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - ControlStyle := [csDoubleClicks, csOpaque]; - FPages := TList.Create; -end; - -destructor TPageControl.Destroy; -var - I: Integer; -begin - for I := 0 to FPages.Count - 1 do TTabSheet(FPages[I]).FPageControl := nil; - FPages.Free; - inherited Destroy; -end; - -function TPageControl.CanShowTab(TabIndex: Integer): Boolean; -begin - Result := TTabSheet(FPages[TabIndex]).Enabled; -end; - -procedure TPageControl.Change; -var - Form: TCustomForm; -begin - UpdateActivePage; - if csDesigning in ComponentState then - begin - Form := GetParentForm(Self); - if (Form <> nil) and (Form.Designer <> nil) then Form.Designer.Modified; - end; - inherited Change; -end; - -procedure TPageControl.ChangeActivePage(Page: TTabSheet); -var - ParentForm: TCustomForm; -begin - if FActivePage <> Page then - begin - ParentForm := GetParentForm(Self); - if (ParentForm <> nil) and (FActivePage <> nil) and - FActivePage.ContainsControl(ParentForm.ActiveControl) then - begin - ParentForm.ActiveControl := FActivePage; - if ParentForm.ActiveControl <> FActivePage then - begin - TabIndex := FActivePage.TabIndex; - Exit; - end; - end; - if Page <> nil then - begin - Page.BringToFront; - Page.Visible := True; - if (ParentForm <> nil) and (FActivePage <> nil) and - (ParentForm.ActiveControl = FActivePage) then - if Page.CanFocus then - ParentForm.ActiveControl := Page else - ParentForm.ActiveControl := Self; - end; - if FActivePage <> nil then FActivePage.Visible := False; - FActivePage := Page; - if (ParentForm <> nil) and (FActivePage <> nil) and - (ParentForm.ActiveControl = FActivePage) then - FActivePage.SelectFirst; - end; -end; - -procedure TPageControl.DeleteTab(Page: TTabSheet; Index: Integer); -var - UpdateIndex: Boolean; -begin - UpdateIndex := Page = ActivePage; - Tabs.Delete(Index); - if UpdateIndex then - begin - if Index >= Tabs.Count then - Index := Tabs.Count - 1; - TabIndex := Index; - end; - UpdateActivePage; -end; - -procedure TPageControl.DoAddDockClient(Client: TControl; const ARect: TRect); -begin - if FNewDockSheet <> nil then Client.Parent := FNewDockSheet; -end; - -procedure TPageControl.DockOver(Source: TDragDockObject; X, Y: Integer; - State: TDragState; var Accept: Boolean); -var - R: TRect; -begin - GetWindowRect(Handle, R); - Source.DockRect := R; - DoDockOver(Source, X, Y, State, Accept); -end; - -procedure TPageControl.DoRemoveDockClient(Client: TControl); -begin - if (FUndockingPage <> nil) and not (csDestroying in ComponentState) then - begin - SelectNextPage(True); - FUndockingPage.Free; - FUndockingPage := nil; - end; -end; - -function TPageControl.FindNextPage(CurPage: TTabSheet; - GoForward, CheckTabVisible: Boolean): TTabSheet; -var - I, StartIndex: Integer; -begin - if FPages.Count <> 0 then - begin - StartIndex := FPages.IndexOf(CurPage); - if StartIndex = -1 then - if GoForward then StartIndex := FPages.Count - 1 else StartIndex := 0; - I := StartIndex; - repeat - if GoForward then - begin - Inc(I); - if I = FPages.Count then I := 0; - end else - begin - if I = 0 then I := FPages.Count; - Dec(I); - end; - Result := FPages[I]; - if not CheckTabVisible or Result.TabVisible then Exit; - until I = StartIndex; - end; - Result := nil; -end; - -procedure TPageControl.GetChildren(Proc: TGetChildProc; Root: TComponent); -var - I: Integer; -begin - for I := 0 to FPages.Count - 1 do Proc(TComponent(FPages[I])); -end; - -function TPageControl.GetImageIndex(TabIndex: Integer): Integer; -begin - if Assigned(FOnGetImageIndex) then - Result := inherited GetImageIndex(TabIndex) else - Result := GetPage(TabIndex).ImageIndex; -end; - -function TPageControl.GetPageFromDockClient(Client: TControl): TTabSheet; -var - I: Integer; -begin - Result := nil; - for I := 0 to PageCount - 1 do - begin - if (Client.Parent = Pages[I]) and (Client.HostDockSite = Self) then - begin - Result := Pages[I]; - Exit; - end; - end; -end; - -function TPageControl.GetPage(Index: Integer): TTabSheet; -begin - Result := FPages[Index]; -end; - -function TPageControl.GetPageCount: Integer; -begin - Result := FPages.Count; -end; - -procedure TPageControl.GetSiteInfo(Client: TControl; var InfluenceRect: TRect; - MousePos: TPoint; var CanDock: Boolean); -begin - CanDock := GetPageFromDockClient(Client) = nil; - inherited GetSiteInfo(Client, InfluenceRect, MousePos, CanDock); -end; - -procedure TPageControl.InsertPage(Page: TTabSheet); -begin - FPages.Add(Page); - Page.FPageControl := Self; - Page.UpdateTabShowing; -end; - -procedure TPageControl.InsertTab(Page: TTabSheet); -begin - Tabs.InsertObject(Page.TabIndex, Page.Caption, Page); - UpdateActivePage; -end; - -procedure TPageControl.MoveTab(CurIndex, NewIndex: Integer); -begin - Tabs.Move(CurIndex, NewIndex); -end; - -procedure TPageControl.RemovePage(Page: TTabSheet); -var - NextSheet: TTabSheet; -begin - NextSheet := FindNextPage(Page, True, not (csDesigning in ComponentState)); - if NextSheet = Page then NextSheet := nil; - Page.SetTabShowing(False); - Page.FPageControl := nil; - FPages.Remove(Page); - SetActivePage(NextSheet); -end; - -procedure TPageControl.SelectNextPage(GoForward: Boolean); -var - Page: TTabSheet; -begin - Page := FindNextPage(ActivePage, GoForward, True); - if (Page <> nil) and (Page <> ActivePage) and CanChange then - begin - TabIndex := Page.TabIndex; - Change; - end; -end; - -procedure TPageControl.SetActivePage(Page: TTabSheet); -begin - if (Page <> nil) and (Page.PageControl <> Self) then Exit; - ChangeActivePage(Page); - if Page = nil then - TabIndex := -1 - else if Page = FActivePage then - TabIndex := Page.TabIndex; -end; - -procedure TPageControl.SetChildOrder(Child: TComponent; Order: Integer); -begin - TTabSheet(Child).PageIndex := Order; -end; - -procedure TPageControl.ShowControl(AControl: TControl); -begin - if (AControl is TTabSheet) and (TTabSheet(AControl).PageControl = Self) then - SetActivePage(TTabSheet(AControl)); - inherited ShowControl(AControl); -end; - -procedure TPageControl.UpdateTab(Page: TTabSheet); -begin - Tabs[Page.TabIndex] := Page.Caption; -end; - -procedure TPageControl.UpdateActivePage; -begin - if TabIndex >= 0 then - SetActivePage(TTabSheet(Tabs.Objects[TabIndex])) - else - SetActivePage(nil); -end; - -procedure TPageControl.CMDesignHitTest(var Message: TCMDesignHitTest); -var - HitIndex: Integer; - HitTestInfo: TTCHitTestInfo; -begin - HitTestInfo.pt := SmallPointToPoint(Message.Pos); - HitIndex := SendMessage(Handle, TCM_HITTEST, 0, Longint(@HitTestInfo)); - if (HitIndex >= 0) and (HitIndex <> TabIndex) then Message.Result := 1; -end; - -procedure TPageControl.CMDialogKey(var Message: TCMDialogKey); -begin - if (Focused or Windows.IsChild(Handle, Windows.GetFocus)) and - (Message.CharCode = VK_TAB) and (GetKeyState(VK_CONTROL) < 0) then - begin - SelectNextPage(GetKeyState(VK_SHIFT) >= 0); - Message.Result := 1; - end else - inherited; -end; - -procedure TPageControl.CMDockClient(var Message: TCMDockClient); -var - IsVisible: Boolean; - DockCtl: TControl; -begin - Message.Result := 0; - FNewDockSheet := TTabSheet.Create(Self); - try - try - DockCtl := Message.DockSource.Control; - if DockCtl is TCustomForm then - FNewDockSheet.Caption := TCustomForm(DockCtl).Caption; - FNewDockSheet.PageControl := Self; - DockCtl.Dock(Self, Message.DockSource.DockRect); - except - FNewDockSheet.Free; - raise; - end; - IsVisible := DockCtl.Visible; - FNewDockSheet.TabVisible := IsVisible; - if IsVisible then ActivePage := FNewDockSheet; - DockCtl.Align := alClient; - finally - FNewDockSheet := nil; - end; -end; - -procedure TPageControl.CMDockNotification(var Message: TCMDockNotification); -var - I: Integer; - S: string; - Page: TTabSheet; -begin - Page := GetPageFromDockClient(Message.Client); - if Page <> nil then - case Message.NotifyRec.ClientMsg of - WM_SETTEXT: - begin - S := PChar(Message.NotifyRec.MsgLParam); - { Search for first CR/LF and end string there } - for I := 1 to Length(S) do - if S[I] in [#13, #10] then - begin - SetLength(S, I - 1); - Break; - end; - Page.Caption := S; - end; - CM_VISIBLECHANGED: - with Page do - begin - Visible := Boolean(Message.NotifyRec.MsgWParam); - TabVisible := Boolean(Message.NotifyRec.MsgWParam);; - end; - end; - inherited; -end; - -procedure TPageControl.CMUnDockClient(var Message: TCMUnDockClient); -var - Page: TTabSheet; -begin - Message.Result := 0; - Page := GetPageFromDockClient(Message.Client); - if Page <> nil then - begin - FUndockingPage := Page; - Message.Client.Align := alNone; - end; -end; - -function TPageControl.GetDockClientFromMousePos(MousePos: TPoint): TControl; -var - HitIndex: Integer; - HitTestInfo: TTCHitTestInfo; - Page: TTabSheet; -begin - Result := nil; - if DockSite then - begin - HitTestInfo.pt := MousePos; - HitIndex := SendMessage(Handle, TCM_HITTEST, 0, Longint(@HitTestInfo)); - if HitIndex >= 0 then - begin - Page := Pages[HitIndex]; - if not Page.TabVisible then Page := FindNextPage(Page, True, True); - if (Page <> nil) and (Page.ControlCount > 0) then - begin - Result := Page.Controls[0]; - if Result.HostDockSite <> Self then Result := nil; - end; - end; - end; -end; - -procedure TPageControl.WMLButtonDown(var Message: TWMLButtonDown); -var - DockCtl: TControl; -begin - inherited; - DockCtl := GetDockClientFromMousePos(SmallPointToPoint(Message.Pos)); - if DockCtl <> nil then DockCtl.BeginDrag(False); -end; - -procedure TPageControl.WMLButtonDblClk(var Message: TWMLButtonDblClk); -var - DockCtl: TControl; -begin - inherited; - DockCtl := GetDockClientFromMousePos(SmallPointToPoint(Message.Pos)); - if DockCtl <> nil then DockCtl.ManualDock(nil, nil, alNone); -end; - -*/ - - diff --git a/apps/X11/VCL/TPageControl.h b/apps/X11/VCL/TPageControl.h deleted file mode 100644 index 447efec..0000000 --- a/apps/X11/VCL/TPageControl.h +++ /dev/null @@ -1,113 +0,0 @@ - -#ifndef TPAGECONTROL_H -#define TPAGECONTROL_H - -#include <TCustomTabControl.h> - -class TPageControl : public TCustomTabControl { -private: -/* - FPages: TList; - FActivePage: TTabSheet; - FNewDockSheet: TTabSheet; - FUndockingPage: TTabSheet; - procedure ChangeActivePage(Page: TTabSheet); - procedure DeleteTab(Page: TTabSheet; Index: Integer); - function GetDockClientFromMousePos(MousePos: TPoint): TControl; - function GetPage(Index: Integer): TTabSheet; - function GetPageCount: Integer; - procedure InsertPage(Page: TTabSheet); - procedure InsertTab(Page: TTabSheet); - procedure MoveTab(CurIndex, NewIndex: Integer); - procedure RemovePage(Page: TTabSheet); - procedure SetActivePage(Page: TTabSheet); - procedure UpdateTab(Page: TTabSheet); - procedure UpdateActivePage; - procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST; - procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY; - procedure CMDockClient(var Message: TCMDockClient); message CM_DOCKCLIENT; - procedure CMDockNotification(var Message: TCMDockNotification); message CM_DOCKNOTIFICATION; - procedure CMUnDockClient(var Message: TCMUnDockClient); message CM_UNDOCKCLIENT; - procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; - procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK; -*/ -protected: -/* - function CanShowTab(TabIndex: Integer): Boolean; override; - procedure Change; override; - procedure DoAddDockClient(Client: TControl; const ARect: TRect); override; - procedure DockOver(Source: TDragDockObject; X, Y: Integer; - State: TDragState; var Accept: Boolean); override; - procedure DoRemoveDockClient(Client: TControl); override; - procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; - function GetImageIndex(TabIndex: Integer): Integer; override; - function GetPageFromDockClient(Client: TControl): TTabSheet; - procedure GetSiteInfo(Client: TControl; var InfluenceRect: TRect; - MousePos: TPoint; var CanDock: Boolean); override; - procedure SetChildOrder(Child: TComponent; Order: Integer); override; - procedure ShowControl(AControl: TControl); override; -*/ -public: - TPageControl(TComponent *AOwner); - virtual ~TPageControl(); -/* - function FindNextPage(CurPage: TTabSheet; - GoForward, CheckTabVisible: Boolean): TTabSheet; - procedure SelectNextPage(GoForward: Boolean); - property PageCount: Integer read GetPageCount; - property Pages[Index: Integer]: TTabSheet read GetPage; - published - property ActivePage: TTabSheet read FActivePage write SetActivePage; - property Align; - property Anchors; - property BiDiMode; - property Constraints; - property DockSite; - property DragCursor; - property DragKind; - property DragMode; - property Enabled; - property Font; - property HotTrack; - property Images; - property MultiLine; - property OwnerDraw; - property ParentBiDiMode; - property ParentFont; - property ParentShowHint; - property PopupMenu; - property RaggedRight; - property ScrollOpposite; - property ShowHint; - property Style; - property TabHeight; - property TabOrder; - property TabPosition; - property TabStop; - property TabWidth; - property Visible; - property OnChange; - property OnChanging; - property OnDockDrop; - property OnDockOver; - property OnDragDrop; - property OnDragOver; - property OnDrawTab; - property OnEndDock; - property OnEndDrag; - property OnEnter; - property OnExit; - property OnGetImageIndex; - property OnGetSiteInfo; - property OnMouseDown; - property OnMouseMove; - property OnMouseUp; - property OnResize; - property OnStartDock; - property OnStartDrag; - property OnUnDock; - end; -*/ -}; - -#endif diff --git a/apps/X11/VCL/TPersistent.cpp b/apps/X11/VCL/TPersistent.cpp deleted file mode 100644 index 8303b01..0000000 --- a/apps/X11/VCL/TPersistent.cpp +++ /dev/null @@ -1,2 +0,0 @@ -#include <TPersistent.h> - diff --git a/apps/X11/VCL/TPersistent.h b/apps/X11/VCL/TPersistent.h deleted file mode 100644 index 7453921..0000000 --- a/apps/X11/VCL/TPersistent.h +++ /dev/null @@ -1,19 +0,0 @@ -#ifndef TPERSISTENT_H -#define TPERSISTENT_H - -#include <TObject.h> - -class TPersistent : public TObject { -private: -// void AssignError(TPersistent Source); -protected: -// virtual void AssignTo(TPersistent Dest); -// virtual void DefineProperties(TFiler Filer); -// TPersistent GetOwner(); // dynamic; -public: -// virtual ~TPersistent(); //override; -// virtual void Assign(Source: TPersistent); -// string GetNamePath(); //dynamic; -}; - -#endif diff --git a/apps/X11/VCL/TTreeNode.cpp b/apps/X11/VCL/TTreeNode.cpp deleted file mode 100644 index e50778b..0000000 --- a/apps/X11/VCL/TTreeNode.cpp +++ /dev/null @@ -1,1003 +0,0 @@ -#include <TTreeNode.h> -#include <TTreeNodes.h> -#include <gtk/gtklabel.h> -#include <gtk/gtkhbox.h> -#include <stdio.h> - - -TTreeNode::TTreeNode(TTreeNodes *AOwner) : - Text(this, &TTreeNode::getText, &TTreeNode::SetText), - StateIndex(this, &TTreeNode::getStateIndex, &TTreeNode::SetStateIndex), - ImageIndex(this, &TTreeNode::getImageIndex, &TTreeNode::SetImageIndex), - Data(this, &TTreeNode::getData, &TTreeNode::SetData), - Parent(this, &TTreeNode::GetParent, 0) { - FOwner = AOwner; - FStateIndex = 0; - FImageIndex = 0; -} - - -TTreeNode::TTreeNode(const TTreeNode &other) : - Text(this, &TTreeNode::getText, &TTreeNode::SetText), - StateIndex(this, &TTreeNode::getStateIndex, &TTreeNode::SetStateIndex), - ImageIndex(this, &TTreeNode::getImageIndex, &TTreeNode::SetImageIndex), - Data(this, &TTreeNode::getData, &TTreeNode::SetData), - Parent(this, &TTreeNode::GetParent, 0) { - FOwner = other.FOwner; - subTreeOwner = other.subTreeOwner; - nativeControl = other.nativeControl; - FData = other.FData; - Text = other.Text; - FStateIndex = other.FStateIndex; - FImageIndex = other.FImageIndex; -} - -TTreeNode::TTreeNode(TTreeNodes *AOwner, GtkTree *AsubTreeOwner, GtkTreeItem *AnativeControl, string AText, void *Ptr) : - Text(this, &TTreeNode::getText, &TTreeNode::SetText), - StateIndex(this, &TTreeNode::getStateIndex, &TTreeNode::SetStateIndex), - ImageIndex(this, &TTreeNode::getImageIndex, &TTreeNode::SetImageIndex), - Data(this, &TTreeNode::getData, &TTreeNode::SetData), - Parent(this, &TTreeNode::GetParent, 0) { - FOwner = AOwner; - subTreeOwner = AsubTreeOwner; - nativeControl = AnativeControl; - FData = Ptr; - Text = AText; - FStateIndex = 0; - FImageIndex = 0; -} - - -TTreeNode::~TTreeNode() { -} - - -/* -function TTreeNode.GetLastChild: TTreeNode; -var - Node: TTreeNode; -begin - Result := GetFirstChild; - if Result <> nil then - begin - Node := Result; - repeat - Result := Node; - Node := Result.GetNextSibling; - until Node = nil; - end; -end; -*/ - -/* -function TTreeNode.GetFirstChild: TTreeNode; -begin - with FOwner do - Result := GetNode(TreeView_GetChild(Handle, ItemId)); -end; -*/ -TTreeNode *TTreeNode::getFirstChild() { - GtkWidget *subtree = nativeControl->subtree; - if (subtree) { - GList *child = g_list_first(GTK_TREE(subtree)->children); - return (child) ? FOwner->GetNode(GTK_TREE_ITEM(child->data)) : 0; - } - return 0; -} - - -/* -function TTreeNode.GetNextSibling: TTreeNode; -begin - with FOwner do - Result := GetNode(TreeView_GetNextSibling(Handle, ItemId)); -end; -*/ -TTreeNode *TTreeNode::getNextSibling() { - GList *node = g_list_find(GTK_TREE(subTreeOwner)->children, nativeControl); - if (node) { - node = g_list_next(node); - return (node) ? FOwner->GetNode(GTK_TREE_ITEM(node->data)) : 0; - } - return 0; -} - - -/* -procedure TTreeNode.SetText(const S: string); -var - Item: TTVItem; -begin - FText := S; - with Item do - begin - mask := TVIF_TEXT; - hItem := ItemId; - pszText := LPSTR_TEXTCALLBACK; - end; - TreeView_SetItem(Handle, Item); - if (TreeView.SortType in [stText, stBoth]) and FInTree then - begin - if (Parent <> nil) then Parent.AlphaSort - else TreeView.AlphaSort; - end; -end; -*/ - - -void TTreeNode::SetText(string S) { - FText = S; - GtkLabel *label; - GtkObject *hbox; - - //It's a Bin, so it has one child, which we know to be a - // hbox, so get that - hbox = GTK_OBJECT(GTK_BIN(nativeControl)->child); - label = GTK_LABEL(gtk_object_get_data(hbox, "label1")); - gtk_label_set(label, FText.c_str()); -} - - -/* -function TTreeNode.GetParent: TTreeNode; -begin - with FOwner do - Result := GetNode(TreeView_GetParent(Handle, ItemId)); -end; -*/ - -TTreeNode *TTreeNode::GetParent() { - return FOwner->GetParentNode(this); -} - - -/* -procedure TTreeNode.SetStateIndex(Value: Integer); -var - Item: TTVItem; -begin - FStateIndex := Value; - if Value >= 0 then Dec(Value); - with Item do - begin - mask := TVIF_STATE or TVIF_HANDLE; - stateMask := TVIS_STATEIMAGEMASK; - hItem := ItemId; - state := IndexToStateImageMask(Value + 1); - end; - TreeView_SetItem(Handle, Item); -end; -*/ - -void TTreeNode::SetStateIndex(int val) { - GtkPixmap *itempixmap = 0, *stateImage; - GdkPixmap *pixmap; - GdkBitmap *mask; - FStateIndex = val; - TCustomImageList *images; - GtkObject *hbox; - // display appropriate image - - hbox = GTK_OBJECT(GTK_BIN(nativeControl)->child); - itempixmap = GTK_PIXMAP(gtk_object_get_data(hbox, "pixmap1")); - - gtk_widget_hide(GTK_WIDGET(itempixmap)); - - images = FOwner->FOwner->StateImages; - - if (images) { - stateImage = images->GetPixmap(val); - if (stateImage) { - gtk_pixmap_get(stateImage, &pixmap, &mask); - gtk_pixmap_set(itempixmap, pixmap, mask); - gtk_widget_show(GTK_WIDGET(itempixmap)); - } - - } -} - - -/* -procedure TTreeNode.SetImageIndex(Value: Integer); -var - Item: TTVItem; -begin - FImageIndex := Value; - with Item do - begin - mask := TVIF_IMAGE or TVIF_HANDLE; - hItem := ItemId; - iImage := I_IMAGECALLBACK; - end; - TreeView_SetItem(Handle, Item); -end; -*/ - -void TTreeNode::SetImageIndex(int val) { - GtkPixmap *itempixmap, *Image; - GdkPixmap *pixmap; - GdkBitmap *mask; - FImageIndex = val; - TCustomImageList *images; - GtkObject *hbox; - // display appropriate image - - hbox = GTK_OBJECT(GTK_BIN(nativeControl)->child); - itempixmap = GTK_PIXMAP(gtk_object_get_data(hbox, "pixmap2")); - - gtk_widget_hide(GTK_WIDGET(itempixmap)); - - images = FOwner->FOwner->Images; - - if (images) { - Image = images->GetPixmap(val); - if (Image) { - gtk_pixmap_get(Image, &pixmap, &mask); - gtk_pixmap_set(itempixmap, pixmap, mask); - gtk_widget_show(GTK_WIDGET(itempixmap)); - } - } -} - - -/* -procedure TTreeNode.SetData(Value: Pointer); -begin - FData := Value; - if (TreeView.SortType in [stData, stBoth]) and Assigned(TreeView.OnCompare) - and (not Deleting) and FInTree then - begin - if Parent <> nil then Parent.AlphaSort - else TreeView.AlphaSort; - end; -end; -*/ - -void TTreeNode::SetData(void *Value) { - FData = Value; -} - - -/* -function TTreeNode.GetNext: TTreeNode; -var - NodeID, ParentID: HTreeItem; - Handle: HWND; -begin - Handle := FOwner.Handle; - NodeID := TreeView_GetChild(Handle, ItemId); - if NodeID = nil then NodeID := TreeView_GetNextSibling(Handle, ItemId); - ParentID := ItemId; - while (NodeID = nil) and (ParentID <> nil) do - begin - ParentID := TreeView_GetParent(Handle, ParentID); - NodeID := TreeView_GetNextSibling(Handle, ParentID); - end; - Result := FOwner.GetNode(NodeID); -end; -*/ - -TTreeNode *TTreeNode::GetNext() { - TTreeNode *parent = this; - TTreeNode *next = getFirstChild(); - if (!next) { - next = getNextSibling(); - while ((!next) && (parent)) { - parent = parent->GetParent(); - if (parent) - next = parent->getNextSibling(); - } - } - - return next; -} - - -/* -procedure TTreeNode.ExpandItem(Expand: Boolean; Recurse: Boolean); -var - Flag: Integer; - Node: TTreeNode; -begin - if Recurse then - begin - Node := Self; - repeat - Node.ExpandItem(Expand, False); - Node := Node.GetNext; - until (Node = nil) or (not Node.HasAsParent(Self)); - end - else begin - TreeView.FManualNotify := True; - try - Flag := 0; - if Expand then - begin - if DoCanExpand(True) then - begin - Flag := TVE_EXPAND; - DoExpand(True); - end; - end - else begin - if DoCanExpand(False) then - begin - Flag := TVE_COLLAPSE; - DoExpand(False); - end; - end; - if Flag <> 0 then TreeView_Expand(Handle, ItemId, Flag); - finally - TreeView.FManualNotify := False; - end; - end; -end; -*/ - -void TTreeNode::ExpandItem(bool Expand, bool Recurse) { - TTreeNode *Node; - - if (Recurse) { - Node = this; - do { - Node->ExpandItem(Expand, false); - Node = Node->GetNext(); - } - while ((Node) /*and (Node.HasAsParent(Self)*/); - } - else { - gtk_tree_item_expand(nativeControl); - -/* - TreeView.FManualNotify := True; - try - Flag := 0; - if Expand then - begin - if DoCanExpand(True) then - begin - Flag := TVE_EXPAND; - DoExpand(True); - end; - end - else begin - if DoCanExpand(False) then - begin - Flag := TVE_COLLAPSE; - DoExpand(False); - end; - end; - if Flag <> 0 then TreeView_Expand(Handle, ItemId, Flag); - finally - TreeView.FManualNotify := False; - end; -*/ - } -} - -/* -procedure TTreeNode.Expand(Recurse: Boolean); -begin - ExpandItem(True, Recurse); -end; -*/ - -void TTreeNode::Expand(bool Recurse) { - ExpandItem(true, Recurse); -} - -/* - -function DefaultTreeViewSort(Node1, Node2: TTreeNode; lParam: Integer): Integer; stdcall; -begin - with Node1 do - if Assigned(TreeView.OnCompare) then - TreeView.OnCompare(TreeView, Node1, Node2, lParam, Result) - else Result := lstrcmp(PChar(Node1.Text), PChar(Node2.Text)); -end; - -procedure TreeViewError(const Msg: string); -begin - raise ETreeViewError.Create(Msg); -end; - -procedure TreeViewErrorFmt(const Msg: string; Format: array of const); -begin - raise ETreeViewError.CreateFmt(Msg, Format); -end; - -constructor TTreeNode.Create(AOwner: TTreeNodes); -begin - inherited Create; - FOverlayIndex := -1; - FStateIndex := -1; - FOwner := AOwner; -end; - -destructor TTreeNode.Destroy; -var - Node: TTreeNode; - CheckValue: Integer; -begin - Owner.ClearCache; - FDeleting := True; - if Owner.Owner.FLastDropTarget = Self then - Owner.Owner.FLastDropTarget := nil; - Node := Parent; - if (Node <> nil) and (not Node.Deleting) then - begin - if Node.IndexOf(Self) <> -1 then CheckValue := 1 - else CheckValue := 0; - if Node.CompareCount(CheckValue) then - begin - Expanded := False; - Node.HasChildren := False; - end; - end; - if ItemId <> nil then TreeView_DeleteItem(Handle, ItemId); - Data := nil; - inherited Destroy; -end; - -function TTreeNode.GetHandle: HWND; -begin - Result := TreeView.Handle; -end; - -function TTreeNode.GetTreeView: TCustomTreeView; -begin - Result := Owner.Owner; -end; - -function TTreeNode.HasAsParent(Value: TTreeNode): Boolean; -begin - if Value <> Nil then - begin - if Parent = nil then Result := False - else if Parent = Value then Result := True - else Result := Parent.HasAsParent(Value); - end - else Result := True; -end; - -function TTreeNode.GetState(NodeState: TNodeState): Boolean; -var - Item: TTVItem; -begin - Result := False; - with Item do - begin - mask := TVIF_STATE; - hItem := ItemId; - if TreeView_GetItem(Handle, Item) then - case NodeState of - nsCut: Result := (state and TVIS_CUT) <> 0; - nsFocused: Result := (state and TVIS_FOCUSED) <> 0; - nsSelected: Result := (state and TVIS_SELECTED) <> 0; - nsExpanded: Result := (state and TVIS_EXPANDED) <> 0; - nsDropHilited: Result := (state and TVIS_DROPHILITED) <> 0; - end; - end; -end; - -procedure TTreeNode.SetSelectedIndex(Value: Integer); -var - Item: TTVItem; -begin - FSelectedIndex := Value; - with Item do - begin - mask := TVIF_SELECTEDIMAGE or TVIF_HANDLE; - hItem := ItemId; - iSelectedImage := I_IMAGECALLBACK; - end; - TreeView_SetItem(Handle, Item); -end; - -procedure TTreeNode.SetOverlayIndex(Value: Integer); -var - Item: TTVItem; -begin - FOverlayIndex := Value; - with Item do - begin - mask := TVIF_STATE or TVIF_HANDLE; - stateMask := TVIS_OVERLAYMASK; - hItem := ItemId; - state := IndexToOverlayMask(OverlayIndex + 1); - end; - TreeView_SetItem(Handle, Item); -end; - -function TTreeNode.CompareCount(CompareMe: Integer): Boolean; -var - Count: integer; - Node: TTreeNode; -Begin - Count := 0; - Result := False; - Node := GetFirstChild; - while Node <> nil do - begin - Inc(Count); - Node := Node.GetNextChild(Node); - if Count > CompareMe then Exit; - end; - if Count = CompareMe then Result := True; -end; - -function TTreeNode.DoCanExpand(Expand: Boolean): Boolean; -begin - Result := False; - if HasChildren then - begin - if Expand then Result := TreeView.CanExpand(Self) - else Result := TreeView.CanCollapse(Self); - end; -end; - -procedure TTreeNode.DoExpand(Expand: Boolean); -begin - if HasChildren then - begin - if Expand then TreeView.Expand(Self) - else TreeView.Collapse(Self); - end; -end; - -procedure TTreeNode.Collapse(Recurse: Boolean); -begin - ExpandItem(False, Recurse); -end; - -function TTreeNode.GetExpanded: Boolean; -begin - Result := GetState(nsExpanded); -end; - -procedure TTreeNode.SetExpanded(Value: Boolean); -begin - if Value then Expand(False) - else Collapse(False); -end; - -function TTreeNode.GetSelected: Boolean; -begin - Result := GetState(nsSelected); -end; - -procedure TTreeNode.SetSelected(Value: Boolean); -begin - if Value then TreeView_SelectItem(Handle, ItemId) - else if Selected then TreeView_SelectItem(Handle, nil); -end; - -function TTreeNode.GetCut: Boolean; -begin - Result := GetState(nsCut); -end; - -procedure TTreeNode.SetCut(Value: Boolean); -var - Item: TTVItem; - Template: DWORD; -begin - if Value then Template := DWORD(-1) - else Template := 0; - with Item do - begin - mask := TVIF_STATE; - hItem := ItemId; - stateMask := TVIS_CUT; - state := stateMask and Template; - end; - TreeView_SetItem(Handle, Item); -end; - -function TTreeNode.GetDropTarget: Boolean; -begin - Result := GetState(nsDropHilited); -end; - -procedure TTreeNode.SetDropTarget(Value: Boolean); -begin - if Value then TreeView_SelectDropTarget(Handle, ItemId) - else if DropTarget then TreeView_SelectDropTarget(Handle, nil); -end; - -function TTreeNode.GetChildren: Boolean; -var - Item: TTVItem; -begin - Item.mask := TVIF_CHILDREN; - Item.hItem := ItemId; - if TreeView_GetItem(Handle, Item) then Result := Item.cChildren > 0 - else Result := False; -end; - -procedure TTreeNode.SetFocused(Value: Boolean); -var - Item: TTVItem; - Template: DWORD; -begin - if Value then Template := DWORD(-1) - else Template := 0; - with Item do - begin - mask := TVIF_STATE; - hItem := ItemId; - stateMask := TVIS_FOCUSED; - state := stateMask and Template; - end; - TreeView_SetItem(Handle, Item); -end; - -function TTreeNode.GetFocused: Boolean; -begin - Result := GetState(nsFocused); -end; - -procedure TTreeNode.SetChildren(Value: Boolean); -var - Item: TTVItem; -begin - with Item do - begin - mask := TVIF_CHILDREN; - hItem := ItemId; - cChildren := Ord(Value); - end; - TreeView_SetItem(Handle, Item); -end; - -function TTreeNode.GetPrevSibling: TTreeNode; -begin - with FOwner do - Result := GetNode(TreeView_GetPrevSibling(Handle, ItemId)); -end; - -function TTreeNode.GetNextVisible: TTreeNode; -begin - if IsVisible then - with FOwner do - Result := GetNode(TreeView_GetNextVisible(Handle, ItemId)) - else Result := nil; -end; - -function TTreeNode.GetPrevVisible: TTreeNode; -begin - with FOwner do - Result := GetNode(TreeView_GetPrevVisible(Handle, ItemId)); -end; - -function TTreeNode.GetNextChild(Value: TTreeNode): TTreeNode; -begin - if Value <> nil then Result := Value.GetNextSibling - else Result := nil; -end; - -function TTreeNode.GetPrevChild(Value: TTreeNode): TTreeNode; -begin - if Value <> nil then Result := Value.GetPrevSibling - else Result := nil; -end; - - -function TTreeNode.GetPrev: TTreeNode; -var - Node: TTreeNode; -begin - Result := GetPrevSibling; - if Result <> nil then - begin - Node := Result; - repeat - Result := Node; - Node := Result.GetLastChild; - until Node = nil; - end else - Result := Parent; -end; - -function TTreeNode.GetAbsoluteIndex: Integer; -var - Node: TTreeNode; -begin - if Owner.FNodeCache.CacheNode = Self then - Result := Owner.FNodeCache.CacheIndex - else begin - Result := -1; - Node := Self; - while Node <> nil do - begin - Inc(Result); - Node := Node.GetPrev; - end; - end; -end; - -function TTreeNode.GetIndex: Integer; -var - Node: TTreeNode; -begin - Result := -1; - Node := Self; - while Node <> nil do - begin - Inc(Result); - Node := Node.GetPrevSibling; - end; -end; - -function TTreeNode.GetItem(Index: Integer): TTreeNode; -begin - Result := GetFirstChild; - while (Result <> nil) and (Index > 0) do - begin - Result := GetNextChild(Result); - Dec(Index); - end; - if Result = nil then TreeViewError(SListIndexError); -end; - -procedure TTreeNode.SetItem(Index: Integer; Value: TTreeNode); -begin - item[Index].Assign(Value); -end; - -function TTreeNode.IndexOf(Value: TTreeNode): Integer; -var - Node: TTreeNode; -begin - Result := -1; - Node := GetFirstChild; - while (Node <> nil) do - begin - Inc(Result); - if Node = Value then Break; - Node := GetNextChild(Node); - end; - if Node = nil then Result := -1; -end; - -function TTreeNode.GetCount: Integer; -var - Node: TTreeNode; -begin - Result := 0; - Node := GetFirstChild; - while Node <> nil do - begin - Inc(Result); - Node := Node.GetNextChild(Node); - end; -end; - -procedure TTreeNode.EndEdit(Cancel: Boolean); -begin - TreeView_EndEditLabelNow(Handle, Cancel); -end; - -procedure TTreeNode.InternalMove(ParentNode, Node: TTreeNode; - HItem: HTreeItem; AddMode: TAddMode); -var - I: Integer; - NodeId: HTreeItem; - TreeViewItem: TTVItem; - Children: Boolean; - IsSelected: Boolean; -begin - Owner.ClearCache; - if (AddMode = taInsert) and (Node <> nil) then - NodeId := Node.ItemId else - NodeId := nil; - Children := HasChildren; - IsSelected := Selected; - if (Parent <> nil) and (Parent.CompareCount(1)) then - begin - Parent.Expanded := False; - Parent.HasChildren := False; - end; - with TreeViewItem do - begin - mask := TVIF_PARAM; - hItem := ItemId; - lParam := 0; - end; - TreeView_SetItem(Handle, TreeViewItem); - with Owner do - HItem := AddItem(HItem, NodeId, CreateItem(Self), AddMode); - if HItem = nil then - raise EOutOfResources.Create(sInsertError); - for I := Count - 1 downto 0 do - Item[I].InternalMove(Self, nil, HItem, taAddFirst); - TreeView_DeleteItem(Handle, ItemId); - FItemId := HItem; - Assign(Self); - HasChildren := Children; - Selected := IsSelected; -end; - -procedure TTreeNode.MoveTo(Destination: TTreeNode; Mode: TNodeAttachMode); -var - AddMode: TAddMode; - Node: TTreeNode; - HItem: HTreeItem; - OldOnChanging: TTVChangingEvent; - OldOnChange: TTVChangedEvent; -begin - OldOnChanging := TreeView.OnChanging; - OldOnChange := TreeView.OnChange; - TreeView.OnChanging := nil; - TreeView.OnChange := nil; - try - if (Destination = nil) or not Destination.HasAsParent(Self) then - begin - AddMode := taAdd; - if (Destination <> nil) and not (Mode in [naAddChild, naAddChildFirst]) then - Node := Destination.Parent else - Node := Destination; - case Mode of - naAdd, - naAddChild: AddMode := taAdd; - naAddFirst, - naAddChildFirst: AddMode := taAddFirst; - naInsert: - begin - Destination := Destination.GetPrevSibling; - if Destination = nil then AddMode := taAddFirst - else AddMode := taInsert; - end; - end; - if Node <> nil then - HItem := Node.ItemId else - HItem := nil; - if (Destination <> Self) then - InternalMove(Node, Destination, HItem, AddMode); - Node := Parent; - if Node <> nil then - begin - Node.HasChildren := True; - Node.Expanded := True; - end; - end; - finally - TreeView.OnChanging := OldOnChanging; - TreeView.OnChange := OldOnChange; - end; -end; - -procedure TTreeNode.MakeVisible; -begin - TreeView_EnsureVisible(Handle, ItemId); -end; - -function TTreeNode.GetLevel: Integer; -var - Node: TTreeNode; -begin - Result := 0; - Node := Parent; - while Node <> nil do - begin - Inc(Result); - Node := Node.Parent; - end; -end; - -function TTreeNode.IsNodeVisible: Boolean; -var - Rect: TRect; -begin - Result := TreeView_GetItemRect(Handle, ItemId, Rect, True); -end; - -function TTreeNode.EditText: Boolean; -begin - Result := TreeView_EditLabel(Handle, ItemId) <> 0; -end; - -function TTreeNode.DisplayRect(TextOnly: Boolean): TRect; -begin - FillChar(Result, SizeOf(Result), 0); - TreeView_GetItemRect(Handle, ItemId, Result, TextOnly); -end; - -function TTreeNode.AlphaSort: Boolean; -begin - Result := CustomSort(nil, 0); -end; - -function TTreeNode.CustomSort(SortProc: TTVCompare; Data: Longint): Boolean; -var - SortCB: TTVSortCB; -begin - Owner.ClearCache; - with SortCB do - begin - if not Assigned(SortProc) then lpfnCompare := @DefaultTreeViewSort - else lpfnCompare := SortProc; - hParent := ItemId; - lParam := Data; - end; - Result := TreeView_SortChildrenCB(Handle, SortCB, 0); -end; - -procedure TTreeNode.Delete; -begin - if not Deleting then Free; -end; - -procedure TTreeNode.DeleteChildren; -begin - Owner.ClearCache; - TreeView_Expand(TreeView.Handle, ItemID, TVE_COLLAPSE or TVE_COLLAPSERESET); - HasChildren := False; -end; - -procedure TTreeNode.Assign(Source: TPersistent); -var - Node: TTreeNode; -begin - Owner.ClearCache; - if Source is TTreeNode then - begin - Node := TTreeNode(Source); - Text := Node.Text; - Data := Node.Data; - ImageIndex := Node.ImageIndex; - SelectedIndex := Node.SelectedIndex; - StateIndex := Node.StateIndex; - OverlayIndex := Node.OverlayIndex; - Focused := Node.Focused; - DropTarget := Node.DropTarget; - Cut := Node.Cut; - HasChildren := Node.HasChildren; - end - else inherited Assign(Source); -end; - -function TTreeNode.IsEqual(Node: TTreeNode): Boolean; -begin - Result := (Text = Node.Text) and (Data = Node.Data); -end; - -procedure TTreeNode.ReadData(Stream: TStream; Info: PNodeInfo); -var - I, Size, ItemCount: Integer; -begin - Owner.ClearCache; - Stream.ReadBuffer(Size, SizeOf(Size)); - Stream.ReadBuffer(Info^, Size); - Text := Info^.Text; - ImageIndex := Info^.ImageIndex; - SelectedIndex := Info^.SelectedIndex; - StateIndex := Info^.StateIndex; - OverlayIndex := Info^.OverlayIndex; - Data := Info^.Data; - ItemCount := Info^.Count; - for I := 0 to ItemCount - 1 do - Owner.AddChild(Self, '').ReadData(Stream, Info); -end; - -procedure TTreeNode.WriteData(Stream: TStream; Info: PNodeInfo); -var - I, Size, L, ItemCount: Integer; -begin - L := Length(Text); - if L > 255 then L := 255; - Size := SizeOf(TNodeInfo) + L - 255; - Info^.Text := Text; - Info^.ImageIndex := ImageIndex; - Info^.SelectedIndex := SelectedIndex; - Info^.OverlayIndex := OverlayIndex; - Info^.StateIndex := StateIndex; - Info^.Data := Data; - ItemCount := Count; - Info^.Count := ItemCount; - Stream.WriteBuffer(Size, SizeOf(Size)); - Stream.WriteBuffer(Info^, Size); - for I := 0 to ItemCount - 1 do Item[I].WriteData(Stream, Info); -end; - -*/ diff --git a/apps/X11/VCL/TTreeNode.h b/apps/X11/VCL/TTreeNode.h deleted file mode 100644 index 6d9647e..0000000 --- a/apps/X11/VCL/TTreeNode.h +++ /dev/null @@ -1,163 +0,0 @@ -#ifndef TTREENODE_H -#define TTREENODE_H - -#include <TPersistent.h> -#include <gtk/gtktreeitem.h> -#include <gtk/gtktree.h> -#include <gtk/gtkpixmap.h> -#include <string> - - class TTreeNodes; - - enum TNodeState {nsCut, nsDropHilited, nsFocused, nsSelected, nsExpanded}; - enum TNodeAttachMode {naAdd, naAddFirst, naAddChild, naAddChildFirst, naInsert}; - enum TAddMode {taAddFirst, taAdd, taInsert}; - - typedef struct { - int ImageIndex; - int SelectedIndex; - int StateIndex; - int OverlayIndex; - void *Data; - int Count; - char Text[255]; - } TNodeInfo; - - -class TTreeNode: public TPersistent { -friend class TTreeNodes; -private: - TTreeNodes *FOwner; - GtkTree *subTreeOwner; - GtkPixmap *image; - GtkPixmap *stateImage; - string FText; - void *FData; -// FStateIndex: Integer; - int FStateIndex; -// FImageIndex: Integer; - int FImageIndex; -/* - FItemId: HTreeItem; - FSelectedIndex: Integer; - FOverlayIndex: Integer; - FDeleting: Boolean; - FInTree: Boolean; - function CompareCount(CompareMe: Integer): Boolean; - function DoCanExpand(Expand: Boolean): Boolean; - procedure DoExpand(Expand: Boolean); - function GetAbsoluteIndex: Integer; - function GetExpanded: Boolean; - function GetLevel: Integer; - function GetChildren: Boolean; - function GetCut: Boolean; - function GetDropTarget: Boolean; - function GetFocused: Boolean; - function GetIndex: Integer; - function GetItem(Index: Integer): TTreeNode; - function GetSelected: Boolean; - function GetState(NodeState: TNodeState): Boolean; - function GetCount: Integer; - function GetTreeView: TCustomTreeView; - procedure InternalMove(ParentNode, Node: TTreeNode; HItem: HTreeItem; - AddMode: TAddMode); - function IsEqual(Node: TTreeNode): Boolean; - function IsNodeVisible: Boolean; - procedure ReadData(Stream: TStream; Info: PNodeInfo); - procedure SetChildren(Value: Boolean); - procedure SetCut(Value: Boolean); - procedure SetDropTarget(Value: Boolean); - procedure SetItem(Index: Integer; Value: TTreeNode); - procedure SetExpanded(Value: Boolean); - procedure SetFocused(Value: Boolean); - procedure SetOverlayIndex(Value: Integer); - procedure SetSelectedIndex(Value: Integer); - procedure SetSelected(Value: Boolean); - procedure WriteData(Stream: TStream; Info: PNodeInfo); -*/ -// procedure ExpandItem(Expand: Boolean; Recurse: Boolean); - void ExpandItem(bool Expand, bool Recurse); -// procedure SetData(Value: Pointer); - void SetData(void *); - void *getData() { return FData; } -// procedure SetText(const S: string); - void SetText(string S); - string getText() { return FText; } -// function GetParent: TTreeNode; - TTreeNode *GetParent(); -// procedure SetStateIndex(Value: Integer); - void SetStateIndex(int val); - int getStateIndex() { return FStateIndex; } -// procedure SetImageIndex(Value: Integer); - void SetImageIndex(int val); - int getImageIndex() { return FImageIndex; } - public: - GtkTreeItem *nativeControl; - TTreeNode(TTreeNodes *AOwner); - TTreeNode(const TTreeNode &other); // copy constructor; - TTreeNode(TTreeNodes *AOwner, GtkTree *subTreeOwner, GtkTreeItem *nativeControl, string FText, void *Ptr = 0); - ~TTreeNode(); - TTreeNode *getNextSibling(); -// function getFirstChild: TTreeNode; - TTreeNode *getFirstChild(); -// function GetNext: TTreeNode; - TTreeNode *GetNext(); -// property Text: string read FText write SetText; - property <TTreeNode, string> Text; -// property StateIndex: Integer read FStateIndex write SetStateIndex; - property <TTreeNode, int> StateIndex; -// property ImageIndex: Integer read FImageIndex write SetImageIndex; - property <TTreeNode, int> ImageIndex; -// property Data: Pointer read FData write SetData; - property <TTreeNode, void *> Data; -// property Parent: TTreeNode read GetParent; - property <TTreeNode, TTreeNode *> Parent; - -// procedure Expand(Recurse: Boolean); - void Expand(bool Recurse); -// procedure MakeVisible; - void MakeVisible(); -/* - function AlphaSort: Boolean; - procedure Assign(Source: TPersistent); override; - procedure Collapse(Recurse: Boolean); - function CustomSort(SortProc: TTVCompare; Data: Longint): Boolean; - procedure Delete; - procedure DeleteChildren; - function DisplayRect(TextOnly: Boolean): TRect; - function EditText: Boolean; - procedure EndEdit(Cancel: Boolean); - function GetHandle: HWND; - function GetLastChild: TTreeNode; - function GetNextChild(Value: TTreeNode): TTreeNode; - function GetNextVisible: TTreeNode; - function GetPrev: TTreeNode; - function GetPrevChild(Value: TTreeNode): TTreeNode; - function getPrevSibling: TTreeNode; - function GetPrevVisible: TTreeNode; - function HasAsParent(Value: TTreeNode): Boolean; - function IndexOf(Value: TTreeNode): Integer; - procedure MoveTo(Destination: TTreeNode; Mode: TNodeAttachMode); virtual; - property AbsoluteIndex: Integer read GetAbsoluteIndex; - property Count: Integer read GetCount; - property Cut: Boolean read GetCut write SetCut; - property Deleting: Boolean read FDeleting; - property Focused: Boolean read GetFocused write SetFocused; - property DropTarget: Boolean read GetDropTarget write SetDropTarget; - property Selected: Boolean read GetSelected write SetSelected; - property Expanded: Boolean read GetExpanded write SetExpanded; - property Handle: HWND read GetHandle; - property HasChildren: Boolean read GetChildren write SetChildren; - property Index: Integer read GetIndex; - property IsVisible: Boolean read IsNodeVisible; - property Item[Index: Integer]: TTreeNode read GetItem write SetItem; default; - property ItemId: HTreeItem read FItemId; - property Level: Integer read GetLevel; - property OverlayIndex: Integer read FOverlayIndex write SetOverlayIndex; - property Owner: TTreeNodes read FOwner; - property SelectedIndex: Integer read FSelectedIndex write SetSelectedIndex; - property TreeView: TCustomTreeView read GetTreeView; -*/ -}; - -#endif diff --git a/apps/X11/VCL/TTreeNodes.cpp b/apps/X11/VCL/TTreeNodes.cpp deleted file mode 100644 index 77657e6..0000000 --- a/apps/X11/VCL/TTreeNodes.cpp +++ /dev/null @@ -1,553 +0,0 @@ -#include <TTreeNodes.h> - -#include <gtk/gtkhbox.h> -#include <gtk/gtklabel.h> -#include <stdio.h> - -TTreeNodes::TTreeNodes(TCustomTreeView *AOwner) { - FOwner = AOwner; -} - - -TTreeNodes::~TTreeNodes() { -} - - -/* -procedure TTreeNodes.Clear; -begin - ClearCache; - if Owner.HandleAllocated then - TreeView_DeleteAllItems(Handle); -end; - -*/ -void TTreeNodes::Clear() { - gtk_tree_remove_items(GTK_TREE(FOwner->nativeControl), GTK_TREE(FOwner->nativeControl)->children); - nodeCache.erase(nodeCache.begin(), nodeCache.end()); -} - - -/* -function TTreeNodes.GetFirstNode: TTreeNode; -begin - Result := GetNode(TreeView_GetRoot(Handle)); -end; -*/ - -TTreeNode *TTreeNodes::GetFirstNode() { - GList *first = g_list_first(GTK_TREE(FOwner->nativeControl)->children); - return (first) ? GetNode(GTK_TREE_ITEM(first->data)) : 0; -} - -/* -function TTreeNodes.GetNode(ItemId: HTreeItem): TTreeNode; -var - Item: TTVItem; -begin - with Item do - begin - hItem := ItemId; - mask := TVIF_PARAM; - end; - if TreeView_GetItem(Handle, Item) then Result := TTreeNode(Item.lParam) - else Result := nil; -end; -*/ - -TTreeNode *TTreeNodes::GetNode(GtkTreeItem *subElement) { - TTreeNodeMap::iterator node; - node = nodeCache.find(subElement); - if (node != nodeCache.end()) - return &(node->second); - else return 0; -} - - -GtkTreeItem *TTreeNodes::GetParentNode(GtkTreeItem *root, GtkTreeItem *subElement) { - GtkWidget *subtree = root->subtree; - if (subtree) { - for (GList *nodes = GTK_TREE(subtree)->children; nodes; nodes = g_list_next(nodes)) { - if (nodes->data == subElement) - return root; - GtkTreeItem *ret = GetParentNode(GTK_TREE_ITEM(nodes->data), subElement); - if (ret) - return ret; - } - } - return 0; -} - - -TTreeNode *TTreeNodes::GetParentNode(TTreeNode *target) { - for (GList *nodes = g_list_first(GTK_TREE(FOwner->nativeControl)->children); nodes; nodes = g_list_next(nodes)) { - if (nodes->data == target->nativeControl) - return 0; // top level; no parent - GtkTreeItem *ret = GetParentNode(GTK_TREE_ITEM(nodes->data), target->nativeControl); - if (ret) - return GetNode(ret); - } - return 0; -} - - -/* -function TTreeNodes.AddChildFirst(Node: TTreeNode; const S: string): TTreeNode; -begin - Result := AddChildObjectFirst(Node, S, nil); -end; -*/ - -GtkTree *TTreeNodes::getSubTree(TTreeNode *node) { - GtkWidget *subtree; - - if (!node) - subtree = FOwner->nativeControl; - else { - subtree = node->nativeControl->subtree; - if (!subtree) { - subtree = gtk_tree_new(); - gtk_tree_set_selection_mode (GTK_TREE(subtree), GTK_SELECTION_SINGLE); - gtk_tree_set_view_mode (GTK_TREE(subtree), GTK_TREE_VIEW_ITEM); - gtk_tree_item_set_subtree (node->nativeControl, subtree); - } - } - return GTK_TREE(subtree); -} - - -GtkTreeItem *TTreeNodes::createTreeItem(GtkWidget *parent, const char *label) { - GtkWidget *treeitem; - GtkWidget *hbox1; - GtkWidget *label1; - GdkPixmap *pixmap; - GdkBitmap *mask; - GtkWidget *pixmap1; - GtkWidget *pixmap2; - GtkStyle *style; - GdkWindow *window = 0; - - treeitem = gtk_tree_item_new (); - - hbox1 = gtk_hbox_new (FALSE, 0); - gtk_widget_show (hbox1); - gtk_container_add (GTK_CONTAINER (treeitem), hbox1); - - while ((!window) && (parent->parent)) { - window = gtk_widget_get_parent_window(GTK_WIDGET(parent)); - parent = parent->parent; - } - style = gtk_widget_get_style( GTK_WIDGET(parent) ); - pixmap = gdk_pixmap_create_from_xpm_d( window, &mask, - &style->bg[GTK_STATE_NORMAL], - (gchar **)default_xpm ); - - pixmap1 = gtk_pixmap_new( pixmap, mask ); - gtk_widget_hide (pixmap1); - gtk_box_pack_start (GTK_BOX (hbox1), pixmap1, FALSE, TRUE, 0); - gtk_object_set_data (GTK_OBJECT (hbox1), "pixmap1", pixmap1); - pixmap2 = gtk_pixmap_new( pixmap, mask ); - gtk_widget_hide (pixmap2); - gtk_box_pack_start (GTK_BOX (hbox1), pixmap2, FALSE, TRUE, 0); - gtk_object_set_data (GTK_OBJECT (hbox1), "pixmap2", pixmap2); - - label1 = gtk_label_new (label); - gtk_widget_ref (label1); - gtk_object_set_data (GTK_OBJECT (hbox1), "label1", label1); - gtk_widget_show (label1); - gtk_box_pack_start (GTK_BOX (hbox1), label1, FALSE, FALSE, 3); - - return GTK_TREE_ITEM(treeitem); -} - - -TTreeNode *TTreeNodes::AddChildFirst(TTreeNode *Node, const string S) { - GtkTree *subtree; - GtkTreeItem *item; - - subtree = getSubTree(Node); - item = createTreeItem(GTK_WIDGET(subtree), (const char *)S.c_str()); - gtk_tree_prepend(subtree, GTK_WIDGET(item)); - gtk_widget_show(GTK_WIDGET(item)); - nodeCache.insert(TTreeNodeMap::value_type(item, TTreeNode(this, subtree, item, S))); - return GetNode(item); -} -TTreeNode *TTreeNodes::AddChild(TTreeNode *Node, const string S) { - GtkTree *subtree; - GtkTreeItem *item; - - subtree = getSubTree(Node); - item = createTreeItem(GTK_WIDGET(subtree), (const char *)S.c_str()); - gtk_tree_append(subtree, GTK_WIDGET(item)); - gtk_widget_show(GTK_WIDGET(item)); - nodeCache.insert(TTreeNodeMap::value_type(item, TTreeNode(this, subtree, item, S))); - return GetNode(item); -} -TTreeNode *TTreeNodes::AddChildObject(TTreeNode *Node, const string S, void *Ptr) { - GtkTree *subtree; - GtkTreeItem *item; - - - subtree = getSubTree(Node); - item = createTreeItem(GTK_WIDGET(subtree), (const char *)S.c_str()); - gtk_tree_append(subtree, GTK_WIDGET(item)); - gtk_widget_show(GTK_WIDGET(item)); - nodeCache.insert(TTreeNodeMap::value_type(item, TTreeNode(this, subtree, item, S))); - TTreeNode *node = GetNode(item); - if (node) - node->Data = Ptr; - - return node; -} - -/* -function TTreeNodes.AddChildObjectFirst(Node: TTreeNode; const S: string; - Ptr: Pointer): TTreeNode; -begin - Result := InternalAddObject(Node, S, Ptr, taAddFirst); -end; - -function TTreeNodes.InternalAddObject(Node: TTreeNode; const S: string; - Ptr: Pointer; AddMode: TAddMode): TTreeNode; -var - Item: HTreeItem; -begin - Result := Owner.CreateNode; - try - if Node <> nil then Item := Node.ItemId - else Item := nil; - Result.Data := Ptr; - Result.Text := S; - Item := AddItem(Item, nil, CreateItem(Result), AddMode); - if Item = nil then - raise EOutOfResources.Create(sInsertError); - Result.FItemId := Item; - AddedNode(Node); - except - Result.Free; - raise; - end; -end; - -function TTreeNodes.AddItem(Parent, Target: HTreeItem; - const Item: TTVItem; AddMode: TAddMode): HTreeItem; -var - InsertStruct: TTVInsertStruct; -begin - ClearCache; - with InsertStruct do - begin - hParent := Parent; - case AddMode of - taAddFirst: - hInsertAfter := TVI_FIRST; - taAdd: - hInsertAfter := TVI_LAST; - taInsert: - hInsertAfter := Target; - end; - end; - InsertStruct.item := Item; - FOwner.FChangeTimer.Enabled := False; - Result := TreeView_InsertItem(Handle, InsertStruct); -end; -*/ - - -/* -{ TTreeNodes } - -constructor TTreeNodes.Create(AOwner: TCustomTreeView); -begin - inherited Create; - FOwner := AOwner; -end; - -destructor TTreeNodes.Destroy; -begin - Clear; - inherited Destroy; -end; - -function TTreeNodes.GetCount: Integer; -begin - if Owner.HandleAllocated then Result := TreeView_GetCount(Handle) - else Result := 0; -end; - -function TTreeNodes.GetHandle: HWND; -begin - Result := Owner.Handle; -end; - -procedure TTreeNodes.Delete(Node: TTreeNode); -begin - if (Node.ItemId = nil) then - Owner.Delete(Node); - Node.Delete; -end; - -function TTreeNodes.AddChild(Node: TTreeNode; const S: string): TTreeNode; -begin - Result := AddChildObject(Node, S, nil); -end; - -function TTreeNodes.AddChildObject(Node: TTreeNode; const S: string; - Ptr: Pointer): TTreeNode; -begin - Result := InternalAddObject(Node, S, Ptr, taAdd); -end; - -function TTreeNodes.AddFirst(Node: TTreeNode; const S: string): TTreeNode; -begin - Result := AddObjectFirst(Node, S, nil); -end; - -function TTreeNodes.AddObjectFirst(Node: TTreeNode; const S: string; - Ptr: Pointer): TTreeNode; -begin - if Node <> nil then Node := Node.Parent; - Result := InternalAddObject(Node, S, Ptr, taAddFirst); -end; - -function TTreeNodes.Add(Node: TTreeNode; const S: string): TTreeNode; -begin - Result := AddObject(Node, S, nil); -end; - -procedure TTreeNodes.Repaint(Node: TTreeNode); -var - R: TRect; -begin - if FUpdateCount < 1 then - begin - while (Node <> nil) and not Node.IsVisible do Node := Node.Parent; - if Node <> nil then - begin - R := Node.DisplayRect(False); - InvalidateRect(Owner.Handle, @R, True); - end; - end; -end; - -function TTreeNodes.AddObject(Node: TTreeNode; const S: string; - Ptr: Pointer): TTreeNode; -begin - if Node <> nil then Node := Node.Parent; - Result := InternalAddObject(Node, S, Ptr, taAdd); -end; - -function TTreeNodes.Insert(Node: TTreeNode; const S: string): TTreeNode; -begin - Result := InsertObject(Node, S, nil); -end; - -procedure TTreeNodes.AddedNode(Value: TTreeNode); -begin - if Value <> nil then - begin - Value.HasChildren := True; - Repaint(Value); - end; -end; - -function TTreeNodes.InsertObject(Node: TTreeNode; const S: string; - Ptr: Pointer): TTreeNode; -var - Item, ItemId: HTreeItem; - Parent: TTreeNode; - AddMode: TAddMode; -begin - Result := Owner.CreateNode; - try - Item := nil; - ItemId := nil; - Parent := nil; - AddMode := taInsert; - if Node <> nil then - begin - Parent := Node.Parent; - if Parent <> nil then Item := Parent.ItemId; - Node := Node.GetPrevSibling; - if Node <> nil then ItemId := Node.ItemId - else AddMode := taAddFirst; - end; - Result.Data := Ptr; - Result.Text := S; - Item := AddItem(Item, ItemId, CreateItem(Result), AddMode); - if Item = nil then - raise EOutOfResources.Create(sInsertError); - Result.FItemId := Item; - AddedNode(Parent); - except - Result.Free; - raise; - end; -end; - -function TTreeNodes.CreateItem(Node: TTreeNode): TTVItem; -begin - Node.FInTree := True; - with Result do - begin - mask := TVIF_TEXT or TVIF_PARAM or TVIF_IMAGE or TVIF_SELECTEDIMAGE; - lParam := Longint(Node); - pszText := LPSTR_TEXTCALLBACK; - iImage := I_IMAGECALLBACK; - iSelectedImage := I_IMAGECALLBACK; - end; -end; - - -function TTreeNodes.GetNodeFromIndex(Index: Integer): TTreeNode; -var - I: Integer; -begin - if Index < 0 then TreeViewError(sInvalidIndex); - if (FNodeCache.CacheNode <> nil) and (Abs(FNodeCache.CacheIndex - Index) <= 1) then - begin - with FNodeCache do - begin - if Index = CacheIndex then Result := CacheNode - else if Index < CacheIndex then Result := CacheNode.GetPrev - else Result := CacheNode.GetNext; - end; - end - else begin - Result := GetFirstNode; - I := Index; - while (I <> 0) and (Result <> nil) do - begin - Result := Result.GetNext; - Dec(I); - end; - end; - if Result = nil then TreeViewError(sInvalidIndex); - FNodeCache.CacheNode := Result; - FNodeCache.CacheIndex := Index; -end; - -function TTreeNodes.GetNode(ItemId: HTreeItem): TTreeNode; -var - Item: TTVItem; -begin - with Item do - begin - hItem := ItemId; - mask := TVIF_PARAM; - end; - if TreeView_GetItem(Handle, Item) then Result := TTreeNode(Item.lParam) - else Result := nil; -end; - -procedure TTreeNodes.SetItem(Index: Integer; Value: TTreeNode); -begin - GetNodeFromIndex(Index).Assign(Value); -end; - -procedure TTreeNodes.BeginUpdate; -begin - if FUpdateCount = 0 then SetUpdateState(True); - Inc(FUpdateCount); -end; - -procedure TTreeNodes.SetUpdateState(Updating: Boolean); -begin - SendMessage(Handle, WM_SETREDRAW, Ord(not Updating), 0); - if not Updating then Owner.Refresh; -end; - -procedure TTreeNodes.EndUpdate; -begin - Dec(FUpdateCount); - if FUpdateCount = 0 then SetUpdateState(False); -end; - -procedure TTreeNodes.Assign(Source: TPersistent); -var - TreeNodes: TTreeNodes; - MemStream: TMemoryStream; -begin - ClearCache; - if Source is TTreeNodes then - begin - TreeNodes := TTreeNodes(Source); - Clear; - MemStream := TMemoryStream.Create; - try - TreeNodes.WriteData(MemStream); - MemStream.Position := 0; - ReadData(MemStream); - finally - MemStream.Free; - end; - end - else inherited Assign(Source); -end; - -procedure TTreeNodes.DefineProperties(Filer: TFiler); - - function WriteNodes: Boolean; - var - I: Integer; - Nodes: TTreeNodes; - begin - Nodes := TTreeNodes(Filer.Ancestor); - if Nodes = nil then - Result := Count > 0 - else if Nodes.Count <> Count then - Result := True - else - begin - Result := False; - for I := 0 to Count - 1 do - begin - Result := not Item[I].IsEqual(Nodes[I]); - if Result then Break; - end - end; - end; - -begin - inherited DefineProperties(Filer); - Filer.DefineBinaryProperty('Data', ReadData, WriteData, WriteNodes); -end; - -procedure TTreeNodes.ReadData(Stream: TStream); -var - I, Count: Integer; - NodeInfo: TNodeInfo; -begin - Clear; - Stream.ReadBuffer(Count, SizeOf(Count)); - for I := 0 to Count - 1 do - Add(nil, '').ReadData(Stream, @NodeInfo); -end; - -procedure TTreeNodes.WriteData(Stream: TStream); -var - I: Integer; - Node: TTreeNode; - NodeInfo: TNodeInfo; -begin - I := 0; - Node := GetFirstNode; - while Node <> nil do - begin - Inc(I); - Node := Node.GetNextSibling; - end; - Stream.WriteBuffer(I, SizeOf(I)); - Node := GetFirstNode; - while Node <> nil do - begin - Node.WriteData(Stream, @NodeInfo); - Node := Node.GetNextSibling; - end; -end; - -procedure TTreeNodes.ClearCache; -begin - FNodeCache.CacheNode := nil; -end; -*/ diff --git a/apps/X11/VCL/TTreeNodes.h b/apps/X11/VCL/TTreeNodes.h deleted file mode 100644 index ed28bad..0000000 --- a/apps/X11/VCL/TTreeNodes.h +++ /dev/null @@ -1,90 +0,0 @@ -#ifndef TTREENODES_H -#define TTREENODES_H - -#include <TTreeNode.h> -#include <TCustomTreeView.h> -#include <map> - - -static char * default_xpm[] = { -"1 1 2 1", -" c None", -". c #FFFFFF", -"."}; - - -/* - TNodeCache = record - CacheNode: TTreeNode; - CacheIndex: Integer; - end; -*/ - -typedef map <GtkTreeItem *, TTreeNode> TTreeNodeMap; - -class TTreeNodes: public TPersistent { -friend class TTreeNode; -private: -// FOwner: TCustomTreeView; - TCustomTreeView *FOwner; - TTreeNodeMap nodeCache; -// function GetNode(ItemId: HTreeItem): TTreeNode; -/* - FUpdateCount: Integer; - FNodeCache: TNodeCache; - procedure AddedNode(Value: TTreeNode); - function GetHandle: HWND; - function GetNodeFromIndex(Index: Integer): TTreeNode; - procedure ReadData(Stream: TStream); - procedure Repaint(Node: TTreeNode); - procedure WriteData(Stream: TStream); - procedure ClearCache; - protected - function AddItem(Parent, Target: HTreeItem; const Item: TTVItem; - AddMode: TAddMode): HTreeItem; - function InternalAddObject(Node: TTreeNode; const S: string; - Ptr: Pointer; AddMode: TAddMode): TTreeNode; - procedure DefineProperties(Filer: TFiler); override; - function CreateItem(Node: TTreeNode): TTVItem; - function GetCount: Integer; - procedure SetItem(Index: Integer; Value: TTreeNode); - procedure SetUpdateState(Updating: Boolean); -*/ - GtkTree *getSubTree(TTreeNode *node); - GtkTreeItem *createTreeItem(GtkWidget *parent, const char *label); -public: - TTreeNodes(TCustomTreeView *AOwner); - virtual ~TTreeNodes(); -// procedure Clear; - void Clear(); - TTreeNode *GetFirstNode(); - TTreeNode *GetNode(GtkTreeItem *subElement); - GtkTreeItem *GetParentNode(GtkTreeItem *root, GtkTreeItem *subElement); - TTreeNode *GetParentNode(TTreeNode *target); - TTreeNode *AddChildFirst(TTreeNode *Node, const string S); - TTreeNode *AddChild(TTreeNode *Node, const string S); - TTreeNode *AddChildObject(TTreeNode *Node, const string S, void *Ptr); -/* - function AddChildObjectFirst(Node: TTreeNode; const S: string; - Ptr: Pointer): TTreeNode; - function AddFirst(Node: TTreeNode; const S: string): TTreeNode; - function Add(Node: TTreeNode; const S: string): TTreeNode; - function AddObjectFirst(Node: TTreeNode; const S: string; - Ptr: Pointer): TTreeNode; - function AddObject(Node: TTreeNode; const S: string; - Ptr: Pointer): TTreeNode; - procedure Assign(Source: TPersistent); override; - procedure BeginUpdate; - procedure Delete(Node: TTreeNode); - procedure EndUpdate; - function Insert(Node: TTreeNode; const S: string): TTreeNode; - function InsertObject(Node: TTreeNode; const S: string; - Ptr: Pointer): TTreeNode; - property Count: Integer read GetCount; - property Handle: HWND read GetHandle; - property Item[Index: Integer]: TTreeNode read GetNodeFromIndex; default; - property Owner: TCustomTreeView read FOwner; -*/ -}; - -#endif diff --git a/apps/X11/VCL/TTreeView.cpp b/apps/X11/VCL/TTreeView.cpp deleted file mode 100644 index 3d17529..0000000 --- a/apps/X11/VCL/TTreeView.cpp +++ /dev/null @@ -1 +0,0 @@ -#include <TTreeView.h> diff --git a/apps/X11/VCL/TTreeView.h b/apps/X11/VCL/TTreeView.h deleted file mode 100644 index af71e4e..0000000 --- a/apps/X11/VCL/TTreeView.h +++ /dev/null @@ -1,92 +0,0 @@ -#ifndef TTREEVIEW_H -#define TTREEVIEW_H - -#include <TCustomTreeView.h> - -class TTreeView : public TCustomTreeView { -public: -// property Items; - property <TTreeView, TTreeNodes *> Items; -// property StateImages; - property <TTreeView, TCustomImageList *> StateImages; -// property Images; - property <TTreeView, TCustomImageList *> Images; -//published: -/* - property Align; - property Anchors; - property AutoExpand; - property BiDiMode; - property BorderStyle; - property BorderWidth; - property ChangeDelay; - property Color; - property Ctl3D; - property Constraints; - property DragKind; - property DragCursor; - property DragMode; - property Enabled; - property Font; - property HideSelection; - property HotTrack; - property Indent; - property ParentBiDiMode; - property ParentColor default False; - property ParentCtl3D; - property ParentFont; - property ParentShowHint; - property PopupMenu; - property ReadOnly; - property RightClickSelect; - property RowSelect; - property ShowButtons; - property ShowHint; - property ShowLines; - property ShowRoot; - property SortType; - property TabOrder; - property TabStop default True; - property ToolTips; - property Visible; - property OnChange; - property OnChanging; - property OnClick; - property OnCollapsing; - property OnCollapsed; - property OnCompare; - property OnCustomDraw; - property OnCustomDrawItem; - property OnDblClick; - property OnDeletion; - property OnDragDrop; - property OnDragOver; - property OnEdited; - property OnEditing; - property OnEndDock; - property OnEndDrag; - property OnEnter; - property OnExit; - property OnExpanding; - property OnExpanded; - property OnGetImageIndex; - property OnGetSelectedIndex; - property OnKeyDown; - property OnKeyPress; - property OnKeyUp; - property OnMouseDown; - property OnMouseMove; - property OnMouseUp; - property OnStartDock; - property OnStartDrag; -*/ -public: - TTreeView(GtkWidget *parent) : - TCustomTreeView(parent), - Items(this, &TCustomTreeView::getItems, &TCustomTreeView::SetTreeNodes), - StateImages(this, &TCustomTreeView::getStateImages, &TCustomTreeView::SetStateImages), - Images(this, &TCustomTreeView::getImages, &TCustomTreeView::SetImages) - {} -}; - -#endif diff --git a/apps/X11/VCL/TWinControl.cpp b/apps/X11/VCL/TWinControl.cpp deleted file mode 100644 index 79edfe8..0000000 --- a/apps/X11/VCL/TWinControl.cpp +++ /dev/null @@ -1,16 +0,0 @@ -#include <TWinControl.h> -extern "C" { -#include <gtk/gtkwidget.h> -} - -TWinControl::TWinControl(TComponent *AOwner) : TControl(AOwner) { -} - - -TWinControl::TWinControl(GtkWidget *ParentWindow) : TControl(0) { -} - - -TWinControl::~TWinControl() { -} - diff --git a/apps/X11/VCL/TWinControl.h b/apps/X11/VCL/TWinControl.h deleted file mode 100644 index b16e1b2..0000000 --- a/apps/X11/VCL/TWinControl.h +++ /dev/null @@ -1,331 +0,0 @@ -#ifndef TWINCONTROL_H -#define TWINCONTROL_H - -#include <TControl.h> -extern "C" { -#include <gtk/gtkwidget.h> -} - -class TWinControl : public TControl { -private: -/* - FAlignLevel: Word; - FBevelEdges: TBevelEdges; - FBevelInner: TBevelCut; - FBevelOuter: TBevelCut; - FBevelKind: TBevelKind; - FBevelWidth: TBevelWidth; - FBorderWidth: TBorderWidth; - FBrush: TBrush; - FControls: TList; - FCtl3D: Boolean; - FDefWndProc: Pointer; - FDockClients: TList; - FDockSite: Boolean; - FDockManager: IDockManager; - FHandle: HWnd; - FHelpContext: THelpContext; - FImeMode: TImeMode; - FImeName: TImeName; - FLastClientWidth: Integer; - FLastClientHeight: Integer; - FLastResize: TPoint; - FObjectInstance: Pointer; - FParentCtl3D: Boolean; - FParentWindow: HWnd; - FShowing: Boolean; - FTabList: TList; - FTabOrder: Integer; - FTabStop: Boolean; - FWheelAccumulator: Integer; - FUseDockManager: Boolean; - FWinControls: TList; - FOnDockDrop: TDockDropEvent; - FOnDockOver: TDockOverEvent; - FOnEnter: TNotifyEvent; - FOnExit: TNotifyEvent; - FOnGetSiteInfo: TGetSiteInfoEvent; - FOnKeyDown: TKeyEvent; - FOnKeyPress: TKeyPressEvent; - FOnKeyUp: TKeyEvent; - FOnMouseWheel: TMouseWheelEvent; - FOnMouseWheelDown: TMouseWheelUpDownEvent; - FOnMouseWheelUp: TMouseWheelUpDownEvent; - FOnUnDock: TUnDockEvent; - procedure AlignControl(AControl: TControl); - procedure CalcConstraints(var MinWidth, MinHeight, MaxWidth, - MaxHeight: Integer); - function GetControl(Index: Integer): TControl; - function GetControlCount: Integer; - function GetDockClientCount: Integer; - function GetDockClients(Index: Integer): TControl; - function GetHandle: HWnd; - function GetTabOrder: TTabOrder; - procedure Insert(AControl: TControl); - procedure InvalidateFrame; - function IsCtl3DStored: Boolean; - function IsHelpContextStored: Boolean; - function PrecedingWindow(Control: TWinControl): HWnd; - procedure Remove(AControl: TControl); - procedure RemoveFocus(Removing: Boolean); - procedure SetBevelCut(Index: Integer; const Value: TBevelCut); - procedure SetBevelEdges(const Value: TBevelEdges); - procedure SetBevelKind(const Value: TBevelKind); - procedure SetBevelWidth(const Value: TBevelWidth); - procedure SetBorderWidth(Value: TBorderWidth); - procedure SetCtl3D(Value: Boolean); - procedure SetDockSite(Value: Boolean); - procedure SetParentCtl3D(Value: Boolean); - procedure SetParentWindow(Value: HWnd); - procedure SetTabOrder(Value: TTabOrder); - procedure SetTabStop(Value: Boolean); - procedure SetUseDockManager(Value: Boolean); - procedure SetZOrderPosition(Position: Integer); - procedure UpdateLastResize(NewWidth, NewHeight: Integer); override; - procedure UpdateTabOrder(Value: TTabOrder); - procedure UpdateBounds; - procedure UpdateShowing; - function IsMenuKey(var Message: TWMKey): Boolean; - procedure WMPaint(var Message: TWMPaint); message WM_PAINT; - procedure WMCommand(var Message: TWMCommand); message WM_COMMAND; - procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY; - procedure WMSysColorChange(var Message: TWMSysColorChange); message WM_SYSCOLORCHANGE; - procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL; - procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL; - procedure WMCompareItem(var Message: TWMCompareItem); message WM_COMPAREITEM; - procedure WMDeleteItem(var Message: TWMDeleteItem); message WM_DELETEITEM; - procedure WMDrawItem(var Message: TWMDrawItem); message WM_DRAWITEM; - procedure WMMeasureItem(var Message: TWMMeasureItem); message WM_MEASUREITEM; - procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND; - procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED; - procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING; - procedure WMSize(var Message: TWMSize); message WM_SIZE; - procedure WMMove(var Message: TWMMove); message WM_MOVE; - procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR; - procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN; - procedure WMSysKeyDown(var Message: TWMKeyDown); message WM_SYSKEYDOWN; - procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP; - procedure WMSysKeyUp(var Message: TWMKeyUp); message WM_SYSKEYUP; - procedure WMChar(var Message: TWMChar); message WM_CHAR; - procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND; - procedure WMCharToItem(var Message: TWMCharToItem); message WM_CHARTOITEM; - procedure WMParentNotify(var Message: TWMParentNotify); message WM_PARENTNOTIFY; - procedure WMVKeyToItem(var Message: TWMVKeyToItem); message WM_VKEYTOITEM; - procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY; - procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE; - procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY; - procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; - procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT; - procedure WMQueryNewPalette(var Message: TMessage); message WM_QUERYNEWPALETTE; - procedure WMPaletteChanged(var Message: TMessage); message WM_PALETTECHANGED; - procedure WMWinIniChange(var Message: TMessage); message WM_WININICHANGE; - procedure WMFontChange(var Message: TMessage); message WM_FONTCHANGE; - procedure WMTimeChange(var Message: TMessage); message WM_TIMECHANGE; - procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS; - procedure WMKillFocus(var Message: TWMSetFocus); message WM_KILLFOCUS; - procedure WMIMEStartComp(var Message: TMessage); message WM_IME_STARTCOMPOSITION; - procedure WMIMEEndComp(var Message: TMessage); message WM_IME_ENDCOMPOSITION; - procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL; - procedure CMChanged(var Message: TMessage); message CM_CHANGED; - procedure CMChildKey(var Message: TMessage); message CM_CHILDKEY; - procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY; - procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR; - procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED; - procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED; - procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; - procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED; - procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; - procedure CMBorderChanged(var Message: TMessage); message CM_BORDERCHANGED; - procedure CMCursorChanged(var Message: TMessage); message CM_CURSORCHANGED; - procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED; - procedure CMParentCtl3DChanged(var Message: TMessage); message CM_PARENTCTL3DCHANGED; - procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED; - procedure CMShowHintChanged(var Message: TMessage); message CM_SHOWHINTCHANGED; - procedure CMEnter(var Message: TCMEnter); message CM_ENTER; - procedure CMExit(var Message: TCMExit); message CM_EXIT; - procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST; - procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE; - procedure CMSysFontChanged(var Message: TMessage); message CM_SYSFONTCHANGED; - procedure CMWinIniChange(var Message: TWMWinIniChange); message CM_WININICHANGE; - procedure CMFontChange(var Message: TMessage); message CM_FONTCHANGE; - procedure CMTimeChange(var Message: TMessage); message CM_TIMECHANGE; - procedure CMDrag(var Message: TCMDrag); message CM_DRAG; - procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN; - procedure CNKeyUp(var Message: TWMKeyUp); message CN_KEYUP; - procedure CNChar(var Message: TWMChar); message CN_CHAR; - procedure CNSysKeyDown(var Message: TWMKeyDown); message CN_SYSKEYDOWN; - procedure CNSysChar(var Message: TWMChar); message CN_SYSCHAR; - procedure CMControlListChange(var Message: TMessage); message CM_CONTROLLISTCHANGE; - procedure CMRecreateWnd(var Message: TMessage); message CM_RECREATEWND; - procedure CMInvalidate(var Message: TMessage); message CM_INVALIDATE; - procedure CMDockClient(var Message: TCMDockClient); message CM_DOCKCLIENT; - procedure CMUnDockClient(var Message: TCMUnDockClient); message CM_UNDOCKCLIENT; - procedure CMFloat(var Message: TCMFloat); message CM_FLOAT; - procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED; - procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL; -*/ -protected: -/* - FDoubleBuffered: Boolean; - FInImeComposition: Boolean; - procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override; - procedure AddBiDiModeExStyle(var ExStyle: DWORD); - procedure AssignTo(Dest: TPersistent); override; - procedure AdjustClientRect(var Rect: TRect); virtual; - procedure AdjustSize; override; - procedure AlignControls(AControl: TControl; var Rect: TRect); virtual; - function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override; - function CanResize(var NewWidth, NewHeight: Integer): Boolean; override; - procedure ChangeScale(M, D: Integer); override; - procedure ConstrainedResize(var MinWidth, MinHeight, MaxWidth, - MaxHeight: Integer); override; - function CreateDockManager: IDockManager; dynamic; - procedure CreateHandle; virtual; - procedure CreateParams(var Params: TCreateParams); virtual; - procedure CreateSubClass(var Params: TCreateParams; - ControlClassName: PChar); - procedure CreateWindowHandle(const Params: TCreateParams); virtual; - procedure CreateWnd; virtual; - procedure DestroyHandle; - procedure DestroyWindowHandle; virtual; - procedure DestroyWnd; virtual; - procedure DoAddDockClient(Client: TControl; const ARect: TRect); dynamic; - procedure DockOver(Source: TDragDockObject; X, Y: Integer; State: TDragState; - var Accept: Boolean); dynamic; - procedure DoDockOver(Source: TDragDockObject; X, Y: Integer; State: TDragState; - var Accept: Boolean); dynamic; - procedure DoEnter; dynamic; - procedure DoExit; dynamic; - procedure DoFlipChildren; dynamic; - function DoKeyDown(var Message: TWMKey): Boolean; - function DoKeyPress(var Message: TWMKey): Boolean; - function DoKeyUp(var Message: TWMKey): Boolean; - function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; - MousePos: TPoint): Boolean; dynamic; - function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; dynamic; - function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; dynamic; - procedure DoRemoveDockClient(Client: TControl); dynamic; - function DoUnDock(NewTarget: TWinControl; Client: TControl): Boolean; dynamic; - function FindNextControl(CurControl: TWinControl; - GoForward, CheckTabStop, CheckParent: Boolean): TWinControl; - procedure FixupTabList; - function GetActionLinkClass: TControlActionLinkClass; override; - procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; - function GetClientOrigin: TPoint; override; - function GetClientRect: TRect; override; - function GetControlExtents: TRect; virtual; - function GetDeviceContext(var WindowHandle: HWnd): HDC; override; - function GetParentHandle: HWnd; - procedure GetSiteInfo(Client: TControl; var InfluenceRect: TRect; - MousePos: TPoint; var CanDock: Boolean); dynamic; - function GetTopParentHandle: HWnd; - function IsControlMouseMsg(var Message: TWMMouse): Boolean; - procedure KeyDown(var Key: Word; Shift: TShiftState); dynamic; - procedure KeyUp(var Key: Word; Shift: TShiftState); dynamic; - procedure KeyPress(var Key: Char); dynamic; - procedure MainWndProc(var Message: TMessage); - procedure NotifyControls(Msg: Word); - procedure PaintControls(DC: HDC; First: TControl); - procedure PaintHandler(var Message: TWMPaint); - procedure PaintWindow(DC: HDC); virtual; - function PaletteChanged(Foreground: Boolean): Boolean; override; - procedure ReadState(Reader: TReader); override; - procedure RecreateWnd; - procedure ReloadDockedControl(const AControlName: string; - var AControl: TControl); dynamic; - procedure ResetIme; - function ResetImeComposition(Action: DWORD): Boolean; - procedure ScaleControls(M, D: Integer); - procedure SelectFirst; - procedure SelectNext(CurControl: TWinControl; - GoForward, CheckTabStop: Boolean); - procedure SetChildOrder(Child: TComponent; Order: Integer); override; - procedure SetIme; - function SetImeCompositionWindow(Font: TFont; XPos, YPos: Integer): Boolean; - procedure SetZOrder(TopMost: Boolean); override; - procedure ShowControl(AControl: TControl); virtual; - procedure WndProc(var Message: TMessage); override; - property BevelEdges: TBevelEdges read FBevelEdges write SetBevelEdges default [beLeft, beTop, beRight, beBottom]; - property BevelInner: TBevelCut index 0 read FBevelInner write SetBevelCut default bvRaised; - property BevelOuter: TBevelCut index 1 read FBevelOuter write SetBevelCut default bvLowered; - property BevelKind: TBevelKind read FBevelKind write SetBevelKind default bkNone; - property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1; - property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth default 0; - property Ctl3D: Boolean read FCtl3D write SetCtl3D stored IsCtl3DStored; - property DefWndProc: Pointer read FDefWndProc write FDefWndProc; - property DockSite: Boolean read FDockSite write SetDockSite default False; - property DockManager: IDockManager read FDockManager write FDockManager; - property ImeMode: TImeMode read FImeMode write FImeMode default imDontCare; - property ImeName: TImeName read FImeName write FImeName; - property ParentCtl3D: Boolean read FParentCtl3D write SetParentCtl3D default True; - property UseDockManager: Boolean read FUseDockManager write SetUseDockManager - default False; - property WheelAccumulator: Integer read FWheelAccumulator write FWheelAccumulator; - property WindowHandle: HWnd read FHandle write FHandle; - property OnDockDrop: TDockDropEvent read FOnDockDrop write FOnDockDrop; - property OnDockOver: TDockOverEvent read FOnDockOver write FOnDockOver; - property OnEnter: TNotifyEvent read FOnEnter write FOnEnter; - property OnExit: TNotifyEvent read FOnExit write FOnExit; - property OnGetSiteInfo: TGetSiteInfoEvent read FOnGetSiteInfo write FOnGetSiteInfo; - property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown; - property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress; - property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp; - property OnMouseWheel: TMouseWheelEvent read FOnMouseWheel write FOnMouseWheel; - property OnMouseWheelDown: TMouseWheelUpDownEvent read FOnMouseWheelDown - write FOnMouseWheelDown; - property OnMouseWheelUp: TMouseWheelUpDownEvent read FOnMouseWheelUp write - FOnMouseWheelUp; - property OnUnDock: TUnDockEvent read FOnUnDock write FOnUnDock; -*/ -public: - GtkWidget *nativeControl; - - TWinControl(TComponent *AOwner); - TWinControl(GtkWidget *ParentWindow); - virtual ~TWinControl(); -/* - class function CreateParentedControl(ParentWindow: HWnd): TWinControl; - procedure Broadcast(var Message); - function CanFocus: Boolean; - function ContainsControl(Control: TControl): Boolean; - function ControlAtPos(const Pos: TPoint; AllowDisabled: Boolean): TControl; - procedure DefaultHandler(var Message); override; - procedure DisableAlign; - property DockClientCount: Integer read GetDockClientCount; - property DockClients[Index: Integer]: TControl read GetDockClients; - procedure DockDrop(Source: TDragDockObject; X, Y: Integer); dynamic; - property DoubleBuffered: Boolean read FDoubleBuffered write FDoubleBuffered; - procedure EnableAlign; - function FindChildControl(const ControlName: string): TControl; - procedure FlipChildren(AllLevels: Boolean); dynamic; - function Focused: Boolean; dynamic; - procedure GetTabOrderList(List: TList); dynamic; - function HandleAllocated: Boolean; - procedure HandleNeeded; - procedure InsertControl(AControl: TControl); - procedure Invalidate; override; - procedure MouseWheelHandler(var Message: TMessage); dynamic; - procedure PaintTo(DC: HDC; X, Y: Integer); - procedure RemoveControl(AControl: TControl); - procedure Realign; - procedure Repaint; override; - procedure ScaleBy(M, D: Integer); - procedure ScrollBy(DeltaX, DeltaY: Integer); - procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; - procedure SetFocus; virtual; - procedure Update; override; - procedure UpdateControlState; - property Brush: TBrush read FBrush; - property Controls[Index: Integer]: TControl read GetControl; - property ControlCount: Integer read GetControlCount; - property Handle: HWnd read GetHandle; - property ParentWindow: HWnd read FParentWindow write SetParentWindow; - property Showing: Boolean read FShowing; - property TabOrder: TTabOrder read GetTabOrder write SetTabOrder default -1; - property TabStop: Boolean read FTabStop write SetTabStop default False; - published - property HelpContext: THelpContext read FHelpContext write FHelpContext stored IsHelpContextStored default 0; -*/ -}; - -#endif diff --git a/apps/X11/VCL/property b/apps/X11/VCL/property deleted file mode 100644 index aee9eda..0000000 --- a/apps/X11/VCL/property +++ /dev/null @@ -1,77 +0,0 @@ -#ifndef PROPERTY_H -#define PROPERTY_H - -#include <iostream> - -template<class Context, class T> struct Property_index; - -template<class Context, class T> -class property { - Context* view; // an Item needs to access values in its context - T (Context::*Getter)(); - void (Context::*Setter)(T); - -protected: - T get() const { return (Getter) ? (view->*Getter)() : 0; } - void set(T val) { if (Setter) (view->*Setter)(val); } - -public: - property(Context* v, - T (Context::*G)() = &Context::get, - void (Context::*S)(T) = &Context::set) - :view(v), Getter(G), Setter(S) { } - - operator T() const { return get(); } - property& operator=(T val) { set(val); return *this; } - property& operator+=(T val) { set(get() + val); return *this; } - property& operator=(const property &other) { set(T(other)); return *this; } - - // specialized operations: - - T operator->() { return get(); } - - // string specific - property<Property_index<Context,T>,char> operator[](int i); - int size() { return (view->*Getter)().size(); } - -}; - -template<class Context, class T> -struct Property_index { // inefficient - property<Context,T>* p; - int i; - Property_index(property<Context,T>* pp, int ii) : p(pp), i(ii) { } - char get() const { return p->get()[i]; } - void set(char ch) { T v = p->get(); v[i] = ch; p->set(v); } -}; - -template<class Context, class T> -property<Property_index<Context,T>,char> property<Context,T>::operator[](int i) -{ - return property<Property_index<Context,T>,char>(new Property_index<Context,T>(this,i)); -// leaks -} - -template<class Context, class T> -inline ostream& operator<<(ostream& s, property<Context,T> p) -{ - s << T(p); -} - -template<class Context, class T> -inline istream& operator>>(istream& s, property<Context,T>& p) -{ - T t; - s >> t; - p = t; -} - - - -/* examples -property<TTreeView,TTreeNodes*> Items; -Items(this, &get, &set); -*/ - - -#endif |