paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-19 12:39:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

Example for OnResize event order from Mike Sapsard. Issue #27386.

Browse Source 
git-svn-id: trunk@47653 -
This commit is contained in:
juha 2015-02-08 18:20:29 +00:00
parent 54f7e2e148
commit 28bef814ed
5 changed files with 369 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitattributes vendored
View File

@ -4509,6 +4509,10 @@ docs/xml/lcl/xmlpropstorage.xml svneol=LF#text/xml eol=lf
docs/xml/mkhtml.bat svneol=native#text/plain docs/xml/mkhtml.bat svneol=native#text/plain
docs/xml/multi_makeskel.pl svneol=native#text/plain docs/xml/multi_makeskel.pl svneol=native#text/plain
docs/xml/updateXML.bat svneol=native#text/plain docs/xml/updateXML.bat svneol=native#text/plain
examples/ReSizeImageDemo/project1.lpi svneol=native#text/plain
examples/ReSizeImageDemo/project1.lpr svneol=native#text/pascal
examples/ReSizeImageDemo/unit1.lfm svneol=native#text/plain
examples/ReSizeImageDemo/unit1.pas svneol=native#text/pascal
examples/SynEdit/Completion/README.txt svneol=native#text/plain examples/SynEdit/Completion/README.txt svneol=native#text/plain
examples/SynEdit/Completion/SynCompletionSample.ico -text examples/SynEdit/Completion/SynCompletionSample.ico -text
examples/SynEdit/Completion/SynCompletionSample.lpi svneol=native#text/plain examples/SynEdit/Completion/SynCompletionSample.lpi svneol=native#text/plain

88
examples/ReSizeImageDemo/project1.lpi Normal file
View File

@ -0,0 +1,88 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="project1"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="/home/mike/Documents/projects/ReSizeImageDemo/Published"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

21
examples/ReSizeImageDemo/project1.lpr Normal file
View File

@ -0,0 +1,21 @@
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

103
examples/ReSizeImageDemo/unit1.lfm Normal file
View File

@ -0,0 +1,103 @@
object Form1: TForm1
Left = 236
Height = 413
Hint = 'Click Checkboxes to select the redraw'#10'events, then resize the form.'
Top = 162
Width = 572
Caption = 'Image Resize Demo'
ClientHeight = 413
ClientWidth = 572
OnClose = FormClose
OnCreate = FormCreate
OnResize = FormResize
ShowHint = True
LCLVersion = '1.5'
object Pnl1: TPanel
Left = 0
Height = 63
Top = 350
Width = 572
Align = alBottom
ClientHeight = 63
ClientWidth = 572
TabOrder = 0
object CheckBoxImage: TCheckBox
Left = 168
Height = 22
Top = 0
Width = 167
Caption = 'Redraw on Image resize'
TabOrder = 0
end
object CheckBoxPanel: TCheckBox
Left = 168
Height = 22
Top = 16
Width = 160
Caption = 'Redraw on Panel resize'
TabOrder = 1
end
object CheckBoxForm: TCheckBox
Left = 168
Height = 22
Top = 32
Width = 160
Caption = 'Redraw on Form resize'
TabOrder = 2
end
object Button1: TButton
Left = 32
Height = 25
Hint = 'Clear Memo text'
Top = 16
Width = 96
Caption = 'Clear Memo'
OnClick = Button1Click
TabOrder = 3
end
end
object Pnl2: TPanel
Left = 0
Height = 350
Top = 0
Width = 160
Align = alLeft
Caption = 'Pnl2'
ClientHeight = 350
ClientWidth = 160
TabOrder = 1
object Memo1: TMemo
Left = 1
Height = 348
Hint = 'Displays event order. '#10'Clears every 200 lines.'
Top = 1
Width = 158
Align = alClient
Lines.Strings = (
'Memo1'
)
ScrollBars = ssAutoBoth
TabOrder = 0
end
end
object PnlImage: TPanel
Left = 160
Height = 350
Top = 0
Width = 412
Align = alClient
Caption = 'PnlImage'
ClientHeight = 350
ClientWidth = 412
TabOrder = 2
OnResize = PnlImageResize
object Image1: TImage
Left = 1
Height = 348
Top = 1
Width = 410
Align = alClient
OnResize = Image1Resize
end
end
end

153
examples/ReSizeImageDemo/unit1.pas Normal file
View File

