Skip to content

Commit 296e0fd

Browse files
PascalCorpsmanPascalCorpsman
committed
ADD: Load "finished" images for testing via contextmenu
ADD: ability to tweak depth image before converting
1 parent b0364db commit 296e0fd

File tree

2 files changed

+160
-17
lines changed

2 files changed

+160
-17
lines changed

‎miniprojects/Autostereogram/unit1.lfm‎

Lines changed: 58 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -50,7 +50,7 @@ object Form1: TForm1
5050
object Button2: TButton
5151
Left = 272
5252
Height = 25
53-
Top = 32
53+
Top = 88
5454
Width = 240
5555
Caption = 'Create Image'
5656
TabOrder = 1
@@ -59,7 +59,7 @@ object Form1: TForm1
5959
object Image2: TImage
6060
Left = 272
6161
Height = 90
62-
Top = 64
62+
Top = 120
6363
Width = 90
6464
AutoSize = True
6565
PopupMenu = PopupMenu1
@@ -76,7 +76,7 @@ object Form1: TForm1
7676
object Image3: TImage
7777
Left = 376
7878
Height = 90
79-
Top = 64
79+
Top = 120
8080
Width = 90
8181
AutoSize = True
8282
PopupMenu = PopupMenu1
@@ -137,6 +137,55 @@ object Form1: TForm1
137137
Width = 192
138138
Caption = 'If you do not have a depthmap'#10'to load at hand click this button:'
139139
end
140+
object ScrollBar3: TScrollBar
141+
Left = 336
142+
Height = 14
143+
Top = 40
144+
Width = 121
145+
Min = 1
146+
PageSize = 0
147+
Position = 1
148+
TabOrder = 5
149+
OnChange = ScrollBar3Change
150+
end
151+
object ScrollBar4: TScrollBar
152+
Left = 336
153+
Height = 14
154+
Top = 67
155+
Width = 121
156+
PageSize = 0
157+
Position = 100
158+
TabOrder = 6
159+
OnChange = ScrollBar4Change
160+
end
161+
object Label9: TLabel
162+
Left = 272
163+
Height = 16
164+
Top = 38
165+
Width = 59
166+
Caption = 'Mindepth'
167+
end
168+
object Label10: TLabel
169+
Left = 272
170+
Height = 16
171+
Top = 64
172+
Width = 62
173+
Caption = 'Maxdepth'
174+
end
175+
object Label11: TLabel
176+
Left = 472
177+
Height = 16
178+
Top = 38
179+
Width = 48
180+
Caption = 'Label11'
181+
end
182+
object Label12: TLabel
183+
Left = 472
184+
Height = 16
185+
Top = 64
186+
Width = 48
187+
Caption = 'Label12'
188+
end
140189
object OpenDialog1: TOpenDialog
141190
DefaultExt = '.bmp'
142191
Filter = 'Bitmap|*.bmp|All|*.*'
@@ -145,16 +194,20 @@ object Form1: TForm1
145194
end
146195
object PopupMenu1: TPopupMenu
147196
Left = 280
148-
Top = 112
197+
Top = 168
149198
object MenuItem1: TMenuItem
150199
Caption = 'Save Image'
151200
OnClick = MenuItem1Click
152201
end
202+
object MenuItem2: TMenuItem
203+
Caption = 'Load Image'
204+
OnClick = MenuItem2Click
205+
end
153206
end
154207
object SaveDialog1: TSaveDialog
155208
DefaultExt = '.bmp'
156209
Filter = 'Bitmap|*.bmp|All|*.*'
157210
Left = 280
158-
Top = 176
211+
Top = 232
159212
end
160213
end

‎miniprojects/Autostereogram/unit1.pas‎

