Check-in [3a643621eb]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Read PNG files as well as JPG. Show some basic info of selected image.
Timelines: family | ancestors | trunk
Files: files | file ages | folders
SHA1: 3a643621eb6fa7bc31e9de3c151c673b4f9cd23d
User & Date: tinus 2015-02-03 13:24:59.668
Context
2015-02-03
13:24
Read PNG files as well as JPG. Show some basic info of selected image. Leaf check-in: 3a643621eb user: tinus tags: trunk
13:24
Implemented several zooming features (keep proportions). Use TWICImage instead of TOleGraphic as fallback. check-in: 1d07ee6f91 user: tinus tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to src/F_Main.pas.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
unit F_Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.ExtCtrls,
  M_Main;

type
  TfrmMain = class(TForm)
    pnlDesktop: TPanel;
    pbxDesktop: TPaintBox;
    shpMonitor: TShape;
    procedure pbxDesktopPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure shpMonitorMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure pbxDesktopClick(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
  private
    { Private declarations }
    FMonitorShape: array of TShape;

  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses
  U_WPImages;

{$R *.dfm}

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.FormCreate(Sender: TObject);
var
  i: integer;
begin







|
















>









<
<
<







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34



35
36
37
38
39
40
41
unit F_Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.ExtCtrls,
  M_Main, U_WPImages;

type
  TfrmMain = class(TForm)
    pnlDesktop: TPanel;
    pbxDesktop: TPaintBox;
    shpMonitor: TShape;
    procedure pbxDesktopPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure shpMonitorMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure pbxDesktopClick(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
  private
    { Private declarations }
    FMonitorShape: array of TShape;
    procedure ShowImageInfo(const WPImage: TWPImage);
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation




{$R *.dfm}

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.FormCreate(Sender: TObject);
var
  i: integer;
begin
87
88
89
90
91
92
93


94
95
96





















97
98
99
100
101
102
103
104
105
106
107

108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138



139
140
141
142
143
                               MR.Width,
                               MR.Height);
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.FormDblClick(Sender: TObject);


begin
  modMain.CycleWallpaper;
  pnlDesktop.Invalidate;





















end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.pbxDesktopClick(Sender: TObject);
var
  i: Integer;
begin
  // TODO: select desktop in list
  for i := Low(FMonitorShape) to High(FMonitorShape) do begin
    FMonitorShape[i].Pen.Style := psClear;
  end;

end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.pbxDesktopPaint(Sender: TObject);
var
  i: integer;
  MonImg: TWPImage;
begin
  pbxDesktop.Canvas.FillRect(pbxDesktop.BoundsRect);
  if Assigned(modMain.Desktop) then
    modMain.Desktop.Draw(pbxDesktop.Canvas, pbxDesktop.BoundsRect);
  for i := 0 to modMain.Monitors.Count - 1 do begin
    MonImg := modMain.Monitors[i];
    if Assigned(MonImg) then begin
      MonImg.Draw(pbxDesktop.Canvas, FMonitorShape[i].BoundsRect);
    end;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.shpMonitorMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i: Integer;
begin
  // TODO: select given monitor in list
  for i := Low(FMonitorShape) to High(FMonitorShape) do begin
    if (Sender = FMonitorShape[i]) and (FMonitorShape[i].Pen.Style = psClear) then begin
      FMonitorShape[i].Pen.Style := psDot;
    end else begin
      FMonitorShape[i].Pen.Style := psClear;



    end;
  end;
end;

end.







>
>



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>











>










|



|
















>
>
>





85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
                               MR.Width,
                               MR.Height);
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.FormDblClick(Sender: TObject);
var
  i: Integer;
begin
  modMain.CycleWallpaper;
  pnlDesktop.Invalidate;

  for i := Low(FMonitorShape) to High(FMonitorShape) do begin
    if FMonitorShape[i].Pen.Style <> psClear then begin
      ShowImageInfo(modMain.Monitors[i]);
      Exit;
    end;
  end;
  ShowImageInfo(modMain.Desktop);
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.ShowImageInfo(const WPImage: TWPImage);
begin
  if Assigned(WPImage) then begin
    Self.Caption := Format('%s (%dx%d) - %s', [ExtractFileName(WPImage.Path),
                                                WPImage.Width,
                                                WPImage.Height,
                                                Application.Title]);
  end else begin
    Self.Caption := Application.Title;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.pbxDesktopClick(Sender: TObject);