@ -0,0 +1,153 @@
unit Unit1;
{$mode objfpc}{$H+}
{Author: Mike Sapsard, 2015.
License: GPL3.
LCL demo of redraw event order for images, panels and forms. it should work
for all widget sets eg Windows, qt, OSX, GTK etc.
Repaint or Invalidate are not needed for resizing events.}
interface
uses
{$ifdef Windows} Windows, {$Endif}Classes, SysUtils, FileUtil,
Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, Buttons;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
CheckBoxImage: TCheckBox;
CheckBoxPanel: TCheckBox;
CheckBoxForm: TCheckBox;
Image1: TImage;
Memo1: TMemo;
Pnl1: TPanel;
Pnl2: TPanel;
PnlImage: TPanel;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure Image1Resize(Sender: TObject);
procedure PnlImageResize(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
Bitmap: TBitmap;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.DoubleBuffered := True; //Stop flickering on some widget sets
Bitmap := TBitmap.Create;
with Bitmap do
begin
// Use ClientWidth and ClientHeight so that code works across widget sets
// eg Windows, qt, OSX, GTK etc
// Height and Width do not allow for widget set and theme borders
Width := PnlImage.ClientWidth;
Height := PnlImage.ClientHeight;
Canvas.brush.color := clBlue;
Canvas.Rectangle(0, 0, Image1.ClientWidth, Image1.ClientHeight);
Canvas.Font.Size := 20;
Canvas.TextOut(15, 170, 'This is the Image');
end;
Image1.Picture.Graphic := Bitmap; //Assign the bitmap to Image1
Memo1.Clear;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
if CheckBoxForm.Checked then
begin
with Image1.Picture.Bitmap do
begin
// Bitmap has a height and width, but these do not change from default,
// because a copy is used by Image1.Picture.Bitmap
Image1.Picture.Bitmap.SetSize(Image1.ClientWidth, Image1.ClientHeight);
// If panel is green, this event was last
Canvas.Brush.Color := clGreen;
Canvas.Rectangle(0, 0, Image1.ClientWidth, Image1.ClientHeight);
Canvas.Font.Color := clYellow;
Canvas.Font.Size := 15;
Canvas.TextOut(10, 90, 'Form resized');
end;
Memo1.Lines.Add(IntToStr(Memo1.Lines.Count) + ' Form resized');
end;
if (Memo1.Lines.Count > 200) then
Memo1.Lines.Clear;
end;
procedure TForm1.Image1Resize(Sender: TObject);
begin
if CheckBoxImage.Checked then
begin
// Bitmap has a height and width, but these do not change from default,
// because a copy is used by Image1.Picture.Bitmap
Image1.Picture.Bitmap.SetSize(Image1.ClientWidth, Image1.ClientHeight);
with Image1.Picture.Bitmap do
begin
// If panel is white, this event was last
Canvas.Brush.Color := clWhite;
Canvas.Rectangle(0, 0, Image1.ClientWidth, Image1.ClientHeight);
Canvas.Font.Color := clGreen;
Canvas.Font.Size := 15;
Canvas.TextOut(10, 10, 'Image resized');
end;
Memo1.Lines.Add(IntToStr(Memo1.Lines.Count) + ' Image resize');
end;
if (Memo1.Lines.Count > 200) then
Memo1.Lines.Clear;
end;
procedure TForm1.PnlImageResize(Sender: TObject);
begin
if CheckBoxPanel.Checked then
begin
// Bitmap has a height and width, but these do not change from default,
// because a copy is used by Image1.Picture.Bitmap
Image1.Picture.Bitmap.SetSize(Image1.ClientWidth, Image1.ClientHeight);
with Image1.Picture.Bitmap do
begin
// If panel is red, this event was last
Canvas.Brush.Color := clRed;
Canvas.Rectangle(0, 0, Image1.ClientWidth, Image1.ClientHeight);
Canvas.Font.Color := clBlack;
Canvas.Font.Size := 15;
Canvas.TextOut(10, 50, 'Panel resized');
end;
Memo1.Lines.Add(IntToStr(Memo1.Lines.Count) + ' Panel resize');
end;
if (Memo1.Lines.Count > 200) then
Memo1.Lines.Clear;
end;
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
CloseAction := caFree;
Bitmap.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Clear;
end;
end.