Lines changed: 102 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
(******************************************************************************)
22
(* Autostereogram 30.11.2025 *)
33
(* *)
4-
(* Version : 0.01 *)
4+
(* Version : 0.02 *)
55
(* *)
66
(* Author : Uwe Schächterle (Corpsman) *)
77
(* *)
@@ -23,6 +23,8 @@
2323
(* Known Issues: none *)
2424
(* *)
2525
(* History : 0.01 - Initial version *)
26+
(* 0.02 - Load "finished" images for testing via contextmenu *)
27+
(* ADD: ability to tweak depth image before converting *)
2628
(* *)
2729
(******************************************************************************)
2830
Unit Unit1;
@@ -48,29 +50,41 @@
4850
Image2: TImage;
4951
Image3: TImage;
5052
Label1: TLabel;
53+
Label10: TLabel;
54+
Label11: TLabel;
55+
Label12: TLabel;
5156
Label2: TLabel;
5257
Label3: TLabel;
5358
Label4: TLabel;
5459
Label5: TLabel;
5560
Label6: TLabel;
5661
Label7: TLabel;
5762
Label8: TLabel;
63+
Label9: TLabel;
5864
MenuItem1: TMenuItem;
65+
MenuItem2: TMenuItem;
5966
OpenDialog1: TOpenDialog;
6067
PopupMenu1: TPopupMenu;
6168
SaveDialog1: TSaveDialog;
6269
ScrollBar1: TScrollBar;
6370
ScrollBar2: TScrollBar;
71+
ScrollBar3: TScrollBar;
72+
ScrollBar4: TScrollBar;
6473
Procedure Button1Click(Sender: TObject);
6574
Procedure Button2Click(Sender: TObject);
6675
Procedure Button3Click(Sender: TObject);
6776
Procedure FormCreate(Sender: TObject);
6877
Procedure MenuItem1Click(Sender: TObject);
78+
Procedure MenuItem2Click(Sender: TObject);
6979
Procedure ScrollBar1Change(Sender: TObject);
7080
Procedure ScrollBar2Change(Sender: TObject);
81+
Procedure ScrollBar3Change(Sender: TObject);
82+
Procedure ScrollBar4Change(Sender: TObject);
7183
private
72-
Raw: Array Of Array Of Byte;
84+
Raw: TRawData;
7385
initialized: Boolean;
86+
87+
Function BitmapToRawData(Const BM: TBitmap): TRawData;
7488
public
7589

7690
End;
@@ -84,12 +98,21 @@
8498

8599
Uses math, FPImage;
86100

101+
Function Map(vmin, vmax, v: Single; rmin, rmax: Single): Single;
102+
Begin
103+
If (vmax - vmin = 0) Then Begin
104+
result := rmin;
105+
exit;
106+
End
107+
Else Begin
108+
result := ((((v - vmin) * (rmax - rmin)) / (vmax - vmin)) + rmin);
109+
End;
110+
End;
111+
87112
{ TForm1 }
88113

89114
Procedure TForm1.Button1Click(Sender: TObject);
90115
Begin
91-
// OpenDialog1.FileName := 'Logo_depth.bmp';
92-
// OpenDialog1.FileName := 'Sphere.bmp';
93116
If OpenDialog1.Execute Then Begin
94117
initialized := true;
95118
Image1.Picture.LoadFromFile(OpenDialog1.FileName);
@@ -115,25 +138,32 @@
115138
i, j, shift: Integer;
116139
pattern_width, pattern_div, idx: integer;
117140

141+
minDepth, maxDepth: byte;
118142
Begin
119143
If Not initialized Then exit;
120144

145+
minDepth := ScrollBar3.Position;
146+
maxDepth := 255 - (100 - ScrollBar4.Position);
121147
// 1. Tiefenbild extrahieren
122148
tmp_bm := TBitmap.Create;
123149
tmp_bm.Assign(Image1.Picture);
124150

125-
depth_data := Nil;
126-
SetLength(depth_data, tmp_bm.Width, tmp_bm.Height);
127-
tmp_img := tmp_bm.CreateIntfImage;
128-
For i := 0 To tmp_bm.Width - 1 Do
129-
For j := 0 To tmp_bm.Height - 1 Do
130-
depth_data[i, j] := (tmp_img.Colors[i, j].Red Shr 8) And $FF;
131-
tmp_img.Free;
151+
depth_data := BitmapToRawData(tmp_bm);
132152

133153
// 2. Zielbild daten bestimmen
134154
Image_Width := tmp_bm.Width;
135155
Image_Height := tmp_bm.Height;
136156

