Jump to content

Anders Melander

Members
  • Content Count

    2771
  • Joined

  • Last visited

  • Days Won

    147

Everything posted by Anders Melander

  1. Anders Melander

    Bringing TGlobe from D5 to present day

    What about it? So it used to be shareware. That doesn't mean that it still is. As far as I have been able to determine the author, Graham Knight, has either vanished from the internet or he is the owner of that Github repository.
  2. Anders Melander

    Drag and Drop Component Suite: Outlook embedded images

    I suggest you install the components and run the Source Analyzer example. Then you can see exactly what information an Outlook drop contains. I would be very surprised if Outlook didn't offer the image as a file with a name (real or synthesized).
  3. Anders Melander

    Remove empty event handler

    Only empty, published methods are removed. Are you saying that you manually add published event handlers?
  4. Anders Melander

    Drag and Drop Component Suite: Outlook embedded images

    I can't see why not. You haven't stated if your application is the drop source or the drop target, but if you can drop to/from Outlook from/to the desktop, then you can do the same from/to your own application.
  5. Anders Melander

    Remove empty event handler

    It's always been this way. It would actually annoy me if they spent time fixing this instead of some of the more important stuff. Defeatism, I know.
  6. Anders Melander

    Remove empty event handler

    procedure TFormFooBar.FormClick(Sender: TObject); begin end; { this comment prevents FormClick from being automatically removed } procedure TFormFooBar.FormCreate(Sender: TObject); begin // Blah end;
  7. Anders Melander

    Applying hue change to font graphic on the fly

    Don't sweat it. Take your time. Look at some code and try to understand what it does and how it does it. Don't rush it and eventually, it'll come to you.
  8. Anders Melander

    Applying hue change to font graphic on the fly

    Apart from this line... Result := TColor32(Integer(Result) + (aDiff.RAdj * $10000) + (aDiff.GAdj * $100) + (aDiff.BAdj)); ...it looks ok. The above doesn't take overflow in the individual color components into account so I'm guessing that what's happening is that the overflow causes the alpha to overflow from 255 to 0 (or some very small value). Do this instead: Result := HSVToRGB(H, S, V, TColor32Entry(aBase).A); TColor32Entry(Result).R := Max(255, TColor32Entry(Result).R + aDiff.RAdj); TColor32Entry(Result).G := Max(255, TColor32Entry(Result).G + aDiff.GAdj); TColor32Entry(Result).B := Max(255, TColor32Entry(Result).B + aDiff.BAdj);
  9. Anders Melander

    Applying hue change to font graphic on the fly

    Can you show us what ApplyColorShift looks like?
  10. Anders Melander

    Applying hue change to font graphic on the fly

    Please tag your post "Graphics32" or otherwise mention that's what you're using. My first guess would be that you forgot to set the ALpha pixel value in ApplyColorShift, but then I realized that you aren't drawing the ScrollerText bitmap anywhere... So, is it correct that you aren't getting any text even without the call to ApplyColorShift?
  11. Always? I haven't done my own benchmarking but I thought arrays also outperformed linked lists for the simple search+insert/delete case: https://kjellkod.wordpress.com/2012/08/08/java-galore-linkedlist-vs-arraylist-vs-dynamicintarray/ (yes, I know it's about Java. potato, potato...) I mostly use linked lists for stuff like MRU/LRU caches, and only because I haven't bothered learning a more suitable structure (for caches, that is).
  12. Anders Melander

    Displaying an independent background in a Delphi app

    If I understand you correctly then you could just set ScreenImg.Bitmap.BitmapAlign=baTile and then display the other stuff on top of that with a TBitmapLayer.
  13. Anders Melander

    Displaying an independent background in a Delphi app

    It looks like you're using a Graphics32 TImage32 control to display the bitmap. You should have stated that as otherwise your code makes no sense. I don't really understand what it is you are trying to do. Would you mind posting a picture/mockup of your desired output and another of the experienced output?
  14. Anders Melander

    Parallel Resampling of (VCL-) Bitmaps

    Note that in Graphics32 I had to revert the change of the Box filter radius from 0.5 back to the original radius of 1. See: https://github.com/graphics32/graphics32/issues/209 Since you're using a radius of 0.5 you might have the same issue.
  15. Object references are pointers. That was the whole point and the failure to understand that was the cause of the problem. Apart from that, I agree that most people probably rarely, if ever, use them directly. Sure but it's an important data structure to know. Would you hire a developer who couldn't create a linked list? I know I wouldn't. That really depends on what you do and how you do it. Common? Yes. Most common? Not a chance. I can't remember when I last used a TStringList and I do a lot of string processing and UI stuff. I certainly wouldn't use it to handle CSV files. There's far too much of the format it can't handle properly. While I agree with this, it's not advice I would give a beginner. There are more important things to learn in the beginning and that one will just get in the way of that.
  16. As long as your employer prefers to have you produce the easiest (for you) solution in the shortest amount of time, I guess that's one way to achieve that goal... Sure, for hobby development this is fine - no problem. But for professional development, that approach is simply lazy. Personally, I would have "done my own research", weighed the available options, and decided which best suited the solution I was looking for.
  17. I would really suggest that you postpone messing with pointers until you have a better understanding of the language. Use an array or a TList instead; They perform better. Also, objects aren't really suited for double-linked lists as you will need a full (but empty) object for the head node. That said, the problem appears to be that you aren't aware that an object reference is itself a pointer and that local variables are temporary and allocated on the stack. Thus... Tmp^.Next := @Node ...assigns the address of the Node pointer (and not the address of the Node object) to the Next field. The correct statement would look more like this: Tmp.Next := Node; Notice that the dereference operator (^) is optional so I didn't use it. I think it often just makes the code harder to read.
  18. Anders Melander

    Does C++ Builder have an input - message box?

    ...and InputBox and InputQuery
  19. Yes. You write an event handler and assign it to the event: procedure TMyForm.LayerConstrainHandler(Sender: TObject; const OldLocation: TFloatRect; var NewLocation: TFloatRect; DragState: TRBDragState; Shift: TShiftState); begin // Snap to nearest 10 pixels if [Shift] is down. // Note that the roQuantized layer option provides similar functionality. if (ssShift in Shift) then begin NewLocation.Left := Trunc((NewLocation.Left + 5) / 10) * 10; NewLocation.Top := Trunc((NewLocation.Top + 5) / 10) * 10; NewLocation.Right := Trunc((NewLocation.Right + 5) / 10) * 10; NewLocation.Bottom := Trunc((NewLocation.Bottom + 5) / 10) * 10; end; end; ... var Layer := TRubberbandLayer.Create(MyImage.Layers); Layer.OnConstrain := LayerConstrainHandler; Layer.Options := Layer.Options + [roConstrained]; ... The code I posted isn't runnable as-is. It's just an example from the top of my head. Replace TSomeType with whatever type you use to identify your object. Typo on my part. The Notify method should take a TObjectLayernotification as a parameter. It's just an example of how to draw a marching ants selection in a layer but I suggest you postpone that until you have a better grasp of the fundamentals and have gotten the other stuff working. I just remembered that it is it's actually possible to animate TRubberBandLayer via the FrameStippleCounter property. For example, if you modify the ImgView_Layers example and place a 100 mS TTimer on the mainform with this code: procedure TMainForm.Timer1Timer(Sender: TObject); const StippleSize = 4; // The size of the default stipple pattern begin if (RBLayer = nil) or (not RBLayer.Visible) then exit; var NewStippleCounter := RBLayer.FrameStippleCounter+0.5; // Handle overflow if (NewStippleCounter >= StippleSize) then NewStippleCounter := NewStippleCounter - StippleSize; RBLayer.FrameStippleCounter := NewStippleCounter; RBLayer.Changed; end; That really depends on your use case. If you just need a bitmap with the final image, then you can use the PaintTo method to draw the flattened image on another bitmap. If you want to save your image as objects then you're on your own; You'll have to write code to save the image state, including layers, to some custom file format. Sure. Create a github (or whatever you prefer) repository for it.
  20. Anders Melander

    Anyone know why?

    Never mind. I see that it's an Indian company...
  21. Anders Melander

    Anyone know why?

    They do seem to be looking for a pretty experienced developer but does that imply grey beard? And how do you conclude that the salary is minimal?
  22. Anders Melander

    Why do I have this??

    You need to show us a bit more of your code. How and when is the form created, how and when is it destroyed, where is Destroying set and read, etc., etc.?
  23. Yes, that was the initial observation but if you reread the thread you will see that the original problem was that for some file types, it didn't work. Probably those that already have stuff registered under SystemFileAssociations. FWIW I think this is a bug in Windows. Regardless, unless one has to support XP, SystemFileAssociations should be used since it's the only way to safely extend file types that you don't "own".
  24. Yes, that's my conclusion too. I'm on Win7, 10 and 11 here. This is the relevant code I use for registration: TPropertySheetHandlerFactory class const // CLSID for this shell extension. // Modify this for your own shell extensions (press [Ctrl]+[Shift]+G in // the IDE editor to gererate a new CLSID). CLSID_PropertySheetHandler: TGUID = '{1067C264-8B1F-4B22-919F-DB5191C359CB}'; sFileClass = 'pasfile'; sFileExtension = '.pas'; sClassName = 'DelphiPropSheetShellExt'; resourcestring // Description of our shell extension. sDescription = 'Drag and Drop Component Suite property sheet demo'; ... //////////////////////////////////////////////////////////////////////////////// type TPropertySheetHandlerFactory = class(TShellExtFactory) protected function HandlerRegSubKey: string; override; end; function TPropertySheetHandlerFactory.HandlerRegSubKey: string; begin Result := 'PropertySheetHandlers'; end; //////////////////////////////////////////////////////////////////////////////// initialization TPropertySheetHandlerFactory.Create(ComServer, TDataModulePropertySheetHandler, CLSID_PropertySheetHandler, sClassName, sDescription, sFileClass, sFileExtension, ciMultiInstance); end. TShellExtFactory class //////////////////////////////////////////////////////////////////////////////// // // TShellExtFactory // //////////////////////////////////////////////////////////////////////////////// // Class factory for component based COM classes. // Specialized for Shell Extensions. //////////////////////////////////////////////////////////////////////////////// type TShellExtFactory = class(TVCLComObjectFactory) private FFileExtension: string; FFileClass: string; protected function GetProgID: string; override; function HandlerRegSubKey: string; virtual; abstract; function UseSystemFileAssociations: boolean; virtual; function OwnsFileExtension: boolean; virtual; public constructor Create(ComServer: TComServerObject; ComponentClass: TComponentClass; const ClassID: TGUID; const ClassName, Description, AFileClass, AFileExtension: string; Instancing: TClassInstancing); procedure UpdateRegistry(ARegister: Boolean); override; property FileClass: string read FFileClass write FFileClass; property FileExtension: string read FFileExtension write FFileExtension; end; ..... //////////////////////////////////////////////////////////////////////////////// // // TShellExtFactory // //////////////////////////////////////////////////////////////////////////////// constructor TShellExtFactory.Create(ComServer: TComServerObject; ComponentClass: TComponentClass; const ClassID: TGUID; const ClassName, Description, AFileClass, AFileExtension: string; Instancing: TClassInstancing); begin inherited Create(ComServer, ComponentClass, ClassID, ClassName, Description, Instancing); FFileClass := AFileClass; FFileExtension := AFileExtension; end; function TShellExtFactory.GetProgID: string; begin Result := ''; end; function TShellExtFactory.OwnsFileExtension: boolean; begin // Return True if it's safe to delete the file association upon unregistration. // Be careful that we don't delete file associations used by other applications Result := False; end; procedure TShellExtFactory.UpdateRegistry(ARegister: Boolean); var RegPrefix: string; RootKey: HKEY; ClassIDStr: string; Registry: TRegistry; begin ComServer.GetRegRootAndPrefix(RootKey, RegPrefix); ClassIDStr := GUIDToString(ClassID); if ARegister then begin inherited UpdateRegistry(ARegister); if UseSystemFileAssociations and (FileExtension <> '') then begin CreateRegKey(RegPrefix+'SystemFileAssociations\'+FileExtension+'\shellex\'+HandlerRegSubKey+'\'+ClassName, '', ClassIDStr, RootKey); end else if (FileClass <> '') then begin if (FileExtension <> '') and (GetRegStringValue(RegPrefix+FileExtension, '', RootKey) = '') then CreateRegKey(RegPrefix+FileExtension, '', FileClass, RootKey); CreateRegKey(RegPrefix+FileClass+'\shellex\'+HandlerRegSubKey+'\'+ClassName, '', ClassIDStr, RootKey); end; if (Win32Platform = VER_PLATFORM_WIN32_NT) then begin Registry := TRegistry.Create; try if (ComServer.PerUserRegistration) then Registry.RootKey := HKEY_CURRENT_USER else Registry.RootKey := HKEY_LOCAL_MACHINE; if Registry.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved', False) then Registry.WriteString(ClassIDStr, Description); finally Registry.Free; end; end; end else begin if (Win32Platform = VER_PLATFORM_WIN32_NT) then begin Registry := TRegistry.Create; try if (ComServer.PerUserRegistration) then Registry.RootKey := HKEY_CURRENT_USER else Registry.RootKey := HKEY_LOCAL_MACHINE; if Registry.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved', False) then Registry.DeleteKey(ClassIDStr); finally Registry.Free; end; end; if UseSystemFileAssociations and (FileExtension <> '') then begin DeleteDefaultRegValue(RegPrefix+'SystemFileAssociations\'+FileExtension+'\shellex\'+HandlerRegSubKey+'\'+ClassName, RootKey); DeleteEmptyRegKey(RegPrefix+'SystemFileAssociations\'+FileExtension+'\shellex\'+HandlerRegSubKey+'\'+ClassName, True, RootKey); end else if (FileClass <> '') then begin if (FileExtension <> '') and (OwnsFileExtension) and (GetRegStringValue(RegPrefix+FileExtension, '', RootKey) = FileClass) then DeleteDefaultRegValue(RegPrefix + FileExtension, RootKey); DeleteDefaultRegValue(RegPrefix+FileClass+'\shellex\'+HandlerRegSubKey+'\'+ClassName, RootKey); DeleteEmptyRegKey(RegPrefix+FileClass+'\shellex\'+HandlerRegSubKey+'\'+ClassName, True, RootKey); end; inherited UpdateRegistry(ARegister); end; SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil); end; function TShellExtFactory.UseSystemFileAssociations: boolean; begin Result := True; end; TVCLComObjectFactory class //////////////////////////////////////////////////////////////////////////////// // // TVCLComObjectFactory // //////////////////////////////////////////////////////////////////////////////// // Class factory for component based COM classes. // Does not require a type library. // Based on TComponentFactory and TComObjectFactory. //////////////////////////////////////////////////////////////////////////////// type TVCLComObjectFactory = class(TComObjectFactory, IClassFactory) private protected function CreateInstance(const UnkOuter: IUnknown; const IID: TGUID; out Obj): HResult; stdcall; public constructor Create(ComServer: TComServerObject; ComponentClass: TComponentClass; const ClassID: TGUID; const ClassName, Description: string; Instancing: TClassInstancing); function CreateComObject(const Controller: IUnknown): TComObject; override; procedure UpdateRegistry(Register: Boolean); override; end; ... //////////////////////////////////////////////////////////////////////////////// // // TVCLComObjectFactory // //////////////////////////////////////////////////////////////////////////////// constructor TVCLComObjectFactory.Create(ComServer: TComServerObject; ComponentClass: TComponentClass; const ClassID: TGUID; const ClassName, Description: string; Instancing: TClassInstancing); begin inherited Create(ComServer, TComClass(ComponentClass), ClassID, ClassName, Description, Instancing, tmApartment); end; function TVCLComObjectFactory.CreateComObject(const Controller: IUnknown): TComObject; begin Result := TVCLComObject.CreateFromFactory(Self, Controller); end; function TVCLComObjectFactory.CreateInstance(const UnkOuter: IUnknown; const IID: TGUID; out Obj): HResult; begin if not IsLibrary then begin LockServer(True); try with TApartmentThread.Create(Self, UnkOuter, IID) do begin if WaitForSingleObject(Semaphore, INFINITE) = WAIT_OBJECT_0 then begin Result := CreateResult; if Result <> S_OK then Exit; Result := CoGetInterfaceAndReleaseStream(IStream(ObjStream), IID, Obj); end else Result := E_FAIL end; finally LockServer(False); end; end else Result := inherited CreateInstance(UnkOuter, IID, Obj); end; type TComponentProtectedAccess = class(TComponent); TComponentProtectedAccessClass = class of TComponentProtectedAccess; procedure TVCLComObjectFactory.UpdateRegistry(Register: Boolean); begin if Register then inherited UpdateRegistry(Register); TComponentProtectedAccessClass(ComClass).UpdateRegistry(Register, GUIDToString(ClassID), ProgID); if not Register then inherited UpdateRegistry(Register); end;
×