Jump to content

Anders Melander

Members
  • Content Count

    2561
  • Joined

  • Last visited

  • Days Won

    133

Everything posted by Anders Melander

  1. Anders Melander

    Not Threadsafe??

    I think he would like for the application not to appear "hung" while it's waiting for the database task to complete.
  2. Yes, and yes. See TCustomAffineLayer in Examples\Layers\RotLayer\GR32_RotLayer.pas
  3. Anders Melander

    Not Threadsafe??

    Yes, if your end is to make a mess of things, then threads will work wonders for you.
  4. Anders Melander

    Copy bitmap from one app to another app bitmap

    From the title it sounds as if you need to pass a bitmap between two applications, but your description makes it sound as if you need to pass a bitmap from a DLL to an application using that DLL. Between applications: Save the bitmap to a memory stream and use WM_COPYDATA to copy the data. From DLL to application: Just pass a pointer or a bitmap handle. Maybe work a bit more on the problem description?
  5. Anders Melander

    Not Threadsafe??

    I'm guessing the purpose of that code block is to keep the application responsive while the tread is executing, right? ProcessMessages is very rarely the solution - for anything. It's fine in quick and dirty, test code, but it doesn't belong in production code. While there is no problem with ProcessMessages in regard to threads in your code (you're not calling it from a thread), it often makes your UI vulnerable to undesired reentrancy. For example, let's say you have a button on a form with the following OnClick handler: procedure TMyForm.MyButtonClick(Sender: TObject); begin // Increment a counter to show we're busy Tag := Tag + 1; Caption := IntToStr(Tag); // Emulate a task that takes a long time for var i := 0 to 1000 do begin // Busy, busy... Sleep(100); // ...But stay "reponsive"... Application.ProcessMessages; end; // We're done; Decrement the counter Tag := Tag - 1; Caption := IntToStr(Tag); end; The problem here is that unless you take extra steps to prevent it, the user can just keep pressing the button (you'll see the counter keeps incrementing); You've created a recursion through ProcessMessages. The easiest way to prevent that is the disable the UI (e.g. Form.Enabled := False), but the best way is to not use ProcessMessages in the first place. Have you tried pressing the Windows close button (or just [Alt]+[F4]) while that code is executing? I'll bet that doesn't end well. You can create a message loop that processes selected messages instead. For example WM_PAINT and a few others are safe to handle. Here's one I've used in an application I worked on. It is called while doing work that updates a progress bar (with an Abort button). There's a bunch of stuff that only makes in that particular application, but I'm sure you get the meaning. type TFormRedacted = class(TForm) private FProgressStart: TStopWatch; FProgressThrottle: TStopWatch; FLastMessagePump: TStopwatch; FProgressEnableAbort: boolean; FProgressAborted: boolean; ... end; procedure TFormRedacted.ProcessProgressMessages(Force: boolean); var Msg: TMsg; begin if (not Force) and (FLastMessagePump.IsRunning) and (FLastMessagePump.ElapsedMilliseconds < MessagePumpRate * ProgressUpdateFactor) then exit; FLastMessagePump.Reset; var ProgressHandle := ButtonProgressAbort.Handle; // Indicate to madExcept freeze detection that we're not frozen FreezeDetection.IndicateApplicationNotFrozen; try // Allow threads to synchronize to avoid deadlock (e.g. busy loop showing progress waiting for thread to complete (e.g. spell check dictionary load)). CheckSynchronize; Msg.message := 0; try // Look for Escape key pressed. if (FProgressEnableAbort) and (Application.Active) and (GetAsyncKeyState(VK_ESCAPE) <> 0) then begin // Wait for Escape key to be released again. while (GetAsyncKeyState(VK_ESCAPE) <> 0) do Sleep(1); // Clear message queue of keyboard messages while (PeekMessage(Msg, 0, WM_KEYFIRST, WM_KEYLAST, PM_REMOVE)) do begin if (Msg.message = WM_QUIT) then exit; end; PromptAbortProgress; // Wait for Escape key to be released so dismissing the abort prompt // dialog with escape doesn't trigger a new prompt. while (GetAsyncKeyState(VK_ESCAPE) <> 0) do Sleep(1); // Clear message queue of keyboard messages while (PeekMessage(Msg, 0, WM_KEYFIRST, WM_KEYLAST, PM_REMOVE)) do begin if (Msg.message = WM_QUIT) then exit; end; end; // Process mouse move for all windows so hot tracking works. // Don't process mouse movement if a mouse key is down. // This tries to avoid recursions caused by scrollbar movement causing work that // ends up calling this method. while (PeekMessage(Msg, 0, WM_MOUSEMOVE, WM_MOUSEMOVE, PM_NOREMOVE)) and (GetKeyState(VK_LBUTTON) = 0) do begin PeekMessage(Msg, 0, WM_MOUSEMOVE, WM_MOUSEMOVE, PM_REMOVE); if (Msg.message = WM_QUIT) then exit; DispatchMessage(Msg); end; // Process mouse hover/enter/exit messages for all windows so button state will be updated while (PeekMessage(Msg, 0, WM_NCMOUSEHOVER, WM_MOUSELEAVE, PM_REMOVE)) do begin if (Msg.message = WM_QUIT) then exit; DispatchMessage(Msg); end; // Process timer message for all windows so animation works - THIS IS DANGEROUS SINCE ALL TIMERS WILL BE PROCESSED while (PeekMessage(Msg, 0, WM_TIMER, WM_TIMER, PM_REMOVE)) do begin if (Msg.message = WM_QUIT) then exit; DispatchMessage(Msg); end; // Process mouse messages for button so user can press Stop button while (PeekMessage(Msg, ProgressHandle, WM_MOUSEFIRST, WM_MOUSELAST, PM_REMOVE)) do begin if (Msg.message = WM_QUIT) then exit; DispatchMessage(Msg); end; // Process cursor update messages for all windows so cursor stays responsive while (PeekMessage(Msg, 0, WM_SETCURSOR, WM_SETCURSOR, PM_REMOVE)) do begin if (Msg.message = WM_QUIT) then exit; DispatchMessage(Msg); end; // Process progress bar messages - This includes WM_TIMER and WM_PAINT used for progress bar animation while PeekMessage(Msg, Progress.Handle, 0, 0, PM_REMOVE) do begin if (Msg.message = WM_QUIT) then exit; DispatchMessage(Msg); end; // Process paint messages for all windows so UI can repaint itself while PeekMessage(Msg, 0, WM_PAINT, WM_PAINT, PM_REMOVE) or PeekMessage(Msg, 0, WM_ERASEBKGND, WM_ERASEBKGND, PM_REMOVE) or PeekMessage(Msg, Handle, DXM_SKINS_POSTREDRAW, DXM_SKINS_POSTREDRAW, PM_REMOVE) or PeekMessage(Msg, 0, WM_PRINT, WM_PRINT, PM_REMOVE) or PeekMessage(Msg, 0, WM_PRINTCLIENT, WM_PRINTCLIENT, PM_REMOVE) do begin if (Msg.message = WM_QUIT) then exit; DispatchMessage(Msg); end; PeekMessage(Msg, 0, WM_NULL, WM_NULL, PM_NOREMOVE); // Avoid window ghosting due to unresponsiveness on Vista+ finally if (Msg.message = WM_QUIT) then begin PostQuitMessage(Msg.wParam); FProgressAborted := True; end; end; finally FLastMessagePump.Start; end; if (FProgressAborted) then AbortProgress; end; Here's another version of it: https://bitbucket.org/anders_melander/better-translation-manager/src/f96e7dcdba22667560178d32aebb5137484107f0/Source/amProgress.pas#lines-444
  6. Anders Melander

    ANN: Better Translation Manager released

    Ah, I see. No, that isn't really supported, but I can see how that would be beneficial. I've created an issue for it: https://bitbucket.org/anders_melander/better-translation-manager/issues/39 Assuming you are using BTMs resource module load functions (amLocalization.Utils unit), you will have to modify the following function in the amLanguageInfo unit: function LoadNewResourceModule(LocaleItem: TLanguageItem; var ModuleFilename: string): HModule; overload; For example, change this: ModuleFilename := TPath.ChangeExtension(Filename, '.'+FileType); ...to this (note that this hard codes the sub-folder name): var Folder := TPath.Combine(TPath.GetDirectoryName(Filename), '.\lang'); ModuleFilename := TPath.Combine(Folder, TPath.GetFileNameWithoutExtension(Filename)+'.'+FileType); If you are using the RTLs built-in loading mechanism then there isn't any way I can think of.
  7. Anders Melander

    Drawing text with GDI

    https://github.com/graphics32/graphics32/tree/master/Examples/Drawing/TextVPR
  8. Anders Melander

    bitmap is not displayed

    function WindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; begin case Msg of WM_DESTROY: begin PostQuitMessage(0); Exit(0); end; else Result := DefWindowProc(hWnd, Msg, wParam, lParam); end; end; procedure RunClient; begin UpdateWindow(LHWND); while (integer(GetMessage(LMsg, LHWND, 0, 0)) > 0) do begin if (LMsg.message = WM_QUIT) then begin PostQuitMessage(0); break; end; TranslateMessage(LMsg); DispatchMessage(LMsg); end; UnregisterClass(PChar(GClassName), LInst); end; The main problem was that GetMessage is declared to return a BOOL but it actually returns an integer. Specifically, it returns -1 when the message queue has been destroyed.
  9. This should of course not have been an abstract class. I have just committed an implementation of the class to the main branch: https://github.com/graphics32/graphics32/commit/aec3713e187d1300b111f0315380a38b50033fef
  10. Anders Melander

    bitmap is not displayed

    The Halt should probably be an Exit. Otherwise, there isn't much point in the PostQuitMessage.
  11. Anders Melander

    bitmap is not displayed

    It isn't a valid Windows GUI application at all so what do you expect us to say? Compare your code to @KodeZwerg's code. Can you spot the difference? Why do you want to do it this way in the first place?
  12. Anders Melander

    ANN: Better Translation Manager released

    If you mean the resource modules, then sure: amResourceModuleBuilder -b -n:2 -s:.\Test\Test.exe -o:.\Test\lang [...] See: Command Line Interface
  13. Anders Melander

    ANN: Better Translation Manager released

    https://bitbucket.org/anders_melander/better-translation-manager/issues/38
  14. Anders Melander

    ANN: Better Translation Manager released

    This is really a problem in your workflow, not a deficiency of the tool. In a company of your size, with an off-the-shelf product, you really should be using a build server to produce the deliverables and not relying on individual developers to produce the files. The language modules will never get out-of-sync or contain the wrong texts if they are produced against the most recent exe file. It doesn't matter if the xlat file (the translation project) was updated or not. Translations might be missing (i.e the source texts are not translated), but they will never be mismatched. Mismatched texts mean that you are using a language module that was produced for another version of the exe. If your exe contains a version resource, and you remember to bump the version with each new build, then the resource module loader will validate the language module version against the exe version on load. I would recommend you use a workflow similar to this: As I said, I can add a switch to have the command line tool save the project file but I can't see that it would have made a difference in your case.
  15. Anders Melander

    bitmap is not displayed

    Uh. This looks like a "classic" Windows application. While it definitely is possible to create a Windows GUI application that doesn't use the RTL or VCL it isn't really something that is done anymore. If really you want to write a Windows application that way there are a few things missing from your code. I suggest you start by reading the following: https://learn.microsoft.com/en-us/windows/win32/learnwin32/your-first-windows-program If all you want is an application that displays a form with a bitmap on it, here's one that does that: program NoVCL; {$APPTYPE GUI} uses Forms, ExtCtrls; var Form: TForm; Image: TImage; begin Form := TForm.CreateNew(nil); try Image := TImage.Create(Form); Image.Parent := Form; Image.AutoSize := True; Image.Picture.Bitmap.LoadFromFile('bitmap.bmp'); Form.ShowModal; finally Form.Free; end; end.
  16. Anders Melander

    Drawing text with GDI

    In addition to the pixel grid (or rounding as Peter labeled it) there are other reasons why you can't expect a linear relationship between font and text size; The TrueType font rasterizer takes stuff like hinting and kerning into account when deciding how to rasterize a character and place it relative to the other characters. You should probably look into that if you are doing WYSIWYG. Here's some light reading to get you started: https://www.joelonsoftware.com/2007/06/12/font-smoothing-anti-aliasing-and-sub-pixel-rendering/ https://blog.codinghorror.com/font-rendering-respecting-the-pixel-grid/ https://blog.codinghorror.com/whats-wrong-with-apples-font-rendering/ https://agg.sourceforge.net/antigrain.com/research/font_rasterization/index.html https://freetype.org/freetype2/docs/hinting/text-rendering-general.html https://en.wikipedia.org/wiki/Font_rasterization The performance mostly depends on how smart you are about it (cache what you can) and what method you use to draw the text. If you just use the GDI the performance penalty should be negligible as you will just be doing the same thing as the GDI does internally. If you want better performance and quality you can use one of the usual graphics libraries; They have the functionality to rasterize and render text.
  17. Anders Melander

    compiling DCU without creating EXE

    Congratulations. -J* makes the compiler output .obj files instead of dcu files. -JHurrah!NoDCUs works "just as well". -h will tell you all the command line switches. No need to have an AI invent new ones.
  18. Btw, you might want to check out the Image32Background and PanAndZoom examples in the image32_background branch. They demonstrate how to do the following without any custom code (they are now built-in optional features in TImage32/TImgView32): and panning & animated (using cubic tweening) exponential zoom with pivot point:
  19. I would just store a reference to your object and the object owner in the layer and then notify the owner when the layer is moved. Something like this: type TObjectLayer = class; TObjectLayerNotification = ( olnDestroy, // Subscribers should remove reference to layer olnPosition // Layer has moved ); IObjectLayerNotification = interface ['{C5715B62-6D20-4BEE-841A-A898AA67D6F7}'] procedure ObjectLayerNotification(ALayer: TObjectLayer; ANotification: TObjectLayerNotification); end; TObjectLayer = class(TIndirectBitmapLayer) private FSubscribers: TList<IObjectLayerNotification>; FObjectID: TSomeType; protected procedure Notify(ANotification: IObjectLayerNotification); procedure DoSetLocation(const NewLocation: TFloatRect); override; public destructor Destroy; override; procedure Subscribe(const ASubscriber: IObjectLayerNotification); procedure Unsubscribe(const ASubscriber: IObjectLayerNotification); property ObjectID: TSomeType read FObjectID write FObjectID; end; destructor TObjectLayer.Destroy; begin Notify(olnDestroy); FSubscribers.Free; inherited; end; procedure TObjectLayer.DoSetLocation(const NewLocation: TFloatRect); begin inherited DoSetLocation(NewLocation); Notify(olnPosition); end; procedure TObjectLayer.Notify(ANotification: IObjectLayerNotification); begin if (FSubscribers = nil) then exit; for var Subscriber in FSubscribers.ToArray do // ToArray for stability Subscriber.ObjectLayerNotification(Self, ANotification); end; procedure TObjectLayer.Subscribe(const ASubscriber: IObjectLayerNotification); begin if (FSubscribers = nil) then FSubscribers := TList<IObjectLayerNotification>.Create; FSubscribers.Add(ASubscriber); end; procedure TObjectLayer.Unsubscribe(const ASubscriber: IObjectLayerNotification); begin if (FSubscribers <> nil) then FSubscribers.Remove(ASubscriber); end; The object ID is stored in the ObjectID property (change the type to whatever type you use an an ID). The owner must implement the IObjectLayerNotification interface and call Subscribe on the layer to get notifications. This is a pretty standard observer pattern. If you are using the TRubberbandLayer then there's a OnConstrain event where you can examine and modify the move/resize. If you are doing move/resize with some other method then I'll need some information about that. I usually implement rubber-band selection via the TImgView32 mouse events (i.e. I'm not using a layer). So I manage the selection-in-progress state (usually just the mouse-down position) and any current selection on the form. In the mouse-up handler, I create a rectangle polygon from the mouse-down pos and the mouse-up pos and then either replace the current selection with the new one or merge the two (union), depending on the keyboard shift state. The selection is stored as a polygon. You can also use a polypolygon depending on your needs. The selection is drawn by a custom layer (visible only when there actually is a selection). The layer has a copy of the polygon and draws a marching ants (btw, try googling "marching ants") animated line using a stipple pattern and a timer. Here's the Paint method of the layer: procedure TSelectionLayer.Paint(Buffer: TBitmap32); begin try // Update local copy of selection polygon UpdateCache; if (BitmapEditor.HasSelection) then begin Buffer.SetStipple(SelectionStipple); Buffer.StippleCounter := FSelectionStippleCounter; Buffer.StippleStep := 1; PolylineXSP(Buffer, FCachedSelection, not SelectionInProgress); end; except // Prevent AV flood due to repaint Visible := False; raise; end; end; and the setup and control of the stipple pattern: constructor TSelectionLayer.Create(ABitmapEditor: TBitmapEditor); begin inherited Create(ABitmapEditor); FCacheValid := False; FTimer := TTimer.Create(nil); FTimer.Interval := 50; FTimer.OnTimer := OnTimer; FTimer.Enabled := False; CreateStipple(FSelectionStipple, $F0F0F0F0, clBlack32, clWhite32); end; procedure TSelectionLayer.OnTimer(Sender: TObject); begin // TODO : Remove dependency on Forms unit if (not Application.Active) then exit; FSelectionStippleCounter := FSelectionStippleCounter+1.5; if (FSelectionStippleCounter >= Length(SelectionStipple)) then FSelectionStippleCounter := FSelectionStippleCounter - Length(SelectionStipple); Update(FBitmapRect); end;
  20. Anders Melander

    bitmap is not displayed

    Don't expect people to help you if you don't want to make an effort yourself. You need to make it as easy as possible for us to help you. Generally, when describing a problem there are 4 things you need to state: What are you trying to do (high-level description)? E.g. I'm trying to display a bitmap How are you doing it (the steps)? Clean up your code. Post the whole method/function and use the code tag (the </> button). What is the expected result? E.g. The bitmap is drawn in the window What is the actual/observed result? E.g. Nothing is drawn in the window You don't need to write it as a list but unless we have all this information we will have to guess and that just slows things down. See also: https://stackoverflow.com/help/how-to-ask
  21. The code was copied from TCustomBitmapLayer in GR32_Layers, so you can find it there: type TImage32Access = class(TCustomImage32); Stretchtransfer is declared in GR32_Resamplers. I'm considering making TIndirectBitmapLayer the base class for TCustomBitmapLayer.
  22. As I've explained to you before, the reason why there are so many variants is that a line is a low-level primitive and the many different variants cover 3 different coordinate types (fixed, float, integer) and different combinations of orientation, anti-aliasing, transparency, stippling, and clipping options. Each one optimized for its particular feature subset. Sure, we could have just replaced them all with a single mediocre all-in-one method, but then why use Graphics32 at all if not for the performance gains possible with specialization? If the library architecture is poorly designed, or the architecture has become obsolete, then I would agree that it might make sense to start from scratch. I don't really think that's what we're talking about here, though. It's just so much easier (and often more fun) to write code when you don't have to stay within the constraints of an existing framework. I think many libraries, not just graphics libraries, start as someone's hobby experiment and eventually end up growing into a fully featured library that does the same as all the others, but in a slightly different way. From an evolutionary POV diversity is good, but with an eco-system as small as Delphi's I think it just fragments the users - and the contributors. Yes, that's definitely a problem. https://github.com/graphics32/graphics32/issues/69 Wow. I can't speak about how things are in Australia, but at the companies I work with there are more "young" Delphi developers than "old" ones (and I'm not defining "young" as "younger than me" 🙂 ). WRT Anders Hejlsberg isn't it time to let that one go? He was just a (very skilled) developer who left for another job. It happens, you know.
  23. No, I don't think it should. A layer is a fairly small object so the overhead should be negligible. I think the easiest way to do it with layers would be to have each layer associated with a bitmap (i.e. it contains a reference to the bitmap, not a copy of the bitmap) and then have the layer draw the bitmap onto the TImage32 back-buffer. One has scrollbars (to move the viewport), and the other doesn't. That's about it I think. No, definitely not. Each layer draws itself onto the back buffer on demand (i.e. when the TImage32 requests it). To force a layer to redraw itself you call the layer Changed method. To force a full redraw call TImage32.Changed You can either use a standard TPositionedLayer (and draw in its OnPaint event handler) or a simple custom layer class that can draw itself: type TIndirectBitmapLayer = class abstract(TPositionedLayer) // Based on TCustomBitmapLayer. Does not own the bitmap it draws. private FBitmap: TBitmap32; FCropped: Boolean; protected procedure Paint(Buffer: TBitmap32); override; protected procedure SetCropped(Value: Boolean); property Bitmap: TBitmap32 read FBitmap; public constructor Create(ALayerCollection: TLayerCollection; ABitmap: TBitmap32); property Cropped: Boolean read FCropped write SetCropped; end; constructor TIndirectBitmapLayer.Create(ALayerCollection: TLayerCollection; ABitmap: TBitmap32); begin inherited Create(ALayerCollection); FBitmap := ABitmap; end; procedure TIndirectBitmapLayer.Paint(Buffer: TBitmap32); var SrcRect, DstRect, ClipRect, TempRect: TRect; ImageRect: TRect; begin if FBitmap.Empty then Exit; DstRect := MakeRect(GetAdjustedRect(Location)); ClipRect := Buffer.ClipRect; GR32.IntersectRect(TempRect, ClipRect, DstRect); if GR32.IsRectEmpty(TempRect) then Exit; SrcRect := MakeRect(0, 0, FBitmap.Width, FBitmap.Height); if Cropped and (LayerCollection.Owner is TCustomImage32) and (not TImage32Access(LayerCollection.Owner).PaintToMode) then begin if (DstRect.Width < 0.5) or (DstRect.Height < 0.5) then Exit; ImageRect := TCustomImage32(LayerCollection.Owner).GetBitmapRect; GR32.IntersectRect(ClipRect, ClipRect, ImageRect); end; StretchTransfer(Buffer, DstRect, ClipRect, FBitmap, SrcRect, FBitmap.Resampler, FBitmap.DrawMode, FBitmap.OnPixelCombine); end; procedure TIndirectBitmapLayer.SetCropped(Value: Boolean); begin if Value <> FCropped then begin FCropped := Value; Changed; end; end; A standard TRubberbandLayer can be associated with a single "child layer" at a time and can then be used to move and resize that child layer. You will probably want something that can handle multi-selection. I would look at how TRubberbandLayer works and try to extend that. Drawing of object frames and similar stuff can be done in layers that sit below or on top of everything else. For example look at the following (it's from a bitmap editor): From bottom to top we have: Background, including frame with drop-shadow Checkerboard pattern Image layers (there's two in this example) Raster grid Selection mask (marching ants) Tool cursor (a stippled polygon) //------------------------------------------------------------------------------ // // TBitmapEditor Layers and Paint Stages // //------------------------------------------------------------------------------ (* +---------------------+ ^ / / | / Hotspot /-+ | +---------------------+ / | / Cursor /-+ | +---------------------+ / | / Selection /-+ | +---------------------+ / | / Mask /-+ Layers ---> | +---------------------+ / | / Grid /-+ | +---------------------+ / | / Tool rendering /-----+ | +---------------------+ / | / Layer 2 /-+ | +---------------------+ / | / Layer 1 /-+ | +---------------------+ / | / Floating selection /-+ | +---------------------+ / | / Layer 0 /-----+ ^ +---------------------+ / | / Image /-+ | +---------------------+ / | <--- Stages / Background /-+ | +---------------------+ / | / / +---------------------+ *) I think you should start by getting the bitmap layers working and then we can talk about how to handle the selection UI later.
  24. Actually, now that I think of it, a TRubberBandLayer is used to move and resize another layer (see the ImgView_Layers example). For freehand rubber band selection, you would need to implement a custom layer. It's pretty simple. Btw, have you seen this old post:
  25. I haven't seen you ask for help anywhere. You could have tried that. I can probably tell you how to solve your problems with Graphics32, should you choose to continue that way, but you need to ask the questions first 🙂 I believe Image32 does layers too and it might be more accessible than Graphics32. When @angusj comes online he can chime in on that. If you're using the TImage32 or TImgView32 controls then the double buffering is already built in and handled automatically. Each layer just needs to draw itself into a bitmap and the control will take care of the rest. Use a TRubberbandLayer. The layer is drawn on demand onto a bitmap like all other layers but that is already done by TRubberbandLayer so you don't need to do anything special. It depends on your needs. One possible solution is to have each vector object be represented by its own layer. Another is to draw all objects onto a single layer. Or you could do a combination. For simplicity, I would probably choose to draw all objects onto a single layer. Regardless TImage32 takes care of producing the final combined image.
×