157+
// Optionales Nachträgliches "verbiegen" des eingeladenen Tiefenbildes ;)
158+
If (minDepth <> 1) Or (maxDepth <> 255) Then Begin
159+
For i := 0 To Image_Width - 1 Do
160+
For j := 0 To Image_Height - 1 Do Begin
161+
If depth_data[i, j] <> 0 Then Begin
162+
depth_data[i, j] := round(Map(1, 255, depth_data[i, j], minDepth, maxDepth));
163+
End;
164+
End;
165+
End;
166+
137167
// 3. Pattern erstellen
138168
tmp_bm.Free;
139169
pattern := Nil;
@@ -158,6 +188,7 @@
158188
End
159189
Else Begin
160190
// Verschieben der Pixel entsprechend der Tiefeninformationen ;)
191+
// shift := trunc(map(0, 255, depth_data[i, j], minDepth, maxDepth) / pattern_div);
161192
shift := trunc(depth_data[i, j] / pattern_div);
162193
idx := i - pattern_width + shift;
163194
idx := max(0, min(idx, Image_Width - 1));
@@ -240,11 +271,13 @@
240271
(*
241272
* Magic eye texture generation inspired by: https://github.com/synesthesiam/magicpy
242273
*)
243-
caption := 'Magic eye image creator ver. 0.01, by Corpsman, www.Corpsman.de';
274+
caption := 'Magic eye image creator ver. 0.02, by Corpsman, www.Corpsman.de';
244275
Randomize;
245276
Raw := Nil;
246277
initialized := false;
247278
ScrollBar2Change(Nil);
279+
ScrollBar3Change(Nil);
280+
ScrollBar4Change(Nil);
248281
End;
249282

250283
Procedure TForm1.MenuItem1Click(Sender: TObject);
@@ -259,6 +292,36 @@
259292
End;
260293
End;
261294

295+
Procedure TForm1.MenuItem2Click(Sender: TObject);
296+
Var
297+
bm: TBitmap;
298+
pattern_width: integer;
299+
Begin
300+
If OpenDialog1.Execute Then Begin
301+
bm := TBitmap.Create;
302+
bm.LoadFromFile(OpenDialog1.FileName);
303+
Image2.Picture.Assign(bm);
304+
305+
image3.Left := Image2.Left + image2.Width + 15;
306+
image3.Picture.Assign(bm);
307+
ScrollBar1.Left := image3.Left;
308+
ScrollBar1.Width := image2.Width;
309+
ScrollBar1.Max := image2.Width;
310+
label4.left := ScrollBar1.Left;
311+
label5.left := label4.left + label4.Width + 5;
312+
raw := BitmapToRawData(bm);
313+
// TODO: mittels Koinzidenztest die Patternwith direkt bestimmen!
314+
pattern_width := bm.Width Div 10;
315+
If ScrollBar1.Position = pattern_width Then Begin
316+
ScrollBar1Change(Nil);
317+
End
318+
Else Begin
319+
ScrollBar1.Position := pattern_width;
320+
End;
321+
bm.Free;
322+
End;
323+
End;
324+
262325
Procedure TForm1.ScrollBar1Change(Sender: TObject);
263326
Var
264327
off, i, j: Integer;
@@ -299,5 +362,32 @@
299362
Button2.Click;
300363
End;
301364

365+
Procedure TForm1.ScrollBar3Change(Sender: TObject);
366+
Begin
367+
Label11.Caption := inttostr(ScrollBar3.Position);
368+
Button2.Click;
369+
End;
370+
371+
Procedure TForm1.ScrollBar4Change(Sender: TObject);
372+
Begin
373+
Label12.Caption := inttostr(255 - (100 - ScrollBar4.Position));
374+
Button2.Click;
375+
End;
376+
377+
Function TForm1.BitmapToRawData(Const BM: TBitmap): TRawData;
378+
Var
379+
i, j: Integer;
380+
tmp_img: TLazIntfImage;
381+
Begin
382+
Result := Nil;
383+
SetLength(Result, bm.Width, bm.Height);
384+
tmp_img := bm.CreateIntfImage;
385+
For i := 0 To bm.Width - 1 Do
386+
For j := 0 To bm.Height - 1 Do
387+
Result[i, j] := (tmp_img.Colors[i, j].Red Shr 8) And $FF;
388+
tmp_img.Free;
389+
390+
End;
391+
302392
End.
303393

0 commit comments

Comments
 (0)