var
  i: Integer;
begin
  // TODO: select desktop in list
  for i := Low(FMonitorShape) to High(FMonitorShape) do begin
    FMonitorShape[i].Pen.Style := psClear;
  end;
  ShowImageInfo(modMain.Desktop);
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.pbxDesktopPaint(Sender: TObject);
var
  i: integer;
  MonImg: TWPImage;
begin
  pbxDesktop.Canvas.FillRect(pbxDesktop.BoundsRect);
  if Assigned(modMain.Desktop) then
    modMain.Desktop.Draw(pbxDesktop.Canvas, pbxDesktop.BoundsRect, TWPImageZoom.FitLargest);
  for i := 0 to modMain.Monitors.Count - 1 do begin
    MonImg := modMain.Monitors[i];
    if Assigned(MonImg) then begin
      MonImg.Draw(pbxDesktop.Canvas, FMonitorShape[i].BoundsRect, TWPImageZoom.FitSmallest);
    end;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.shpMonitorMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i: Integer;
begin
  // TODO: select given monitor in list
  for i := Low(FMonitorShape) to High(FMonitorShape) do begin
    if (Sender = FMonitorShape[i]) and (FMonitorShape[i].Pen.Style = psClear) then begin
      FMonitorShape[i].Pen.Style := psDot;
    end else begin
      FMonitorShape[i].Pen.Style := psClear;
    end;
    if Sender = FMonitorShape[i] then begin
      ShowImageInfo(modMain.Monitors[i]);
    end;
  end;
end;

end.
Changes to src/M_Main.pas.
58
59
60
61
62
63
64
65







66
67
68
69
70
71
72

{ ------------------------------------------------------------------------------------------------ }
procedure TmodMain.DataModuleCreate(Sender: TObject);
var
  i: Integer;
begin
  FDesktop := nil; // TWPImage.Create('C:\MC\MM\Image\Work\Background\composite\Chateau_de_Lassay_2.bmp');
  FFiles := TDirectory.GetFiles('C:\MC\MM\Image\Work\Background\single', '*.jpg', TSearchOption.soAllDirectories);







  SetLength(FFiles, Length(FFiles) + 1);
  FFiles[Length(FFiles) - 1] := 'C:\MC\MM\Image\Work\Background\composite\Chateau_de_Lassay_2.bmp';

  // randomize FFiles
  TArray.Sort<string>(FFiles, TComparer<string>.Construct(function(const Left, Right: string): Integer
                                                          begin
                                                            Result := Random(2) - 1;







|
>
>
>
>
>
>
>







58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79

{ ------------------------------------------------------------------------------------------------ }
procedure TmodMain.DataModuleCreate(Sender: TObject);
var
  i: Integer;
begin
  FDesktop := nil; // TWPImage.Create('C:\MC\MM\Image\Work\Background\composite\Chateau_de_Lassay_2.bmp');
  FFiles := TDirectory.GetFiles('C:\MC\MM\Image\Work\Background\single', TSearchOption.soAllDirectories,
            function(const Path: string; const SearchRec: TSearchRec): Boolean
            var
              Ext: string;
            begin
              Ext := ExtractFileExt(SearchRec.Name);
              Result := SameFileName(Ext, '.jpg') or SameFilename(Ext, '.png');
            end);
  SetLength(FFiles, Length(FFiles) + 1);
  FFiles[Length(FFiles) - 1] := 'C:\MC\MM\Image\Work\Background\composite\Chateau_de_Lassay_2.bmp';

  // randomize FFiles
  TArray.Sort<string>(FFiles, TComparer<string>.Construct(function(const Left, Right: string): Integer
                                                          begin
                                                            Result := Random(2) - 1;